From lattner at cs.uiuc.edu  Mon Feb 16 00:36:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 00:36:01 2004
Subject: [llvm-commits] CVS: llvm/test/Regression/Transforms/SimplifyCFG/UncondBranchToReturn.ll
Message-ID: <200402160635.AAA12003@zion.cs.uiuc.edu>


Changes in directory llvm/test/Regression/Transforms/SimplifyCFG:

UncondBranchToReturn.ll added (r1.1)

---
Log message:

New testcase, details in the comments


---
Diffs of the changes:  (+32 -0)

Index: llvm/test/Regression/Transforms/SimplifyCFG/UncondBranchToReturn.ll
diff -c /dev/null llvm/test/Regression/Transforms/SimplifyCFG/UncondBranchToReturn.ll:1.1
*** /dev/null	Mon Feb 16 00:35:29 2004
--- llvm/test/Regression/Transforms/SimplifyCFG/UncondBranchToReturn.ll	Mon Feb 16 00:35:19 2004
***************
*** 0 ****
--- 1,32 ----
+ ; The unify-function-exit-nodes pass often makes basic blocks that just contain
+ ; a PHI node and a return.  Make sure the simplify cfg can straighten out this
+ ; important case.  This is basically the most trivial form of tail-duplication.
+ 
+ ; RUN: llvm-as < %s | opt -simplifycfg | llvm-dis | not grep 'br label'
+ 
+ int %test(bool %B, int %A, int %B) {
+ 	br bool %B, label %T, label %F
+ T:
+ 	br label %ret
+ F:
+ 	br label %ret
+ ret:
+ 	%X = phi int [%A, %F], [%B, %T]
+ 	ret int %X
+ }
+ 
+ ; Make sure it's willing to move unconditional branches to return instructions
+ ; as well, even if the return block is shared and the source blocks are
+ ; non-empty.
+ int %test2(bool %B, int %A, int %B) {
+ 	br bool %B, label %T, label %F
+ T:
+ 	call int %test(bool true, int 5, int 8)
+ 	br label %ret
+ F:
+ 	call int %test(bool true, int 5, int 8)
+ 	br label %ret
+ ret:
+ 	ret int %A
+ }
+ 




From lattner at cs.uiuc.edu  Mon Feb 16 00:36:04 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 00:36:04 2004
Subject: [llvm-commits] CVS: llvm/lib/Transforms/Utils/SimplifyCFG.cpp
Message-ID: <200402160635.AAA12014@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Transforms/Utils:

SimplifyCFG.cpp updated: 1.22 -> 1.23

---
Log message:

Implement test/Regression/Transforms/SimplifyCFG/UncondBranchToReturn.ll,
see the testcase for the reasoning.


---
Diffs of the changes:  (+48 -0)

Index: llvm/lib/Transforms/Utils/SimplifyCFG.cpp
diff -u llvm/lib/Transforms/Utils/SimplifyCFG.cpp:1.22 llvm/lib/Transforms/Utils/SimplifyCFG.cpp:1.23
--- llvm/lib/Transforms/Utils/SimplifyCFG.cpp:1.22	Tue Feb 10 21:36:04 2004
+++ llvm/lib/Transforms/Utils/SimplifyCFG.cpp	Mon Feb 16 00:35:48 2004
@@ -342,6 +342,54 @@
     }
   }
 
+  // If this is a returning block with only PHI nodes in it, fold the return
+  // instruction into any unconditional branch predecessors.
+  if (ReturnInst *RI = dyn_cast<ReturnInst>(BB->getTerminator())) {
+    BasicBlock::iterator BBI = BB->getTerminator();
+    if (BBI == BB->begin() || isa<PHINode>(--BBI)) {
+      // Find predecessors that end with unconditional branches.
+      std::vector<BasicBlock*> UncondBranchPreds;
+      for (pred_iterator PI = pred_begin(BB), E = pred_end(BB); PI != E; ++PI) {
+        TerminatorInst *PTI = (*PI)->getTerminator();
+        if (BranchInst *BI = dyn_cast<BranchInst>(PTI))
+          if (BI->isUnconditional())
+            UncondBranchPreds.push_back(*PI);
+      }
+      
+      // If we found some, do the transformation!
+      if (!UncondBranchPreds.empty()) {
+        while (!UncondBranchPreds.empty()) {
+          BasicBlock *Pred = UncondBranchPreds.back();
+          UncondBranchPreds.pop_back();
+          Instruction *UncondBranch = Pred->getTerminator();
+          // Clone the return and add it to the end of the predecessor.
+          Instruction *NewRet = RI->clone();
+          Pred->getInstList().push_back(NewRet);
+
+          // If the return instruction returns a value, and if the value was a
+          // PHI node in "BB", propagate the right value into the return.
+          if (NewRet->getNumOperands() == 1)
+            if (PHINode *PN = dyn_cast<PHINode>(NewRet->getOperand(0)))
+              if (PN->getParent() == BB)
+                NewRet->setOperand(0, PN->getIncomingValueForBlock(Pred));
+          // Update any PHI nodes in the returning block to realize that we no
+          // longer branch to them.
+          BB->removePredecessor(Pred);
+          Pred->getInstList().erase(UncondBranch);
+        }
+
+        // If we eliminated all predecessors of the block, delete the block now.
+        if (pred_begin(BB) == pred_end(BB))
+          // We know there are no successors, so just nuke the block.
+          M->getBasicBlockList().erase(BB);
+
+        
+        return true;
+      }
+    }
+  }
+
+
   // Merge basic blocks into their predecessor if there is only one distinct
   // pred, and if there is only one distinct successor of the predecessor, and
   // if there are no PHI nodes.




From alkis at cs.uiuc.edu  Mon Feb 16 01:18:00 2004
From: alkis at cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 01:18:00 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/MachineBasicBlock.cpp MachineInstr.cpp MachineFunction.cpp
Message-ID: <200402160717.BAA28772@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

MachineBasicBlock.cpp updated: 1.5 -> 1.6
MachineInstr.cpp updated: 1.89 -> 1.90
MachineFunction.cpp updated: 1.51 -> 1.52

---
Log message:

Add LeakDetection to MachineInstr.

Move out of line member functions of MachineBasicBlock to
MachineBasicBlock.cpp.


---
Diffs of the changes:  (+80 -11)

Index: llvm/lib/CodeGen/MachineBasicBlock.cpp
diff -u /dev/null llvm/lib/CodeGen/MachineBasicBlock.cpp:1.6
--- /dev/null	Mon Feb 16 01:17:53 2004
+++ llvm/lib/CodeGen/MachineBasicBlock.cpp	Mon Feb 16 01:17:42 2004
@@ -0,0 +1,68 @@
+//===-- llvm/CodeGen/MachineBasicBlock.cpp ----------------------*- C++ -*-===//
+//
+//                     The LLVM Compiler Infrastructure
+//
+// This file was developed by the LLVM research group and is distributed under
+// the University of Illinois Open Source License. See LICENSE.TXT for details.
+//
+//===----------------------------------------------------------------------===//
+//
+// Collect the sequence of machine instructions for a basic block.
+//
+//===----------------------------------------------------------------------===//
+
+#include "llvm/CodeGen/MachineBasicBlock.h"
+
+#include "llvm/BasicBlock.h"
+#include "llvm/CodeGen/MachineFunction.h"
+#include "llvm/CodeGen/MachineInstr.h"
+#include "Support/LeakDetector.h"
+#include <iostream>
+
+using namespace llvm;
+
+MachineInstr* ilist_traits<MachineInstr>::createNode()
+{
+    MachineInstr* dummy = new MachineInstr(0, 0);
+    LeakDetector::removeGarbageObject(dummy);
+    return dummy;
+}
+
+void ilist_traits<MachineInstr>::addNodeToList(MachineInstr* N)
+{
+    assert(N->parent == 0 && "machine instruction already in a basic block");
+    N->parent = parent;
+    LeakDetector::removeGarbageObject(N);
+}
+
+void ilist_traits<MachineInstr>::removeNodeFromList(MachineInstr* N)
+{
+    assert(N->parent != 0 && "machine instruction not in a basic block");
+    N->parent = 0;
+    LeakDetector::addGarbageObject(N);
+}
+
+void ilist_traits<MachineInstr>::transferNodesFromList(
+    iplist<MachineInstr, ilist_traits<MachineInstr> >& toList,
+    ilist_iterator<MachineInstr> first,
+    ilist_iterator<MachineInstr> last)
+{
+    if (parent != toList.parent)
+        for (; first != last; ++first)
+            first->parent = toList.parent;
+}
+
+void MachineBasicBlock::dump() const
+{
+    print(std::cerr);
+}
+
+void MachineBasicBlock::print(std::ostream &OS) const
+{
+    const BasicBlock *LBB = getBasicBlock();
+    OS << "\n" << LBB->getName() << " (" << (const void*)LBB << "):\n";
+    for (const_iterator I = begin(); I != end(); ++I) {
+        OS << "\t";
+        I->print(OS, MachineFunction::get(LBB->getParent()).getTarget());
+    }
+}


Index: llvm/lib/CodeGen/MachineInstr.cpp
diff -u llvm/lib/CodeGen/MachineInstr.cpp:1.89 llvm/lib/CodeGen/MachineInstr.cpp:1.90
--- llvm/lib/CodeGen/MachineInstr.cpp:1.89	Fri Feb 13 15:01:20 2004
+++ llvm/lib/CodeGen/MachineInstr.cpp	Mon Feb 16 01:17:42 2004
@@ -20,6 +20,7 @@
 #include "llvm/Target/TargetMachine.h"
 #include "llvm/Target/TargetInstrInfo.h"
 #include "llvm/Target/MRegisterInfo.h"
+#include "Support/LeakDetector.h"
 
 namespace llvm {
 
@@ -38,6 +39,8 @@
     numImplicitRefs(0),
     operands(numOperands, MachineOperand()),
     parent(0) {
+  // Make sure that we get added to a machine basicblock
+  LeakDetector::addGarbageObject(this);
 }
 
 /// MachineInstr ctor - This constructor only does a _reserve_ of the operands,
@@ -48,6 +51,8 @@
 MachineInstr::MachineInstr(short opcode, unsigned numOperands, bool XX, bool YY)
   : Opcode(opcode), numImplicitRefs(0), parent(0) {
   operands.reserve(numOperands);
+  // Make sure that we get added to a machine basicblock
+  LeakDetector::addGarbageObject(this);
 }
 
 /// MachineInstr ctor - Work exactly the same as the ctor above, except that the
@@ -58,7 +63,14 @@
   : Opcode(opcode), numImplicitRefs(0), parent(0) {
   assert(MBB && "Cannot use inserting ctor with null basic block!");
   operands.reserve(numOperands);
+  // Make sure that we get added to a machine basicblock
+  LeakDetector::addGarbageObject(this);
   MBB->push_back(this);  // Add instruction to end of basic block!
+}
+
+MachineInstr::~MachineInstr()
+{
+  LeakDetector::removeGarbageObject(this);
 }
 
 /// OperandComplete - Return true if it's illegal to add a new operand


Index: llvm/lib/CodeGen/MachineFunction.cpp
diff -u llvm/lib/CodeGen/MachineFunction.cpp:1.51 llvm/lib/CodeGen/MachineFunction.cpp:1.52
--- llvm/lib/CodeGen/MachineFunction.cpp:1.51	Sat Feb 14 18:03:15 2004
+++ llvm/lib/CodeGen/MachineFunction.cpp	Mon Feb 16 01:17:42 2004
@@ -120,17 +120,6 @@
   OS << "\nEnd function \"" << Fn->getName() << "\"\n\n";
 }
 
-void MachineBasicBlock::dump() const { print(std::cerr); }
-
-void MachineBasicBlock::print(std::ostream &OS) const {
-  const BasicBlock *LBB = getBasicBlock();
-  OS << "\n" << LBB->getName() << " (" << (const void*)LBB << "):\n";
-  for (const_iterator I = begin(); I != end(); ++I) {
-    OS << "\t";
-    I->print(OS, MachineFunction::get(LBB->getParent()).getTarget());
-  }
-}
-
 // The next two methods are used to construct and to retrieve
 // the MachineCodeForFunction object for the given function.
 // construct() -- Allocates and initializes for a given function and target




From alkis at cs.uiuc.edu  Mon Feb 16 01:18:02 2004
From: alkis at cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 01:18:02 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/CodeGen/MachineInstr.h MachineBasicBlock.h
Message-ID: <200402160717.BAA28784@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm/CodeGen:

MachineInstr.h updated: 1.136 -> 1.137
MachineBasicBlock.h updated: 1.18 -> 1.19

---
Log message:

Add LeakDetection to MachineInstr.

Move out of line member functions of MachineBasicBlock to
MachineBasicBlock.cpp.


---
Diffs of the changes:  (+9 -22)

Index: llvm/include/llvm/CodeGen/MachineInstr.h
diff -u llvm/include/llvm/CodeGen/MachineInstr.h:1.136 llvm/include/llvm/CodeGen/MachineInstr.h:1.137
--- llvm/include/llvm/CodeGen/MachineInstr.h:1.136	Fri Feb 13 15:01:20 2004
+++ llvm/include/llvm/CodeGen/MachineInstr.h	Mon Feb 16 01:17:43 2004
@@ -345,7 +345,6 @@
   // Intrusive list support
   //
   friend class ilist_traits<MachineInstr>;
-  MachineInstr() : Opcode(0), numImplicitRefs(0) { /* used only by ilist */ }
 
 public:
   MachineInstr(short Opcode, unsigned numOperands);
@@ -363,6 +362,8 @@
   ///
   MachineInstr(MachineBasicBlock *MBB, short Opcode, unsigned numOps);
   
+  ~MachineInstr();
+
   const MachineBasicBlock* getParent() const { return parent; }
   MachineBasicBlock* getParent() { return parent; }
 


Index: llvm/include/llvm/CodeGen/MachineBasicBlock.h
diff -u llvm/include/llvm/CodeGen/MachineBasicBlock.h:1.18 llvm/include/llvm/CodeGen/MachineBasicBlock.h:1.19
--- llvm/include/llvm/CodeGen/MachineBasicBlock.h:1.18	Fri Feb 13 14:05:56 2004
+++ llvm/include/llvm/CodeGen/MachineBasicBlock.h	Mon Feb 16 01:17:43 2004
@@ -24,8 +24,6 @@
 template <>
 class ilist_traits<MachineInstr>
 {
-  typedef ilist_traits<MachineInstr> self;
-
   // this is only set by the MachineBasicBlock owning the ilist
   friend class MachineBasicBlock;
   MachineBasicBlock* parent;
@@ -45,25 +43,13 @@
   static void setPrev(MachineInstr* N, MachineInstr* prev) { N->prev = prev; }
   static void setNext(MachineInstr* N, MachineInstr* next) { N->next = next; }
 
-  static MachineInstr* createNode() { return new MachineInstr(0, 0); }
-
-  void addNodeToList(MachineInstr* N) {
-    assert(N->parent == 0 && "machine instruction already in a basic block");
-    N->parent = parent;
-  }
-
-  void removeNodeFromList(MachineInstr* N) {
-    assert(N->parent != 0 && "machine instruction not in a basic block");
-    N->parent = 0;
-  }
-
-  void transferNodesFromList(iplist<MachineInstr, self>& toList,
-                             ilist_iterator<MachineInstr> first,
-                             ilist_iterator<MachineInstr> last) {
-    if (parent != toList.parent)
-      for (; first != last; ++first)
-          first->parent = toList.parent;
-  }
+  static MachineInstr* createNode();
+  void addNodeToList(MachineInstr* N);
+  void removeNodeFromList(MachineInstr* N);
+  void transferNodesFromList(
+      iplist<MachineInstr, ilist_traits<MachineInstr> >& toList,
+      ilist_iterator<MachineInstr> first,
+      ilist_iterator<MachineInstr> last);
 };
 
 class BasicBlock;




From criswell at cs.uiuc.edu  Mon Feb 16 08:56:02 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 08:56:02 2004
Subject: [llvm-commits] CVS: llvm/configure
Message-ID: <200402161455.IAA19916@choi.cs.uiuc.edu>


Changes in directory llvm:

configure updated: 1.73 -> 1.74

---
Log message:

Adjusted the default pathname to the SPEC95 benchmarks.  The new directory
has source code corrections and some input files pre-filtered for use
with the LLVM test suite.



---
Diffs of the changes:  (+3 -3)

Index: llvm/configure
diff -u llvm/configure:1.73 llvm/configure:1.74
--- llvm/configure:1.73	Fri Feb 13 15:56:57 2004
+++ llvm/configure	Mon Feb 16 08:55:15 2004
@@ -21722,9 +21722,9 @@
 fi;
 if test ${enableval} = "no"
 then
-	if test -d /home/vadve/shared/benchmarks/spec95_sparcv9/benchspec
+	if test -d /home/vadve/shared/benchmarks/spec95/benchspec
 	then
-		SPEC95_ROOT=/home/vadve/shared/benchmarks/spec95_sparcv9/benchspec
+		SPEC95_ROOT=/home/vadve/shared/benchmarks/spec95/benchspec
 
 		USE_SPEC95=USE_SPEC95=1
 
@@ -21736,7 +21736,7 @@
 else
 	if test ${enableval} = ""
 	then
-		SPEC95_ROOT=/home/vadve/shared/benchmarks/spec95_sparcv9/benchspec
+		SPEC95_ROOT=/home/vadve/shared/benchmarks/spec95/benchspec
 
 	else
 		SPEC95_ROOT=${enableval}




From criswell at cs.uiuc.edu  Mon Feb 16 08:56:05 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 08:56:05 2004
Subject: [llvm-commits] CVS: llvm/autoconf/configure.ac
Message-ID: <200402161455.IAA19923@choi.cs.uiuc.edu>


Changes in directory llvm/autoconf:

configure.ac updated: 1.70 -> 1.71

---
Log message:

Adjusted the default pathname to the SPEC95 benchmarks.  The new directory
has source code corrections and some input files pre-filtered for use
with the LLVM test suite.



---
Diffs of the changes:  (+3 -3)

Index: llvm/autoconf/configure.ac
diff -u llvm/autoconf/configure.ac:1.70 llvm/autoconf/configure.ac:1.71
--- llvm/autoconf/configure.ac:1.70	Fri Feb 13 15:57:03 2004
+++ llvm/autoconf/configure.ac	Mon Feb 16 08:55:18 2004
@@ -311,9 +311,9 @@
 AC_ARG_ENABLE(spec95,AC_HELP_STRING([--enable-spec95],[Compile SPEC 95 benchmarks (default is NO)]),,enableval=no)
 if test ${enableval} = "no"
 then
-	if test -d /home/vadve/shared/benchmarks/spec95_sparcv9/benchspec
+	if test -d /home/vadve/shared/benchmarks/spec95/benchspec
 	then
-		AC_SUBST(SPEC95_ROOT,[/home/vadve/shared/benchmarks/spec95_sparcv9/benchspec])
+		AC_SUBST(SPEC95_ROOT,[/home/vadve/shared/benchmarks/spec95/benchspec])
 		AC_SUBST(USE_SPEC95,[[USE_SPEC95=1]])
 	else
 		AC_SUBST(USE_SPEC95,[[]])
@@ -322,7 +322,7 @@
 else
 	if test ${enableval} = ""
 	then
-		AC_SUBST(SPEC95_ROOT,[/home/vadve/shared/benchmarks/spec95_sparcv9/benchspec])
+		AC_SUBST(SPEC95_ROOT,[/home/vadve/shared/benchmarks/spec95/benchspec])
 	else
 		AC_SUBST(SPEC95_ROOT,[${enableval}])
 	fi




From criswell at cs.uiuc.edu  Mon Feb 16 10:23:02 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 10:23:02 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile
Message-ID: <200402161622.KAA14827@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/External/SPEC/CINT95/134.perl:

Makefile added (r1.1)

---
Log message:

Initial checkin of 134.perl SPEC95 integer benchmark.



---
Diffs of the changes:  (+4 -0)

Index: llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile
diff -c /dev/null llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile:1.1
*** /dev/null	Mon Feb 16 10:22:30 2004
--- llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile	Mon Feb 16 10:22:19 2004
***************
*** 0 ****
--- 1,4 ----
+ LEVEL = ../../../../../..
+ CPPFLAGS += -DHAVE_STRERROR -DHAS_MKDIR -DHAS_RMDIR -DI_TIME
+ include ../../Makefile.spec95
+ 




From criswell at cs.uiuc.edu  Mon Feb 16 10:26:01 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 10:26:01 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile
Message-ID: <200402161625.KAA15044@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/External/SPEC/CINT95/134.perl:

Makefile updated: 1.1 -> 1.2

---
Log message:

Added inputs and run options for the primes test.



---
Diffs of the changes:  (+3 -0)

Index: llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile
diff -u llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile:1.1 llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile:1.2
--- llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile:1.1	Mon Feb 16 10:22:19 2004
+++ llvm/test/Programs/External/SPEC/CINT95/134.perl/Makefile	Mon Feb 16 10:25:17 2004
@@ -1,4 +1,7 @@
 LEVEL = ../../../../../..
+RUN_OPTIONS     := primes.pl
+STDIN_FILENAME  := primes.in
+STDOUT_FILENAME := primes.out
 CPPFLAGS += -DHAVE_STRERROR -DHAS_MKDIR -DHAS_RMDIR -DI_TIME
 include ../../Makefile.spec95
 




From criswell at cs.uiuc.edu  Mon Feb 16 10:27:01 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 10:27:01 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/External/SPEC/CINT95/Makefile
Message-ID: <200402161626.KAA15059@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/External/SPEC/CINT95:

Makefile updated: 1.3 -> 1.4

---
Log message:

Add 134.perl.



---
Diffs of the changes:  (+2 -5)

Index: llvm/test/Programs/External/SPEC/CINT95/Makefile
diff -u llvm/test/Programs/External/SPEC/CINT95/Makefile:1.3 llvm/test/Programs/External/SPEC/CINT95/Makefile:1.4
--- llvm/test/Programs/External/SPEC/CINT95/Makefile:1.3	Wed Feb 11 10:47:29 2004
+++ llvm/test/Programs/External/SPEC/CINT95/Makefile	Mon Feb 16 10:25:51 2004
@@ -1,16 +1,13 @@
 LEVEL = ../../../../..
 PARALLEL_DIRS := \
   099.go \
+  124.m88ksim \
   126.gcc \
   129.compress \
   130.li \
   132.ijpeg \
+  134.perl \
   147.vortex
-
-# These are not yet compiling/running right
-#  124.m88ksim \
-#  126.gcc \
-#  134.perl \
 
 # Get the $(ARCH) setting
 include $(LEVEL)/Makefile.config




From lattner at cs.uiuc.edu  Mon Feb 16 12:20:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 12:20:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86InstrInfo.td
Message-ID: <200402161819.MAA12704@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86InstrInfo.td updated: 1.23 -> 1.24

---
Log message:

Add some ADD instructions that take memory operands for Alkis


---
Diffs of the changes:  (+7 -0)

Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.23 llvm/lib/Target/X86/X86InstrInfo.td:1.24
--- llvm/lib/Target/X86/X86InstrInfo.td:1.23	Sat Feb 14 15:06:02 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Mon Feb 16 12:19:31 2004
@@ -272,6 +272,13 @@
 def ADDri16b : I2A8 <"add", 0x83, MRMS0r    >, OpSize;   // ADDri with sign extended 8 bit imm
 def ADDri32b : I2A8 <"add", 0x83, MRMS0r    >;
 
+def ADDmr8   : I2A8 <"add", 0x00, MRMDestMem>;         // [mem] += R8
+def ADDmr16  : I2A16<"add", 0x01, MRMDestMem>, OpSize; // [mem] += R16
+def ADDmr32  : I2A32<"add", 0x01, MRMDestMem>;         // [mem] += R32
+def ADDrm8   : I2A8 <"add", 0x02, MRMSrcMem >;         // R8  += [mem]
+def ADDrm16  : I2A16<"add", 0x03, MRMSrcMem >, OpSize; // R16 += [mem]
+def ADDrm32  : I2A32<"add", 0x03, MRMSrcMem >;         // R32 += [mem]
+
 def ADCrr32  : I2A32<"adc", 0x11, MRMDestReg>;                // R32 += imm32+Carry
 
 def SUBrr8   : I2A8 <"sub", 0x28, MRMDestReg>,         Pattern<(set R8 , (minus R8 , R8 ))>;




From lattner at cs.uiuc.edu  Mon Feb 16 12:38:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 12:38:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Analysis/DataStructure/Local.cpp
Message-ID: <200402161837.MAA14869@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Analysis/DataStructure:

Local.cpp updated: 1.82 -> 1.83

---
Log message:

memset and bcopy and now unified by the llvm.memset intrinsic


---
Diffs of the changes:  (+5 -14)

Index: llvm/lib/Analysis/DataStructure/Local.cpp
diff -u llvm/lib/Analysis/DataStructure/Local.cpp:1.82 llvm/lib/Analysis/DataStructure/Local.cpp:1.83
--- llvm/lib/Analysis/DataStructure/Local.cpp:1.82	Sat Feb 14 23:53:42 2004
+++ llvm/lib/Analysis/DataStructure/Local.cpp	Mon Feb 16 12:37:40 2004
@@ -468,6 +468,11 @@
           N->setModifiedMarker()->setReadMarker();
         return;
       }
+      case Intrinsic::memset:
+        // Mark the memory modified.
+        if (DSNode *N = getValueDest(**CS.arg_begin()).getNode())
+          N->setModifiedMarker();
+        return;
       default:
         if (F->getName() == "calloc") {
           setDestTo(*CS.getInstruction(),
@@ -478,20 +483,6 @@
           RetNH.mergeWith(getValueDest(**CS.arg_begin()));
           if (DSNode *N = RetNH.getNode())
             N->setHeapNodeMarker()->setModifiedMarker()->setReadMarker();
-          return;
-        } else if (F->getName() == "memset") {
-          // Merge the first argument with the return value, and mark the memory
-          // modified.
-          DSNodeHandle RetNH = getValueDest(*CS.getInstruction());
-          RetNH.mergeWith(getValueDest(**CS.arg_begin()));
-          if (DSNode *N = RetNH.getNode())
-            N->setModifiedMarker();
-          return;
-        } else if (F->getName() == "bzero") {
-          // Mark the memory modified.
-          DSNodeHandle H = getValueDest(**CS.arg_begin());
-          if (DSNode *N = H.getNode())
-            N->setModifiedMarker();
           return;
         } else if (F->getName() == "fopen" && CS.arg_end()-CS.arg_begin() == 2){
           // fopen reads the mode argument strings.




From brukman at cs.uiuc.edu  Mon Feb 16 13:46:01 2004
From: brukman at cs.uiuc.edu (Misha Brukman)
Date: Mon Feb 16 13:46:01 2004
Subject: [llvm-commits] CVS: llvm/docs/CommandGuide/llc.html
Message-ID: <200402161945.NAA29219@zion.cs.uiuc.edu>


Changes in directory llvm/docs/CommandGuide:

llc.html updated: 1.6 -> 1.7

---
Log message:

PreSelection isn't optional and so there's no way to turn it off.


---
Diffs of the changes:  (+0 -5)

Index: llvm/docs/CommandGuide/llc.html
diff -u llvm/docs/CommandGuide/llc.html:1.6 llvm/docs/CommandGuide/llc.html:1.7
--- llvm/docs/CommandGuide/llc.html:1.6	Tue Oct  7 15:12:04 2003
+++ llvm/docs/CommandGuide/llc.html	Mon Feb 16 13:45:26 2004
@@ -159,11 +159,6 @@
 	Disable peephole optimization pass.
 	<p>
 
-	<li>-disable-preopt
-	<br>
-	Disable optimizations prior to instruction selection.
-	<p>
-
 	<li>-disable-sched
 	<br>
 	Disable local scheduling pass.




From lattner at cs.uiuc.edu  Mon Feb 16 14:47:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 14:47:02 2004
Subject: [llvm-commits] CVS: llvm/lib/VMCore/ConstantFolding.cpp Constants.cpp
Message-ID: <200402162046.OAA00955@zion.cs.uiuc.edu>


Changes in directory llvm/lib/VMCore:

ConstantFolding.cpp updated: 1.51 -> 1.52
Constants.cpp updated: 1.79 -> 1.80

---
Log message:

Move the folding of gep null, 0, 0, 0 to a place where it can be shared and
enjoyed by all, fixing a fixme.  Add an assert


---
Diffs of the changes:  (+20 -14)

Index: llvm/lib/VMCore/ConstantFolding.cpp
diff -u llvm/lib/VMCore/ConstantFolding.cpp:1.51 llvm/lib/VMCore/ConstantFolding.cpp:1.52
--- llvm/lib/VMCore/ConstantFolding.cpp:1.51	Sat Jan 31 19:23:19 2004
+++ llvm/lib/VMCore/ConstantFolding.cpp	Mon Feb 16 14:46:13 2004
@@ -927,8 +927,21 @@
       (IdxList.size() == 1 && IdxList[0]->isNullValue()))
     return const_cast<Constant*>(C);
 
-  // TODO If C is null and all idx's are null, return null of the right type.
-
+  if (C->isNullValue()) {
+    bool isNull = true;
+    for (unsigned i = 0, e = IdxList.size(); i != e; ++i)
+      if (!IdxList[i]->isNullValue()) {
+        isNull = false;
+        break;
+      }
+    if (isNull) {
+      std::vector<Value*> VIdxList(IdxList.begin(), IdxList.end());
+      const Type *Ty = GetElementPtrInst::getIndexedType(C->getType(), VIdxList,
+                                                         true);
+      assert(Ty != 0 && "Invalid indices for GEP!");
+      return ConstantPointerNull::get(PointerType::get(Ty));
+    }
+  }
 
   if (ConstantExpr *CE = dyn_cast<ConstantExpr>(const_cast<Constant*>(C))) {
     // Combine Indices - If the source pointer to this getelementptr instruction


Index: llvm/lib/VMCore/Constants.cpp
diff -u llvm/lib/VMCore/Constants.cpp:1.79 llvm/lib/VMCore/Constants.cpp:1.80
--- llvm/lib/VMCore/Constants.cpp:1.79	Sat Feb 14 23:53:04 2004
+++ llvm/lib/VMCore/Constants.cpp	Mon Feb 16 14:46:13 2004
@@ -1081,11 +1081,15 @@
 
 Constant *ConstantExpr::getGetElementPtrTy(const Type *ReqTy, Constant *C,
                                         const std::vector<Constant*> &IdxList) {
+  assert(GetElementPtrInst::getIndexedType(C->getType(),
+                   std::vector<Value*>(IdxList.begin(), IdxList.end()), true) &&
+         "GEP indices invalid!");
+
   if (Constant *FC = ConstantFoldGetElementPtr(C, IdxList))
     return FC;          // Fold a few common cases...
+
   assert(isa<PointerType>(C->getType()) &&
          "Non-pointer type for constant GetElementPtr expression");
-
   // Look up the constant in the table first to ensure uniqueness
   std::vector<Constant*> argVec(1, C);
   argVec.insert(argVec.end(), IdxList.begin(), IdxList.end());
@@ -1101,17 +1105,6 @@
   const Type *Ty = GetElementPtrInst::getIndexedType(C->getType(), VIdxList,
                                                      true);
   assert(Ty && "GEP indices invalid!");
-
-  if (C->isNullValue()) {
-    bool isNull = true;
-    for (unsigned i = 0, e = IdxList.size(); i != e; ++i)
-      if (!IdxList[i]->isNullValue()) {
-        isNull = false;
-        break;
-      }
-    if (isNull) return ConstantPointerNull::get(PointerType::get(Ty));
-  }
-
   return getGetElementPtrTy(PointerType::get(Ty), C, IdxList);
 }
 




From 37ufqb at email.com  Mon Feb 16 16:32:04 2004
From: 37ufqb at email.com (Alyson Begay)
Date: Mon Feb 16 16:32:04 2004
Subject: [llvm-commits] fast weight |oss
Message-ID: <ko73dw5-9799$i0-08igd@ni3jr>

An HTML attachment was scrubbed...
URL: http://lists.cs.uiuc.edu/pipermail/llvm-commits/attachments/20040216/2f769102/attachment.html 

From 604ttcp at altavista.com  Mon Feb 16 16:32:06 2004
From: 604ttcp at altavista.com (Myles Brooks)
Date: Mon Feb 16 16:32:06 2004
Subject: [llvm-commits] guaranteed weight loss
Message-ID: <7zj47rua-t9-$08@61gidc.3d>

An HTML attachment was scrubbed...
URL: http://lists.cs.uiuc.edu/pipermail/llvm-commits/attachments/20040216/98ab3240/attachment.html 

From lattner at cs.uiuc.edu  Mon Feb 16 16:58:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 16:58:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Analysis/DataStructure/Local.cpp
Message-ID: <200402162257.QAA06433@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Analysis/DataStructure:

Local.cpp updated: 1.83 -> 1.84

---
Log message:

Only spit out warning for functions that take pointers, not for sin and the like
Add more special case handling for stdio functions.  I feel dirty, how about you?


---
Diffs of the changes:  (+25 -5)

Index: llvm/lib/Analysis/DataStructure/Local.cpp
diff -u llvm/lib/Analysis/DataStructure/Local.cpp:1.83 llvm/lib/Analysis/DataStructure/Local.cpp:1.84
--- llvm/lib/Analysis/DataStructure/Local.cpp:1.83	Mon Feb 16 12:37:40 2004
+++ llvm/lib/Analysis/DataStructure/Local.cpp	Mon Feb 16 16:57:19 2004
@@ -484,6 +484,12 @@
           if (DSNode *N = RetNH.getNode())
             N->setHeapNodeMarker()->setModifiedMarker()->setReadMarker();
           return;
+        } else if (F->getName() == "atoi") {
+          // atoi reads its argument.
+          if (DSNode *N = getValueDest(**CS.arg_begin()).getNode())
+            N->setReadMarker();
+          return;
+
         } else if (F->getName() == "fopen" && CS.arg_end()-CS.arg_begin() == 2){
           // fopen reads the mode argument strings.
           CallSite::arg_iterator AI = CS.arg_begin();
@@ -511,8 +517,11 @@
           if (const PointerType *PTy = dyn_cast<PointerType>(ArgTy))
             H.getNode()->mergeTypeInfo(PTy->getElementType(), H.getOffset());
           return;
-        } else if (F->getName() == "fflush" && CS.arg_end()-CS.arg_begin() ==1){
-          // fclose reads and writes the memory for the file descriptor.  It
+        } else if (CS.arg_end()-CS.arg_begin() == 1 && 
+                   (F->getName() == "fflush" || F->getName() == "feof" ||
+                    F->getName() == "fileno" || F->getName() == "clearerr" ||
+                    F->getName() == "rewind" || F->getName() == "ftell")) {
+          // fflush reads and writes the memory for the file descriptor.  It
           // merges the FILE type into the descriptor.
           DSNodeHandle H = getValueDest(**CS.arg_begin());
           H.getNode()->setReadMarker()->setModifiedMarker();
@@ -522,7 +531,7 @@
             H.getNode()->mergeTypeInfo(PTy->getElementType(), H.getOffset());
           return;
         } else if (F->getName() == "fgets" && CS.arg_end()-CS.arg_begin() == 3){
-          // fclose reads and writes the memory for the file descriptor.  It
+          // fgets reads and writes the memory for the file descriptor.  It
           // merges the FILE type into the descriptor, and writes to the
           // argument.  It returns the argument as well.
           CallSite::arg_iterator AI = CS.arg_begin();
@@ -565,8 +574,19 @@
         } else if (F->getName() == "exit") {
           // Nothing to do!
         } else {
-          std::cerr << "WARNING: Call to unknown external function '"
-                    << F->getName() << "' will cause pessimistic results!\n";
+          // Unknown function, warn if it returns a pointer type or takes a
+          // pointer argument.
+          bool Warn = isPointerType(CS.getInstruction()->getType());
+          if (!Warn)
+            for (CallSite::arg_iterator I = CS.arg_begin(), E = CS.arg_end();
+                 I != E; ++I)
+              if (isPointerType((*I)->getType())) {
+                Warn = true;
+                break;
+              }
+          if (Warn)
+            std::cerr << "WARNING: Call to unknown external function '"
+                      << F->getName() << "' will cause pessimistic results!\n";
         }
       }
 




From criswell at cs.uiuc.edu  Mon Feb 16 17:33:02 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:33:02 2004
Subject: [llvm-commits] CVS: llvm/LICENSE.TXT
Message-ID: <200402162332.RAA30432@choi.cs.uiuc.edu>


Changes in directory llvm:

LICENSE.TXT updated: 1.5 -> 1.6

---
Log message:

Preemptive additions for the MallocBench tests.



---
Diffs of the changes:  (+4 -0)

Index: llvm/LICENSE.TXT
diff -u llvm/LICENSE.TXT:1.5 llvm/LICENSE.TXT:1.6
--- llvm/LICENSE.TXT:1.5	Fri Feb 13 10:46:05 2004
+++ llvm/LICENSE.TXT	Mon Feb 16 17:32:26 2004
@@ -77,6 +77,10 @@
 Ptrdist:            llvm/test/Programs/MultiSource/Benchmarks/Ptrdist
 LLUBenchmark:       llvm/test/Programs/MultiSource/Benchmarks/llubenchmark
 SIM:                llvm/test/Programs/MultiSource/Benchmarks/sim
+ps:                 llvm/test/Programs/MultiSource/Benchmarks/MallocBench/ps
+p2c:                llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c
+gawk:               llvm/test/Programs/MultiSource/Benchmarks/MallocBench/gawk
+make:               llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make
 Dhrystone:          llvm/test/Programs/SingleSource/Benchmarks/Dhrystone
 SingleSource Tests: llvm/test/Programs/SingleSource/Benchmarks/Misc
                     llvm/test/Programs/SingleSource/CustomChecked




From criswell at cs.uiuc.edu  Mon Feb 16 17:43:02 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:43:02 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/
Message-ID: <200402162342.RAA30867@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Mon Feb 16 17:43:04 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:43:04 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/
Message-ID: <200402162342.RAA30886@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Mon Feb 16 17:44:00 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:44:00 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/
Message-ID: <200402162343.RAA30918@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Mon Feb 16 17:44:05 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:44:05 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README grading.p mf.p ptc.p
Message-ID: <200402162343.RAA30996@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT:

README added (r1.1)
grading.p added (r1.1)
mf.p added (r1.1)
ptc.p added (r1.1)

---
Log message:

Initial commit of the p2c benchmark (part of the Malloc Benchmark).



---
Diffs of the changes:  (+29755 -0)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README	Mon Feb 16 17:43:31 2004
***************
*** 0 ****
--- 1,8 ----
+ 
+ Test Inputs to p2c program:
+ 
+ p2c -v < INPUT/grading.p
+ p2c -v < INPUT/ptc.p 
+ p2c -v < INPUT/mf.p
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p	Mon Feb 16 17:43:31 2004
***************
*** 0 ****
--- 1,514 ----
+ program grading (input, output);
+ 
+ const
+         namelength = 34;
+           idlength = 12;
+      commentlength =  6;
+     headlinelength = 40;
+ 
+ type
+ 
+     scores =
+         (
+          assign1, assign2, assign3, assign4,
+          assign5, assign6, assign7, assign8, assigns,
+          exam1, exam2, better, final, total
+         );
+ 
+     gradetype =
+         (
+                A, Aminus,
+         Bplus, B, Bminus,
+         Cplus, C, Cminus,
+         Dplus, D, Dminus,
+                F
+         );
+ 
+     grades =
+         (
+          absolu, curved, course
+         );
+ 
+         namestring = packed array [1..    namelength] of char;
+           idstring = packed array [1..      idlength] of char;
+      commentstring = packed array [1.. commentlength] of char;
+     headlinestring = packed array [1..headlinelength] of char;
+ 
+     studentpointer = ^ studentrecord;
+     studentrecord =
+         record
+                    name : namestring;
+                      id : idstring;
+                   score : array [scores] of integer;
+                   grade : array [grades] of gradetype;
+                    rank : integer;
+              percentile : integer;
+                 comment : commentstring;
+                    next : studentpointer;
+              nextinrank : studentpointer
+         end;
+ 
+ var
+     studentlist : studentpointer;
+     nonames : boolean;
+     nstudents, noshows, nofinals : integer;
+ 
+     scoresfile : text;
+ 
+     histogram : array [0..100] of integer;
+     histogramlist : array [0..100] of studentpointer;
+ 
+     scoretorank : array [0..100] of integer; (* scoretorank [76] = rank of student(s)
+                                                 with total score of 76 *)
+     percent : array [0..100] of integer; (* percent [76] = percentile of student(s)
+                                             with total score of 76 *)
+ 
+ function isnoshow (student : studentrecord) : boolean;
+     begin
+         isnoshow := (student.score [total] = 0)
+     end (* isnoshow *);
+ 
+ procedure computescoretorank;
+     var
+         score, nhigher : integer;
+     begin
+         nhigher := 0;
+         for score := 100 downto 0 do begin
+             scoretorank [score] := 1 + nhigher;
+             if
+                 (nstudents - noshows - nofinals) > 0
+             then
+                 percent [score] :=
+                     ((nstudents - noshows - nofinals - nhigher) * 100)
+                     div
+                     (nstudents - noshows - nofinals)
+             else
+                percent [score] := 0;
+             nhigher := nhigher + histogram [score];
+         end
+     end (* computescoretorank *);
+ 
+ procedure settitle (headline : headlinestring);
+     begin
+         writeln ('.bp');
+         writeln ('.ds Ti ', headline)
+     end (* settitle *);
+ 
+ procedure writetroffheader;
+     begin
+         writeln ('.po 1.2c');
+         writeln ('.m3 0');
+         writeln ('.m4 10');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('.pl 10.0i');
+         writeln ('.ll 7.3i');
+         writeln ('.lt 7.3i');
+         writeln ('\ ');
+         writeln ('.bp');
+         writeln ('.de $f');
+         writeln ('.ev 1');
+         writeln ('.nf');
+         writeln ('.ti 4.85c');
+         writeln ('\fC\ Gr\ \ \ \ \ Id\ \ \ \ \ \ \ \ A1\ A2\ A3\ A4\ A5\ A6\ A7\ A8\ A\ \ E1\ E2\ E\ \ Fi\ To\ Ab\ Cu\ Gr\ Rank\ Percentile\ Coll');
+         writeln ('.sp 2');
+         writeln ('.in 1.0i');
+         writeln ('\fC\s+2A  = \fRsum of all assignments');
+         writeln ('\fCE1 = \fRfirst exam');
+         writeln ('\fCE2 = \fRsecond exam');
+         writeln ('\fCE  = \fR better of first two exams');
+         writeln ('\fCFi = \fRfinal exam');
+         writeln ('.sp -5');
+         writeln ('.in +2.3i');
+         writeln ('\fCTo = \fRtotal score in course');
+         writeln ('\fCAb = \fRgrade according to first (absolute, i.e. not curved) policy');
+         writeln ('\fCCu = \fRgrade according to second (curved) policy');
+         writeln ('\fCGr = \fRcourse grade');
+         writeln ('Percentiles are computed ignoring ''No shows'' and ''No finals''.\s-2');
+         writeln ('.sp 2');
+         writeln ('.in 0');
+         writeln ('.tl ^\s+8\fB\\*(Ti^^\*(td\s-8\fP^^');
+         writeln ('.ev');
+         writeln ('..');
+         writeln ('.de $h');
+         writeln ('.ev 1');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('\ ');
+         writeln ('.sp |2.5c');
+         writeln ('.ti 4.85c');
+         writeln ('\fC\ Gr\ \ \ \ \ Id\ \ \ \ \ \ \ \ A1\ A2\ A3\ A4\ A5\ A6\ A7\ A8\ A\ \ E1\ E2\ E\ \ Fi\ To\ Ab\ Cu\ Gr\ Rank\ Percentile\ Coll');
+         writeln ('.sp 2');
+         writeln ('.ev');
+         writeln ('..');
+         writeln ('\ ');
+         writeln ('.bp');
+         writeln ('\fC');
+         writeln ('.nf');
+         writeln ('.ev 1');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('.ev');
+     end (* writetroffheader *);
+ 
+ procedure initialize;
+     var
+         score : integer;
+     begin
+         nstudents := 0;
+         noshows := 0;
+         nofinals := 0;
+         studentlist := nil;
+ 
+         for score := 0 to 100 do begin
+             histogram [score] := 0;
+             histogramlist [score] := nil
+         end;
+ 
+         writetroffheader
+     end (* initialize *);
+ 
+ procedure readscores;
+     var
+         newstudent : studentpointer;
+         s : scores;
+         c : integer;
+     begin
+         new (newstudent);
+         nstudents := nstudents + 1;
+ 
+         with newstudent^ do begin
+             next := studentlist;
+ 
+             for c := 1 to namelength do
+                 read (input, name [c]);
+ 
+             for c := 1 to idlength do
+                 read (input, id   [c]);
+ 
+             for s := assign1 to assign8 do
+                 read (input, score [s]);
+ 
+             read (input, score [exam1]);
+             read (input, score [exam2]);
+             read (input, score [final]);
+             
+             for c := 1 to commentlength do
+                 read (input, comment [c])
+         end;
+ 
+         readln (input);
+         studentlist := newstudent
+     end (* readscores *);
+ 
+ procedure computescores (student : studentpointer);
+     var
+         s : scores;
+     begin
+         with student^ do begin
+             score [assigns] := 0;
+             for s := assign1 to assign8 do
+                 score [assigns] := score [assigns] + score [s];
+ 
+             if
+                 score [exam1] > score [exam2]
+             then
+                 score [better] := score [exam1]
+             else
+                 score [better] := score [exam2];
+ 
+             score [total] :=    score [assigns]
+                               + score [better ]
+                               + score [final  ];
+ 
+             if
+                 isnoshow (student^)
+             then
+                 noshows := noshows + 1
+             else if
+                 score [final] = 0
+             then
+                 nofinals := nofinals + 1
+             else
+                 histogram [score [total]] := histogram [score [total]] + 1;
+       
+         end
+     end (* computescores *);
+ 
+ procedure computeallscores (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             computescores (studentlist);
+             computeallscores (studentlist^.next)
+         end
+     end (* computeallscores *);
+     
+ procedure computegrades (student : studentpointer);
+     
+     begin
+         with student^ do begin
+             if score [total] >= 90 then grade [absolu] := A      else
+             if score [total] >= 88 then grade [absolu] := Aminus else
+             if score [total] >= 86 then grade [absolu] := Bplus  else
+             if score [total] >= 80 then grade [absolu] := B      else
+             if score [total] >= 78 then grade [absolu] := Bminus else
+             if score [total] >= 76 then grade [absolu] := Cplus  else
+             if score [total] >= 70 then grade [absolu] := C      else
+             if score [total] >= 65 then grade [absolu] := Cminus else
+             if score [total] >= 60 then grade [absolu] := Dplus  else
+             if score [total] >= 55 then grade [absolu] := D      else
+             if score [total] >= 50 then grade [absolu] := Dminus else
+                                         grade [absolu] := F
+             ;
+ 
+                   rank := scoretorank   [score [total]];
+             nextinrank := histogramlist [score [total]];
+                           histogramlist [score [total]] := student;
+             percentile := percent       [score [total]];
+ 
+             if percentile >= 80 then grade [curved] := A      else
+             if percentile >= 78 then grade [curved] := Aminus else
+             if percentile >= 76 then grade [curved] := Bplus  else
+             if percentile >= 50 then grade [curved] := B      else
+             if percentile >= 48 then grade [curved] := Bminus else
+             if percentile >= 46 then grade [curved] := Cplus  else
+             if percentile >= 25 then grade [curved] := C      else
+             if percentile >= 23 then grade [curved] := Cminus else
+             if percentile >= 21 then grade [curved] := Dplus  else
+             if percentile >= 10 then grade [curved] := D      else
+             if percentile >=  8 then grade [curved] := Dminus else
+                                      grade [curved] := F
+             ;
+ 
+            if
+                grade [absolu] < grade [curved]
+            then
+                grade [course] := grade [absolu]
+            else
+                grade [course] := grade [curved]
+ 
+         end
+     end (* computegrades *);
+ 
+ procedure computeallgrades (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             computegrades (studentlist);
+             computeallgrades (studentlist^.next)
+         end
+     end (* computeallgrades *);
+ 
+ function gradepoint (g : gradetype) : real;
+     begin
+         if g = A      then gradepoint := 4.0 else
+         if g = Aminus then gradepoint := 3.7 else
+         if g = Bplus  then gradepoint := 3.3 else
+         if g = B      then gradepoint := 3.0 else
+         if g = Bminus then gradepoint := 2.7 else
+         if g = Cplus  then gradepoint := 2.3 else
+         if g = C      then gradepoint := 2.0 else
+         if g = Cminus then gradepoint := 1.7 else
+         if g = Dplus  then gradepoint := 1.3 else
+         if g = D      then gradepoint := 1.0 else
+         if g = Dminus then gradepoint := 0.7 else
+         if g = F      then gradepoint := 0.0 else
+                            gradepoint := 0.0
+     end (* gradepoint *);
+ 
+ procedure writegrade (g : gradetype);
+     begin
+         if g = A      then write (' A ') else
+         if g = Aminus then write (' A-') else
+         if g = Bplus  then write (' B+') else
+         if g = B      then write (' B ') else
+         if g = Bminus then write (' B-') else
+         if g = Cplus  then write (' C+') else
+         if g = C      then write (' C ') else
+         if g = Cminus then write (' C-') else
+         if g = Dplus  then write (' D+') else
+         if g = D      then write (' D ') else
+         if g = Dminus then write (' D-') else
+         if g = F      then write (' F ') else
+                            write (' ??')
+     end (* writegrade *);
+ 
+ procedure readallscores;
+     begin
+         while
+             not eof (input)
+         do
+             readscores
+     end (* readallscores *);
+ 
+ procedure writestudent (student : studentpointer);
+     var
+         c : integer;
+         s : scores;
+         g : grades;
+     begin
+     end (* writestudent *);
+ 
+ procedure writestraight (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             writestraight (studentlist^.next);
+             writestudent (studentlist);
+         end
+     end (* writestraight *);
+ 
+ procedure gotoXY (x, y : integer);
+     begin
+         writeln ('\ ');
+         writeln ('.sp |', 1500 - 40 * y : 0, 'u');
+         writeln ('.ti  ',        40 * x : 0, 'u');
+     end (* gotoXY *);
+ 
+ procedure writehistogram;
+     var
+         score, height : integer;
+     begin
+         for score := 0 to 100 do
+             for height := 1 to histogram [score] do begin
+                 gotoXY (score, height);
+                 writeln ('X')
+             end;
+ 
+         score := 0;
+         repeat
+             gotoXY (score, - 1);
+             writeln ('\v''0.5c''|');
+             gotoXY (score, - 3);
+             writeln (score : 0);
+             score := score + 5
+         until
+             score > 100;
+ 
+         gotoXY (0,- 10)
+     end (* writehistogram *);
+ 
+ procedure writerank (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             writerank (studentlist^.nextinrank);
+             writestudent (studentlist)
+         end
+     end (* writerank *);
+ 
+ procedure writebyrank;
+     var
+         score : integer;
+     begin
+         for score := 100 downto 0 do
+             writerank (histogramlist [score])
+     end (* writebyrank *);
+ 
+ procedure stats;
+     var
+         scoresum : array [scores] of real;
+         gradecount : array [grades, gradetype] of integer;
+         s   : scores;
+         g   : grades;
+         gt  : gradetype;
+         currentstudent : studentpointer;
+     begin
+         writeln ('.in 0');
+         writeln ('.hl');
+         writeln ('\fC');
+         writeln ('.2c');
+         write   ('Number of students: ');
+         writeln (nstudents : 5);
+         write   ('          No-shows: ');
+         writeln (noshows   : 5);
+         write   ('         No finals: ');
+         writeln (nofinals  : 5);
+         write   ('      Assignment 1: ');
+         writeln (scoresum [assign1] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 2: ');
+         writeln (scoresum [assign2] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 3: ');
+         writeln (scoresum [assign3] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 4: ');
+         writeln (scoresum [assign4] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 5: ');
+         writeln (scoresum [assign5] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 6: ');
+         writeln (scoresum [assign6] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 7: ');
+         writeln (scoresum [assign7] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 8: ');
+         writeln (scoresum [assign8] / (nstudents - noshows) : 5 : 1);
+         write   ('   All assignments: ');
+         writeln (scoresum [assigns] / (nstudents - noshows) : 5 : 1);
+         write   ('            Exam 1: ');
+         writeln (scoresum [exam1  ] / (nstudents - noshows) : 5 : 1);
+         write   ('            Exam 2: ');
+         writeln (scoresum [exam2  ] / (nstudents - noshows) : 5 : 1);
+         write   ('     Better of 1,2: ');
+         writeln (scoresum [better ] / (nstudents - noshows) : 5 : 1);
+         write   ('        Final exam: ');
+         writeln (scoresum [final  ] / (nstudents - noshows) : 5 : 1);
+         write   ('       Total score: ');
+         writeln (scoresum [total  ] / (nstudents - noshows) : 5 : 1);
+         
+         writeln ('.sp 2');
+         writeln ('Absolute grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [absolu, gt])
+         end;
+         writeln ('.bc');
+ 
+         writeln ('Curved grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [curved, gt])
+         end;
+         writeln ('.sp 2');
+ 
+         writeln ('Course grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [course, gt])
+         end;
+ 
+     end (* stats *);
+ 
+ begin
+     initialize;
+     readallscores;
+     computeallscores (studentlist);
+     computescoretorank;
+     computeallgrades (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989');
+     nonames := false;
+     writestraight (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989');
+     nonames := true;
+     writestraight (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989, grades by rank');
+     nonames := false;
+     writebyrank;
+ 
+     settitle ('CSCI 1200, Spring 1989, grade statistics');
+     writeln ('.de $f');
+     writeln ('.tl ^\v''1.0i''\s+8\fB\\*(Ti^^\*(td\s-8\fP\v''-1.0i''^^');
+     writeln ('..');
+     writeln ('.de $h');
+     writeln ('..');
+     writeln ('\ ');
+     writeln ('.bp');
+     writeln ('Histogram, without ''No-shows'' and ''No finals''');
+     writehistogram;
+     stats;
+ end.


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p:1.1
*** /dev/null	Mon Feb 16 17:43:42 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p	Mon Feb 16 17:43:31 2004
***************
*** 0 ****
--- 1,19497 ----
+ program MF(input, output); {6:}
+ 
+ {------------------------------}
+ { declarations are in mf2ps1.h }
+ {------------------------------}
+ label
+     1, 9998, 9999;
+ {:6} {11:}
+ const
+     memmax = 30000;
+     maxinternal = 100;
+     bufsize = 500;
+     errorline = 79;
+     halferrorline = 50;
+     maxprintline = 79;
+     screenwidth = 1024;
+     screendepth = 1024;
+     stacksize = 30;
+     maxstrings = 2000;
+     stringvacancies = 8000;
+     poolsize = 32000;
+     movesize = 5000;
+     maxwiggle = 300;
+     gfbufsize = 800;
+     filenamesize = 256;
+     poolname = 'mf.pool';
+     pathsize = 300;
+     bistacksize = 785;
+     headersize = 100;
+     ligtablesize = 300;
+     maxfontdimen = 50; {:11} {18:}
+ type
+     ASCIIcode = 0..127; {:18}
+ {24:}
+     eightbits = 0..255;
+     alphafile = text;
+     {------------------}
+     postscript = text;
+     {------------------}
+     UNIXfilename = packed array [1..filenamesize] of char;
+     bytefile = 
+ 	record 
+ 	    stdioptr: ^ integer;
+ 	    locptr: ^ integer;
+ 	    filename: UNIXfilename
+ 	end; {:24} {37:}
+     poolpointer = 0..poolsize;
+     strnumber = 0..maxstrings; {:37}
+ {101:}
+     scaled = integer;
+     smallnumber = 0..63; {:101} {105:}
+     fraction = integer;
+ {:105}
+     {106:}
+     angle = integer; {:106} {156:}
+     quarterword = -128..127;
+     halfword = -32768..32767;
+     twochoices = 1..2;
+     threechoices = 1..3;
+     twohalves = packed 
+ 	record 
+ 	    rh: halfword;
+ 	    case twochoices of
+ 		1: (
+ 		    lh: halfword
+ 		);
+ 		2: (
+ 		    b0: quarterword;
+ 		    b1: quarterword
+ 		)
+ 	end;
+     fourquarters = packed 
+ 	record 
+ 	    b0: quarterword;
+ 	    b1: quarterword;
+ 	    b2: quarterword;
+ 	    b3: quarterword
+ 	end;
+     memoryword = 
+ 	record 
+ 	    case threechoices of
+ 		1: (
+ 		    int: integer
+ 		);
+ 		2: (
+ 		    hh: twohalves
+ 		);
+ 		3: (
+ 		    qqqq: fourquarters
+ 		)
+ 	end;
+     wordfile = file of memoryword; {:156} {186:}
+     commandcode = 1..82; {:186} {565:}
+     screenrow = 0..screendepth;
+     screencol = 0..screenwidth;
+     transspec = array [screencol] of screencol;
+     pixelcolor = 0..1; {:565} {571:}
+     windownumber = 0..15; {:571} {627:}
+     instaterecord = 
+ 	record 
+ 	    indexfield: quarterword;
+ 	    startfield, locfield, limitfield, namefield: halfword
+ 	end; {:627} {1151:}
+     gfindex = 0..gfbufsize;
+     gfbuftype = array [gfindex] of eightbits; {:1151} {13:}
+ var
+     bad: integer; {:13} {20:}
+     xord: array [char] of ASCIIcode;
+     xchr: array [ASCIIcode] of char; {:20} {25:}
+     nameoffile, realnameoffile: UNIXfilename;
+     namelength: 0..filenamesize; {:25}
+ {29:}
+     buffer: array [0..bufsize] of ASCIIcode;
+     first: 0..bufsize;
+     last: 0..bufsize;
+     maxbufstack: 0..bufsize; {:29} {38:}
+     strpool: packed array [poolpointer] of ASCIIcode;
+     strstart: array [strnumber] of poolpointer;
+     poolptr: poolpointer;
+     strptr: strnumber;
+     initpoolptr: poolpointer;
+     initstrptr: strnumber;
+     maxpoolptr: poolpointer;
+     maxstrptr: strnumber; {:38} {42:}
+     strref: array [strnumber] of 0..127; {:42} {50:}
+     poolfile: alphafile; {:50} {54:}
+     logfile: alphafile;
+     {-------------------------------------------------------------}
+      psfile          :postscript; { the PostScript code           }
+      g               :postscript; { holds the character information after re-arrange}
+      lastx0 , lasty0 :real   ;    { last point in sunpath         }
+      lastx3 , lasty3 :real   ;    { make optimization on commands } 
+      prevtox3 , prevtoy3 :real;
+      lastyearval ,                { mark entering to macros       } 
+      lastmonthval    :integer;    { STROKE , FILL , and ERASE     }
+                                   { in MY plain.mf                }   
+      my_xx , my_yy   :integer;    { hold the values of xx & yy    }
+      LineSource     : integer;    { Identifier for sendline source  }
+      CurveSource    : integer;    { Identifier for makemoves source }
+      foundnew       : boolean;    { true while xchr[s]='[' until ']' } 
+      ascval         : integer;    { holds the ascii of curr. letter }
+      ascii_on       : boolean;    { reading ascval is 'on'        }
+     {-------------------------------------------------------------}
+     selector: 0..5;
+     dig: array [0..22] of 0..15;
+     tally: integer;
+     termoffset: 0..maxprintline;
+     fileoffset: 0..maxprintline;
+     trickbuf: array [0..errorline] of ASCIIcode;
+     trickcount: integer;
+     firstcount: integer; {:54} {68:}
+     interaction: 0..3; {:68} {71:}
+     deletionsallowed: boolean;
+     history: 0..3;
+     errorcount: -1..100; {:71} {74:}
+     helpline: array [0..5] of strnumber;
+     helpptr: 0..6;
+     useerrhelp: boolean;
+     errhelp: strnumber; {:74} {91:}
+     interrupt: integer;
+     OKtointerrupt: boolean;
+ {:91}
+     {97:}
+     aritherror: boolean; {:97} {129:}
+     twotothe: array [0..30] of integer;
+     speclog: array [1..28] of integer; {:129} {137:}
+     specatan: array [1..26] of angle; {:137} {144:}
+     nsin, ncos: fraction; {:144}
+ {148:}
+     randoms: array [0..54] of fraction;
+     jrandom: 0..54; {:148} {158:}
+     tempptr: halfword; {:158} {159:}
+     mem: array [-30000..memmax] of memoryword;
+     lomemmax: halfword;
+     himemmin: halfword; {:159} {160:}
+     varused, dynused: integer;
+ {:160}
+     {161:}
+     avail: halfword;
+     memend: halfword; {:161} {166:}
+     rover: halfword;
+ {:166}
+     {178:}
+     freearr: packed array [-30000..memmax] of boolean;
+     wasfree: packed array [-30000..memmax] of boolean;
+     wasmemend, waslomax, washimin: halfword;
+     panicking: boolean; {:178} {190:}
+     internal: array [1..maxinternal] of scaled;
+     intname: array [1..maxinternal] of strnumber;
+     intptr: 40..maxinternal; {:190}
+ {196:}
+     oldsetting: 0..5; {:196} {198:}
+     charclass: array [ASCIIcode] of 0..20;
+ {:198}
+     {200:}
+     hashused: halfword;
+     stcount: integer; {:200} {201:}
+     hash: array [1..2241] of twohalves;
+     eqtb: array [1..2241] of twohalves; {:201}
+ {225:}
+     gpointer: halfword; {:225} {230:}
+     bignodesize: array [13..14] of smallnumber; {:230} {250:}
+     saveptr: halfword;
+ {:250}
+     {267:}
+     pathtail: halfword; {:267} {279:}
+     deltax, deltay, delta: array [0..pathsize] of scaled;
+     psi: array [1..pathsize] of angle; {:279} {283:}
+     theta: array [0..pathsize] of angle;
+     uu: array [0..pathsize] of fraction;
+     vv: array [0..pathsize] of angle;
+     ww: array [0..pathsize] of fraction; {:283}
+ {298:}
+     st, ct, sf, cf: fraction; {:298} {308:}
+     move: array [0..movesize] of integer;
+     moveptr: 0..movesize; {:308} {309:}
+     bisectstack: array [0..bistacksize] of integer;
+     bisectptr: 0..bistacksize;
+ {:309}
+     {327:}
+     curedges: halfword;
+     curwt: integer; {:327} {371:}
+     tracex: integer;
+     tracey: integer;
+     traceyy: integer; {:371} {379:}
+     octant: 1..8; {:379} {389:}
+     curx, cury: scaled; {:389} {395:}
+     octantdir: array [1..8] of strnumber; {:395}
+ {403:}
+     curspec: halfword;
+     turningnumber: integer;
+     curpen: halfword;
+     curpathtype: 0..2;
+     maxallowed: scaled; {:403} {427:}
+     before, after: array [0..maxwiggle] of scaled;
+     nodetoround: array [0..maxwiggle] of halfword;
+     curroundingptr: 0..maxwiggle;
+     maxroundingptr: 0..maxwiggle; {:427} {430:}
+     curgran: scaled; {:430} {448:}
+     octantnumber: array [1..8] of 1..8;
+     octantcode: array [1..8] of 1..8; {:448}
+ {455:}
+     revturns: boolean; {:455} {461:}
+     ycorr, xycorr, zcorr: array [1..8] of 0..1;
+     xcorr: array [1..8] of -1..1; {:461}
+ {464:}
+     m0, n0, m1, n1: integer;
+     d0, d1: 0..1; {:464} {507:}
+     envmove: array [0..movesize] of integer; {:507} {552:}
+     tolstep: 0..6; {:552}
+ {555:}
+     curt, curtt: integer;
+     timetogo: integer;
+     maxt: integer; {:555} {557:}
+     delx, dely: integer;
+     tol: integer;
+     uv, xy: 0..bistacksize;
+     threel: integer;
+     apprt, apprtt: integer; {:557} {566:}
+ {screenpixel:array[screenrow,screencol]of pixelcolor;}
+     {:566}
+     {569:}
+     screenstarted: boolean;
+     screenOK: boolean; {:569} {572:}
+     windowopen: array [windownumber] of boolean;
+     leftcol: array [windownumber] of screencol;
+     rightcol: array [windownumber] of screencol;
+     toprow: array [windownumber] of screenrow;
+     botrow: array [windownumber] of screenrow;
+     mwindow: array [windownumber] of integer;
+     nwindow: array [windownumber] of integer;
+     windowtime: array [windownumber] of integer; {:572} {579:}
+     rowtransition: transspec; {:579} {585:}
+     serialno: integer; {:585} {592:}
+     fixneeded: boolean;
+     watchcoefs: boolean;
+     depfinal: halfword; {:592} {624:}
+     curcmd: eightbits;
+     curmod: integer;
+     cursym: halfword; {:624} {628:}
+     inputstack: array [0..stacksize] of instaterecord;
+     inputptr: 0..stacksize;
+     maxinstack: 0..stacksize;
+     curinput: instaterecord; {:628} {631:}
+     inopen: 0..6;
+     inputfile: array [1..6] of alphafile;
+     line: integer;
+     linestack: array [1..6] of integer; {:631} {633:}
+     paramstack: array [0..150] of halfword;
+     paramptr: 0..150;
+     maxparamstack: integer; {:633} {634:}
+     fileptr: 0..stacksize; {:634} {659:}
+     scannerstatus: 0..6;
+     warninginfo: integer; {:659} {680:}
+     forceeof: boolean;
+ {:680}
+     {699:}
+     bgloc, egloc: 1..2241; {:699} {738:}
+     condptr: halfword;
+     iflimit: 0..4;
+     curif: smallnumber;
+     ifline: integer; {:738} {752:}
+     loopptr: halfword; {:752} {767:}
+     curname: strnumber;
+     curarea: strnumber;
+     curext: strnumber; {:767} {768:}
+     areadelimiter: poolpointer;
+     extdelimiter: poolpointer; {:768} {775:}
+     MFbasedefault: packed array [1..10] of char; {:775} {782:}
+     jobname: strnumber;
+     logname: strnumber; {:782} {785:}
+     gfext: strnumber; {:785} {791:}
+     gffile: bytefile;
+     outputfilename: strnumber; {:791} {796:}
+     curtype: smallnumber;
+     curexp: integer; {:796} {813:}
+     maxc: array [17..18] of integer;
+     maxptr: array [17..18] of halfword;
+     maxlink: array [17..18] of halfword; {:813} {821:}
+     varflag: 0..82; {:821} {954:}
+     txx, txy, tyx, tyy, tx, ty: scaled; {:954} {1077:}
+     startsym: halfword; {:1077}
+ {1084:}
+     longhelpseen: boolean; {:1084} {1087:}
+     tfmfile: bytefile;
+     metricfilename: strnumber; {:1087} {1096:}
+     bc, ec: eightbits;
+     tfmwidth: array [eightbits] of scaled;
+     tfmheight: array [eightbits] of scaled;
+     tfmdepth: array [eightbits] of scaled;
+     tfmitalcorr: array [eightbits] of scaled;
+     charexists: array [eightbits] of boolean;
+     chartag: array [eightbits] of 0..3;
+     charremainder: array [eightbits] of eightbits;
+     headerbyte: array [1..headersize] of -1..255;
+     ligkern: array [0..ligtablesize] of fourquarters;
+     nl: 0..ligtablesize;
+     kern: array [eightbits] of scaled;
+     nk: 0..256;
+     exten: array [eightbits] of fourquarters;
+     ne: 0..256;
+     param: array [1..maxfontdimen] of scaled;
+     np: 0..maxfontdimen;
+     nw, nh, nd, ni: 0..256; {:1096} {1119:}
+     perturbation: scaled; {:1119} {1125:}
+     dimenhead: array [1..4] of halfword; {:1125} {1130:}
+     maxtfmdimen: scaled;
+     tfmchanged: integer; {:1130} {1149:}
+     gfminm, gfmaxm, gfminn, gfmaxn: integer;
+     gfprevptr: integer;
+     totalchars: integer;
+     charptr: array [eightbits] of integer;
+     gfdx, gfdy: array [eightbits] of integer; {:1149} {1152:}
+     gfbuf: gfbuftype;
+     halfbuf: gfindex;
+     gflimit: gfindex;
+     gfptr: gfindex;
+     gfoffset: integer; {:1152}
+ {1162:}
+     bocc, bocp: integer; {:1162} {1183:}
+     baseident: strnumber; {:1183}
+ {1188:}
+     basefile: wordfile; {:1188} {1203:}
+     readyalready: integer; {:1203}
+ {1214:}
+     editnamestart: poolpointer;
+     editnamelength, editline: integer; {:1214}
+ 
+ procedure unskew(x, y: scaled; octant: smallnumber);external;
+ 
+ procedure sendcurve(x0,x1,x2,x3,y0,y1,y2,y3,octant:integer);external;
+ 
+ procedure sendline(x0,y0,x1,y1,octant,LineSource:integer);external;
+ 
+ procedure confusion(s: strnumber);external;
+ 
+ function abvscd(a, b, c, d: integer): integer;external;
+ 
+ procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber;CurveSource:integer;oc:smallnumber);external;
+ 
+ procedure print_start(var f:postscript);external;
+ 
+ procedure print_end(var f:postscript);external;
+ 
+ procedure init_ps(var f:postscript);external;
+ 
+ procedure tini_ps(var f:postscript);external;
+ 
+ procedure auxslowprint(s: integer);external;
+ 
+ procedure auxprintnl(s: strnumber);external;
+ 
+ procedure sendascii(asc: integer);external;
+ 
+ {------------------------------}
+ { $Header: /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p,v 1.1 2004/02/16 23:43:31 criswell Exp $ }
+ 
+ { declarations for external C assist routines for MetaFont }
+ 
+ procedure exit(x : integer);
+  external;
+ 
+ procedure closea(var f:text);
+  external;
+ 
+ procedure closew(var f:wordfile);
+  external;
+ 
+ procedure dateandtime(var minutes, day, month, year : integer);
+     external;
+ 
+ procedure setpaths;
+     external;
+ 
+ function testaccess(var nameoffile, realnameoffile: UNIXfilename;
+ 		accessmode:integer; filepath:integer): boolean;
+     external;
+ 
+ procedure calledit(var filename: ASCIIcode; fnlength, linenumber: integer);
+     external;
+ 
+ function bopenout(var f: bytefile; var name: UNIXfilename): boolean;
+     external;
+ 
+ procedure bclose(var f: bytefile);
+     external;
+ 
+ procedure bgetname(var f: bytefile; var name: UNIXfilename);
+     external;
+ 
+ procedure bwritebuf(var f: bytefile; var buf: gfbuftype;
+ 		first, last: integer);
+     external;
+ 
+ procedure bwritebyte(var f: bytefile; b: integer);
+     external;
+ 
+ procedure bwrite2bytes(var f: bytefile; b: integer);
+     external;
+ 
+ procedure bwrite4bytes(var f: bytefile; b: integer);
+     external;
+ 
+ function makefraction(p, q: integer): fraction;
+     external;
+ 
+ function takefraction(q: integer; f: fraction): integer;
+     external;
+ 
+ { $Header: /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p,v 1.1 2004/02/16 23:43:31 criswell Exp $ }
+ 
+ { External procedures for UNIX MetaFont VIRMF for display graphics }
+ 
+ function initscreen: boolean;
+     external;
+ 
+ procedure updatescreen;
+     external;
+ 
+ procedure blankrectangle(leftcol, rightcol: screencol; toprow, botrow: screenrow);
+     external;
+ 
+ procedure paintrow(r: screenrow; b: pixelcolor; var a: transspec; n: screencol);
+     external;
+ 
+ 
+     procedure initialize; {19:}
+     var
+ 	i: 0..127; {:19} {130:}
+ 	k: integer; {:130} {21:}
+     begin
+ 	xchr[32] := ' ';
+ 	xchr[33] := '!';
+ 	xchr[34] := '"';
+ 	xchr[35] := '#';
+ 	xchr[36] := '$';
+ 	xchr[37] := '%';
+ 	xchr[38] := '&';
+ 	xchr[39] := '''';
+ 	xchr[40] := '(';
+ 	xchr[41] := ')';
+ 	xchr[42] := '*';
+ 	xchr[43] := '+';
+ 	xchr[44] := ',';
+ 	xchr[45] := '-';
+ 	xchr[46] := '.';
+ 	xchr[47] := '/';
+ 	xchr[48] := '0';
+ 	xchr[49] := '1';
+ 	xchr[50] := '2';
+ 	xchr[51] := '3';
+ 	xchr[52] := '4';
+ 	xchr[53] := '5';
+ 	xchr[54] := '6';
+ 	xchr[55] := '7';
+ 	xchr[56] := '8';
+ 	xchr[57] := '9';
+ 	xchr[58] := ':';
+ 	xchr[59] := ';';
+ 	xchr[60] := '<';
+ 	xchr[61] := '=';
+ 	xchr[62] := '>';
+ 	xchr[63] := '?';
+ 	xchr[64] := '@';
+ 	xchr[65] := 'A';
+ 	xchr[66] := 'B';
+ 	xchr[67] := 'C';
+ 	xchr[68] := 'D';
+ 	xchr[69] := 'E';
+ 	xchr[70] := 'F';
+ 	xchr[71] := 'G';
+ 	xchr[72] := 'H';
+ 	xchr[73] := 'I';
+ 	xchr[74] := 'J';
+ 	xchr[75] := 'K';
+ 	xchr[76] := 'L';
+ 	xchr[77] := 'M';
+ 	xchr[78] := 'N';
+ 	xchr[79] := 'O';
+ 	xchr[80] := 'P';
+ 	xchr[81] := 'Q';
+ 	xchr[82] := 'R';
+ 	xchr[83] := 'S';
+ 	xchr[84] := 'T';
+ 	xchr[85] := 'U';
+ 	xchr[86] := 'V';
+ 	xchr[87] := 'W';
+ 	xchr[88] := 'X';
+ 	xchr[89] := 'Y';
+ 	xchr[90] := 'Z';
+ 	xchr[91] := '[';
+ 	xchr[92] := '\';
+ 	xchr[93] := ']';
+ 	xchr[94] := '^';
+ 	xchr[95] := '_';
+ 	xchr[96] := '`';
+ 	xchr[97] := 'a';
+ 	xchr[98] := 'b';
+ 	xchr[99] := 'c';
+ 	xchr[100] := 'd';
+ 	xchr[101] := 'e';
+ 	xchr[102] := 'f';
+ 	xchr[103] := 'g';
+ 	xchr[104] := 'h';
+ 	xchr[105] := 'i';
+ 	xchr[106] := 'j';
+ 	xchr[107] := 'k';
+ 	xchr[108] := 'l';
+ 	xchr[109] := 'm';
+ 	xchr[110] := 'n';
+ 	xchr[111] := 'o';
+ 	xchr[112] := 'p';
+ 	xchr[113] := 'q';
+ 	xchr[114] := 'r';
+ 	xchr[115] := 's';
+ 	xchr[116] := 't';
+ 	xchr[117] := 'u';
+ 	xchr[118] := 'v';
+ 	xchr[119] := 'w';
+ 	xchr[120] := 'x';
+ 	xchr[121] := 'y';
+ 	xchr[122] := 'z';
+ 	xchr[123] := '{';
+ 	xchr[124] := '|';
+ 	xchr[125] := '}';
+ 	xchr[126] := '~';
+ 	xchr[0] := ' ';
+ 	xchr[127] := ' '; {:21} {22:}
+ 	for i := 1 to 31 do 
+ 	    xchr[i] := ' ';
+ 	xchr[9] := chr(9);
+ 	xchr[12] := chr(12); {:22}
+ {23:}
+ 	for i := 0 to 127 do 
+ 	    xord[chr(i)] := 127;
+ 	for i := 1 to 126 do 
+ 	    xord[xchr[i]] := i; {:23} {69:}
+ 	interaction := 3; {:69} {72:}
+ 	deletionsallowed := true;
+ 	errorcount := 0; {:72} {75:}
+ 	helpptr := 0;
+ 	useerrhelp := false;
+ 	errhelp := 0; {:75} {92:}
+ 	interrupt := 0;
+ 	OKtointerrupt := true;
+ {:92}
+ 	{98:}
+ 	aritherror := false; {:98} {131:}
+ 	twotothe[0] := 1;
+ 	for k := 1 to 30 do 
+ 	    twotothe[k] := 2 * twotothe[k - 1];
+ 	speclog[1] := 93032640;
+ 	speclog[2] := 38612034;
+ 	speclog[3] := 17922280;
+ 	speclog[4] := 8662214;
+ 	speclog[5] := 4261238;
+ 	speclog[6] := 2113709;
+ 	speclog[7] := 1052693;
+ 	speclog[8] := 525315;
+ 	speclog[9] := 262400;
+ 	speclog[10] := 131136;
+ 	speclog[11] := 65552;
+ 	speclog[12] := 32772;
+ 	speclog[13] := 16385;
+ 	for k := 14 to 27 do 
+ 	    speclog[k] := twotothe[27 - k];
+ 	speclog[28] := 1; {:131}
+ {138:}
+ 	specatan[1] := 27855475;
+ 	specatan[2] := 14718068;
+ 	specatan[3] := 7471121;
+ 	specatan[4] := 3750058;
+ 	specatan[5] := 1876857;
+ 	specatan[6] := 938658;
+ 	specatan[7] := 469357;
+ 	specatan[8] := 234682;
+ 	specatan[9] := 117342;
+ 	specatan[10] := 58671;
+ 	specatan[11] := 29335;
+ 	specatan[12] := 14668;
+ 	specatan[13] := 7334;
+ 	specatan[14] := 3667;
+ 	specatan[15] := 1833;
+ 	specatan[16] := 917;
+ 	specatan[17] := 458;
+ 	specatan[18] := 229;
+ 	specatan[19] := 115;
+ 	specatan[20] := 57;
+ 	specatan[21] := 29;
+ 	specatan[22] := 14;
+ 	specatan[23] := 7;
+ 	specatan[24] := 4;
+ 	specatan[25] := 2;
+ 	specatan[26] := 1; {:138} {179:}
+ {wasmemend:=-30000;waslomax:=-30000;washimin:=memmax;panicking:=false;}
+ {:179}
+ 	{191:}
+ 	for k := 1 to 40 do 
+ 	    internal[k] := 0;
+ 	intptr := 40; {:191} {199:}
+ 	for k := 48 to 57 do 
+ 	    charclass[k] := 0;
+ 	charclass[46] := 1;
+ 	charclass[32] := 2;
+ 	charclass[37] := 3;
+ 	charclass[34] := 4;
+ 	charclass[44] := 5;
+ 	charclass[59] := 6;
+ 	charclass[40] := 7;
+ 	charclass[41] := 8;
+ 	for k := 65 to 90 do 
+ 	    charclass[k] := 9;
+ 	for k := 97 to 122 do 
+ 	    charclass[k] := 9;
+ 	charclass[95] := 9;
+ 	charclass[60] := 10;
+ 	charclass[61] := 10;
+ 	charclass[62] := 10;
+ 	charclass[58] := 10;
+ 	charclass[124] := 10;
+ 	charclass[96] := 11;
+ 	charclass[39] := 11;
+ 	charclass[43] := 12;
+ 	charclass[45] := 12;
+ 	charclass[47] := 13;
+ 	charclass[42] := 13;
+ 	charclass[92] := 13;
+ 	charclass[33] := 14;
+ 	charclass[63] := 14;
+ 	charclass[35] := 15;
+ 	charclass[38] := 15;
+ 	charclass[64] := 15;
+ 	charclass[36] := 15;
+ 	charclass[94] := 16;
+ 	charclass[126] := 16;
+ 	charclass[91] := 17;
+ 	charclass[93] := 18;
+ 	charclass[123] := 19;
+ 	charclass[125] := 19;
+ 	for k := 0 to 31 do 
+ 	    charclass[k] := 20;
+ 	charclass[127] := 20;
+ 	charclass[9] := 2;
+ 	charclass[12] := 2; {:199} {202:}
+ 	hash[1].lh := 0;
+ 	hash[1].rh := 0;
+ 	eqtb[1].lh := 41;
+ 	eqtb[1].rh := -30000;
+ 	for k := 2 to 2241 do begin
+ 	    hash[k] := hash[1];
+ 	    eqtb[k] := eqtb[1]
+ 	end; {:202} {231:}
+ 	bignodesize[13] := 12;
+ 	bignodesize[14] := 4;
+ {:231}
+ 	{251:}
+ 	saveptr := -30000; {:251} {396:}
+ 	octantdir[1] := 415;
+ 	octantdir[5] := 416;
+ 	octantdir[6] := 417;
+ 	octantdir[2] := 418;
+ 	octantdir[4] := 419;
+ 	octantdir[8] := 420;
+ 	octantdir[7] := 421;
+ 	octantdir[3] := 422; {:396} {428:}
+ 	maxroundingptr := 0; {:428} {449:}
+ 	octantcode[1] := 1;
+ 	octantcode[2] := 5;
+ 	octantcode[3] := 6;
+ 	octantcode[4] := 2;
+ 	octantcode[5] := 4;
+ 	octantcode[6] := 8;
+ 	octantcode[7] := 7;
+ 	octantcode[8] := 3;
+ 	for k := 1 to 8 do 
+ 	    octantnumber[octantcode[k]] := k; {:449} {456:}
+ 	revturns := false; {:456} {462:}
+ 	xcorr[1] := 0;
+ 	ycorr[1] := 0;
+ 	xycorr[1] := 0;
+ 	xcorr[5] := 0;
+ 	ycorr[5] := 0;
+ 	xycorr[5] := 1;
+ 	xcorr[6] := -1;
+ 	ycorr[6] := 1;
+ 	xycorr[6] := 0;
+ 	xcorr[2] := 1;
+ 	ycorr[2] := 0;
+ 	xycorr[2] := 1;
+ 	xcorr[4] := 0;
+ 	ycorr[4] := 1;
+ 	xycorr[4] := 1;
+ 	xcorr[8] := 0;
+ 	ycorr[8] := 1;
+ 	xycorr[8] := 0;
+ 	xcorr[7] := 1;
+ 	ycorr[7] := 0;
+ 	xycorr[7] := 1;
+ 	xcorr[3] := -1;
+ 	ycorr[3] := 1;
+ 	xycorr[3] := 0;
+ 	for k := 1 to 8 do 
+ 	    zcorr[k] := xycorr[k] - xcorr[k]; {:462} {570:}
+ 	screenstarted := false;
+ 	screenOK := false; {:570} {573:}
+ 	for k := 0 to 15 do begin
+ 	    windowopen[k] := false;
+ 	    windowtime[k] := 0
+ 	end; {:573}
+ {593:}
+ 	fixneeded := false;
+ 	watchcoefs := true; {:593} {739:}
+ 	condptr := -30000;
+ 	iflimit := 0;
+ 	curif := 0;
+ 	ifline := 0; {:739} {753:}
+ 	loopptr := -30000; {:753} {776:}
+ 	MFbasedefault := 'plain.base'; {:776} {797:}
+ 	curexp := 0; {:797} {822:}
+ 	varflag := 0; {:822} {1078:}
+ 	startsym := 0; {:1078} {1085:}
+ 	longhelpseen := false;
+ {:1085}
+ 	{1097:}
+ 	for k := 0 to 255 do begin
+ 	    tfmwidth[k] := 0;
+ 	    tfmheight[k] := 0;
+ 	    tfmdepth[k] := 0;
+ 	    tfmitalcorr[k] := 0;
+ 	    charexists[k] := false;
+ 	    chartag[k] := 0;
+ 	    charremainder[k] := 0
+ 	end;
+ 	for k := 1 to headersize do 
+ 	    headerbyte[k] := -1;
+ 	bc := 255;
+ 	ec := 0;
+ 	nl := 0;
+ 	nk := 0;
+ 	ne := 0;
+ 	np := 0; {:1097} {1150:}
+ 	gfprevptr := 0;
+ 	totalchars := 0; {:1150} {1153:}
+ 	halfbuf := gfbufsize div 2;
+ 	gflimit := gfbufsize;
+ 	gfptr := 0;
+ 	gfoffset := 0; {:1153} {1184:}
+ 	baseident := 0; {:1184} {1215:}
+ 	editnamestart := 0
+     end; {:1215} {57:}
+ 
+     procedure println;
+     begin
+ 	case selector of
+ 	    3:
+ 		begin
+ 		    writeln(output);
+ 		    writeln(logfile);
+ 		    termoffset := 0;
+ 		    fileoffset := 0
+ 		end;
+ 	    2:
+ 		begin
+ 		    writeln(logfile);
+ 		    fileoffset := 0
+ 		end;
+ 	    1:
+ 		begin
+ 		    writeln(output);
+ 		    termoffset := 0
+ 		end;
+ 	    0, 4, 5:
+ 	end
+     end; {:57} {58:}
+ 
+     procedure printchar(s: ASCIIcode);
+     var tmp : integer;
+     begin
+ 	case selector of
+ 	    3:
+ 		begin
+ 		    {----------------------------------}
+ 		     if xchr[s] = '[' then 
+ 		     begin
+ 			ascii_on := true;
+ 			ascval := 0;
+                      end
+ 		     else if xchr[s] = ']' then 
+ 		     begin
+ 			ascii_on := false;
+ 			sendascii(ascval);
+                      end
+ 		     else if ascii_on then 
+ 		     begin
+ 			tmp := s - ord('0');
+ 			ascval := ascval*10+tmp;
+                      end;
+                     {-------------------------------------}
+ 		    write(output, xchr[s]);
+ 		    write(logfile, xchr[s]);
+ 		    termoffset := termoffset + 1;
+ 		    fileoffset := fileoffset + 1;
+ 		    if termoffset = maxprintline then begin
+ 			writeln(output);
+ 			termoffset := 0
+ 		    end;
+ 		    if fileoffset = maxprintline then begin
+ 			writeln(logfile);
+ 			fileoffset := 0
+ 		    end
+ 		end;
+ 	    2:
+ 		begin
+ 		    write(logfile, xchr[s]);
+ 		    fileoffset := fileoffset + 1;
+ 		    if fileoffset = maxprintline then 
+ 			println
+ 		end;
+ 	    1:
+ 		begin
+ 		    write(output, xchr[s]);
+ 		    termoffset := termoffset + 1;
+ 		    if termoffset = maxprintline then 
+ 			println
+ 		end;
+ 	    0:
+ 		;
+ 	    4:
+ 		if tally < trickcount then 
+ 		    trickbuf[tally mod errorline] := s;
+ 	    5:
+ 		begin
+ 		    if poolptr < poolsize then begin
+ 			strpool[poolptr] := s;
+ 			poolptr := poolptr + 1
+ 		    end
+ 		end
+ 	end;
+ 	tally := tally + 1
+     end; {:58} {59:}
+ 
+     procedure print(s: integer);
+     var
+ 	j: poolpointer;
+     begin
+ 	if (s < 0) or (s >= strptr) then 
+ 	    s := 131;
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    printchar(strpool[j]);
+ 	    j := j + 1
+ 	end
+     end; {:59}
+ {60:}
+ 
+     procedure slowprint(s: integer);
+     var
+ 	j: poolpointer;
+     begin
+ 	if (s < 0) or (s >= strptr) then 
+ 	    s := 131;
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    print(strpool[j]);
+ 	    j := j + 1
+ 	end
+     end; {:60}
+ {62:}
+ 
+     procedure printnl(s: strnumber);
+     begin
+ 	if ((termoffset > 0) and odd(selector)) or ((fileoffset > 0) and (selector >= 2)) then 
+ 	    println;
+ 	print(s)
+     end; {:62} {63:}
+ 
+     procedure printthedigs(k: eightbits);
+     begin
+ 	while k > 0 do begin
+ 	    k := k - 1;
+ 	    printchar(48 + dig[k])
+ 	end
+     end; {:63} {64:}
+ 
+     procedure printint(n: integer);
+     var
+ 	k: 0..23;
+ 	m: integer;
+     begin
+ 	k := 0;
+ 	if n < 0 then begin
+ 	    printchar(45);
+ 	    if n > (-100000000) then 
+ 		n := -n
+ 	    else begin
+ 		m := (-1) - n;
+ 		n := m div 10;
+ 		m := (m mod 10) + 1;
+ 		k := 1;
+ 		if m < 10 then 
+ 		    dig[0] := m
+ 		else begin
+ 		    dig[0] := 0;
+ 		    n := n + 1
+ 		end
+ 	    end
+ 	end;
+ 	repeat
+ 	    dig[k] := n mod 10;
+ 	    n := n div 10;
+ 	    k := k + 1
+ 	until n = 0;
+ 	printthedigs(k)
+     end; {:64} {103:}
+ 
+     procedure printscaled(s: scaled);
+     var
+ 	delta: scaled;
+     begin
+ 	if s < 0 then begin
+ 	    printchar(45);
+ 	    s := -s
+ 	end;
+ 	printint(s div 65536);
+ 	s := (10 * (s mod 65536)) + 5;
+ 	if s <> 5 then begin
+ 	    delta := 10;
+ 	    printchar(46);
+ 	    repeat
+ 		if delta > 65536 then 
+ 		    s := (s + 32768) - (delta div 2);
+ 		printchar(48 + (s div 65536));
+ 		s := 10 * (s mod 65536);
+ 		delta := delta * 10
+ 	    until s <= delta
+ 	end
+     end; {:103} {104:}
+ 
+     procedure printtwo(x, y: scaled);
+     begin
+ 	printchar(40);
+ 	printscaled(x);
+ 	printchar(44);
+ 	printscaled(y);
+ 	printchar(41)
+     end; {:104} {187:}
+ 
+     procedure printtype(t: smallnumber);
+     begin
+ 	if t in
+ 	    [1, 2, 3, 4, 5, 6, 7, 8,
+ 	     9, 10, 11, 12, 13, 14, 16, 17,
+ 	     18, 15, 19, 20, 21, 22, 23] then
+ 	    case t of
+ 		1:
+ 		    print(194);
+ 		2:
+ 		    print(195);
+ 		3:
+ 		    print(196);
+ 		4:
+ 		    print(197);
+ 		5:
+ 		    print(198);
+ 		6:
+ 		    print(199);
+ 		7:
+ 		    print(200);
+ 		8:
+ 		    print(201);
+ 		9:
+ 		    print(202);
+ 		10:
+ 		    print(203);
+ 		11:
+ 		    print(204);
+ 		12:
+ 		    print(205);
+ 		13:
+ 		    print(206);
+ 		14:
+ 		    print(207);
+ 		16:
+ 		    print(208);
+ 		17:
+ 		    print(209);
+ 		18:
+ 		    print(210);
+ 		15:
+ 		    print(211);
+ 		19:
+ 		    print(212);
+ 		20:
+ 		    print(213);
+ 		21:
+ 		    print(214);
+ 		22:
+ 		    print(215);
+ 		23:
+ 		    print(216)
+ 	    end
+ 	else
+ 	    print(217)
+     end; {:187} {195:}
+ 
+     procedure begindiagnostic;
+     begin
+ 	oldsetting := selector;
+ 	if (internal[13] <= 0) and (selector = 3) then begin
+ 	    selector := selector - 1;
+ 	    if history = 0 then 
+ 		history := 1
+ 	end
+     end; { begindiagnostic }
+ 
+     procedure enddiagnostic(blankline: boolean);
+     begin
+ 	printnl(155);
+ 	if blankline then 
+ 	    println;
+ 	selector := oldsetting
+     end; {:195} {197:}
+ 
+     procedure printdiagnostic(s, t: strnumber; nuline: boolean);
+     begin
+ 	begindiagnostic;
+ 	if nuline then 
+ 	    printnl(s)
+ 	else 
+ 	    print(s);
+ 	print(320);
+ 	printint(line);
+ 	print(t);
+ 	printchar(58)
+     end; {:197} {773:}
+ 
+     procedure printfilename(n, a, e: integer);
+     begin
+ 	print(a);
+ 	print(n);
+ 	print(e)
+     end; {:773} {73:}
+ 
+     procedure normalizeselector;
+     forward;
+ 
+     procedure getnext;
+     forward;
+ 
+     procedure terminput;
+     forward;
+ 
+     procedure showcontext;
+     forward;
+ 
+     procedure beginfilereading;
+     forward;
+ 
+     procedure openlogfile;
+     forward;
+ 
+     procedure closefilesandtermina;
+     forward;
+ 
+     procedure clearforerrorprompt;
+     forward; {procedure debughelp;forward;} {43:}
+ 
+     procedure flushstring(s: strnumber);
+     begin
+ 	if s < (strptr - 1) then 
+ 	    strref[s] := 0
+ 	else 
+ 	    repeat
+ 		strptr := strptr - 1
+ 	    until strref[strptr - 1] <> 0;
+ 	poolptr := strstart[strptr]
+     end; {:43} {:73} {76:}
+ 
+     procedure jumpout;
+     begin
+ 	goto 9998
+     end; {:76} {77:}
+ 
+     procedure error;
+     label
+ 	22, 10;
+     var
+ 	c: ASCIIcode;
+ 	s1, s2, s3: integer;
+ 	j: poolpointer;
+     begin
+ 	if history < 2 then 
+ 	    history := 2;
+ 	printchar(46);
+ 	showcontext;
+ 	if interaction = 3 then  {78:}
+ 	    while true do begin
+     22:
+ 		clearforerrorprompt;
+ 		begin
+ 		    print(135);
+ 		    terminput
+ 		end;
+ 		if last = first then 
+ 		    goto 10;
+ 		c := buffer[first];
+ 		if c >= 97 then 
+ 		    c := c - 32; {79:}
+ 		if c in
+ 		    [48, 49, 50, 51, 52, 53, 54, 55,
+ 		     56, 57, 69, 72, 73, 81, 82, 83,
+ 		     88] then
+ 		    case c of
+ 			48, 49, 50, 51, 52, 53, 54,
+ 			55, 56, 57:
+ 			    if deletionsallowed then begin {83:}
+ 				s1 := curcmd;
+ 				s2 := curmod;
+ 				s3 := cursym;
+ 				OKtointerrupt := false;
+ 				if ((last > (first + 1)) and (buffer[first + 1] >= 48)) and (buffer[first + 1] <= 57) then 
+ 				    c := ((c * 10) + buffer[first + 1]) - (48 * 11)
+ 				else 
+ 				    c := c - 48;
+ 				while c > 0 do begin
+ 				    getnext;
+ {743:}
+ 				    if curcmd = 39 then begin
+ 					if strref[curmod] < 127 then 
+ 					    if strref[curmod] > 1 then 
+ 						strref[curmod] := strref[curmod] - 1
+ 					    else 
+ 						flushstring(curmod)
+ 				    end {:743};
+ 				    c := c - 1
+ 				end;
+ 				curcmd := s1;
+ 				curmod := s2;
+ 				cursym := s3;
+ 				OKtointerrupt := true;
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 148;
+ 				    helpline[0] := 149
+ 				end;
+ 				showcontext;
+ 				goto 22
+ 			    end {:83}; {68:begin debughelp;goto 22;end;}
+ 			69:
+ 			    if fileptr > 0 then begin
+ 				editnamestart := strstart[inputstack[fileptr].namefield];
+ 				editnamelength := strstart[inputstack[fileptr].namefield + 1] - strstart[inputstack[fileptr].namefield];
+ 				editline := line;
+ 				jumpout
+ 			    end;
+ 			72:
+ 			    begin {84:}
+ 				if useerrhelp then begin {85:}
+ 				    j := strstart[errhelp];
+ 				    while j < strstart[errhelp + 1] do begin
+ 					if strpool[j] <> 37 then 
+ 					    print(strpool[j])
+ 					else if (j + 1) = strstart[errhelp + 1] then 
+ 					    println
+ 					else if strpool[j + 1] <> 37 then 
+ 					    println
+ 					else begin
+ 					    j := j + 1;
+ 					    printchar(37)
+ 					end;
+ 					j := j + 1
+ 				    end {:85};
+ 				    useerrhelp := false
+ 				end else begin
+ 				    if helpptr = 0 then begin
+ 					helpptr := 2;
+ 					helpline[1] := 150;
+ 					helpline[0] := 151
+ 				    end;
+ 				    repeat
+ 					helpptr := helpptr - 1;
+ 					print(helpline[helpptr]);
+ 					println
+ 				    until helpptr = 0
+ 				end;
+ 				begin
+ 				    helpptr := 4;
+ 				    helpline[3] := 152;
+ 				    helpline[2] := 151;
+ 				    helpline[1] := 153;
+ 				    helpline[0] := 154
+ 				end;
+ 				goto 22
+ 			    end; {:84}
+ 			73:
+ 			    begin {82:}
+ 				beginfilereading;
+ 				if last > (first + 1) then begin
+ 				    curinput.locfield := first + 1;
+ 				    buffer[first] := 32
+ 				end else begin
+ 				    begin
+ 					print(147);
+ 					terminput
+ 				    end;
+ 				    curinput.locfield := first
+ 				end;
+ 				first := last + 1;
+ 				curinput.limitfield := last;
+ 				goto 10
+ 			    end; {:82}
+ 			81, 82, 83:
+ 			    begin {81:}
+ 				errorcount := 0;
+ 				interaction := (0 + c) - 81;
+ 				print(142);
+ 				case c of
+ 				    81:
+ 					begin
+ 					    print(143);
+ 					    selector := selector - 1
+ 					end;
+ 				    82:
+ 					print(144);
+ 				    83:
+ 					print(145)
+ 				end;
+ 				print(146);
+ 				println;
+ 				flush(output);
+ 				goto 10
+ 			    end; {:81}
+ 			88:
+ 			    begin
+ 				interaction := 2;
+ 				jumpout
+ 			    end
+ 		    end
+ 		else
+ 		    ; {80:}
+ 		begin
+ 		    print(136);
+ 		    printnl(137);
+ 		    printnl(138);
+ 		    if fileptr > 0 then 
+ 			print(139);
+ 		    if deletionsallowed then 
+ 			printnl(140);
+ 		    printnl(141)
+ 		end {:80} {:79}
+ 	    end {:78};
+ 	errorcount := errorcount + 1;
+ 	if errorcount = 100 then begin
+ 	    printnl(134);
+ 	    history := 3;
+ 	    jumpout
+ 	end; {86:}
+ 	if interaction > 0 then 
+ 	    selector := selector - 1;
+ 	if useerrhelp then begin
+ 	    printnl(155); {85:}
+ 	    j := strstart[errhelp];
+ 	    while j < strstart[errhelp + 1] do begin
+ 		if strpool[j] <> 37 then 
+ 		    print(strpool[j])
+ 		else if (j + 1) = strstart[errhelp + 1] then 
+ 		    println
+ 		else if strpool[j + 1] <> 37 then 
+ 		    println
+ 		else begin
+ 		    j := j + 1;
+ 		    printchar(37)
+ 		end;
+ 		j := j + 1
+ 	    end {:85}
+ 	end else 
+ 	    while helpptr > 0 do begin
+ 		helpptr := helpptr - 1;
+ 		printnl(helpline[helpptr])
+ 	    end;
+ 	println;
+ 	if interaction > 0 then 
+ 	    selector := selector + 1; {:86}
+ 	println;
+     10:
+ 	
+     end; {:77}
+ {88:}
+ 
+     procedure fatalerror(s: strnumber);
+     begin
+ 	normalizeselector;
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(156)
+ 	end;
+ 	begin
+ 	    helpptr := 1;
+ 	    helpline[0] := s
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:88} {89:}
+ 
+     procedure overflow(s: strnumber; n: integer);
+     begin
+ 	normalizeselector;
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(157)
+ 	end;
+ 	print(s);
+ 	printchar(61);
+ 	printint(n);
+ 	printchar(93);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 158;
+ 	    helpline[0] := 159
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:89} {90:}
+ 
+     procedure confusion;
+     begin
+ 	normalizeselector;
+ 	if history < 2 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(160)
+ 	    end;
+ 	    print(s);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 161
+ 	    end
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(162)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 163;
+ 		helpline[0] := 164
+ 	    end
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:90} {:4}
+ 
+ 
+ {26:}
+ 
+     function aopenin(var f: alphafile; pathspecifier: integer): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 4, pathspecifier) then begin
+ 	    reset(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	aopenin := ok
+     end; { aopenin }
+ 
+     function aopenout(var f: alphafile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 2, 0) then begin
+ 	    rewrite(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	aopenout := ok
+     end; { aopenout }
+ 
+     function wopenin(var f: wordfile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 4, 7) then begin
+ 	    reset(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	wopenin := ok
+     end; { wopenin }
+ 
+     function wopenout(var f: wordfile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 2, 0) then begin
+ 	    rewrite(f, nameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	wopenout := ok
+     end; {:26} {27:}
+ 
+     procedure aclose(var f: alphafile);
+     begin
+ 	closea(f)
+     end; { aclose }
+ 
+     procedure wclose(var f: wordfile);
+     begin
+ 	closew(f)
+     end; {:27} {30:}
+ 
+     function inputln(var f: alphafile; bypasseoln: boolean): boolean;
+     var
+ 	lastnonblank: 0..bufsize;
+     begin
+ 	if bypasseoln then 
+ 	    if not eof(f) then 
+ 		if eoln(f) then 
+ 		    get(f);
+ 	last := first;
+ 	if eof(f) then 
+ 	    inputln := false
+ 	else begin
+ 	    lastnonblank := first;
+ 	    while not eoln(f) do begin
+ 		if last >= maxbufstack then begin
+ 		    maxbufstack := last + 1;
+ 		    if maxbufstack = bufsize then 
+ 			overflow(128, bufsize)
+ 		end;
+ 		buffer[last] := xord[f^];
+ 		get(f);
+ 		last := last + 1;
+ 		if buffer[last - 1] <> 32 then 
+ 		    lastnonblank := last
+ 	    end;
+ 	    last := lastnonblank;
+ 	    inputln := true
+ 	end
+     end; {:30} {36:}
+ 
+     function initterminal: boolean;
+     label
+ 	10;
+     var
+ 	dummy, i, j, k: integer;
+ 	arg: packed array [1..100] of char;
+     begin
+ 	if argc > 1 then begin
+ 	    last := first;
+ 	    for i := 1 to argc - 1 do begin
+ 		argv(i, arg);
+ 		j := 1;
+ 		k := 100;
+ 		while (k > 1) and (arg[k] = ' ') do 
+ 		    k := k - 1;
+ 		while j <= k do begin
+ 		    buffer[last] := xord[arg[j]];
+ 		    j := j + 1;
+ 		    last := last + 1
+ 		end;
+ 		if k > 1 then begin
+ 		    buffer[last] := xord[' '];
+ 		    last := last + 1
+ 		end
+ 	    end;
+ 	    if last > first then begin
+ 		curinput.locfield := first;
+ 		initterminal := true;
+ 		goto 10
+ 	    end
+ 	end;
+ 	while true do begin
+ 	    write(output, '**');
+ 	    flush(output);
+ 	    if not inputln(input, true) then begin
+ 		writeln(output);
+ 		writeln(output, '! End of file on the terminal... why?');
+ 		initterminal := false;
+ 		goto 10
+ 	    end;
+ 	    curinput.locfield := first;
+ 	    while (curinput.locfield < last) and (buffer[curinput.locfield] = 32) do 
+ 		curinput.locfield := curinput.locfield + 1;
+ 	    if curinput.locfield < last then begin
+ 		initterminal := true;
+ 		goto 10
+ 	    end;
+ 	    writeln(output, 'Please type the name of your input file.')
+ 	end;
+     10:
+ 	
+     end; { initterminal }
+ {:36}
+     {44:}
+ 
+     function makestring: strnumber;
+     begin
+ 	if strptr = maxstrptr then begin
+ 	    if strptr = maxstrings then 
+ 		overflow(130, maxstrings - initstrptr);
+ 	    maxstrptr := maxstrptr + 1
+ 	end;
+ 	strref[strptr] := 1;
+ 	strptr := strptr + 1;
+ 	strstart[strptr] := poolptr;
+ 	makestring := strptr - 1
+     end; { makestring }
+ {:44}
+     {45:}
+ 
+     function streqbuf(s: strnumber; k: integer): boolean;
+     label
+ 	45;
+     var
+ 	j: poolpointer;
+ 	result: boolean;
+     begin
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    if strpool[j] <> buffer[k] then begin
+ 		result := false;
+ 		goto 45
+ 	    end;
+ 	    j := j + 1;
+ 	    k := k + 1
+ 	end;
+ 	result := true;
+     45:
+ 	streqbuf := result
+     end; {:45} {46:}
+ 
+     function strvsstr(s, t: strnumber): integer;
+     label
+ 	10;
+     var
+ 	j, k: poolpointer;
+ 	ls, lt: integer;
+ 	l: integer;
+     begin
+ 	ls := strstart[s + 1] - strstart[s];
+ 	lt := strstart[t + 1] - strstart[t];
+ 	if ls <= lt then 
+ 	    l := ls
+ 	else 
+ 	    l := lt;
+ 	j := strstart[s];
+ 	k := strstart[t];
+ 	while l > 0 do begin
+ 	    if strpool[j] <> strpool[k] then begin
+ 		strvsstr := strpool[j] - strpool[k];
+ 		goto 10
+ 	    end;
+ 	    j := j + 1;
+ 	    k := k + 1;
+ 	    l := l - 1
+ 	end;
+ 	strvsstr := ls - lt;
+     10:
+ 	
+     end; {:46} {47:}
+     {function getstringsstarted:boolean;label 30,10;
+     var k,l:0..127;m,n:char;g:strnumber;a:integer;c:boolean;
+     begin poolptr:=0;strptr:=0;maxpoolptr:=0;maxstrptr:=0;strstart[0]:=0;
+     [48:]for k:=0 to 127 do begin if([49:](k<32)or(k>126)[:49])then begin
+     begin strpool[poolptr]:=94;poolptr:=poolptr+1;end;
+     begin strpool[poolptr]:=94;poolptr:=poolptr+1;end;
+     if k<64 then begin strpool[poolptr]:=k+64;poolptr:=poolptr+1;
+     end else begin strpool[poolptr]:=k-64;poolptr:=poolptr+1;end;
+     end else begin strpool[poolptr]:=k;poolptr:=poolptr+1;end;g:=makestring;
+     strref[g]:=127;end[:48];[51:]nameoffile:=poolname;
+     if aopenin(poolfile,8)then begin c:=false;
+     repeat[52:]begin if eof(poolfile)then begin;
+     writeln(output,'! mf.pool has no check sum.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end;read(poolfile,m,n);
+     if m='*'then[53:]begin a:=0;k:=1;
+     while true do begin if(xord[n]<48)or(xord[n]>57)then begin;
+     writeln(output,'! mf.pool check sum doesn''t have nine digits.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;
+     a:=10*a+xord[n]-48;if k=9 then goto 30;k:=k+1;read(poolfile,n);end;
+     30:if a<>503742536 then begin;
+     writeln(output,'! mf.pool doesn''t match; tangle me again.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;c:=true;
+     end[:53]else begin if(xord[m]<48)or(xord[m]>57)or(xord[n]<48)or(xord[n]>
+     57)then begin;
+     writeln(output,'! mf.pool line doesn''t begin with two digits.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;
+     l:=xord[m]*10+xord[n]-48*11;
+     if poolptr+l+stringvacancies>poolsize then begin;
+     writeln(output,'! You have to increase POOLSIZE.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end;
+     for k:=1 to l do begin if eoln(poolfile)then m:=' 'else read(poolfile,m)
+     ;begin strpool[poolptr]:=xord[m];poolptr:=poolptr+1;end;end;
+     readln(poolfile);g:=makestring;strref[g]:=127;end;end[:52];until c;
+     aclose(poolfile);getstringsstarted:=true;end else begin;
+     writeln(output,'! I can''t read mf.pool.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end[:51];10:end;}
+     {:47}
+     {65:}
+ 
+     procedure printdd(n: integer);
+     begin
+ 	n := abs(n) mod 100;
+ 	printchar(48 + (n div 10));
+ 	printchar(48 + (n mod 10))
+     end; {:65} {66:}
+ 
+     procedure terminput;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	flush(output);
+ 	if not inputln(input, true) then 
+ 	    fatalerror(132);
+ 	termoffset := 0;
+ 	selector := selector - 1;
+ 	if last <> first then 
+ 	    for k := first to last - 1 do 
+ 		print(buffer[k]);
+ 	println;
+ 	buffer[last] := 37;
+ 	selector := selector + 1
+     end; {:66} {87:}
+ 
+     procedure normalizeselector;
+     begin
+ 	if jobname > 0 then 
+ 	    selector := 3
+ 	else 
+ 	    selector := 1;
+ 	if jobname = 0 then 
+ 	    openlogfile;
+ 	if interaction = 0 then 
+ 	    selector := selector - 1
+     end; {:87} {93:}
+ 
+     procedure pauseforinstructions;
+     begin
+ 	if OKtointerrupt then begin
+ 	    interaction := 3;
+ 	    if (selector = 2) or (selector = 0) then 
+ 		selector := selector + 1;
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(165)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 166;
+ 		helpline[1] := 167;
+ 		helpline[0] := 168
+ 	    end;
+ 	    deletionsallowed := false;
+ 	    error;
+ 	    deletionsallowed := true;
+ 	    interrupt := 0
+ 	end
+     end; {:93} {94:}
+ 
+     procedure missingerr(s: strnumber);
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(169)
+ 	end;
+ 	print(s);
+ 	print(170)
+     end; {:94} {99:}
+ 
+     procedure cleararith;
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(171)
+ 	end;
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 172;
+ 	    helpline[2] := 173;
+ 	    helpline[1] := 174;
+ 	    helpline[0] := 175
+ 	end;
+ 	error;
+ 	aritherror := false
+     end; {:99} {100:}
+ 
+     function slowadd(x, y: integer): integer;
+     begin
+ 	if x >= 0 then 
+ 	    if y <= (2147483647 - x) then 
+ 		slowadd := x + y
+ 	    else begin
+ 		aritherror := true;
+ 		slowadd := 2147483647
+ 	    end
+ 	else if (-y) <= (2147483647 + x) then 
+ 	    slowadd := x + y
+ 	else begin
+ 	    aritherror := true;
+ 	    slowadd := -2147483647
+ 	end
+     end; {:100} {102:}
+ 
+     function rounddecimals(k: smallnumber): scaled;
+     var
+ 	a: integer;
+     begin
+ 	a := 0;
+ 	while k > 0 do begin
+ 	    k := k - 1;
+ 	    a := (a + (dig[k] * 131072)) div 10
+ 	end;
+ 	rounddecimals := (a + 1) div 2
+     end; {:102} {112:}
+ 
+     function takescaled(q: integer; f: scaled): integer;
+     var
+ 	p: integer;
+ 	negative: boolean;
+ 	n: integer;
+ 	becareful: integer; {110:}
+     begin
+ 	if f >= 0 then 
+ 	    negative := false
+ 	else begin
+ 	    f := -f;
+ 	    negative := true
+ 	end;
+ 	if q < 0 then begin
+ 	    q := -q;
+ 	    negative := not negative
+ 	end; {:110}
+ 	if f < 65536 then 
+ 	    n := 0
+ 	else begin
+ 	    n := f div 65536;
+ 	    f := f mod 65536;
+ 	    if q <= (2147483647 div n) then 
+ 		n := n * q
+ 	    else begin
+ 		aritherror := true;
+ 		n := 2147483647
+ 	    end
+ 	end;
+ 	f := f + 65536; {113:}
+ 	p := 32768;
+ 	if q < 1073741824 then 
+ 	    repeat
+ 		if odd(f) then 
+ 		    p := (p + q) div 2
+ 		else 
+ 		    p := p div 2;
+ 		f := f div 2
+ 	    until f = 1
+ 	else 
+ 	    repeat
+ 		if odd(f) then 
+ 		    p := p + ((q - p) div 2)
+ 		else 
+ 		    p := p div 2;
+ 		f := f div 2
+ 	    until f = 1 {:113};
+ 	becareful := n - 2147483647;
+ 	if (becareful + p) > 0 then begin
+ 	    aritherror := true;
+ 	    n := 2147483647 - p
+ 	end;
+ 	if negative then 
+ 	    takescaled := -(n + p)
+ 	else 
+ 	    takescaled := n + p
+     end; {:112} {114:}
+ 
+     function makescaled(p, q: integer): scaled;
+     var
+ 	f: integer;
+ 	n: integer;
+ 	negative: boolean;
+ 	becareful: integer;
+     begin
+ 	if p >= 0 then 
+ 	    negative := false
+ 	else begin
+ 	    p := -p;
+ 	    negative := true
+ 	end;
+ 	if q <= 0 then begin {if q=0 then confusion(47);}
+ 	    q := -q;
+ 	    negative := not negative
+ 	end;
+ 	n := p div q;
+ 	p := p mod q;
+ 	if n >= 32768 then begin
+ 	    aritherror := true;
+ 	    if negative then 
+ 		makescaled := -2147483647
+ 	    else 
+ 		makescaled := 2147483647
+ 	end else begin
+ 	    n := (n - 1) * 65536; {115:}
+ 	    f := 1;
+ 	    repeat
+ 		becareful := p - q;
+ 		p := becareful + p;
+ 		if p >= 0 then 
+ 		    f := (f + f) + 1
+ 		else begin
+ 		    f := f + f;
+ 		    p := p + q
+ 		end
+ 	    until f >= 65536;
+ 	    becareful := p - q;
+ 	    if (becareful + p) >= 0 then 
+ 		f := f + 1 {:115};
+ 	    if negative then 
+ 		makescaled := -(f + n)
+ 	    else 
+ 		makescaled := f + n
+ 	end
+     end; {:114}
+ {116:}
+ 
+     function velocity(st, ct, sf, cf: fraction; t: scaled): fraction;
+     var
+ 	acc, num, denom: integer;
+     begin
+ 	acc := takefraction(st - (sf div 16), sf - (st div 16));
+ 	acc := takefraction(acc, ct - cf);
+ 	num := 536870912 + takefraction(acc, 379625062);
+ 	denom := (805306368 + takefraction(ct, 497706707)) + takefraction(cf, 307599661);
+ 	if t <> 65536 then 
+ 	    num := makescaled(num, t);
+ 	if (num div 4) >= denom then 
+ 	    velocity := 1073741824
+ 	else 
+ 	    velocity := makefraction(num, denom)
+     end; {:116} {117:}
+ 
+     function abvscd ;
+     label
+ 	10;
+     var
+ 	q, r: integer; {118:}
+     begin
+ 	if a < 0 then begin
+ 	    a := -a;
+ 	    b := -b
+ 	end;
+ 	if c < 0 then begin
+ 	    c := -c;
+ 	    d := -d
+ 	end;
+ 	if d <= 0 then begin
+ 	    if b >= 0 then 
+ 		if ((a = 0) or (b = 0)) and ((c = 0) or (d = 0)) then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end;
+ 	    if d = 0 then 
+ 		if a = 0 then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    q := a;
+ 	    a := c;
+ 	    c := q;
+ 	    q := -b;
+ 	    b := -d;
+ 	    d := q
+ 	end else if b <= 0 then begin
+ 	    if b < 0 then 
+ 		if a > 0 then begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    if c = 0 then begin
+ 		abvscd := 0;
+ 		goto 10
+ 	    end else begin
+ 		abvscd := -1;
+ 		goto 10
+ 	    end
+ 	end {:118};
+ 	while true do begin
+ 	    q := a div d;
+ 	    r := c div b;
+ 	    if q <> r then 
+ 		if q > r then begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    q := a mod d;
+ 	    r := c mod b;
+ 	    if r = 0 then 
+ 		if q = 0 then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end;
+ 	    if q = 0 then begin
+ 		abvscd := -1;
+ 		goto 10
+ 	    end;
+ 	    a := b;
+ 	    b := q;
+ 	    c := d;
+ 	    d := r
+ 	end;
+     10:
+ 	
+     end; {:117} {119:}
+ 
+     function floorscaled(x: scaled): scaled;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 0 then 
+ 	    floorscaled := x - (x mod 65536)
+ 	else begin
+ 	    becareful := x + 1;
+ 	    floorscaled := (x + ((-becareful) mod 65536)) - 65535
+ 	end
+     end; { floorscaled }
+ 
+     function floorunscaled(x: scaled): integer;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 0 then 
+ 	    floorunscaled := x div 65536
+ 	else begin
+ 	    becareful := x + 1;
+ 	    floorunscaled := -(1 + ((-becareful) div 65536))
+ 	end
+     end; { floorunscaled }
+ 
+     function roundunscaled(x: scaled): integer;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 32768 then 
+ 	    roundunscaled := 1 + ((x - 32768) div 65536)
+ 	else if x >= (-32768) then 
+ 	    roundunscaled := 0
+ 	else begin
+ 	    becareful := x + 1;
+ 	    roundunscaled := -(1 + (((-becareful) - 32768) div 65536))
+ 	end
+     end; { roundunscaled }
+ 
+     function roundfraction(x: fraction): scaled;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 2048 then 
+ 	    roundfraction := 1 + ((x - 2048) div 4096)
+ 	else if x >= (-2048) then 
+ 	    roundfraction := 0
+ 	else begin
+ 	    becareful := x + 1;
+ 	    roundfraction := -(1 + (((-becareful) - 2048) div 4096))
+ 	end
+     end; {:119} {121:}
+ 
+     function squarert(x: scaled): scaled;
+     var
+ 	k: smallnumber;
+ 	y, q: integer;
+     begin
+ 	if x <= 0 then begin {122:}
+ 	    if x < 0 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(176)
+ 		end;
+ 		printscaled(x);
+ 		print(177);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 178;
+ 		    helpline[0] := 179
+ 		end;
+ 		error
+ 	    end;
+ 	    squarert := 0
+ 	end else begin {:122}
+ 	    k := 23;
+ 	    q := 2;
+ 	    while x < 536870912 do begin
+ 		k := k - 1;
+ 		x := ((x + x) + x) + x
+ 	    end;
+ 	    if x < 1073741824 then 
+ 		y := 0
+ 	    else begin
+ 		x := x - 1073741824;
+ 		y := 1
+ 	    end; {123:}
+ 	    repeat
+ 		x := x + x;
+ 		y := y + y;
+ 		if x >= 1073741824 then begin
+ 		    x := x - 1073741824;
+ 		    y := y + 1
+ 		end;
+ 		x := x + x;
+ 		y := (y + y) - q;
+ 		q := q + q;
+ 		if x >= 1073741824 then begin
+ 		    x := x - 1073741824;
+ 		    y := y + 1
+ 		end;
+ 		if y > q then begin
+ 		    y := y - q;
+ 		    q := q + 2
+ 		end else if y <= 0 then begin
+ 		    q := q - 2;
+ 		    y := y + q
+ 		end;
+ 		k := k - 1 {:123}
+ 	    until k = 0;
+ 	    squarert := q div 2
+ 	end
+     end; {:121}
+ {124:}
+ 
+     function pythadd(a, b: integer): integer;
+     label
+ 	30;
+     var
+ 	r: fraction;
+ 	big: boolean;
+     begin
+ 	a := abs(a);
+ 	b := abs(b);
+ 	if a < b then begin
+ 	    r := b;
+ 	    b := a;
+ 	    a := r
+ 	end;
+ 	if a > 0 then begin
+ 	    if a < 536870912 then 
+ 		big := false
+ 	    else begin
+ 		a := a div 4;
+ 		b := b div 4;
+ 		big := true
+ 	    end; {125:}
+ 	    while true do begin
+ 		r := makefraction(b, a);
+ 		r := takefraction(r, r);
+ 		if r = 0 then 
+ 		    goto 30;
+ 		r := makefraction(r, 1073741824 + r);
+ 		a := a + takefraction(a + a, r);
+ 		b := takefraction(b, r)
+ 	    end;
+     30: {:125}
+ 	    ;
+ 	    if big then 
+ 		if a < 536870912 then 
+ 		    a := ((a + a) + a) + a
+ 		else begin
+ 		    aritherror := true;
+ 		    a := 2147483647
+ 		end
+ 	end;
+ 	pythadd := a
+     end; {:124} {126:}
+ 
+     function pythsub(a, b: integer): integer;
+     label
+ 	30;
+     var
+ 	r: fraction;
+ 	big: boolean;
+     begin
+ 	a := abs(a);
+ 	b := abs(b);
+ 	if a <= b then begin {128:}
+ 	    if a < b then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(180)
+ 		end;
+ 		printscaled(a);
+ 		print(181);
+ 		printscaled(b);
+ 		print(177);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 178;
+ 		    helpline[0] := 179
+ 		end;
+ 		error
+ 	    end;
+ 	    a := 0
+ 	end else begin {:128}
+ 	    if a < 1073741824 then 
+ 		big := false
+ 	    else begin
+ 		a := a div 2;
+ 		b := b div 2;
+ 		big := true
+ 	    end; {127:}
+ 	    while true do begin
+ 		r := makefraction(b, a);
+ 		r := takefraction(r, r);
+ 		if r = 0 then 
+ 		    goto 30;
+ 		r := makefraction(r, 1073741824 - r);
+ 		a := a - takefraction(a + a, r);
+ 		b := takefraction(b, r)
+ 	    end;
+     30: {:127}
+ 	    ;
+ 	    if big then 
+ 		a := a + a
+ 	end;
+ 	pythsub := a
+     end; {:126} {132:}
+ 
+     function mlog(x: scaled): scaled;
+     var
+ 	y, z: integer;
+ 	k: integer;
+     begin
+ 	if x <= 0 then begin {134:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(182)
+ 	    end;
+ 	    printscaled(x);
+ 	    print(177);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 183;
+ 		helpline[0] := 179
+ 	    end;
+ 	    error;
+ 	    mlog := 0
+ 	end else begin {:134}
+ 	    y := 1302456860;
+ 	    z := 6581195;
+ 	    while x < 1073741824 do begin
+ 		x := x + x;
+ 		y := y - 93032639;
+ 		z := z - 48782
+ 	    end;
+ 	    y := y + (z div 65536);
+ 	    k := 2;
+ 	    while x > 1073741828 do begin {133:}
+ 		z := ((x - 1) div twotothe[k]) + 1;
+ 		while x < (1073741824 + z) do begin
+ 		    z := (z + 1) div 2;
+ 		    k := k + 1
+ 		end;
+ 		y := y + speclog[k];
+ 		x := x - z
+ 	    end {:133};
+ 	    mlog := y div 8
+ 	end
+     end; {:132} {135:}
+ 
+     function mexp(x: scaled): scaled;
+     var
+ 	k: smallnumber;
+ 	y, z: integer;
+     begin
+ 	if x > 174436200 then begin
+ 	    aritherror := true;
+ 	    mexp := 2147483647
+ 	end else if x < (-197694359) then 
+ 	    mexp := 0
+ 	else begin
+ 	    if x <= 0 then begin
+ 		z := -(8 * x);
+ 		y := 1048576
+ 	    end else begin
+ 		if x <= 127919879 then 
+ 		    z := 1023359037 - (8 * x)
+ 		else 
+ 		    z := 8 * (174436200 - x);
+ 		y := 2147483647
+ 	    end; {136:}
+ 	    k := 1;
+ 	    while z > 0 do begin
+ 		while z >= speclog[k] do begin
+ 		    z := z - speclog[k];
+ 		    y := (y - 1) - ((y - twotothe[k - 1]) div twotothe[k])
+ 		end;
+ 		k := k + 1
+ 	    end {:136};
+ 	    if x <= 127919879 then 
+ 		mexp := (y + 8) div 16
+ 	    else 
+ 		mexp := y
+ 	end
+     end; {:135} {139:}
+ 
+     function narg(x, y: integer): angle;
+     var
+ 	z: angle;
+ 	t: integer;
+ 	k: smallnumber;
+ 	octant: 1..8;
+     begin
+ 	if x >= 0 then 
+ 	    octant := 1
+ 	else begin
+ 	    x := -x;
+ 	    octant := 2
+ 	end;
+ 	if y < 0 then begin
+ 	    y := -y;
+ 	    octant := octant + 2
+ 	end;
+ 	if x < y then begin
+ 	    t := y;
+ 	    y := x;
+ 	    x := t;
+ 	    octant := octant + 4
+ 	end;
+ 	if x = 0 then begin {140:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(184)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 185;
+ 		helpline[0] := 179
+ 	    end;
+ 	    error;
+ 	    narg := 0
+ 	end else begin {:140} {142:}
+ 	    while x >= 536870912 do begin
+ 		x := x div 2;
+ 		y := y div 2
+ 	    end;
+ 	    z := 0;
+ 	    if y > 0 then begin
+ 		while x < 268435456 do begin
+ 		    x := x + x;
+ 		    y := y + y
+ 		end; {143:}
+ 		k := 0;
+ 		repeat
+ 		    y := y + y;
+ 		    k := k + 1;
+ 		    if y > x then begin
+ 			z := z + specatan[k];
+ 			t := x;
+ 			x := x + (y div twotothe[k + k]);
+ 			y := y - t
+ 		    end
+ 		until k = 15;
+ 		repeat
+ 		    y := y + y;
+ 		    k := k + 1;
+ 		    if y > x then begin
+ 			z := z + specatan[k];
+ 			y := y - x
+ 		    end
+ 		until k = 26 {:143}
+ 	    end {:142}; {141:}
+ 	    case octant of
+ 		1:
+ 		    narg := z;
+ 		5:
+ 		    narg := 94371840 - z;
+ 		6:
+ 		    narg := 94371840 + z;
+ 		2:
+ 		    narg := 188743680 - z;
+ 		4:
+ 		    narg := z - 188743680;
+ 		8:
+ 		    narg := (-z) - 94371840;
+ 		7:
+ 		    narg := z - 94371840;
+ 		3:
+ 		    narg := -z
+ 	    end {:141}
+ 	end
+     end; {:139} {145:}
+ 
+     procedure nsincos(z: angle);
+     var
+ 	k: smallnumber;
+ 	q: 0..7;
+ 	r: fraction;
+ 	x, y, t: integer;
+     begin
+ 	while z < 0 do 
+ 	    z := z + 377487360;
+ 	z := z mod 377487360;
+ 	q := z div 47185920;
+ 	z := z mod 47185920;
+ 	x := 268435456;
+ 	y := x;
+ 	if not odd(q) then 
+ 	    z := 47185920 - z; {147:}
+ 	k := 1;
+ 	while z > 0 do begin
+ 	    if z >= specatan[k] then begin
+ 		z := z - specatan[k];
+ 		t := x;
+ 		x := t + (y div twotothe[k]);
+ 		y := y - (t div twotothe[k])
+ 	    end;
+ 	    k := k + 1
+ 	end;
+ 	if y < 0 then 
+ 	    y := 0 {:147}; {146:}
+ 	case q of
+ 	    0:
+ 		;
+ 	    1:
+ 		begin
+ 		    t := x;
+ 		    x := y;
+ 		    y := t
+ 		end;
+ 	    2:
+ 		begin
+ 		    t := x;
+ 		    x := -y;
+ 		    y := t
+ 		end;
+ 	    3:
+ 		x := -x;
+ 	    4:
+ 		begin
+ 		    x := -x;
+ 		    y := -y
+ 		end;
+ 	    5:
+ 		begin
+ 		    t := x;
+ 		    x := -y;
+ 		    y := -t
+ 		end;
+ 	    6:
+ 		begin
+ 		    t := x;
+ 		    x := y;
+ 		    y := -t
+ 		end;
+ 	    7:
+ 		y := -y
+ 	end {:146};
+ 	r := pythadd(x, y);
+ 	ncos := makefraction(x, r);
+ 	nsin := makefraction(y, r)
+     end; {:145} {149:}
+ 
+     procedure newrandoms;
+     var
+ 	k: 0..54;
+ 	x: fraction;
+     begin
+ 	for k := 0 to 23 do begin
+ 	    x := randoms[k] - randoms[k + 31];
+ 	    if x < 0 then 
+ 		x := x + 268435456;
+ 	    randoms[k] := x
+ 	end;
+ 	for k := 24 to 54 do begin
+ 	    x := randoms[k] - randoms[k - 24];
+ 	    if x < 0 then 
+ 		x := x + 268435456;
+ 	    randoms[k] := x
+ 	end;
+ 	jrandom := 54
+     end; {:149}
+ {150:}
+ 
+     procedure initrandoms(seed: scaled);
+     var
+ 	j, jj, k: fraction;
+ 	i: 0..54;
+     begin
+ 	j := abs(seed);
+ 	while j >= 268435456 do 
+ 	    j := j div 2;
+ 	k := 1;
+ 	for i := 0 to 54 do begin
+ 	    jj := k;
+ 	    k := j - k;
+ 	    j := jj;
+ 	    if k < 0 then 
+ 		k := k + 268435456;
+ 	    randoms[(i * 21) mod 55] := j
+ 	end;
+ 	newrandoms;
+ 	newrandoms;
+ 	newrandoms
+     end; {:150}
+ {151:}
+ 
+     function unifrand(x: scaled): scaled;
+     var
+ 	y: scaled;
+     begin
+ 	if jrandom = 0 then 
+ 	    newrandoms
+ 	else 
+ 	    jrandom := jrandom - 1;
+ 	y := takefraction(abs(x), randoms[jrandom]);
+ 	if y = abs(x) then 
+ 	    unifrand := 0
+ 	else if x > 0 then 
+ 	    unifrand := y
+ 	else 
+ 	    unifrand := -y
+     end; {:151} {152:}
+ 
+     function normrand: scaled;
+     var
+ 	x, u, l: integer;
+     begin
+ 	repeat
+ 	    repeat
+ 		if jrandom = 0 then 
+ 		    newrandoms
+ 		else 
+ 		    jrandom := jrandom - 1;
+ 		x := takefraction(112429, randoms[jrandom] - 134217728);
+ 		if jrandom = 0 then 
+ 		    newrandoms
+ 		else 
+ 		    jrandom := jrandom - 1;
+ 		u := randoms[jrandom]
+ 	    until abs(x) < u;
+ 	    x := makefraction(x, u);
+ 	    l := 139548960 - mlog(u)
+ 	until abvscd(1024, l, x, x) >= 0;
+ 	normrand := x
+     end; {:152}
+ {157:}
+     {procedure printword(w:memoryword);begin printint(w.int);
+     printchar(32);printscaled(w.int);printchar(32);
+     printscaled(w.int div 4096);println;printint(w.hh.lh);printchar(61);
+     printint(w.hh.b0);printchar(58);printint(w.hh.b1);printchar(59);
+     printint(w.hh.rh);printchar(32);printint(w.qqqq.b0);printchar(58);
+     printint(w.qqqq.b1);printchar(58);printint(w.qqqq.b2);printchar(58);
+     printint(w.qqqq.b3);end;}
+     {:157}
+     {162:}
+     {217:}
+ 
+     procedure printcapsule;
+     forward;
+ 
+     procedure showtokenlist(p, q: integer; l, nulltally: integer);
+     label
+ 	10;
+     var
+ 	class, c: smallnumber;
+ 	r, v: integer;
+     begin
+ 	class := 3;
+ 	tally := nulltally;
+ 	while (p <> (-30000)) and (tally < l) do begin
+ 	    if p = q then begin {646:}
+ 		firstcount := tally;
+ 		trickcount := ((tally + 1) + errorline) - halferrorline;
+ 		if trickcount < errorline then 
+ 		    trickcount := errorline
+ 	    end {:646}; {218:}
+ 	    c := 9;
+ 	    if (p < (-30000)) or (p > memend) then begin
+ 		print(360);
+ 		goto 10
+ 	    end;
+ 	    if p < himemmin then  {219:}
+ 		if mem[p].hh.b1 = 12 then 
+ 		    if mem[p].hh.b0 = 16 then begin {220:}
+ 			if class = 0 then 
+ 			    printchar(32);
+ 			v := mem[p + 1].int;
+ 			if v < 0 then begin
+ 			    if class = 17 then 
+ 				printchar(32);
+ 			    printchar(91);
+ 			    printscaled(v);
+ 			    printchar(93);
+ 			    c := 18
+ 			end else begin
+ 			    printscaled(v);
+ 			    c := 0
+ 			end
+ 		    end else if mem[p].hh.b0 <> 4 then  {:220}
+ 			print(363)
+ 		    else begin
+ 			printchar(34);
+ 			slowprint(mem[p + 1].int);
+ 			printchar(34);
+ 			c := 4
+ 		    end
+ 		else if ((mem[p].hh.b1 <> 11) or (mem[p].hh.b0 < 1)) or (mem[p].hh.b0 > 19) then 
+ 		    print(363)
+ 		else begin
+ 		    gpointer := p;
+ 		    printcapsule;
+ 		    c := 8
+ 		end {:219}
+ 	    else begin
+ 		r := mem[p].hh.lh;
+ 		if r >= 2242 then begin {222:}
+ 		    if r < 2392 then begin
+ 			print(365);
+ 			r := r - 2242
+ 		    end else if r < 2542 then begin
+ 			print(366);
+ 			r := r - 2392
+ 		    end else begin
+ 			print(367);
+ 			r := r - 2542
+ 		    end;
+ 		    printint(r);
+ 		    printchar(41);
+ 		    c := 8
+ 		end else if r < 1 then  {:222}
+ 		    if r = 0 then begin {221:}
+ 			if class = 17 then 
+ 			    printchar(32);
+ 			print(364);
+ 			c := 18
+ 		    end else  {:221}
+ 			print(361)
+ 		else begin
+ 		    r := hash[r].rh;
+ 		    if (r < 0) or (r >= strptr) then 
+ 			print(362) {223:}
+ 		    else begin
+ 			c := charclass[strpool[strstart[r]]];
+ 			if c = class then 
+ 			    if c in
+ 				[9, 5, 6, 7, 8] then
+ 				case c of
+ 				    9:
+ 					printchar(46);
+ 				    5, 6, 7, 8:
+ 				end
+ 			    else
+ 				printchar(32);
+ 			print(r)
+ 		    end {:223}
+ 		end
+ 	    end {:218};
+ 	    class := c;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	if p <> (-30000) then 
+ 	    print(359);
+     10:
+ 	
+     end; {:217} {665:}
+ 
+     procedure runaway;
+     begin
+ 	if scannerstatus > 2 then begin
+ 	    printnl(503);
+ 	    case scannerstatus of
+ 		3:
+ 		    print(504);
+ 		4, 5:
+ 		    print(505);
+ 		6:
+ 		    print(506)
+ 	    end;
+ 	    println;
+ 	    showtokenlist(mem[29998].hh.rh, -30000, errorline - 10, 0)
+ 	end
+     end; { runaway }
+ {:665}
+     {:162}
+     {163:}
+ 
+     function getavail: halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := avail;
+ 	if p <> (-30000) then 
+ 	    avail := mem[avail].hh.rh
+ 	else if memend < memmax then begin
+ 	    memend := memend + 1;
+ 	    p := memend
+ 	end else begin
+ 	    himemmin := himemmin - 1;
+ 	    p := himemmin;
+ 	    if himemmin <= lomemmax then begin
+ 		runaway;
+ 		overflow(186, memmax + 30001)
+ 	    end
+ 	end;
+ 	mem[p].hh.rh := -30000;
+ {dynused:=dynused+1;}
+ 	getavail := p
+     end; {:163} {167:}
+ 
+     function getnode(s: integer): halfword;
+     label
+ 	40, 10, 20;
+     var
+ 	p: halfword;
+ 	q: halfword;
+ 	r: integer;
+ 	t, tt: integer;
+     begin
+     20:
+ 	p := rover; {169:}
+ 	repeat
+ 	    q := p + mem[p].hh.lh;
+ 	    while mem[q].hh.rh = 32767 do begin
+ 		t := mem[q + 1].hh.rh;
+ 		tt := mem[q + 1].hh.lh;
+ 		if q = rover then 
+ 		    rover := t;
+ 		mem[t + 1].hh.lh := tt;
+ 		mem[tt + 1].hh.rh := t;
+ 		q := q + mem[q].hh.lh
+ 	    end;
+ 	    r := q - s;
+ 	    if r > (p + 1) then begin {170:}
+ 		mem[p].hh.lh := r - p;
+ 		rover := p;
+ 		goto 40
+ 	    end {:170};
+ 	    {171
+ 	    :}
+ 	    if r = p then 
+ 		if (mem[p + 1].hh.rh <> rover) or (mem[p + 1].hh.lh <> rover) then begin
+ 		    rover := mem[p + 1].hh.rh;
+ 		    t := mem[p + 1].hh.lh;
+ 		    mem[rover + 1].hh.lh := t;
+ 		    mem[t + 1].hh.rh := rover;
+ 		    goto 40
+ 		end {:171};
+ 	    mem[p].hh.lh := q - p {:169};
+ 	    p := mem[p + 1].hh.rh
+ 	until p = rover;
+ 	if s = 1073741824 then begin
+ 	    getnode := 32767;
+ 	    goto 10
+ 	end;
+ 	if (lomemmax + 2) < himemmin then 
+ 	    if (lomemmax + 2) <= 2767 then begin {168:}
+ 		if (lomemmax + 1000) < himemmin then 
+ 		    t := lomemmax + 1000
+ 		else 
+ 		    t := ((lomemmax + himemmin) + 2) div 2;
+ 		if t > 2767 then 
+ 		    t := 2767;
+ 		p := mem[rover + 1].hh.lh;
+ 		q := lomemmax;
+ 		mem[p + 1].hh.rh := q;
+ 		mem[rover + 1].hh.lh := q;
+ 		mem[q + 1].hh.rh := rover;
+ 		mem[q + 1].hh.lh := p;
+ 		mem[q].hh.rh := 32767;
+ 		mem[q].hh.lh := t - lomemmax;
+ 		lomemmax := t;
+ 		mem[lomemmax].hh.rh := -30000;
+ 		mem[lomemmax].hh.lh := -30000;
+ 		rover := q;
+ 		goto 20
+ 	    end {:168};
+ 	overflow(186, memmax + 30001);
+     40:
+ 	mem[r].hh.rh := -30000; {varused:=varused+s;}
+ 	getnode := r;
+     10:
+ 	
+     end; {:167} {172:}
+ 
+     procedure freenode(p: halfword; s: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	mem[p].hh.lh := s;
+ 	mem[p].hh.rh := 32767;
+ 	q := mem[rover + 1].hh.lh;
+ 	mem[p + 1].hh.lh := q;
+ 	mem[p + 1].hh.rh := rover;
+ 	mem[rover + 1].hh.lh := p;
+ 	mem[q + 1].hh.rh := p
+     end; {varused:=varused-s;} {:172}
+ {173:}
+     {procedure sortavail;var p,q,r:halfword;oldrover:halfword;
+     begin p:=getnode(1073741824);p:=mem[rover+1].hh.rh;
+     mem[rover+1].hh.rh:=32767;oldrover:=rover;
+     while p<>oldrover do[174:]if p<rover then begin q:=p;p:=mem[q+1].hh.rh;
+     mem[q+1].hh.rh:=rover;rover:=q;end else begin q:=rover;
+     while mem[q+1].hh.rh<p do q:=mem[q+1].hh.rh;r:=mem[p+1].hh.rh;
+     mem[p+1].hh.rh:=mem[q+1].hh.rh;mem[q+1].hh.rh:=p;p:=r;end[:174];
+     p:=rover;
+     while mem[p+1].hh.rh<>32767 do begin mem[mem[p+1].hh.rh+1].hh.lh:=p;
+     p:=mem[p+1].hh.rh;end;mem[p+1].hh.rh:=rover;mem[rover+1].hh.lh:=p;end;}
+ {:173}
+     {177:}
+ 
+     procedure flushlist(p: halfword);
+     label
+ 	30;
+     var
+ 	q, r: halfword;
+     begin
+ 	if p >= himemmin then 
+ 	    if p <> 30000 then begin
+ 		r := p;
+ 		repeat
+ 		    q := r;
+ 		    r := mem[r].hh.rh; {dynused:=dynused-1;}
+ 		    if r < himemmin then 
+ 			goto 30
+ 		until r = 30000;
+     30:
+ 		mem[q].hh.rh := avail;
+ 		avail := p
+ 	    end
+     end; { flushlist }
+ 
+     procedure flushnodelist(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	while p <> (-30000) do begin
+ 	    q := p;
+ 	    p := mem[p].hh.rh;
+ 	    if q < himemmin then 
+ 		freenode(q, 2)
+ 	    else begin
+ 		mem[q].hh.rh := avail;
+ 		avail := q
+ 	    end
+ {dynused:=dynused-1;}
+ 	end
+     end; {:177} {180:}
+ {procedure checkmem(printlocs:boolean);label 31,32;var p,q,r:halfword;
+ clobbered:boolean;begin for p:=-30000 to lomemmax do freearr[p]:=false;
+ for p:=himemmin to memend do freearr[p]:=false;[181:]p:=avail;q:=-30000;
+ clobbered:=false;
+ while p<>-30000 do begin if(p>memend)or(p<himemmin)then clobbered:=true
+ else if freearr[p]then clobbered:=true;
+ if clobbered then begin printnl(187);printint(q);goto 31;end;
+ freearr[p]:=true;q:=p;p:=mem[q].hh.rh;end;31:[:181];[182:]p:=rover;
+ q:=-30000;clobbered:=false;
+ repeat if(p>=lomemmax)or(p<-30000)then clobbered:=true else if(mem[p+1].
+ hh.rh>=lomemmax)or(mem[p+1].hh.rh<-30000)then clobbered:=true else if
+ not((mem[p].hh.rh=32767))or(mem[p].hh.lh<2)or(p+mem[p].hh.lh>lomemmax)or
+ (mem[mem[p+1].hh.rh+1].hh.lh<>p)then clobbered:=true;
+ if clobbered then begin printnl(188);printint(q);goto 32;end;
+ for q:=p to p+mem[p].hh.lh-1 do begin if freearr[q]then begin printnl(
+ 189);printint(q);goto 32;end;freearr[q]:=true;end;q:=p;
+ p:=mem[p+1].hh.rh;until p=rover;32:[:182];[183:]p:=-30000;
+ while p<=lomemmax do begin if(mem[p].hh.rh=32767)then begin printnl(190)
+ ;printint(p);end;while(p<=lomemmax)and not freearr[p]do p:=p+1;
+ while(p<=lomemmax)and freearr[p]do p:=p+1;end[:183];[617:]q:=-29987;
+ p:=mem[q].hh.rh;
+ while p<>-29987 do begin if mem[p+1].hh.lh<>q then begin printnl(463);
+ printint(p);end;p:=mem[p+1].hh.rh;r:=himemmin;
+ repeat if mem[p].hh.lh>=r then begin printnl(464);printint(p);end;
+ r:=mem[p].hh.lh;q:=p;p:=mem[q].hh.rh;until r=-30000;end[:617];
+ if printlocs then[184:]begin printnl(191);
+ for p:=-30000 to lomemmax do if not freearr[p]and((p>waslomax)or wasfree
+ [p])then begin printchar(32);printint(p);end;
+ for p:=himemmin to memend do if not freearr[p]and((p<washimin)or(p>
+ wasmemend)or wasfree[p])then begin printchar(32);printint(p);end;
+ end[:184];for p:=-30000 to lomemmax do wasfree[p]:=freearr[p];
+ for p:=himemmin to memend do wasfree[p]:=freearr[p];wasmemend:=memend;
+ waslomax:=lomemmax;washimin:=himemmin;end;}
+     {:180}
+     {185:}
+ {procedure searchmem(p:halfword);var q:integer;
+ begin for q:=-30000 to lomemmax do begin if mem[q].hh.rh=p then begin
+ printnl(192);printint(q);printchar(41);end;
+ if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end;
+ end;
+ for q:=himemmin to memend do begin if mem[q].hh.rh=p then begin printnl(
+ 192);printint(q);printchar(41);end;
+ if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end;
+ end;
+ [209:]for q:=1 to 2241 do begin if eqtb[q].rh=p then begin printnl(328);
+ printint(q);printchar(41);end;end[:209];end;}
+     {:185}
+     {189:}
+ 
+     procedure printop(c: quarterword);
+     begin
+ 	if c <= 15 then 
+ 	    printtype(c)
+ 	else 
+ 	    if c in
+ 		[30, 31, 32, 33, 34, 35, 36, 37,
+ 		 38, 39, 40, 41, 42, 43, 44, 45,
+ 		 46, 47, 48, 49, 50, 51, 52, 53,
+ 		 54, 55, 56, 57, 58, 59, 60, 61,
+ 		 62, 63, 64, 65, 66, 67, 68, 69,
+ 		 70, 71, 72, 73, 74, 75, 76, 77,
+ 		 78, 79, 80, 81, 82, 83, 84, 85,
+ 		 86, 87, 88, 89, 90, 91, 92, 94,
+ 		 95, 96, 97, 98, 99, 100] then
+ 		case c of
+ 		    30:
+ 			print(218);
+ 		    31:
+ 			print(219);
+ 		    32:
+ 			print(220);
+ 		    33:
+ 			print(221);
+ 		    34:
+ 			print(222);
+ 		    35:
+ 			print(223);
+ 		    36:
+ 			print(224);
+ 		    37:
+ 			print(225);
+ 		    38:
+ 			print(226);
+ 		    39:
+ 			print(227);
+ 		    40:
+ 			print(228);
+ 		    41:
+ 			print(229);
+ 		    42:
+ 			print(230);
+ 		    43:
+ 			print(231);
+ 		    44:
+ 			print(232);
+ 		    45:
+ 			print(233);
+ 		    46:
+ 			print(234);
+ 		    47:
+ 			print(235);
+ 		    48:
+ 			print(236);
+ 		    49:
+ 			print(237);
+ 		    50:
+ 			print(238);
+ 		    51:
+ 			print(239);
+ 		    52:
+ 			print(240);
+ 		    53:
+ 			print(241);
+ 		    54:
+ 			print(242);
+ 		    55:
+ 			print(243);
+ 		    56:
+ 			print(244);
+ 		    57:
+ 			print(245);
+ 		    58:
+ 			print(246);
+ 		    59:
+ 			print(247);
+ 		    60:
+ 			print(248);
+ 		    61:
+ 			print(249);
+ 		    62:
+ 			print(250);
+ 		    63:
+ 			print(251);
+ 		    64:
+ 			print(252);
+ 		    65:
+ 			print(253);
+ 		    66:
+ 			print(254);
+ 		    67:
+ 			print(255);
+ 		    68:
+ 			print(256);
+ 		    69:
+ 			printchar(43);
+ 		    70:
+ 			printchar(45);
+ 		    71:
+ 			printchar(42);
+ 		    72:
+ 			printchar(47);
+ 		    73:
+ 			print(257);
+ 		    74:
+ 			print(181);
+ 		    75:
+ 			print(258);
+ 		    76:
+ 			print(259);
+ 		    77:
+ 			printchar(60);
+ 		    78:
+ 			print(260);
+ 		    79:
+ 			printchar(62);
+ 		    80:
+ 			print(261);
+ 		    81:
+ 			printchar(61);
+ 		    82:
+ 			print(262);
+ 		    83:
+ 			print(38);
+ 		    84:
+ 			print(263);
+ 		    85:
+ 			print(264);
+ 		    86:
+ 			print(265);
+ 		    87:
+ 			print(266);
+ 		    88:
+ 			print(267);
+ 		    89:
+ 			print(268);
+ 		    90:
+ 			print(269);
+ 		    91:
+ 			print(270);
+ 		    92:
+ 			print(271);
+ 		    94:
+ 			print(272);
+ 		    95:
+ 			print(273);
+ 		    96:
+ 			print(274);
+ 		    97:
+ 			print(275);
+ 		    98:
+ 			print(276);
+ 		    99:
+ 			print(277);
+ 		    100:
+ 			print(278)
+ 		end
+ 	    else
+ 		print(279)
+     end; { printop }
+ {:189}
+     {194:}
+ 
+     procedure fixdateandtime;
+     begin
+ 	dateandtime(internal[17], internal[16], internal[15], internal[14]);
+ 	internal[17] := internal[17] * 65536;
+ 	internal[16] := internal[16] * 65536;
+ 	internal[15] := internal[15] * 65536;
+ 	internal[14] := internal[14] * 65536;
+ 	{----------------------------------}
+ 	 lastyearval := internal[14];
+ 	 lastmonthval:= internal[15];
+         {----------------------------------}
+     end; { fixdateandtime }
+ {:194}
+     {205:}
+ 
+     function idlookup(j, l: integer): halfword;
+     label
+ 	40;
+     var
+ 	h: integer;
+ 	p: halfword;
+ 	k: halfword;
+     begin
+ 	if l = 1 then begin {206:}
+ 	    p := buffer[j] + 1;
+ 	    hash[p].rh := p - 1;
+ 	    goto 40
+ 	end {:206}; {208:}
+ 	h := buffer[j];
+ 	for k := j + 1 to (j + l) - 1 do begin
+ 	    h := (h + h) + buffer[k];
+ 	    while h >= 1777 do 
+ 		h := h - 1777
+ 	end {:208};
+ 	p := h + 129;
+ 	while true do begin
+ 	    if hash[p].rh > 0 then 
+ 		if (strstart[hash[p].rh + 1] - strstart[hash[p].rh]) = l then 
+ 		    if streqbuf(hash[p].rh, j) then 
+ 			goto 40;
+ 	    if hash[p].lh = 0 then begin {207:}
+ 		if hash[p].rh > 0 then begin
+ 		    repeat
+ 			if hashused = 1 then 
+ 			    overflow(327, 2100);
+ 			hashused := hashused - 1
+ 		    until hash[hashused].rh = 0;
+ 		    hash[p].lh := hashused;
+ 		    p := hashused
+ 		end;
+ 		begin
+ 		    if (poolptr + l) > maxpoolptr then begin
+ 			if (poolptr + l) > poolsize then 
+ 			    overflow(129, poolsize - initpoolptr);
+ 			maxpoolptr := poolptr + l
+ 		    end
+ 		end;
+ 		for k := j to (j + l) - 1 do begin
+ 		    strpool[poolptr] := buffer[k];
+ 		    poolptr := poolptr + 1
+ 		end;
+ 		hash[p].rh := makestring;
+ 		strref[hash[p].rh] := 127;
+ {stcount:=stcount+1;}
+ 		goto 40
+ 	    end {:207};
+ 	    p := hash[p].lh
+ 	end;
+     40:
+ 	idlookup := p
+     end; {:205} {210:}
+     {procedure primitive(s:strnumber;c:halfword;o:halfword);
+     var k:poolpointer;j:smallnumber;l:smallnumber;begin k:=strstart[s];
+     l:=strstart[s+1]-k;for j:=0 to l-1 do buffer[j]:=strpool[k+j];
+     cursym:=idlookup(0,l);if s>=128 then begin flushstring(strptr-1);
+     hash[cursym].rh:=s;end;eqtb[cursym].lh:=c;eqtb[cursym].rh:=o;end;}
+     {:210}
+ {215:}
+ 
+     function newnumtok(v: scaled): halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p + 1].int := v;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p].hh.b1 := 12;
+ 	newnumtok := p
+     end; {:215} {216:}
+ 
+     procedure tokenrecycle;
+     forward;
+ 
+     procedure flushtokenlist(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	while p <> (-30000) do begin
+ 	    q := p;
+ 	    p := mem[p].hh.rh;
+ 	    if q >= himemmin then begin
+ 		mem[q].hh.rh := avail;
+ 		avail := q
+ 	    end else begin
+ {dynused:=dynused-1;}
+ 		if mem[q].hh.b0 in
+ 		    [1, 2, 16, 4, 3, 5, 7, 12,
+ 		     10, 6, 9, 8, 11, 14, 13, 17,
+ 		     18, 19] then
+ 		    case mem[q].hh.b0 of
+ 			1, 2, 16:
+ 			    ;
+ 			4:
+ 			    begin
+ 				if strref[mem[q + 1].int] < 127 then 
+ 				    if strref[mem[q + 1].int] > 1 then 
+ 					strref[mem[q + 1].int] := strref[mem[q + 1].int] - 1
+ 				    else 
+ 					flushstring(mem[q + 1].int)
+ 			    end;
+ 			3, 5, 7, 12, 10, 6, 9,
+ 			8, 11, 14, 13, 17, 18, 19:
+ 			    begin
+ 				gpointer := q;
+ 				tokenrecycle
+ 			    end
+ 		    end
+ 		else
+ 		    confusion(358);
+ 		freenode(q, 2)
+ 	    end
+ 	end
+     end; { flushtokenlist }
+ {:216}
+     {226:}
+ 
+     procedure deletemacref(p: halfword);
+     begin
+ 	if mem[p].hh.lh = (-30000) then 
+ 	    flushtokenlist(p)
+ 	else 
+ 	    mem[p].hh.lh := mem[p].hh.lh - 1
+     end; {:226} {227:} {625:}
+ 
+     procedure printcmdmod(c, m: integer);
+     begin
+ 	if c in
+ 	    [18, 77, 59, 72, 32, 78, 79, 57,
+ 	     19, 60, 27, 11, 81, 26, 6, 9,
+ 	     70, 73, 13, 46, 63, 14, 15, 69,
+ 	     28, 47, 24, 7, 65, 64, 12, 8,
+ 	     80, 17, 74, 35, 58, 71, 75, 16,
+ 	     4, 61, 56, 3, 1, 2, 33, 34,
+ 	     37, 55, 45, 50, 36, 43, 54, 48,
+ 	     51, 52, 30, 82, 23, 21, 22, 31,
+ 	     62, 41, 10, 53, 44, 49, 5, 40,
+ 	     68, 66, 67, 25, 20, 76, 29] then
+ 	    case c of {212:}
+ 		18:
+ 		    print(330);
+ 		77:
+ 		    print(329);
+ 		59:
+ 		    print(332);
+ 		72:
+ 		    print(331);
+ 		32:
+ 		    print(333);
+ 		78:
+ 		    print(58);
+ 		79:
+ 		    print(44);
+ 		57:
+ 		    print(334);
+ 		19:
+ 		    print(335);
+ 		60:
+ 		    print(336);
+ 		27:
+ 		    print(337);
+ 		11:
+ 		    print(338);
+ 		81:
+ 		    print(323);
+ 		26:
+ 		    print(339);
+ 		6:
+ 		    print(340);
+ 		9:
+ 		    print(341);
+ 		70:
+ 		    print(342);
+ 		73:
+ 		    print(343);
+ 		13:
+ 		    print(344);
+ 		46:
+ 		    print(123);
+ 		63:
+ 		    print(91);
+ 		14:
+ 		    print(345);
+ 		15:
+ 		    print(346);
+ 		69:
+ 		    print(347);
+ 		28:
+ 		    print(348);
+ 		47:
+ 		    print(279);
+ 		24:
+ 		    print(349);
+ 		7:
+ 		    printchar(92);
+ 		65:
+ 		    print(125);
+ 		64:
+ 		    print(93);
+ 		12:
+ 		    print(350);
+ 		8:
+ 		    print(351);
+ 		80:
+ 		    print(59);
+ 		17:
+ 		    print(352);
+ 		74:
+ 		    print(353);
+ 		35:
+ 		    print(354);
+ 		58:
+ 		    print(355);
+ 		71:
+ 		    print(356);
+ 		75:
+ 		    print(357); {:212} {684:}
+ 		16:
+ 		    if m <= 2 then 
+ 			if m = 1 then 
+ 			    print(520)
+ 			else if m < 1 then 
+ 			    print(324)
+ 			else 
+ 			    print(521)
+ 		    else if m = 53 then 
+ 			print(522)
+ 		    else if m = 44 then 
+ 			print(523)
+ 		    else 
+ 			print(524);
+ 		4:
+ 		    if m <= 1 then 
+ 			if m = 1 then 
+ 			    print(527)
+ 			else 
+ 			    print(325)
+ 		    else if m = 2242 then 
+ 			print(525)
+ 		    else 
+ 			print(526); {:684} {689:}
+ 		61:
+ 		    if m in
+ 			[1, 2, 3] then
+ 			case m of
+ 			    1:
+ 				print(529);
+ 			    2:
+ 				printchar(64);
+ 			    3:
+ 				print(530)
+ 			end
+ 		    else
+ 			print(528); {:689} {696:}
+ 		56:
+ 		    if m >= 2242 then 
+ 			if m = 2242 then 
+ 			    print(541)
+ 			else if m = 2392 then 
+ 			    print(542)
+ 			else 
+ 			    print(543)
+ 		    else if m < 2 then 
+ 			print(544)
+ 		    else if m = 2 then 
+ 			print(545)
+ 		    else 
+ 			print(546); {:696} {710:}
+ 		3:
+ 		    if m = 0 then 
+ 			print(556)
+ 		    else 
+ 			print(482);
+ {:710}
+ 		{741:}
+ 		1, 2:
+ 		    if m in
+ 			[1, 2, 3] then
+ 			case m of
+ 			    1:
+ 				print(583);
+ 			    2:
+ 				print(322);
+ 			    3:
+ 				print(584)
+ 			end
+ 		    else
+ 			print(585); {:741} {894:}
+ 		33, 34, 37, 55, 45, 50, 36,
+ 		43, 54, 48, 51, 52:
+ 		    printop(m); {:894} {1014:}
+ 		30:
+ 		    printtype(m); {:1014} {1019:}
+ 		82:
+ 		    if m = 0 then 
+ 			print(776)
+ 		    else 
+ 			print(777);
+ {:1019}
+ 		{1025:}
+ 		23:
+ 		    if m in
+ 			[0, 1, 2] then
+ 			case m of
+ 			    0:
+ 				print(143);
+ 			    1:
+ 				print(144);
+ 			    2:
+ 				print(145)
+ 			end
+ 		    else
+ 			print(783); {:1025} {1028:}
+ 		21:
+ 		    if m = 0 then 
+ 			print(784)
+ 		    else 
+ 			print(785); {:1028} {1038:}
+ 		22:
+ 		    if m in
+ 			[0, 1, 2, 3] then
+ 			case m of
+ 			    0:
+ 				print(799);
+ 			    1:
+ 				print(800);
+ 			    2:
+ 				print(801);
+ 			    3:
+ 				print(802)
+ 			end
+ 		    else
+ 			print(803); {:1038} {1043:}
+ 		31, 62:
+ 		    begin
+ 			if c = 31 then 
+ 			    print(806)
+ 			else 
+ 			    print(807);
+ 			print(808);
+ 			print(hash[m].rh)
+ 		    end;
+ 		41:
+ 		    if m = (-30000) then 
+ 			print(809)
+ 		    else 
+ 			print(810);
+ 		10:
+ 		    print(811);
+ 		53, 44, 49:
+ 		    begin
+ 			printcmdmod(16, c);
+ 			print(812);
+ 			println;
+ 			showtokenlist(mem[mem[m].hh.rh].hh.rh, -30000, 1000, 0)
+ 		    end;
+ 		5:
+ 		    print(813);
+ 		40:
+ 		    print(intname[m]); {:1043} {1053:}
+ 		68:
+ 		    if m = 1 then 
+ 			print(820)
+ 		    else if m = 0 then 
+ 			print(821)
+ 		    else 
+ 			print(822);
+ 		66:
+ 		    if m = 6 then 
+ 			print(823)
+ 		    else 
+ 			print(824);
+ 		67:
+ 		    if m = 0 then 
+ 			print(825)
+ 		    else 
+ 			print(826); {:1053} {1080:}
+ 		25:
+ 		    if m < 1 then 
+ 			print(856)
+ 		    else if m = 1 then 
+ 			print(857)
+ 		    else 
+ 			print(858);
+ {:1080}
+ 		{1102:}
+ 		20:
+ 		    if m in
+ 			[0, 1, 2, 3] then
+ 			case m of
+ 			    0:
+ 				print(868);
+ 			    1:
+ 				print(869);
+ 			    2:
+ 				print(870);
+ 			    3:
+ 				print(871)
+ 			end
+ 		    else
+ 			print(872); {:1102} {1110:}
+ 		76:
+ 		    if m = 0 then 
+ 			print(889)
+ 		    else 
+ 			print(890); {:1110} {1180:}
+ 		29:
+ 		    if m = 16 then 
+ 			print(913)
+ 		    else 
+ 			print(912)
+ 	    end
+ 	else {:1180}
+ 	    print(468)
+     end; {:625}
+ 
+     procedure showmacro(p: halfword; q, l: integer);
+     label
+ 	10;
+     var
+ 	r: halfword;
+     begin
+ 	p := mem[p].hh.rh;
+ 	while mem[p].hh.lh > 7 do begin
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := -30000;
+ 	    showtokenlist(p, -30000, l, 0);
+ 	    mem[p].hh.rh := r;
+ 	    p := r;
+ 	    if l > 0 then 
+ 		l := l - tally
+ 	    else 
+ 		goto 10
+ 	end;
+ 	tally := 0;
+ 	case mem[p].hh.lh of
+ 	    0:
+ 		print(368);
+ 	    1, 2, 3:
+ 		begin
+ 		    printchar(60);
+ 		    printcmdmod(56, mem[p].hh.lh);
+ 		    print(369)
+ 		end;
+ 	    4:
+ 		print(370);
+ 	    5:
+ 		print(371);
+ 	    6:
+ 		print(372);
+ 	    7:
+ 		print(373)
+ 	end;
+ 	showtokenlist(mem[p].hh.rh, q, l - tally, 0);
+     10:
+ 	
+     end; {:227} {232:}
+ 
+     procedure initbignode(p: halfword);
+     var
+ 	q: halfword;
+ 	s: smallnumber;
+     begin
+ 	s := bignodesize[mem[p].hh.b0];
+ 	q := getnode(s);
+ 	repeat
+ 	    s := s - 2; {586:}
+ 	    begin
+ 		mem[q + s].hh.b0 := 19;
+ 		serialno := serialno + 64;
+ 		mem[(q + s) + 1].int := serialno
+ 	    end {:586};
+ 	    mem[q + s].hh.b1 := (s div 2) + 5;
+ 	    mem[q + s].hh.rh := -30000
+ 	until s = 0;
+ 	mem[q].hh.rh := p;
+ 	mem[p + 1].int := q
+     end; { initbignode }
+ {:232}
+     {233:}
+ 
+     function idtransform: halfword;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p].hh.b0 := 13;
+ 	mem[p].hh.b1 := 11;
+ 	mem[p + 1].int := -30000;
+ 	initbignode(p);
+ 	q := mem[p + 1].int;
+ 	r := q + 12;
+ 	repeat
+ 	    r := r - 2;
+ 	    mem[r].hh.b0 := 16;
+ 	    mem[r + 1].int := 0
+ 	until r = q;
+ 	mem[q + 5].int := 65536;
+ 	mem[q + 11].int := 65536;
+ 	idtransform := p
+     end; {:233} {234:}
+ 
+     procedure newroot(x: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p].hh.b0 := 0;
+ 	mem[p].hh.b1 := 0;
+ 	mem[p].hh.rh := x;
+ 	eqtb[x].rh := p
+     end; {:234}
+ {235:}
+ 
+     procedure printvariablename(p: halfword);
+     label
+ 	40, 10;
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	while mem[p].hh.b1 >= 5 do begin {237:}
+ 	    case mem[p].hh.b1 of
+ 		5:
+ 		    printchar(120);
+ 		6:
+ 		    printchar(121);
+ 		7:
+ 		    print(376);
+ 		8:
+ 		    print(377);
+ 		9:
+ 		    print(378);
+ 		10:
+ 		    print(379);
+ 		11:
+ 		    begin
+ 			print(380);
+ 			printint(p + 30000);
+ 			goto 10
+ 		    end
+ 	    end;
+ 	    print(381);
+ 	    p := mem[p - (2 * (mem[p].hh.b1 - 5))].hh.rh
+ 	end {:237};
+ 	q := -30000;
+ 	while mem[p].hh.b1 > 1 do begin {236:}
+ 	    if mem[p].hh.b1 = 3 then begin
+ 		r := newnumtok(mem[p + 2].int);
+ 		repeat
+ 		    p := mem[p].hh.rh
+ 		until mem[p].hh.b1 = 4
+ 	    end else if mem[p].hh.b1 = 2 then begin
+ 		p := mem[p].hh.rh;
+ 		goto 40
+ 	    end else begin
+ 		if mem[p].hh.b1 <> 4 then 
+ 		    confusion(375);
+ 		r := getavail;
+ 		mem[r].hh.lh := mem[p + 2].hh.lh
+ 	    end;
+ 	    mem[r].hh.rh := q;
+ 	    q := r;
+     40:
+ 	    p := mem[p + 2].hh.rh
+ 	end {:236};
+ 	r := getavail;
+ 	mem[r].hh.lh := mem[p].hh.rh;
+ 	mem[r].hh.rh := q;
+ 	if mem[p].hh.b1 = 1 then 
+ 	    print(374);
+ 	showtokenlist(r, -30000, 2147483647, tally);
+ 	flushtokenlist(r);
+     10:
+ 	
+     end; {:235}
+ {238:}
+ 
+     function interesting(p: halfword): boolean;
+     var
+ 	t: smallnumber;
+     begin
+ 	if internal[3] > 0 then 
+ 	    interesting := true
+ 	else begin
+ 	    t := mem[p].hh.b1;
+ 	    if t >= 5 then 
+ 		if t <> 11 then 
+ 		    t := mem[mem[p - (2 * (t - 5))].hh.rh].hh.b1;
+ 	    interesting := t <> 11
+ 	end
+     end; {:238} {239:}
+ 
+     function newstructure(p: halfword): halfword;
+     var
+ 	q, r: halfword;
+     begin
+ 	if mem[p].hh.b1 in
+ 	    [0, 3, 4] then
+ 	    case mem[p].hh.b1 of
+ 		0:
+ 		    begin
+ 			q := mem[p].hh.rh;
+ 			r := getnode(2);
+ 			eqtb[q].rh := r
+ 		    end;
+ 		3:
+ 		    begin {240:}
+ 			q := p;
+ 			repeat
+ 			    q := mem[q].hh.rh
+ 			until mem[q].hh.b1 = 4;
+ 			q := mem[q + 2].hh.rh;
+ 			r := q + 1;
+ 			repeat
+ 			    q := r;
+ 			    r := mem[r].hh.rh
+ 			until r = p;
+ 			r := getnode(3);
+ 			mem[q].hh.rh := r;
+ 			mem[r + 2].int := mem[p + 2].int
+ 		    end; {:240}
+ 		4:
+ 		    begin {241:}
+ 			q := mem[p + 2].hh.rh;
+ 			r := mem[q + 1].hh.lh;
+ 			repeat
+ 			    q := r;
+ 			    r := mem[r].hh.rh
+ 			until r = p;
+ 			r := getnode(3);
+ 			mem[q].hh.rh := r;
+ 			mem[r + 2] := mem[p + 2];
+ 			if mem[p + 2].hh.lh = 0 then begin
+ 			    q := mem[p + 2].hh.rh + 1;
+ 			    while mem[q].hh.rh <> p do 
+ 				q := mem[q].hh.rh;
+ 			    mem[q].hh.rh := r
+ 			end
+ 		    end
+ 	    end
+ 	else {:241}
+ 	    confusion(382);
+ 	mem[r].hh.rh := mem[p].hh.rh;
+ 	mem[r].hh.b0 := 21;
+ 	mem[r].hh.b1 := mem[p].hh.b1;
+ 	mem[r + 1].hh.lh := p;
+ 	mem[p].hh.b1 := 2;
+ 	q := getnode(3);
+ 	mem[p].hh.rh := q;
+ 	mem[r + 1].hh.rh := q;
+ 	mem[q + 2].hh.rh := r;
+ 	mem[q].hh.b0 := 0;
+ 	mem[q].hh.b1 := 4;
+ 	mem[q].hh.rh := -29983;
+ 	mem[q + 2].hh.lh := 0;
+ 	newstructure := r
+     end; {:239} {242:}
+ 
+     function findvariable(t: halfword): halfword;
+     label
+ 	10;
+     var
+ 	p, q, r, s: halfword;
+ 	pp, qq, rr, ss: halfword;
+ 	n: integer;
+ 	saveword: memoryword;
+     begin
+ 	p := mem[t].hh.lh;
+ 	t := mem[t].hh.rh;
+ 	if (eqtb[p].lh mod 83) <> 41 then begin
+ 	    findvariable := -30000;
+ 	    goto 10
+ 	end;
+ 	if eqtb[p].rh = (-30000) then 
+ 	    newroot(p);
+ 	p := eqtb[p].rh;
+ 	pp := p;
+ 	while t <> (-30000) do begin {243:}
+ 	    if mem[pp].hh.b0 <> 21 then begin
+ 		if mem[pp].hh.b0 > 21 then begin
+ 		    findvariable := -30000;
+ 		    goto 10
+ 		end;
+ 		ss := newstructure(pp);
+ 		if p = pp then 
+ 		    p := ss;
+ 		pp := ss
+ 	    end;
+ 	    if mem[p].hh.b0 <> 21 then 
+ 		p := newstructure(p) {:243};
+ 	    if t < himemmin then begin {244:}
+ 		n := mem[t + 1].int;
+ 		pp := mem[mem[pp + 1].hh.lh].hh.rh;
+ 		q := mem[mem[p + 1].hh.lh].hh.rh;
+ 		saveword := mem[q + 2];
+ 		mem[q + 2].int := 2147483647;
+ 		s := p + 1;
+ 		repeat
+ 		    r := s;
+ 		    s := mem[s].hh.rh
+ 		until n <= mem[s + 2].int;
+ 		if n = mem[s + 2].int then 
+ 		    p := s
+ 		else begin
+ 		    p := getnode(3);
+ 		    mem[r].hh.rh := p;
+ 		    mem[p].hh.rh := s;
+ 		    mem[p + 2].int := n;
+ 		    mem[p].hh.b1 := 3;
+ 		    mem[p].hh.b0 := 0
+ 		end;
+ 		mem[q + 2] := saveword
+ 	    end else begin {:244} {245:}
+ 		n := mem[t].hh.lh;
+ 		ss := mem[pp + 1].hh.lh;
+ 		repeat
+ 		    rr := ss;
+ 		    ss := mem[ss].hh.rh
+ 		until n <= mem[ss + 2].hh.lh;
+ 		if n < mem[ss + 2].hh.lh then begin
+ 		    qq := getnode(3);
+ 		    mem[rr].hh.rh := qq;
+ 		    mem[qq].hh.rh := ss;
+ 		    mem[qq + 2].hh.lh := n;
+ 		    mem[qq].hh.b1 := 4;
+ 		    mem[qq].hh.b0 := 0;
+ 		    mem[qq + 2].hh.rh := pp;
+ 		    ss := qq
+ 		end;
+ 		if p = pp then begin
+ 		    p := ss;
+ 		    pp := ss
+ 		end else begin
+ 		    pp := ss;
+ 		    s := mem[p + 1].hh.lh;
+ 		    repeat
+ 			r := s;
+ 			s := mem[s].hh.rh
+ 		    until n <= mem[s + 2].hh.lh;
+ 		    if n = mem[s + 2].hh.lh then 
+ 			p := s
+ 		    else begin
+ 			q := getnode(3);
+ 			mem[r].hh.rh := q;
+ 			mem[q].hh.rh := s;
+ 			mem[q + 2].hh.lh := n;
+ 			mem[q].hh.b1 := 4;
+ 			mem[q].hh.b0 := 0;
+ 			mem[q + 2].hh.rh := p;
+ 			p := q
+ 		    end
+ 		end
+ 	    end {:245};
+ 	    t := mem[t].hh.rh
+ 	end;
+ 	if mem[pp].hh.b0 >= 21 then 
+ 	    if mem[pp].hh.b0 = 21 then 
+ 		pp := mem[pp + 1].hh.lh
+ 	    else begin
+ 		findvariable := -30000;
+ 		goto 10
+ 	    end;
+ 	if mem[p].hh.b0 = 21 then 
+ 	    p := mem[p + 1].hh.lh;
+ 	if mem[p].hh.b0 = 0 then begin
+ 	    if mem[pp].hh.b0 = 0 then begin
+ 		mem[pp].hh.b0 := 15;
+ 		mem[pp + 1].int := -30000
+ 	    end;
+ 	    mem[p].hh.b0 := mem[pp].hh.b0;
+ 	    mem[p + 1].int := -30000
+ 	end;
+ 	findvariable := p;
+     10:
+ 	
+     end; {:242} {246:} {257:}
+ 
+     procedure printpath(h: halfword; s: strnumber; nuline: boolean);
+     label
+ 	30, 31;
+     var
+ 	p, q: halfword;
+     begin
+ 	printdiagnostic(384, s, nuline);
+ 	println;
+ 	p := h;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if (p = (-30000)) or (q = (-30000)) then begin
+ 		printnl(131);
+ 		goto 30
+ 	    end; {258:}
+ 	    printtwo(mem[p + 1].int, mem[p + 2].int);
+ 	    if mem[p].hh.b1 in
+ 		[0, 1, 4, 3, 2] then
+ 		case mem[p].hh.b1 of
+ 		    0:
+ 			begin
+ 			    if mem[p].hh.b0 = 4 then 
+ 				print(385);
+ 			    if (mem[q].hh.b0 <> 0) or (q <> h) then 
+ 				q := -30000;
+ 			    goto 31
+ 			end;
+ 		    1:
+ 			begin {261:}
+ 			    print(391);
+ 			    printtwo(mem[p + 5].int, mem[p + 6].int);
+ 			    print(390);
+ 			    if mem[q].hh.b0 <> 1 then 
+ 				print(392)
+ 			    else 
+ 				printtwo(mem[q + 3].int, mem[q + 4].int);
+ 			    goto 31
+ 			end; {:261}
+ 		    4: {262:}
+ 			if (mem[p].hh.b0 <> 1) and (mem[p].hh.b0 <> 4) then 
+ 			    print(385) {:262};
+ 		    3, 2:
+ 			begin {263:}
+ 			    if mem[p].hh.b0 = 4 then 
+ 				print(392);
+ 			    if mem[p].hh.b1 = 3 then begin
+ 				print(388);
+ 				printscaled(mem[p + 5].int)
+ 			    end else begin
+ 				nsincos(mem[p + 5].int);
+ 				printchar(123);
+ 				printscaled(ncos);
+ 				printchar(44);
+ 				printscaled(nsin)
+ 			    end;
+ 			    printchar(125)
+ 			end
+ 		end
+ 	    else {:263}
+ 		print(131);
+ 	    if mem[q].hh.b0 <= 1 then 
+ 		print(386)
+ 	    else if (mem[p + 6].int <> 65536) or (mem[q + 4].int <> 65536) then begin {260:}
+ 		print(389);
+ 		if mem[p + 6].int < 0 then 
+ 		    print(332);
+ 		printscaled(abs(mem[p + 6].int));
+ 		if mem[p + 6].int <> mem[q + 4].int then begin
+ 		    print(390);
+ 		    if mem[q + 4].int < 0 then 
+ 			print(332);
+ 		    printscaled(abs(mem[q + 4].int))
+ 		end
+ 	    end {:260};
+     31: {:258}
+ 	    ;
+ 	    p := q;
+ 	    if (p <> h) or (mem[h].hh.b0 <> 0) then begin {259:}
+ 		printnl(387);
+ 		if mem[p].hh.b0 = 2 then begin
+ 		    nsincos(mem[p + 3].int);
+ 		    printchar(123);
+ 		    printscaled(ncos);
+ 		    printchar(44);
+ 		    printscaled(nsin);
+ 		    printchar(125)
+ 		end else if mem[p].hh.b0 = 3 then begin
+ 		    print(388);
+ 		    printscaled(mem[p + 3].int);
+ 		    printchar(125)
+ 		end
+ 	    end {:259}
+ 	until p = h;
+ 	if mem[h].hh.b0 <> 0 then 
+ 	    print(256);
+     30:
+ 	enddiagnostic(true)
+     end; {:257}
+ {332:}
+     {333:}
+ 
+     procedure printweight(q: halfword; xoff: integer);
+     var
+ 	w, m: integer;
+ 	d: integer;
+     begin
+ 	d := mem[q].hh.lh + 32768;
+ 	w := d mod 8;
+ 	m := (d div 8) - mem[curedges + 3].hh.lh;
+ 	if fileoffset > (maxprintline - 9) then 
+ 	    printnl(32)
+ 	else 
+ 	    printchar(32);
+ 	printint(m + xoff);
+ 	while w > 4 do begin
+ 	    printchar(43);
+ 	    w := w - 1
+ 	end;
+ 	while w < 4 do begin
+ 	    printchar(45);
+ 	    w := w + 1
+ 	end
+     end; {:333}
+ 
+     procedure printedges(s: strnumber; nuline: boolean; xoff, yoff: integer);
+     var
+ 	p, q, r: halfword;
+ 	n: integer;
+     begin
+ 	printdiagnostic(399, s, nuline);
+ 	p := mem[curedges].hh.lh;
+ 	n := mem[curedges + 1].hh.rh - 4096;
+ 	while p <> curedges do begin
+ 	    q := mem[p + 1].hh.lh;
+ 	    r := mem[p + 1].hh.rh;
+ 	    if (q > (-29999)) or (r <> 30000) then begin
+ 		printnl(400);
+ 		printint(n + yoff);
+ 		printchar(58);
+ 		while q > (-29999) do begin
+ 		    printweight(q, xoff);
+ 		    q := mem[q].hh.rh
+ 		end;
+ 		print(401);
+ 		while r <> 30000 do begin
+ 		    printweight(r, xoff);
+ 		    r := mem[r].hh.rh
+ 		end
+ 	    end;
+ 	    p := mem[p].hh.lh;
+ 	    n := n - 1
+ 	end;
+ 	enddiagnostic(true)
+     end; {:332} {388:}
+ 
+     {---------------------------------------------------
+     procedure unskew(x, y: scaled; octant: smallnumber);
+ 
+     moved to mf2ps1.p
+     ---------------------------------------------------}
+ 
+     procedure printpen(p: halfword; s: strnumber; nuline: boolean);
+     var
+ 	nothingprinted: boolean;
+ 	k: 1..8;
+ 	h: halfword;
+ 	m, n: integer;
+ 	w, ww: halfword;
+     begin
+ 	printdiagnostic(436, s, nuline);
+ 	nothingprinted := true;
+ 	println;
+ 	for k := 1 to 8 do begin
+ 	    octant := octantcode[k];
+ 	    h := p + octant;
+ 	    n := mem[h].hh.lh;
+ 	    w := mem[h].hh.rh;
+ 	    if not odd(k) then 
+ 		w := mem[w].hh.lh;
+ 	    for m := 1 to n + 1 do begin
+ 		if odd(k) then 
+ 		    ww := mem[w].hh.rh
+ 		else 
+ 		    ww := mem[w].hh.lh;
+ 		if (mem[ww + 1].int <> mem[w + 1].int) or (mem[ww + 2].int <> mem[w + 2].int) then begin {474:}
+ 		    if nothingprinted then 
+ 			nothingprinted := false
+ 		    else 
+ 			printnl(438);
+ 		    unskew(mem[ww + 1].int, mem[ww + 2].int, octant);
+ 		    printtwo(curx, cury)
+ 		end {:474};
+ 		w := ww
+ 	    end
+ 	end;
+ 	if nothingprinted then begin
+ 	    w := mem[p + 1].hh.rh;
+ 	    printtwo(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int)
+ 	end;
+ 	printnl(437);
+ 	enddiagnostic(true)
+     end; {:473} {589:}
+ 
+     procedure printdependency(p: halfword; t: smallnumber);
+     label
+ 	10;
+     var
+ 	v: integer;
+ 	pp, q: halfword;
+     begin
+ 	pp := p;
+ 	while true do begin
+ 	    v := abs(mem[p + 1].int);
+ 	    q := mem[p].hh.lh;
+ 	    if q = (-30000) then begin
+ 		if (v <> 0) or (p = pp) then begin
+ 		    if mem[p + 1].int > 0 then 
+ 			if p <> pp then 
+ 			    printchar(43);
+ 		    printscaled(mem[p + 1].int)
+ 		end;
+ 		goto 10
+ 	    end;
+ {590:}
+ 	    if mem[p + 1].int < 0 then 
+ 		printchar(45)
+ 	    else if p <> pp then 
+ 		printchar(43);
+ 	    if t = 17 then 
+ 		v := roundfraction(v);
+ 	    if v <> 65536 then 
+ 		printscaled(v) {:590};
+ 	    if mem[q].hh.b0 <> 19 then 
+ 		confusion(454);
+ 	    printvariablename(q);
+ 	    v := mem[q + 1].int mod 64;
+ 	    while v > 0 do begin
+ 		print(455);
+ 		v := v - 2
+ 	    end;
+ 	    p := mem[p].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:589} {801:} {805:}
+ 
+     procedure printdp(t: smallnumber; p: halfword; verbosity: smallnumber);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	if (mem[q].hh.lh = (-30000)) or (verbosity > 0) then 
+ 	    printdependency(p, t)
+ 	else 
+ 	    print(628)
+     end; {:805} {799:}
+ 
+     function stashcurexp: halfword;
+     var
+ 	p: halfword;
+     begin
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    p := curexp
+ 	    end
+ 	else
+ 	    begin
+ 		p := getnode(2);
+ 		mem[p].hh.b1 := 11;
+ 		mem[p].hh.b0 := curtype;
+ 		mem[p + 1].int := curexp
+ 	    end;
+ 	curtype := 1;
+ 	mem[p].hh.rh := -29999;
+ 	stashcurexp := p
+     end; {:799} {800:}
+ 
+     procedure unstashcurexp(p: halfword);
+     begin
+ 	curtype := mem[p].hh.b0;
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    curexp := p
+ 	    end
+ 	else
+ 	    begin
+ 		curexp := mem[p + 1].int;
+ 		freenode(p, 2)
+ 	    end
+     end; {:800}
+ 
+     procedure printexp(p: halfword; verbosity: smallnumber);
+     var
+ 	restorecurexp: boolean;
+ 	t: smallnumber;
+ 	v: integer;
+ 	q: halfword;
+     begin
+ 	if p <> (-30000) then 
+ 	    restorecurexp := false
+ 	else begin
+ 	    p := stashcurexp;
+ 	    restorecurexp := true
+ 	end;
+ 	t := mem[p].hh.b0;
+ 	if t < 17 then 
+ 	    v := mem[p + 1].int
+ 	else if t < 19 then 
+ 	    v := mem[p + 1].hh.rh; {802:}
+ 	if t in
+ 	    [1, 2, 3, 5, 7, 12, 10, 15,
+ 	     4, 6, 8, 9, 11, 13, 14, 16,
+ 	     17, 18, 19] then
+ 	    case t of
+ 		1:
+ 		    print(194);
+ 		2:
+ 		    if v = 30 then 
+ 			print(218)
+ 		    else 
+ 			print(219);
+ 		3, 5, 7, 12, 10, 15:
+ 		    begin {806:}
+ 			printtype(t);
+ 			if v <> (-30000) then begin
+ 			    printchar(32);
+ 			    while (mem[v].hh.b1 = 11) and (v <> p) do 
+ 				v := mem[v + 1].int;
+ 			    printvariablename(v)
+ 			end
+ 		    end; {:806}
+ 		4:
+ 		    begin
+ 			printchar(34);
+ 			slowprint(v);
+ 			printchar(34)
+ 		    end;
+ 		6, 8, 9, 11: {804:}
+ 		    if verbosity <= 1 then 
+ 			printtype(t)
+ 		    else begin
+ 			if selector = 3 then 
+ 			    if internal[13] <= 0 then begin
+ 				selector := 1;
+ 				printtype(t);
+ 				print(626);
+ 				selector := 3
+ 			    end;
+ 			case t of
+ 			    6:
+ 				printpen(v, 155, false);
+ 			    8:
+ 				printpath(v, 627, false);
+ 			    9:
+ 				printpath(v, 155, false);
+ 			    11:
+ 				begin
+ 				    curedges := v;
+ 				    printedges(155, false, 0, 0)
+ 				end
+ 			end
+ 		    end {:804};
+ 		13, 14:
+ 		    if v = (-30000) then 
+ 			printtype(t) {803:}
+ 		    else begin
+ 			printchar(40);
+ 			q := v + bignodesize[t];
+ 			repeat
+ 			    if mem[v].hh.b0 = 16 then 
+ 				printscaled(mem[v + 1].int)
+ 			    else if mem[v].hh.b0 = 19 then 
+ 				printvariablename(v)
+ 			    else 
+ 				printdp(mem[v].hh.b0, mem[v + 1].hh.rh, verbosity);
+ 			    v := v + 2;
+ 			    if v <> q then 
+ 				printchar(44)
+ 			until v = q;
+ 			printchar(41)
+ 		    end {:803};
+ 		16:
+ 		    printscaled(v);
+ 		17, 18:
+ 		    printdp(t, v, verbosity);
+ 		19:
+ 		    printvariablename(p)
+ 	    end
+ 	else
+ 	    confusion(625) {:802};
+ 	if restorecurexp then 
+ 	    unstashcurexp(p)
+     end; {:801} {807:}
+ 
+     procedure disperr(p: halfword; s: strnumber);
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	printnl(629);
+ 	printexp(p, 1);
+ 	if s <> 155 then begin
+ 	    printnl(133);
+ 	    print(s)
+ 	end
+     end; {:807} {594:}
+ 
+     function pplusfq(p: halfword; f: integer; q: halfword; t, tt: smallnumber): halfword;
+     label
+ 	30;
+     var
+ 	pp, qq: halfword;
+ 	r, s: halfword;
+ 	threshold: integer;
+ 	v: integer;
+     begin
+ 	if t = 17 then 
+ 	    threshold := 2685
+ 	else 
+ 	    threshold := 8;
+ 	r := 29999;
+ 	pp := mem[p].hh.lh;
+ 	qq := mem[q].hh.lh;
+ 	while true do 
+ 	    if pp = qq then 
+ 		if pp = (-30000) then 
+ 		    goto 30 {595:}
+ 		else begin
+ 		    if tt = 17 then 
+ 			v := mem[p + 1].int + takefraction(f, mem[q + 1].int)
+ 		    else 
+ 			v := mem[p + 1].int + takescaled(f, mem[q + 1].int);
+ 		    mem[p + 1].int := v;
+ 		    s := p;
+ 		    p := mem[p].hh.rh;
+ 		    if abs(v) < threshold then 
+ 			freenode(s, 2)
+ 		    else begin
+ 			if abs(v) >= 626349397 then 
+ 			    if watchcoefs then begin
+ 				mem[qq].hh.b0 := 0;
+ 				fixneeded := true
+ 			    end;
+ 			mem[r].hh.rh := s;
+ 			r := s
+ 		    end;
+ 		    pp := mem[p].hh.lh;
+ 		    q := mem[q].hh.rh;
+ 		    qq := mem[q].hh.lh
+ 		end {:595}
+ 	    else if mem[pp + 1].int < mem[qq + 1].int then begin {596:}
+ 		if tt = 17 then 
+ 		    v := takefraction(f, mem[q + 1].int)
+ 		else 
+ 		    v := takescaled(f, mem[q + 1].int);
+ 		if abs(v) > (threshold div 2) then begin
+ 		    s := getnode(2);
+ 		    mem[s].hh.lh := qq;
+ 		    mem[s + 1].int := v;
+ 		    if abs(v) >= 626349397 then 
+ 			if watchcoefs then begin
+ 			    mem[qq].hh.b0 := 0;
+ 			    fixneeded := true
+ 			end;
+ 		    mem[r].hh.rh := s;
+ 		    r := s
+ 		end;
+ 		q := mem[q].hh.rh;
+ 		qq := mem[q].hh.lh
+ 	    end else begin {:596}
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		p := mem[p].hh.rh;
+ 		pp := mem[p].hh.lh
+ 	    end;
+     30:
+ 	if t = 17 then 
+ 	    mem[p + 1].int := slowadd(mem[p + 1].int, takefraction(mem[q + 1].int, f))
+ 	else 
+ 	    mem[p + 1].int := slowadd(mem[p + 1].int, takescaled(mem[q + 1].int, f));
+ 	mem[r].hh.rh := p;
+ 	depfinal := p;
+ 	pplusfq := mem[29999].hh.rh
+     end; {:594}
+ {600:}
+ 
+     function poverv(p: halfword; v: scaled; t0, t1: smallnumber): halfword;
+     var
+ 	r, s: halfword;
+ 	w: integer;
+ 	threshold: integer;
+ 	scalingdown: boolean;
+     begin
+ 	if t0 <> t1 then 
+ 	    scalingdown := true
+ 	else 
+ 	    scalingdown := false;
+ 	if t1 = 17 then 
+ 	    threshold := 1342
+ 	else 
+ 	    threshold := 4;
+ 	r := 29999;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if scalingdown then 
+ 		if abs(v) < 524288 then 
+ 		    w := makescaled(mem[p + 1].int, v * 4096)
+ 		else 
+ 		    w := makescaled(roundfraction(mem[p + 1].int), v)
+ 	    else 
+ 		w := makescaled(mem[p + 1].int, v);
+ 	    if abs(w) <= threshold then begin
+ 		s := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := s
+ 	    end else begin
+ 		if abs(w) >= 626349397 then begin
+ 		    fixneeded := true;
+ 		    mem[mem[p].hh.lh].hh.b0 := 0
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		mem[p + 1].int := w;
+ 		p := mem[p].hh.rh
+ 	    end
+ 	end;
+ 	mem[r].hh.rh := p;
+ 	mem[p + 1].int := makescaled(mem[p + 1].int, v);
+ 	poverv := mem[29999].hh.rh
+     end; { poverv }
+ {:600}
+     {602:}
+ 
+     procedure valtoobig(x: scaled);
+     begin
+ 	if internal[40] > 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(456)
+ 	    end;
+ 	    printscaled(x);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 457;
+ 		helpline[2] := 458;
+ 		helpline[1] := 459;
+ 		helpline[0] := 460
+ 	    end;
+ 	    error
+ 	end
+     end; {:602} {603:}
+ 
+     procedure makeknown(p, q: halfword);
+     var
+ 	t: 17..18;
+     begin
+ 	mem[mem[q].hh.rh + 1].hh.lh := mem[p + 1].hh.lh;
+ 	mem[mem[p + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 	t := mem[p].hh.b0;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	freenode(q, 2);
+ 	if abs(mem[p + 1].int) >= 268435456 then 
+ 	    valtoobig(mem[p + 1].int);
+ 	if internal[2] > 0 then 
+ 	    if interesting(p) then begin
+ 		begindiagnostic;
+ 		printnl(461);
+ 		printvariablename(p);
+ 		printchar(61);
+ 		printscaled(mem[p + 1].int);
+ 		enddiagnostic(false)
+ 	    end;
+ 	if curexp = p then 
+ 	    if curtype = t then begin
+ 		curtype := 16;
+ 		curexp := mem[p + 1].int;
+ 		freenode(p, 2)
+ 	    end
+     end; {:603} {604:}
+ 
+     procedure fixdependencies;
+     label
+ 	30;
+     var
+ 	p, q, r, s, t: halfword;
+ 	x: halfword;
+     begin
+ 	r := mem[-29987].hh.rh;
+ 	s := -30000;
+ 	while r <> (-29987) do begin
+ 	    t := r;
+ {605:}
+ 	    r := t + 1;
+ 	    while true do begin
+ 		q := mem[r].hh.rh;
+ 		x := mem[q].hh.lh;
+ 		if x = (-30000) then 
+ 		    goto 30;
+ 		if mem[x].hh.b0 <= 1 then begin
+ 		    if mem[x].hh.b0 < 1 then begin
+ 			p := getavail;
+ 			mem[p].hh.rh := s;
+ 			s := p;
+ 			mem[s].hh.lh := x;
+ 			mem[x].hh.b0 := 1
+ 		    end;
+ 		    mem[q + 1].int := mem[q + 1].int div 4;
+ 		    if mem[q + 1].int = 0 then begin
+ 			mem[r].hh.rh := mem[q].hh.rh;
+ 			freenode(q, 2);
+ 			q := r
+ 		    end
+ 		end;
+ 		r := q
+ 	    end;
+     30: {:605}
+ 	    ;
+ 	    r := mem[q].hh.rh;
+ 	    if q = mem[t + 1].hh.rh then 
+ 		makeknown(t, q)
+ 	end;
+ 	while s <> (-30000) do begin
+ 	    p := mem[s].hh.rh;
+ 	    x := mem[s].hh.lh;
+ 	    begin
+ 		mem[s].hh.rh := avail;
+ 		avail := s
+ 	    end {dynused:=dynused-1;};
+ 	    s := p;
+ 	    mem[x].hh.b0 := 19;
+ 	    mem[x + 1].int := mem[x + 1].int + 2
+ 	end;
+ 	fixneeded := false
+     end; { fixdependencies }
+ {:604}
+     {268:}
+ 
+     procedure tossknotlist(p: halfword);
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := p;
+ 	repeat
+ 	    r := mem[q].hh.rh;
+ 	    freenode(q, 7);
+ 	    q := r
+ 	until q = p
+     end; {:268} {385:}
+ 
+     procedure tossedges(h: halfword);
+     var
+ 	p, q: halfword;
+     begin
+ 	q := mem[h].hh.rh;
+ 	while q <> h do begin
+ 	    flushlist(mem[q + 1].hh.rh);
+ 	    if mem[q + 1].hh.lh > (-29999) then 
+ 		flushlist(mem[q + 1].hh.lh);
+ 	    p := q;
+ 	    q := mem[q].hh.rh;
+ 	    freenode(p, 2)
+ 	end;
+ 	freenode(h, 6)
+     end; {:385} {487:}
+ 
+     procedure tosspen(p: halfword);
+     var
+ 	k: 1..8;
+ 	w, ww: halfword;
+     begin
+ 	if p <> (-29997) then begin
+ 	    for k := 1 to 8 do begin
+ 		w := mem[p + k].hh.rh;
+ 		repeat
+ 		    ww := mem[w].hh.rh;
+ 		    freenode(w, 3);
+ 		    w := ww
+ 		until w = mem[p + k].hh.rh
+ 	    end;
+ 	    freenode(p, 10)
+ 	end
+     end; {:487} {620:}
+ 
+     procedure ringdelete(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p + 1].int;
+ 	if q <> (-30000) then 
+ 	    if q <> p then begin
+ 		while mem[q + 1].int <> p do 
+ 		    q := mem[q + 1].int;
+ 		mem[q + 1].int := mem[p + 1].int
+ 	    end
+     end; {:620} {809:}
+ 
+     procedure recyclevalue(p: halfword);
+     label
+ 	30;
+     var
+ 	t: smallnumber;
+ 	v: integer;
+ 	vv: integer;
+ 	q, r, s, pp: halfword;
+     begin
+ 	t := mem[p].hh.b0;
+ 	if t < 17 then 
+ 	    v := mem[p + 1].int;
+ 	case t of
+ 	    0, 1, 2, 16, 15:
+ 		;
+ 	    3, 5, 7, 12, 10:
+ 		ringdelete(p);
+ 	    4:
+ 		begin
+ 		    if strref[v] < 127 then 
+ 			if strref[v] > 1 then 
+ 			    strref[v] := strref[v] - 1
+ 			else 
+ 			    flushstring(v)
+ 		end;
+ 	    6:
+ 		if mem[v].hh.lh = (-30000) then 
+ 		    tosspen(v)
+ 		else 
+ 		    mem[v].hh.lh := mem[v].hh.lh - 1;
+ 	    9, 8:
+ 		tossknotlist(v);
+ 	    11:
+ 		tossedges(v);
+ 	    14, 13: {810:}
+ 		if v <> (-30000) then begin
+ 		    q := v + bignodesize[t];
+ 		    repeat
+ 			q := q - 2;
+ 			recyclevalue(q)
+ 		    until q = v;
+ 		    freenode(v, bignodesize[t])
+ 		end {:810};
+ 	    17, 18:
+ 		begin {811:}
+ 		    q := mem[p + 1].hh.rh;
+ 		    while mem[q].hh.lh <> (-30000) do 
+ 			q := mem[q].hh.rh;
+ 		    mem[mem[p + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 		    mem[mem[q].hh.rh + 1].hh.lh := mem[p + 1].hh.lh;
+ 		    mem[q].hh.rh := -30000;
+ 		    flushnodelist(mem[p + 1].hh.rh)
+ 		end; {:811}
+ 	    19:
+ 		begin {812:}
+ 		    maxc[17] := 0;
+ 		    maxc[18] := 0;
+ 		    maxlink[17] := -30000;
+ 		    maxlink[18] := -30000;
+ 		    q := mem[-29987].hh.rh;
+ 		    while q <> (-29987) do begin
+ 			s := q + 1;
+ 			while true do begin
+ 			    r := mem[s].hh.rh;
+ 			    if mem[r].hh.lh = (-30000) then 
+ 				goto 30;
+ 			    if mem[r].hh.lh <> p then 
+ 				s := r
+ 			    else begin
+ 				t := mem[q].hh.b0;
+ 				mem[s].hh.rh := mem[r].hh.rh;
+ 				mem[r].hh.lh := q;
+ 				if abs(mem[r + 1].int) > maxc[t] then begin {814:}
+ 				    if maxc[t] > 0 then begin
+ 					mem[maxptr[t]].hh.rh := maxlink[t];
+ 					maxlink[t] := maxptr[t]
+ 				    end;
+ 				    maxc[t] := abs(mem[r + 1].int);
+ 				    maxptr[t] := r
+ 				end else begin {:814}
+ 				    mem[r].hh.rh := maxlink[t];
+ 				    maxlink[t] := r
+ 				end
+ 			    end
+ 			end;
+     30:
+ 			q := mem[r].hh.rh
+ 		    end;
+ 		    if (maxc[17] > 0) or (maxc[18] > 0) then begin {815:}
+ 			if (maxc[17] >= 268435456) or ((maxc[17] div 4096) >= maxc[18]) then 
+ 			    t := 17
+ 			else 
+ 			    t := 18; {816:}
+ 			s := maxptr[t];
+ 			pp := mem[s].hh.lh;
+ 			v := mem[s + 1].int;
+ 			if t = 17 then 
+ 			    mem[s + 1].int := -268435456
+ 			else 
+ 			    mem[s + 1].int := -65536;
+ 			r := mem[pp + 1].hh.rh;
+ 			mem[s].hh.rh := r;
+ 			while mem[r].hh.lh <> (-30000) do 
+ 			    r := mem[r].hh.rh;
+ 			q := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000;
+ 			mem[q + 1].hh.lh := mem[pp + 1].hh.lh;
+ 			mem[mem[pp + 1].hh.lh].hh.rh := q;
+ 			begin
+ 			    mem[pp].hh.b0 := 19;
+ 			    serialno := serialno + 64;
+ 			    mem[pp + 1].int := serialno
+ 			end;
+ 			if curexp = pp then 
+ 			    if curtype = t then 
+ 				curtype := 19;
+ 			if internal[2] > 0 then  {817:}
+ 			    if interesting(p) then begin
+ 				begindiagnostic;
+ 				printnl(631);
+ 				if v > 0 then 
+ 				    printchar(45);
+ 				if t = 17 then 
+ 				    vv := roundfraction(maxc[17])
+ 				else 
+ 				    vv := maxc[18];
+ 				if vv <> 65536 then 
+ 				    printscaled(vv);
+ 				printvariablename(p);
+ 				while (mem[p + 1].int mod 64) > 0 do begin
+ 				    print(455);
+ 				    mem[p + 1].int := mem[p + 1].int - 2
+ 				end;
+ 				if t = 17 then 
+ 				    printchar(61)
+ 				else 
+ 				    print(632);
+ 				printdependency(s, t);
+ 				enddiagnostic(false)
+ 			    end {:817} {:816};
+ 			t := 35 - t;
+ 			if maxc[t] > 0 then begin
+ 			    mem[maxptr[t]].hh.rh := maxlink[t];
+ 			    maxlink[t] := maxptr[t]
+ 			end;
+ 			if t <> 17 then  {818:}
+ 			    for t := 17 to 18 do begin
+ 				r := maxlink[t];
+ 				while r <> (-30000) do begin
+ 				    q := mem[r].hh.lh;
+ 				    mem[q + 1].hh.rh := pplusfq(mem[q + 1].hh.rh, makefraction(mem[r + 1].int, -v), s, t, 17);
+ 				    if mem[q + 1].hh.rh = depfinal then 
+ 					makeknown(q, depfinal);
+ 				    q := r;
+ 				    r := mem[r].hh.rh;
+ 				    freenode(q, 2)
+ 				end
+ 			    end {:818} {819:}
+ 			else 
+ 			    for t := 17 to 18 do begin
+ 				r := maxlink[t];
+ 				while r <> (-30000) do begin
+ 				    q := mem[r].hh.lh;
+ 				    if t = 17 then begin
+ 					if curexp = q then 
+ 					    if curtype = 17 then 
+ 						curtype := 18;
+ 					mem[q + 1].hh.rh := poverv(mem[q + 1].hh.rh, 65536, 17, 18);
+ 					mem[q].hh.b0 := 18;
+ 					mem[r + 1].int := roundfraction(mem[r + 1].int)
+ 				    end;
+ 				    mem[q + 1].hh.rh := pplusfq(mem[q + 1].hh.rh, makescaled(mem[r + 1].int, -v), s, 18, 18);
+ 				    if mem[q + 1].hh.rh = depfinal then 
+ 					makeknown(q, depfinal);
+ 				    q := r;
+ 				    r := mem[r].hh.rh;
+ 				    freenode(q, 2)
+ 				end
+ 			    end {:819};
+ 			flushnodelist(s);
+ 			if fixneeded then 
+ 			    fixdependencies;
+ 			begin
+ 			    if aritherror then 
+ 				cleararith
+ 			end
+ 		    end {:815}
+ 		end; {:812}
+ 	    20, 21:
+ 		confusion(630);
+ 	    22, 23:
+ 		deletemacref(mem[p + 1].int)
+ 	end;
+ 	mem[p].hh.b0 := 0
+     end; {:809} {808:}
+ 
+     procedure flushcurexp(v: scaled);
+     begin
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19, 6, 4, 8, 9, 11] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    begin
+ 			recyclevalue(curexp);
+ 			freenode(curexp, 2)
+ 		    end;
+ 		6:
+ 		    if mem[curexp].hh.lh = (-30000) then 
+ 			tosspen(curexp)
+ 		    else 
+ 			mem[curexp].hh.lh := mem[curexp].hh.lh - 1;
+ 		4:
+ 		    begin
+ 			if strref[curexp] < 127 then 
+ 			    if strref[curexp] > 1 then 
+ 				strref[curexp] := strref[curexp] - 1
+ 			    else 
+ 				flushstring(curexp)
+ 		    end;
+ 		8, 9:
+ 		    tossknotlist(curexp);
+ 		11:
+ 		    tossedges(curexp)
+ 	    end
+ 	else
+ 	    ;
+ 	curtype := 16;
+ 	curexp := v
+     end; {:808} {820:}
+ 
+     procedure flusherror(v: scaled);
+     begin
+ 	error;
+ 	flushcurexp(v)
+     end;
+ 
+     procedure backerror;
+     forward;
+ 
+     procedure getxnext;
+     forward;
+ 
+     procedure putgeterror;
+     begin
+ 	backerror;
+ 	getxnext
+     end; { putgeterror }
+ 
+     procedure putgetflusherror(v: scaled);
+     begin
+ 	putgeterror;
+ 	flushcurexp(v)
+     end; {:820} {247:}
+ 
+     procedure flushbelowvariable(p: halfword);
+     var
+ 	q, r: halfword;
+     begin
+ 	if mem[p].hh.b0 <> 21 then 
+ 	    recyclevalue(p)
+ 	else begin
+ 	    q := mem[p + 1].hh.rh;
+ 	    while mem[q].hh.b1 = 3 do begin
+ 		flushbelowvariable(q);
+ 		r := q;
+ 		q := mem[q].hh.rh;
+ 		freenode(r, 3)
+ 	    end;
+ 	    r := mem[p + 1].hh.lh;
+ 	    q := mem[r].hh.rh;
+ 	    recyclevalue(r);
+ 	    if mem[p].hh.b1 <= 1 then 
+ 		freenode(r, 2)
+ 	    else 
+ 		freenode(r, 3);
+ 	    repeat
+ 		flushbelowvariable(q);
+ 		r := q;
+ 		q := mem[q].hh.rh;
+ 		freenode(r, 3)
+ 	    until q = (-29983);
+ 	    mem[p].hh.b0 := 0
+ 	end
+     end; {:247}
+ 
+     procedure flushvariable(p, t: halfword; discardsuffixes: boolean);
+     label
+ 	10;
+     var
+ 	q, r: halfword;
+ 	n: halfword;
+     begin
+ 	while t <> (-30000) do begin
+ 	    if mem[p].hh.b0 <> 21 then 
+ 		goto 10;
+ 	    n := mem[t].hh.lh;
+ 	    t := mem[t].hh.rh;
+ 	    if n = 0 then begin
+ 		r := p + 1;
+ 		q := mem[r].hh.rh;
+ 		while mem[q].hh.b1 = 3 do begin
+ 		    flushvariable(q, t, discardsuffixes);
+ 		    if t = (-30000) then 
+ 			if mem[q].hh.b0 = 21 then 
+ 			    r := q
+ 			else begin
+ 			    mem[r].hh.rh := mem[q].hh.rh;
+ 			    freenode(q, 3)
+ 			end
+ 		    else 
+ 			r := q;
+ 		    q := mem[r].hh.rh
+ 		end
+ 	    end;
+ 	    p := mem[p + 1].hh.lh;
+ 	    repeat
+ 		r := p;
+ 		p := mem[p].hh.rh
+ 	    until mem[p + 2].hh.lh >= n;
+ 	    if mem[p + 2].hh.lh <> n then 
+ 		goto 10
+ 	end;
+ 	if discardsuffixes then 
+ 	    flushbelowvariable(p)
+ 	else begin
+ 	    if mem[p].hh.b0 = 21 then 
+ 		p := mem[p + 1].hh.lh;
+ 	    recyclevalue(p)
+ 	end;
+     10:
+ 	
+     end; {:246} {248:}
+ 
+     function undtype(p: halfword): smallnumber;
+     begin
+ 	case mem[p].hh.b0 of
+ 	    0, 1:
+ 		undtype := 0;
+ 	    2, 3:
+ 		undtype := 3;
+ 	    4, 5:
+ 		undtype := 5;
+ 	    6, 7, 8:
+ 		undtype := 7;
+ 	    9, 10:
+ 		undtype := 10;
+ 	    11, 12:
+ 		undtype := 12;
+ 	    13, 14, 15:
+ 		undtype := mem[p].hh.b0;
+ 	    16, 17, 18, 19:
+ 		undtype := 15
+ 	end
+     end; {:248}
+ {249:}
+ 
+     procedure clearsymbol(p: halfword; saving: boolean);
+     var
+ 	q: halfword;
+     begin
+ 	q := eqtb[p].rh;
+ 	if eqtb[p].lh mod 83 in
+ 	    [10, 53, 44, 49, 41] then
+ 	    case eqtb[p].lh mod 83 of
+ 		10, 53, 44, 49:
+ 		    if not saving then 
+ 			deletemacref(q);
+ 		41:
+ 		    if q <> (-30000) then 
+ 			if saving then 
+ 			    mem[q].hh.b1 := 1
+ 			else begin
+ 			    flushbelowvariable(q);
+ 			    freenode(q, 2)
+ 			end
+ 	    end
+ 	else
+ 	    ;
+ 	eqtb[p] := eqtb[2241]
+     end; {:249} {252:}
+ 
+     procedure savevariable(q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if saveptr <> (-30000) then begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.lh := q;
+ 	    mem[p].hh.rh := saveptr;
+ 	    mem[p + 1].hh := eqtb[q];
+ 	    saveptr := p
+ 	end;
+ 	clearsymbol(q, saveptr <> (-30000))
+     end; {:252} {253:}
+ 
+     procedure saveinternal(q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if saveptr <> (-30000) then begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.lh := 2241 + q;
+ 	    mem[p].hh.rh := saveptr;
+ 	    mem[p + 1].int := internal[q];
+ 	    saveptr := p
+ 	end
+     end; { saveinternal }
+ {:253}
+     {254:}
+ 
+     procedure unsave;
+     var
+ 	q: halfword;
+ 	p: halfword;
+     begin
+ 	while mem[saveptr].hh.lh <> 0 do begin
+ 	    q := mem[saveptr].hh.lh;
+ 	    if q > 2241 then begin
+ 		if internal[8] > 0 then begin
+ 		    begindiagnostic;
+ 		    printnl(383);
+ 		    print(intname[q - 2241]);
+ 		    printchar(61);
+ 		    printscaled(mem[saveptr + 1].int);
+ 		    printchar(125);
+ 		    enddiagnostic(false)
+ 		end;
+ 		internal[q - 2241] := mem[saveptr + 1].int
+ 	    end else begin
+ 		if internal[8] > 0 then begin
+ 		    begindiagnostic;
+ 		    printnl(383);
+ 		    print(hash[q].rh);
+ 		    printchar(125);
+ 		    enddiagnostic(false)
+ 		end;
+ 		clearsymbol(q, false);
+ 		eqtb[q] := mem[saveptr + 1].hh;
+ 		if (eqtb[q].lh mod 83) = 41 then begin
+ 		    p := eqtb[q].rh;
+ 		    if p <> (-30000) then 
+ 			mem[p].hh.b1 := 0
+ 		end
+ 	    end;
+ 	    p := mem[saveptr].hh.rh;
+ 	    freenode(saveptr, 2);
+ 	    saveptr := p
+ 	end;
+ 	p := mem[saveptr].hh.rh;
+ 	begin
+ 	    mem[saveptr].hh.rh := avail;
+ 	    avail := saveptr
+ 	end {dynused:=dynused-1;};
+ 	saveptr := p
+     end; {:254} {264:}
+ 
+     function copyknot(p: halfword): halfword;
+     var
+ 	q: halfword;
+ 	k: 0..6;
+     begin
+ 	q := getnode(7);
+ 	for k := 0 to 6 do 
+ 	    mem[q + k] := mem[p + k];
+ 	copyknot := q
+     end; {:264} {265:}
+ 
+     function copypath(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q, pp, qq: halfword;
+     begin
+ 	q := getnode(7);
+ 	qq := q;
+ 	pp := p;
+ 	while true do begin
+ 	    mem[qq].hh.b0 := mem[pp].hh.b0;
+ 	    mem[qq].hh.b1 := mem[pp].hh.b1;
+ 	    mem[qq + 1].int := mem[pp + 1].int;
+ 	    mem[qq + 2].int := mem[pp + 2].int;
+ 	    mem[qq + 3].int := mem[pp + 3].int;
+ 	    mem[qq + 4].int := mem[pp + 4].int;
+ 	    mem[qq + 5].int := mem[pp + 5].int;
+ 	    mem[qq + 6].int := mem[pp + 6].int;
+ 	    if mem[pp].hh.rh = p then begin
+ 		mem[qq].hh.rh := q;
+ 		copypath := q;
+ 		goto 10
+ 	    end;
+ 	    mem[qq].hh.rh := getnode(7);
+ 	    qq := mem[qq].hh.rh;
+ 	    pp := mem[pp].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:265} {266:}
+ 
+     function htapypoc(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q, pp, qq, rr: halfword;
+     begin
+ 	q := getnode(7);
+ 	qq := q;
+ 	pp := p;
+ 	while true do begin
+ 	    mem[qq].hh.b1 := mem[pp].hh.b0;
+ 	    mem[qq].hh.b0 := mem[pp].hh.b1;
+ 	    mem[qq + 1].int := mem[pp + 1].int;
+ 	    mem[qq + 2].int := mem[pp + 2].int;
+ 	    mem[qq + 5].int := mem[pp + 3].int;
+ 	    mem[qq + 6].int := mem[pp + 4].int;
+ 	    mem[qq + 3].int := mem[pp + 5].int;
+ 	    mem[qq + 4].int := mem[pp + 6].int;
+ 	    if mem[pp].hh.rh = p then begin
+ 		mem[q].hh.rh := qq;
+ 		pathtail := pp;
+ 		htapypoc := q;
+ 		goto 10
+ 	    end;
+ 	    rr := getnode(7);
+ 	    mem[rr].hh.rh := qq;
+ 	    qq := rr;
+ 	    pp := mem[pp].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:266} {269:} {284:} {296:}
+ 
+     function curlratio(gamma, atension, btension: scaled): fraction;
+     var
+ 	alpha, beta, num, denom, ff: fraction;
+     begin
+ 	alpha := makefraction(65536, atension);
+ 	beta := makefraction(65536, btension);
+ 	if alpha <= beta then begin
+ 	    ff := makefraction(alpha, beta);
+ 	    ff := takefraction(ff, ff);
+ 	    gamma := takefraction(gamma, ff);
+ 	    beta := beta div 4096;
+ 	    denom := (takefraction(gamma, alpha) + 196608) - beta;
+ 	    num := takefraction(gamma, 805306368 - alpha) + beta
+ 	end else begin
+ 	    ff := makefraction(beta, alpha);
+ 	    ff := takefraction(ff, ff);
+ 	    beta := takefraction(beta, ff) div 4096;
+ 	    denom := (takefraction(gamma, alpha) + (ff div 1365)) - beta;
+ 	    num := takefraction(gamma, 805306368 - alpha) + beta
+ 	end;
+ 	if num >= (((denom + denom) + denom) + denom) then 
+ 	    curlratio := 1073741824
+ 	else 
+ 	    curlratio := makefraction(num, denom)
+     end; {:296} {299:}
+ 
+     procedure setcontrols(p, q: halfword; k: integer);
+     var
+ 	rr, ss: fraction;
+ 	lt, rt: scaled;
+ 	sine: fraction;
+     begin
+ 	lt := abs(mem[q + 4].int);
+ 	rt := abs(mem[p + 6].int);
+ 	rr := velocity(st, ct, sf, cf, rt);
+ 	ss := velocity(sf, cf, st, ct, lt);
+ 	if (mem[p + 6].int < 0) or (mem[q + 4].int < 0) then  {300:}
+ 	    if ((st >= 0) and (sf >= 0)) or ((st <= 0) and (sf <= 0)) then begin
+ 		sine := takefraction(abs(st), cf) + takefraction(abs(sf), ct);
+ 		if sine > 0 then begin
+ 		    sine := takefraction(sine, 268500992);
+ 		    if mem[p + 6].int < 0 then 
+ 			if abvscd(abs(sf), 268435456, rr, sine) < 0 then 
+ 			    rr := makefraction(abs(sf), sine);
+ 		    if mem[q + 4].int < 0 then 
+ 			if abvscd(abs(st), 268435456, ss, sine) < 0 then 
+ 			    ss := makefraction(abs(st), sine)
+ 		end
+ 	    end {:300};
+ 	mem[p + 5].int := mem[p + 1].int + takefraction(takefraction(deltax[k], ct) - takefraction(deltay[k], st), rr);
+ 	mem[p + 6].int := mem[p + 2].int + takefraction(takefraction(deltay[k], ct) + takefraction(deltax[k], st), rr);
+ 	mem[q + 3].int := mem[q + 1].int - takefraction(takefraction(deltax[k], cf) + takefraction(deltay[k], sf), ss);
+ 	mem[q + 4].int := mem[q + 2].int - takefraction(takefraction(deltay[k], cf) - takefraction(deltax[k], sf), ss);
+ 	mem[p].hh.b1 := 1;
+ 	mem[q].hh.b0 := 1
+     end; { setcontrols }
+ {:299}
+ 
+     procedure solvechoices(p, q: halfword; n: halfword);
+     label
+ 	40, 10;
+     var
+ 	k: 0..pathsize;
+ 	r, s, t: halfword;
+ 	sine, cosine: fraction; {286:}
+ 	aa, bb, cc, ff, acc: fraction;
+ 	dd, ee: scaled;
+ 	lt, rt: scaled; {:286}
+     begin
+ 	k := 0;
+ 	s := p;
+ 	while true do begin
+ 	    t := mem[s].hh.rh;
+ 	    if k = 0 then  {285:}
+ 		case mem[s].hh.b1 of
+ 		    2:
+ 			if mem[t].hh.b0 = 2 then begin {301:}
+ 			    aa := narg(deltax[0], deltay[0]);
+ 			    nsincos(mem[p + 5].int - aa);
+ 			    ct := ncos;
+ 			    st := nsin;
+ 			    nsincos(mem[q + 3].int - aa);
+ 			    cf := ncos;
+ 			    sf := -nsin;
+ 			    setcontrols(p, q, 0);
+ 			    goto 10
+ 			end else begin {:301} {293:}
+ 			    vv[0] := mem[s + 5].int - narg(deltax[0], deltay[0]);
+ 			    if abs(vv[0]) > 188743680 then 
+ 				if vv[0] > 0 then 
+ 				    vv[0] := vv[0] - 377487360
+ 				else 
+ 				    vv[0] := vv[0] + 377487360;
+ 			    uu[0] := 0;
+ 			    ww[0] := 0
+ 			end {:293};
+ 		    3:
+ 			if mem[t].hh.b0 = 3 then begin {302:}
+ 			    mem[p].hh.b1 := 1;
+ 			    mem[q].hh.b0 := 1;
+ 			    lt := abs(mem[q + 4].int);
+ 			    rt := abs(mem[p + 6].int);
+ 			    if rt = 65536 then begin
+ 				if deltax[0] >= 0 then 
+ 				    mem[p + 5].int := mem[p + 1].int + ((deltax[0] + 1) div 3)
+ 				else 
+ 				    mem[p + 5].int := mem[p + 1].int + ((deltax[0] - 1) div 3);
+ 				if deltay[0] >= 0 then 
+ 				    mem[p + 6].int := mem[p + 2].int + ((deltay[0] + 1) div 3)
+ 				else 
+ 				    mem[p + 6].int := mem[p + 2].int + ((deltay[0] - 1) div 3)
+ 			    end else begin
+ 				ff := makefraction(65536, 3 * rt);
+ 				mem[p + 5].int := mem[p + 1].int + takefraction(deltax[0], ff);
+ 				mem[p + 6].int := mem[p + 2].int + takefraction(deltay[0], ff)
+ 			    end;
+ 			    if lt = 65536 then begin
+ 				if deltax[0] >= 0 then 
+ 				    mem[q + 3].int := mem[q + 1].int - ((deltax[0] + 1) div 3)
+ 				else 
+ 				    mem[q + 3].int := mem[q + 1].int - ((deltax[0] - 1) div 3);
+ 				if deltay[0] >= 0 then 
+ 				    mem[q + 4].int := mem[q + 2].int - ((deltay[0] + 1) div 3)
+ 				else 
+ 				    mem[q + 4].int := mem[q + 2].int - ((deltay[0] - 1) div 3)
+ 			    end else begin
+ 				ff := makefraction(65536, 3 * lt);
+ 				mem[q + 3].int := mem[q + 1].int - takefraction(deltax[0], ff);
+ 				mem[q + 4].int := mem[q + 2].int - takefraction(deltay[0], ff)
+ 			    end;
+ 			    goto 10
+ 			end else begin {:302} {294:}
+ 			    cc := mem[s + 5].int;
+ 			    lt := abs(mem[t + 4].int);
+ 			    rt := abs(mem[s + 6].int);
+ 			    if (rt = 65536) and (lt = 65536) then 
+ 				uu[0] := makefraction((cc + cc) + 65536, cc + 131072)
+ 			    else 
+ 				uu[0] := curlratio(cc, rt, lt);
+ 			    vv[0] := -takefraction(psi[1], uu[0]);
+ 			    ww[0] := 0
+ 			end {:294};
+ 		    4:
+ 			begin
+ 			    uu[0] := 0;
+ 			    vv[0] := 0;
+ 			    ww[0] := 268435456
+ 			end
+ 		end {:285}
+ 	    else 
+ 		case mem[s].hh.b0 of
+ 		    5, 4:
+ 			begin {287:} {288:}
+ 			    if abs(mem[r + 6].int) = 65536 then begin
+ 				aa := 134217728;
+ 				dd := 2 * delta[k]
+ 			    end else begin
+ 				aa := makefraction(65536, (3 * abs(mem[r + 6].int)) - 65536);
+ 				dd := takefraction(delta[k], 805306368 - makefraction(65536, abs(mem[r + 6].int)))
+ 			    end;
+ 			    if abs(mem[t + 4].int) = 65536 then begin
+ 				bb := 134217728;
+ 				ee := 2 * delta[k - 1]
+ 			    end else begin
+ 				bb := makefraction(65536, (3 * abs(mem[t + 4].int)) - 65536);
+ 				ee := takefraction(delta[k - 1], 805306368 - makefraction(65536, abs(mem[t + 4].int)))
+ 			    end;
+ 			    cc := 268435456 - takefraction(uu[k - 1], aa) {:288}; {289:}
+ 			    dd := takefraction(dd, cc);
+ 			    lt := abs(mem[s + 4].int);
+ 			    rt := abs(mem[s + 6].int);
+ 			    if lt <> rt then 
+ 				if lt < rt then begin
+ 				    ff := makefraction(lt, rt);
+ 				    ff := takefraction(ff, ff);
+ 				    dd := takefraction(dd, ff)
+ 				end else begin
+ 				    ff := makefraction(rt, lt);
+ 				    ff := takefraction(ff, ff);
+ 				    ee := takefraction(ee, ff)
+ 				end;
+ 			    ff := makefraction(ee, ee + dd) {:289};
+ 			    uu[k] := takefraction(ff, bb); {290:}
+ 			    acc := -takefraction(psi[k + 1], uu[k]);
+ 			    if mem[r].hh.b1 = 3 then begin
+ 				ww[k] := 0;
+ 				vv[k] := acc - takefraction(psi[1], 268435456 - ff)
+ 			    end else begin
+ 				ff := makefraction(268435456 - ff, cc);
+ 				acc := acc - takefraction(psi[k], ff);
+ 				ff := takefraction(ff, aa);
+ 				vv[k] := acc - takefraction(vv[k - 1], ff);
+ 				if ww[k - 1] = 0 then 
+ 				    ww[k] := 0
+ 				else 
+ 				    ww[k] := -takefraction(ww[k - 1], ff)
+ 			    end {:290};
+ 			    if mem[s].hh.b0 = 5 then begin {291:}
+ 				aa := 0;
+ 				bb := 268435456;
+ 				repeat
+ 				    k := k - 1;
+ 				    if k = 0 then 
+ 					k := n;
+ 				    aa := vv[k] - takefraction(aa, uu[k]);
+ 				    bb := ww[k] - takefraction(bb, uu[k])
+ 				until k = n;
+ 				aa := makefraction(aa, 268435456 - bb);
+ 				theta[n] := aa;
+ 				vv[0] := aa;
+ 				for k := 1 to n - 1 do 
+ 				    vv[k] := vv[k] + takefraction(aa, ww[k]);
+ 				goto 40
+ 			    end {:291}
+ 			end; {:287}
+ 		    3:
+ 			begin {295:}
+ 			    cc := mem[s + 3].int;
+ 			    lt := abs(mem[s + 4].int);
+ 			    rt := abs(mem[r + 6].int);
+ 			    if (rt = 65536) and (lt = 65536) then 
+ 				ff := makefraction((cc + cc) + 65536, cc + 131072)
+ 			    else 
+ 				ff := curlratio(cc, lt, rt);
+ 			    theta[n] := -makefraction(takefraction(vv[n - 1], ff), 268435456 - takefraction(ff, uu[n - 1]));
+ 			    goto 40
+ 			end; {:295}
+ 		    2:
+ 			begin {292:}
+ 			    theta[n] := mem[s + 3].int - narg(deltax[n - 1], deltay[n - 1]);
+ 			    if abs(theta[n]) > 188743680 then 
+ 				if theta[n] > 0 then 
+ 				    theta[n] := theta[n] - 377487360
+ 				else 
+ 				    theta[n] := theta[n] + 377487360;
+ 			    goto 40
+ 			end
+ 		end {:292};
+ 	    r := s;
+ 	    s := t;
+ 	    k := k + 1
+ 	end;
+     40: {297:}
+ 	for k := n - 1 downto 0 do 
+ 	    theta[k] := vv[k] - takefraction(theta[k + 1], uu[k]);
+ 	s := p;
+ 	k := 0;
+ 	repeat
+ 	    t := mem[s].hh.rh;
+ 	    nsincos(theta[k]);
+ 	    st := nsin;
+ 	    ct := ncos;
+ 	    nsincos((-psi[k + 1]) - theta[k + 1]);
+ 	    sf := nsin;
+ 	    cf := ncos;
+ 	    setcontrols(s, t, k);
+ 	    k := k + 1;
+ 	    s := t
+ 	until k = n {:297};
+     10:
+ 	
+     end; {:284}
+ 
+     procedure makechoices(knots: halfword);
+     label
+ 	30;
+     var
+ 	h: halfword;
+ 	p, q: halfword; {280:}
+ 	k, n: 0..pathsize;
+ 	r, s, t: halfword;
+ 	delx, dely: scaled;
+ 	sine, cosine: fraction; {:280}
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[4] > 0 then 
+ 	    printpath(knots, 393, true); {271:}
+ 	p := knots;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if mem[p + 1].int = mem[q + 1].int then 
+ 		if mem[p + 2].int = mem[q + 2].int then 
+ 		    if mem[p].hh.b1 > 1 then begin
+ 			mem[p].hh.b1 := 1;
+ 			if mem[p].hh.b0 = 4 then begin
+ 			    mem[p].hh.b0 := 3;
+ 			    mem[p + 3].int := 65536
+ 			end;
+ 			mem[q].hh.b0 := 1;
+ 			if mem[q].hh.b1 = 4 then begin
+ 			    mem[q].hh.b1 := 3;
+ 			    mem[q + 5].int := 65536
+ 			end;
+ 			mem[p + 5].int := mem[p + 1].int;
+ 			mem[q + 3].int := mem[p + 1].int;
+ 			mem[p + 6].int := mem[p + 2].int;
+ 			mem[q + 4].int := mem[p + 2].int
+ 		    end;
+ 	    p := q
+ 	until p = knots {:271}; {272:}
+ 	h := knots;
+ 	while true do begin
+ 	    if mem[h].hh.b0 <> 4 then 
+ 		goto 30;
+ 	    if mem[h].hh.b1 <> 4 then 
+ 		goto 30;
+ 	    h := mem[h].hh.rh;
+ 	    if h = knots then begin
+ 		mem[h].hh.b0 := 5;
+ 		goto 30
+ 	    end
+ 	end;
+     30: {:272}
+ 	;
+ 	p := h; {273:}
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if mem[p].hh.b1 >= 2 then begin
+ 		while (mem[q].hh.b0 = 4) and (mem[q].hh.b1 = 4) do 
+ 		    q := mem[q].hh.rh; {278:} {281:}
+ 		k := 0;
+ 		s := p;
+ 		n := pathsize;
+ 		repeat
+ 		    t := mem[s].hh.rh;
+ 		    deltax[k] := mem[t + 1].int - mem[s + 1].int;
+ 		    deltay[k] := mem[t + 2].int - mem[s + 2].int;
+ 		    delta[k] := pythadd(deltax[k], deltay[k]);
+ 		    if k > 0 then begin
+ 			sine := makefraction(deltay[k - 1], delta[k - 1]);
+ 			cosine := makefraction(deltax[k - 1], delta[k - 1]);
+ 			psi[k] := narg(takefraction(deltax[k], cosine) + takefraction(deltay[k], sine), takefraction(deltay[k], cosine) - takefraction(deltax[k], sine))
+ 		    end;
+ 		    k := k + 1;
+ 		    s := t;
+ 		    if k = pathsize then 
+ 			overflow(398, pathsize);
+ 		    if s = q then 
+ 			n := k
+ 		until (k >= n) and (mem[s].hh.b0 <> 5);
+ 		if k = n then 
+ 		    psi[n] := 0
+ 		else 
+ 		    psi[k] := psi[1] {:281}; {282:}
+ 		if mem[q].hh.b0 = 4 then begin
+ 		    delx := mem[q + 5].int - mem[q + 1].int;
+ 		    dely := mem[q + 6].int - mem[q + 2].int;
+ 		    if (delx = 0) and (dely = 0) then begin
+ 			mem[q].hh.b0 := 3;
+ 			mem[q + 3].int := 65536
+ 		    end else begin
+ 			mem[q].hh.b0 := 2;
+ 			mem[q + 3].int := narg(delx, dely)
+ 		    end
+ 		end;
+ 		if (mem[p].hh.b1 = 4) and (mem[p].hh.b0 = 1) then begin
+ 		    delx := mem[p + 1].int - mem[p + 3].int;
+ 		    dely := mem[p + 2].int - mem[p + 4].int;
+ 		    if (delx = 0) and (dely = 0) then begin
+ 			mem[p].hh.b1 := 3;
+ 			mem[p + 5].int := 65536
+ 		    end else begin
+ 			mem[p].hh.b1 := 2;
+ 			mem[p + 5].int := narg(delx, dely)
+ 		    end
+ 		end {:282};
+ 		solvechoices(p, q, n) {:278}
+ 	    end;
+ 	    p := q {:273}
+ 	until p = h;
+ 	if internal[4] > 0 then 
+ 	    printpath(knots, 394, true);
+ 	if aritherror then begin {270:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(395)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 396;
+ 		helpline[0] := 397
+ 	    end;
+ 	    putgeterror;
+ 	    aritherror := false
+ 	end {:270}
+     end; {:269} {311:}
+ 
+     {-------------------------------------------------------------------
+     procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber);
+ 
+     moved to mf2ps3.p
+     -------------------------------------------------------------------}
+ 
+     procedure smoothmoves(b, t: integer);
+     var
+ 	k: 1..movesize;
+ 	a, aa, aaa: integer;
+     begin
+ 	if (t - b) >= 3 then begin
+ 	    k := b + 2;
+ 	    aa := move[k - 1];
+ 	    aaa := move[k - 2];
+ 	    repeat
+ 		a := move[k];
+ 		if abs(a - aa) > 1 then  {322:}
+ 		    if a > aa then begin
+ 			if aaa >= aa then 
+ 			    if a >= move[k + 1] then begin
+ 				move[k - 1] := move[k - 1] + 1;
+ 				move[k] := a - 1
+ 			    end
+ 		    end else begin
+ 			if aaa <= aa then 
+ 			    if a <= move[k + 1] then begin
+ 				move[k - 1] := move[k - 1] - 1;
+ 				move[k] := a + 1
+ 			    end
+ 		    end {:322};
+ 		k := k + 1;
+ 		aaa := aa;
+ 		aa := a
+ 	    until k = t
+ 	end
+     end; {:321} {326:}
+ 
+     procedure initedges(h: halfword);
+     begin
+ 	mem[h].hh.lh := h;
+ 	mem[h].hh.rh := h;
+ 	mem[h + 1].hh.lh := 8191;
+ 	mem[h + 1].hh.rh := 1;
+ 	mem[h + 2].hh.lh := 8191;
+ 	mem[h + 2].hh.rh := 1;
+ 	mem[h + 3].hh.lh := 4096;
+ 	mem[h + 3].hh.rh := 0;
+ 	mem[h + 4].int := 0;
+ 	mem[h + 5].hh.rh := h;
+ 	mem[h + 5].hh.lh := 0
+     end; {:326} {328:}
+ 
+     procedure fixoffset;
+     var
+ 	p, q: halfword;
+ 	delta: integer;
+     begin
+ 	delta := 8 * (mem[curedges + 3].hh.lh - 4096);
+ 	mem[curedges + 3].hh.lh := 4096;
+ 	q := mem[curedges].hh.rh;
+ 	while q <> curedges do begin
+ 	    p := mem[q + 1].hh.rh;
+ 	    while p <> 30000 do begin
+ 		mem[p].hh.lh := mem[p].hh.lh - delta;
+ 		p := mem[p].hh.rh
+ 	    end;
+ 	    p := mem[q + 1].hh.lh;
+ 	    while p > (-29999) do begin
+ 		mem[p].hh.lh := mem[p].hh.lh - delta;
+ 		p := mem[p].hh.rh
+ 	    end;
+ 	    q := mem[q].hh.rh
+ 	end
+     end; {:328} {329:}
+ 
+     procedure edgeprep(ml, mr, nl, nr: integer);
+     var
+ 	delta: halfword;
+ 	p, q: halfword;
+     begin
+ 	ml := ml + 4096;
+ 	mr := mr + 4096;
+ 	nl := nl + 4096;
+ 	nr := nr + 4095;
+ 	if ml < mem[curedges + 2].hh.lh then 
+ 	    mem[curedges + 2].hh.lh := ml;
+ 	if mr > mem[curedges + 2].hh.rh then 
+ 	    mem[curedges + 2].hh.rh := mr;
+ 	if (not (abs((mem[curedges + 2].hh.lh + mem[curedges + 3].hh.lh) - 8192) < 4096)) or (not (abs((mem[curedges + 2].hh.rh + mem[curedges + 3].hh.lh) - 8192) < 4096)) then 
+ 	    fixoffset;
+ 	if mem[curedges].hh.rh = curedges then begin
+ 	    mem[curedges + 1].hh.lh := nr + 1;
+ 	    mem[curedges + 1].hh.rh := nr
+ 	end;
+ 	if nl < mem[curedges + 1].hh.lh then begin {330:}
+ 	    delta := mem[curedges + 1].hh.lh - nl;
+ 	    mem[curedges + 1].hh.lh := nl;
+ 	    p := mem[curedges].hh.rh;
+ 	    repeat
+ 		q := getnode(2);
+ 		mem[q + 1].hh.rh := 30000;
+ 		mem[q + 1].hh.lh := -29999;
+ 		mem[p].hh.lh := q;
+ 		mem[q].hh.rh := p;
+ 		p := q;
+ 		delta := delta - 1
+ 	    until delta = 0;
+ 	    mem[p].hh.lh := curedges;
+ 	    mem[curedges].hh.rh := p;
+ 	    if mem[curedges + 5].hh.rh = curedges then 
+ 		mem[curedges + 5].hh.lh := nl - 1
+ 	end {:330};
+ 	if nr > mem[curedges + 1].hh.rh then begin {331:}
+ 	    delta := nr - mem[curedges + 1].hh.rh;
+ 	    mem[curedges + 1].hh.rh := nr;
+ 	    p := mem[curedges].hh.lh;
+ 	    repeat
+ 		q := getnode(2);
+ 		mem[q + 1].hh.rh := 30000;
+ 		mem[q + 1].hh.lh := -29999;
+ 		mem[p].hh.rh := q;
+ 		mem[q].hh.lh := p;
+ 		p := q;
+ 		delta := delta - 1
+ 	    until delta = 0;
+ 	    mem[p].hh.rh := curedges;
+ 	    mem[curedges].hh.lh := p;
+ 	    if mem[curedges + 5].hh.rh = curedges then 
+ 		mem[curedges + 5].hh.lh := nr + 1
+ 	end {:331}
+     end; {:329} {334:}
+ 
+     function copyedges(h: halfword): halfword;
+     var
+ 	p, r: halfword;
+ 	hh, pp, qq, rr, ss: halfword;
+     begin
+ 	hh := getnode(6);
+ 	mem[hh + 1] := mem[h + 1];
+ 	mem[hh + 2] := mem[h + 2];
+ 	mem[hh + 3] := mem[h + 3];
+ 	mem[hh + 4] := mem[h + 4];
+ 	mem[hh + 5].hh.lh := mem[hh + 1].hh.rh + 1;
+ 	mem[hh + 5].hh.rh := hh;
+ 	p := mem[h].hh.rh;
+ 	qq := hh;
+ 	while p <> h do begin
+ 	    pp := getnode(2);
+ 	    mem[qq].hh.rh := pp;
+ 	    mem[pp].hh.lh := qq;
+ {335:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    rr := pp + 1;
+ 	    while r <> 30000 do begin
+ 		ss := getavail;
+ 		mem[rr].hh.rh := ss;
+ 		rr := ss;
+ 		mem[rr].hh.lh := mem[r].hh.lh;
+ 		r := mem[r].hh.rh
+ 	    end;
+ 	    mem[rr].hh.rh := 30000;
+ 	    r := mem[p + 1].hh.lh;
+ 	    rr := 29999;
+ 	    while r > (-29999) do begin
+ 		ss := getavail;
+ 		mem[rr].hh.rh := ss;
+ 		rr := ss;
+ 		mem[rr].hh.lh := mem[r].hh.lh;
+ 		r := mem[r].hh.rh
+ 	    end;
+ 	    mem[rr].hh.rh := r;
+ 	    mem[pp + 1].hh.lh := mem[29999].hh.rh {:335};
+ 	    p := mem[p].hh.rh;
+ 	    qq := pp
+ 	end;
+ 	mem[qq].hh.rh := hh;
+ 	mem[hh].hh.lh := qq;
+ 	copyedges := hh
+     end; {:334} {336:}
+ 
+     procedure yreflectedges;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := mem[curedges + 1].hh.lh;
+ 	mem[curedges + 1].hh.lh := 8191 - mem[curedges + 1].hh.rh;
+ 	mem[curedges + 1].hh.rh := 8191 - p;
+ 	mem[curedges + 5].hh.lh := 8191 - mem[curedges + 5].hh.lh;
+ 	p := mem[curedges].hh.rh;
+ 	q := curedges;
+ 	repeat
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := q;
+ 	    mem[q].hh.lh := p;
+ 	    q := p;
+ 	    p := r
+ 	until q = curedges;
+ 	mem[curedges + 4].int := 0
+     end; {:336} {337:}
+ 
+     procedure xreflectedges;
+     var
+ 	p, q, r, s: halfword;
+ 	m: integer;
+     begin
+ 	p := mem[curedges + 2].hh.lh;
+ 	mem[curedges + 2].hh.lh := 8192 - mem[curedges + 2].hh.rh;
+ 	mem[curedges + 2].hh.rh := 8192 - p;
+ 	m := ((4096 + mem[curedges + 3].hh.lh) * 8) - 65528;
+ 	mem[curedges + 3].hh.lh := 4096;
+ 	p := mem[curedges].hh.rh; {339:}
+ 	repeat
+ 	    q := mem[p + 1].hh.rh;
+ 	    r := 30000;
+ 	    while q <> 30000 do begin
+ 		s := mem[q].hh.rh;
+ 		mem[q].hh.rh := r;
+ 		r := q;
+ 		mem[r].hh.lh := m - mem[q].hh.lh;
+ 		q := s
+ 	    end;
+ 	    mem[p + 1].hh.rh := r {:339}; {338:}
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin
+ 		mem[q].hh.lh := m - mem[q].hh.lh;
+ 		q := mem[q].hh.rh
+ 	    end {:338};
+ 	    p := mem[p].hh.rh
+ 	until p = curedges;
+ 	mem[curedges + 4].int := 0
+     end; { xreflectedges }
+ {:337}
+     {340:}
+ 
+     procedure yscaleedges(s: integer);
+     var
+ 	p, q, pp, r, rr, ss: halfword;
+ 	t: integer;
+     begin
+ 	if ((s * (mem[curedges + 1].hh.rh - 4095)) >= 4096) or ((s * (mem[curedges + 1].hh.lh - 4096)) <= (-4096)) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(402)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 403;
+ 		helpline[1] := 404;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror
+ 	end else begin
+ 	    mem[curedges + 1].hh.rh := (s * (mem[curedges + 1].hh.rh - 4095)) + 4095;
+ 	    mem[curedges + 1].hh.lh := (s * (mem[curedges + 1].hh.lh - 4096)) + 4096; {341:}
+ 	    p := curedges;
+ 	    repeat
+ 		q := p;
+ 		p := mem[p].hh.rh;
+ 		for t := 2 to s do begin
+ 		    pp := getnode(2);
+ 		    mem[q].hh.rh := pp;
+ 		    mem[p].hh.lh := pp;
+ 		    mem[pp].hh.rh := p;
+ 		    mem[pp].hh.lh := q;
+ 		    q := pp; {335:}
+ 		    r := mem[p + 1].hh.rh;
+ 		    rr := pp + 1;
+ 		    while r <> 30000 do begin
+ 			ss := getavail;
+ 			mem[rr].hh.rh := ss;
+ 			rr := ss;
+ 			mem[rr].hh.lh := mem[r].hh.lh;
+ 			r := mem[r].hh.rh
+ 		    end;
+ 		    mem[rr].hh.rh := 30000;
+ 		    r := mem[p + 1].hh.lh;
+ 		    rr := 29999;
+ 		    while r > (-29999) do begin
+ 			ss := getavail;
+ 			mem[rr].hh.rh := ss;
+ 			rr := ss;
+ 			mem[rr].hh.lh := mem[r].hh.lh;
+ 			r := mem[r].hh.rh
+ 		    end;
+ 		    mem[rr].hh.rh := r;
+ 		    mem[pp + 1].hh.lh := mem[29999].hh.rh {:335}
+ 		end
+ 	    until mem[p].hh.rh = curedges {:341};
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; {:340}
+ {342:}
+ 
+     procedure xscaleedges(s: integer);
+     var
+ 	p, q: halfword;
+ 	t: 0..65535;
+ 	w: 0..7;
+ 	delta: integer;
+     begin
+ 	if ((s * (mem[curedges + 2].hh.rh - 4096)) >= 4096) or ((s * (mem[curedges + 2].hh.lh - 4096)) <= (-4096)) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(402)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 406;
+ 		helpline[1] := 404;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror
+ 	end else if (mem[curedges + 2].hh.rh <> 4096) or (mem[curedges + 2].hh.lh <> 4096) then begin
+ 	    mem[curedges + 2].hh.rh := (s * (mem[curedges + 2].hh.rh - 4096)) + 4096;
+ 	    mem[curedges + 2].hh.lh := (s * (mem[curedges + 2].hh.lh - 4096)) + 4096;
+ 	    delta := (8 * (4096 - (s * mem[curedges + 3].hh.lh))) - 32768;
+ 	    mem[curedges + 3].hh.lh := 4096; {343:}
+ 	    q := mem[curedges].hh.rh;
+ 	    repeat
+ 		p := mem[q + 1].hh.rh;
+ 		while p <> 30000 do begin
+ 		    t := mem[p].hh.lh + 32768;
+ 		    w := t mod 8;
+ 		    mem[p].hh.lh := (((t - w) * s) + w) + delta;
+ 		    p := mem[p].hh.rh
+ 		end;
+ 		p := mem[q + 1].hh.lh;
+ 		while p > (-29999) do begin
+ 		    t := mem[p].hh.lh + 32768;
+ 		    w := t mod 8;
+ 		    mem[p].hh.lh := (((t - w) * s) + w) + delta;
+ 		    p := mem[p].hh.rh
+ 		end;
+ 		q := mem[q].hh.rh
+ 	    until q = curedges {:343};
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; { xscaleedges }
+ {:342}
+     {344:}
+ 
+     procedure negateedges(h: halfword);
+     label
+ 	30;
+     var
+ 	p, q, r, s, t, u: halfword;
+     begin
+ 	p := mem[h].hh.rh;
+ 	while p <> h do begin
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin
+ 		mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh;
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    q := mem[p + 1].hh.rh;
+ 	    if q <> 30000 then begin
+ 		repeat
+ 		    mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh;
+ 		    q := mem[q].hh.rh
+ 		until q = 30000; {345:}
+ 		u := p + 1;
+ 		q := mem[u].hh.rh;
+ 		r := q;
+ 		s := mem[r].hh.rh;
+ 		while true do 
+ 		    if mem[s].hh.lh > mem[r].hh.lh then begin
+ 			mem[u].hh.rh := q;
+ 			if s = 30000 then 
+ 			    goto 30;
+ 			u := r;
+ 			q := s;
+ 			r := q;
+ 			s := mem[r].hh.rh
+ 		    end else begin
+ 			t := s;
+ 			s := mem[t].hh.rh;
+ 			mem[t].hh.rh := q;
+ 			q := t
+ 		    end;
+     30:
+ 		mem[r].hh.rh := 30000 {:345}
+ 	    end;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	mem[h + 4].int := 0
+     end; {:344} {346:}
+ 
+     procedure sortedges(h: halfword);
+     label
+ 	30;
+     var
+ 	k: halfword;
+ 	p, q, r, s: halfword;
+     begin
+ 	r := mem[h + 1].hh.lh;
+ 	mem[h + 1].hh.lh := -30000;
+ 	p := mem[r].hh.rh;
+ 	mem[r].hh.rh := 30000;
+ 	mem[29999].hh.rh := r;
+ 	while p > (-29999) do begin
+ 	    k := mem[p].hh.lh;
+ 	    q := 29999;
+ 	    repeat
+ 		r := q;
+ 		q := mem[r].hh.rh
+ 	    until k <= mem[q].hh.lh;
+ 	    mem[r].hh.rh := p;
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := q;
+ 	    p := r
+ 	end; {347:}
+ 	begin
+ 	    r := h + 1;
+ 	    q := mem[r].hh.rh;
+ 	    p := mem[29999].hh.rh;
+ 	    while true do begin
+ 		k := mem[p].hh.lh;
+ 		while k > mem[q].hh.lh do begin
+ 		    r := q;
+ 		    q := mem[r].hh.rh
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		s := mem[p].hh.rh;
+ 		mem[p].hh.rh := q;
+ 		if s = 30000 then 
+ 		    goto 30;
+ 		r := p;
+ 		p := s
+ 	    end;
+     30: {:347}
+ 	    
+ 	end
+     end; {:346} {348:}
+ 
+     procedure culledges(wlo, whi, wout, win: integer);
+     label
+ 	30;
+     var
+ 	p, q, r, s: halfword;
+ 	w: integer;
+ 	d: integer;
+ 	m: integer;
+ 	mm: integer;
+ 	ww: integer;
+ 	prevw: integer;
+ 	n, minn, maxn: halfword;
+ 	mind, maxd: halfword;
+     begin
+ 	mind := 32767;
+ 	maxd := -32768;
+ 	minn := 32767;
+ 	maxn := -32768;
+ 	p := mem[curedges].hh.rh;
+ 	n := mem[curedges + 1].hh.lh;
+ 	while p <> curedges do begin
+ 	    if mem[p + 1].hh.lh > (-29999) then 
+ 		sortedges(p);
+ 	    if mem[p + 1].hh.rh <> 30000 then begin {349:}
+ 		r := 29999;
+ 		q := mem[p + 1].hh.rh;
+ 		ww := 0;
+ 		m := 1000000;
+ 		prevw := 0;
+ 		while true do begin
+ 		    if q = 30000 then 
+ 			mm := 1000000
+ 		    else begin
+ 			d := mem[q].hh.lh + 32768;
+ 			mm := d div 8;
+ 			ww := (ww + (d mod 8)) - 4
+ 		    end;
+ 		    if mm > m then begin {350:}
+ 			if w <> prevw then begin
+ 			    s := getavail;
+ 			    mem[r].hh.rh := s;
+ 			    mem[s].hh.lh := (((8 * m) - 32764) + w) - prevw;
+ 			    r := s;
+ 			    prevw := w
+ 			end {:350};
+ 			if q = 30000 then 
+ 			    goto 30
+ 		    end;
+ 		    m := mm;
+ 		    if ww >= wlo then 
+ 			if ww <= whi then 
+ 			    w := win
+ 			else 
+ 			    w := wout
+ 		    else 
+ 			w := wout;
+ 		    s := mem[q].hh.rh;
+ 		    begin
+ 			mem[q].hh.rh := avail;
+ 			avail := q
+ 		    end {dynused:=dynused-1;};
+ 		    q := s
+ 		end;
+     30:
+ 		mem[r].hh.rh := 30000;
+ 		mem[p + 1].hh.rh := mem[29999].hh.rh;
+ 		if r <> 29999 then begin {351:}
+ 		    if minn = 32767 then 
+ 			minn := n;
+ 		    maxn := n;
+ 		    if mind > mem[mem[29999].hh.rh].hh.lh then 
+ 			mind := mem[mem[29999].hh.rh].hh.lh;
+ 		    if maxd < mem[r].hh.lh then 
+ 			maxd := mem[r].hh.lh
+ 		end {:351}
+ 	    end {:349};
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 1
+ 	end; {352:}
+ 	if minn > maxn then begin {353:}
+ 	    p := mem[curedges].hh.rh;
+ 	    while p <> curedges do begin
+ 		q := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := q
+ 	    end;
+ 	    initedges(curedges)
+ 	end else begin {:353}
+ 	    n := mem[curedges + 1].hh.lh;
+ 	    mem[curedges + 1].hh.lh := minn;
+ 	    while minn > n do begin
+ 		p := mem[curedges].hh.rh;
+ 		mem[curedges].hh.rh := mem[p].hh.rh;
+ 		mem[mem[p].hh.rh].hh.lh := curedges;
+ 		freenode(p, 2);
+ 		n := n + 1
+ 	    end;
+ 	    n := mem[curedges + 1].hh.rh;
+ 	    mem[curedges + 1].hh.rh := maxn;
+ 	    mem[curedges + 5].hh.lh := maxn + 1;
+ 	    mem[curedges + 5].hh.rh := curedges;
+ 	    while maxn < n do begin
+ 		p := mem[curedges].hh.lh;
+ 		mem[curedges].hh.lh := mem[p].hh.lh;
+ 		mem[mem[p].hh.lh].hh.rh := curedges;
+ 		freenode(p, 2);
+ 		n := n - 1
+ 	    end;
+ 	    mem[curedges + 2].hh.lh := (((mind + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096;
+ 	    mem[curedges + 2].hh.rh := (((maxd + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096
+ 	end {:352};
+ 	mem[curedges + 4].int := 0
+     end; {:348} {354:}
+ 
+     procedure xyswapedges;
+     label
+ 	30;
+     var
+ 	mmagic, nmagic: integer;
+ 	p, q, r, s: halfword; {357:}
+ 	mspread: integer;
+ 	j, jj: 0..movesize;
+ 	m, mm: integer;
+ 	pd, rd: integer;
+ 	pm, rm: integer;
+ 	w: integer;
+ 	ww: integer;
+ 	dw: integer; {:357} {363:}
+ 	extras: integer;
+ 	xw: -3..3;
+ 	k: integer; {:363} {356:}
+     begin
+ 	mspread := mem[curedges + 2].hh.rh - mem[curedges + 2].hh.lh;
+ 	if mspread > movesize then 
+ 	    overflow(407, movesize);
+ 	for j := 0 to mspread do 
+ 	    move[j] := 30000 {:356}; {355:}
+ 	p := getnode(2);
+ 	mem[p + 1].hh.rh := 30000;
+ 	mem[p + 1].hh.lh := -30000;
+ 	mem[p].hh.lh := curedges;
+ 	mem[mem[curedges].hh.rh].hh.lh := p;
+ 	p := getnode(2);
+ 	mem[p + 1].hh.rh := 30000;
+ 	mem[p].hh.lh := mem[curedges].hh.lh; {:355} {365:}
+ 	mmagic := (mem[curedges + 2].hh.lh + mem[curedges + 3].hh.lh) - 4096;
+ 	nmagic := (8 * mem[curedges + 1].hh.rh) - 32756 {:365};
+ 	repeat
+ 	    q := mem[p].hh.lh;
+ 	    if mem[q + 1].hh.lh > (-29999) then 
+ 		sortedges(q); {358:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    freenode(p, 2);
+ 	    p := r;
+ 	    pd := mem[p].hh.lh + 32768;
+ 	    pm := pd div 8;
+ 	    r := mem[q + 1].hh.rh;
+ 	    rd := mem[r].hh.lh + 32768;
+ 	    rm := rd div 8;
+ 	    w := 0;
+ 	    while true do begin
+ 		if pm < rm then 
+ 		    mm := pm
+ 		else 
+ 		    mm := rm;
+ 		if w <> 0 then  {362:}
+ 		    if m <> mm then begin
+ 			if (mm - mmagic) >= movesize then 
+ 			    confusion(377);
+ 			extras := (abs(w) - 1) div 3;
+ 			if extras > 0 then begin
+ 			    if w > 0 then 
+ 				xw := +3
+ 			    else 
+ 				xw := -3;
+ 			    ww := w - (extras * xw)
+ 			end else 
+ 			    ww := w;
+ 			repeat
+ 			    j := m - mmagic;
+ 			    for k := 1 to extras do begin
+ 				s := getavail;
+ 				mem[s].hh.lh := nmagic + xw;
+ 				mem[s].hh.rh := move[j];
+ 				move[j] := s
+ 			    end;
+ 			    s := getavail;
+ 			    mem[s].hh.lh := nmagic + ww;
+ 			    mem[s].hh.rh := move[j];
+ 			    move[j] := s;
+ 			    m := m + 1
+ 			until m = mm
+ 		    end {:362};
+ 		if pd < rd then begin
+ 		    dw := (pd mod 8) - 4; {360:}
+ 		    s := mem[p].hh.rh;
+ 		    begin
+ 			mem[p].hh.rh := avail;
+ 			avail := p
+ 		    end {dynused:=dynused-1;};
+ 		    p := s;
+ 		    pd := mem[p].hh.lh + 32768;
+ 		    pm := pd div 8 {:360}
+ 		end else begin
+ 		    if r = 30000 then 
+ 			goto 30;
+ 		    dw := -((rd mod 8) - 4); {359:}
+ 		    r := mem[r].hh.rh;
+ 		    rd := mem[r].hh.lh + 32768;
+ 		    rm := rd div 8 {:359}
+ 		end;
+ 		m := mm;
+ 		w := w + dw
+ 	    end;
+     30: {:358}
+ 	    ;
+ 	    p := q;
+ 	    nmagic := nmagic - 8
+ 	until mem[p].hh.lh = curedges;
+ 	freenode(p, 2); {364:}
+ 	move[mspread] := 0;
+ 	j := 0;
+ 	while move[j] = 30000 do 
+ 	    j := j + 1;
+ 	if j = mspread then 
+ 	    initedges(curedges)
+ 	else begin
+ 	    mm := mem[curedges + 2].hh.lh;
+ 	    mem[curedges + 2].hh.lh := mem[curedges + 1].hh.lh;
+ 	    mem[curedges + 2].hh.rh := mem[curedges + 1].hh.rh + 1;
+ 	    mem[curedges + 3].hh.lh := 4096;
+ 	    jj := mspread - 1;
+ 	    while move[jj] = 30000 do 
+ 		jj := jj - 1;
+ 	    mem[curedges + 1].hh.lh := j + mm;
+ 	    mem[curedges + 1].hh.rh := jj + mm;
+ 	    q := curedges;
+ 	    repeat
+ 		p := getnode(2);
+ 		mem[q].hh.rh := p;
+ 		mem[p].hh.lh := q;
+ 		mem[p + 1].hh.rh := move[j];
+ 		mem[p + 1].hh.lh := -30000;
+ 		j := j + 1;
+ 		q := p
+ 	    until j > jj;
+ 	    mem[q].hh.rh := curedges;
+ 	    mem[curedges].hh.lh := q;
+ 	    mem[curedges + 5].hh.lh := mem[curedges + 1].hh.rh + 1;
+ 	    mem[curedges + 5].hh.rh := curedges;
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; {:364}
+ {:354}
+     {366:}
+ 
+     procedure mergeedges(h: halfword);
+     label
+ 	30;
+     var
+ 	p, q, r, pp, qq, rr: halfword;
+ 	n: integer;
+ 	k: halfword;
+ 	delta: integer;
+     begin
+ 	if mem[h].hh.rh <> h then begin
+ 	    if (((mem[h + 2].hh.lh < mem[curedges + 2].hh.lh) or (mem[h + 2].hh.rh > mem[curedges + 2].hh.rh)) or (mem[h + 1].hh.lh < mem[curedges + 1].hh.lh)) or (mem[h + 1].hh.rh > mem[curedges + 1].hh.rh) then 
+ 		edgeprep(mem[h + 2].hh.lh - 4096, mem[h + 2].hh.rh - 4096, mem[h + 1].hh.lh - 4096, mem[h + 1].hh.rh - 4095);
+ 	    if mem[h + 3].hh.lh <> mem[curedges + 3].hh.lh then begin {367:}
+ 		pp := mem[h].hh.rh;
+ 		delta := 8 * (mem[curedges + 3].hh.lh - mem[h + 3].hh.lh);
+ 		repeat
+ 		    qq := mem[pp + 1].hh.rh;
+ 		    while qq <> 30000 do begin
+ 			mem[qq].hh.lh := mem[qq].hh.lh + delta;
+ 			qq := mem[qq].hh.rh
+ 		    end;
+ 		    qq := mem[pp + 1].hh.lh;
+ 		    while qq > (-29999) do begin
+ 			mem[qq].hh.lh := mem[qq].hh.lh + delta;
+ 			qq := mem[qq].hh.rh
+ 		    end;
+ 		    pp := mem[pp].hh.rh
+ 		until pp = h
+ 	    end {:367};
+ 	    n := mem[curedges + 1].hh.lh;
+ 	    p := mem[curedges].hh.rh;
+ 	    pp := mem[h].hh.rh;
+ 	    while n < mem[h + 1].hh.lh do begin
+ 		n := n + 1;
+ 		p := mem[p].hh.rh
+ 	    end; {368:}
+ 	    repeat
+ 		qq := mem[pp + 1].hh.lh;
+ 		if qq > (-29999) then 
+ 		    if mem[p + 1].hh.lh <= (-29999) then 
+ 			mem[p + 1].hh.lh := qq
+ 		    else begin
+ 			while mem[qq].hh.rh > (-29999) do 
+ 			    qq := mem[qq].hh.rh;
+ 			mem[qq].hh.rh := mem[p + 1].hh.lh;
+ 			mem[p + 1].hh.lh := mem[pp + 1].hh.lh
+ 		    end;
+ 		mem[pp + 1].hh.lh := -30000;
+ 		qq := mem[pp + 1].hh.rh;
+ 		if qq <> 30000 then begin
+ 		    if mem[p + 1].hh.lh = (-29999) then 
+ 			mem[p + 1].hh.lh := -30000;
+ 		    mem[pp + 1].hh.rh := 30000;
+ 		    r := p + 1;
+ 		    q := mem[r].hh.rh;
+ 		    if q = 30000 then 
+ 			mem[p + 1].hh.rh := qq
+ 		    else 
+ 			while true do begin
+ 			    k := mem[qq].hh.lh;
+ 			    while k > mem[q].hh.lh do begin
+ 				r := q;
+ 				q := mem[r].hh.rh
+ 			    end;
+ 			    mem[r].hh.rh := qq;
+ 			    rr := mem[qq].hh.rh;
+ 			    mem[qq].hh.rh := q;
+ 			    if rr = 30000 then 
+ 				goto 30;
+ 			    r := qq;
+ 			    qq := rr
+ 			end
+ 		end;
+     30: {:368}
+ 		;
+ 		pp := mem[pp].hh.rh;
+ 		p := mem[p].hh.rh
+ 	    until pp = h
+ 	end
+     end; {:366} {369:}
+ 
+     function totalweight(h: halfword): integer;
+     var
+ 	p, q: halfword;
+ 	n: integer;
+ 	m: 0..65535;
+     begin
+ 	n := 0;
+ 	p := mem[h].hh.rh;
+ 	while p <> h do begin
+ 	    q := mem[p + 1].hh.rh;
+ 	    while q <> 30000 do begin {370:}
+ 		m := mem[q].hh.lh + 32768;
+ 		n := n - (((m mod 8) - 4) * (m div 8));
+ 		q := mem[q].hh.rh
+ 	    end {:370};
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin {370:}
+ 		m := mem[q].hh.lh + 32768;
+ 		n := n - (((m mod 8) - 4) * (m div 8));
+ 		q := mem[q].hh.rh
+ 	    end {:370};
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	totalweight := n
+     end; {:369}
+ {372:}
+ 
+     procedure beginedgetracing;
+     begin
+ 	printdiagnostic(408, 155, true);
+ 	print(409);
+ 	printint(curwt);
+ 	printchar(41);
+ 	tracex := -4096
+     end; { beginedgetracing }
+ 
+     procedure traceacorner;
+     begin
+ 	if fileoffset > (maxprintline - 13) then 
+ 	    printnl(155);
+ 	printchar(40);
+ 	printint(tracex);
+ 	printchar(44);
+ 	printint(traceyy);
+ 	printchar(41);
+ 	tracey := traceyy
+     end;
+ 
+     procedure endedgetracing;
+     begin
+ 	if tracex = (-4096) then 
+ 	    printnl(410)
+ 	else begin
+ 	    traceacorner;
+ 	    printchar(46)
+ 	end;
+ 	enddiagnostic(true)
+     end; {:372} {373:}
+ 
+     procedure tracenewedge(r: halfword; n: integer);
+     var
+ 	d: integer;
+ 	w: -3..3;
+ 	m, n0, n1: integer;
+     begin
+ 	d := mem[r].hh.lh + 32768;
+ 	w := (d mod 8) - 4;
+ 	m := (d div 8) - mem[curedges + 3].hh.lh;
+ 	if w = curwt then begin
+ 	    n0 := n + 1;
+ 	    n1 := n
+ 	end else begin
+ 	    n0 := n;
+ 	    n1 := n + 1
+ 	end;
+ 	if m <> tracex then begin
+ 	    if tracex = (-4096) then begin
+ 		printnl(155);
+ 		traceyy := n0
+ 	    end else if traceyy <> n0 then 
+ 		printchar(63)
+ 	    else 
+ 		traceacorner;
+ 	    tracex := m;
+ 	    traceacorner
+ 	end else begin
+ 	    if n0 <> traceyy then 
+ 		printchar(33);
+ 	    if ((n0 < n1) and (tracey > traceyy)) or ((n0 > n1) and (tracey < traceyy)) then 
+ 		traceacorner
+ 	end;
+ 	traceyy := n1
+     end; {:373} {374:}
+ 
+     procedure lineedges(x0, y0, x1, y1: scaled);
+     label
+ 	30, 31;
+     var
+ 	m0, n0, m1, n1: integer;
+ 	delx, dely: scaled;
+ 	yt: scaled;
+ 	tx: scaled;
+ 	p, r: halfword;
+ 	base: integer;
+ 	n: integer;
+     begin
+ 	n0 := roundunscaled(y0);
+ 	n1 := roundunscaled(y1);
+ 	if n0 <> n1 then begin
+ 	    m0 := roundunscaled(x0);
+ 	    m1 := roundunscaled(x1);
+ 	    delx := x1 - x0;
+ 	    dely := y1 - y0;
+ 	    yt := (n0 * 65536) - 32768;
+ 	    y0 := y0 - yt;
+ 	    y1 := y1 - yt;
+ 	    if n0 < n1 then begin {375:}
+ 		base := ((8 * mem[curedges + 3].hh.lh) - 32764) - curwt;
+ 		if m0 <= m1 then 
+ 		    edgeprep(m0, m1, n0, n1)
+ 		else 
+ 		    edgeprep(m1, m0, n0, n1); {377:}
+ 		n := mem[curedges + 5].hh.lh - 4096;
+ 		p := mem[curedges + 5].hh.rh;
+ 		if n <> n0 then 
+ 		    if n < n0 then 
+ 			repeat
+ 			    n := n + 1;
+ 			    p := mem[p].hh.rh
+ 			until n = n0
+ 		    else 
+ 			repeat
+ 			    n := n - 1;
+ 			    p := mem[p].hh.lh
+ 			until n = n0 {:377};
+ 		y0 := 65536 - y0;
+ 		while true do begin
+ 		    r := getavail;
+ 		    mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		    mem[p + 1].hh.lh := r;
+ 		    tx := takefraction(delx, makefraction(y0, dely));
+ 		    if abvscd(delx, y0, dely, tx) < 0 then 
+ 			tx := tx - 1;
+ 		    mem[r].hh.lh := (8 * roundunscaled(x0 + tx)) + base;
+ 		    y1 := y1 - 65536;
+ 		    if internal[10] > 0 then 
+ 			tracenewedge(r, n);
+ 		    if y1 < 65536 then 
+ 			goto 30;
+ 		    p := mem[p].hh.rh;
+ 		    y0 := y0 + 65536;
+ 		    n := n + 1
+ 		end;
+     30: {:375}
+ 		
+ 	    end else begin {376:}
+ 		base := ((8 * mem[curedges + 3].hh.lh) - 32764) + curwt;
+ 		if m0 <= m1 then 
+ 		    edgeprep(m0, m1, n1, n0)
+ 		else 
+ 		    edgeprep(m1, m0, n1, n0);
+ 		n0 := n0 - 1;
+ {377:}
+ 		n := mem[curedges + 5].hh.lh - 4096;
+ 		p := mem[curedges + 5].hh.rh;
+ 		if n <> n0 then 
+ 		    if n < n0 then 
+ 			repeat
+ 			    n := n + 1;
+ 			    p := mem[p].hh.rh
+ 			until n = n0
+ 		    else 
+ 			repeat
+ 			    n := n - 1;
+ 			    p := mem[p].hh.lh
+ 			until n = n0 {:377};
+ 		while true do begin
+ 		    r := getavail;
+ 		    mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		    mem[p + 1].hh.lh := r;
+ 		    tx := takefraction(delx, makefraction(y0, dely));
+ 		    if abvscd(delx, y0, dely, tx) < 0 then 
+ 			tx := tx + 1;
+ 		    mem[r].hh.lh := (8 * roundunscaled(x0 - tx)) + base;
+ 		    y1 := y1 + 65536;
+ 		    if internal[10] > 0 then 
+ 			tracenewedge(r, n);
+ 		    if y1 >= 0 then 
+ 			goto 31;
+ 		    p := mem[p].hh.lh;
+ 		    y0 := y0 + 65536;
+ 		    n := n - 1
+ 		end;
+     31: {:376}
+ 		
+ 	    end;
+ 	    mem[curedges + 5].hh.rh := p;
+ 	    mem[curedges + 5].hh.lh := n + 4096
+ 	end
+     end; {:374}
+ {378:}
+ 
+     procedure movetoedges(m0, n0, m1, n1: integer);
+     label
+ 	60, 61, 62, 63, 30;
+     var
+ 	delta: 0..movesize;
+ 	k: 0..movesize;
+ 	p, r: halfword;
+ 	dx: integer;
+ 	edgeandweight: integer;
+ 	j: integer;
+ 	n: integer; {sum:integer;}
+     {sum:=move[0];
+     for k:=1 to delta do sum:=sum+abs(move[k]);
+     if sum<>m1-m0 then confusion(48);}
+     begin
+ 	delta := n1 - n0;
+ 	{380:}
+ 	case octant of
+ 	    1:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(m0, m1, n0, n1);
+ 		    goto 60
+ 		end;
+ 	    5:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(n0, n1, m0, m1);
+ 		    goto 62
+ 		end;
+ 	    6:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-n1, -n0, m0, m1);
+ 		    n0 := -n0;
+ 		    goto 62
+ 		end;
+ 	    2:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-m1, -m0, n0, n1);
+ 		    m0 := -m0;
+ 		    goto 60
+ 		end;
+ 	    4:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-m1, -m0, -n1, -n0);
+ 		    m0 := -m0;
+ 		    goto 61
+ 		end;
+ 	    8:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-n1, -n0, -m1, -m0);
+ 		    n0 := -n0;
+ 		    goto 63
+ 		end;
+ 	    7:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(n0, n1, -m1, -m0);
+ 		    goto 63
+ 		end;
+ 	    3:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(m0, m1, -n1, -n0);
+ 		    goto 61
+ 		end
+ 	end; {:380}
+     60: {381:} {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	if delta > 0 then begin
+ 	    k := 0;
+ 	    edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) - curwt;
+ 	    repeat
+ 		edgeandweight := edgeandweight + (dx * move[k]);
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.rh;
+ 		k := k + 1;
+ 		n := n + 1
+ 	    until k = delta
+ 	end;
+ 	goto 30 {:381};
+     61: {382:}
+ 	n0 := (-n0) - 1; {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	if delta > 0 then begin
+ 	    k := 0;
+ 	    edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) + curwt;
+ 	    repeat
+ 		edgeandweight := edgeandweight + (dx * move[k]);
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.lh;
+ 		k := k + 1;
+ 		n := n - 1
+ 	    until k = delta
+ 	end;
+ 	goto 30 {:382};
+     62: {383:}
+ 	edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) - curwt;
+ 	n0 := m0;
+ 	k := 0;
+ {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	repeat
+ 	    j := move[k];
+ 	    while j > 0 do begin
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.rh;
+ 		j := j - 1;
+ 		n := n + 1
+ 	    end;
+ 	    edgeandweight := edgeandweight + dx;
+ 	    k := k + 1
+ 	until k > delta;
+ 	goto 30 {:383};
+     63: {384:}
+ 	edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) + curwt;
+ 	n0 := (-m0) - 1;
+ 	k := 0;
+ {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	repeat
+ 	    j := move[k];
+ 	    while j > 0 do begin
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.lh;
+ 		j := j - 1;
+ 		n := n - 1
+ 	    end;
+ 	    edgeandweight := edgeandweight + dx;
+ 	    k := k + 1
+ 	until k > delta;
+ 	goto 30 {:384};
+     30:
+ 	mem[curedges + 5].hh.lh := n + 4096;
+ 	mem[curedges + 5].hh.rh := p
+     end; {:378} {387:}
+ 
+     procedure skew(x, y: scaled; octant: smallnumber);
+     begin
+ 	case octant of
+ 	    1:
+ 		begin
+ 		    curx := x - y;
+ 		    cury := y
+ 		end;
+ 	    5:
+ 		begin
+ 		    curx := y - x;
+ 		    cury := x
+ 		end;
+ 	    6:
+ 		begin
+ 		    curx := y + x;
+ 		    cury := -x
+ 		end;
+ 	    2:
+ 		begin
+ 		    curx := (-x) - y;
+ 		    cury := y
+ 		end;
+ 	    4:
+ 		begin
+ 		    curx := (-x) + y;
+ 		    cury := -y
+ 		end;
+ 	    8:
+ 		begin
+ 		    curx := (-y) + x;
+ 		    cury := -x
+ 		end;
+ 	    7:
+ 		begin
+ 		    curx := (-y) - x;
+ 		    cury := x
+ 		end;
+ 	    3:
+ 		begin
+ 		    curx := x + y;
+ 		    cury := -y
+ 		end
+ 	end
+     end; {:387} {390:}
+ 
+     procedure abnegate(x, y: scaled; octantbefore, octantafter: smallnumber);
+     begin
+ 	if odd(octantbefore) = odd(octantafter) then 
+ 	    curx := x
+ 	else 
+ 	    curx := -x;
+ 	if (octantbefore > 2) = (octantafter > 2) then 
+ 	    cury := y
+ 	else 
+ 	    cury := -y
+     end; {:390}
+ {391:}
+ 
+     function crossingpoint(a, b, c: integer): fraction;
+     label
+ 	10;
+     var
+ 	d: integer;
+ 	x, xx, x0, x1, x2: integer;
+     begin
+ 	if a < 0 then begin
+ 	    crossingpoint := 0;
+ 	    goto 10
+ 	end;
+ 	if c >= 0 then begin
+ 	    if b >= 0 then 
+ 		if c > 0 then begin
+ 		    crossingpoint := 268435457;
+ 		    goto 10
+ 		end else if (a = 0) and (b = 0) then begin
+ 		    crossingpoint := 268435457;
+ 		    goto 10
+ 		end else begin
+ 		    crossingpoint := 268435456;
+ 		    goto 10
+ 		end;
+ 	    if a = 0 then begin
+ 		crossingpoint := 0;
+ 		goto 10
+ 	    end
+ 	end else if a = 0 then 
+ 	    if b <= 0 then begin
+ 		crossingpoint := 0;
+ 		goto 10
+ 	    end;
+ {392:}
+ 	d := 1;
+ 	x0 := a;
+ 	x1 := a - b;
+ 	x2 := b - c;
+ 	repeat
+ 	    x := (x1 + x2) div 2;
+ 	    if (x1 - x0) > x0 then begin
+ 		x2 := x;
+ 		x0 := x0 + x0;
+ 		d := d + d
+ 	    end else begin
+ 		xx := (x1 + x) - x0;
+ 		if xx > x0 then begin
+ 		    x2 := x;
+ 		    x0 := x0 + x0;
+ 		    d := d + d
+ 		end else begin
+ 		    x0 := x0 - xx;
+ 		    if x <= x0 then 
+ 			if (x + x2) <= x0 then begin
+ 			    crossingpoint := 268435457;
+ 			    goto 10
+ 			end;
+ 		    x1 := x;
+ 		    d := (d + d) + 1
+ 		end
+ 	    end
+ 	until d >= 268435456;
+ 	crossingpoint := d - 268435456 {:392};
+     10:
+ 	
+     end; {:391} {394:}
+ 
+     procedure printspec(s: strnumber);
+     label
+ 	45, 30;
+     var
+ 	p, q: halfword;
+ 	octant: smallnumber;
+     begin
+ 	printdiagnostic(411, s, true);
+ 	p := curspec;
+ 	octant := mem[p + 3].int;
+ 	println;
+ 	unskew(mem[curspec + 1].int, mem[curspec + 2].int, octant);
+ 	printtwo(curx, cury);
+ 	print(412);
+ 	while true do begin
+ 	    print(octantdir[octant]);
+ 	    printchar(39);
+ 	    while true do begin
+ 		q := mem[p].hh.rh;
+ 		if mem[p].hh.b1 = 0 then 
+ 		    goto 45;
+ {397:}
+ 		begin
+ 		    printnl(423);
+ 		    unskew(mem[p + 5].int, mem[p + 6].int, octant);
+ 		    printtwo(curx, cury);
+ 		    print(390);
+ 		    unskew(mem[q + 3].int, mem[q + 4].int, octant);
+ 		    printtwo(curx, cury);
+ 		    printnl(387);
+ 		    unskew(mem[q + 1].int, mem[q + 2].int, octant);
+ 		    printtwo(curx, cury);
+ 		    print(424);
+ 		    printint(mem[q].hh.b0 - 1)
+ 		end {:397};
+ 		p := q
+ 	    end;
+     45:
+ 	    if q = curspec then 
+ 		goto 30;
+ 	    p := q;
+ 	    octant := mem[p + 3].int;
+ 	    printnl(413)
+ 	end;
+     30:
+ 	printnl(414);
+ 	enddiagnostic(true)
+     end; {:394} {398:}
+ 
+     procedure printstrange(s: strnumber);
+     var
+ 	p: halfword;
+ 	f: halfword;
+ 	q: halfword;
+ 	t: integer;
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	printnl(62); {399:}
+ 	p := curspec;
+ 	t := 128;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    if mem[p].hh.b0 <> 0 then begin
+ 		if mem[p].hh.b0 < t then 
+ 		    f := p;
+ 		t := mem[p].hh.b0
+ 	    end
+ 	until p = curspec {:399}; {400:}
+ 	p := curspec;
+ 	q := p;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    if mem[p].hh.b0 = 0 then 
+ 		q := p
+ 	until p = f {:400};
+ 	t := 0;
+ 	repeat
+ 	    if mem[p].hh.b0 <> 0 then begin
+ 		if mem[p].hh.b0 <> t then begin
+ 		    t := mem[p].hh.b0;
+ 		    printchar(32);
+ 		    printint(t - 1)
+ 		end;
+ 		if q <> (-30000) then begin {401:}
+ 		    if mem[mem[q].hh.rh].hh.b0 = 0 then begin
+ 			print(425);
+ 			print(octantdir[mem[q + 3].int]);
+ 			q := mem[q].hh.rh;
+ 			while mem[mem[q].hh.rh].hh.b0 = 0 do begin
+ 			    printchar(32);
+ 			    print(octantdir[mem[q + 3].int]);
+ 			    q := mem[q].hh.rh
+ 			end;
+ 			printchar(41)
+ 		    end {:401};
+ 		    printchar(32);
+ 		    print(octantdir[mem[q + 3].int]);
+ 		    q := -30000
+ 		end
+ 	    end else if q = (-30000) then 
+ 		q := p;
+ 	    p := mem[p].hh.rh
+ 	until p = f;
+ 	printchar(32);
+ 	printint(mem[p].hh.b0 - 1);
+ 	if q <> (-30000) then  {401:}
+ 	    if mem[mem[q].hh.rh].hh.b0 = 0 then begin
+ 		print(425);
+ 		print(octantdir[mem[q + 3].int]);
+ 		q := mem[q].hh.rh;
+ 		while mem[mem[q].hh.rh].hh.b0 = 0 do begin
+ 		    printchar(32);
+ 		    print(octantdir[mem[q + 3].int]);
+ 		    q := mem[q].hh.rh
+ 		end;
+ 		printchar(41)
+ 	    end {:401};
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(s)
+ 	end
+     end; { printstrange }
+ {:398}
+     {402:}
+     {405:}
+ 
+     procedure removecubic(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	mem[p].hh.b1 := mem[q].hh.b1;
+ 	mem[p].hh.rh := mem[q].hh.rh;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	mem[p + 2].int := mem[q + 2].int;
+ 	mem[p + 5].int := mem[q + 5].int;
+ 	mem[p + 6].int := mem[q + 6].int;
+ 	freenode(q, 7)
+     end; {:405} {406:} {410:}
+ 
+     procedure splitcubic(p: halfword; t: fraction; xq, yq: scaled);
+     var
+ 	v: scaled;
+ 	q, r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	r := getnode(7);
+ 	mem[p].hh.rh := r;
+ 	mem[r].hh.rh := q;
+ 	mem[r].hh.b0 := mem[q].hh.b0;
+ 	mem[r].hh.b1 := mem[p].hh.b1;
+ 	v := mem[p + 5].int - takefraction(mem[p + 5].int - mem[q + 3].int, t);
+ 	mem[p + 5].int := mem[p + 1].int - takefraction(mem[p + 1].int - mem[p + 5].int, t);
+ 	mem[q + 3].int := mem[q + 3].int - takefraction(mem[q + 3].int - xq, t);
+ 	mem[r + 3].int := mem[p + 5].int - takefraction(mem[p + 5].int - v, t);
+ 	mem[r + 5].int := v - takefraction(v - mem[q + 3].int, t);
+ 	mem[r + 1].int := mem[r + 3].int - takefraction(mem[r + 3].int - mem[r + 5].int, t);
+ 	v := mem[p + 6].int - takefraction(mem[p + 6].int - mem[q + 4].int, t);
+ 	mem[p + 6].int := mem[p + 2].int - takefraction(mem[p + 2].int - mem[p + 6].int, t);
+ 	mem[q + 4].int := mem[q + 4].int - takefraction(mem[q + 4].int - yq, t);
+ 	mem[r + 4].int := mem[p + 6].int - takefraction(mem[p + 6].int - v, t);
+ 	mem[r + 6].int := v - takefraction(v - mem[q + 4].int, t);
+ 	mem[r + 2].int := mem[r + 4].int - takefraction(mem[r + 4].int - mem[r + 6].int, t)
+     end; {:410}
+ 
+     procedure quadrantsubdivide;
+     label
+ 	22, 10;
+     var
+ 	p, q, r, s, pp, qq: halfword;
+ 	firstx, firsty: scaled;
+ 	del1, del2, del3, del, dmax: scaled;
+ 	t: fraction;
+ 	destx, desty: scaled;
+ 	constantx: boolean;
+     begin
+ 	p := curspec;
+ 	firstx := mem[curspec + 1].int;
+ 	firsty := mem[curspec + 2].int;
+ 	repeat
+     22:
+ 	    q := mem[p].hh.rh; {407:}
+ 	    if q = curspec then begin
+ 		destx := firstx;
+ 		desty := firsty
+ 	    end else begin
+ 		destx := mem[q + 1].int;
+ 		desty := mem[q + 2].int
+ 	    end;
+ 	    del1 := mem[p + 5].int - mem[p + 1].int;
+ 	    del2 := mem[q + 3].int - mem[p + 5].int;
+ 	    del3 := destx - mem[q + 3].int; {408:}
+ 	    if del1 <> 0 then 
+ 		del := del1
+ 	    else if del2 <> 0 then 
+ 		del := del2
+ 	    else 
+ 		del := del3;
+ 	    if del <> 0 then begin
+ 		dmax := abs(del1);
+ 		if abs(del2) > dmax then 
+ 		    dmax := abs(del2);
+ 		if abs(del3) > dmax then 
+ 		    dmax := abs(del3);
+ 		while dmax < 134217728 do begin
+ 		    dmax := dmax + dmax;
+ 		    del1 := del1 + del1;
+ 		    del2 := del2 + del2;
+ 		    del3 := del3 + del3
+ 		end
+ 	    end {:408};
+ 	    if del = 0 then 
+ 		constantx := true
+ 	    else begin
+ 		constantx := false;
+ 		if del < 0 then begin {409:}
+ 		    mem[p + 1].int := -mem[p + 1].int;
+ 		    mem[p + 5].int := -mem[p + 5].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    destx := -destx;
+ 		    mem[p].hh.b1 := 2
+ 		end {:409};
+ 		t := crossingpoint(del1, del2, del3);
+ 		if t < 268435456 then begin {411:}
+ 		    splitcubic(p, t, destx, desty);
+ 		    r := mem[p].hh.rh;
+ 		    if mem[r].hh.b1 > 1 then 
+ 			mem[r].hh.b1 := 1
+ 		    else 
+ 			mem[r].hh.b1 := 2;
+ 		    if mem[r + 1].int < mem[p + 1].int then 
+ 			mem[r + 1].int := mem[p + 1].int;
+ 		    mem[r + 3].int := mem[r + 1].int;
+ 		    mem[r + 1].int := -mem[r + 1].int;
+ 		    mem[r + 5].int := mem[r + 1].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    destx := -destx;
+ 		    del2 := del2 - takefraction(del2 - del3, t);
+ 		    if del2 > 0 then 
+ 			del2 := 0;
+ 		    t := crossingpoint(0, -del2, -del3);
+ 		    if t < 268435456 then begin {412:}
+ 			splitcubic(r, t, destx, desty);
+ 			s := mem[r].hh.rh;
+ 			if mem[s + 1].int < destx then 
+ 			    mem[s + 1].int := destx;
+ 			if mem[s + 1].int < mem[r + 1].int then 
+ 			    mem[s + 1].int := mem[r + 1].int;
+ 			mem[s].hh.b1 := mem[p].hh.b1;
+ 			mem[s + 3].int := mem[s + 1].int;
+ 			mem[s + 1].int := -mem[s + 1].int;
+ 			mem[s + 5].int := mem[s + 1].int;
+ 			mem[q + 3].int := -mem[q + 3].int
+ 		    end else if mem[r + 1].int > destx then  {:412}
+ 			mem[r + 1].int := destx
+ 		end {:411}
+ 	    end {:407};
+ {413:}
+ 	    pp := p;
+ 	    repeat
+ 		qq := mem[pp].hh.rh;
+ 		abnegate(mem[qq + 1].int, mem[qq + 2].int, mem[qq].hh.b1, mem[pp].hh.b1);
+ 		destx := curx;
+ 		desty := cury;
+ 		del1 := mem[pp + 6].int - mem[pp + 2].int;
+ 		del2 := mem[qq + 4].int - mem[pp + 6].int;
+ 		del3 := desty - mem[qq + 4].int; {408:}
+ 		if del1 <> 0 then 
+ 		    del := del1
+ 		else if del2 <> 0 then 
+ 		    del := del2
+ 		else 
+ 		    del := del3;
+ 		if del <> 0 then begin
+ 		    dmax := abs(del1);
+ 		    if abs(del2) > dmax then 
+ 			dmax := abs(del2);
+ 		    if abs(del3) > dmax then 
+ 			dmax := abs(del3);
+ 		    while dmax < 134217728 do begin
+ 			dmax := dmax + dmax;
+ 			del1 := del1 + del1;
+ 			del2 := del2 + del2;
+ 			del3 := del3 + del3
+ 		    end
+ 		end {:408};
+ 		if del <> 0 then begin
+ 		    if del < 0 then begin {414:}
+ 			mem[pp + 2].int := -mem[pp + 2].int;
+ 			mem[pp + 6].int := -mem[pp + 6].int;
+ 			mem[qq + 4].int := -mem[qq + 4].int;
+ 			del1 := -del1;
+ 			del2 := -del2;
+ 			del3 := -del3;
+ 			desty := -desty;
+ 			mem[pp].hh.b1 := mem[pp].hh.b1 + 2
+ 		    end {:414};
+ 		    t := crossingpoint(del1, del2, del3);
+ 		    if t < 268435456 then begin {415:}
+ 			splitcubic(pp, t, destx, desty);
+ 			r := mem[pp].hh.rh;
+ 			if mem[r].hh.b1 > 2 then 
+ 			    mem[r].hh.b1 := mem[r].hh.b1 - 2
+ 			else 
+ 			    mem[r].hh.b1 := mem[r].hh.b1 + 2;
+ 			if mem[r + 1].int > destx then 
+ 			    mem[r + 1].int := destx
+ 			else if mem[r + 1].int < mem[pp + 1].int then 
+ 			    mem[r + 1].int := mem[pp + 1].int;
+ 			if mem[r + 2].int < mem[pp + 2].int then 
+ 			    mem[r + 2].int := mem[pp + 2].int;
+ 			mem[r + 4].int := mem[r + 2].int;
+ 			mem[r + 2].int := -mem[r + 2].int;
+ 			mem[r + 6].int := mem[r + 2].int;
+ 			mem[qq + 4].int := -mem[qq + 4].int;
+ 			desty := -desty;
+ 			del2 := del2 - takefraction(del2 - del3, t);
+ 			if del2 > 0 then 
+ 			    del2 := 0;
+ 			t := crossingpoint(0, -del2, -del3);
+ 			if t < 268435456 then begin {416:}
+ 			    splitcubic(r, t, destx, desty);
+ 			    s := mem[r].hh.rh;
+ 			    if mem[s + 1].int > destx then 
+ 				mem[s + 1].int := destx
+ 			    else if mem[s + 1].int < mem[r + 1].int then 
+ 				mem[s + 1].int := mem[r + 1].int;
+ 			    if mem[s + 2].int < desty then 
+ 				mem[s + 2].int := desty;
+ 			    if mem[s + 2].int < mem[r + 2].int then 
+ 				mem[s + 2].int := mem[r + 2].int;
+ 			    mem[s].hh.b1 := mem[pp].hh.b1;
+ 			    mem[s + 4].int := mem[s + 2].int;
+ 			    mem[s + 2].int := -mem[s + 2].int;
+ 			    mem[s + 6].int := mem[s + 2].int;
+ 			    mem[qq + 4].int := -mem[qq + 4].int
+ 			end else if mem[r + 2].int > desty then  {:416}
+ 			    mem[r + 2].int := desty
+ 		    end {:415}
+ 		end else if constantx then begin {417:}
+ 		    if q <> p then begin
+ 			removecubic(p);
+ 			if curspec <> q then 
+ 			    goto 22
+ 			else begin
+ 			    curspec := p;
+ 			    goto 10
+ 			end
+ 		    end
+ 		end else if not odd(mem[pp].hh.b1) then begin {414:}
+ 		    mem[pp + 2].int := -mem[pp + 2].int;
+ 		    mem[pp + 6].int := -mem[pp + 6].int;
+ 		    mem[qq + 4].int := -mem[qq + 4].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    desty := -desty;
+ 		    mem[pp].hh.b1 := mem[pp].hh.b1 + 2
+ 		end {:414} {:417};
+ 		pp := qq
+ 	    until pp = q;
+ 	    if constantx then begin {418:}
+ 		pp := p;
+ 		repeat
+ 		    qq := mem[pp].hh.rh;
+ 		    if mem[pp].hh.b1 > 2 then begin
+ 			mem[pp].hh.b1 := mem[pp].hh.b1 + 1;
+ 			mem[pp + 1].int := -mem[pp + 1].int;
+ 			mem[pp + 5].int := -mem[pp + 5].int;
+ 			mem[qq + 3].int := -mem[qq + 3].int
+ 		    end;
+ 		    pp := qq
+ 		until pp = q
+ 	    end {:418} {:413};
+ 	    p := q
+ 	until p = curspec;
+     10:
+ 	
+     end; {:406} {419:}
+ 
+     procedure octantsubdivide;
+     var
+ 	p, q, r, s: halfword;
+ 	del1, del2, del3, del, dmax: scaled;
+ 	t: fraction;
+ 	destx, desty: scaled;
+     begin
+ 	p := curspec;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    mem[p + 1].int := mem[p + 1].int - mem[p + 2].int;
+ 	    mem[p + 5].int := mem[p + 5].int - mem[p + 6].int;
+ 	    mem[q + 3].int := mem[q + 3].int - mem[q + 4].int; {420:} {421:}
+ 	    if q = curspec then begin
+ 		unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 		skew(curx, cury, mem[p].hh.b1);
+ 		destx := curx;
+ 		desty := cury
+ 	    end else begin
+ 		abnegate(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1, mem[p].hh.b1);
+ 		destx := curx - cury;
+ 		desty := cury
+ 	    end;
+ 	    del1 := mem[p + 5].int - mem[p + 1].int;
+ 	    del2 := mem[q + 3].int - mem[p + 5].int;
+ 	    del3 := destx - mem[q + 3].int {:421}; {408:}
+ 	    if del1 <> 0 then 
+ 		del := del1
+ 	    else if del2 <> 0 then 
+ 		del := del2
+ 	    else 
+ 		del := del3;
+ 	    if del <> 0 then begin
+ 		dmax := abs(del1);
+ 		if abs(del2) > dmax then 
+ 		    dmax := abs(del2);
+ 		if abs(del3) > dmax then 
+ 		    dmax := abs(del3);
+ 		while dmax < 134217728 do begin
+ 		    dmax := dmax + dmax;
+ 		    del1 := del1 + del1;
+ 		    del2 := del2 + del2;
+ 		    del3 := del3 + del3
+ 		end
+ 	    end {:408};
+ 	    if del <> 0 then begin
+ 		if del < 0 then begin {423:}
+ 		    mem[p + 2].int := mem[p + 1].int + mem[p + 2].int;
+ 		    mem[p + 1].int := -mem[p + 1].int;
+ 		    mem[p + 6].int := mem[p + 5].int + mem[p + 6].int;
+ 		    mem[p + 5].int := -mem[p + 5].int;
+ 		    mem[q + 4].int := mem[q + 3].int + mem[q + 4].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    desty := destx + desty;
+ 		    destx := -destx;
+ 		    mem[p].hh.b1 := mem[p].hh.b1 + 4
+ 		end {:423};
+ 		t := crossingpoint(del1, del2, del3);
+ 		if t < 268435456 then begin {424:}
+ 		    splitcubic(p, t, destx, desty);
+ 		    r := mem[p].hh.rh;
+ 		    if mem[r].hh.b1 > 4 then 
+ 			mem[r].hh.b1 := mem[r].hh.b1 - 4
+ 		    else 
+ 			mem[r].hh.b1 := mem[r].hh.b1 + 4;
+ 		    if mem[r + 2].int > desty then 
+ 			mem[r + 2].int := desty
+ 		    else if mem[r + 2].int < mem[p + 2].int then 
+ 			mem[r + 2].int := mem[p + 2].int;
+ 		    if mem[r + 1].int < mem[p + 1].int then 
+ 			mem[r + 1].int := mem[p + 1].int;
+ 		    mem[r + 3].int := mem[r + 1].int;
+ 		    mem[r + 2].int := mem[r + 2].int + mem[r + 1].int;
+ 		    mem[r + 1].int := -mem[r + 1].int;
+ 		    mem[r + 5].int := mem[r + 1].int;
+ 		    mem[r + 6].int := mem[r + 6].int - mem[r + 5].int;
+ 		    mem[q + 4].int := mem[q + 4].int + mem[q + 3].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    desty := desty + destx;
+ 		    destx := -destx;
+ 		    del2 := del2 - takefraction(del2 - del3, t);
+ 		    if del2 > 0 then 
+ 			del2 := 0;
+ 		    t := crossingpoint(0, -del2, -del3);
+ 		    if t < 268435456 then begin {425:}
+ 			splitcubic(r, t, destx, desty);
+ 			s := mem[r].hh.rh;
+ 			if mem[s + 2].int > desty then 
+ 			    mem[s + 2].int := desty
+ 			else if mem[s + 2].int < mem[r + 2].int then 
+ 			    mem[s + 2].int := mem[r + 2].int;
+ 			if mem[s + 1].int < destx then 
+ 			    mem[s + 1].int := destx;
+ 			if mem[s + 1].int < mem[r + 1].int then 
+ 			    mem[s + 1].int := mem[r + 1].int;
+ 			mem[s].hh.b1 := mem[p].hh.b1;
+ 			mem[s + 3].int := mem[s + 1].int;
+ 			mem[s + 2].int := mem[s + 2].int + mem[s + 1].int;
+ 			mem[s + 1].int := -mem[s + 1].int;
+ 			mem[s + 6].int := mem[s + 6].int - mem[s + 1].int;
+ 			mem[s + 5].int := mem[s + 1].int;
+ 			mem[q + 4].int := mem[q + 4].int + mem[q + 3].int;
+ 			mem[q + 3].int := -mem[q + 3].int
+ 		    end else if mem[r + 1].int > destx then  {:425}
+ 			mem[r + 1].int := destx {:424}
+ 		end
+ 	    end {:420};
+ 	    p := q
+ 	until p = curspec
+     end; {:419} {426:}
+ 
+     procedure makesafe;
+     var
+ 	k: 0..maxwiggle;
+ 	allsafe: boolean;
+ 	nexta: scaled;
+ 	deltaa, deltab: scaled;
+     begin
+ 	before[curroundingptr] := before[0];
+ 	nodetoround[curroundingptr] := nodetoround[0];
+ 	repeat
+ 	    after[curroundingptr] := after[0];
+ 	    allsafe := true;
+ 	    nexta := after[0];
+ 	    for k := 0 to curroundingptr - 1 do begin
+ 		deltab := before[k + 1] - before[k];
+ 		if deltab >= 0 then 
+ 		    deltaa := after[k + 1] - nexta
+ 		else 
+ 		    deltaa := nexta - after[k + 1];
+ 		nexta := after[k + 1];
+ 		if (deltaa < 0) or (deltaa > abs(deltab + deltab)) then begin
+ 		    allsafe := false;
+ 		    after[k] := before[k];
+ 		    if k = (curroundingptr - 1) then 
+ 			after[0] := before[0]
+ 		    else 
+ 			after[k + 1] := before[k + 1]
+ 		end
+ 	    end
+ 	until allsafe
+     end; {:426} {429:}
+ 
+     procedure beforeandafter(b, a: scaled; p: halfword);
+     begin
+ 	if curroundingptr = maxroundingptr then 
+ 	    if maxroundingptr < maxwiggle then 
+ 		maxroundingptr := maxroundingptr + 1
+ 	    else 
+ 		overflow(435, maxwiggle);
+ 	after[curroundingptr] := a;
+ 	before[curroundingptr] := b;
+ 	nodetoround[curroundingptr] := p;
+ 	curroundingptr := curroundingptr + 1
+     end; { beforeandafter }
+ {:429}
+     {431:}
+ 
+     function goodval(b, o: scaled): scaled;
+     var
+ 	a: scaled;
+     begin
+ 	a := b + o;
+ 	if a >= 0 then 
+ 	    a := (a - (a mod curgran)) - o
+ 	else 
+ 	    a := (((a + ((-(a + 1)) mod curgran)) - curgran) + 1) - o;
+ 	if (b - a) < ((a + curgran) - b) then 
+ 	    goodval := a
+ 	else 
+ 	    goodval := a + curgran
+     end; {:431} {432:}
+ 
+     function compromise(u, v: scaled): scaled;
+     begin
+ 	compromise := goodval(u + u, (-u) - v) div 2
+     end; {:432} {433:}
+ 
+     procedure xyround;
+     var
+ 	p, q: halfword;
+ 	b, a: scaled;
+ 	penedge: scaled;
+ 	alpha: fraction;
+     begin
+ 	curgran := abs(internal[37]);
+ 	if curgran = 0 then 
+ 	    curgran := 65536;
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {434:}
+ 	    if odd(mem[p].hh.b1) <> odd(mem[q].hh.b1) then begin
+ 		if odd(mem[q].hh.b1) then 
+ 		    b := mem[q + 1].int
+ 		else 
+ 		    b := -mem[q + 1].int;
+ 		if (abs(mem[q + 1].int - mem[q + 5].int) < 655) or (abs(mem[q + 1].int + mem[q + 3].int) < 655) then begin {435:}
+ 		    if curpen = (-29997) then 
+ 			penedge := 0
+ 		    else if curpathtype = 0 then 
+ 			penedge := compromise(mem[mem[curpen + 5].hh.rh + 2].int, mem[mem[curpen + 7].hh.rh + 2].int)
+ 		    else if odd(mem[q].hh.b1) then 
+ 			penedge := mem[mem[curpen + 7].hh.rh + 2].int
+ 		    else 
+ 			penedge := mem[mem[curpen + 5].hh.rh + 2].int;
+ 		    a := goodval(b, penedge)
+ 		end else  {:435}
+ 		    a := b;
+ 		if abs(a) > maxallowed then 
+ 		    if a > 0 then 
+ 			a := maxallowed
+ 		    else 
+ 			a := -maxallowed;
+ 		beforeandafter(b, a, q)
+ 	    end {:434};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {436:}
+ 	    makesafe;
+ 	    repeat
+ 		curroundingptr := curroundingptr - 1;
+ 		if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin
+ 		    p := nodetoround[curroundingptr];
+ 		    if odd(mem[p].hh.b1) then begin
+ 			b := before[curroundingptr];
+ 			a := after[curroundingptr]
+ 		    end else begin
+ 			b := -before[curroundingptr];
+ 			a := -after[curroundingptr]
+ 		    end;
+ 		    if before[curroundingptr] = before[curroundingptr + 1] then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]);
+ 		    repeat
+ 			mem[p + 1].int := takefraction(alpha, mem[p + 1].int - b) + a;
+ 			mem[p + 5].int := takefraction(alpha, mem[p + 5].int - b) + a;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 3].int := takefraction(alpha, mem[p + 3].int - b) + a
+ 		    until p = nodetoround[curroundingptr + 1]
+ 		end
+ 	    until curroundingptr = 0
+ 	end {:436};
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {437:}
+ 	    if (mem[p].hh.b1 > 2) <> (mem[q].hh.b1 > 2) then begin
+ 		if mem[q].hh.b1 <= 2 then 
+ 		    b := mem[q + 2].int
+ 		else 
+ 		    b := -mem[q + 2].int;
+ 		if (abs(mem[q + 2].int - mem[q + 6].int) < 655) or (abs(mem[q + 2].int + mem[q + 4].int) < 655) then begin {438:}
+ 		    if curpen = (-29997) then 
+ 			penedge := 0
+ 		    else if curpathtype = 0 then 
+ 			penedge := compromise(mem[mem[curpen + 2].hh.rh + 2].int, mem[mem[curpen + 1].hh.rh + 2].int)
+ 		    else if mem[q].hh.b1 <= 2 then 
+ 			penedge := mem[mem[curpen + 1].hh.rh + 2].int
+ 		    else 
+ 			penedge := mem[mem[curpen + 2].hh.rh + 2].int;
+ 		    a := goodval(b, penedge)
+ 		end else  {:438}
+ 		    a := b;
+ 		if abs(a) > maxallowed then 
+ 		    if a > 0 then 
+ 			a := maxallowed
+ 		    else 
+ 			a := -maxallowed;
+ 		beforeandafter(b, a, q)
+ 	    end {:437};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {439:}
+ 	    makesafe;
+ 	    repeat
+ 		curroundingptr := curroundingptr - 1;
+ 		if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin
+ 		    p := nodetoround[curroundingptr];
+ 		    if mem[p].hh.b1 <= 2 then begin
+ 			b := before[curroundingptr];
+ 			a := after[curroundingptr]
+ 		    end else begin
+ 			b := -before[curroundingptr];
+ 			a := -after[curroundingptr]
+ 		    end;
+ 		    if before[curroundingptr] = before[curroundingptr + 1] then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]);
+ 		    repeat
+ 			mem[p + 2].int := takefraction(alpha, mem[p + 2].int - b) + a;
+ 			mem[p + 6].int := takefraction(alpha, mem[p + 6].int - b) + a;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 4].int := takefraction(alpha, mem[p + 4].int - b) + a
+ 		    until p = nodetoround[curroundingptr + 1]
+ 		end
+ 	    until curroundingptr = 0
+ 	end {:439}
+     end; {:433} {440:}
+ 
+     procedure diaground;
+     var
+ 	p, q, pp: halfword;
+ 	b, a, bb, aa, d, c, dd, cc: scaled;
+ 	penedge: scaled;
+ 	alpha, beta: fraction;
+ 	nexta: scaled;
+ 	allsafe: boolean;
+ 	k: 0..maxwiggle;
+ 	firstx, firsty: scaled;
+     begin
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {441:}
+ 	    if mem[p].hh.b1 <> mem[q].hh.b1 then begin
+ 		if mem[q].hh.b1 > 4 then 
+ 		    b := -mem[q + 1].int
+ 		else 
+ 		    b := mem[q + 1].int;
+ 		if abs(mem[q].hh.b1 - mem[p].hh.b1) = 4 then 
+ 		    if (abs(mem[q + 1].int - mem[q + 5].int) < 655) or (abs(mem[q + 1].int + mem[q + 3].int) < 655) then begin {442:}
+ 			if curpen = (-29997) then 
+ 			    penedge := 0
+ 			else if curpathtype = 0 then  {443:}
+ 			    case mem[q].hh.b1 of
+ 				1, 5:
+ 				    penedge := compromise(mem[mem[mem[curpen + 1].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 4].hh.rh].hh.lh + 1].int);
+ 				4, 8:
+ 				    penedge := -compromise(mem[mem[mem[curpen + 1].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 4].hh.rh].hh.lh + 1].int);
+ 				6, 2:
+ 				    penedge := compromise(mem[mem[mem[curpen + 2].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 3].hh.rh].hh.lh + 1].int);
+ 				7, 3:
+ 				    penedge := -compromise(mem[mem[mem[curpen + 2].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 3].hh.rh].hh.lh + 1].int)
+ 			    end {:443}
+ 			else if mem[q].hh.b1 <= 4 then 
+ 			    penedge := mem[mem[mem[curpen + mem[q].hh.b1].hh.rh].hh.lh + 1].int
+ 			else 
+ 			    penedge := -mem[mem[mem[curpen + mem[q].hh.b1].hh.rh].hh.lh + 1].int;
+ 			if odd(mem[q].hh.b1) then 
+ 			    a := goodval(b, penedge + (curgran div 2))
+ 			else 
+ 			    a := goodval(b - 1, penedge + (curgran div 2))
+ 		    end else  {:442}
+ 			a := b
+ 		else 
+ 		    a := b;
+ 		beforeandafter(b, a, q)
+ 	    end {:441};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {444:}
+ 	    p := nodetoround[0];
+ 	    firstx := mem[p + 1].int;
+ 	    firsty := mem[p + 2].int; {446:}
+ 	    before[curroundingptr] := before[0];
+ 	    nodetoround[curroundingptr] := nodetoround[0];
+ 	    repeat
+ 		after[curroundingptr] := after[0];
+ 		allsafe := true;
+ 		nexta := after[0];
+ 		for k := 0 to curroundingptr - 1 do begin
+ 		    a := nexta;
+ 		    b := before[k];
+ 		    nexta := after[k + 1];
+ 		    aa := nexta;
+ 		    bb := before[k + 1];
+ 		    if (a <> b) or (aa <> bb) then begin
+ 			p := nodetoround[k];
+ 			pp := nodetoround[k + 1];
+ {445:}
+ 			if aa = bb then begin
+ 			    if pp = nodetoround[0] then 
+ 				unskew(firstx, firsty, mem[pp].hh.b1)
+ 			    else 
+ 				unskew(mem[pp + 1].int, mem[pp + 2].int, mem[pp].hh.b1);
+ 			    skew(curx, cury, mem[p].hh.b1);
+ 			    bb := curx;
+ 			    aa := bb;
+ 			    dd := cury;
+ 			    cc := dd;
+ 			    if mem[p].hh.b1 > 4 then begin
+ 				b := -b;
+ 				a := -a
+ 			    end
+ 			end else begin
+ 			    if mem[p].hh.b1 > 4 then begin
+ 				bb := -bb;
+ 				aa := -aa;
+ 				b := -b;
+ 				a := -a
+ 			    end;
+ 			    if pp = nodetoround[0] then 
+ 				dd := firsty - bb
+ 			    else 
+ 				dd := mem[pp + 2].int - bb;
+ 			    if odd(aa - bb) then 
+ 				if mem[p].hh.b1 > 4 then 
+ 				    cc := dd - (((aa - bb) + 1) div 2)
+ 				else 
+ 				    cc := dd - (((aa - bb) - 1) div 2)
+ 			    else 
+ 				cc := dd - ((aa - bb) div 2)
+ 			end;
+ 			d := mem[p + 2].int;
+ 			if odd(a - b) then 
+ 			    if mem[p].hh.b1 > 4 then 
+ 				c := d - (((a - b) - 1) div 2)
+ 			    else 
+ 				c := d - (((a - b) + 1) div 2)
+ 			else 
+ 			    c := d - ((a - b) div 2) {:445};
+ 			if (((aa < a) or (cc < c)) or ((aa - a) > (2 * (bb - b)))) or ((cc - c) > (2 * (dd - d))) then begin
+ 			    allsafe := false;
+ 			    after[k] := before[k];
+ 			    if k = (curroundingptr - 1) then 
+ 				after[0] := before[0]
+ 			    else 
+ 				after[k + 1] := before[k + 1]
+ 			end
+ 		    end
+ 		end
+ 	    until allsafe {:446};
+ 	    for k := 0 to curroundingptr - 1 do begin
+ 		a := after[k];
+ 		b := before[k];
+ 		aa := after[k + 1];
+ 		bb := before[k + 1];
+ 		if (a <> b) or (aa <> bb) then begin
+ 		    p := nodetoround[k];
+ 		    pp := nodetoround[k + 1];
+ {445:}
+ 		    if aa = bb then begin
+ 			if pp = nodetoround[0] then 
+ 			    unskew(firstx, firsty, mem[pp].hh.b1)
+ 			else 
+ 			    unskew(mem[pp + 1].int, mem[pp + 2].int, mem[pp].hh.b1);
+ 			skew(curx, cury, mem[p].hh.b1);
+ 			bb := curx;
+ 			aa := bb;
+ 			dd := cury;
+ 			cc := dd;
+ 			if mem[p].hh.b1 > 4 then begin
+ 			    b := -b;
+ 			    a := -a
+ 			end
+ 		    end else begin
+ 			if mem[p].hh.b1 > 4 then begin
+ 			    bb := -bb;
+ 			    aa := -aa;
+ 			    b := -b;
+ 			    a := -a
+ 			end;
+ 			if pp = nodetoround[0] then 
+ 			    dd := firsty - bb
+ 			else 
+ 			    dd := mem[pp + 2].int - bb;
+ 			if odd(aa - bb) then 
+ 			    if mem[p].hh.b1 > 4 then 
+ 				cc := dd - (((aa - bb) + 1) div 2)
+ 			    else 
+ 				cc := dd - (((aa - bb) - 1) div 2)
+ 			else 
+ 			    cc := dd - ((aa - bb) div 2)
+ 		    end;
+ 		    d := mem[p + 2].int;
+ 		    if odd(a - b) then 
+ 			if mem[p].hh.b1 > 4 then 
+ 			    c := d - (((a - b) - 1) div 2)
+ 			else 
+ 			    c := d - (((a - b) + 1) div 2)
+ 		    else 
+ 			c := d - ((a - b) div 2) {:445};
+ 		    if b = bb then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(aa - a, bb - b);
+ 		    if d = dd then 
+ 			beta := 268435456
+ 		    else 
+ 			beta := makefraction(cc - c, dd - d);
+ 		    repeat
+ 			mem[p + 1].int := takefraction(alpha, mem[p + 1].int - b) + a;
+ 			mem[p + 2].int := takefraction(beta, mem[p + 2].int - d) + c;
+ 			mem[p + 5].int := takefraction(alpha, mem[p + 5].int - b) + a;
+ 			mem[p + 6].int := takefraction(beta, mem[p + 6].int - d) + c;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 3].int := takefraction(alpha, mem[p + 3].int - b) + a;
+ 			mem[p + 4].int := takefraction(beta, mem[p + 4].int - d) + c
+ 		    until p = pp
+ 		end
+ 	    end
+ 	end {:444}
+     end; {:440} {451:}
+ 
+     procedure newboundary(p: halfword; octant: smallnumber);
+     var
+ 	q, r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	r := getnode(7);
+ 	mem[r].hh.rh := q;
+ 	mem[p].hh.rh := r;
+ 	mem[r].hh.b0 := mem[q].hh.b0;
+ 	mem[r + 3].int := mem[q + 3].int;
+ 	mem[r + 4].int := mem[q + 4].int;
+ 	mem[r].hh.b1 := 0;
+ 	mem[q].hh.b0 := 0;
+ 	mem[r + 5].int := octant;
+ 	mem[q + 3].int := mem[q].hh.b1;
+ 	unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 	skew(curx, cury, octant);
+ 	mem[r + 1].int := curx;
+ 	mem[r + 2].int := cury
+     end; {:451}
+ 
+     function makespec(h: halfword; safetymargin: scaled; tracing: integer): halfword;
+     label
+ 	22, 30;
+     var
+ 	p, q, r, s: halfword;
+ 	k: integer;
+ 	chopped: boolean; {453:}
+ 	o1, o2: smallnumber;
+ 	clockwise: boolean;
+ 	dx1, dy1, dx2, dy2: integer;
+ 	dmax, del: integer; {:453}
+     begin
+ 	curspec := h;
+ 	if tracing > 0 then 
+ 	    printpath(curspec, 426, true);
+ 	maxallowed := 268402687 - safetymargin; {404:}
+ 	p := curspec;
+ 	k := 1;
+ 	chopped := false;
+ 	repeat
+ 	    if abs(mem[p + 3].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 3].int > 0 then 
+ 		    mem[p + 3].int := maxallowed
+ 		else 
+ 		    mem[p + 3].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 4].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 4].int > 0 then 
+ 		    mem[p + 4].int := maxallowed
+ 		else 
+ 		    mem[p + 4].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 1].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 1].int > 0 then 
+ 		    mem[p + 1].int := maxallowed
+ 		else 
+ 		    mem[p + 1].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 2].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 2].int > 0 then 
+ 		    mem[p + 2].int := maxallowed
+ 		else 
+ 		    mem[p + 2].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 5].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 5].int > 0 then 
+ 		    mem[p + 5].int := maxallowed
+ 		else 
+ 		    mem[p + 5].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 6].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 6].int > 0 then 
+ 		    mem[p + 6].int := maxallowed
+ 		else 
+ 		    mem[p + 6].int := -maxallowed
+ 	    end;
+ 	    p := mem[p].hh.rh;
+ 	    mem[p].hh.b0 := k;
+ 	    if k < 127 then 
+ 		k := k + 1
+ 	    else 
+ 		k := 1
+ 	until p = curspec;
+ 	if chopped then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(430)
+ 	    end;
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 431;
+ 		helpline[2] := 432;
+ 		helpline[1] := 433;
+ 		helpline[0] := 434
+ 	    end;
+ 	    putgeterror
+ 	end {:404};
+ 	quadrantsubdivide;
+ 	if internal[36] > 0 then 
+ 	    xyround;
+ 	octantsubdivide;
+ 	if internal[36] > 65536 then 
+ 	    diaground; {447:}
+ 	p := curspec;
+ 	repeat
+     22:
+ 	    q := mem[p].hh.rh;
+ 	    if p <> q then begin
+ 		if mem[p + 1].int = mem[p + 5].int then 
+ 		    if mem[p + 2].int = mem[p + 6].int then 
+ 			if mem[p + 1].int = mem[q + 3].int then 
+ 			    if mem[p + 2].int = mem[q + 4].int then begin
+ 				unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 				skew(curx, cury, mem[p].hh.b1);
+ 				if mem[p + 1].int = curx then 
+ 				    if mem[p + 2].int = cury then begin
+ 					removecubic(p);
+ 					if q <> curspec then 
+ 					    goto 22;
+ 					curspec := p;
+ 					q := p
+ 				    end
+ 			    end
+ 	    end;
+ 	    p := q
+ 	until p = curspec; {:447} {450:}
+ 	turningnumber := 0;
+ 	p := curspec;
+ 	q := mem[p].hh.rh;
+ 	repeat
+ 	    r := mem[q].hh.rh;
+ 	    if (mem[p].hh.b1 <> mem[q].hh.b1) or (q = r) then begin {452:}
+ 		newboundary(p, mem[p].hh.b1);
+ 		s := mem[p].hh.rh;
+ 		o1 := octantnumber[mem[p].hh.b1];
+ 		o2 := octantnumber[mem[q].hh.b1];
+ 		case o2 - o1 of
+ 		    1, -7, 7, -1:
+ 			goto 30;
+ 		    2, -6:
+ 			clockwise := false;
+ 		    3, -5, 4, -4, 5, -3:
+ 			begin {454:} {457:}
+ 			    dx1 := mem[s + 1].int - mem[s + 3].int;
+ 			    dy1 := mem[s + 2].int - mem[s + 4].int;
+ 			    if dx1 = 0 then 
+ 				if dy1 = 0 then begin
+ 				    dx1 := mem[s + 1].int - mem[p + 5].int;
+ 				    dy1 := mem[s + 2].int - mem[p + 6].int;
+ 				    if dx1 = 0 then 
+ 					if dy1 = 0 then begin
+ 					    dx1 := mem[s + 1].int - mem[p + 1].int;
+ 					    dy1 := mem[s + 2].int - mem[p + 2].int
+ 					end
+ 				end;
+ 			    dmax := abs(dx1);
+ 			    if abs(dy1) > dmax then 
+ 				dmax := abs(dy1);
+ 			    while dmax < 268435456 do begin
+ 				dmax := dmax + dmax;
+ 				dx1 := dx1 + dx1;
+ 				dy1 := dy1 + dy1
+ 			    end;
+ 			    dx2 := mem[q + 5].int - mem[q + 1].int;
+ 			    dy2 := mem[q + 6].int - mem[q + 2].int;
+ 			    if dx2 = 0 then 
+ 				if dy2 = 0 then begin
+ 				    dx2 := mem[r + 3].int - mem[q + 1].int;
+ 				    dy2 := mem[r + 4].int - mem[q + 2].int;
+ 				    if dx2 = 0 then 
+ 					if dy2 = 0 then begin
+ 					    if mem[r].hh.b1 = 0 then begin
+ 						curx := mem[r + 1].int;
+ 						cury := mem[r + 2].int
+ 					    end else begin
+ 						unskew(mem[r + 1].int, mem[r + 2].int, mem[r].hh.b1);
+ 						skew(curx, cury, mem[q].hh.b1)
+ 					    end;
+ 					    dx2 := curx - mem[q + 1].int;
+ 					    dy2 := cury - mem[q + 2].int
+ 					end
+ 				end;
+ 			    dmax := abs(dx2);
+ 			    if abs(dy2) > dmax then 
+ 				dmax := abs(dy2);
+ 			    while dmax < 268435456 do begin
+ 				dmax := dmax + dmax;
+ 				dx2 := dx2 + dx2;
+ 				dy2 := dy2 + dy2
+ 			    end {:457};
+ 			    unskew(dx1, dy1, mem[p].hh.b1);
+ 			    del := pythadd(curx, cury);
+ 			    dx1 := makefraction(curx, del);
+ 			    dy1 := makefraction(cury, del);
+ 			    unskew(dx2, dy2, mem[q].hh.b1);
+ 			    del := pythadd(curx, cury);
+ 			    dx2 := makefraction(curx, del);
+ 			    dy2 := makefraction(cury, del);
+ 			    del := takefraction(dx1, dy2) - takefraction(dx2, dy1);
+ 			    if del > 4684844 then 
+ 				clockwise := false
+ 			    else if del < (-4684844) then 
+ 				clockwise := true
+ 			    else 
+ 				clockwise := revturns
+ 			end; {:454}
+ 		    6, -2:
+ 			clockwise := true;
+ 		    0:
+ 			clockwise := revturns
+ 		end; {458:}
+ 		while true do begin
+ 		    if clockwise then 
+ 			if o1 = 1 then 
+ 			    o1 := 8
+ 			else 
+ 			    o1 := o1 - 1
+ 		    else if o1 = 8 then 
+ 			o1 := 1
+ 		    else 
+ 			o1 := o1 + 1;
+ 		    if o1 = o2 then 
+ 			goto 30;
+ 		    newboundary(s, octantcode[o1]);
+ 		    s := mem[s].hh.rh;
+ 		    mem[s + 3].int := mem[s + 5].int
+ 		end {:458};
+     30:
+ 		if q = r then begin
+ 		    q := mem[q].hh.rh;
+ 		    r := q;
+ 		    p := s;
+ 		    mem[s].hh.rh := q;
+ 		    mem[q + 3].int := mem[q + 5].int;
+ 		    mem[q].hh.b0 := 0;
+ 		    freenode(curspec, 7);
+ 		    curspec := q
+ 		end; {459:}
+ 		p := mem[p].hh.rh;
+ 		repeat
+ 		    s := mem[p].hh.rh;
+ 		    o1 := octantnumber[mem[p + 5].int];
+ 		    o2 := octantnumber[mem[s + 3].int];
+ 		    if abs(o1 - o2) = 1 then begin
+ 			if o2 < o1 then 
+ 			    o2 := o1;
+ 			if odd(o2) then 
+ 			    mem[p + 6].int := 0
+ 			else 
+ 			    mem[p + 6].int := 1
+ 		    end else begin
+ 			if o1 = 8 then 
+ 			    turningnumber := turningnumber + 1
+ 			else 
+ 			    turningnumber := turningnumber - 1;
+ 			mem[p + 6].int := 0
+ 		    end;
+ 		    mem[s + 4].int := mem[p + 6].int;
+ 		    p := s
+ 		until p = q {:459}
+ 	    end {:452};
+ 	    p := q;
+ 	    q := r
+ 	until p = curspec; {:450}
+ 	while mem[curspec].hh.b0 <> 0 do 
+ 	    curspec := mem[curspec].hh.rh;
+ 	if tracing > 0 then 
+ 	    if internal[36] <= 0 then 
+ 		printspec(427)
+ 	    else if internal[36] > 65536 then 
+ 		printspec(428)
+ 	    else 
+ 		printspec(429);
+ 	makespec := curspec
+     end; { makespec }
+ {:402}
+     {463:}
+ 
+     procedure endround(x, y: scaled);
+     begin
+ 	y := (y + 32768) - ycorr[octant];
+ 	x := (x + y) - xcorr[octant];
+ 	m1 := floorunscaled(x);
+ 	n1 := floorunscaled(y);
+ 	if (x - (65536 * m1)) >= ((y - (65536 * n1)) + zcorr[octant]) then 
+ 	    d1 := 1
+ 	else 
+ 	    d1 := 0
+     end; {:463}
+ {465:}
+ 
+     procedure fillspec(h: halfword);
+     var
+ 	p, q, r, s: halfword;
+     begin
+ 	if internal[10] > 0 then 
+ 	    beginedgetracing;
+ 	p := h;
+ 	{------------------------------------}
+ 	print_start(psfile); { Start cycle }
+ 	{------------------------------------}
+ 	repeat
+ 	    octant := mem[p + 3].int; {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466};
+ 	    if q <> p then begin {467:}
+ 		endround(mem[p + 1].int, mem[p + 2].int);
+ 		m0 := m1;
+ 		n0 := n1;
+ 		d0 := d1;
+ 		endround(mem[q + 1].int, mem[q + 2].int) {:467}; {468:}
+ 		if (n1 - n0) >= movesize then 
+ 		    overflow(407, movesize);
+ 		move[0] := d0;
+ 		moveptr := 0;
+ 		r := p;
+ 		repeat
+ 		    s := mem[r].hh.rh;
+ 		    makemoves(mem[r + 1].int, mem[r + 5].int, mem[s + 3].int, mem[s + 1].int, mem[r + 2].int + 32768, mem[r + 6].int + 32768, mem[s + 4].int + 32768, mem[s + 2].int + 32768, xycorr[octant], ycorr[octant],465,octant);
+ 		    r := s
+ 		until r = q;
+ 		move[moveptr] := move[moveptr] - d1;
+ 		if internal[35] > 0 then 
+ 		    smoothmoves(0, moveptr) {:468};
+ 		movetoedges(m0, n0, m1, n1)
+ 	    end;
+ 	    p := mem[q].hh.rh
+ 	until p = h;
+ 	{------------------------------------}
+ 	print_end(psfile); { End cycle }
+ 	{------------------------------------}
+ 	tossknotlist(h);
+ 	if internal[10] > 0 then 
+ 	    endedgetracing
+     end; {:465} {476:}
+ 
+     procedure dupoffset(w: halfword);
+     var
+ 	r: halfword;
+     begin
+ 	r := getnode(3);
+ 	mem[r + 1].int := mem[w + 1].int;
+ 	mem[r + 2].int := mem[w + 2].int;
+ 	mem[r].hh.rh := mem[w].hh.rh;
+ 	mem[mem[w].hh.rh].hh.lh := r;
+ 	mem[r].hh.lh := w;
+ 	mem[w].hh.rh := r
+     end; {:476} {477:}
+ 
+     function makepen(h: halfword): halfword;
+     label
+ 	30, 31, 45, 40;
+     var
+ 	o, oo, k: smallnumber;
+ 	p: halfword;
+ 	q, r, s, w, hh: halfword;
+ 	n: integer;
+ 	dx, dy: scaled;
+ 	mc: scaled; {479:}
+     begin
+ 	q := h;
+ 	r := mem[q].hh.rh;
+ 	mc := abs(mem[h + 1].int);
+ 	if q = r then begin
+ 	    hh := h;
+ 	    mem[h].hh.b1 := 0;
+ 	    if mc < abs(mem[h + 2].int) then 
+ 		mc := abs(mem[h + 2].int)
+ 	end else begin
+ 	    o := 0;
+ 	    hh := -30000;
+ 	    while true do begin
+ 		s := mem[r].hh.rh;
+ 		if mc < abs(mem[r + 1].int) then 
+ 		    mc := abs(mem[r + 1].int);
+ 		if mc < abs(mem[r + 2].int) then 
+ 		    mc := abs(mem[r + 2].int);
+ 		dx := mem[r + 1].int - mem[q + 1].int;
+ 		dy := mem[r + 2].int - mem[q + 2].int;
+ 		if dx = 0 then 
+ 		    if dy = 0 then 
+ 			goto 45;
+ 		if abvscd(dx, mem[s + 2].int - mem[r + 2].int, dy, mem[s + 1].int - mem[r + 1].int) < 0 then 
+ 		    goto 45; {480:}
+ 		if dx > 0 then 
+ 		    octant := 1
+ 		else if dx = 0 then 
+ 		    if dy > 0 then 
+ 			octant := 1
+ 		    else 
+ 			octant := 2
+ 		else begin
+ 		    dx := -dx;
+ 		    octant := 2
+ 		end;
+ 		if dy < 0 then begin
+ 		    dy := -dy;
+ 		    octant := octant + 2
+ 		end else if dy = 0 then 
+ 		    if octant > 1 then 
+ 			octant := 4;
+ 		if dx < dy then 
+ 		    octant := octant + 4 {:480};
+ 		mem[q].hh.b1 := octant;
+ 		oo := octantnumber[octant];
+ 		if o > oo then begin
+ 		    if hh <> (-30000) then 
+ 			goto 45;
+ 		    hh := q
+ 		end;
+ 		o := oo;
+ 		if (q = h) and (hh <> (-30000)) then 
+ 		    goto 30;
+ 		q := r;
+ 		r := s
+ 	    end;
+     30: {:479}
+ 	    
+ 	end;
+ 	if mc >= 268402688 then 
+ 	    goto 45;
+ 	p := getnode(10);
+ 	q := hh;
+ 	mem[p + 9].int := mc;
+ 	mem[p].hh.lh := -30000;
+ 	if mem[q].hh.rh <> q then 
+ 	    mem[p].hh.rh := -29999;
+ 	for k := 1 to 8 do begin {481:}
+ 	    octant := octantcode[k];
+ 	    n := 0;
+ 	    h := p + octant;
+ 	    while true do begin
+ 		r := getnode(3);
+ 		skew(mem[q + 1].int, mem[q + 2].int, octant);
+ 		mem[r + 1].int := curx;
+ 		mem[r + 2].int := cury;
+ 		if n = 0 then 
+ 		    mem[h].hh.rh := r {482:}
+ 		else if odd(k) then begin
+ 		    mem[w].hh.rh := r;
+ 		    mem[r].hh.lh := w
+ 		end else begin
+ 		    mem[w].hh.lh := r;
+ 		    mem[r].hh.rh := w
+ 		end {:482};
+ 		w := r;
+ 		if mem[q].hh.b1 <> octant then 
+ 		    goto 31;
+ 		q := mem[q].hh.rh;
+ 		n := n + 1
+ 	    end;
+     31: {483:}
+ 	    r := mem[h].hh.rh;
+ 	    if odd(k) then begin
+ 		mem[w].hh.rh := r;
+ 		mem[r].hh.lh := w
+ 	    end else begin
+ 		mem[w].hh.lh := r;
+ 		mem[r].hh.rh := w;
+ 		mem[h].hh.rh := w;
+ 		r := w
+ 	    end;
+ 	    if (mem[r + 2].int <> mem[mem[r].hh.rh + 2].int) or (n = 0) then begin
+ 		dupoffset(r);
+ 		n := n + 1
+ 	    end;
+ 	    r := mem[r].hh.lh;
+ 	    {:
+ 	    483}
+ 	    if mem[r + 1].int <> mem[mem[r].hh.lh + 1].int then 
+ 		dupoffset(r)
+ 	    else 
+ 		n := n - 1;
+ 	    if n >= 127 then 
+ 		overflow(446, 127);
+ 	    mem[h].hh.lh := n
+ 	end {:481};
+ 	goto 40;
+     45:
+ 	p := -29997; {478:}
+ 	if mc >= 268402688 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(440)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 441;
+ 		helpline[0] := 442
+ 	    end
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(443)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 444;
+ 		helpline[1] := 445;
+ 		helpline[0] := 442
+ 	    end
+ 	end; {:478}
+ 	putgeterror;
+     40:
+ 	if internal[6] > 0 then 
+ 	    printpen(p, 439, true);
+ 	makepen := p
+     end; {:477} {484:} {486:}
+ 
+     function trivialknot(x, y: scaled): halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(7);
+ 	mem[p].hh.b0 := 1;
+ 	mem[p].hh.b1 := 1;
+ 	mem[p + 1].int := x;
+ 	mem[p + 3].int := x;
+ 	mem[p + 5].int := x;
+ 	mem[p + 2].int := y;
+ 	mem[p + 4].int := y;
+ 	mem[p + 6].int := y;
+ 	trivialknot := p
+     end; {:486}
+ 
+     function makepath(penhead: halfword): halfword;
+     var
+ 	p: halfword;
+ 	k: 1..8;
+ 	h: halfword;
+ 	m, n: integer;
+ 	w, ww: halfword;
+     begin
+ 	p := 29999;
+ 	for k := 1 to 8 do begin
+ 	    octant := octantcode[k];
+ 	    h := penhead + octant;
+ 	    n := mem[h].hh.lh;
+ 	    w := mem[h].hh.rh;
+ 	    if not odd(k) then 
+ 		w := mem[w].hh.lh;
+ 	    for m := 1 to n + 1 do begin
+ 		if odd(k) then 
+ 		    ww := mem[w].hh.rh
+ 		else 
+ 		    ww := mem[w].hh.lh;
+ 		if (mem[ww + 1].int <> mem[w + 1].int) or (mem[ww + 2].int <> mem[w + 2].int) then begin {485:}
+ 		    unskew(mem[ww + 1].int, mem[ww + 2].int, octant);
+ 		    mem[p].hh.rh := trivialknot(curx, cury);
+ 		    p := mem[p].hh.rh
+ 		end {:485};
+ 		w := ww
+ 	    end
+ 	end;
+ 	if p = 29999 then begin
+ 	    w := mem[penhead + 1].hh.rh;
+ 	    p := trivialknot(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int);
+ 	    mem[29999].hh.rh := p
+ 	end;
+ 	mem[p].hh.rh := mem[29999].hh.rh;
+ 	makepath := mem[29999].hh.rh
+     end; {:484} {488:}
+ 
+     procedure findoffset(x, y: scaled; p: halfword);
+     label
+ 	30, 10;
+     var
+ 	octant: 1..8;
+ 	s: -1..+1;
+ 	n: integer;
+ 	h, w, ww: halfword; {489:}
+     begin
+ 	if x > 0 then 
+ 	    octant := 1
+ 	else if x = 0 then 
+ 	    if y <= 0 then 
+ 		if y = 0 then begin
+ 		    curx := 0;
+ 		    cury := 0;
+ 		    goto 10
+ 		end else 
+ 		    octant := 2
+ 	    else 
+ 		octant := 1
+ 	else begin
+ 	    x := -x;
+ 	    if y = 0 then 
+ 		octant := 4
+ 	    else 
+ 		octant := 2
+ 	end;
+ 	if y < 0 then begin
+ 	    octant := octant + 2;
+ 	    y := -y
+ 	end;
+ 	if x >= y then 
+ 	    x := x - y
+ 	else begin
+ 	    octant := octant + 4;
+ 	    x := y - x;
+ 	    y := y - x
+ 	end {:489};
+ 	if odd(octantnumber[octant]) then 
+ 	    s := -1
+ 	else 
+ 	    s := +1;
+ 	h := p + octant;
+ 	w := mem[mem[h].hh.rh].hh.rh;
+ 	ww := mem[w].hh.rh;
+ 	n := mem[h].hh.lh;
+ 	while n > 1 do begin
+ 	    if abvscd(x, mem[ww + 2].int - mem[w + 2].int, y, mem[ww + 1].int - mem[w + 1].int) <> s then 
+ 		goto 30;
+ 	    w := ww;
+ 	    ww := mem[w].hh.rh;
+ 	    n := n - 1
+ 	end;
+     30:
+ 	unskew(mem[w + 1].int, mem[w + 2].int, octant);
+     10:
+ 	
+     end; {:488} {491:} {493:}
+ 
+     procedure splitforoffset(p: halfword; t: fraction);
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	splitcubic(p, t, mem[q + 1].int, mem[q + 2].int);
+ 	r := mem[p].hh.rh;
+ 	if mem[r + 2].int < mem[p + 2].int then 
+ 	    mem[r + 2].int := mem[p + 2].int
+ 	else if mem[r + 2].int > mem[q + 2].int then 
+ 	    mem[r + 2].int := mem[q + 2].int;
+ 	if mem[r + 1].int < mem[p + 1].int then 
+ 	    mem[r + 1].int := mem[p + 1].int
+ 	else if mem[r + 1].int > mem[q + 1].int then 
+ 	    mem[r + 1].int := mem[q + 1].int
+     end; {:493} {497:}
+ 
+     procedure finoffsetprep(p: halfword; k: halfword; w: halfword; x0, x1, x2, y0, y1, y2: integer; rising: boolean; n: integer);
+     label
+ 	10;
+     var
+ 	q, ww: halfword;
+ 	du, dv: scaled;
+ 	t0, t1, t2: integer;
+ 	t: fraction;
+ 	s: fraction;
+ 	v: integer;
+     begin
+ 	while true do begin
+ 	    q := mem[p].hh.rh;
+ 	    mem[p].hh.b1 := k;
+ 	    if rising then 
+ 		if k = n then 
+ 		    goto 10
+ 		else 
+ 		    ww := mem[w].hh.rh
+ 	    else if k = 1 then 
+ 		goto 10
+ 	    else 
+ 		ww := mem[w].hh.lh; {498:}
+ 	    du := mem[ww + 1].int - mem[w + 1].int;
+ 	    dv := mem[ww + 2].int - mem[w + 2].int;
+ 	    if abs(du) >= abs(dv) then begin
+ 		s := makefraction(dv, du);
+ 		t0 := takefraction(x0, s) - y0;
+ 		t1 := takefraction(x1, s) - y1;
+ 		t2 := takefraction(x2, s) - y2
+ 	    end else begin
+ 		s := makefraction(du, dv);
+ 		t0 := x0 - takefraction(y0, s);
+ 		t1 := x1 - takefraction(y1, s);
+ 		t2 := x2 - takefraction(y2, s)
+ 	    end {:498};
+ 	    t := crossingpoint(t0, t1, t2);
+ 	    if t >= 268435456 then 
+ 		goto 10; {499:}
+ 	    begin
+ 		splitforoffset(p, t);
+ 		mem[p].hh.b1 := k;
+ 		p := mem[p].hh.rh;
+ 		v := x0 - takefraction(x0 - x1, t);
+ 		x1 := x1 - takefraction(x1 - x2, t);
+ 		x0 := v - takefraction(v - x1, t);
+ 		v := y0 - takefraction(y0 - y1, t);
+ 		y1 := y1 - takefraction(y1 - y2, t);
+ 		y0 := v - takefraction(v - y1, t);
+ 		t1 := t1 - takefraction(t1 - t2, t);
+ 		if t1 > 0 then 
+ 		    t1 := 0;
+ 		t := crossingpoint(0, -t1, -t2);
+ 		if t < 268435456 then begin
+ 		    splitforoffset(p, t);
+ 		    mem[mem[p].hh.rh].hh.b1 := k;
+ 		    v := x1 - takefraction(x1 - x2, t);
+ 		    x1 := x0 - takefraction(x0 - x1, t);
+ 		    x2 := x1 - takefraction(x1 - v, t);
+ 		    v := y1 - takefraction(y1 - y2, t);
+ 		    y1 := y0 - takefraction(y0 - y1, t);
+ 		    y2 := y1 - takefraction(y1 - v, t)
+ 		end
+ 	    end {:499};
+ 	    if rising then 
+ 		k := k + 1
+ 	    else 
+ 		k := k - 1;
+ 	    w := ww
+ 	end;
+     10:
+ 	
+     end; {:497}
+ 
+     procedure offsetprep(c, h: halfword);
+     label
+ 	30, 45;
+     var
+ 	n: halfword;
+ 	p, q, r, lh, ww: halfword;
+ 	k: halfword;
+ 	w: halfword; {495:}
+ 	x0, x1, x2, y0, y1, y2: integer;
+ 	t0, t1, t2: integer;
+ 	du, dv, dx, dy: integer;
+ 	maxcoef: integer;
+ 	x0a, x1a, x2a, y0a, y1a, y2a: integer;
+ 	t: fraction;
+ 	s: fraction;
+ {:495}
+     begin
+ 	p := c;
+ 	n := mem[h].hh.lh;
+ 	lh := mem[h].hh.rh;
+ 	while mem[p].hh.b1 <> 0 do begin
+ 	    q := mem[p].hh.rh; {494:}
+ 	    if n <= 1 then 
+ 		mem[p].hh.b1 := 1
+ 	    else begin {496:}
+ 		x0 := mem[p + 5].int - mem[p + 1].int;
+ 		x2 := mem[q + 1].int - mem[q + 3].int;
+ 		x1 := mem[q + 3].int - mem[p + 5].int;
+ 		y0 := mem[p + 6].int - mem[p + 2].int;
+ 		y2 := mem[q + 2].int - mem[q + 4].int;
+ 		y1 := mem[q + 4].int - mem[p + 6].int;
+ 		maxcoef := abs(x0);
+ 		if abs(x1) > maxcoef then 
+ 		    maxcoef := abs(x1);
+ 		if abs(x2) > maxcoef then 
+ 		    maxcoef := abs(x2);
+ 		if abs(y0) > maxcoef then 
+ 		    maxcoef := abs(y0);
+ 		if abs(y1) > maxcoef then 
+ 		    maxcoef := abs(y1);
+ 		if abs(y2) > maxcoef then 
+ 		    maxcoef := abs(y2);
+ 		if maxcoef = 0 then 
+ 		    goto 45;
+ 		while maxcoef < 268435456 do begin
+ 		    maxcoef := maxcoef + maxcoef;
+ 		    x0 := x0 + x0;
+ 		    x1 := x1 + x1;
+ 		    x2 := x2 + x2;
+ 		    y0 := y0 + y0;
+ 		    y1 := y1 + y1;
+ 		    y2 := y2 + y2
+ 		end {:496}; {501:}
+ 		dx := x0;
+ 		dy := y0;
+ 		if dx = 0 then 
+ 		    if dy = 0 then begin
+ 			dx := x1;
+ 			dy := y1;
+ 			if dx = 0 then 
+ 			    if dy = 0 then begin
+ 				dx := x2;
+ 				dy := y2
+ 			    end
+ 		    end {:501};
+ 		if dx = 0 then  {505:}
+ 		    finoffsetprep(p, n, mem[mem[lh].hh.lh].hh.lh, -x0, -x1, -x2, -y0, -y1, -y2, false, n) {:505}
+ 		else begin {502:}
+ 		    k := 1;
+ 		    w := mem[lh].hh.rh;
+ 		    while true do begin
+ 			if k = n then 
+ 			    goto 30;
+ 			ww := mem[w].hh.rh;
+ 			if abvscd(dy, abs(mem[ww + 1].int - mem[w + 1].int), dx, abs(mem[ww + 2].int - mem[w + 2].int)) >= 0 then begin
+ 			    k := k + 1;
+ 			    w := ww
+ 			end else 
+ 			    goto 30
+ 		    end;
+     30: {:502}
+ 		    ;
+ {503:}
+ 		    if k = 1 then 
+ 			t := 268435457
+ 		    else begin
+ 			ww := mem[w].hh.lh; {498:}
+ 			du := mem[ww + 1].int - mem[w + 1].int;
+ 			dv := mem[ww + 2].int - mem[w + 2].int;
+ 			if abs(du) >= abs(dv) then begin
+ 			    s := makefraction(dv, du);
+ 			    t0 := takefraction(x0, s) - y0;
+ 			    t1 := takefraction(x1, s) - y1;
+ 			    t2 := takefraction(x2, s) - y2
+ 			end else begin
+ 			    s := makefraction(du, dv);
+ 			    t0 := x0 - takefraction(y0, s);
+ 			    t1 := x1 - takefraction(y1, s);
+ 			    t2 := x2 - takefraction(y2, s)
+ 			end {:498};
+ 			t := crossingpoint(-t0, -t1, -t2)
+ 		    end;
+ 		    if t >= 268435456 then 
+ 			finoffsetprep(p, k, w, x0, x1, x2, y0, y1, y2, true, n)
+ 		    else begin
+ 			splitforoffset(p, t);
+ 			r := mem[p].hh.rh;
+ 			x1a := x0 - takefraction(x0 - x1, t);
+ 			x1 := x1 - takefraction(x1 - x2, t);
+ 			x2a := x1a - takefraction(x1a - x1, t);
+ 			y1a := y0 - takefraction(y0 - y1, t);
+ 			y1 := y1 - takefraction(y1 - y2, t);
+ 			y2a := y1a - takefraction(y1a - y1, t);
+ 			finoffsetprep(p, k, w, x0, x1a, x2a, y0, y1a, y2a, true, n);
+ 			x0 := x2a;
+ 			y0 := y2a;
+ 			t1 := t1 - takefraction(t1 - t2, t);
+ 			if t1 < 0 then 
+ 			    t1 := 0;
+ 			t := crossingpoint(0, t1, t2);
+ 			if t < 268435456 then begin {504:}
+ 			    splitforoffset(r, t);
+ 			    x1a := x1 - takefraction(x1 - x2, t);
+ 			    x1 := x0 - takefraction(x0 - x1, t);
+ 			    x0a := x1 - takefraction(x1 - x1a, t);
+ 			    y1a := y1 - takefraction(y1 - y2, t);
+ 			    y1 := y0 - takefraction(y0 - y1, t);
+ 			    y0a := y1 - takefraction(y1 - y1a, t);
+ 			    finoffsetprep(mem[r].hh.rh, k, w, x0a, x1a, x2, y0a, y1a, y2, true, n);
+ 			    x2 := x0a;
+ 			    y2 := y0a
+ 			end {:504};
+ 			finoffsetprep(r, k - 1, ww, -x0, -x1, -x2, -y0, -y1, -y2, false, n)
+ 		    end {:503}
+ 		end;
+     45: {:494}
+ 		
+ 	    end; {492:}
+ 	    repeat
+ 		r := mem[p].hh.rh;
+ 		if mem[p + 1].int = mem[p + 5].int then 
+ 		    if mem[p + 2].int = mem[p + 6].int then 
+ 			if mem[p + 1].int = mem[r + 3].int then 
+ 			    if mem[p + 2].int = mem[r + 4].int then 
+ 				if mem[p + 1].int = mem[r + 1].int then 
+ 				    if mem[p + 2].int = mem[r + 2].int then begin
+ 					removecubic(p);
+ 					if r = q then 
+ 					    q := p;
+ 					r := p
+ 				    end;
+ 		p := r
+ 	    until p = q {:492}
+ 	end
+     end; { offsetprep }
+ {:491}
+     {506:}
+     {510:}
+ 
+     procedure skewlineedges(p, w, ww: halfword);
+     var
+ 	x0, y0, x1, y1: scaled;
+     begin
+ 	if (mem[w + 1].int <> mem[ww + 1].int) or (mem[w + 2].int <> mem[ww + 2].int) then begin
+ 	    x0 := mem[p + 1].int + mem[w + 1].int;
+ 	    y0 := mem[p + 2].int + mem[w + 2].int;
+ 	    x1 := mem[p + 1].int + mem[ww + 1].int;
+ 	    y1 := mem[p + 2].int + mem[ww + 2].int;
+             {-------------------------------------}
+              sendline(x0,y0,x1,y1,octant,510);
+             {-------------------------------------}
+ 	    unskew(x0, y0, octant);
+ 	    x0 := curx;
+ 	    y0 := cury;
+ 	    unskew(x1, y1, octant);
+ {if internal[10]>65536 then begin printnl(451);printtwo(x0,y0);
+ print(450);printtwo(curx,cury);printnl(155);end;}
+ 	    lineedges(x0, y0, curx, cury)
+ 	end
+     end; {:510} {518:}
+ 
+     procedure dualmoves(h, p, q: halfword);
+     label
+ 	30, 31;
+     var
+ 	r, s: halfword; {511:}
+ 	m, n: integer;
+ 	mm0, mm1: integer;
+ 	k: integer;
+ 	w, ww: halfword;
+ 	smoothbot, smoothtop: 0..movesize;
+ 	xx, yy, xp, yp, delx, dely, tx, ty: scaled;
+ {:511} {519:}
+     begin
+ 	k := mem[h].hh.lh + 1;
+ 	ww := mem[h].hh.rh;
+ 	w := mem[ww].hh.lh;
+ 	mm0 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]);
+ 	mm1 := floorunscaled((mem[q + 1].int + mem[ww + 1].int) - xycorr[octant]);
+ 	for n := 1 to (n1 - n0) + 1 do 
+ 	    envmove[n] := mm1;
+ 	envmove[0] := mm0;
+ 	moveptr := 0;
+ 	m := mm0 {:519};
+ 	r := p;
+ 	while true do begin
+ 	    if r = q then 
+ 		smoothtop := moveptr;
+ 	    while mem[r].hh.b1 <> k do begin {521:}
+ 		xx := mem[r + 1].int + mem[w + 1].int;
+ 		yy := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ {if internal[10]>65536 then begin printnl(452);printint(k);print(453);
+ unskew(xx,yy-32768,octant);printtwo(curx,cury);end;}
+                 {------------}
+                  my_xx := xx;
+                  my_yy := yy;
+                 {------------}
+ 		if mem[r].hh.b1 < k then begin
+ 		    k := k - 1;
+ 		    w := mem[w].hh.lh;
+ 		    xp := mem[r + 1].int + mem[w + 1].int;
+ 		    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 		    if yp <> yy then begin {522:}
+ 			ty := floorscaled(yy - ycorr[octant]);
+ 			dely := yp - yy;
+ 			yy := yy - ty;
+ 			ty := (yp - ycorr[octant]) - ty;
+ 			if ty >= 65536 then begin
+ 			    delx := xp - xx;
+ 			    yy := 65536 - yy;
+ 			    while true do begin
+ 				if m < envmove[moveptr] then 
+ 				    envmove[moveptr] := m;
+ 				tx := takefraction(delx, makefraction(yy, dely));
+ 				if (abvscd(tx, dely, delx, yy) + xycorr[octant]) > 0 then 
+ 				    tx := tx - 1;
+ 				m := floorunscaled(xx + tx);
+ 				ty := ty - 65536;
+ 				moveptr := moveptr + 1;
+ 				if ty < 65536 then 
+ 				    goto 31;
+ 				yy := yy + 65536
+ 			    end;
+     31:
+ 			    if m < envmove[moveptr] then 
+ 				envmove[moveptr] := m
+ 			end
+ 		    end {:522}
+ 		end else begin
+ 		    k := k + 1;
+ 		    w := mem[w].hh.rh;
+ 		    xp := mem[r + 1].int + mem[w + 1].int;
+ 		    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 		end;
+ {if internal[10]>65536 then begin print(450);unskew(xp,yp-32768,octant);
+ printtwo(curx,cury);printnl(155);end;}
+ 		{---------------------------------------------------}
+ 		 sendline(my_xx,my_yy-32768,xp,yp-32768,octant,521);
+ 		{---------------------------------------------------}
+ 		m := floorunscaled(xp - xycorr[octant]);
+ 		moveptr := floorunscaled(yp - ycorr[octant]) - n0;
+ 		if m < envmove[moveptr] then 
+ 		    envmove[moveptr] := m
+ 	    end {:521};
+ 	    if r = p then 
+ 		smoothbot := moveptr;
+ 	    if r = q then 
+ 		goto 30;
+ 	    move[moveptr] := 1;
+ 	    n := moveptr;
+ 	    s := mem[r].hh.rh;
+ 	    makemoves(mem[r + 1].int + mem[w + 1].int, mem[r + 5].int + mem[w + 1].int, mem[s + 3].int + mem[w + 1].int, mem[s + 1].int + mem[w + 1].int, (mem[r + 2].int + mem[w + 2].int) + 32768, (mem[r + 6].int + mem[w + 2].int) + 32768, (mem[s + 4].int + mem[w + 2].int) + 32768, (mem[s + 2].int + mem[w + 2].int) + 32768, xycorr[octant], ycorr[octant],518,octant); {520:}
+ 	    repeat
+ 		if m < envmove[n] then 
+ 		    envmove[n] := m;
+ 		m := (m + move[n]) - 1;
+ 		n := n + 1
+ 	    until n > moveptr {:520};
+ 	    r := s
+ 	end;
+     30: {523:}
+ {if(m<>mm1)or(moveptr<>n1-n0)then confusion(50);}
+ 	move[0] := (d0 + envmove[1]) - mm0;
+ 	for n := 1 to moveptr do 
+ 	    move[n] := (envmove[n + 1] - envmove[n]) + 1;
+ 	move[moveptr] := move[moveptr] - d1;
+ 	if internal[35] > 0 then 
+ 	    smoothmoves(smoothbot, smoothtop);
+ 	movetoedges(m0, n0, m1, n1);
+ 	if mem[q + 6].int = 1 then begin
+ 	    w := mem[h].hh.rh;
+ 	    skewlineedges(q, w, mem[w].hh.lh)
+ 	end {:523}
+     end; {:518}
+ 
+     procedure fillenvelope(spechead: halfword);
+     label
+ 	30, 31;
+     var
+ 	p, q, r, s: halfword;
+ 	h: halfword;
+ 	www: halfword; {511:}
+ 	m, n: integer;
+ 	mm0, mm1: integer;
+ 	k: integer;
+ 	w, ww: halfword;
+ 	smoothbot, smoothtop: 0..movesize;
+ 	xx, yy, xp, yp, delx, dely, tx, ty: scaled; {:511}
+     begin
+ 	if internal[10] > 0 then 
+ 	    beginedgetracing;
+ 	{------------------------------------}
+ 	print_start(psfile); { Start cycle }
+ 	{------------------------------------}
+ 	p := spechead;
+ 	repeat
+ 	    octant := mem[p + 3].int;
+ 	    h := curpen + octant; {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466}; {508:}
+ 	    w := mem[h].hh.rh;
+ 	    if mem[p + 4].int = 1 then 
+ 		w := mem[w].hh.lh;
+ {if internal[10]>65536 then[509:]begin printnl(447);
+ print(octantdir[octant]);print(425);printint(mem[h].hh.lh);print(448);
+ if mem[h].hh.lh<>1 then printchar(115);print(449);
+ unskew(mem[p+1].int+mem[w+1].int,mem[p+2].int+mem[w+2].int,octant);
+ printtwo(curx,cury);ww:=mem[h].hh.rh;
+ if mem[q+6].int=1 then ww:=mem[ww].hh.lh;print(450);
+ unskew(mem[q+1].int+mem[ww+1].int,mem[q+2].int+mem[ww+2].int,octant);
+ printtwo(curx,cury);end[:509];}
+ 	    ww := mem[h].hh.rh;
+ 	    www := ww;
+ 	    if odd(octantnumber[octant]) then 
+ 		www := mem[www].hh.lh
+ 	    else 
+ 		ww := mem[ww].hh.lh;
+ 	    if w <> ww then 
+ 		skewlineedges(p, w, ww);
+ 	    endround(mem[p + 1].int + mem[ww + 1].int, mem[p + 2].int + mem[ww + 2].int);
+ 	    m0 := m1;
+ 	    n0 := n1;
+ 	    d0 := d1;
+ 	    endround(mem[q + 1].int + mem[www + 1].int, mem[q + 2].int + mem[www + 2].int);
+ 	    if (n1 - n0) >= movesize then 
+ 		overflow(407, movesize) {:508};
+ 	    offsetprep(p, h);
+ {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466}; {512:}
+ 	    if odd(octantnumber[octant]) then begin {513:}
+ 		k := 0;
+ 		w := mem[h].hh.rh;
+ 		ww := mem[w].hh.lh;
+ 		mm0 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]);
+ 		mm1 := floorunscaled((mem[q + 1].int + mem[ww + 1].int) - xycorr[octant]);
+ 		for n := 0 to n1 - n0 do 
+ 		    envmove[n] := mm0;
+ 		envmove[n1 - n0] := mm1;
+ 		moveptr := 0;
+ 		m := mm0 {:513};
+ 		r := p;
+ 		mem[q].hh.b1 := mem[h].hh.lh + 1;
+ 		while true do begin
+ 		    if r = q then 
+ 			smoothtop := moveptr;
+ 		    while mem[r].hh.b1 <> k do begin {515:}
+ 			xx := mem[r + 1].int + mem[w + 1].int;
+ 			yy := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ {if internal[10]>65536 then begin printnl(452);printint(k);print(453);
+ unskew(xx,yy-32768,octant);printtwo(curx,cury);end;}
+                         {------------}
+                          my_xx := xx;
+                          my_yy := yy;
+                         {------------}
+ 			if mem[r].hh.b1 > k then begin
+ 			    k := k + 1;
+ 			    w := mem[w].hh.rh;
+ 			    xp := mem[r + 1].int + mem[w + 1].int;
+ 			    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 			    if yp <> yy then begin {516:}
+ 				ty := floorscaled(yy - ycorr[octant]);
+ 				dely := yp - yy;
+ 				yy := yy - ty;
+ 				ty := (yp - ycorr[octant]) - ty;
+ 				if ty >= 65536 then begin
+ 				    delx := xp - xx;
+ 				    yy := 65536 - yy;
+ 				    while true do begin
+ 					tx := takefraction(delx, makefraction(yy, dely));
+ 					if (abvscd(tx, dely, delx, yy) + xycorr[octant]) > 0 then 
+ 					    tx := tx - 1;
+ 					m := floorunscaled(xx + tx);
+ 					if m > envmove[moveptr] then 
+ 					    envmove[moveptr] := m;
+ 					ty := ty - 65536;
+ 					if ty < 65536 then 
+ 					    goto 31;
+ 					yy := yy + 65536;
+ 					moveptr := moveptr + 1
+ 				    end;
+     31:
+ 				    
+ 				end
+ 			    end {:516}
+ 			end else begin
+ 			    k := k - 1;
+ 			    w := mem[w].hh.lh;
+ 			    xp := mem[r + 1].int + mem[w + 1].int;
+ 			    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 			end;
+ {if internal[10]>65536 then begin print(450);unskew(xp,yp-32768,octant);
+ printtwo(curx,cury);printnl(155);end;}
+ 		{---------------------------------------------------}
+ 		 sendline(my_xx,my_yy-32768,xp,yp-32768,octant,515);
+ 		{---------------------------------------------------}
+ 			m := floorunscaled(xp - xycorr[octant]);
+ 			moveptr := floorunscaled(yp - ycorr[octant]) - n0;
+ 			if m > envmove[moveptr] then 
+ 			    envmove[moveptr] := m
+ 		    end {:515};
+ 		    if r = p then 
+ 			smoothbot := moveptr;
+ 		    if r = q then 
+ 			goto 30;
+ 		    move[moveptr] := 1;
+ 		    n := moveptr;
+ 		    s := mem[r].hh.rh;
+ 		    makemoves(mem[r + 1].int + mem[w + 1].int, mem[r + 5].int + mem[w + 1].int, mem[s + 3].int + mem[w + 1].int, mem[s + 1].int + mem[w + 1].int, (mem[r + 2].int + mem[w + 2].int) + 32768, (mem[r + 6].int + mem[w + 2].int) + 32768, (mem[s + 4].int + mem[w + 2].int) + 32768, (mem[s + 2].int + mem[w + 2].int) + 32768, xycorr[octant], ycorr[octant],512,octant); {514:}
+ 		    repeat
+ 			m := (m + move[n]) - 1;
+ 			if m > envmove[n] then 
+ 			    envmove[n] := m;
+ 			n := n + 1
+ 		    until n > moveptr {:514};
+ 		    r := s
+ 		end;
+     30: {517:}
+ {if(m<>mm1)or(moveptr<>n1-n0)then confusion(49);}
+ 		move[0] := (d0 + envmove[0]) - mm0;
+ 		for n := 1 to moveptr do 
+ 		    move[n] := (envmove[n] - envmove[n - 1]) + 1;
+ 		move[moveptr] := move[moveptr] - d1;
+ 		if internal[35] > 0 then 
+ 		    smoothmoves(smoothbot, smoothtop);
+ 		movetoedges(m0, n0, m1, n1);
+ 		if mem[q + 6].int = 0 then begin
+ 		    w := mem[h].hh.rh;
+ 		    skewlineedges(q, mem[w].hh.lh, w)
+ 		end {:517}
+ 	    end else 
+ 		dualmoves(h, p, q);
+ 	    mem[q].hh.b1 := 0 {:512};
+ 	    p := mem[q].hh.rh
+ 	until p = spechead;
+ 	{------------------------------------}
+ 	print_end(psfile); { End cycle }
+ 	{------------------------------------}
+ 	if internal[10] > 0 then 
+ 	    endedgetracing;
+ 	tossknotlist(spechead)
+     end; {:506}
+ {527:}
+ 
+     function makeellipse(majoraxis, minoraxis: scaled; theta: angle): halfword;
+     label
+ 	30, 31, 40;
+     var
+ 	p, q, r, s: halfword;
+ 	h: halfword;
+ 	alpha, beta, gamma, delta: integer;
+ 	c, d: integer;
+ 	u, v: integer;
+ 	symmetric: boolean; {528:}
+     begin {530:}
+ 	if (majoraxis = minoraxis) or ((theta mod 94371840) = 0) then begin
+ 	    symmetric := true;
+ 	    alpha := 0;
+ 	    if odd(theta div 94371840) then begin
+ 		beta := majoraxis;
+ 		gamma := minoraxis;
+ 		nsin := 268435456;
+ 		ncos := 0
+ 	    end else begin
+ 		beta := minoraxis;
+ 		gamma := majoraxis
+ 	    end
+ 	end else begin
+ 	    symmetric := false;
+ 	    nsincos(theta);
+ 	    gamma := takefraction(majoraxis, nsin);
+ 	    delta := takefraction(minoraxis, ncos);
+ 	    beta := pythadd(gamma, delta);
+ 	    alpha := takefraction(takefraction(majoraxis, makefraction(gamma, beta)), ncos) - takefraction(takefraction(minoraxis, makefraction(delta, beta)), nsin);
+ 	    alpha := (alpha + 32768) div 65536;
+ 	    gamma := pythadd(takefraction(majoraxis, ncos), takefraction(minoraxis, nsin))
+ 	end;
+ 	beta := (beta + 32768) div 65536;
+ 	gamma := (gamma + 32768) div 65536 {:530};
+ 	p := getnode(7);
+ 	q := getnode(7);
+ 	r := getnode(7);
+ 	if symmetric then 
+ 	    s := -30000
+ 	else 
+ 	    s := getnode(7);
+ 	h := p;
+ 	mem[p].hh.rh := q;
+ 	mem[q].hh.rh := r;
+ 	mem[r].hh.rh := s; {529:}
+ 	if beta = 0 then 
+ 	    beta := 1;
+ 	if gamma = 0 then 
+ 	    gamma := 1;
+ 	if gamma <= abs(alpha) then 
+ 	    if alpha > 0 then 
+ 		alpha := gamma - 1
+ 	    else 
+ 		alpha := 1 - gamma {:529};
+ 	mem[p + 1].int := -(alpha * 32768);
+ 	mem[p + 2].int := -(beta * 32768);
+ 	mem[q + 1].int := gamma * 32768;
+ 	mem[q + 2].int := mem[p + 2].int;
+ 	mem[r + 1].int := mem[q + 1].int;
+ 	mem[p + 5].int := 0;
+ 	mem[q + 3].int := -32768;
+ 	mem[q + 5].int := 32768;
+ 	mem[r + 3].int := 0;
+ 	mem[r + 5].int := 0;
+ 	mem[p + 6].int := beta;
+ 	mem[q + 6].int := gamma;
+ 	mem[r + 6].int := beta;
+ 	mem[q + 4].int := gamma + alpha;
+ 	if symmetric then begin
+ 	    mem[r + 2].int := 0;
+ 	    mem[r + 4].int := beta
+ 	end else begin
+ 	    mem[r + 2].int := -mem[p + 2].int;
+ 	    mem[r + 4].int := beta + beta;
+ 	    mem[s + 1].int := -mem[p + 1].int;
+ 	    mem[s + 2].int := mem[r + 2].int;
+ 	    mem[s + 3].int := 32768;
+ 	    mem[s + 4].int := gamma - alpha
+ 	end {:528}; {531:}
+ 	while true do begin
+ 	    u := mem[p + 5].int + mem[q + 5].int;
+ 	    v := mem[q + 3].int + mem[r + 3].int;
+ 	    c := mem[p + 6].int + mem[q + 6].int; {533:}
+ 	    delta := pythadd(u, v);
+ 	    if majoraxis = minoraxis then 
+ 		d := majoraxis
+ 	    else begin
+ 		if theta = 0 then begin
+ 		    alpha := u;
+ 		    beta := v
+ 		end else begin
+ 		    alpha := takefraction(u, ncos) + takefraction(v, nsin);
+ 		    beta := takefraction(v, ncos) - takefraction(u, nsin)
+ 		end;
+ 		alpha := makefraction(alpha, delta);
+ 		beta := makefraction(beta, delta);
+ 		d := pythadd(takefraction(majoraxis, alpha), takefraction(minoraxis, beta))
+ 	    end;
+ 	    d := takefraction(d, delta);
+ 	    alpha := abs(u);
+ 	    beta := abs(v);
+ 	    if alpha < beta then begin
+ 		delta := alpha;
+ 		alpha := beta;
+ 		beta := delta
+ 	    end;
+ 	    if internal[38] <> 0 then 
+ 		d := d - takefraction(internal[38], beta + beta);
+ 	    d := (d + 4) div 8;
+ 	    alpha := alpha div 32768;
+ 	    if d < alpha then 
+ 		d := alpha {:533};
+ 	    delta := c - d;
+ 	    if delta > 0 then begin
+ 		if delta > mem[r + 4].int then 
+ 		    delta := mem[r + 4].int;
+ 		if delta >= mem[q + 4].int then begin {534:}
+ 		    delta := mem[q + 4].int;
+ 		    mem[p + 6].int := c - delta;
+ 		    mem[p + 5].int := u;
+ 		    mem[q + 3].int := v;
+ 		    mem[q + 1].int := mem[q + 1].int - (delta * mem[r + 3].int);
+ 		    mem[q + 2].int := mem[q + 2].int + (delta * mem[q + 5].int);
+ 		    mem[r + 4].int := mem[r + 4].int - delta
+ 		end else begin {:534} {535:}
+ 		    s := getnode(7);
+ 		    mem[p].hh.rh := s;
+ 		    mem[s].hh.rh := q;
+ 		    mem[s + 1].int := mem[q + 1].int + (delta * mem[q + 3].int);
+ 		    mem[s + 2].int := mem[q + 2].int - (delta * mem[p + 5].int);
+ 		    mem[q + 1].int := mem[q + 1].int - (delta * mem[r + 3].int);
+ 		    mem[q + 2].int := mem[q + 2].int + (delta * mem[q + 5].int);
+ 		    mem[s + 3].int := mem[q + 3].int;
+ 		    mem[s + 5].int := u;
+ 		    mem[q + 3].int := v;
+ 		    mem[s + 6].int := c - delta;
+ 		    mem[s + 4].int := mem[q + 4].int - delta;
+ 		    mem[q + 4].int := delta;
+ 		    mem[r + 4].int := mem[r + 4].int - delta
+ 		end {:535}
+ 	    end else 
+ 		p := q; {532:}
+ 	    while true do begin
+ 		q := mem[p].hh.rh;
+ 		if q = (-30000) then 
+ 		    goto 30;
+ 		if mem[q + 4].int = 0 then begin
+ 		    mem[p].hh.rh := mem[q].hh.rh;
+ 		    mem[p + 6].int := mem[q + 6].int;
+ 		    mem[p + 5].int := mem[q + 5].int;
+ 		    freenode(q, 7)
+ 		end else begin
+ 		    r := mem[q].hh.rh;
+ 		    if r = (-30000) then 
+ 			goto 30;
+ 		    if mem[r + 4].int = 0 then begin
+ 			mem[p].hh.rh := r;
+ 			freenode(q, 7);
+ 			p := r
+ 		    end else 
+ 			goto 40
+ 		end
+ 	    end;
+     40: {:532}
+ 	    
+ 	end;
+     30: {:531}
+ 	;
+ 	if symmetric then begin {536:}
+ 	    s := -30000;
+ 	    q := h;
+ 	    while true do begin
+ 		r := getnode(7);
+ 		mem[r].hh.rh := s;
+ 		s := r;
+ 		mem[s + 1].int := mem[q + 1].int;
+ 		mem[s + 2].int := -mem[q + 2].int;
+ 		if q = p then 
+ 		    goto 31;
+ 		q := mem[q].hh.rh;
+ 		if mem[q + 2].int = 0 then 
+ 		    goto 31
+ 	    end;
+     31:
+ 	    mem[p].hh.rh := s;
+ 	    beta := -mem[h + 2].int;
+ 	    while mem[p + 2].int <> beta do 
+ 		p := mem[p].hh.rh;
+ 	    q := mem[p].hh.rh
+ 	end {:536};
+ {537:}
+ 	if q <> (-30000) then begin
+ 	    if mem[h + 5].int = 0 then begin
+ 		p := h;
+ 		h := mem[h].hh.rh;
+ 		freenode(p, 7);
+ 		mem[q + 1].int := -mem[h + 1].int
+ 	    end;
+ 	    p := q
+ 	end else 
+ 	    q := p;
+ 	r := mem[h].hh.rh;
+ 	repeat
+ 	    s := getnode(7);
+ 	    mem[p].hh.rh := s;
+ 	    p := s;
+ 	    mem[p + 1].int := -mem[r + 1].int;
+ 	    mem[p + 2].int := -mem[r + 2].int;
+ 	    r := mem[r].hh.rh
+ 	until r = q;
+ 	mem[p].hh.rh := h {:537};
+ 	makeellipse := h
+     end; {:527} {539:}
+ 
+     function finddirectiontime(x, y: scaled; h: halfword): scaled;
+     label
+ 	10, 40, 45, 30;
+     var
+ 	max: scaled;
+ 	p, q: halfword;
+ 	n: scaled;
+ 	tt: scaled; {542:}
+ 	x1, x2, x3, y1, y2, y3: scaled;
+ 	theta, phi: angle;
+ 	t: fraction; {:542} {540:}
+     begin
+ 	if abs(x) < abs(y) then begin
+ 	    x := makefraction(x, abs(y));
+ 	    if y > 0 then 
+ 		y := 268435456
+ 	    else 
+ 		y := -268435456
+ 	end else if x = 0 then begin
+ 	    finddirectiontime := 0;
+ 	    goto 10
+ 	end else begin
+ 	    y := makefraction(y, abs(x));
+ 	    if x > 0 then 
+ 		x := 268435456
+ 	    else 
+ 		x := -268435456
+ 	end {:540};
+ 	n := 0;
+ 	p := h;
+ 	while true do begin
+ 	    if mem[p].hh.b1 = 0 then 
+ 		goto 45;
+ 	    q := mem[p].hh.rh;
+ {541:}
+ 	    tt := 0; {543:}
+ 	    x1 := mem[p + 5].int - mem[p + 1].int;
+ 	    x2 := mem[q + 3].int - mem[p + 5].int;
+ 	    x3 := mem[q + 1].int - mem[q + 3].int;
+ 	    y1 := mem[p + 6].int - mem[p + 2].int;
+ 	    y2 := mem[q + 4].int - mem[p + 6].int;
+ 	    y3 := mem[q + 2].int - mem[q + 4].int;
+ 	    max := abs(x1);
+ 	    if abs(x2) > max then 
+ 		max := abs(x2);
+ 	    if abs(x3) > max then 
+ 		max := abs(x3);
+ 	    if abs(y1) > max then 
+ 		max := abs(y1);
+ 	    if abs(y2) > max then 
+ 		max := abs(y2);
+ 	    if abs(y3) > max then 
+ 		max := abs(y3);
+ 	    if max = 0 then 
+ 		goto 40;
+ 	    while max < 134217728 do begin
+ 		max := max + max;
+ 		x1 := x1 + x1;
+ 		x2 := x2 + x2;
+ 		x3 := x3 + x3;
+ 		y1 := y1 + y1;
+ 		y2 := y2 + y2;
+ 		y3 := y3 + y3
+ 	    end;
+ 	    t := x1;
+ 	    x1 := takefraction(x1, x) + takefraction(y1, y);
+ 	    y1 := takefraction(y1, x) - takefraction(t, y);
+ 	    t := x2;
+ 	    x2 := takefraction(x2, x) + takefraction(y2, y);
+ 	    y2 := takefraction(y2, x) - takefraction(t, y);
+ 	    t := x3;
+ 	    x3 := takefraction(x3, x) + takefraction(y3, y);
+ 	    y3 := takefraction(y3, x) - takefraction(t, y) {:543};
+ 	    if y1 = 0 then 
+ 		if x1 >= 0 then 
+ 		    goto 40;
+ 	    if n > 0 then begin {544:}
+ 		theta := narg(x1, y1);
+ 		if theta >= 0 then 
+ 		    if phi <= 0 then 
+ 			if phi >= (theta - 188743680) then 
+ 			    goto 40;
+ 		{:
+ 		544}
+ 		if theta <= 0 then 
+ 		    if phi >= 0 then 
+ 			if phi <= (theta + 188743680) then 
+ 			    goto 40;
+ 		if p = h then 
+ 		    goto 45
+ 	    end;
+ 	    if (x3 <> 0) or (y3 <> 0) then 
+ 		phi := narg(x3, y3);
+ {546:}
+ 	    if x1 < 0 then 
+ 		if x2 < 0 then 
+ 		    if x3 < 0 then 
+ 			goto 30;
+ 	    if abvscd(y1, y3, y2, y2) = 0 then begin {548:}
+ 		if abvscd(y1, y2, 0, 0) < 0 then begin
+ 		    t := makefraction(y1, y1 - y2);
+ 		    x1 := x1 - takefraction(x1 - x2, t);
+ 		    x2 := x2 - takefraction(x2 - x3, t);
+ 		    if (x1 - takefraction(x1 - x2, t)) >= 0 then begin
+ 			tt := (t + 2048) div 4096;
+ 			goto 40
+ 		    end
+ 		end else if y3 = 0 then 
+ 		    if y1 = 0 then begin {549:}
+ 			t := crossingpoint(-x1, -x2, -x3);
+ 			if t <= 268435456 then begin
+ 			    tt := (t + 2048) div 4096;
+ 			    goto 40
+ 			end;
+ 			if abvscd(x1, x3, x2, x2) <= 0 then begin
+ 			    t := makefraction(x1, x1 - x2);
+ 			    begin
+ 				tt := (t + 2048) div 4096;
+ 				goto 40
+ 			    end
+ 			end
+ 		    end else if x3 >= 0 then begin {:549}
+ 			tt := 65536;
+ 			goto 40
+ 		    end;
+ 		goto 30
+ 	    end {:548};
+ 	    if y1 <= 0 then 
+ 		if y1 < 0 then begin
+ 		    y1 := -y1;
+ 		    y2 := -y2;
+ 		    y3 := -y3
+ 		end else if y2 > 0 then begin
+ 		    y2 := -y2;
+ 		    y3 := -y3
+ 		end; {547:}
+ 	    t := crossingpoint(y1, y2, y3);
+ 	    if t > 268435456 then 
+ 		goto 30;
+ 	    y2 := y2 - takefraction(y2 - y3, t);
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    x2 := x2 - takefraction(x2 - x3, t);
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    if x1 >= 0 then begin
+ 		tt := (t + 2048) div 4096;
+ 		goto 40
+ 	    end;
+ 	    if y2 > 0 then 
+ 		y2 := 0;
+ 	    tt := t;
+ 	    t := crossingpoint(0, -y2, -y3);
+ 	    if t > 268435456 then 
+ 		goto 30;
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    x2 := x2 - takefraction(x2 - x3, t);
+ 	    if (x1 - takefraction(x1 - x2, t)) >= 0 then begin
+ 		t := tt - takefraction(tt - 268435456, t);
+ 		begin
+ 		    tt := (t + 2048) div 4096;
+ 		    goto 40
+ 		end
+ 	    end {:547};
+     30: {:546}
+ {:541}
+ 	    ;
+ 	    p := q;
+ 	    n := n + 65536
+ 	end;
+     45:
+ 	finddirectiontime := -65536;
+ 	goto 10;
+     40:
+ 	finddirectiontime := n + tt;
+     10:
+ 	
+     end; {:539} {556:}
+ 
+     procedure cubicintersection(p, pp: halfword);
+     label
+ 	22, 45, 10;
+     var
+ 	q, qq: halfword;
+     begin
+ 	timetogo := 5000;
+ 	maxt := 2; {558:}
+ 	q := mem[p].hh.rh;
+ 	qq := mem[pp].hh.rh;
+ 	bisectptr := 20;
+ 	bisectstack[bisectptr - 5] := mem[p + 5].int - mem[p + 1].int;
+ 	bisectstack[bisectptr - 4] := mem[q + 3].int - mem[p + 5].int;
+ 	bisectstack[bisectptr - 3] := mem[q + 1].int - mem[q + 3].int;
+ 	if bisectstack[bisectptr - 5] < 0 then 
+ 	    if bisectstack[bisectptr - 3] >= 0 then begin
+ 		if bisectstack[bisectptr - 4] < 0 then 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 		else 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 		bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 		if bisectstack[bisectptr - 1] < 0 then 
+ 		    bisectstack[bisectptr - 1] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 		if bisectstack[bisectptr - 2] > bisectstack[bisectptr - 5] then 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 		if bisectstack[bisectptr - 1] < 0 then 
+ 		    bisectstack[bisectptr - 1] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 3] <= 0 then begin
+ 	    if bisectstack[bisectptr - 4] > 0 then 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 	    else 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 	    bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 	    if bisectstack[bisectptr - 2] > 0 then 
+ 		bisectstack[bisectptr - 2] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 	    if bisectstack[bisectptr - 1] < bisectstack[bisectptr - 5] then 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 	    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 	    if bisectstack[bisectptr - 2] > 0 then 
+ 		bisectstack[bisectptr - 2] := 0
+ 	end;
+ 	bisectstack[bisectptr - 10] := mem[p + 6].int - mem[p + 2].int;
+ 	bisectstack[bisectptr - 9] := mem[q + 4].int - mem[p + 6].int;
+ 	bisectstack[bisectptr - 8] := mem[q + 2].int - mem[q + 4].int;
+ 	if bisectstack[bisectptr - 10] < 0 then 
+ 	    if bisectstack[bisectptr - 8] >= 0 then begin
+ 		if bisectstack[bisectptr - 9] < 0 then 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 		else 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 		bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 		if bisectstack[bisectptr - 6] < 0 then 
+ 		    bisectstack[bisectptr - 6] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 		if bisectstack[bisectptr - 7] > bisectstack[bisectptr - 10] then 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 		if bisectstack[bisectptr - 6] < 0 then 
+ 		    bisectstack[bisectptr - 6] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 8] <= 0 then begin
+ 	    if bisectstack[bisectptr - 9] > 0 then 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 	    else 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 	    bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 	    if bisectstack[bisectptr - 7] > 0 then 
+ 		bisectstack[bisectptr - 7] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 	    if bisectstack[bisectptr - 6] < bisectstack[bisectptr - 10] then 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 	    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 	    if bisectstack[bisectptr - 7] > 0 then 
+ 		bisectstack[bisectptr - 7] := 0
+ 	end;
+ 	bisectstack[bisectptr - 15] := mem[pp + 5].int - mem[pp + 1].int;
+ 	bisectstack[bisectptr - 14] := mem[qq + 3].int - mem[pp + 5].int;
+ 	bisectstack[bisectptr - 13] := mem[qq + 1].int - mem[qq + 3].int;
+ 	if bisectstack[bisectptr - 15] < 0 then 
+ 	    if bisectstack[bisectptr - 13] >= 0 then begin
+ 		if bisectstack[bisectptr - 14] < 0 then 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 		else 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 		bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 		if bisectstack[bisectptr - 11] < 0 then 
+ 		    bisectstack[bisectptr - 11] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 		if bisectstack[bisectptr - 12] > bisectstack[bisectptr - 15] then 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 		if bisectstack[bisectptr - 11] < 0 then 
+ 		    bisectstack[bisectptr - 11] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 13] <= 0 then begin
+ 	    if bisectstack[bisectptr - 14] > 0 then 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 	    else 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 	    bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 	    if bisectstack[bisectptr - 12] > 0 then 
+ 		bisectstack[bisectptr - 12] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 	    if bisectstack[bisectptr - 11] < bisectstack[bisectptr - 15] then 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 	    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 	    if bisectstack[bisectptr - 12] > 0 then 
+ 		bisectstack[bisectptr - 12] := 0
+ 	end;
+ 	bisectstack[bisectptr - 20] := mem[pp + 6].int - mem[pp + 2].int;
+ 	bisectstack[bisectptr - 19] := mem[qq + 4].int - mem[pp + 6].int;
+ 	bisectstack[bisectptr - 18] := mem[qq + 2].int - mem[qq + 4].int;
+ 	if bisectstack[bisectptr - 20] < 0 then 
+ 	    if bisectstack[bisectptr - 18] >= 0 then begin
+ 		if bisectstack[bisectptr - 19] < 0 then 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 		else 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 		bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 		if bisectstack[bisectptr - 16] < 0 then 
+ 		    bisectstack[bisectptr - 16] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 		if bisectstack[bisectptr - 17] > bisectstack[bisectptr - 20] then 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 		if bisectstack[bisectptr - 16] < 0 then 
+ 		    bisectstack[bisectptr - 16] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 18] <= 0 then begin
+ 	    if bisectstack[bisectptr - 19] > 0 then 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 	    else 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 	    bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 	    if bisectstack[bisectptr - 17] > 0 then 
+ 		bisectstack[bisectptr - 17] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 	    if bisectstack[bisectptr - 16] < bisectstack[bisectptr - 20] then 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 	    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 	    if bisectstack[bisectptr - 17] > 0 then 
+ 		bisectstack[bisectptr - 17] := 0
+ 	end;
+ 	delx := mem[p + 1].int - mem[pp + 1].int;
+ 	dely := mem[p + 2].int - mem[pp + 2].int;
+ 	tol := 0;
+ 	uv := bisectptr;
+ 	xy := bisectptr;
+ 	threel := 0;
+ 	curt := 1;
+ 	curtt := 1 {:558};
+ 	while true do begin
+     22:
+ 	    if (delx - tol) <= (bisectstack[xy - 11] - bisectstack[uv - 2]) then 
+ 		if (delx + tol) >= (bisectstack[xy - 12] - bisectstack[uv - 1]) then 
+ 		    if (dely - tol) <= (bisectstack[xy - 16] - bisectstack[uv - 7]) then 
+ 			if (dely + tol) >= (bisectstack[xy - 17] - bisectstack[uv - 6]) then begin
+ 			    if curt >= maxt then begin
+ 				if maxt = 131072 then begin
+ 				    curt := (curt + 1) div 2;
+ 				    curtt := (curtt + 1) div 2;
+ 				    goto 10
+ 				end;
+ 				maxt := maxt + maxt;
+ 				apprt := curt;
+ 				apprtt := curtt
+ 			    end; {559:}
+ 			    bisectstack[bisectptr] := delx;
+ 			    bisectstack[bisectptr + 1] := dely;
+ 			    bisectstack[bisectptr + 2] := tol;
+ 			    bisectstack[bisectptr + 3] := uv;
+ 			    bisectstack[bisectptr + 4] := xy;
+ 			    bisectptr := bisectptr + 45;
+ 			    curt := curt + curt;
+ 			    curtt := curtt + curtt;
+ 			    bisectstack[bisectptr - 25] := bisectstack[uv - 5];
+ 			    bisectstack[bisectptr - 3] := bisectstack[uv - 3];
+ 			    bisectstack[bisectptr - 24] := (bisectstack[bisectptr - 25] + bisectstack[uv - 4]) div 2;
+ 			    bisectstack[bisectptr - 4] := (bisectstack[bisectptr - 3] + bisectstack[uv - 4]) div 2;
+ 			    bisectstack[bisectptr - 23] := (bisectstack[bisectptr - 24] + bisectstack[bisectptr - 4]) div 2;
+ 			    bisectstack[bisectptr - 5] := bisectstack[bisectptr - 23];
+ 			    if bisectstack[bisectptr - 25] < 0 then 
+ 				if bisectstack[bisectptr - 23] >= 0 then begin
+ 				    if bisectstack[bisectptr - 24] < 0 then 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]
+ 				    else 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25];
+ 				    bisectstack[bisectptr - 21] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				    if bisectstack[bisectptr - 21] < 0 then 
+ 					bisectstack[bisectptr - 21] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 22] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				    if bisectstack[bisectptr - 22] > bisectstack[bisectptr - 25] then 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25];
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24];
+ 				    if bisectstack[bisectptr - 21] < 0 then 
+ 					bisectstack[bisectptr - 21] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 23] <= 0 then begin
+ 				if bisectstack[bisectptr - 24] > 0 then 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]
+ 				else 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25];
+ 				bisectstack[bisectptr - 22] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				if bisectstack[bisectptr - 22] > 0 then 
+ 				    bisectstack[bisectptr - 22] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 21] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				if bisectstack[bisectptr - 21] < bisectstack[bisectptr - 25] then 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25];
+ 				bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24];
+ 				if bisectstack[bisectptr - 22] > 0 then 
+ 				    bisectstack[bisectptr - 22] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 5] < 0 then 
+ 				if bisectstack[bisectptr - 3] >= 0 then begin
+ 				    if bisectstack[bisectptr - 4] < 0 then 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 				    else 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 				    bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				    if bisectstack[bisectptr - 1] < 0 then 
+ 					bisectstack[bisectptr - 1] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				    if bisectstack[bisectptr - 2] > bisectstack[bisectptr - 5] then 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 				    if bisectstack[bisectptr - 1] < 0 then 
+ 					bisectstack[bisectptr - 1] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 3] <= 0 then begin
+ 				if bisectstack[bisectptr - 4] > 0 then 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 				else 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 				bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				if bisectstack[bisectptr - 2] > 0 then 
+ 				    bisectstack[bisectptr - 2] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				if bisectstack[bisectptr - 1] < bisectstack[bisectptr - 5] then 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 				bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 				if bisectstack[bisectptr - 2] > 0 then 
+ 				    bisectstack[bisectptr - 2] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 30] := bisectstack[uv - 10];
+ 			    bisectstack[bisectptr - 8] := bisectstack[uv - 8];
+ 			    bisectstack[bisectptr - 29] := (bisectstack[bisectptr - 30] + bisectstack[uv - 9]) div 2;
+ 			    bisectstack[bisectptr - 9] := (bisectstack[bisectptr - 8] + bisectstack[uv - 9]) div 2;
+ 			    bisectstack[bisectptr - 28] := (bisectstack[bisectptr - 29] + bisectstack[bisectptr - 9]) div 2;
+ 			    bisectstack[bisectptr - 10] := bisectstack[bisectptr - 28];
+ 			    if bisectstack[bisectptr - 30] < 0 then 
+ 				if bisectstack[bisectptr - 28] >= 0 then begin
+ 				    if bisectstack[bisectptr - 29] < 0 then 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]
+ 				    else 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30];
+ 				    bisectstack[bisectptr - 26] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				    if bisectstack[bisectptr - 26] < 0 then 
+ 					bisectstack[bisectptr - 26] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 27] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				    if bisectstack[bisectptr - 27] > bisectstack[bisectptr - 30] then 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30];
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29];
+ 				    if bisectstack[bisectptr - 26] < 0 then 
+ 					bisectstack[bisectptr - 26] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 28] <= 0 then begin
+ 				if bisectstack[bisectptr - 29] > 0 then 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]
+ 				else 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30];
+ 				bisectstack[bisectptr - 27] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				if bisectstack[bisectptr - 27] > 0 then 
+ 				    bisectstack[bisectptr - 27] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 26] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				if bisectstack[bisectptr - 26] < bisectstack[bisectptr - 30] then 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30];
+ 				bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29];
+ 				if bisectstack[bisectptr - 27] > 0 then 
+ 				    bisectstack[bisectptr - 27] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 10] < 0 then 
+ 				if bisectstack[bisectptr - 8] >= 0 then begin
+ 				    if bisectstack[bisectptr - 9] < 0 then 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 				    else 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 				    bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				    if bisectstack[bisectptr - 6] < 0 then 
+ 					bisectstack[bisectptr - 6] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				    if bisectstack[bisectptr - 7] > bisectstack[bisectptr - 10] then 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 				    if bisectstack[bisectptr - 6] < 0 then 
+ 					bisectstack[bisectptr - 6] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 8] <= 0 then begin
+ 				if bisectstack[bisectptr - 9] > 0 then 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 				else 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 				bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				if bisectstack[bisectptr - 7] > 0 then 
+ 				    bisectstack[bisectptr - 7] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				if bisectstack[bisectptr - 6] < bisectstack[bisectptr - 10] then 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 				bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 				if bisectstack[bisectptr - 7] > 0 then 
+ 				    bisectstack[bisectptr - 7] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 35] := bisectstack[xy - 15];
+ 			    bisectstack[bisectptr - 13] := bisectstack[xy - 13];
+ 			    bisectstack[bisectptr - 34] := (bisectstack[bisectptr - 35] + bisectstack[xy - 14]) div 2;
+ 			    bisectstack[bisectptr - 14] := (bisectstack[bisectptr - 13] + bisectstack[xy - 14]) div 2;
+ 			    bisectstack[bisectptr - 33] := (bisectstack[bisectptr - 34] + bisectstack[bisectptr - 14]) div 2;
+ 			    bisectstack[bisectptr - 15] := bisectstack[bisectptr - 33];
+ 			    if bisectstack[bisectptr - 35] < 0 then 
+ 				if bisectstack[bisectptr - 33] >= 0 then begin
+ 				    if bisectstack[bisectptr - 34] < 0 then 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]
+ 				    else 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35];
+ 				    bisectstack[bisectptr - 31] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				    if bisectstack[bisectptr - 31] < 0 then 
+ 					bisectstack[bisectptr - 31] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 32] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				    if bisectstack[bisectptr - 32] > bisectstack[bisectptr - 35] then 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35];
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34];
+ 				    if bisectstack[bisectptr - 31] < 0 then 
+ 					bisectstack[bisectptr - 31] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 33] <= 0 then begin
+ 				if bisectstack[bisectptr - 34] > 0 then 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]
+ 				else 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35];
+ 				bisectstack[bisectptr - 32] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				if bisectstack[bisectptr - 32] > 0 then 
+ 				    bisectstack[bisectptr - 32] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 31] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				if bisectstack[bisectptr - 31] < bisectstack[bisectptr - 35] then 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35];
+ 				bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34];
+ 				if bisectstack[bisectptr - 32] > 0 then 
+ 				    bisectstack[bisectptr - 32] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 15] < 0 then 
+ 				if bisectstack[bisectptr - 13] >= 0 then begin
+ 				    if bisectstack[bisectptr - 14] < 0 then 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 				    else 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 				    bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				    if bisectstack[bisectptr - 11] < 0 then 
+ 					bisectstack[bisectptr - 11] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				    if bisectstack[bisectptr - 12] > bisectstack[bisectptr - 15] then 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 				    if bisectstack[bisectptr - 11] < 0 then 
+ 					bisectstack[bisectptr - 11] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 13] <= 0 then begin
+ 				if bisectstack[bisectptr - 14] > 0 then 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 				else 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 				bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				if bisectstack[bisectptr - 12] > 0 then 
+ 				    bisectstack[bisectptr - 12] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				if bisectstack[bisectptr - 11] < bisectstack[bisectptr - 15] then 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 				bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 				if bisectstack[bisectptr - 12] > 0 then 
+ 				    bisectstack[bisectptr - 12] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 40] := bisectstack[xy - 20];
+ 			    bisectstack[bisectptr - 18] := bisectstack[xy - 18];
+ 			    bisectstack[bisectptr - 39] := (bisectstack[bisectptr - 40] + bisectstack[xy - 19]) div 2;
+ 			    bisectstack[bisectptr - 19] := (bisectstack[bisectptr - 18] + bisectstack[xy - 19]) div 2;
+ 			    bisectstack[bisectptr - 38] := (bisectstack[bisectptr - 39] + bisectstack[bisectptr - 19]) div 2;
+ 			    bisectstack[bisectptr - 20] := bisectstack[bisectptr - 38];
+ 			    if bisectstack[bisectptr - 40] < 0 then 
+ 				if bisectstack[bisectptr - 38] >= 0 then begin
+ 				    if bisectstack[bisectptr - 39] < 0 then 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]
+ 				    else 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40];
+ 				    bisectstack[bisectptr - 36] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				    if bisectstack[bisectptr - 36] < 0 then 
+ 					bisectstack[bisectptr - 36] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 37] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				    if bisectstack[bisectptr - 37] > bisectstack[bisectptr - 40] then 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40];
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39];
+ 				    if bisectstack[bisectptr - 36] < 0 then 
+ 					bisectstack[bisectptr - 36] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 38] <= 0 then begin
+ 				if bisectstack[bisectptr - 39] > 0 then 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]
+ 				else 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40];
+ 				bisectstack[bisectptr - 37] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				if bisectstack[bisectptr - 37] > 0 then 
+ 				    bisectstack[bisectptr - 37] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 36] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				if bisectstack[bisectptr - 36] < bisectstack[bisectptr - 40] then 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40];
+ 				bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39];
+ 				if bisectstack[bisectptr - 37] > 0 then 
+ 				    bisectstack[bisectptr - 37] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 20] < 0 then 
+ 				if bisectstack[bisectptr - 18] >= 0 then begin
+ 				    if bisectstack[bisectptr - 19] < 0 then 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 				    else 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 				    bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				    if bisectstack[bisectptr - 16] < 0 then 
+ 					bisectstack[bisectptr - 16] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				    if bisectstack[bisectptr - 17] > bisectstack[bisectptr - 20] then 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 				    if bisectstack[bisectptr - 16] < 0 then 
+ 					bisectstack[bisectptr - 16] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 18] <= 0 then begin
+ 				if bisectstack[bisectptr - 19] > 0 then 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 				else 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 				bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				if bisectstack[bisectptr - 17] > 0 then 
+ 				    bisectstack[bisectptr - 17] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				if bisectstack[bisectptr - 16] < bisectstack[bisectptr - 20] then 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 				bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 				if bisectstack[bisectptr - 17] > 0 then 
+ 				    bisectstack[bisectptr - 17] := 0
+ 			    end;
+ 			    uv := bisectptr - 20;
+ 			    xy := bisectptr - 20;
+ 			    delx := delx + delx;
+ 			    dely := dely + dely;
+ 			    tol := (tol - threel) + tolstep;
+ 			    tol := tol + tol;
+ 			    threel := threel + tolstep {:559};
+ 			    goto 22
+ 			end;
+ 	    if timetogo > 0 then 
+ 		timetogo := timetogo - 1
+ 	    else begin
+ 		while apprt < 65536 do begin
+ 		    apprt := apprt + apprt;
+ 		    apprtt := apprtt + apprtt
+ 		end;
+ 		curt := apprt;
+ 		curtt := apprtt;
+ 		goto 10
+ 	    end; {560:}
+     45:
+ 	    if odd(curtt) then 
+ 		if odd(curt) then begin {561:}
+ 		    curt := curt div 2;
+ 		    curtt := curtt div 2;
+ 		    if curt = 0 then 
+ 			goto 10;
+ 		    bisectptr := bisectptr - 45;
+ 		    threel := threel - tolstep;
+ 		    delx := bisectstack[bisectptr];
+ 		    dely := bisectstack[bisectptr + 1];
+ 		    tol := bisectstack[bisectptr + 2];
+ 		    uv := bisectstack[bisectptr + 3];
+ 		    xy := bisectstack[bisectptr + 4];
+ 		    goto 45
+ 		end else begin {:561}
+ 		    curt := curt + 1;
+ 		    delx := ((delx + bisectstack[uv - 5]) + bisectstack[uv - 4]) + bisectstack[uv - 3];
+ 		    dely := ((dely + bisectstack[uv - 10]) + bisectstack[uv - 9]) + bisectstack[uv - 8];
+ 		    uv := uv + 20;
+ 		    curtt := curtt - 1;
+ 		    xy := xy - 20;
+ 		    delx := ((delx + bisectstack[xy - 15]) + bisectstack[xy - 14]) + bisectstack[xy - 13];
+ 		    dely := ((dely + bisectstack[xy - 20]) + bisectstack[xy - 19]) + bisectstack[xy - 18]
+ 		end
+ 	    else begin
+ 		curtt := curtt + 1;
+ 		tol := tol + threel;
+ 		delx := ((delx - bisectstack[xy - 15]) - bisectstack[xy - 14]) - bisectstack[xy - 13];
+ 		dely := ((dely - bisectstack[xy - 20]) - bisectstack[xy - 19]) - bisectstack[xy - 18];
+ 		xy := xy + 20
+ 	    end {:560}
+ 	end;
+     10:
+ 	
+     end; {:556} {562:}
+ 
+     procedure pathintersection(h, hh: halfword);
+     label
+ 	10;
+     var
+ 	p, pp: halfword;
+ 	n, nn: integer; {563:}
+     begin
+ 	if mem[h].hh.b1 = 0 then begin
+ 	    mem[h + 5].int := mem[h + 1].int;
+ 	    mem[h + 3].int := mem[h + 1].int;
+ 	    mem[h + 6].int := mem[h + 2].int;
+ 	    mem[h + 4].int := mem[h + 2].int;
+ 	    mem[h].hh.b1 := 1
+ 	end;
+ 	if mem[hh].hh.b1 = 0 then begin
+ 	    mem[hh + 5].int := mem[hh + 1].int;
+ 	    mem[hh + 3].int := mem[hh + 1].int;
+ 	    mem[hh + 6].int := mem[hh + 2].int;
+ 	    mem[hh + 4].int := mem[hh + 2].int;
+ 	    mem[hh].hh.b1 := 1
+ 	end; {:563}
+ 	tolstep := 0;
+ 	repeat
+ 	    n := -65536;
+ 	    p := h;
+ 	    repeat
+ 		if mem[p].hh.b1 <> 0 then begin
+ 		    nn := -65536;
+ 		    pp := hh;
+ 		    repeat
+ 			if mem[pp].hh.b1 <> 0 then begin
+ 			    cubicintersection(p, pp);
+ 			    if curt > 0 then begin
+ 				curt := curt + n;
+ 				curtt := curtt + nn;
+ 				goto 10
+ 			    end
+ 			end;
+ 			nn := nn + 65536;
+ 			pp := mem[pp].hh.rh
+ 		    until pp = hh
+ 		end;
+ 		n := n + 65536;
+ 		p := mem[p].hh.rh
+ 	    until p = h;
+ 	    tolstep := tolstep + 3
+ 	until tolstep > 3;
+ 	curt := -65536;
+ 	curtt := -65536;
+     10:
+ 	
+     end; {:562} {574:}
+ 
+     procedure openawindow(k: windownumber; r0, c0, r1, c1: scaled; x, y: scaled);
+     var
+ 	m, n: integer; {575:}
+     begin
+ 	if r0 < 0 then 
+ 	    r0 := 0
+ 	else 
+ 	    r0 := roundunscaled(r0);
+ 	r1 := roundunscaled(r1);
+ 	if r1 > screendepth then 
+ 	    r1 := screendepth;
+ 	if r1 < r0 then 
+ 	    if r0 > screendepth then 
+ 		r0 := r1
+ 	    else 
+ 		r1 := r0;
+ 	if c0 < 0 then 
+ 	    c0 := 0
+ 	else 
+ 	    c0 := roundunscaled(c0);
+ 	c1 := roundunscaled(c1);
+ 	if c1 > screenwidth then 
+ 	    c1 := screenwidth;
+ 	if c1 < c0 then 
+ 	    if c0 > screenwidth then 
+ 		c0 := c1
+ 	    else 
+ 		c1 := c0 {:575};
+ 	windowopen[k] := true;
+ 	windowtime[k] := windowtime[k] + 1;
+ 	leftcol[k] := c0;
+ 	rightcol[k] := c1;
+ 	toprow[k] := r0;
+ 	botrow[k] := r1; {576:}
+ 	m := roundunscaled(x);
+ 	n := roundunscaled(y) - 1;
+ 	mwindow[k] := c0 - m;
+ 	nwindow[k] := r0 + n {:576};
+ 	begin
+ 	    if not screenstarted then begin
+ 		screenOK := initscreen;
+ 		screenstarted := true
+ 	    end
+ 	end;
+ 	if screenOK then begin
+ 	    blankrectangle(c0, c1, r0, r1);
+ 	    updatescreen
+ 	end
+     end; { openawindow }
+ {:574}
+     {577:}
+ 
+     procedure dispedges(k: windownumber);
+     label
+ 	30, 40;
+     var
+ 	p, q: halfword;
+ 	alreadythere: boolean;
+ 	r: integer; {580:}
+ 	n: screencol;
+ 	w, ww: integer;
+ 	b: pixelcolor;
+ 	m, mm: integer;
+ 	d: integer;
+ 	madjustment: integer;
+ 	rightedge: integer;
+ 	mincol: screencol; {:580}
+     begin
+ 	if screenOK then 
+ 	    if leftcol[k] < rightcol[k] then 
+ 		if toprow[k] < botrow[k] then begin
+ 		    alreadythere := false;
+ 		    if mem[curedges + 3].hh.rh = k then 
+ 			if mem[curedges + 4].int = windowtime[k] then 
+ 			    alreadythere := true;
+ 		    if not alreadythere then 
+ 			blankrectangle(leftcol[k], rightcol[k], toprow[k], botrow[k]); {581:}
+ 		    madjustment := mwindow[k] - mem[curedges + 3].hh.lh;
+ 		    rightedge := 8 * (rightcol[k] - madjustment);
+ 		    mincol := leftcol[k] {:581};
+ 		    p := mem[curedges].hh.rh;
+ 		    r := nwindow[k] - (mem[curedges + 1].hh.lh - 4096);
+ 		    while (p <> curedges) and (r >= toprow[k]) do begin
+ 			if r < botrow[k] then begin {578:}
+ 			    if mem[p + 1].hh.lh > (-29999) then 
+ 				sortedges(p)
+ 			    else if mem[p + 1].hh.lh = (-29999) then 
+ 				if alreadythere then 
+ 				    goto 30;
+ 			    mem[p + 1].hh.lh := -29999; {582:}
+ 			    n := 0;
+ 			    ww := 0;
+ 			    m := -1;
+ 			    w := 0;
+ 			    q := mem[p + 1].hh.rh;
+ 			    rowtransition[0] := mincol;
+ 			    while true do begin
+ 				if q = 30000 then 
+ 				    d := rightedge
+ 				else 
+ 				    d := mem[q].hh.lh + 32768;
+ 				mm := (d div 8) + madjustment;
+ 				if mm <> m then begin {583:}
+ 				    if w <= 0 then begin
+ 					if ww > 0 then 
+ 					    if m > mincol then begin
+ 						if n = 0 then 
+ 						    if alreadythere then begin
+ 							b := 0;
+ 							n := n + 1
+ 						    end else 
+ 							b := 1
+ 						else 
+ 						    n := n + 1;
+ 						rowtransition[n] := m
+ 					    end
+ 				    end else if ww <= 0 then 
+ 					if m > mincol then begin
+ 					    if n = 0 then 
+ 						b := 1;
+ 					    n := n + 1;
+ 					    rowtransition[n] := m
+ 					end {:583};
+ 				    m := mm;
+ 				    w := ww
+ 				end;
+ 				if d >= rightedge then 
+ 				    goto 40;
+ 				ww := (ww + (d mod 8)) - 4;
+ 				q := mem[q].hh.rh
+ 			    end;
+     40: {584:}
+ 			    if alreadythere or (ww > 0) then begin
+ 				if n = 0 then 
+ 				    if ww > 0 then 
+ 					b := 1
+ 				    else 
+ 					b := 0;
+ 				n := n + 1;
+ 				rowtransition[n] := rightcol[k]
+ 			    end else if n = 0 then 
+ 				goto 30 {:584}; {:582}
+ 			    paintrow(r, b, rowtransition, n);
+     30: {:578}
+ 			    
+ 			end;
+ 			p := mem[p].hh.rh;
+ 			r := r - 1
+ 		    end;
+ 		    updatescreen;
+ 		    windowtime[k] := windowtime[k] + 1;
+ 		    mem[curedges + 3].hh.rh := k;
+ 		    mem[curedges + 4].int := windowtime[k]
+ 		end
+     end; {:577} {591:}
+ 
+     function maxcoef(p: halfword): fraction;
+     var
+ 	x: fraction;
+     begin
+ 	x := 0;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if abs(mem[p + 1].int) > x then 
+ 		x := abs(mem[p + 1].int);
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	maxcoef := x
+     end; {:591} {597:}
+ 
+     function pplusq(p: halfword; q: halfword; t: smallnumber): halfword;
+     label
+ 	30;
+     var
+ 	pp, qq: halfword;
+ 	r, s: halfword;
+ 	threshold: integer;
+ 	v: integer;
+     begin
+ 	if t = 17 then 
+ 	    threshold := 2685
+ 	else 
+ 	    threshold := 8;
+ 	r := 29999;
+ 	pp := mem[p].hh.lh;
+ 	qq := mem[q].hh.lh;
+ 	while true do 
+ 	    if pp = qq then 
+ 		if pp = (-30000) then 
+ 		    goto 30 {598:}
+ 		else begin
+ 		    v := mem[p + 1].int + mem[q + 1].int;
+ 		    mem[p + 1].int := v;
+ 		    s := p;
+ 		    p := mem[p].hh.rh;
+ 		    pp := mem[p].hh.lh;
+ 		    if abs(v) < threshold then 
+ 			freenode(s, 2)
+ 		    else begin
+ 			if abs(v) >= 626349397 then 
+ 			    if watchcoefs then begin
+ 				mem[qq].hh.b0 := 0;
+ 				fixneeded := true
+ 			    end;
+ 			mem[r].hh.rh := s;
+ 			r := s
+ 		    end;
+ 		    q := mem[q].hh.rh;
+ 		    qq := mem[q].hh.lh
+ 		end {:598}
+ 	    else if mem[pp + 1].int < mem[qq + 1].int then begin
+ 		s := getnode(2);
+ 		mem[s].hh.lh := qq;
+ 		mem[s + 1].int := mem[q + 1].int;
+ 		q := mem[q].hh.rh;
+ 		qq := mem[q].hh.lh;
+ 		mem[r].hh.rh := s;
+ 		r := s
+ 	    end else begin
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		p := mem[p].hh.rh;
+ 		pp := mem[p].hh.lh
+ 	    end;
+     30:
+ 	mem[p + 1].int := slowadd(mem[p + 1].int, mem[q + 1].int);
+ 	mem[r].hh.rh := p;
+ 	depfinal := p;
+ 	pplusq := mem[29999].hh.rh
+     end; {:597} {599:}
+ 
+     function ptimesv(p: halfword; v: integer; t0, t1: smallnumber; visscaled: boolean): halfword;
+     var
+ 	r, s: halfword;
+ 	w: integer;
+ 	threshold: integer;
+ 	scalingdown: boolean;
+     begin
+ 	if t0 <> t1 then 
+ 	    scalingdown := true
+ 	else 
+ 	    scalingdown := not visscaled;
+ 	if t1 = 17 then 
+ 	    threshold := 1342
+ 	else 
+ 	    threshold := 4;
+ 	r := 29999;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if scalingdown then 
+ 		w := takefraction(v, mem[p + 1].int)
+ 	    else 
+ 		w := takescaled(v, mem[p + 1].int);
+ 	    if abs(w) <= threshold then begin
+ 		s := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := s
+ 	    end else begin
+ 		if abs(w) >= 626349397 then begin
+ 		    fixneeded := true;
+ 		    mem[mem[p].hh.lh].hh.b0 := 0
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		mem[p + 1].int := w;
+ 		p := mem[p].hh.rh
+ 	    end
+ 	end;
+ 	mem[r].hh.rh := p;
+ 	if visscaled then 
+ 	    mem[p + 1].int := takescaled(mem[p + 1].int, v)
+ 	else 
+ 	    mem[p + 1].int := takefraction(mem[p + 1].int, v);
+ 	ptimesv := mem[29999].hh.rh
+     end; {:599}
+ {601:}
+ 
+     function pwithxbecomingq(p, x, q: halfword; t: smallnumber): halfword;
+     var
+ 	r, s: halfword;
+ 	v: integer;
+ 	sx: integer;
+     begin
+ 	s := p;
+ 	r := 29999;
+ 	sx := mem[x + 1].int;
+ 	while mem[mem[s].hh.lh + 1].int > sx do begin
+ 	    r := s;
+ 	    s := mem[s].hh.rh
+ 	end;
+ 	if mem[s].hh.lh <> x then 
+ 	    pwithxbecomingq := p
+ 	else begin
+ 	    mem[29999].hh.rh := p;
+ 	    mem[r].hh.rh := mem[s].hh.rh;
+ 	    v := mem[s + 1].int;
+ 	    freenode(s, 2);
+ 	    pwithxbecomingq := pplusfq(mem[29999].hh.rh, v, q, t, 17)
+ 	end
+     end; {:601} {606:}
+ 
+     procedure newdep(q, p: halfword);
+     var
+ 	r: halfword;
+     begin
+ 	mem[q + 1].hh.rh := p;
+ 	mem[q + 1].hh.lh := -29987;
+ 	r := mem[-29987].hh.rh;
+ 	mem[depfinal].hh.rh := r;
+ 	mem[r + 1].hh.lh := depfinal;
+ 	mem[-29987].hh.rh := q
+     end; {:606} {607:}
+ 
+     function constdependency(v: scaled): halfword;
+     begin
+ 	depfinal := getnode(2);
+ 	mem[depfinal + 1].int := v;
+ 	mem[depfinal].hh.lh := -30000;
+ 	constdependency := depfinal
+     end; {:607} {608:}
+ 
+     function singledependency(p: halfword): halfword;
+     var
+ 	q: halfword;
+ 	m: integer;
+     begin
+ 	m := mem[p + 1].int mod 64;
+ 	if m > 28 then 
+ 	    singledependency := constdependency(0)
+ 	else begin
+ 	    q := getnode(2);
+ 	    mem[q + 1].int := twotothe[28 - m];
+ 	    mem[q].hh.lh := p;
+ 	    mem[q].hh.rh := constdependency(0);
+ 	    singledependency := q
+ 	end
+     end; {:608}
+ {609:}
+ 
+     function copydeplist(p: halfword): halfword;
+     label
+ 	30;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(2);
+ 	depfinal := q;
+ 	while true do begin
+ 	    mem[depfinal].hh.lh := mem[p].hh.lh;
+ 	    mem[depfinal + 1].int := mem[p + 1].int;
+ 	    if mem[depfinal].hh.lh = (-30000) then 
+ 		goto 30;
+ 	    mem[depfinal].hh.rh := getnode(2);
+ 	    depfinal := mem[depfinal].hh.rh;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	copydeplist := q
+     end; {:609} {610:}
+ 
+     procedure lineareq(p: halfword; t: smallnumber);
+     var
+ 	q, r, s: halfword;
+ 	x: halfword;
+ 	n: integer;
+ 	v: integer;
+ 	prevr: halfword;
+ 	finalnode: halfword;
+ 	w: integer; {611:}
+     begin
+ 	q := p;
+ 	r := mem[p].hh.rh;
+ 	v := mem[q + 1].int;
+ 	while mem[r].hh.lh <> (-30000) do begin
+ 	    if abs(mem[r + 1].int) > abs(v) then begin
+ 		q := r;
+ 		v := mem[r + 1].int
+ 	    end;
+ 	    r := mem[r].hh.rh
+ 	end {:611};
+ 	x := mem[q].hh.lh;
+ 	n := mem[x + 1].int mod 64; {612:}
+ 	s := 29999;
+ 	mem[s].hh.rh := p;
+ 	r := p;
+ 	repeat
+ 	    if r = q then begin
+ 		mem[s].hh.rh := mem[r].hh.rh;
+ 		freenode(r, 2)
+ 	    end else begin
+ 		w := makefraction(mem[r + 1].int, v);
+ 		if abs(w) <= 1342 then begin
+ 		    mem[s].hh.rh := mem[r].hh.rh;
+ 		    freenode(r, 2)
+ 		end else begin
+ 		    mem[r + 1].int := -w;
+ 		    s := r
+ 		end
+ 	    end;
+ 	    r := mem[s].hh.rh
+ 	until mem[r].hh.lh = (-30000);
+ 	if t = 18 then 
+ 	    mem[r + 1].int := -makescaled(mem[r + 1].int, v)
+ 	else if v <> (-268435456) then 
+ 	    mem[r + 1].int := -makefraction(mem[r + 1].int, v);
+ 	finalnode := r;
+ 	p := mem[29999].hh.rh {:612};
+ 	if internal[2] > 0 then  {613:}
+ 	    if interesting(x) then begin
+ 		begindiagnostic;
+ 		printnl(462);
+ 		printvariablename(x);
+ 		w := n;
+ 		while w > 0 do begin
+ 		    print(455);
+ 		    w := w - 2
+ 		end;
+ 		printchar(61);
+ 		printdependency(p, 17);
+ 		enddiagnostic(false)
+ 	    end {:613};
+ {614:}
+ 	prevr := -29987;
+ 	r := mem[-29987].hh.rh;
+ 	while r <> (-29987) do begin
+ 	    s := mem[r + 1].hh.rh;
+ 	    q := pwithxbecomingq(s, x, p, mem[r].hh.b0);
+ 	    if mem[q].hh.lh = (-30000) then 
+ 		makeknown(r, q)
+ 	    else begin
+ 		mem[r + 1].hh.rh := q;
+ 		repeat
+ 		    q := mem[q].hh.rh
+ 		until mem[q].hh.lh = (-30000);
+ 		prevr := q
+ 	    end;
+ 	    r := mem[prevr].hh.rh
+ 	end {:614}; {615:}
+ 	if n > 0 then begin {616:}
+ 	    s := 29999;
+ 	    mem[29999].hh.rh := p;
+ 	    r := p;
+ 	    repeat
+ 		if n > 30 then 
+ 		    w := 0
+ 		else 
+ 		    w := mem[r + 1].int div twotothe[n];
+ 		if (abs(w) <= 1342) and (mem[r].hh.lh <> (-30000)) then begin
+ 		    mem[s].hh.rh := mem[r].hh.rh;
+ 		    freenode(r, 2)
+ 		end else begin
+ 		    mem[r + 1].int := w;
+ 		    s := r
+ 		end;
+ 		r := mem[s].hh.rh
+ 	    until mem[s].hh.lh = (-30000);
+ 	    p := mem[29999].hh.rh
+ 	end {:616};
+ 	if mem[p].hh.lh = (-30000) then begin
+ 	    mem[x].hh.b0 := 16;
+ 	    mem[x + 1].int := mem[p + 1].int;
+ 	    if abs(mem[x + 1].int) >= 268435456 then 
+ 		valtoobig(mem[x + 1].int);
+ 	    freenode(p, 2);
+ 	    if curexp = x then 
+ 		if curtype = 19 then begin
+ 		    curexp := mem[x + 1].int;
+ 		    curtype := 16;
+ 		    freenode(x, 2)
+ 		end
+ 	end else begin
+ 	    mem[x].hh.b0 := 17;
+ 	    depfinal := finalnode;
+ 	    newdep(x, p);
+ 	    if curexp = x then 
+ 		if curtype = 19 then 
+ 		    curtype := 17
+ 	end {:615};
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:610} {619:}
+ 
+     function newringentry(p: halfword): halfword;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(2);
+ 	mem[q].hh.b1 := 11;
+ 	mem[q].hh.b0 := mem[p].hh.b0;
+ 	if mem[p + 1].int = (-30000) then 
+ 	    mem[q + 1].int := p
+ 	else 
+ 	    mem[q + 1].int := mem[p + 1].int;
+ 	mem[p + 1].int := q;
+ 	newringentry := q
+     end; {:619} {621:}
+ 
+     procedure nonlineareq(v: integer; p: halfword; flushp: boolean);
+     var
+ 	t: smallnumber;
+ 	q, r: halfword;
+     begin
+ 	t := mem[p].hh.b0 - 1;
+ 	q := mem[p + 1].int;
+ 	if flushp then 
+ 	    mem[p].hh.b0 := 1
+ 	else 
+ 	    p := q;
+ 	repeat
+ 	    r := mem[q + 1].int;
+ 	    mem[q].hh.b0 := t;
+ 	    case t of
+ 		2:
+ 		    mem[q + 1].int := v;
+ 		4:
+ 		    begin
+ 			mem[q + 1].int := v;
+ 			begin
+ 			    if strref[v] < 127 then 
+ 				strref[v] := strref[v] + 1
+ 			end
+ 		    end;
+ 		6:
+ 		    begin
+ 			mem[q + 1].int := v;
+ 			mem[v].hh.lh := mem[v].hh.lh + 1
+ 		    end;
+ 		9:
+ 		    mem[q + 1].int := copypath(v);
+ 		11:
+ 		    mem[q + 1].int := copyedges(v)
+ 	    end;
+ 	    q := r
+ 	until q = p
+     end; {:621} {622:}
+ 
+     procedure ringmerge(p, q: halfword);
+     label
+ 	10;
+     var
+ 	r: halfword;
+     begin
+ 	r := mem[p + 1].int;
+ 	while r <> p do begin
+ 	    if r = q then begin {623:}
+ 		begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(465)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 466;
+ 			helpline[0] := 467
+ 		    end;
+ 		    putgeterror
+ 		end {:623};
+ 		goto 10
+ 	    end;
+ 	    r := mem[r + 1].int
+ 	end;
+ 	r := mem[p + 1].int;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	mem[q + 1].int := r;
+     10:
+ 	
+     end; {:622} {626:}
+ 
+     procedure showcmdmod(c, m: integer);
+     begin
+ 	begindiagnostic;
+ 	printnl(123);
+ 	printcmdmod(c, m);
+ 	printchar(125);
+ 	enddiagnostic(false)
+     end; {:626} {635:}
+ 
+     procedure showcontext;
+     label
+ 	30;
+     var
+ 	oldsetting: 0..5; {641:}
+ 	i: 0..bufsize;
+ 	l: integer;
+ 	m: integer;
+ 	n: 0..errorline;
+ 	p: integer;
+ 	q: integer; {:641}
+     begin
+ 	fileptr := inputptr;
+ 	inputstack[fileptr] := curinput;
+ 	while true do begin
+ 	    curinput := inputstack[fileptr]; {636:}
+ 	    if (((fileptr = inputptr) or (curinput.indexfield <= 6)) or (curinput.indexfield <> 10)) or (curinput.locfield <> (-30000)) then begin
+ 		tally := 0;
+ 		oldsetting := selector;
+ 		if curinput.indexfield <= 6 then begin {637:}
+ 		    if curinput.namefield <= 1 then 
+ 			if (curinput.namefield = 0) and (fileptr = 0) then 
+ 			    printnl(469)
+ 			else 
+ 			    printnl(470)
+ 		    else if curinput.namefield = 2 then 
+ 			printnl(471)
+ 		    else begin
+ 			printnl(472);
+ 			printint(line)
+ 		    end;
+ 		    printchar(32) {:637};
+ {644:}
+ 		    begin
+ 			l := tally;
+ 			tally := 0;
+ 			selector := 4;
+ 			trickcount := 1000000
+ 		    end;
+ 		    if curinput.limitfield > 0 then 
+ 			for i := curinput.startfield to curinput.limitfield - 1 do begin
+ 			    if i = curinput.locfield then begin
+ 				firstcount := tally;
+ 				trickcount := ((tally + 1) + errorline) - halferrorline;
+ 				if trickcount < errorline then 
+ 				    trickcount := errorline
+ 			    end;
+ 			    print(buffer[i])
+ 			end {:644}
+ 		end else begin {638:}
+ 		    if curinput.indexfield in
+ 			[7, 8, 9, 10, 11, 12] then
+ 			case curinput.indexfield of
+ 			    7:
+ 				printnl(473);
+ 			    8:
+ 				begin {639:}
+ 				    printnl(478);
+ 				    p := paramstack[curinput.limitfield];
+ 				    if p <> (-30000) then 
+ 					if mem[p].hh.rh = (-29999) then 
+ 					    printexp(p, 0)
+ 					else 
+ 					    showtokenlist(p, -30000, 20, tally);
+ 				    print(479)
+ 				end; {:639}
+ 			    9:
+ 				printnl(474);
+ 			    10:
+ 				if curinput.locfield = (-30000) then 
+ 				    printnl(475)
+ 				else 
+ 				    printnl(476);
+ 			    11:
+ 				printnl(477);
+ 			    12:
+ 				begin
+ 				    println;
+ 				    if curinput.namefield <> (-30000) then 
+ 					print(hash[curinput.namefield].rh) {640:}
+ 				    else begin
+ 					p := paramstack[curinput.limitfield];
+ 					if p = (-30000) then 
+ 					    showtokenlist(paramstack[curinput.limitfield + 1], -30000, 20, tally)
+ 					else begin
+ 					    q := p;
+ 					    while mem[q].hh.rh <> (-30000) do 
+ 						q := mem[q].hh.rh;
+ 					    mem[q].hh.rh := paramstack[curinput.limitfield + 1];
+ 					    showtokenlist(p, -30000, 20, tally);
+ 					    mem[q].hh.rh := -30000
+ 					end
+ 				    end {:640};
+ 				    print(368)
+ 				end
+ 			end
+ 		    else
+ 			printnl(63) {:638}; {645:}
+ 		    begin
+ 			l := tally;
+ 			tally := 0;
+ 			selector := 4;
+ 			trickcount := 1000000
+ 		    end;
+ 		    if curinput.indexfield <> 12 then 
+ 			showtokenlist(curinput.startfield, curinput.locfield, 100000, 0)
+ 		    else 
+ 			showmacro(curinput.startfield, curinput.locfield, 100000) {:645}
+ 		end;
+ 		selector := oldsetting; {643:}
+ 		if trickcount = 1000000 then begin
+ 		    firstcount := tally;
+ 		    trickcount := ((tally + 1) + errorline) - halferrorline;
+ 		    if trickcount < errorline then 
+ 			trickcount := errorline
+ 		end;
+ 		if tally < trickcount then 
+ 		    m := tally - firstcount
+ 		else 
+ 		    m := trickcount - firstcount;
+ 		if (l + firstcount) <= halferrorline then begin
+ 		    p := 0;
+ 		    n := l + firstcount
+ 		end else begin
+ 		    print(146);
+ 		    p := ((l + firstcount) - halferrorline) + 3;
+ 		    n := halferrorline
+ 		end;
+ 		for q := p to firstcount - 1 do 
+ 		    printchar(trickbuf[q mod errorline]);
+ 		println;
+ 		for q := 1 to n do 
+ 		    printchar(32);
+ 		if (m + n) <= errorline then 
+ 		    p := firstcount + m
+ 		else 
+ 		    p := firstcount + ((errorline - n) - 3);
+ 		for q := firstcount to p - 1 do 
+ 		    printchar(trickbuf[q mod errorline]);
+ 		if (m + n) > errorline then 
+ 		    print(146) {:643}
+ 	    end {:636};
+ 	    if curinput.indexfield <= 6 then 
+ 		if (curinput.namefield > 2) or (fileptr = 0) then 
+ 		    goto 30;
+ 	    fileptr := fileptr - 1
+ 	end;
+     30:
+ 	curinput := inputstack[inputptr]
+     end; { showcontext }
+ {:635}
+     {649:}
+ 
+     procedure begintokenlist(p: halfword; t: quarterword);
+     begin
+ 	begin
+ 	    if inputptr > maxinstack then begin
+ 		maxinstack := inputptr;
+ 		if inputptr = stacksize then 
+ 		    overflow(480, stacksize)
+ 	    end;
+ 	    inputstack[inputptr] := curinput;
+ 	    inputptr := inputptr + 1
+ 	end;
+ 	curinput.startfield := p;
+ 	curinput.indexfield := t;
+ 	curinput.limitfield := paramptr;
+ 	curinput.locfield := p
+     end; {:649} {650:}
+ 
+     procedure endtokenlist;
+     label
+ 	30;
+     var
+ 	p: halfword;
+     begin
+ 	if curinput.indexfield >= 10 then 
+ 	    if curinput.indexfield <= 11 then begin
+ 		flushtokenlist(curinput.startfield);
+ 		goto 30
+ 	    end else 
+ 		deletemacref(curinput.startfield);
+ 	while paramptr > curinput.limitfield do begin
+ 	    paramptr := paramptr - 1;
+ 	    p := paramstack[paramptr];
+ 	    if p <> (-30000) then 
+ 		if mem[p].hh.rh = (-29999) then begin
+ 		    recyclevalue(p);
+ 		    freenode(p, 2)
+ 		end else 
+ 		    flushtokenlist(p)
+ 	end;
+     30:
+ 	begin
+ 	    inputptr := inputptr - 1;
+ 	    curinput := inputstack[inputptr]
+ 	end;
+ 	begin
+ 	    if interrupt <> 0 then 
+ 		pauseforinstructions
+ 	end
+     end; {:650} {651:}
+ {855:}
+     {856:}
+ 
+     procedure encapsulate(p: halfword);
+     begin
+ 	curexp := getnode(2);
+ 	mem[curexp].hh.b0 := curtype;
+ 	mem[curexp].hh.b1 := 11;
+ 	newdep(curexp, p)
+     end; { encapsulate }
+ {:856}
+     {858:}
+ 
+     procedure install(r, q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if mem[q].hh.b0 = 16 then begin
+ 	    mem[r + 1].int := mem[q + 1].int;
+ 	    mem[r].hh.b0 := 16
+ 	end else if mem[q].hh.b0 = 19 then begin
+ 	    p := singledependency(q);
+ 	    if p = depfinal then begin
+ 		mem[r].hh.b0 := 16;
+ 		mem[r + 1].int := 0;
+ 		freenode(p, 2)
+ 	    end else begin
+ 		mem[r].hh.b0 := 17;
+ 		newdep(r, p)
+ 	    end
+ 	end else begin
+ 	    mem[r].hh.b0 := mem[q].hh.b0;
+ 	    newdep(r, copydeplist(mem[q + 1].hh.rh))
+ 	end
+     end; {:858}
+ 
+     procedure makeexpcopy(p: halfword);
+     label
+ 	20;
+     var
+ 	q, r, t: halfword;
+     begin
+     20:
+ 	curtype := mem[p].hh.b0;
+ 	if curtype in
+ 	    [1, 2, 16, 3, 5, 7, 12, 10,
+ 	     4, 6, 11, 9, 8, 13, 14, 17,
+ 	     18, 15, 19] then
+ 	    case curtype of
+ 		1, 2, 16:
+ 		    curexp := mem[p + 1].int;
+ 		3, 5, 7, 12, 10:
+ 		    curexp := newringentry(p);
+ 		4:
+ 		    begin
+ 			curexp := mem[p + 1].int;
+ 			begin
+ 			    if strref[curexp] < 127 then 
+ 				strref[curexp] := strref[curexp] + 1
+ 			end
+ 		    end;
+ 		6:
+ 		    begin
+ 			curexp := mem[p + 1].int;
+ 			mem[curexp].hh.lh := mem[curexp].hh.lh + 1
+ 		    end;
+ 		11:
+ 		    curexp := copyedges(mem[p + 1].int);
+ 		9, 8:
+ 		    curexp := copypath(mem[p + 1].int);
+ 		13, 14:
+ 		    begin {857:}
+ 			if mem[p + 1].int = (-30000) then 
+ 			    initbignode(p);
+ 			t := getnode(2);
+ 			mem[t].hh.b1 := 11;
+ 			mem[t].hh.b0 := curtype;
+ 			initbignode(t);
+ 			q := mem[p + 1].int + bignodesize[curtype];
+ 			r := mem[t + 1].int + bignodesize[curtype];
+ 			repeat
+ 			    q := q - 2;
+ 			    r := r - 2;
+ 			    install(r, q)
+ 			until q = mem[p + 1].int;
+ 			curexp := t
+ 		    end; {:857}
+ 		17, 18:
+ 		    encapsulate(copydeplist(mem[p + 1].hh.rh));
+ 		15:
+ 		    begin
+ 			begin
+ 			    mem[p].hh.b0 := 19;
+ 			    serialno := serialno + 64;
+ 			    mem[p + 1].int := serialno
+ 			end;
+ 			goto 20
+ 		    end;
+ 		19:
+ 		    begin
+ 			q := singledependency(p);
+ 			if q = depfinal then begin
+ 			    curtype := 16;
+ 			    curexp := 0;
+ 			    freenode(q, 2)
+ 			end else begin
+ 			    curtype := 17;
+ 			    encapsulate(q)
+ 			end
+ 		    end
+ 	    end
+ 	else
+ 	    confusion(664)
+     end; {:855}
+ 
+     function curtok: halfword;
+     var
+ 	p: halfword;
+ 	savetype: smallnumber;
+ 	saveexp: integer;
+     begin
+ 	if cursym = 0 then 
+ 	    if curcmd = 38 then begin
+ 		savetype := curtype;
+ 		saveexp := curexp;
+ 		makeexpcopy(curmod);
+ 		p := stashcurexp;
+ 		mem[p].hh.rh := -30000;
+ 		curtype := savetype;
+ 		curexp := saveexp
+ 	    end else begin
+ 		p := getnode(2);
+ 		mem[p + 1].int := curmod;
+ 		mem[p].hh.b1 := 12;
+ 		if curcmd = 42 then 
+ 		    mem[p].hh.b0 := 16
+ 		else 
+ 		    mem[p].hh.b0 := 4
+ 	    end
+ 	else begin
+ 	    begin
+ 		p := avail;
+ 		if p = (-30000) then 
+ 		    p := getavail
+ 		else begin
+ 		    avail := mem[p].hh.rh;
+ 		    mem[p].hh.rh := -30000
+ 		end {dynused:=dynused+1;}
+ 	    end;
+ 	    mem[p].hh.lh := cursym
+ 	end;
+ 	curtok := p
+     end; {:651} {652:}
+ 
+     procedure backinput;
+     var
+ 	p: halfword;
+ 	s: 0..150;
+     begin
+ 	p := curtok;
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	begintokenlist(p, 10)
+     end; {:652} {653:}
+ 
+     procedure backerror;
+     begin
+ 	OKtointerrupt := false;
+ 	backinput;
+ 	OKtointerrupt := true;
+ 	error
+     end; { backerror }
+ 
+     procedure inserror;
+     begin
+ 	OKtointerrupt := false;
+ 	backinput;
+ 	curinput.indexfield := 11;
+ 	OKtointerrupt := true;
+ 	error
+     end; {:653} {654:}
+ 
+     procedure beginfilereading;
+     begin
+ 	if inopen = 6 then 
+ 	    overflow(481, 6);
+ 	if first = bufsize then 
+ 	    overflow(128, bufsize);
+ 	inopen := inopen + 1;
+ 	begin
+ 	    if inputptr > maxinstack then begin
+ 		maxinstack := inputptr;
+ 		if inputptr = stacksize then 
+ 		    overflow(480, stacksize)
+ 	    end;
+ 	    inputstack[inputptr] := curinput;
+ 	    inputptr := inputptr + 1
+ 	end;
+ 	curinput.indexfield := inopen;
+ 	linestack[curinput.indexfield] := line;
+ 	curinput.startfield := first;
+ 	curinput.namefield := 0
+     end; {:654} {655:}
+ 
+     procedure endfilereading;
+     begin
+ 	first := curinput.startfield;
+ 	line := linestack[curinput.indexfield];
+ 	if curinput.indexfield <> inopen then 
+ 	    confusion(482);
+ 	if curinput.namefield > 2 then 
+ 	    aclose(inputfile[curinput.indexfield]);
+ 	begin
+ 	    inputptr := inputptr - 1;
+ 	    curinput := inputstack[inputptr]
+ 	end;
+ 	inopen := inopen - 1
+     end; {:655} {656:}
+ 
+     procedure clearforerrorprompt;
+     begin
+ 	while (((curinput.indexfield <= 6) and (curinput.namefield = 0)) and (inputptr > 0)) and (curinput.locfield = curinput.limitfield) do 
+ 	    endfilereading;
+ 	println
+     end; {:656} {661:}
+ 
+     function checkoutervalidity: boolean;
+     var
+ 	p: halfword;
+     begin
+ 	if scannerstatus = 0 then 
+ 	    checkoutervalidity := true
+ 	else begin
+ 	    deletionsallowed := false; {662:}
+ 	    if cursym <> 0 then begin
+ 		p := getavail;
+ 		mem[p].hh.lh := cursym;
+ 		begintokenlist(p, 10)
+ 	    end {:662};
+ 	    if scannerstatus > 1 then begin {663:}
+ 		runaway;
+ 		if cursym = 0 then begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(488)
+ 		end else begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(489)
+ 		    end
+ 		end;
+ 		print(490);
+ 		begin
+ 		    helpptr := 4;
+ 		    helpline[3] := 491;
+ 		    helpline[2] := 492;
+ 		    helpline[1] := 493;
+ 		    helpline[0] := 494
+ 		end;
+ 		case scannerstatus of {664:}
+ 		    2:
+ 			begin
+ 			    print(495);
+ 			    helpline[3] := 496;
+ 			    cursym := 2235
+ 			end;
+ 		    3:
+ 			begin
+ 			    print(497);
+ 			    helpline[3] := 498;
+ 			    if warninginfo = 0 then 
+ 				cursym := 2239
+ 			    else begin
+ 				cursym := 2231;
+ 				eqtb[2231].rh := warninginfo
+ 			    end
+ 			end;
+ 		    4, 5:
+ 			begin
+ 			    print(499);
+ 			    if scannerstatus = 5 then 
+ 				print(hash[warninginfo].rh)
+ 			    else 
+ 				printvariablename(warninginfo);
+ 			    cursym := 2237
+ 			end;
+ 		    6:
+ 			begin
+ 			    print(500);
+ 			    print(hash[warninginfo].rh);
+ 			    print(501);
+ 			    helpline[3] := 502;
+ 			    cursym := 2236
+ 			end
+ 		end {:664};
+ 		inserror
+ 	    end else begin {:663}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(483)
+ 		end;
+ 		printint(warninginfo);
+ 		begin
+ 		    helpptr := 3;
+ 		    helpline[2] := 484;
+ 		    helpline[1] := 485;
+ 		    helpline[0] := 486
+ 		end;
+ 		if cursym = 0 then 
+ 		    helpline[2] := 487;
+ 		cursym := 2238;
+ 		inserror
+ 	    end;
+ 	    deletionsallowed := true;
+ 	    checkoutervalidity := false
+ 	end
+     end; {:661} {666:}
+ 
+     procedure firmuptheline;
+     forward; {:666} {667:}
+ 
+     procedure getnext;
+     label
+ 	20, 10, 40, 25, 85, 86, 87, 30;
+     var
+ 	k: 0..bufsize;
+ 	c: ASCIIcode;
+ 	class: ASCIIcode;
+ 	n, f: integer;
+     begin
+     20:
+ 	cursym := 0;
+ 	if curinput.indexfield <= 6 then begin {669:}
+     25:
+ 	    c := buffer[curinput.locfield];
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	    class := charclass[c];
+ 	    if class in
+ 		[0, 1, 2, 3, 4, 5, 6, 7,
+ 		 8, 20] then
+ 		case class of
+ 		    0:
+ 			goto 85;
+ 		    1:
+ 			begin
+ 			    class := charclass[buffer[curinput.locfield]];
+ 			    if class > 1 then 
+ 				goto 25
+ 			    else if class < 1 then begin
+ 				n := 0;
+ 				goto 86
+ 			    end
+ 			end;
+ 		    2:
+ 			goto 25;
+ 		    3:
+ 			begin {679:}
+ 			    if curinput.namefield > 2 then begin {681:}
+ 				line := line + 1;
+ 				first := curinput.startfield;
+ 				if not forceeof then begin
+ 				    if inputln(inputfile[curinput.indexfield], true) then 
+ 					firmuptheline
+ 				    else 
+ 					forceeof := true
+ 				end;
+ 				if forceeof then begin
+ 				    printchar(41);
+ 				    forceeof := false;
+ 				    flush(output);
+ 				    endfilereading;
+ 				    if checkoutervalidity then 
+ 					goto 20
+ 				    else 
+ 					goto 20
+ 				end;
+ 				buffer[curinput.limitfield] := 37;
+ 				first := curinput.limitfield + 1;
+ 				curinput.locfield := curinput.startfield
+ 			    end else begin {:681}
+ 				if inputptr > 0 then begin
+ 				    endfilereading;
+ 				    goto 20
+ 				end;
+ 				if selector < 2 then 
+ 				    openlogfile;
+ 				if interaction > 1 then begin
+ 				    if curinput.limitfield = curinput.startfield then 
+ 					printnl(517);
+ 				    println;
+ 				    first := curinput.startfield;
+ 				    begin
+ 					print(42);
+ 					terminput
+ 				    end;
+ 				    curinput.limitfield := last;
+ 				    buffer[curinput.limitfield] := 37;
+ 				    first := curinput.limitfield + 1;
+ 				    curinput.locfield := curinput.startfield
+ 				end else 
+ 				    fatalerror(518)
+ 			    end {:679};
+ 			    begin
+ 				if interrupt <> 0 then 
+ 				    pauseforinstructions
+ 			    end;
+ 			    goto 25
+ 			end;
+ 		    4:
+ 			begin {671:}
+ 			    if buffer[curinput.locfield] = 34 then 
+ 				curmod := 155
+ 			    else begin
+ 				k := curinput.locfield;
+ 				buffer[curinput.limitfield + 1] := 34;
+ 				repeat
+ 				    curinput.locfield := curinput.locfield + 1
+ 				until buffer[curinput.locfield] = 34;
+ 				if curinput.locfield > curinput.limitfield then begin {672:}
+ 				    curinput.locfield := curinput.limitfield;
+ 				    begin
+ 					if interaction = 3 then 
+ 					    ;
+ 					printnl(133);
+ 					print(510)
+ 				    end;
+ 				    begin
+ 					helpptr := 3;
+ 					helpline[2] := 511;
+ 					helpline[1] := 512;
+ 					helpline[0] := 513
+ 				    end;
+ 				    deletionsallowed := false;
+ 				    error;
+ 				    deletionsallowed := true;
+ 				    goto 20
+ 				end {:672};
+ 				if curinput.locfield = (k + 1) then 
+ 				    curmod := buffer[k]
+ 				else begin
+ 				    begin
+ 					if ((poolptr + curinput.locfield) - k) > maxpoolptr then begin
+ 					    if ((poolptr + curinput.locfield) - k) > poolsize then 
+ 						overflow(129, poolsize - initpoolptr);
+ 					    maxpoolptr := (poolptr + curinput.locfield) - k
+ 					end
+ 				    end;
+ 				    repeat
+ 					begin
+ 					    strpool[poolptr] := buffer[k];
+ 					    poolptr := poolptr + 1
+ 					end;
+ 					k := k + 1
+ 				    until k = curinput.locfield;
+ 				    curmod := makestring
+ 				end
+ 			    end;
+ 			    curinput.locfield := curinput.locfield + 1;
+ 			    curcmd := 39;
+ 			    goto 10
+ 			end; {:671}
+ 		    5, 6, 7, 8:
+ 			begin
+ 			    k := curinput.locfield - 1;
+ 			    goto 40
+ 			end;
+ 		    20:
+ 			begin {670:}
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(507)
+ 			    end;
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 508;
+ 				helpline[0] := 509
+ 			    end;
+ 			    deletionsallowed := false;
+ 			    error;
+ 			    deletionsallowed := true;
+ 			    goto 20
+ 			end
+ 		end
+ 	    else
+ 		 {:670};
+ 	    k := curinput.locfield - 1;
+ 	    while charclass[buffer[curinput.locfield]] = class do 
+ 		curinput.locfield := curinput.locfield + 1;
+ 	    goto 40;
+     85: {673:}
+ 	    n := c - 48;
+ 	    while charclass[buffer[curinput.locfield]] = 0 do begin
+ 		if n < 4096 then 
+ 		    n := ((10 * n) + buffer[curinput.locfield]) - 48;
+ 		curinput.locfield := curinput.locfield + 1
+ 	    end;
+ 	    if buffer[curinput.locfield] = 46 then 
+ 		if charclass[buffer[curinput.locfield + 1]] = 0 then 
+ 		    goto 30;
+ 	    f := 0;
+ 	    goto 87;
+     30:
+ 	    curinput.locfield := curinput.locfield + 1 {:673};
+     86: {674:}
+ 	    k := 0;
+ 	    repeat
+ 		if k < 17 then begin
+ 		    dig[k] := buffer[curinput.locfield] - 48;
+ 		    k := k + 1
+ 		end;
+ 		curinput.locfield := curinput.locfield + 1
+ 	    until charclass[buffer[curinput.locfield]] <> 0;
+ 	    f := rounddecimals(k);
+ 	    if f = 65536 then begin
+ 		n := n + 1;
+ 		f := 0
+ 	    end {:674};
+     87: {675:}
+ 	    if n < 4096 then 
+ 		curmod := (n * 65536) + f
+ 	    else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(514)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 515;
+ 		    helpline[0] := 516
+ 		end;
+ 		deletionsallowed := false;
+ 		error;
+ 		deletionsallowed := true;
+ 		curmod := 268435455
+ 	    end;
+ 	    curcmd := 42;
+ 	    goto 10 {:675};
+     40:
+ 	    cursym := idlookup(k, curinput.locfield - k)
+ 	end else if curinput.locfield >= himemmin then begin {:669} {676:}
+ 	    cursym := mem[curinput.locfield].hh.lh;
+ 	    curinput.locfield := mem[curinput.locfield].hh.rh;
+ 	    if cursym >= 2242 then 
+ 		if cursym >= 2392 then begin {677:}
+ 		    if cursym >= 2542 then 
+ 			cursym := cursym - 150;
+ 		    begintokenlist(paramstack[(curinput.limitfield + cursym) - 2392], 9);
+ 		    goto 20
+ 		end else begin {:677}
+ 		    curcmd := 38;
+ 		    curmod := paramstack[(curinput.limitfield + cursym) - 2242];
+ 		    cursym := 0;
+ 		    goto 10
+ 		end
+ 	end else if curinput.locfield > (-30000) then begin {678:}
+ 	    if mem[curinput.locfield].hh.b1 = 12 then begin
+ 		curmod := mem[curinput.locfield + 1].int;
+ 		if mem[curinput.locfield].hh.b0 = 16 then 
+ 		    curcmd := 42
+ 		else begin
+ 		    curcmd := 39;
+ 		    begin
+ 			if strref[curmod] < 127 then 
+ 			    strref[curmod] := strref[curmod] + 1
+ 		    end
+ 		end
+ 	    end else begin
+ 		curmod := curinput.locfield;
+ 		curcmd := 38
+ 	    end;
+ 	    curinput.locfield := mem[curinput.locfield].hh.rh;
+ 	    goto 10
+ 	end else begin {:678}
+ 	    endtokenlist;
+ 	    goto 20
+ 	end {:676}; {668:}
+ 	curcmd := eqtb[cursym].lh;
+ 	curmod := eqtb[cursym].rh;
+ 	if curcmd >= 83 then 
+ 	    if checkoutervalidity then 
+ 		curcmd := curcmd - 83
+ 	    else 
+ 		goto 20 {:668};
+     10:
+ 	
+     end; {:667} {682:}
+ 
+     procedure firmuptheline;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	curinput.limitfield := last;
+ 	if internal[31] > 0 then 
+ 	    if interaction > 1 then begin
+ 		println;
+ 		if curinput.startfield < curinput.limitfield then 
+ 		    for k := curinput.startfield to curinput.limitfield - 1 do 
+ 			print(buffer[k]);
+ 		first := curinput.limitfield;
+ 		begin
+ 		    print(519);
+ 		    terminput
+ 		end;
+ 		if last > first then begin
+ 		    for k := first to last - 1 do 
+ 			buffer[(k + curinput.startfield) - first] := buffer[k];
+ 		    curinput.limitfield := (curinput.startfield + last) - first
+ 		end
+ 	    end
+     end; {:682}
+ {685:}
+ 
+     function scantoks(terminator: commandcode; substlist, tailend: halfword; suffixcount: smallnumber): halfword;
+     label
+ 	30, 40;
+     var
+ 	p: halfword;
+ 	q: halfword;
+ 	balance: integer;
+     begin
+ 	p := 29998;
+ 	balance := 1;
+ 	mem[29998].hh.rh := -30000;
+ 	while true do begin
+ 	    getnext;
+ 	    if cursym > 0 then begin {686:}
+ 		begin
+ 		    q := substlist;
+ 		    while q <> (-30000) do begin
+ 			if mem[q].hh.lh = cursym then begin
+ 			    cursym := mem[q + 1].int;
+ 			    curcmd := 7;
+ 			    goto 40
+ 			end;
+ 			q := mem[q].hh.rh
+ 		    end;
+     40: {:686}
+ 		    
+ 		end;
+ 		if curcmd = terminator then  {687:}
+ 		    if curmod > 0 then 
+ 			balance := balance + 1
+ 		    else begin
+ 			balance := balance - 1;
+ 			if balance = 0 then 
+ 			    goto 30
+ 		    end {:687}
+ 		else if curcmd = 61 then begin {690:}
+ 		    if curmod = 0 then 
+ 			getnext
+ 		    else if curmod <= suffixcount then 
+ 			cursym := 2391 + curmod
+ 		end {:690}
+ 	    end;
+ 	    mem[p].hh.rh := curtok;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	mem[p].hh.rh := tailend;
+ 	flushnodelist(substlist);
+ 	scantoks := mem[29998].hh.rh
+     end; {:685} {691:}
+ 
+     procedure getsymbol;
+     label
+ 	20;
+     begin
+     20:
+ 	getnext;
+ 	if (cursym = 0) or (cursym > 2229) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(531)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 532;
+ 		helpline[1] := 533;
+ 		helpline[0] := 534
+ 	    end;
+ 	    if cursym > 0 then 
+ 		helpline[2] := 535
+ 	    else if curcmd = 39 then begin
+ 		if strref[curmod] < 127 then 
+ 		    if strref[curmod] > 1 then 
+ 			strref[curmod] := strref[curmod] - 1
+ 		    else 
+ 			flushstring(curmod)
+ 	    end;
+ 	    cursym := 2229;
+ 	    inserror;
+ 	    goto 20
+ 	end
+     end; { getsymbol }
+ {:691}
+     {692:}
+ 
+     procedure getclearsymbol;
+     begin
+ 	getsymbol;
+ 	clearsymbol(cursym, false)
+     end; {:692} {693:}
+ 
+     procedure checkequals;
+     begin
+ 	if curcmd <> 51 then 
+ 	    if curcmd <> 77 then begin
+ 		missingerr(61);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 536;
+ 		    helpline[3] := 537;
+ 		    helpline[2] := 538;
+ 		    helpline[1] := 539;
+ 		    helpline[0] := 540
+ 		end;
+ 		backerror
+ 	    end
+     end; {:693} {694:}
+ 
+     procedure makeopdef;
+     var
+ 	m: commandcode;
+ 	p, q, r: halfword;
+     begin
+ 	m := curmod;
+ 	getsymbol;
+ 	q := getnode(2);
+ 	mem[q].hh.lh := cursym;
+ 	mem[q + 1].int := 2242;
+ 	getclearsymbol;
+ 	warninginfo := cursym;
+ 	getsymbol;
+ 	p := getnode(2);
+ 	mem[p].hh.lh := cursym;
+ 	mem[p + 1].int := 2243;
+ 	mem[p].hh.rh := q;
+ 	getnext;
+ 	checkequals;
+ 	scannerstatus := 5;
+ 	q := getavail;
+ 	mem[q].hh.lh := -30000;
+ 	r := getavail;
+ 	mem[q].hh.rh := r;
+ 	mem[r].hh.lh := 0;
+ 	mem[r].hh.rh := scantoks(16, p, -30000, 0);
+ 	scannerstatus := 0;
+ 	eqtb[warninginfo].lh := m;
+ 	eqtb[warninginfo].rh := q;
+ 	getxnext
+     end; {:694}
+ {697:}
+     {1032:}
+ 
+     procedure checkdelimiter(ldelim, rdelim: halfword);
+     label
+ 	10;
+     begin
+ 	if curcmd = 62 then 
+ 	    if curmod = ldelim then 
+ 		goto 10;
+ 	if cursym <> rdelim then begin
+ 	    missingerr(hash[rdelim].rh);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 786;
+ 		helpline[0] := 787
+ 	    end;
+ 	    backerror
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(788)
+ 	    end;
+ 	    print(hash[rdelim].rh);
+ 	    print(789);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 790;
+ 		helpline[1] := 791;
+ 		helpline[0] := 792
+ 	    end;
+ 	    error
+ 	end;
+     10:
+ 	
+     end; {:1032} {1011:}
+ 
+     function scandeclaredvariable: halfword;
+     label
+ 	30;
+     var
+ 	x: halfword;
+ 	h, t: halfword;
+ 	l: halfword;
+     begin
+ 	getsymbol;
+ 	x := cursym;
+ 	if curcmd <> 41 then 
+ 	    clearsymbol(x, false);
+ 	if eqtb[x].rh = (-30000) then 
+ 	    newroot(x);
+ 	h := getavail;
+ 	mem[h].hh.lh := x;
+ 	t := h;
+ 	while true do begin
+ 	    getxnext;
+ 	    if cursym = 0 then 
+ 		goto 30;
+ 	    if curcmd <> 41 then 
+ 		if curcmd <> 40 then 
+ 		    if curcmd = 63 then begin {1012:}
+ 			l := cursym;
+ 			getxnext;
+ 			if curcmd <> 64 then begin
+ 			    backinput;
+ 			    cursym := l;
+ 			    curcmd := 63;
+ 			    goto 30
+ 			end else 
+ 			    cursym := 0
+ 		    end else  {:1012}
+ 			goto 30;
+ 	    mem[t].hh.rh := getavail;
+ 	    t := mem[t].hh.rh;
+ 	    mem[t].hh.lh := cursym
+ 	end;
+     30:
+ 	scandeclaredvariable := h
+     end; {:1011}
+ 
+     procedure scandef;
+     var
+ 	m: 1..2;
+ 	n: 0..3;
+ 	k: 0..150;
+ 	c: 0..7;
+ 	r: halfword;
+ 	q: halfword;
+ 	p: halfword;
+ 	base: halfword;
+ 	ldelim, rdelim: halfword;
+     begin
+ 	m := curmod;
+ 	c := 0;
+ 	mem[29998].hh.rh := -30000;
+ 	q := getavail;
+ 	mem[q].hh.lh := -30000;
+ 	r := -30000; {700:}
+ 	if m = 1 then begin
+ 	    getclearsymbol;
+ 	    warninginfo := cursym;
+ 	    getnext;
+ 	    scannerstatus := 5;
+ 	    n := 0;
+ 	    eqtb[warninginfo].lh := 10;
+ 	    eqtb[warninginfo].rh := q
+ 	end else begin
+ 	    p := scandeclaredvariable;
+ 	    flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, true);
+ 	    warninginfo := findvariable(p);
+ 	    flushlist(p);
+ 	    if warninginfo = (-30000) then begin {701:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(547)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 548;
+ 		    helpline[0] := 549
+ 		end;
+ 		error;
+ 		warninginfo := -29979
+ 	    end {:701};
+ 	    scannerstatus := 4;
+ 	    n := 2;
+ 	    if curcmd = 61 then 
+ 		if curmod = 3 then begin
+ 		    n := 3;
+ 		    getnext
+ 		end;
+ 	    mem[warninginfo].hh.b0 := 20 + n;
+ 	    mem[warninginfo + 1].int := q
+ 	end {:700};
+ 	k := n;
+ 	if curcmd = 31 then  {703:}
+ 	    repeat
+ 		ldelim := cursym;
+ 		rdelim := curmod;
+ 		getnext;
+ 		if (curcmd = 56) and (curmod >= 2242) then 
+ 		    base := curmod
+ 		else begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(550)
+ 		    end;
+ 		    begin
+ 			helpptr := 1;
+ 			helpline[0] := 551
+ 		    end;
+ 		    backerror;
+ 		    base := 2242
+ 		end; {704:}
+ 		repeat
+ 		    mem[q].hh.rh := getavail;
+ 		    q := mem[q].hh.rh;
+ 		    mem[q].hh.lh := base + k;
+ 		    getsymbol;
+ 		    p := getnode(2);
+ 		    mem[p + 1].int := base + k;
+ 		    mem[p].hh.lh := cursym;
+ 		    if k = 150 then 
+ 			overflow(552, 150);
+ 		    k := k + 1;
+ 		    mem[p].hh.rh := r;
+ 		    r := p;
+ 		    getnext
+ 		until curcmd <> 79 {:704};
+ 		checkdelimiter(ldelim, rdelim);
+ 		getnext
+ 	    until curcmd <> 31 {:703};
+ 	if curcmd = 56 then begin {705:}
+ 	    p := getnode(2);
+ 	    if curmod < 2242 then begin
+ 		c := curmod;
+ 		mem[p + 1].int := 2242 + k
+ 	    end else begin
+ 		mem[p + 1].int := curmod + k;
+ 		if curmod = 2242 then 
+ 		    c := 4
+ 		else if curmod = 2392 then 
+ 		    c := 6
+ 		else 
+ 		    c := 7
+ 	    end;
+ 	    if k = 150 then 
+ 		overflow(552, 150);
+ 	    k := k + 1;
+ 	    getsymbol;
+ 	    mem[p].hh.lh := cursym;
+ 	    mem[p].hh.rh := r;
+ 	    r := p;
+ 	    getnext;
+ 	    if c = 4 then 
+ 		if curcmd = 69 then begin
+ 		    c := 5;
+ 		    p := getnode(2);
+ 		    if k = 150 then 
+ 			overflow(552, 150);
+ 		    mem[p + 1].int := 2242 + k;
+ 		    getsymbol;
+ 		    mem[p].hh.lh := cursym;
+ 		    mem[p].hh.rh := r;
+ 		    r := p;
+ 		    getnext
+ 		end
+ 	end {:705};
+ 	checkequals;
+ 	p := getavail;
+ 	mem[p].hh.lh := c;
+ 	mem[q].hh.rh := p; {698:}
+ 	if m = 1 then 
+ 	    mem[p].hh.rh := scantoks(16, r, -30000, n)
+ 	else begin
+ 	    q := getavail;
+ 	    mem[q].hh.lh := bgloc;
+ 	    mem[p].hh.rh := q;
+ 	    p := getavail;
+ 	    mem[p].hh.lh := egloc;
+ 	    mem[q].hh.rh := scantoks(16, r, p, n)
+ 	end;
+ 	if warninginfo = (-29979) then 
+ 	    flushtokenlist(mem[-29978].int) {:698};
+ 	scannerstatus := 0;
+ 	getxnext
+     end; {:697} {706:}
+ 
+     procedure scanprimary;
+     forward;
+ 
+     procedure scansecondary;
+     forward;
+ 
+     procedure scantertiary;
+     forward;
+ 
+     procedure scanexpression;
+     forward;
+ 
+     procedure scansuffix;
+     forward; {720:}
+ {722:}
+ 
+     procedure printmacroname(a, n: halfword);
+     var
+ 	p, q: halfword;
+     begin
+ 	if n <> (-30000) then 
+ 	    print(hash[n].rh)
+ 	else begin
+ 	    p := mem[a].hh.lh;
+ 	    if p = (-30000) then 
+ 		print(hash[mem[mem[mem[a].hh.rh].hh.lh].hh.lh].rh)
+ 	    else begin
+ 		q := p;
+ 		while mem[q].hh.rh <> (-30000) do 
+ 		    q := mem[q].hh.rh;
+ 		mem[q].hh.rh := mem[mem[a].hh.rh].hh.lh;
+ 		showtokenlist(p, -30000, 1000, 0);
+ 		mem[q].hh.rh := -30000
+ 	    end
+ 	end
+     end; {:722} {723:}
+ 
+     procedure printarg(q: halfword; n: integer; b: halfword);
+     begin
+ 	if mem[q].hh.rh = (-29999) then 
+ 	    printnl(365)
+ 	else if (b < 2542) and (b <> 7) then 
+ 	    printnl(366)
+ 	else 
+ 	    printnl(367);
+ 	printint(n);
+ 	print(568);
+ 	if mem[q].hh.rh = (-29999) then 
+ 	    printexp(q, 1)
+ 	else 
+ 	    showtokenlist(q, -30000, 1000, 0)
+     end; {:723} {730:}
+ 
+     procedure scantextarg(ldelim, rdelim: halfword);
+     label
+ 	30;
+     var
+ 	balance: integer;
+ 	p: halfword;
+     begin
+ 	warninginfo := ldelim;
+ 	scannerstatus := 3;
+ 	p := 29998;
+ 	balance := 1;
+ 	mem[29998].hh.rh := -30000;
+ 	while true do begin
+ 	    getnext;
+ 	    if ldelim = 0 then begin {732:}
+ 		if curcmd > 79 then begin
+ 		    if balance = 1 then 
+ 			goto 30
+ 		    else if curcmd = 81 then 
+ 			balance := balance - 1
+ 		end else if curcmd = 32 then 
+ 		    balance := balance + 1
+ 	    end else begin {:732} {731:}
+ 		if curcmd = 62 then begin
+ 		    if curmod = ldelim then begin
+ 			balance := balance - 1;
+ 			if balance = 0 then 
+ 			    goto 30
+ 		    end
+ 		end else if curcmd = 31 then 
+ 		    if curmod = rdelim then 
+ 			balance := balance + 1
+ 	    end {:731};
+ 	    mem[p].hh.rh := curtok;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	curexp := mem[29998].hh.rh;
+ 	curtype := 20;
+ 	scannerstatus := 0
+     end; {:730}
+ 
+     procedure macrocall(defref, arglist, macroname: halfword);
+     label
+ 	40;
+     var
+ 	r: halfword;
+ 	p, q: halfword;
+ 	n: integer;
+ 	ldelim, rdelim: halfword;
+ 	tail: halfword;
+     begin
+ 	r := mem[defref].hh.rh;
+ 	mem[defref].hh.lh := mem[defref].hh.lh + 1;
+ 	if arglist = (-30000) then 
+ 	    n := 0 {724:}
+ 	else begin
+ 	    n := 1;
+ 	    tail := arglist;
+ 	    while mem[tail].hh.rh <> (-30000) do begin
+ 		n := n + 1;
+ 		tail := mem[tail].hh.rh
+ 	    end
+ 	end {:724};
+ 	if internal[9] > 0 then begin {721:}
+ 	    begindiagnostic;
+ 	    println;
+ 	    printmacroname(arglist, macroname);
+ 	    if n = 3 then 
+ 		print(530);
+ 	    showmacro(defref, -30000, 100000);
+ 	    if arglist <> (-30000) then begin
+ 		n := 0;
+ 		p := arglist;
+ 		repeat
+ 		    q := mem[p].hh.lh;
+ 		    printarg(q, n, 0);
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until p = (-30000)
+ 	    end;
+ 	    enddiagnostic(false)
+ 	end {:721}; {725:}
+ 	curcmd := 80;
+ 	while mem[r].hh.lh >= 2242 do begin {726:}
+ 	    if curcmd <> 79 then begin
+ 		getxnext;
+ 		if curcmd <> 31 then begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(574)
+ 		    end;
+ 		    printmacroname(arglist, macroname);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 575;
+ 			helpline[1] := 576;
+ 			helpline[0] := 577
+ 		    end;
+ 		    if mem[r].hh.lh >= 2392 then begin
+ 			curexp := -30000;
+ 			curtype := 20
+ 		    end else begin
+ 			curexp := 0;
+ 			curtype := 16
+ 		    end;
+ 		    backerror;
+ 		    curcmd := 62;
+ 		    goto 40
+ 		end;
+ 		ldelim := cursym;
+ 		rdelim := curmod
+ 	    end; {729:}
+ 	    if mem[r].hh.lh >= 2542 then 
+ 		scantextarg(ldelim, rdelim)
+ 	    else begin
+ 		getxnext;
+ 		if mem[r].hh.lh >= 2392 then 
+ 		    scansuffix
+ 		else 
+ 		    scanexpression
+ 	    end {:729};
+ 	    if curcmd <> 79 then  {727:}
+ 		if (curcmd <> 62) or (curmod <> ldelim) then 
+ 		    if mem[mem[r].hh.rh].hh.lh >= 2242 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 3;
+ 			    helpline[2] := 578;
+ 			    helpline[1] := 579;
+ 			    helpline[0] := 573
+ 			end;
+ 			backerror;
+ 			curcmd := 79
+ 		    end else begin
+ 			missingerr(hash[rdelim].rh);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 580;
+ 			    helpline[0] := 573
+ 			end;
+ 			backerror
+ 		    end {:727};
+     40: {728:}
+ 	    begin
+ 		p := getavail;
+ 		if curtype = 20 then 
+ 		    mem[p].hh.lh := curexp
+ 		else 
+ 		    mem[p].hh.lh := stashcurexp;
+ 		if internal[9] > 0 then begin
+ 		    begindiagnostic;
+ 		    printarg(mem[p].hh.lh, n, mem[r].hh.lh);
+ 		    enddiagnostic(false)
+ 		end;
+ 		if arglist = (-30000) then 
+ 		    arglist := p
+ 		else 
+ 		    mem[tail].hh.rh := p;
+ 		tail := p;
+ 		n := n + 1
+ 	    end {:728} {:726};
+ 	    r := mem[r].hh.rh
+ 	end;
+ 	if curcmd = 79 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(569)
+ 	    end;
+ 	    printmacroname(arglist, macroname);
+ 	    printchar(59);
+ 	    printnl(570);
+ 	    print(hash[rdelim].rh);
+ 	    print(170);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 571;
+ 		helpline[1] := 572;
+ 		helpline[0] := 573
+ 	    end;
+ 	    error
+ 	end;
+ 	if mem[r].hh.lh <> 0 then begin {733:}
+ 	    if mem[r].hh.lh < 7 then begin
+ 		getxnext;
+ 		if mem[r].hh.lh <> 6 then 
+ 		    if (curcmd = 51) or (curcmd = 77) then 
+ 			getxnext
+ 	    end;
+ 	    case mem[r].hh.lh of
+ 		1:
+ 		    scanprimary;
+ 		2:
+ 		    scansecondary;
+ 		3:
+ 		    scantertiary;
+ 		4:
+ 		    scanexpression;
+ 		5:
+ 		    begin {734:}
+ 			scanexpression;
+ 			p := getavail;
+ 			mem[p].hh.lh := stashcurexp;
+ 			if internal[9] > 0 then begin
+ 			    begindiagnostic;
+ 			    printarg(mem[p].hh.lh, n, 0);
+ 			    enddiagnostic(false)
+ 			end;
+ 			if arglist = (-30000) then 
+ 			    arglist := p
+ 			else 
+ 			    mem[tail].hh.rh := p;
+ 			tail := p;
+ 			n := n + 1;
+ 			if curcmd <> 69 then begin
+ 			    missingerr(347);
+ 			    print(581);
+ 			    printmacroname(arglist, macroname);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 582
+ 			    end;
+ 			    backerror
+ 			end;
+ 			getxnext;
+ 			scanprimary
+ 		    end; {:734}
+ 		6:
+ 		    begin {735:}
+ 			if curcmd <> 31 then 
+ 			    ldelim := -30000
+ 			else begin
+ 			    ldelim := cursym;
+ 			    rdelim := curmod;
+ 			    getxnext
+ 			end;
+ 			scansuffix;
+ 			if ldelim <> (-30000) then begin
+ 			    if (curcmd <> 62) or (curmod <> ldelim) then begin
+ 				missingerr(hash[rdelim].rh);
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 580;
+ 				    helpline[0] := 573
+ 				end;
+ 				backerror
+ 			    end;
+ 			    getxnext
+ 			end
+ 		    end; {:735}
+ 		7:
+ 		    scantextarg(0, 0)
+ 	    end;
+ 	    backinput; {728:}
+ 	    begin
+ 		p := getavail;
+ 		if curtype = 20 then 
+ 		    mem[p].hh.lh := curexp
+ 		else 
+ 		    mem[p].hh.lh := stashcurexp;
+ 		if internal[9] > 0 then begin
+ 		    begindiagnostic;
+ 		    printarg(mem[p].hh.lh, n, mem[r].hh.lh);
+ 		    enddiagnostic(false)
+ 		end;
+ 		if arglist = (-30000) then 
+ 		    arglist := p
+ 		else 
+ 		    mem[tail].hh.rh := p;
+ 		tail := p;
+ 		n := n + 1
+ 	    end {:728}
+ 	end {:733};
+ 	r := mem[r].hh.rh {:725}; {736:}
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	if (paramptr + n) > maxparamstack then begin
+ 	    maxparamstack := paramptr + n;
+ 	    if maxparamstack > 150 then 
+ 		overflow(552, 150)
+ 	end;
+ 	begintokenlist(defref, 12);
+ 	curinput.namefield := macroname;
+ 	curinput.locfield := r;
+ 	if n > 0 then begin
+ 	    p := arglist;
+ 	    repeat
+ 		paramstack[paramptr] := mem[p].hh.lh;
+ 		paramptr := paramptr + 1;
+ 		p := mem[p].hh.rh
+ 	    until p = (-30000);
+ 	    flushlist(arglist)
+ 	end {:736}
+     end; {:720}
+ 
+     procedure getboolean;
+     forward;
+ 
+     procedure passtext;
+     forward;
+ 
+     procedure conditional;
+     forward;
+ 
+     procedure startinput;
+     forward;
+ 
+     procedure beginiteration;
+     forward;
+ 
+     procedure resumeiteration;
+     forward;
+ 
+     procedure stopiteration;
+     forward; {:706} {707:}
+ 
+     procedure expand;
+     var
+ 	p: halfword;
+ 	k: integer;
+ 	j: poolpointer;
+     begin
+ 	if internal[7] > 65536 then 
+ 	    if curcmd <> 10 then 
+ 		showcmdmod(curcmd, curmod);
+ 	case curcmd of
+ 	    1:
+ 		conditional;
+ 	    2: {751:}
+ 		if curmod > iflimit then 
+ 		    if iflimit = 1 then begin
+ 			missingerr(58);
+ 			backinput;
+ 			cursym := 2234;
+ 			inserror
+ 		    end else begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(589)
+ 			end;
+ 			printcmdmod(2, curmod);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 590
+ 			end;
+ 			error
+ 		    end
+ 		else begin
+ 		    while curmod <> 2 do 
+ 			passtext;
+ {745:}
+ 		    begin
+ 			p := condptr;
+ 			ifline := mem[p + 1].int;
+ 			curif := mem[p].hh.b1;
+ 			iflimit := mem[p].hh.b0;
+ 			condptr := mem[p].hh.rh;
+ 			freenode(p, 2)
+ 		    end {:745}
+ 		end {:751};
+ 	    3: {711:}
+ 		if curmod > 0 then 
+ 		    forceeof := true
+ 		else  {:711}
+ 		    startinput;
+ 	    4:
+ 		if curmod = 0 then begin {708:}
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(553)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 554;
+ 			helpline[0] := 555
+ 		    end;
+ 		    error
+ 		end else  {:708}
+ 		    beginiteration;
+ 	    5:
+ 		begin {712:}
+ 		    while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 			endtokenlist;
+ 		    if loopptr = (-30000) then begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(557)
+ 			end;
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 558;
+ 			    helpline[0] := 559
+ 			end;
+ 			error
+ 		    end else 
+ 			resumeiteration
+ 		end; {:712}
+ 	    6:
+ 		begin {713:}
+ 		    getboolean;
+ 		    if internal[7] > 65536 then 
+ 			showcmdmod(33, curexp);
+ 		    if curexp = 30 then 
+ 			if loopptr = (-30000) then begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(560)
+ 			    end;
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 561
+ 			    end;
+ 			    if curcmd = 80 then 
+ 				error
+ 			    else 
+ 				backerror
+ 			end else begin {714:}
+ 			    p := -30000;
+ 			    repeat
+ 				if curinput.indexfield <= 6 then 
+ 				    endfilereading
+ 				else begin
+ 				    if curinput.indexfield <= 8 then 
+ 					p := curinput.startfield;
+ 				    endtokenlist
+ 				end
+ 			    until p <> (-30000);
+ 			    if p <> mem[loopptr].hh.lh then 
+ 				fatalerror(564);
+ 			    stopiteration
+ 			end {:714}
+ 		    else if curcmd <> 80 then begin
+ 			missingerr(59);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 562;
+ 			    helpline[0] := 563
+ 			end;
+ 			backerror
+ 		    end
+ 		end; {:713}
+ 	    7:
+ 		;
+ 	    9:
+ 		begin {715:}
+ 		    getnext;
+ 		    p := curtok;
+ 		    getnext;
+ 		    if curcmd < 11 then 
+ 			expand
+ 		    else 
+ 			backinput;
+ 		    begintokenlist(p, 10)
+ 		end; {:715}
+ 	    8:
+ 		begin {716:}
+ 		    getxnext;
+ 		    scanprimary;
+ 		    if curtype <> 4 then begin
+ 			disperr(-30000, 565);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 566;
+ 			    helpline[0] := 567
+ 			end;
+ 			putgetflusherror(0)
+ 		    end else begin
+ 			backinput;
+ 			if (strstart[curexp + 1] - strstart[curexp]) > 0 then begin {717:}
+ 			    beginfilereading;
+ 			    curinput.namefield := 2;
+ 			    k := first + (strstart[curexp + 1] - strstart[curexp]);
+ 			    if k >= maxbufstack then begin
+ 				if k >= bufsize then begin
+ 				    maxbufstack := bufsize;
+ 				    overflow(128, bufsize)
+ 				end;
+ 				maxbufstack := k + 1
+ 			    end;
+ 			    j := strstart[curexp];
+ 			    curinput.limitfield := k;
+ 			    while first < curinput.limitfield do begin
+ 				buffer[first] := strpool[j];
+ 				j := j + 1;
+ 				first := first + 1
+ 			    end;
+ 			    buffer[curinput.limitfield] := 37;
+ 			    first := curinput.limitfield + 1;
+ 			    curinput.locfield := curinput.startfield;
+ 			    flushcurexp(0)
+ 			end {:717}
+ 		    end
+ 		end; {:716}
+ 	    10:
+ 		macrocall(curmod, -30000, cursym)
+ 	end
+     end; {:707} {718:}
+ 
+     procedure getxnext;
+     var
+ 	saveexp: halfword;
+     begin
+ 	getnext;
+ 	if curcmd < 11 then begin
+ 	    saveexp := stashcurexp;
+ 	    repeat
+ 		if curcmd = 10 then 
+ 		    macrocall(curmod, -30000, cursym)
+ 		else 
+ 		    expand;
+ 		getnext
+ 	    until curcmd >= 11;
+ 	    unstashcurexp(saveexp)
+ 	end
+     end; {:718} {737:}
+ 
+     procedure stackargument(p: halfword);
+     begin
+ 	if paramptr = maxparamstack then begin
+ 	    maxparamstack := maxparamstack + 1;
+ 	    if maxparamstack > 150 then 
+ 		overflow(552, 150)
+ 	end;
+ 	paramstack[paramptr] := p;
+ 	paramptr := paramptr + 1
+     end; {:737} {742:}
+ 
+     procedure passtext;
+     label
+ 	30;
+     var
+ 	l: integer;
+     begin
+ 	scannerstatus := 1;
+ 	l := 0;
+ 	warninginfo := line;
+ 	while true do begin
+ 	    getnext;
+ 	    if curcmd <= 2 then 
+ 		if curcmd < 2 then 
+ 		    l := l + 1
+ 		else begin
+ 		    if l = 0 then 
+ 			goto 30;
+ 		    if curmod = 2 then 
+ 			l := l - 1
+ 		end {743:}
+ 	    else if curcmd = 39 then begin
+ 		if strref[curmod] < 127 then 
+ 		    if strref[curmod] > 1 then 
+ 			strref[curmod] := strref[curmod] - 1
+ 		    else 
+ 			flushstring(curmod)
+ 	    end {:743}
+ 	end;
+     30:
+ 	scannerstatus := 0
+     end; {:742} {746:}
+ 
+     procedure changeiflimit(l: smallnumber; p: halfword);
+     label
+ 	10;
+     var
+ 	q: halfword;
+     begin
+ 	if p = condptr then 
+ 	    iflimit := l
+ 	else begin
+ 	    q := condptr;
+ 	    while true do begin
+ 		if q = (-30000) then 
+ 		    confusion(583);
+ 		if mem[q].hh.rh = p then begin
+ 		    mem[q].hh.b0 := l;
+ 		    goto 10
+ 		end;
+ 		q := mem[q].hh.rh
+ 	    end
+ 	end;
+     10:
+ 	
+     end; {:746} {747:}
+ 
+     procedure checkcolon;
+     begin
+ 	if curcmd <> 78 then begin
+ 	    missingerr(58);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 586;
+ 		helpline[0] := 563
+ 	    end;
+ 	    backerror
+ 	end
+     end; {:747} {748:}
+ 
+     procedure conditional;
+     label
+ 	10, 30, 21, 40;
+     var
+ 	savecondptr: halfword;
+ 	newiflimit: 2..4;
+ 	p: halfword; {744:}
+     begin
+ 	begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.rh := condptr;
+ 	    mem[p].hh.b0 := iflimit;
+ 	    mem[p].hh.b1 := curif;
+ 	    mem[p + 1].int := ifline;
+ 	    condptr := p;
+ 	    iflimit := 1;
+ 	    ifline := line;
+ 	    curif := 1
+ 	end {:744};
+ 	savecondptr := condptr;
+     21:
+ 	getboolean;
+ 	newiflimit := 4;
+ 	if internal[7] > 65536 then begin {750:}
+ 	    begindiagnostic;
+ 	    if curexp = 30 then 
+ 		print(587)
+ 	    else 
+ 		print(588);
+ 	    enddiagnostic(false)
+ 	end {:750};
+     40:
+ 	checkcolon;
+ 	if curexp = 30 then begin
+ 	    changeiflimit(newiflimit, savecondptr);
+ 	    goto 10
+ 	end; {749:}
+ 	while true do begin
+ 	    passtext;
+ 	    if condptr = savecondptr then 
+ 		goto 30
+ 	    else if curmod = 2 then begin {745:}
+ 		p := condptr;
+ 		ifline := mem[p + 1].int;
+ 		curif := mem[p].hh.b1;
+ 		iflimit := mem[p].hh.b0;
+ 		condptr := mem[p].hh.rh;
+ 		freenode(p, 2)
+ 	    end {:745}
+ 	end {:749};
+     30:
+ 	curif := curmod;
+ 	ifline := line;
+ 	if curmod = 2 then begin {745:}
+ 	    p := condptr;
+ 	    ifline := mem[p + 1].int;
+ 	    curif := mem[p].hh.b1;
+ 	    iflimit := mem[p].hh.b0;
+ 	    condptr := mem[p].hh.rh;
+ 	    freenode(p, 2)
+ 	end else if curmod = 4 then  {:745}
+ 	    goto 21
+ 	else begin
+ 	    curexp := 30;
+ 	    newiflimit := 2;
+ 	    getxnext;
+ 	    goto 40
+ 	end;
+     10:
+ 	
+     end; {:748} {754:}
+ 
+     procedure badfor(s: strnumber);
+     begin
+ 	disperr(-30000, 591);
+ 	print(s);
+ 	print(177);
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 592;
+ 	    helpline[2] := 593;
+ 	    helpline[1] := 594;
+ 	    helpline[0] := 179
+ 	end;
+ 	putgetflusherror(0)
+     end; {:754} {755:}
+ 
+     procedure beginiteration;
+     label
+ 	22, 30, 40;
+     var
+ 	m: halfword;
+ 	n: halfword;
+ 	p, q, s, pp: halfword;
+     begin
+ 	m := curmod;
+ 	n := cursym;
+ 	s := getnode(2);
+ 	if m = 1 then begin
+ 	    mem[s + 1].hh.lh := -29999;
+ 	    p := -30000;
+ 	    getxnext;
+ 	    goto 40
+ 	end;
+ 	getsymbol;
+ 	p := getnode(2);
+ 	mem[p].hh.lh := cursym;
+ 	mem[p + 1].int := m;
+ 	getxnext;
+ 	if (curcmd <> 51) and (curcmd <> 77) then begin
+ 	    missingerr(61);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 595;
+ 		helpline[1] := 538;
+ 		helpline[0] := 596
+ 	    end;
+ 	    backerror
+ 	end;
+ {764:}
+ 	mem[s + 1].hh.lh := -30000;
+ 	q := s + 1;
+ 	mem[q].hh.rh := -30000;
+ 	repeat
+ 	    getxnext;
+ 	    if m <> 2242 then 
+ 		scansuffix
+ 	    else begin
+ 		if curcmd >= 78 then 
+ 		    if curcmd <= 79 then 
+ 			goto 22;
+ 		scanexpression;
+ 		if curcmd = 74 then 
+ 		    if q = (s + 1) then begin {765:}
+ 			if curtype <> 16 then 
+ 			    badfor(602);
+ 			pp := getnode(4);
+ 			mem[pp + 1].int := curexp;
+ 			getxnext;
+ 			scanexpression;
+ 			if curtype <> 16 then 
+ 			    badfor(603);
+ 			mem[pp + 2].int := curexp;
+ 			if curcmd <> 75 then begin
+ 			    missingerr(357);
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 604;
+ 				helpline[0] := 605
+ 			    end;
+ 			    backerror
+ 			end;
+ 			getxnext;
+ 			scanexpression;
+ 			if curtype <> 16 then 
+ 			    badfor(606);
+ 			mem[pp + 3].int := curexp;
+ 			mem[s + 1].hh.lh := pp;
+ 			goto 30
+ 		    end {:765};
+ 		curexp := stashcurexp
+ 	    end;
+ 	    mem[q].hh.rh := getavail;
+ 	    q := mem[q].hh.rh;
+ 	    mem[q].hh.lh := curexp;
+ 	    curtype := 1;
+     22:
+ 	    
+ 	until curcmd <> 79;
+     30: {:764}
+ 	;
+     40: {756:}
+ 	if curcmd <> 78 then begin
+ 	    missingerr(58);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 597;
+ 		helpline[1] := 598;
+ 		helpline[0] := 599
+ 	    end;
+ 	    backerror
+ 	end {:756}; {758:}
+ 	q := getavail;
+ 	mem[q].hh.lh := 2230;
+ 	scannerstatus := 6;
+ 	warninginfo := n;
+ 	mem[s].hh.lh := scantoks(4, p, q, 0);
+ 	scannerstatus := 0;
+ 	mem[s].hh.rh := loopptr;
+ 	loopptr := s {:758};
+ 	resumeiteration
+     end; {:755} {760:}
+ 
+     procedure resumeiteration;
+     label
+ 	45, 10;
+     var
+ 	p, q: halfword;
+     begin
+ 	p := mem[loopptr + 1].hh.lh;
+ 	if p > (-29999) then begin
+ 	    curexp := mem[p + 1].int; {761:}
+ 	    if ((mem[p + 2].int > 0) and (curexp > mem[p + 3].int)) or ((mem[p + 2].int < 0) and (curexp < mem[p + 3].int)) then  {:761}
+ 		goto 45;
+ 	    curtype := 16;
+ 	    q := stashcurexp;
+ 	    mem[p + 1].int := curexp + mem[p + 2].int
+ 	end else if p < (-29999) then begin
+ 	    p := mem[loopptr + 1].hh.rh;
+ 	    if p = (-30000) then 
+ 		goto 45;
+ 	    mem[loopptr + 1].hh.rh := mem[p].hh.rh;
+ 	    q := mem[p].hh.lh;
+ 	    begin
+ 		mem[p].hh.rh := avail;
+ 		avail := p
+ 	    end {dynused:=dynused-1;}
+ 	end else begin
+ 	    begintokenlist(mem[loopptr].hh.lh, 7);
+ 	    goto 10
+ 	end;
+ 	begintokenlist(mem[loopptr].hh.lh, 8);
+ 	stackargument(q);
+ 	if internal[7] > 65536 then begin {762:}
+ 	    begindiagnostic;
+ 	    printnl(601);
+ 	    if (q <> (-30000)) and (mem[q].hh.rh = (-29999)) then 
+ 		printexp(q, 1)
+ 	    else 
+ 		showtokenlist(q, -30000, 50, 0);
+ 	    printchar(125);
+ 	    enddiagnostic(false)
+ 	end {:762};
+ 	goto 10;
+     45:
+ 	stopiteration;
+     10:
+ 	
+     end; {:760} {763:}
+ 
+     procedure stopiteration;
+     var
+ 	p, q: halfword;
+     begin
+ 	p := mem[loopptr + 1].hh.lh;
+ 	if p > (-29999) then 
+ 	    freenode(p, 4)
+ 	else if p < (-29999) then begin
+ 	    q := mem[loopptr + 1].hh.rh;
+ 	    while q <> (-30000) do begin
+ 		p := mem[q].hh.lh;
+ 		if p <> (-30000) then 
+ 		    if mem[p].hh.rh = (-29999) then begin
+ 			recyclevalue(p);
+ 			freenode(p, 2)
+ 		    end else 
+ 			flushtokenlist(p);
+ 		p := q;
+ 		q := mem[q].hh.rh;
+ 		begin
+ 		    mem[p].hh.rh := avail;
+ 		    avail := p
+ 		end {dynused:=dynused-1;}
+ 	    end
+ 	end;
+ 	p := loopptr;
+ 	loopptr := mem[p].hh.rh;
+ 	flushtokenlist(mem[p].hh.lh);
+ 	freenode(p, 2)
+     end; {:763} {770:}
+ 
+     procedure beginname;
+     begin
+ 	areadelimiter := 0;
+ 	extdelimiter := 0
+     end; {:770} {771:}
+ 
+     function morename(c: ASCIIcode): boolean;
+     begin
+ 	if (c = 32) or (c = 9) then 
+ 	    morename := false
+ 	else begin
+ 	    if c = 47 then begin
+ 		areadelimiter := poolptr;
+ 		extdelimiter := 0
+ 	    end else if (c = 46) and (extdelimiter = 0) then 
+ 		extdelimiter := poolptr;
+ 	    begin
+ 		if (poolptr + 1) > maxpoolptr then begin
+ 		    if (poolptr + 1) > poolsize then 
+ 			overflow(129, poolsize - initpoolptr);
+ 		    maxpoolptr := poolptr + 1
+ 		end
+ 	    end;
+ 	    begin
+ 		strpool[poolptr] := c;
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	    morename := true
+ 	end
+     end; { morename }
+ {:771}
+     {772:}
+ 
+     procedure endname;
+     begin
+ 	if (strptr + 3) > maxstrptr then begin
+ 	    if (strptr + 3) > maxstrings then 
+ 		overflow(130, maxstrings - initstrptr);
+ 	    maxstrptr := strptr + 3
+ 	end;
+ 	if areadelimiter = 0 then 
+ 	    curarea := 155
+ 	else begin
+ 	    curarea := strptr;
+ 	    strptr := strptr + 1;
+ 	    strstart[strptr] := areadelimiter + 1
+ 	end;
+ 	if extdelimiter = 0 then begin
+ 	    curext := 155;
+ 	    curname := makestring
+ 	end else begin
+ 	    curname := strptr;
+ 	    strptr := strptr + 1;
+ 	    strstart[strptr] := extdelimiter;
+ 	    curext := makestring
+ 	end
+     end; {:772} {774:}
+ 
+     procedure packfilename(n, a, e: strnumber);
+     var
+ 	k: integer;
+ 	c: ASCIIcode;
+ 	j: poolpointer;
+     begin
+ 	k := 0;
+ 	for j := strstart[a] to strstart[a + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := strstart[n] to strstart[n + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := strstart[e] to strstart[e + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	if k <= filenamesize then 
+ 	    namelength := k
+ 	else 
+ 	    namelength := filenamesize;
+ 	for k := namelength + 1 to filenamesize do 
+ 	    nameoffile[k] := ' '
+     end; {:774}
+ {778:}
+ 
+     procedure packbufferedname(n: smallnumber; a, b: integer);
+     var
+ 	k: integer;
+ 	c: ASCIIcode;
+ 	j: integer;
+     begin
+ 	if (((n + b) - a) + 6) > filenamesize then 
+ 	    b := ((a + filenamesize) - n) - 6;
+ 	k := 0;
+ 	for j := 1 to n do begin
+ 	    c := xord[MFbasedefault[j]];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := a to b do begin
+ 	    c := buffer[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := 6 to 10 do begin
+ 	    c := xord[MFbasedefault[j]];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	if k <= filenamesize then 
+ 	    namelength := k
+ 	else 
+ 	    namelength := filenamesize;
+ 	for k := namelength + 1 to filenamesize do 
+ 	    nameoffile[k] := ' '
+     end; {:778}
+ {780:}
+ 
+     function makenamestring: strnumber;
+     var
+ 	k, kstart: 1..filenamesize;
+     begin
+ 	k := 1;
+ 	while (k < filenamesize) and (xord[realnameoffile[k]] <> 32) do 
+ 	    k := k + 1;
+ 	namelength := k - 1;
+ 	if ((poolptr + namelength) > poolsize) or (strptr = maxstrings) then 
+ 	    makenamestring := 63
+ 	else begin
+ 	    if (xord[realnameoffile[1]] = 46) and (xord[realnameoffile[2]] = 47) then 
+ 		kstart := 3
+ 	    else 
+ 		kstart := 1;
+ 	    for k := kstart to namelength do begin
+ 		strpool[poolptr] := xord[realnameoffile[k]];
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	    makenamestring := makestring
+ 	end
+     end;
+ 
+     function amakenamestring(var f: alphafile): strnumber;
+     begin
+ 	amakenamestring := makenamestring
+     end; { amakenamestring }
+ 
+     function bmakenamestring(var f: bytefile): strnumber;
+     begin
+ 	bgetname(f, realnameoffile);
+ 	bmakenamestring := makenamestring
+     end; { bmakenamestring }
+ 
+     function wmakenamestring(var f: wordfile): strnumber;
+     begin
+ 	wmakenamestring := makenamestring
+     end; {:780} {781:}
+ 
+     procedure scanfilename;
+     label
+ 	30;
+     begin
+ 	beginname;
+ 	while (buffer[curinput.locfield] = 32) or (buffer[curinput.locfield] = 9) do 
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	while true do begin
+ 	    if (buffer[curinput.locfield] = 59) or (buffer[curinput.locfield] = 37) then 
+ 		goto 30;
+ 	    if not morename(buffer[curinput.locfield]) then 
+ 		goto 30;
+ 	    curinput.locfield := curinput.locfield + 1
+ 	end;
+     30:
+ 	endname
+     end; {:781} {784:}
+ 
+     procedure packjobname(s: strnumber);
+     begin
+ 	curarea := 155;
+ 	curext := s;
+ 	curname := jobname;
+ 	packfilename(curname, curarea, curext)
+     end; {:784} {786:}
+ 
+     procedure promptfilename(s, e: strnumber);
+     label
+ 	30;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	if interaction = 2 then 
+ 	    ;
+ 	if s = 607 then begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(608)
+ 	end else begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(609)
+ 	end;
+ 	printfilename(curname, curarea, curext);
+ 	print(610);
+ 	if e = 611 then 
+ 	    showcontext;
+ 	printnl(612);
+ 	print(s);
+ 	if interaction < 2 then 
+ 	    fatalerror(613);
+ 	begin
+ 	    print(614);
+ 	    terminput
+ 	end;
+ {787:}
+ 	begin
+ 	    beginname;
+ 	    k := first;
+ 	    while ((buffer[k] = 32) or (buffer[k] = 9)) and (k < last) do 
+ 		k := k + 1;
+ 	    while true do begin
+ 		if k = last then 
+ 		    goto 30;
+ 		if not morename(buffer[k]) then 
+ 		    goto 30;
+ 		k := k + 1
+ 	    end;
+     30:
+ 	    endname
+ 	end {:787};
+ 	if curext = 155 then 
+ 	    curext := e;
+ 	packfilename(curname, curarea, curext)
+     end; { promptfilename }
+ {:786}
+     {788:}
+ 
+     procedure openlogfile;
+     var
+ 	oldsetting: 0..5;
+ 	k: 0..bufsize;
+ 	l: 0..bufsize;
+ 	m: integer;
+ 	months: packed array [1..36] of char;
+     begin
+ 	oldsetting := selector;
+ 	if jobname = 0 then 
+ 	    jobname := 615;
+ 	packjobname(616);
+ 	while not aopenout(logfile) do begin {789:}
+ 	    if interaction < 2 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(609)
+ 		end;
+ 		printfilename(curname, curarea, curext);
+ 		print(610);
+ 		jobname := 0;
+ 		history := 3;
+ 		jumpout
+ 	    end;
+ 	    promptfilename(618, 616)
+ 	end {:789};
+ 	logname := amakenamestring(logfile);
+ 	selector := 2; {790:}
+ 	begin
+ 	    write(logfile, 'This is METAFONT, Version 1.0 for Berkeley UNIX');
+ 	    print(baseident);
+ 	    print(619);
+ 	    printint(roundunscaled(internal[16]));
+ 	    printchar(32);
+ 	    months := 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+ 	    m := roundunscaled(internal[15]);
+ 	    for k := (3 * m) - 2 to 3 * m do 
+ 		write(logfile, months[k]);
+ 	    printchar(32);
+ 	    printint(roundunscaled(internal[14]));
+ 	    printchar(32);
+ 	    m := roundunscaled(internal[17]);
+ 	    printdd(m div 60);
+ 	    printchar(58);
+ 	    printdd(m mod 60)
+ 	end {:790};
+ 	inputstack[inputptr] := curinput;
+ 	printnl(617);
+ 	l := inputstack[0].limitfield - 1;
+ 	for k := 1 to l do 
+ 	    print(buffer[k]);
+ 	println;
+ 	selector := oldsetting + 2
+     end; {:788} {793:}
+ 
+     procedure startinput;
+     label
+ 	30; {795:}
+     begin
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	if curinput.indexfield > 6 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(621)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 622;
+ 		helpline[1] := 623;
+ 		helpline[0] := 624
+ 	    end;
+ 	    error
+ 	end;
+ 	if curinput.indexfield <= 6 then 
+ 	    scanfilename
+ 	else begin
+ 	    curname := 155;
+ 	    curext := 155;
+ 	    curarea := 155
+ 	end {:795};
+ 	if curext = 155 then 
+ 	    curext := 611;
+ 	packfilename(curname, curarea, curext);
+ 	while true do begin
+ 	    beginfilereading;
+ 	    if aopenin(inputfile[curinput.indexfield], 6) then 
+ 		goto 30;
+ 	    endfilereading;
+ 	    promptfilename(607, 611)
+ 	end;
+     30:
+ 	curinput.namefield := amakenamestring(inputfile[curinput.indexfield]);
+ 	strref[curname] := 127;
+ 	if jobname = 0 then begin
+ 	    jobname := curname;
+ 	    openlogfile
+ 	end;
+ 	if (termoffset + (strstart[curinput.namefield + 1] - strstart[curinput.namefield])) > (maxprintline - 2) then 
+ 	    println
+ 	else if (termoffset > 0) or (fileoffset > 0) then 
+ 	    printchar(32);
+ 	printchar(40);
+ 	print(curinput.namefield);
+ 	flush(output); {794:}
+ 	begin
+ 	    if not inputln(inputfile[curinput.indexfield], false) then 
+ 		;
+ 	    firmuptheline;
+ 	    buffer[curinput.limitfield] := 37;
+ 	    first := curinput.limitfield + 1;
+ 	    curinput.locfield := curinput.startfield;
+ 	    line := 1
+ 	end {:794}
+     end; {:793} {824:}
+ 
+     procedure badexp(s: strnumber);
+     var
+ 	saveflag: 0..82;
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(s)
+ 	end;
+ 	print(634);
+ 	printcmdmod(curcmd, curmod);
+ 	printchar(39);
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 635;
+ 	    helpline[2] := 636;
+ 	    helpline[1] := 637;
+ 	    helpline[0] := 638
+ 	end;
+ 	backinput;
+ 	cursym := 0;
+ 	curcmd := 42;
+ 	curmod := 0;
+ 	inserror;
+ 	saveflag := varflag;
+ 	varflag := 0;
+ 	getxnext;
+ 	varflag := saveflag
+     end; {:824} {827:}
+ 
+     procedure stashin(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	mem[p].hh.b0 := curtype;
+ 	{
+ 	829:}
+ 	if curtype = 16 then 
+ 	    mem[p + 1].int := curexp
+ 	else begin
+ 	    if curtype = 19 then begin
+ 		q := singledependency(curexp);
+ 		if q = depfinal then begin
+ 		    mem[p].hh.b0 := 16;
+ 		    mem[p + 1].int := 0;
+ 		    freenode(q, 2)
+ 		end else begin
+ 		    mem[p].hh.b0 := 17;
+ 		    newdep(p, q)
+ 		end;
+ 		recyclevalue(curexp)
+ 	    end else begin {:829}
+ 		mem[p + 1] := mem[curexp + 1];
+ 		mem[mem[p + 1].hh.lh].hh.rh := p
+ 	    end;
+ 	    freenode(curexp, 2)
+ 	end;
+ 	curtype := 1
+     end; { stashin }
+ {:827}
+     {848:}
+ 
+     procedure backexpr;
+     var
+ 	p: halfword;
+     begin
+ 	p := stashcurexp;
+ 	mem[p].hh.rh := -30000;
+ 	begintokenlist(p, 10)
+     end; {:848} {849:}
+ 
+     procedure badsubscript;
+     begin
+ 	disperr(-30000, 650);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 651;
+ 	    helpline[1] := 652;
+ 	    helpline[0] := 653
+ 	end;
+ 	flusherror(0)
+     end; {:849} {851:}
+ 
+     procedure obliterated(q: halfword);
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(654)
+ 	end;
+ 	showtokenlist(q, -30000, 1000, 0);
+ 	print(655);
+ 	begin
+ 	    helpptr := 5;
+ 	    helpline[4] := 656;
+ 	    helpline[3] := 657;
+ 	    helpline[2] := 658;
+ 	    helpline[1] := 659;
+ 	    helpline[0] := 660
+ 	end
+     end; {:851} {863:}
+ 
+     procedure binarymac(p, c, n: halfword);
+     var
+ 	q, r: halfword;
+     begin
+ 	q := getavail;
+ 	r := getavail;
+ 	mem[q].hh.rh := r;
+ 	mem[q].hh.lh := p;
+ 	mem[r].hh.lh := stashcurexp;
+ 	macrocall(c, q, n)
+     end; {:863} {865:}
+ 
+     procedure materializepen;
+     label
+ 	50;
+     var
+ 	aminusb, aplusb, majoraxis, minoraxis: scaled;
+ 	theta: angle;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	q := curexp;
+ 	if mem[q].hh.b0 = 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(670)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 671;
+ 		helpline[0] := 442
+ 	    end;
+ 	    putgeterror;
+ 	    curexp := -29997;
+ 	    goto 50
+ 	end else if mem[q].hh.b0 = 4 then begin {866:}
+ 	    tx := mem[q + 1].int;
+ 	    ty := mem[q + 2].int;
+ 	    txx := mem[q + 3].int - tx;
+ 	    tyx := mem[q + 4].int - ty;
+ 	    txy := mem[q + 5].int - tx;
+ 	    tyy := mem[q + 6].int - ty;
+ 	    aminusb := pythadd(txx - tyy, tyx + txy);
+ 	    aplusb := pythadd(txx + tyy, tyx - txy);
+ 	    majoraxis := (aminusb + aplusb) div 2;
+ 	    minoraxis := abs(aplusb - aminusb) div 2;
+ 	    if majoraxis = minoraxis then 
+ 		theta := 0
+ 	    else 
+ 		theta := (narg(txx - tyy, tyx + txy) + narg(txx + tyy, tyx - txy)) div 2;
+ 	    freenode(q, 7);
+ 	    q := makeellipse(majoraxis, minoraxis, theta);
+ 	    if (tx <> 0) or (ty <> 0) then begin {867:}
+ 		p := q;
+ 		repeat
+ 		    mem[p + 1].int := mem[p + 1].int + tx;
+ 		    mem[p + 2].int := mem[p + 2].int + ty;
+ 		    p := mem[p].hh.rh
+ 		until p = q
+ 	    end {:867}
+ 	end {:866};
+ 	curexp := makepen(q);
+     50:
+ 	tossknotlist(q);
+ 	curtype := 6
+     end; {:865}
+ {871:}
+     {872:}
+ 
+     procedure knownpair;
+     var
+ 	p: halfword;
+     begin
+ 	if curtype <> 14 then begin
+ 	    disperr(-30000, 673);
+ 	    begin
+ 		helpptr := 5;
+ 		helpline[4] := 674;
+ 		helpline[3] := 675;
+ 		helpline[2] := 676;
+ 		helpline[1] := 677;
+ 		helpline[0] := 678
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    curx := 0;
+ 	    cury := 0
+ 	end else begin
+ 	    p := mem[curexp + 1].int; {873:}
+ 	    if mem[p].hh.b0 = 16 then 
+ 		curx := mem[p + 1].int
+ 	    else begin
+ 		disperr(p, 679);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 680;
+ 		    helpline[3] := 675;
+ 		    helpline[2] := 676;
+ 		    helpline[1] := 677;
+ 		    helpline[0] := 678
+ 		end;
+ 		putgeterror;
+ 		recyclevalue(p);
+ 		curx := 0
+ 	    end;
+ 	    if mem[p + 2].hh.b0 = 16 then 
+ 		cury := mem[p + 3].int
+ 	    else begin
+ 		disperr(p + 2, 681);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 682;
+ 		    helpline[3] := 675;
+ 		    helpline[2] := 676;
+ 		    helpline[1] := 677;
+ 		    helpline[0] := 678
+ 		end;
+ 		putgeterror;
+ 		recyclevalue(p + 2);
+ 		cury := 0
+ 	    end {:873};
+ 	    flushcurexp(0)
+ 	end
+     end; {:872}
+ 
+     function newknot: halfword;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(7);
+ 	mem[q].hh.b0 := 0;
+ 	mem[q].hh.b1 := 0;
+ 	mem[q].hh.rh := q;
+ 	knownpair;
+ 	mem[q + 1].int := curx;
+ 	mem[q + 2].int := cury;
+ 	newknot := q
+     end; {:871} {875:}
+ 
+     function scandirection: smallnumber;
+     var
+ 	t: 2..4;
+ 	x: scaled;
+     begin
+ 	getxnext;
+ 	if curcmd = 60 then begin {876:}
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if (curtype <> 16) or (curexp < 0) then begin
+ 		disperr(-30000, 685);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 686
+ 		end;
+ 		putgetflusherror(65536)
+ 	    end;
+ 	    t := 3
+ 	end else begin {:876} {877:}
+ 	    scanexpression;
+ 	    if curtype > 14 then begin {878:}
+ 		if curtype <> 16 then begin
+ 		    disperr(-30000, 679);
+ 		    begin
+ 			helpptr := 5;
+ 			helpline[4] := 680;
+ 			helpline[3] := 675;
+ 			helpline[2] := 676;
+ 			helpline[1] := 677;
+ 			helpline[0] := 678
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end;
+ 		x := curexp;
+ 		if curcmd <> 79 then begin
+ 		    missingerr(44);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 687;
+ 			helpline[0] := 688
+ 		    end;
+ 		    backerror
+ 		end;
+ 		getxnext;
+ 		scanexpression;
+ 		if curtype <> 16 then begin
+ 		    disperr(-30000, 681);
+ 		    begin
+ 			helpptr := 5;
+ 			helpline[4] := 682;
+ 			helpline[3] := 675;
+ 			helpline[2] := 676;
+ 			helpline[1] := 677;
+ 			helpline[0] := 678
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end;
+ 		cury := curexp;
+ 		curx := x
+ 	    end else  {:878}
+ 		knownpair;
+ 	    if (curx = 0) and (cury = 0) then 
+ 		t := 4
+ 	    else begin
+ 		t := 2;
+ 		curexp := narg(curx, cury)
+ 	    end
+ 	end {:877};
+ 	if curcmd <> 65 then begin
+ 	    missingerr(125);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 683;
+ 		helpline[1] := 684;
+ 		helpline[0] := 563
+ 	    end;
+ 	    backerror
+ 	end;
+ 	getxnext;
+ 	scandirection := t
+     end; {:875} {895:}
+ 
+     procedure donullary(c: quarterword);
+     var
+ 	k: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then 
+ 	    showcmdmod(33, c);
+ 	case c of
+ 	    30, 31:
+ 		begin
+ 		    curtype := 2;
+ 		    curexp := c
+ 		end;
+ 	    32:
+ 		begin
+ 		    curtype := 11;
+ 		    curexp := getnode(6);
+ 		    initedges(curexp)
+ 		end;
+ 	    33:
+ 		begin
+ 		    curtype := 6;
+ 		    curexp := -29997
+ 		end;
+ 	    37:
+ 		begin
+ 		    curtype := 16;
+ 		    curexp := normrand
+ 		end;
+ 	    36:
+ 		begin {896:}
+ 		    curtype := 8;
+ 		    curexp := getnode(7);
+ 		    mem[curexp].hh.b0 := 4;
+ 		    mem[curexp].hh.b1 := 4;
+ 		    mem[curexp].hh.rh := curexp;
+ 		    mem[curexp + 1].int := 0;
+ 		    mem[curexp + 2].int := 0;
+ 		    mem[curexp + 3].int := 65536;
+ 		    mem[curexp + 4].int := 0;
+ 		    mem[curexp + 5].int := 0;
+ 		    mem[curexp + 6].int := 65536
+ 		end; {:896}
+ 	    34:
+ 		begin
+ 		    if jobname = 0 then 
+ 			openlogfile;
+ 		    curtype := 4;
+ 		    curexp := jobname
+ 		end;
+ 	    35:
+ 		begin {897:}
+ 		    if interaction <= 1 then 
+ 			fatalerror(699);
+ 		    beginfilereading;
+ 		    curinput.namefield := 1;
+ 		    begin
+ 			print(155);
+ 			terminput
+ 		    end;
+ 		    begin
+ 			if ((poolptr + last) - curinput.startfield) > maxpoolptr then begin
+ 			    if ((poolptr + last) - curinput.startfield) > poolsize then 
+ 				overflow(129, poolsize - initpoolptr);
+ 			    maxpoolptr := (poolptr + last) - curinput.startfield
+ 			end
+ 		    end;
+ 		    for k := curinput.startfield to last - 1 do begin
+ 			strpool[poolptr] := buffer[k];
+ 			poolptr := poolptr + 1
+ 		    end;
+ 		    endfilereading;
+ 		    curtype := 4;
+ 		    curexp := makestring
+ 		end
+ 	end {:897};
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end
+     end; {:895} {898:}
+ {899:}
+ 
+     function nicepair(p: integer; t: quarterword): boolean;
+     label
+ 	10;
+     begin
+ 	if t = 14 then begin
+ 	    p := mem[p + 1].int;
+ 	    if mem[p].hh.b0 = 16 then 
+ 		if mem[p + 2].hh.b0 = 16 then begin
+ 		    nicepair := true;
+ 		    goto 10
+ 		end
+ 	end;
+ 	nicepair := false;
+     10:
+ 	
+     end; {:899} {900:}
+ 
+     procedure printknownorunknownt(t: smallnumber; v: integer);
+     begin
+ 	printchar(40);
+ 	if t < 17 then 
+ 	    if t <> 14 then 
+ 		printtype(t)
+ 	    else if nicepair(v, 14) then 
+ 		print(207)
+ 	    else 
+ 		print(700)
+ 	else 
+ 	    print(701);
+ 	printchar(41)
+     end; {:900} {901:}
+ 
+     procedure badunary(c: quarterword);
+     begin
+ 	disperr(-30000, 702);
+ 	printop(c);
+ 	printknownorunknownt(curtype, curexp);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 703;
+ 	    helpline[1] := 704;
+ 	    helpline[0] := 705
+ 	end;
+ 	putgeterror
+     end; {:901} {904:}
+ 
+     procedure negatedeplist(p: halfword);
+     label
+ 	10;
+     begin
+ 	while true do begin
+ 	    mem[p + 1].int := -mem[p + 1].int;
+ 	    if mem[p].hh.lh = (-30000) then 
+ 		goto 10;
+ 	    p := mem[p].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:904}
+ {908:}
+ 
+     procedure pairtopath;
+     begin
+ 	curexp := newknot;
+ 	curtype := 9
+     end; {:908}
+ {910:}
+ 
+     procedure takepart(c: quarterword);
+     var
+ 	p: halfword;
+     begin
+ 	p := mem[curexp + 1].int;
+ 	mem[-29982].int := p;
+ 	mem[-29983].hh.b0 := curtype;
+ 	mem[p].hh.rh := -29983;
+ 	freenode(curexp, 2);
+ 	makeexpcopy(p + (2 * (c - 53)));
+ 	recyclevalue(-29983)
+     end; {:910} {913:}
+ 
+     procedure strtonum(c: quarterword);
+     var
+ 	n: integer;
+ 	m: ASCIIcode;
+ 	k: poolpointer;
+ 	b: 8..16;
+ 	badchar: boolean;
+     begin
+ 	if c = 49 then 
+ 	    if (strstart[curexp + 1] - strstart[curexp]) = 0 then 
+ 		n := -1
+ 	    else 
+ 		n := strpool[strstart[curexp]]
+ 	else begin
+ 	    if c = 47 then 
+ 		b := 8
+ 	    else 
+ 		b := 16;
+ 	    n := 0;
+ 	    badchar := false;
+ 	    for k := strstart[curexp] to strstart[curexp + 1] - 1 do begin
+ 		m := strpool[k];
+ 		if (m >= 48) and (m <= 57) then 
+ 		    m := m - 48
+ 		else if (m >= 65) and (m <= 70) then 
+ 		    m := m - 55
+ 		else if (m >= 97) and (m <= 102) then 
+ 		    m := m - 87
+ 		else begin
+ 		    badchar := true;
+ 		    m := 0
+ 		end;
+ 		if m >= b then begin
+ 		    badchar := true;
+ 		    m := 0
+ 		end;
+ 		if n < (32768 div b) then 
+ 		    n := (n * b) + m
+ 		else 
+ 		    n := 32767
+ 	    end; {914:}
+ 	    if badchar then begin
+ 		disperr(-30000, 707);
+ 		if c = 47 then begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 708
+ 		end else begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 709
+ 		end;
+ 		putgeterror
+ 	    end;
+ 	    if n > 4095 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(710)
+ 		end;
+ 		printint(n);
+ 		printchar(41);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 711
+ 		end;
+ 		putgeterror
+ 	    end {:914}
+ 	end;
+ 	flushcurexp(n * 65536)
+     end; { strtonum }
+ {:913}
+     {916:}
+ 
+     function pathlength: scaled;
+     var
+ 	n: scaled;
+ 	p: halfword;
+     begin
+ 	p := curexp;
+ 	if mem[p].hh.b0 = 0 then 
+ 	    n := -65536
+ 	else 
+ 	    n := 0;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 65536
+ 	until p = curexp;
+ 	pathlength := n
+     end; { pathlength }
+ {:916}
+     {919:}
+ 
+     procedure testknown(c: quarterword);
+     label
+ 	30;
+     var
+ 	b: 30..31;
+ 	p, q: halfword;
+     begin
+ 	b := 31;
+ 	if curtype in
+ 	    [1, 2, 4, 6, 8, 9, 11, 16,
+ 	     13, 14] then
+ 	    case curtype of
+ 		1, 2, 4, 6, 8, 9, 11,
+ 		16:
+ 		    b := 30;
+ 		13, 14:
+ 		    begin
+ 			p := mem[curexp + 1].int;
+ 			q := p + bignodesize[curtype];
+ 			repeat
+ 			    q := q - 2;
+ 			    if mem[q].hh.b0 <> 16 then 
+ 				goto 30
+ 			until q = p;
+ 			b := 30;
+     30:
+ 			
+ 		    end
+ 	    end
+ 	else
+ 	    ;
+ 	if c = 39 then 
+ 	    flushcurexp(b)
+ 	else 
+ 	    flushcurexp(61 - b);
+ 	curtype := 2
+     end; {:919}
+ 
+     procedure dounary(c: quarterword);
+     var
+ 	p, q: halfword;
+ 	x: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then begin {902:}
+ 	    begindiagnostic;
+ 	    printnl(123);
+ 	    printop(c);
+ 	    printchar(40);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:902};
+ 	case c of
+ 	    69:
+ 		if curtype < 14 then 
+ 		    if curtype <> 11 then 
+ 			badunary(69);
+ 	    70: {903:}
+ 		if curtype in
+ 		    [14, 19, 17, 18, 16, 11] then
+ 		    case curtype of
+ 			14, 19:
+ 			    begin
+ 				q := curexp;
+ 				makeexpcopy(q);
+ 				if curtype = 17 then 
+ 				    negatedeplist(mem[curexp + 1].hh.rh)
+ 				else if curtype = 14 then begin
+ 				    p := mem[curexp + 1].int;
+ 				    if mem[p].hh.b0 = 16 then 
+ 					mem[p + 1].int := -mem[p + 1].int
+ 				    else 
+ 					negatedeplist(mem[p + 1].hh.rh);
+ 				    if mem[p + 2].hh.b0 = 16 then 
+ 					mem[p + 3].int := -mem[p + 3].int
+ 				    else 
+ 					negatedeplist(mem[p + 3].hh.rh)
+ 				end;
+ 				recyclevalue(q);
+ 				freenode(q, 2)
+ 			    end;
+ 			17, 18:
+ 			    negatedeplist(mem[curexp + 1].hh.rh);
+ 			16:
+ 			    curexp := -curexp;
+ 			11:
+ 			    negateedges(curexp)
+ 		    end
+ 		else
+ 		    badunary(70) {:903}; {905:}
+ 	    41:
+ 		if curtype <> 2 then 
+ 		    badunary(41)
+ 		else 
+ 		    curexp := 61 - curexp; {:905} {906:}
+ 	    59, 60, 61, 62, 63, 64, 65,
+ 	    38, 66:
+ 		if curtype <> 16 then 
+ 		    badunary(c)
+ 		else 
+ 		    case c of
+ 			59:
+ 			    curexp := squarert(curexp);
+ 			60:
+ 			    curexp := mexp(curexp);
+ 			61:
+ 			    curexp := mlog(curexp);
+ 			62, 63:
+ 			    begin
+ 				nsincos((curexp mod 23592960) * 16);
+ 				if c = 62 then 
+ 				    curexp := roundfraction(nsin)
+ 				else 
+ 				    curexp := roundfraction(ncos)
+ 			    end;
+ 			64:
+ 			    curexp := floorscaled(curexp);
+ 			65:
+ 			    curexp := unifrand(curexp);
+ 			38:
+ 			    begin
+ 				if odd(roundunscaled(curexp)) then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 				curtype := 2
+ 			    end;
+ 			66:
+ 			    begin {1181:}
+ 				curexp := roundunscaled(curexp) mod 256;
+ 				if curexp < 0 then 
+ 				    curexp := curexp + 256;
+ 				if charexists[curexp] then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 				curtype := 2
+ 			    end
+ 		    end {:1181}; {:906} {907:}
+ 	    67:
+ 		if nicepair(curexp, curtype) then begin
+ 		    p := mem[curexp + 1].int;
+ 		    x := narg(mem[p + 1].int, mem[p + 3].int);
+ 		    if x >= 0 then 
+ 			flushcurexp((x + 8) div 16)
+ 		    else 
+ 			flushcurexp(-(((-x) + 8) div 16))
+ 		end else 
+ 		    badunary(67); {:907} {909:}
+ 	    53, 54:
+ 		if (curtype <= 14) and (curtype >= 13) then 
+ 		    takepart(c)
+ 		else 
+ 		    badunary(c);
+ 	    55, 56, 57, 58:
+ 		if curtype = 13 then 
+ 		    takepart(c)
+ 		else 
+ 		    badunary(c); {:909} {912:}
+ 	    50:
+ 		if curtype <> 16 then 
+ 		    badunary(50)
+ 		else begin
+ 		    curexp := roundunscaled(curexp) mod 128;
+ 		    curtype := 4;
+ 		    if curexp < 0 then 
+ 			curexp := curexp + 128;
+ 		    if (strstart[curexp + 1] - strstart[curexp]) <> 1 then begin
+ 			begin
+ 			    if (poolptr + 1) > maxpoolptr then begin
+ 				if (poolptr + 1) > poolsize then 
+ 				    overflow(129, poolsize - initpoolptr);
+ 				maxpoolptr := poolptr + 1
+ 			    end
+ 			end;
+ 			begin
+ 			    strpool[poolptr] := curexp;
+ 			    poolptr := poolptr + 1
+ 			end;
+ 			curexp := makestring
+ 		    end
+ 		end;
+ 	    42:
+ 		if curtype <> 16 then 
+ 		    badunary(42)
+ 		else begin
+ 		    oldsetting := selector;
+ 		    selector := 5;
+ 		    printscaled(curexp);
+ 		    curexp := makestring;
+ 		    selector := oldsetting;
+ 		    curtype := 4
+ 		end;
+ 	    47, 48, 49:
+ 		if curtype <> 4 then 
+ 		    badunary(c)
+ 		else 
+ 		    strtonum(c);
+ {:912}
+ 	    {915:}
+ 	    51:
+ 		if curtype = 4 then 
+ 		    flushcurexp((strstart[curexp + 1] - strstart[curexp]) * 65536)
+ 		else if curtype = 9 then 
+ 		    flushcurexp(pathlength)
+ 		else if curtype = 16 then 
+ 		    curexp := abs(curexp)
+ 		else if nicepair(curexp, curtype) then 
+ 		    flushcurexp(pythadd(mem[mem[curexp + 1].int + 1].int, mem[mem[curexp + 1].int + 3].int))
+ 		else 
+ 		    badunary(c); {:915} {917:}
+ 	    52:
+ 		if curtype = 14 then 
+ 		    flushcurexp(0)
+ 		else if curtype <> 9 then 
+ 		    badunary(52)
+ 		else if mem[curexp].hh.b0 = 0 then 
+ 		    flushcurexp(0)
+ 		else begin
+ 		    curpen := -29997;
+ 		    curpathtype := 1;
+ 		    curexp := makespec(curexp, -1879080960, 0);
+ 		    flushcurexp(turningnumber * 65536)
+ 		end; {:917} {918:}
+ 	    2:
+ 		begin
+ 		    if (curtype >= 2) and (curtype <= 3) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    4:
+ 		begin
+ 		    if (curtype >= 4) and (curtype <= 5) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    6:
+ 		begin
+ 		    if (curtype >= 6) and (curtype <= 8) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    9:
+ 		begin
+ 		    if (curtype >= 9) and (curtype <= 10) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    11:
+ 		begin
+ 		    if (curtype >= 11) and (curtype <= 12) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    13, 14:
+ 		begin
+ 		    if curtype = c then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    15:
+ 		begin
+ 		    if (curtype >= 16) and (curtype <= 19) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    39, 40:
+ 		testknown(c); {:918} {920:}
+ 	    68:
+ 		begin
+ 		    if curtype <> 9 then 
+ 			flushcurexp(31)
+ 		    else if mem[curexp].hh.b0 <> 0 then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end; {:920} {921:}
+ 	    45:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if curtype = 9 then 
+ 			curtype := 8
+ 		    else 
+ 			badunary(45)
+ 		end;
+ 	    44:
+ 		begin
+ 		    if curtype = 8 then 
+ 			materializepen;
+ 		    if curtype <> 6 then 
+ 			badunary(44)
+ 		    else begin
+ 			flushcurexp(makepath(curexp));
+ 			curtype := 9
+ 		    end
+ 		end;
+ 	    46:
+ 		if curtype <> 11 then 
+ 		    badunary(46)
+ 		else 
+ 		    flushcurexp(totalweight(curexp));
+ 	    43:
+ 		if curtype = 9 then begin
+ 		    p := htapypoc(curexp);
+ 		    if mem[p].hh.b1 = 0 then 
+ 			p := mem[p].hh.rh;
+ 		    tossknotlist(curexp);
+ 		    curexp := p
+ 		end else if curtype = 14 then 
+ 		    pairtopath
+ 		else 
+ 		    badunary(43)
+ 	end {:921};
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end
+     end; {:898} {922:} {923:}
+ 
+     procedure badbinary(p: halfword; c: quarterword);
+     begin
+ 	disperr(p, 155);
+ 	disperr(-30000, 702);
+ 	if c >= 94 then 
+ 	    printop(c);
+ 	printknownorunknownt(mem[p].hh.b0, p);
+ 	if c >= 94 then 
+ 	    print(347)
+ 	else 
+ 	    printop(c);
+ 	printknownorunknownt(curtype, curexp);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 703;
+ 	    helpline[1] := 712;
+ 	    helpline[0] := 713
+ 	end;
+ 	putgeterror
+     end; {:923} {928:}
+ 
+     function tarnished(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := mem[p + 1].int;
+ 	r := q + bignodesize[mem[p].hh.b0];
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 = 19 then begin
+ 		tarnished := -29999;
+ 		goto 10
+ 	    end
+ 	until r = q;
+ 	tarnished := -30000;
+     10:
+ 	
+     end; {:928} {930:} {935:}
+ 
+     procedure depfinish(v, q: halfword; t: smallnumber);
+     var
+ 	p: halfword;
+ 	vv: scaled;
+     begin
+ 	if q = (-30000) then 
+ 	    p := curexp
+ 	else 
+ 	    p := q;
+ 	mem[p + 1].hh.rh := v;
+ 	mem[p].hh.b0 := t;
+ 	if mem[v].hh.lh = (-30000) then begin
+ 	    vv := mem[v + 1].int;
+ 	    if q = (-30000) then 
+ 		flushcurexp(vv)
+ 	    else begin
+ 		recyclevalue(p);
+ 		mem[q].hh.b0 := 16;
+ 		mem[q + 1].int := vv
+ 	    end
+ 	end else if q = (-30000) then 
+ 	    curtype := t;
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:935}
+ 
+     procedure addorsubtract(p, q: halfword; c: quarterword);
+     label
+ 	30, 10;
+     var
+ 	s, t: smallnumber;
+ 	r: halfword;
+ 	v: integer;
+     begin
+ 	if q = (-30000) then begin
+ 	    t := curtype;
+ 	    if t < 17 then 
+ 		v := curexp
+ 	    else 
+ 		v := mem[curexp + 1].hh.rh
+ 	end else begin
+ 	    t := mem[q].hh.b0;
+ 	    if t < 17 then 
+ 		v := mem[q + 1].int
+ 	    else 
+ 		v := mem[q + 1].hh.rh
+ 	end;
+ 	if t = 16 then begin
+ 	    if c = 70 then 
+ 		v := -v;
+ 	    if mem[p].hh.b0 = 16 then begin
+ 		v := slowadd(mem[p + 1].int, v);
+ 		if q = (-30000) then 
+ 		    curexp := v
+ 		else 
+ 		    mem[q + 1].int := v;
+ 		goto 10
+ 	    end; {931:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    while mem[r].hh.lh <> (-30000) do 
+ 		r := mem[r].hh.rh;
+ 	    mem[r + 1].int := slowadd(mem[r + 1].int, v);
+ 	    if q = (-30000) then begin
+ 		q := getnode(2);
+ 		curexp := q;
+ 		curtype := mem[p].hh.b0;
+ 		mem[q].hh.b1 := 11
+ 	    end;
+ 	    mem[q + 1].hh.rh := mem[p + 1].hh.rh;
+ 	    mem[q].hh.b0 := mem[p].hh.b0;
+ 	    mem[q + 1].hh.lh := mem[p + 1].hh.lh;
+ 	    mem[mem[p + 1].hh.lh].hh.rh := q;
+ 	    mem[p].hh.b0 := 16
+ 	end else begin {:931}
+ 	    if c = 70 then 
+ 		negatedeplist(v); {932:}
+ 	    if mem[p].hh.b0 = 16 then begin {933:}
+ 		while mem[v].hh.lh <> (-30000) do 
+ 		    v := mem[v].hh.rh;
+ 		mem[v + 1].int := slowadd(mem[p + 1].int, mem[v + 1].int)
+ 	    end else begin {:933}
+ 		s := mem[p].hh.b0;
+ 		r := mem[p + 1].hh.rh;
+ 		if t = 17 then begin
+ 		    if s = 17 then 
+ 			if (maxcoef(r) + maxcoef(v)) < 626349397 then begin
+ 			    v := pplusq(v, r, 17);
+ 			    goto 30
+ 			end;
+ 		    t := 18;
+ 		    v := poverv(v, 65536, 17, 18)
+ 		end;
+ 		if s = 18 then 
+ 		    v := pplusq(v, r, 18)
+ 		else 
+ 		    v := pplusfq(v, 65536, r, 18, 17);
+     30: {934:}
+ 		if q <> (-30000) then 
+ 		    depfinish(v, q, t)
+ 		else begin
+ 		    curtype := t;
+ 		    depfinish(v, -30000, t)
+ 		end {:934}
+ 	    end {:932}
+ 	end;
+     10:
+ 	
+     end; {:930} {943:}
+ 
+     procedure depmult(p: halfword; v: integer; visscaled: boolean);
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	s, t: smallnumber;
+     begin
+ 	if p = (-30000) then 
+ 	    q := curexp
+ 	else if mem[p].hh.b0 <> 16 then 
+ 	    q := p
+ 	else begin
+ 	    if visscaled then 
+ 		mem[p + 1].int := takescaled(mem[p + 1].int, v)
+ 	    else 
+ 		mem[p + 1].int := takefraction(mem[p + 1].int, v);
+ 	    goto 10
+ 	end;
+ 	t := mem[q].hh.b0;
+ 	q := mem[q + 1].hh.rh;
+ 	s := t;
+ 	if t = 17 then 
+ 	    if visscaled then 
+ 		if abvscd(maxcoef(q), abs(v), 626349396, 65536) >= 0 then 
+ 		    t := 18;
+ 	q := ptimesv(q, v, s, t, visscaled);
+ 	depfinish(q, p, t);
+     10:
+ 	
+     end; {:943} {946:}
+ 
+     procedure hardtimes(p: halfword);
+     var
+ 	q: halfword;
+ 	r: halfword;
+ 	u, v: scaled;
+     begin
+ 	if mem[p].hh.b0 = 14 then begin
+ 	    q := stashcurexp;
+ 	    unstashcurexp(p);
+ 	    p := q
+ 	end;
+ 	r := mem[curexp + 1].int;
+ 	u := mem[r + 1].int;
+ 	v := mem[r + 3].int; {947:}
+ 	mem[r + 2].hh.b0 := mem[p].hh.b0;
+ 	newdep(r + 2, copydeplist(mem[p + 1].hh.rh));
+ 	mem[r].hh.b0 := mem[p].hh.b0;
+ 	mem[r + 1] := mem[p + 1];
+ 	mem[mem[p + 1].hh.lh].hh.rh := r;
+ 	freenode(p, 2) {:947};
+ 	depmult(r, u, true);
+ 	depmult(r + 2, v, true)
+     end; {:946} {949:}
+ 
+     procedure depdiv(p: halfword; v: scaled);
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	s, t: smallnumber;
+     begin
+ 	if p = (-30000) then 
+ 	    q := curexp
+ 	else if mem[p].hh.b0 <> 16 then 
+ 	    q := p
+ 	else begin
+ 	    mem[p + 1].int := makescaled(mem[p + 1].int, v);
+ 	    goto 10
+ 	end;
+ 	t := mem[q].hh.b0;
+ 	q := mem[q + 1].hh.rh;
+ 	s := t;
+ 	if t = 17 then 
+ 	    if abvscd(maxcoef(q), 65536, 626349396, abs(v)) >= 0 then 
+ 		t := 18;
+ 	q := poverv(q, v, s, t);
+ 	depfinish(q, p, t);
+     10:
+ 	
+     end; {:949} {953:}
+ 
+     procedure setuptrans(c: quarterword);
+     label
+ 	30, 10;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	if (c <> 88) or (curtype <> 13) then begin {955:}
+ 	    p := stashcurexp;
+ 	    curexp := idtransform;
+ 	    curtype := 13;
+ 	    q := mem[curexp + 1].int;
+ 	    case c of {957:}
+ 		84:
+ 		    if mem[p].hh.b0 = 16 then begin {958:}
+ 			nsincos((mem[p + 1].int mod 23592960) * 16);
+ 			mem[q + 5].int := roundfraction(ncos);
+ 			mem[q + 9].int := roundfraction(nsin);
+ 			mem[q + 7].int := -mem[q + 9].int;
+ 			mem[q + 11].int := mem[q + 5].int;
+ 			goto 30
+ 		    end {:958};
+ 		85:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 6, p);
+ 			goto 30
+ 		    end;
+ 		86:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 4, p);
+ 			install(q + 10, p);
+ 			goto 30
+ 		    end;
+ 		87:
+ 		    if mem[p].hh.b0 = 14 then begin
+ 			r := mem[p + 1].int;
+ 			install(q, r);
+ 			install(q + 2, r + 2);
+ 			goto 30
+ 		    end;
+ 		89:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 4, p);
+ 			goto 30
+ 		    end;
+ 		90:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 10, p);
+ 			goto 30
+ 		    end;
+ 		91:
+ 		    if mem[p].hh.b0 = 14 then begin {959:}
+ 			r := mem[p + 1].int;
+ 			install(q + 4, r);
+ 			install(q + 10, r);
+ 			install(q + 8, r + 2);
+ 			if mem[r + 2].hh.b0 = 16 then 
+ 			    mem[r + 3].int := -mem[r + 3].int
+ 			else 
+ 			    negatedeplist(mem[r + 3].hh.rh);
+ 			install(q + 6, r + 2);
+ 			goto 30
+ 		    end {:959};
+ 		88:
+ 		    
+ 	    end {:957};
+ 	    disperr(p, 722);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 723;
+ 		helpline[1] := 724;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror;
+     30:
+ 	    recyclevalue(p);
+ 	    freenode(p, 2)
+ 	end {:955}; {956:}
+ 	q := mem[curexp + 1].int;
+ 	r := q + 12;
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 <> 16 then 
+ 		goto 10
+ 	until r = q;
+ 	txx := mem[q + 5].int;
+ 	txy := mem[q + 7].int;
+ 	tyx := mem[q + 9].int;
+ 	tyy := mem[q + 11].int;
+ 	tx := mem[q + 1].int;
+ 	ty := mem[q + 3].int;
+ 	flushcurexp(0) {:956};
+     10:
+ 	
+     end; {:953} {960:}
+ 
+     procedure setupknowntrans(c: quarterword);
+     begin
+ 	setuptrans(c);
+ 	if curtype <> 16 then begin
+ 	    disperr(-30000, 725);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 726;
+ 		helpline[1] := 727;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    txx := 65536;
+ 	    txy := 0;
+ 	    tyx := 0;
+ 	    tyy := 65536;
+ 	    tx := 0;
+ 	    ty := 0
+ 	end
+     end; {:960} {961:}
+ 
+     procedure trans(p, q: halfword);
+     var
+ 	v: scaled;
+     begin
+ 	v := (takescaled(mem[p].int, txx) + takescaled(mem[q].int, txy)) + tx;
+ 	mem[q].int := (takescaled(mem[p].int, tyx) + takescaled(mem[q].int, tyy)) + ty;
+ 	mem[p].int := v
+     end; {:961} {962:}
+ 
+     procedure pathtrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     var
+ 	q: halfword;
+     begin
+ 	setupknowntrans(c);
+ 	unstashcurexp(p);
+ 	if curtype = 6 then begin
+ 	    if mem[curexp + 9].int = 0 then 
+ 		if tx = 0 then 
+ 		    if ty = 0 then 
+ 			goto 10;
+ 	    flushcurexp(makepath(curexp));
+ 	    curtype := 8
+ 	end;
+ 	q := curexp;
+ 	repeat
+ 	    if mem[q].hh.b0 <> 0 then 
+ 		trans(q + 3, q + 4);
+ 	    trans(q + 1, q + 2);
+ 	    if mem[q].hh.b1 <> 0 then 
+ 		trans(q + 5, q + 6);
+ 	    q := mem[q].hh.rh
+ 	until q = curexp;
+     10:
+ 	
+     end; {:962} {963:}
+ 
+     procedure edgestrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     begin
+ 	setupknowntrans(c);
+ 	unstashcurexp(p);
+ 	curedges := curexp;
+ 	if mem[curedges].hh.rh = curedges then 
+ 	    goto 10;
+ 	if txx = 0 then 
+ 	    if tyy = 0 then 
+ 		if (txy mod 65536) = 0 then 
+ 		    if (tyx mod 65536) = 0 then begin
+ 			xyswapedges;
+ 			txx := txy;
+ 			tyy := tyx;
+ 			txy := 0;
+ 			tyx := 0;
+ 			if mem[curedges].hh.rh = curedges then 
+ 			    goto 10
+ 		    end;
+ 	if txy = 0 then 
+ 	    if tyx = 0 then 
+ 		if (txy mod 65536) = 0 then 
+ 		    if (tyy mod 65536) = 0 then begin {964:}
+ 			if (txx = 0) or (tyy = 0) then begin
+ 			    tossedges(curedges);
+ 			    curexp := getnode(6);
+ 			    initedges(curexp)
+ 			end else begin
+ 			    if txx < 0 then begin
+ 				xreflectedges;
+ 				txx := -txx
+ 			    end;
+ 			    if tyy < 0 then begin
+ 				yreflectedges;
+ 				tyy := -tyy
+ 			    end;
+ 			    if txx <> 65536 then 
+ 				xscaleedges(txx div 65536);
+ 			    if tyy <> 65536 then 
+ 				yscaleedges(tyy div 65536); {965:}
+ 			    tx := roundunscaled(tx);
+ 			    ty := roundunscaled(ty);
+ 			    if ((((((mem[curedges + 2].hh.lh + tx) <= 0) or ((mem[curedges + 2].hh.rh + tx) >= 8192)) or ((mem[curedges + 1].hh.lh + ty) <= 0)) or ((mem[curedges + 1].hh.rh + ty) >= 8191)) or (abs(tx) >= 4096)) or (abs(ty) >= 4096) then begin
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(731)
+ 				end;
+ 				begin
+ 				    helpptr := 3;
+ 				    helpline[2] := 732;
+ 				    helpline[1] := 404;
+ 				    helpline[0] := 405
+ 				end;
+ 				putgeterror
+ 			    end else begin
+ 				if tx <> 0 then begin
+ 				    if not (abs((mem[curedges + 3].hh.lh - tx) - 4096) < 4096) then 
+ 					fixoffset;
+ 				    mem[curedges + 2].hh.lh := mem[curedges + 2].hh.lh + tx;
+ 				    mem[curedges + 2].hh.rh := mem[curedges + 2].hh.rh + tx;
+ 				    mem[curedges + 3].hh.lh := mem[curedges + 3].hh.lh - tx;
+ 				    mem[curedges + 4].int := 0
+ 				end;
+ 				if ty <> 0 then begin
+ 				    mem[curedges + 1].hh.lh := mem[curedges + 1].hh.lh + ty;
+ 				    mem[curedges + 1].hh.rh := mem[curedges + 1].hh.rh + ty;
+ 				    mem[curedges + 5].hh.lh := mem[curedges + 5].hh.lh + ty;
+ 				    mem[curedges + 4].int := 0
+ 				end
+ 			    end {:965}
+ 			end;
+ 			goto 10
+ 		    end {:964};
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(728)
+ 	end;
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 729;
+ 	    helpline[1] := 730;
+ 	    helpline[0] := 405
+ 	end;
+ 	putgeterror;
+     10:
+ 	
+     end; {:963} {966:}
+ {968:}
+ 
+     procedure bilin1(p: halfword; t: scaled; q: halfword; u, delta: scaled);
+     var
+ 	r: halfword;
+     begin
+ 	if t <> 65536 then 
+ 	    depmult(p, t, true);
+ 	if u <> 0 then 
+ 	    if mem[q].hh.b0 = 16 then 
+ 		delta := delta + takescaled(mem[q + 1].int, u)
+ 	    else begin {969:}
+ 		if mem[p].hh.b0 <> 18 then begin
+ 		    if mem[p].hh.b0 = 16 then 
+ 			newdep(p, constdependency(mem[p + 1].int))
+ 		    else 
+ 			mem[p + 1].hh.rh := ptimesv(mem[p + 1].hh.rh, 65536, 17, 18, true);
+ 		    mem[p].hh.b0 := 18
+ 		end {:969};
+ 		mem[p + 1].hh.rh := pplusfq(mem[p + 1].hh.rh, u, mem[q + 1].hh.rh, 18, mem[q].hh.b0)
+ 	    end;
+ 	if mem[p].hh.b0 = 16 then 
+ 	    mem[p + 1].int := mem[p + 1].int + delta
+ 	else begin
+ 	    r := mem[p + 1].hh.rh;
+ 	    while mem[r].hh.lh <> (-30000) do 
+ 		r := mem[r].hh.rh;
+ 	    delta := mem[r + 1].int + delta;
+ 	    if r <> mem[p + 1].hh.rh then 
+ 		mem[r + 1].int := delta
+ 	    else begin
+ 		recyclevalue(p);
+ 		mem[p].hh.b0 := 16;
+ 		mem[p + 1].int := delta
+ 	    end
+ 	end;
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:968} {971:}
+ 
+     procedure addmultdep(p: halfword; v: scaled; r: halfword);
+     begin
+ 	if mem[r].hh.b0 = 16 then 
+ 	    mem[depfinal + 1].int := mem[depfinal + 1].int + takescaled(mem[r + 1].int, v)
+ 	else begin
+ 	    mem[p + 1].hh.rh := pplusfq(mem[p + 1].hh.rh, v, mem[r + 1].hh.rh, 18, mem[r].hh.b0);
+ 	    if fixneeded then 
+ 		fixdependencies
+ 	end
+     end; {:971} {972:}
+ 
+     procedure bilin2(p, t: halfword; v: scaled; u, q: halfword);
+     var
+ 	vv: scaled;
+     begin
+ 	vv := mem[p + 1].int;
+ 	mem[p].hh.b0 := 18;
+ 	newdep(p, constdependency(0));
+ 	if vv <> 0 then 
+ 	    addmultdep(p, vv, t);
+ 	if v <> 0 then 
+ 	    addmultdep(p, v, u);
+ 	if q <> (-30000) then 
+ 	    addmultdep(p, 65536, q);
+ 	if mem[p + 1].hh.rh = depfinal then begin
+ 	    vv := mem[depfinal + 1].int;
+ 	    recyclevalue(p);
+ 	    mem[p].hh.b0 := 16;
+ 	    mem[p + 1].int := vv
+ 	end
+     end; {:972} {974:}
+ 
+     procedure bilin3(p: halfword; t, v, u, delta: scaled);
+     begin
+ 	if t <> 65536 then 
+ 	    delta := delta + takescaled(mem[p + 1].int, t)
+ 	else 
+ 	    delta := delta + mem[p + 1].int;
+ 	if u <> 0 then 
+ 	    mem[p + 1].int := delta + takescaled(v, u)
+ 	else 
+ 	    mem[p + 1].int := delta
+     end; {:974}
+ 
+     procedure bigtrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     var
+ 	q, r, pp, qq: halfword;
+ 	s: smallnumber;
+     begin
+ 	s := bignodesize[mem[p].hh.b0];
+ 	q := mem[p + 1].int;
+ 	r := q + s;
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 <> 16 then begin {967:}
+ 		setupknowntrans(c);
+ 		makeexpcopy(p);
+ 		r := mem[curexp + 1].int;
+ 		if curtype = 13 then begin
+ 		    bilin1(r + 10, tyy, q + 6, tyx, 0);
+ 		    bilin1(r + 8, tyy, q + 4, tyx, 0);
+ 		    bilin1(r + 6, txx, q + 10, txy, 0);
+ 		    bilin1(r + 4, txx, q + 8, txy, 0)
+ 		end;
+ 		bilin1(r + 2, tyy, q, tyx, ty);
+ 		bilin1(r, txx, q + 2, txy, tx);
+ 		goto 10
+ 	    end {:967}
+ 	until r = q; {970:}
+ 	setuptrans(c);
+ 	if curtype = 16 then begin {973:}
+ 	    makeexpcopy(p);
+ 	    r := mem[curexp + 1].int;
+ 	    if curtype = 13 then begin
+ 		bilin3(r + 10, tyy, mem[q + 7].int, tyx, 0);
+ 		bilin3(r + 8, tyy, mem[q + 5].int, tyx, 0);
+ 		bilin3(r + 6, txx, mem[q + 11].int, txy, 0);
+ 		bilin3(r + 4, txx, mem[q + 9].int, txy, 0)
+ 	    end;
+ 	    bilin3(r + 2, tyy, mem[q + 1].int, tyx, ty);
+ 	    bilin3(r, txx, mem[q + 3].int, txy, tx)
+ 	end else begin {:973}
+ 	    pp := stashcurexp;
+ 	    qq := mem[pp + 1].int;
+ 	    makeexpcopy(p);
+ 	    r := mem[curexp + 1].int;
+ 	    if curtype = 13 then begin
+ 		bilin2(r + 10, qq + 10, mem[q + 7].int, qq + 8, -30000);
+ 		bilin2(r + 8, qq + 10, mem[q + 5].int, qq + 8, -30000);
+ 		bilin2(r + 6, qq + 4, mem[q + 11].int, qq + 6, -30000);
+ 		bilin2(r + 4, qq + 4, mem[q + 9].int, qq + 6, -30000)
+ 	    end;
+ 	    bilin2(r + 2, qq + 10, mem[q + 1].int, qq + 8, qq + 2);
+ 	    bilin2(r, qq + 4, mem[q + 3].int, qq + 6, qq);
+ 	    recyclevalue(pp);
+ 	    freenode(pp, 2)
+ 	end;
+ {:970}
+     10:
+ 	
+     end; {:966} {976:}
+ 
+     procedure cat(p: halfword);
+     var
+ 	a, b: strnumber;
+ 	k: poolpointer;
+     begin
+ 	a := mem[p + 1].int;
+ 	b := curexp;
+ 	begin
+ 	    if ((poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])) > maxpoolptr then begin
+ 		if ((poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])) > poolsize then 
+ 		    overflow(129, poolsize - initpoolptr);
+ 		maxpoolptr := (poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])
+ 	    end
+ 	end;
+ 	for k := strstart[a] to strstart[a + 1] - 1 do begin
+ 	    strpool[poolptr] := strpool[k];
+ 	    poolptr := poolptr + 1
+ 	end;
+ 	for k := strstart[b] to strstart[b + 1] - 1 do begin
+ 	    strpool[poolptr] := strpool[k];
+ 	    poolptr := poolptr + 1
+ 	end;
+ 	curexp := makestring;
+ 	begin
+ 	    if strref[b] < 127 then 
+ 		if strref[b] > 1 then 
+ 		    strref[b] := strref[b] - 1
+ 		else 
+ 		    flushstring(b)
+ 	end
+     end; {:976} {977:}
+ 
+     procedure chopstring(p: halfword);
+     var
+ 	a, b: integer;
+ 	l: integer;
+ 	k: integer;
+ 	s: strnumber;
+ 	reversed: boolean;
+     begin
+ 	a := roundunscaled(mem[p + 1].int);
+ 	b := roundunscaled(mem[p + 3].int);
+ 	if a <= b then 
+ 	    reversed := false
+ 	else begin
+ 	    reversed := true;
+ 	    k := a;
+ 	    a := b;
+ 	    b := k
+ 	end;
+ 	s := curexp;
+ 	l := strstart[s + 1] - strstart[s];
+ 	if a < 0 then begin
+ 	    a := 0;
+ 	    if b < 0 then 
+ 		b := 0
+ 	end;
+ 	if b > l then begin
+ 	    b := l;
+ 	    if a > l then 
+ 		a := l
+ 	end;
+ 	begin
+ 	    if ((poolptr + b) - a) > maxpoolptr then begin
+ 		if ((poolptr + b) - a) > poolsize then 
+ 		    overflow(129, poolsize - initpoolptr);
+ 		maxpoolptr := (poolptr + b) - a
+ 	    end
+ 	end;
+ 	if reversed then 
+ 	    for k := (strstart[s] + b) - 1 downto strstart[s] + a do begin
+ 		strpool[poolptr] := strpool[k];
+ 		poolptr := poolptr + 1
+ 	    end
+ 	else 
+ 	    for k := strstart[s] + a to (strstart[s] + b) - 1 do begin
+ 		strpool[poolptr] := strpool[k];
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	curexp := makestring;
+ 	begin
+ 	    if strref[s] < 127 then 
+ 		if strref[s] > 1 then 
+ 		    strref[s] := strref[s] - 1
+ 		else 
+ 		    flushstring(s)
+ 	end
+     end; {:977} {978:}
+ 
+     procedure choppath(p: halfword);
+     var
+ 	q: halfword;
+ 	pp, qq, rr, ss: halfword;
+ 	a, b, k, l: scaled;
+ 	reversed: boolean;
+     begin
+ 	l := pathlength;
+ 	a := mem[p + 1].int;
+ 	b := mem[p + 3].int;
+ 	if a <= b then 
+ 	    reversed := false
+ 	else begin
+ 	    reversed := true;
+ 	    k := a;
+ 	    a := b;
+ 	    b := k
+ 	end; {979:}
+ 	if a < 0 then 
+ 	    if mem[curexp].hh.b0 = 0 then begin
+ 		a := 0;
+ 		if b < 0 then 
+ 		    b := 0
+ 	    end else 
+ 		repeat
+ 		    a := a + l;
+ 		    b := b + l
+ 		until a >= 0;
+ 	if b > l then 
+ 	    if mem[curexp].hh.b0 = 0 then begin
+ 		b := l;
+ 		if a > l then 
+ 		    a := l
+ 	    end else 
+ 		while a >= l do begin
+ 		    a := a - l;
+ 		    b := b - l
+ 		end {:979};
+ 	q := curexp;
+ 	while a >= 65536 do begin
+ 	    q := mem[q].hh.rh;
+ 	    a := a - 65536;
+ 	    b := b - 65536
+ 	end;
+ 	if b = a then begin {981:}
+ 	    if a > 0 then begin
+ 		qq := mem[q].hh.rh;
+ 		splitcubic(q, a * 4096, mem[qq + 1].int, mem[qq + 2].int);
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    pp := copyknot(q);
+ 	    qq := pp
+ 	end else begin {:981} {980:}
+ 	    pp := copyknot(q);
+ 	    qq := pp;
+ 	    repeat
+ 		q := mem[q].hh.rh;
+ 		rr := qq;
+ 		qq := copyknot(q);
+ 		mem[rr].hh.rh := qq;
+ 		b := b - 65536
+ 	    until b <= 0;
+ 	    if a > 0 then begin
+ 		ss := pp;
+ 		pp := mem[pp].hh.rh;
+ 		splitcubic(ss, a * 4096, mem[pp + 1].int, mem[pp + 2].int);
+ 		pp := mem[ss].hh.rh;
+ 		freenode(ss, 7);
+ 		if rr = ss then begin
+ 		    b := makescaled(b, 65536 - a);
+ 		    rr := pp
+ 		end
+ 	    end;
+ 	    if b < 0 then begin
+ 		splitcubic(rr, (b + 65536) * 4096, mem[qq + 1].int, mem[qq + 2].int);
+ 		freenode(qq, 7);
+ 		qq := mem[rr].hh.rh
+ 	    end
+ 	end {:980};
+ 	mem[pp].hh.b0 := 0;
+ 	mem[qq].hh.b1 := 0;
+ 	mem[qq].hh.rh := pp;
+ 	tossknotlist(curexp);
+ 	if reversed then begin
+ 	    curexp := mem[htapypoc(pp)].hh.rh;
+ 	    tossknotlist(pp)
+ 	end else 
+ 	    curexp := pp
+     end; {:978} {982:}
+ 
+     procedure pairvalue(x, y: scaled);
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	flushcurexp(p);
+ 	curtype := 14;
+ 	mem[p].hh.b0 := 14;
+ 	mem[p].hh.b1 := 11;
+ 	initbignode(p);
+ 	p := mem[p + 1].int;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p + 1].int := x;
+ 	mem[p + 2].hh.b0 := 16;
+ 	mem[p + 3].int := y
+     end; { pairvalue }
+ {:982}
+     {984:}
+ 
+     procedure setupoffset(p: halfword);
+     begin
+ 	findoffset(mem[p + 1].int, mem[p + 3].int, curexp);
+ 	pairvalue(curx, cury)
+     end;
+ 
+     procedure setupdirectiontime(p: halfword);
+     begin
+ 	flushcurexp(finddirectiontime(mem[p + 1].int, mem[p + 3].int, curexp))
+     end; {:984} {985:}
+ 
+     procedure findpoint(v: scaled; c: quarterword);
+     var
+ 	p: halfword;
+ 	n: scaled;
+ 	vv: scaled;
+ 	q: halfword;
+     begin
+ 	vv := v;
+ 	p := curexp;
+ 	if mem[p].hh.b0 = 0 then 
+ 	    n := -65536
+ 	else 
+ 	    n := 0;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 65536
+ 	until p = curexp;
+ 	if n = 0 then 
+ 	    v := 0
+ 	else if v < 0 then 
+ 	    if mem[p].hh.b0 = 0 then 
+ 		v := 0
+ 	    else 
+ 		v := (n - 1) - (((-v) - 1) mod n)
+ 	else if v > n then 
+ 	    if mem[p].hh.b0 = 0 then 
+ 		v := n
+ 	    else 
+ 		v := v mod n;
+ 	p := curexp;
+ 	while v >= 65536 do begin
+ 	    p := mem[p].hh.rh;
+ 	    v := v - 65536
+ 	end;
+ 	if v <> 0 then begin {986:}
+ 	    q := mem[p].hh.rh;
+ 	    splitcubic(p, v * 4096, mem[q + 1].int, mem[q + 2].int);
+ 	    p := mem[p].hh.rh
+ 	end {:986}; {987:}
+ 	case c of
+ 	    97:
+ 		pairvalue(mem[p + 1].int, mem[p + 2].int);
+ 	    98:
+ 		if mem[p].hh.b0 = 0 then 
+ 		    pairvalue(mem[p + 1].int, mem[p + 2].int)
+ 		else 
+ 		    pairvalue(mem[p + 3].int, mem[p + 4].int);
+ 	    99:
+ 		if mem[p].hh.b1 = 0 then 
+ 		    pairvalue(mem[p + 1].int, mem[p + 2].int)
+ 		else 
+ 		    pairvalue(mem[p + 5].int, mem[p + 6].int)
+ 	end {:987}
+     end; {:985}
+ 
+     procedure dobinary(p: halfword; c: quarterword);
+     label
+ 	30, 31, 10;
+     var
+ 	q, r, rr: halfword;
+ 	oldp, oldexp: halfword;
+ 	v: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then begin {924:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printexp(p, 0);
+ 	    printchar(41);
+ 	    printop(c);
+ 	    printchar(40);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:924}; {926:}
+ 	if mem[p].hh.b0 in
+ 	    [13, 14, 19] then
+ 	    case mem[p].hh.b0 of
+ 		13, 14:
+ 		    oldp := tarnished(p);
+ 		19:
+ 		    oldp := -29999
+ 	    end
+ 	else
+ 	    oldp := -30000;
+ 	if oldp <> (-30000) then begin
+ 	    q := stashcurexp;
+ 	    oldp := p;
+ 	    makeexpcopy(oldp);
+ 	    p := stashcurexp;
+ 	    unstashcurexp(q)
+ 	end; {:926}
+ {927:}
+ 	if curtype in
+ 	    [13, 14, 19] then
+ 	    case curtype of
+ 		13, 14:
+ 		    oldexp := tarnished(curexp);
+ 		19:
+ 		    oldexp := -29999
+ 	    end
+ 	else
+ 	    oldexp := -30000;
+ 	if oldexp <> (-30000) then begin
+ 	    oldexp := curexp;
+ 	    makeexpcopy(oldexp)
+ 	end {:927};
+ 	case c of
+ 	    69, 70: {929:}
+ 		if (curtype < 14) or (mem[p].hh.b0 < 14) then 
+ 		    if (curtype = 11) and (mem[p].hh.b0 = 11) then begin
+ 			if c = 70 then 
+ 			    negateedges(curexp);
+ 			curedges := curexp;
+ 			mergeedges(mem[p + 1].int)
+ 		    end else 
+ 			badbinary(p, c)
+ 		else if curtype = 14 then 
+ 		    if mem[p].hh.b0 <> 14 then 
+ 			badbinary(p, c)
+ 		    else begin
+ 			q := mem[p + 1].int;
+ 			r := mem[curexp + 1].int;
+ 			addorsubtract(q, r, c);
+ 			addorsubtract(q + 2, r + 2, c)
+ 		    end
+ 		else if mem[p].hh.b0 = 14 then 
+ 		    badbinary(p, c)
+ 		else 
+ 		    addorsubtract(p, -30000, c) {:929}; {936:}
+ 	    77, 78, 79, 80, 81, 82:
+ 		begin
+ 		    if (curtype > 14) and (mem[p].hh.b0 > 14) then 
+ 			addorsubtract(p, -30000, 70)
+ 		    else if curtype <> mem[p].hh.b0 then begin
+ 			badbinary(p, c);
+ 			goto 30
+ 		    end else if curtype = 4 then 
+ 			flushcurexp(strvsstr(mem[p + 1].int, curexp))
+ 		    else if (curtype = 5) or (curtype = 3) then begin {938:}
+ 			q := mem[curexp + 1].int;
+ 			while (q <> curexp) and (q <> p) do 
+ 			    q := mem[q + 1].int;
+ 			if q = p then 
+ 			    flushcurexp(0)
+ 		    end else if (curtype = 14) or (curtype = 13) then begin {:938} {939:}
+ 			q := mem[p + 1].int;
+ 			r := mem[curexp + 1].int;
+ 			rr := (r + bignodesize[curtype]) - 2;
+ 			while true do begin
+ 			    addorsubtract(q, r, 70);
+ 			    if mem[r].hh.b0 <> 16 then 
+ 				goto 31;
+ 			    if mem[r + 1].int <> 0 then 
+ 				goto 31;
+ 			    if r = rr then 
+ 				goto 31;
+ 			    q := q + 2;
+ 			    r := r + 2
+ 			end;
+     31:
+ 			takepart(53 + ((r - mem[curexp + 1].int) div 2))
+ 		    end else if curtype = 2 then  {:939}
+ 			flushcurexp(curexp - mem[p + 1].int)
+ 		    else begin
+ 			badbinary(p, c);
+ 			goto 30
+ 		    end; {937:}
+ 		    if curtype <> 16 then begin
+ 			if curtype < 16 then begin
+ 			    disperr(p, 155);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 715
+ 			    end
+ 			end else begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 716;
+ 			    helpline[0] := 717
+ 			end;
+ 			disperr(-30000, 718);
+ 			putgetflusherror(31)
+ 		    end else 
+ 			case c of
+ 			    77:
+ 				if curexp < 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    78:
+ 				if curexp <= 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    79:
+ 				if curexp > 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    80:
+ 				if curexp >= 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    81:
+ 				if curexp = 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    82:
+ 				if curexp <> 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31
+ 			end;
+ 		    curtype := 2 {:937};
+     30:
+ 		    
+ 		end; {:936} {940:}
+ 	    76, 75:
+ 		if (mem[p].hh.b0 <> 2) or (curtype <> 2) then 
+ 		    badbinary(p, c)
+ 		else if mem[p + 1].int = (c - 45) then 
+ 		    curexp := mem[p + 1].int; {:940} {941:}
+ 	    71:
+ 		if (curtype < 14) or (mem[p].hh.b0 < 14) then 
+ 		    badbinary(p, 71)
+ 		else if (curtype = 16) or (mem[p].hh.b0 = 16) then begin {942:}
+ 		    if mem[p].hh.b0 = 16 then begin
+ 			v := mem[p + 1].int;
+ 			freenode(p, 2)
+ 		    end else begin
+ 			v := curexp;
+ 			unstashcurexp(p)
+ 		    end;
+ 		    if curtype = 16 then 
+ 			curexp := takescaled(curexp, v)
+ 		    else if curtype = 14 then begin
+ 			p := mem[curexp + 1].int;
+ 			depmult(p, v, true);
+ 			depmult(p + 2, v, true)
+ 		    end else 
+ 			depmult(-30000, v, true);
+ 		    goto 10
+ 		end else if (nicepair(p, mem[p].hh.b0) and (curtype > 14)) or (nicepair(curexp, curtype) and (mem[p].hh.b0 > 14)) then begin {:942}
+ 		    hardtimes(p);
+ 		    goto 10
+ 		end else 
+ 		    badbinary(p, 71); {:941} {948:}
+ 	    72:
+ 		if (curtype <> 16) or (mem[p].hh.b0 < 14) then 
+ 		    badbinary(p, 72)
+ 		else begin
+ 		    v := curexp;
+ 		    unstashcurexp(p);
+ 		    if v = 0 then begin {950:}
+ 			disperr(-30000, 648);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 720;
+ 			    helpline[0] := 721
+ 			end;
+ 			putgeterror
+ 		    end else begin {:950}
+ 			if curtype = 16 then 
+ 			    curexp := makescaled(curexp, v)
+ 			else if curtype = 14 then begin
+ 			    p := mem[curexp + 1].int;
+ 			    depdiv(p, v);
+ 			    depdiv(p + 2, v)
+ 			end else 
+ 			    depdiv(-30000, v)
+ 		    end;
+ 		    goto 10
+ 		end; {:948} {951:}
+ 	    73, 74:
+ 		if (curtype = 16) and (mem[p].hh.b0 = 16) then 
+ 		    if c = 73 then 
+ 			curexp := pythadd(mem[p + 1].int, curexp)
+ 		    else 
+ 			curexp := pythsub(mem[p + 1].int, curexp)
+ 		else 
+ 		    badbinary(p, c); {:951} {952:}
+ 	    84, 85, 86, 87, 88, 89, 90,
+ 	    91:
+ 		if ((mem[p].hh.b0 = 9) or (mem[p].hh.b0 = 8)) or (mem[p].hh.b0 = 6) then begin
+ 		    pathtrans(p, c);
+ 		    goto 10
+ 		end else if (mem[p].hh.b0 = 14) or (mem[p].hh.b0 = 13) then 
+ 		    bigtrans(p, c)
+ 		else if mem[p].hh.b0 = 11 then begin
+ 		    edgestrans(p, c);
+ 		    goto 10
+ 		end else 
+ 		    badbinary(p, c); {:952} {975:}
+ 	    83:
+ 		if (curtype = 4) and (mem[p].hh.b0 = 4) then 
+ 		    cat(p)
+ 		else 
+ 		    badbinary(p, 83);
+ 	    94:
+ 		if nicepair(p, mem[p].hh.b0) and (curtype = 4) then 
+ 		    chopstring(mem[p + 1].int)
+ 		else 
+ 		    badbinary(p, 94);
+ 	    95:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if nicepair(p, mem[p].hh.b0) and (curtype = 9) then 
+ 			choppath(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 95)
+ 		end; {:975} {983:}
+ 	    97, 98, 99:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and (mem[p].hh.b0 = 16) then 
+ 			findpoint(mem[p + 1].int, c)
+ 		    else 
+ 			badbinary(p, c)
+ 		end;
+ 	    100:
+ 		begin
+ 		    if curtype = 8 then 
+ 			materializepen;
+ 		    if (curtype = 6) and nicepair(p, mem[p].hh.b0) then 
+ 			setupoffset(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 100)
+ 		end;
+ 	    96:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and nicepair(p, mem[p].hh.b0) then 
+ 			setupdirectiontime(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 96)
+ 		end; {:983} {988:}
+ 	    92:
+ 		begin
+ 		    if mem[p].hh.b0 = 14 then begin
+ 			q := stashcurexp;
+ 			unstashcurexp(p);
+ 			pairtopath;
+ 			p := stashcurexp;
+ 			unstashcurexp(q)
+ 		    end;
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and (mem[p].hh.b0 = 9) then begin
+ 			pathintersection(mem[p + 1].int, curexp);
+ 			pairvalue(curt, curtt)
+ 		    end else 
+ 			badbinary(p, 92)
+ 		end
+ 	end {:988};
+ 	recyclevalue(p);
+ 	freenode(p, 2);
+     10:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end; {925:}
+ 	if oldp <> (-30000) then begin
+ 	    recyclevalue(oldp);
+ 	    freenode(oldp, 2)
+ 	end;
+ 	if oldexp <> (-30000) then begin
+ 	    recyclevalue(oldexp);
+ 	    freenode(oldexp, 2)
+ 	end {:925}
+     end; {:922} {944:}
+ 
+     procedure fracmult(n, d: scaled);
+     var
+ 	p: halfword;
+ 	oldexp: halfword;
+ 	v: fraction;
+     begin
+ 	if internal[7] > 131072 then begin {945:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printscaled(n);
+ 	    printchar(47);
+ 	    printscaled(d);
+ 	    print(719);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:945};
+ 	if curtype in
+ 	    [13, 14, 19] then
+ 	    case curtype of
+ 		13, 14:
+ 		    oldexp := tarnished(curexp);
+ 		19:
+ 		    oldexp := -29999
+ 	    end
+ 	else
+ 	    oldexp := -30000;
+ 	if oldexp <> (-30000) then begin
+ 	    oldexp := curexp;
+ 	    makeexpcopy(oldexp)
+ 	end;
+ 	v := makefraction(n, d);
+ 	if curtype = 16 then 
+ 	    curexp := takefraction(curexp, v)
+ 	else if curtype = 14 then begin
+ 	    p := mem[curexp + 1].int;
+ 	    depmult(p, v, false);
+ 	    depmult(p + 2, v, false)
+ 	end else 
+ 	    depmult(-30000, v, false);
+ 	if oldexp <> (-30000) then begin
+ 	    recyclevalue(oldexp);
+ 	    freenode(oldexp, 2)
+ 	end
+     end; {:944} {989:} {1155:}
+ 
+     procedure gfswap;
+     begin
+ 	if gflimit = gfbufsize then begin
+ 	    bwritebuf(gffile, gfbuf, 0, halfbuf - 1);
+ 	    gflimit := halfbuf;
+ 	    gfoffset := gfoffset + gfbufsize;
+ 	    gfptr := 0
+ 	end else begin
+ 	    bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1);
+ 	    gflimit := gfbufsize
+ 	end
+     end; {:1155} {1157:}
+ 
+     procedure gffour(x: integer);
+     begin
+ 	if x >= 0 then begin
+ 	    gfbuf[gfptr] := x div 16777216;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end else begin
+ 	    x := x + 1073741824;
+ 	    x := x + 1073741824;
+ 	    begin
+ 		gfbuf[gfptr] := (x div 16777216) + 128;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end;
+ 	x := x mod 16777216;
+ 	begin
+ 	    gfbuf[gfptr] := x div 65536;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	x := x mod 65536;
+ 	begin
+ 	    gfbuf[gfptr] := x div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end; {:1157} {1158:}
+ 
+     procedure gftwo(x: integer);
+     begin
+ 	begin
+ 	    gfbuf[gfptr] := x div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end;
+ 
+     procedure gfthree(x: integer);
+     begin
+ 	begin
+ 	    gfbuf[gfptr] := x div 65536;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := (x mod 65536) div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end; {:1158} {1159:}
+ 
+     procedure gfpaint(d: integer);
+     begin
+ 	if d < 64 then begin
+ 	    gfbuf[gfptr] := 0 + d;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end else if d < 256 then begin
+ 	    begin
+ 		gfbuf[gfptr] := 64;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end;
+ 	    begin
+ 		gfbuf[gfptr] := d;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end else begin
+ 	    begin
+ 		gfbuf[gfptr] := 65;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end;
+ 	    gftwo(d)
+ 	end
+     end; {:1159}
+ {1160:}
+ 
+     procedure gfstring(s, t: strnumber);
+     var
+ 	k: poolpointer;
+ 	l: integer;
+     begin
+ 	if s <> 0 then begin
+ 	    l := strstart[s + 1] - strstart[s];
+ 	    if t <> 0 then 
+ 		l := l + (strstart[t + 1] - strstart[t]);
+ 	    if l <= 255 then begin
+ 		begin
+ 		    gfbuf[gfptr] := 239;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		begin
+ 		    gfbuf[gfptr] := l;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end
+ 	    end else begin
+ 		begin
+ 		    gfbuf[gfptr] := 241;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gfthree(l)
+ 	    end;
+ 	    for k := strstart[s] to strstart[s + 1] - 1 do begin
+ 		gfbuf[gfptr] := strpool[k];
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end;
+ 	if t <> 0 then 
+ 	    for k := strstart[t] to strstart[t + 1] - 1 do begin
+ 		gfbuf[gfptr] := strpool[k];
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+     end; {:1160}
+ {1161:}
+ 
+     procedure gfboc(minm, maxm, minn, maxn: integer);
+     label
+ 	10;
+     begin
+ 	if minm < gfminm then 
+ 	    gfminm := minm;
+ 	if maxn > gfmaxn then 
+ 	    gfmaxn := maxn;
+ 	if bocp = (-1) then 
+ 	    if bocc >= 0 then 
+ 		if bocc < 256 then 
+ 		    if (maxm - minm) >= 0 then 
+ 			if (maxm - minm) < 256 then 
+ 			    if maxm >= 0 then 
+ 				if maxm < 256 then 
+ 				    if (maxn - minn) >= 0 then 
+ 					if (maxn - minn) < 256 then 
+ 					    if maxn >= 0 then 
+ 						if maxn < 256 then begin
+ 						    begin
+ 							gfbuf[gfptr] := 68;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := bocc;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxm - minm;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxm;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxn - minn;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxn;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    goto 10
+ 						end;
+ 	begin
+ 	    gfbuf[gfptr] := 67;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	gffour(bocc);
+ 	gffour(bocp);
+ 	gffour(minm);
+ 	gffour(maxm);
+ 	gffour(minn);
+ 	gffour(maxn);
+     10:
+ 	
+     end; {:1161} {1163:}
+ 
+     procedure initgf;
+     var
+ 	k: eightbits;
+ 	t: integer;
+     begin
+ 	gfminm := 4096;
+ 	gfmaxm := -4096;
+ 	gfminn := 4096;
+ 	gfmaxn := -4096;
+ 	for k := 0 to 255 do 
+ 	    charptr[k] := -1; {1164:}
+ 	if internal[27] <= 0 then 
+ 	    gfext := 908
+ 	else begin
+ 	    oldsetting := selector;
+ 	    selector := 5;
+ 	    printchar(46);
+ 	    printint(makescaled(internal[27], 59429463));
+ 	    print(909);
+ 	    gfext := makestring;
+ 	    selector := oldsetting
+ 	end {:1164};
+ 	begin
+ 	    if jobname = 0 then 
+ 		openlogfile;
+ 	    packjobname(gfext);
+ 	    while not bopenout(gffile, nameoffile) do 
+ 		promptfilename(620, gfext);
+ 	    outputfilename := bmakenamestring(gffile)
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := 247;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := 131;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	oldsetting := selector;
+ 	selector := 5;
+ 	print(907);
+ 	printint(roundunscaled(internal[14]));
+ 	printchar(46);
+ 	printdd(roundunscaled(internal[15]));
+ 	printchar(46);
+ 	printdd(roundunscaled(internal[16]));
+ 	printchar(58);
+ 	t := roundunscaled(internal[17]);
+ 	printdd(t div 60);
+ 	printdd(t mod 60);
+ 	selector := oldsetting;
+ 	begin
+ 	    gfbuf[gfptr] := poolptr - strstart[strptr];
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	strstart[strptr + 1] := poolptr;
+ 	gfstring(0, strptr);
+ 	poolptr := strstart[strptr];
+ 	gfprevptr := gfoffset + gfptr
+     end; {:1163} {1165:}
+ 
+     procedure shipout(c: eightbits);
+     label
+ 	30;
+     var
+ 	f: integer;
+ 	prevm, m, mm: integer;
+ 	prevn, n: integer;
+ 	p, q: halfword;
+ 	prevw, w, ww: integer;
+ 	d: integer;
+ 	delta: integer;
+ 	curminm: integer;
+ 	xoff, yoff: integer;
+     begin
+ 	if outputfilename = 0 then 
+ 	    initgf;
+ 	f := roundunscaled(internal[19]);
+ 	xoff := roundunscaled(internal[29]);
+ 	yoff := roundunscaled(internal[30]);
+ 	if termoffset > (maxprintline - 9) then 
+ 	    println
+ 	else if (termoffset > 0) or (fileoffset > 0) then 
+ 	    printchar(32);
+ 	printchar(91);
+ 	printint(c);
+ 	if f <> 0 then begin
+ 	    printchar(46);
+ 	    printint(f)
+ 	end;
+ 	flush(output);
+ 	bocc := (256 * f) + c;
+ 	bocp := charptr[c];
+ 	charptr[c] := gfprevptr;
+ 	if internal[34] > 0 then begin {1166:}
+ 	    if xoff <> 0 then begin
+ 		gfstring(308, 0);
+ 		begin
+ 		    gfbuf[gfptr] := 243;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(xoff * 65536)
+ 	    end;
+ 	    if yoff <> 0 then begin
+ 		gfstring(309, 0);
+ 		begin
+ 		    gfbuf[gfptr] := 243;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(yoff * 65536)
+ 	    end
+ 	end {:1166}; {1167:}
+ 	prevn := 4096;
+ 	p := mem[curedges].hh.lh;
+ 	n := mem[curedges + 1].hh.rh - 4096;
+ 	while p <> curedges do begin {1169:}
+ 	    if mem[p + 1].hh.lh > (-29999) then 
+ 		sortedges(p);
+ 	    q := mem[p + 1].hh.rh;
+ 	    w := 0;
+ 	    prevm := -268435456;
+ 	    ww := 0;
+ 	    prevw := 0;
+ 	    m := prevm;
+ 	    repeat
+ 		if q = 30000 then 
+ 		    mm := 268435456
+ 		else begin
+ 		    d := mem[q].hh.lh + 32768;
+ 		    mm := d div 8;
+ 		    ww := (ww + (d mod 8)) - 4
+ 		end;
+ 		if mm <> m then begin
+ 		    if prevw <= 0 then begin
+ 			if w > 0 then begin {1170:}
+ 			    if prevm = (-268435456) then begin {1172:}
+ 				if prevn = 4096 then begin
+ 				    gfboc((mem[curedges + 2].hh.lh + xoff) - 4096, (mem[curedges + 2].hh.rh + xoff) - 4096, (mem[curedges + 1].hh.lh + yoff) - 4096, n + yoff);
+ 				    curminm := (mem[curedges + 2].hh.lh - 4096) + mem[curedges + 3].hh.lh
+ 				end else if prevn > (n + 1) then begin {1174:}
+ 				    delta := (prevn - n) - 1;
+ 				    if delta < 256 then 
+ 					if delta = 0 then begin
+ 					    gfbuf[gfptr] := 70;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end else begin
+ 					    begin
+ 						gfbuf[gfptr] := 71;
+ 						gfptr := gfptr + 1;
+ 						if gfptr = gflimit then 
+ 						    gfswap
+ 					    end;
+ 					    begin
+ 						gfbuf[gfptr] := delta;
+ 						gfptr := gfptr + 1;
+ 						if gfptr = gflimit then 
+ 						    gfswap
+ 					    end
+ 					end
+ 				    else begin
+ 					begin
+ 					    gfbuf[gfptr] := 72;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end;
+ 					gftwo(delta)
+ 				    end
+ 				end else begin {:1174} {1173:}
+ 				    delta := m - curminm;
+ 				    if delta > 164 then begin
+ 					gfbuf[gfptr] := 70;
+ 					gfptr := gfptr + 1;
+ 					if gfptr = gflimit then 
+ 					    gfswap
+ 				    end else begin
+ 					begin
+ 					    gfbuf[gfptr] := 74 + delta;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end;
+ 					goto 30
+ 				    end
+ 				end {:1173};
+ 				gfpaint(m - curminm);
+     30:
+ 				prevn := n
+ 			    end else  {:1172}
+ 				gfpaint(m - prevm);
+ 			    prevm := m;
+ 			    prevw := w
+ 			end {:1170}
+ 		    end else if w <= 0 then begin {1171:}
+ 			gfpaint(m - prevm);
+ 			prevm := m;
+ 			prevw := w
+ 		    end {:1171};
+ 		    m := mm
+ 		end;
+ 		w := ww;
+ 		q := mem[q].hh.rh
+ 	    until mm = 268435456;
+ 	    if w <> 0 then 
+ 		printnl(911);
+ 	    if ((prevm - mem[curedges + 3].hh.lh) + xoff) > gfmaxm then 
+ 		gfmaxm := (prevm - mem[curedges + 3].hh.lh) + xoff {:1169};
+ 	    p := mem[p].hh.lh;
+ 	    n := n - 1
+ 	end;
+ 	if prevn = 4096 then begin {1168:}
+ 	    gfboc(0, 0, 0, 0);
+ 	    if gfmaxm < 0 then 
+ 		gfmaxm := 0;
+ 	    if gfminn > 0 then 
+ 		gfminn := 0
+ 	end else if (prevn + yoff) < gfminn then  {:1168}
+ 	    gfminn := prevn + yoff {:1167};
+ 	begin
+ 	    gfbuf[gfptr] := 69;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	gfprevptr := gfoffset + gfptr;
+ 	totalchars := totalchars + 1;
+ 	printchar(93);
+ 	flush(output);
+ 	if internal[11] > 0 then 
+ 	    printedges(910, true, xoff, yoff)
+     end; { shipout }
+ {:1165}
+     {995:}
+     {1006:}
+ 
+     procedure tryeq(l, r: halfword);
+     label
+ 	30, 31;
+     var
+ 	p: halfword;
+ 	t: 16..19;
+ 	q: halfword;
+ 	pp: halfword;
+ 	tt: 17..19;
+ 	copied: boolean; {1007:}
+     begin
+ 	t := mem[l].hh.b0;
+ 	if t = 16 then begin
+ 	    t := 17;
+ 	    p := constdependency(-mem[l + 1].int);
+ 	    q := p
+ 	end else if t = 19 then begin
+ 	    t := 17;
+ 	    p := singledependency(l);
+ 	    mem[p + 1].int := -mem[p + 1].int;
+ 	    q := depfinal
+ 	end else begin
+ 	    p := mem[l + 1].hh.rh;
+ 	    q := p;
+ 	    while true do begin
+ 		mem[q + 1].int := -mem[q + 1].int;
+ 		if mem[q].hh.lh = (-30000) then 
+ 		    goto 30;
+ 		q := mem[q].hh.rh
+ 	    end;
+     30:
+ 	    mem[mem[l + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 	    mem[mem[q].hh.rh + 1].hh.lh := mem[l + 1].hh.lh;
+ 	    mem[l].hh.b0 := 16
+ 	end {:1007};
+ {1009:}
+ 	if r = (-30000) then 
+ 	    if curtype = 16 then begin
+ 		mem[q + 1].int := mem[q + 1].int + curexp;
+ 		goto 31
+ 	    end else begin
+ 		tt := curtype;
+ 		if tt = 19 then 
+ 		    pp := singledependency(curexp)
+ 		else 
+ 		    pp := mem[curexp + 1].hh.rh
+ 	    end
+ 	else if mem[r].hh.b0 = 16 then begin
+ 	    mem[q + 1].int := mem[q + 1].int + mem[r + 1].int;
+ 	    goto 31
+ 	end else begin
+ 	    tt := mem[r].hh.b0;
+ 	    if tt = 19 then 
+ 		pp := singledependency(r)
+ 	    else 
+ 		pp := mem[r + 1].hh.rh
+ 	end;
+ 	if tt <> 19 then 
+ 	    copied := false
+ 	else begin
+ 	    copied := true;
+ 	    tt := 17
+ 	end; {1010:}
+ 	watchcoefs := false;
+ 	if t = tt then 
+ 	    p := pplusq(p, pp, t)
+ 	else if t = 18 then 
+ 	    p := pplusfq(p, 65536, pp, 18, 17)
+ 	else begin
+ 	    q := p;
+ 	    while mem[q].hh.lh <> (-30000) do begin
+ 		mem[q + 1].int := roundfraction(mem[q + 1].int);
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    t := 18;
+ 	    p := pplusq(p, pp, t)
+ 	end;
+ 	watchcoefs := true;
+ {:1010}
+ 	if copied then 
+ 	    flushnodelist(pp);
+     31: {:1009}
+ 	;
+ 	if mem[p].hh.lh = (-30000) then begin {1008:}
+ 	    if abs(mem[p + 1].int) > 64 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(761)
+ 		end;
+ 		print(763);
+ 		printscaled(mem[p + 1].int);
+ 		printchar(41);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 762;
+ 		    helpline[0] := 760
+ 		end;
+ 		putgeterror
+ 	    end else if r = (-30000) then begin {623:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(465)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 466;
+ 		    helpline[0] := 467
+ 		end;
+ 		putgeterror
+ 	    end {:623};
+ 	    freenode(p, 2)
+ 	end else begin {:1008}
+ 	    lineareq(p, t);
+ 	    if r = (-30000) then 
+ 		if curtype <> 16 then 
+ 		    if mem[curexp].hh.b0 = 16 then begin
+ 			pp := curexp;
+ 			curexp := mem[curexp + 1].int;
+ 			curtype := 16;
+ 			freenode(pp, 2)
+ 		    end
+ 	end
+     end; {:1006} {1001:}
+ 
+     procedure makeeq(lhs: halfword);
+     label
+ 	20, 30, 45;
+     var
+ 	t: smallnumber;
+ 	v: integer;
+ 	p, q: halfword;
+     begin
+     20:
+ 	t := mem[lhs].hh.b0;
+ 	if t <= 14 then 
+ 	    v := mem[lhs + 1].int;
+ 	case t of {1003:}
+ 	    2, 4, 6, 9, 11:
+ 		if curtype = (t + 1) then begin
+ 		    nonlineareq(v, curexp, false);
+ 		    goto 30
+ 		end else if curtype = t then begin {1004:}
+ 		    if curtype <= 4 then begin
+ 			if curtype = 4 then begin
+ 			    if strvsstr(v, curexp) <> 0 then 
+ 				goto 45
+ 			end else if v <> curexp then 
+ 			    goto 45; {623:}
+ 			begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(465)
+ 			    end;
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 466;
+ 				helpline[0] := 467
+ 			    end;
+ 			    putgeterror
+ 			end {:623};
+ 			goto 30
+ 		    end;
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(758)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 759;
+ 			helpline[0] := 760
+ 		    end;
+ 		    putgeterror;
+ 		    goto 30;
+     45:
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(761)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 762;
+ 			helpline[0] := 760
+ 		    end;
+ 		    putgeterror;
+ 		    goto 30
+ 		end {:1004};
+ 	    3, 5, 7, 12, 10:
+ 		if curtype = (t - 1) then begin
+ 		    nonlineareq(curexp, lhs, true);
+ 		    goto 30
+ 		end else if curtype = t then begin
+ 		    ringmerge(lhs, curexp);
+ 		    goto 30
+ 		end else if curtype = 14 then 
+ 		    if t = 10 then begin
+ 			pairtopath;
+ 			goto 20
+ 		    end;
+ 	    13, 14:
+ 		if curtype = t then begin {1005:}
+ 		    p := v + bignodesize[t];
+ 		    q := mem[curexp + 1].int + bignodesize[t];
+ 		    repeat
+ 			p := p - 2;
+ 			q := q - 2;
+ 			tryeq(p, q)
+ 		    until p = v;
+ 		    goto 30
+ 		end {:1005};
+ 	    16, 17, 18, 19:
+ 		if curtype >= 16 then begin
+ 		    tryeq(lhs, -30000);
+ 		    goto 30
+ 		end;
+ 	    1:
+ 		
+ 	end
+ {:1003}; {1002:}
+ 	disperr(lhs, 155);
+ 	disperr(-30000, 755);
+ 	if mem[lhs].hh.b0 <= 14 then 
+ 	    printtype(mem[lhs].hh.b0)
+ 	else 
+ 	    print(211);
+ 	printchar(61);
+ 	if curtype <= 14 then 
+ 	    printtype(curtype)
+ 	else 
+ 	    print(211);
+ 	printchar(41);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 756;
+ 	    helpline[0] := 757
+ 	end; {:1002}
+ 	putgeterror;
+     30:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	recyclevalue(lhs);
+ 	freenode(lhs, 2)
+     end; {:1001}
+ 
+     procedure doassignment;
+     forward;
+ 
+     procedure doequation;
+     var
+ 	lhs: halfword;
+ 	p: halfword;
+     begin
+ 	lhs := stashcurexp;
+ 	getxnext;
+ 	varflag := 77;
+ 	scanexpression;
+ 	if curcmd = 51 then 
+ 	    doequation
+ 	else if curcmd = 77 then 
+ 	    doassignment;
+ 	if internal[7] > 131072 then begin {997:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printexp(lhs, 0);
+ 	    print(750);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:997};
+ 	if curtype = 10 then 
+ 	    if mem[lhs].hh.b0 = 14 then begin
+ 		p := stashcurexp;
+ 		unstashcurexp(lhs);
+ 		lhs := p
+ 	    end;
+ 	makeeq(lhs)
+     end; {:995} {996:}
+ 
+     procedure doassignment;
+     var
+ 	lhs: halfword;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	if curtype <> 20 then begin
+ 	    disperr(-30000, 747);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 748;
+ 		helpline[0] := 749
+ 	    end;
+ 	    error;
+ 	    doequation
+ 	end else begin
+ 	    lhs := curexp;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    varflag := 77;
+ 	    scanexpression;
+ 	    if curcmd = 51 then 
+ 		doequation
+ 	    else if curcmd = 77 then 
+ 		doassignment;
+ 	    if internal[7] > 131072 then begin {998:}
+ 		begindiagnostic;
+ 		printnl(123);
+ 		if mem[lhs].hh.lh > 2241 then 
+ 		    print(intname[mem[lhs].hh.lh - 2241])
+ 		else 
+ 		    showtokenlist(lhs, -30000, 1000, 0);
+ 		print(329);
+ 		printexp(-30000, 0);
+ 		printchar(125);
+ 		enddiagnostic(false)
+ 	    end {:998};
+ 	    if mem[lhs].hh.lh > 2241 then  {999:}
+ 		if curtype = 16 then 
+ 		    internal[mem[lhs].hh.lh - 2241] := curexp
+ 		else begin
+ 		    disperr(-30000, 751);
+ 		    print(intname[mem[lhs].hh.lh - 2241]);
+ 		    print(752);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 753;
+ 			helpline[0] := 754
+ 		    end;
+ 		    putgeterror
+ 		end {:999} {1000:}
+ 	    else begin
+ 		p := findvariable(lhs);
+ 		if p <> (-30000) then begin
+ 		    q := stashcurexp;
+ 		    curtype := undtype(p);
+ 		    recyclevalue(p);
+ 		    mem[p].hh.b0 := curtype;
+ 		    mem[p + 1].int := -30000;
+ 		    makeexpcopy(p);
+ 		    p := stashcurexp;
+ 		    unstashcurexp(q);
+ 		    makeeq(p)
+ 		end else begin
+ 		    obliterated(lhs);
+ 		    putgeterror
+ 		end
+ 	    end {:1000};
+ 	    flushnodelist(lhs)
+ 	end
+     end; {:996} {1015:}
+ 
+     procedure dotypedeclaration;
+     var
+ 	t: smallnumber;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	if curmod >= 13 then 
+ 	    t := curmod
+ 	else 
+ 	    t := curmod + 1;
+ 	repeat
+ 	    p := scandeclaredvariable;
+ 	    flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, false);
+ 	    q := findvariable(p);
+ 	    if q <> (-30000) then begin
+ 		mem[q].hh.b0 := t;
+ 		mem[q + 1].int := -30000
+ 	    end else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(764)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 765;
+ 		    helpline[0] := 766
+ 		end;
+ 		putgeterror
+ 	    end;
+ 	    flushlist(p);
+ 	    if curcmd < 79 then begin {1016:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(767)
+ 		end;
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 768;
+ 		    helpline[3] := 769;
+ 		    helpline[2] := 770;
+ 		    helpline[1] := 771;
+ 		    helpline[0] := 772
+ 		end;
+ 		if curcmd = 42 then 
+ 		    helpline[2] := 773;
+ 		putgeterror;
+ 		scannerstatus := 2;
+ 		repeat
+ 		    getnext; {743:}
+ 		    if curcmd = 39 then begin
+ 			if strref[curmod] < 127 then 
+ 			    if strref[curmod] > 1 then 
+ 				strref[curmod] := strref[curmod] - 1
+ 			    else 
+ 				flushstring(curmod)
+ 		    end {:743}
+ 		until curcmd >= 79;
+ 		scannerstatus := 0
+ 	    end {:1016}
+ 	until curcmd > 79
+     end; { dotypedeclaration }
+ {:1015}
+     {1021:}
+ 
+     procedure dorandomseed;
+     begin
+ 	getxnext;
+ 	if curcmd <> 77 then begin
+ 	    missingerr(329);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 778
+ 	    end;
+ 	    backerror
+ 	end;
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 16 then begin
+ 	    disperr(-30000, 779);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 780;
+ 		helpline[0] := 781
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {1022:}
+ 	    initrandoms(curexp);
+ 	    if selector >= 2 then begin
+ 		oldsetting := selector;
+ 		selector := 2;
+ 		printnl(782);
+ 		printscaled(curexp);
+ 		printchar(125);
+ 		printnl(155);
+ 		selector := oldsetting
+ 	    end
+ 	end {:1022}
+     end; {:1021} {1029:}
+ 
+     procedure doprotection;
+     var
+ 	m: 0..1;
+ 	t: halfword;
+     begin
+ 	m := curmod;
+ 	repeat
+ 	    getsymbol;
+ 	    t := eqtb[cursym].lh;
+ 	    if m = 0 then begin
+ 		if t >= 83 then 
+ 		    eqtb[cursym].lh := t - 83
+ 	    end else if t < 83 then 
+ 		eqtb[cursym].lh := t + 83;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1029} {1031:}
+ 
+     procedure defdelims;
+     var
+ 	ldelim, rdelim: halfword;
+     begin
+ 	getclearsymbol;
+ 	ldelim := cursym;
+ 	getclearsymbol;
+ 	rdelim := cursym;
+ 	eqtb[ldelim].lh := 31;
+ 	eqtb[ldelim].rh := rdelim;
+ 	eqtb[rdelim].lh := 62;
+ 	eqtb[rdelim].rh := ldelim;
+ 	getxnext
+     end; {:1031} {1034:}
+ 
+     procedure dostatement;
+     forward;
+ 
+     procedure dointerim;
+     begin
+ 	getxnext;
+ 	if curcmd <> 40 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(788)
+ 	    end;
+ 	    if cursym = 0 then 
+ 		print(793)
+ 	    else 
+ 		print(hash[cursym].rh);
+ 	    print(794);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 795
+ 	    end;
+ 	    backerror
+ 	end else begin
+ 	    saveinternal(curmod);
+ 	    backinput
+ 	end;
+ 	dostatement
+     end; { dointerim }
+ {:1034}
+     {1035:}
+ 
+     procedure dolet;
+     var
+ 	l: halfword;
+     begin
+ 	getsymbol;
+ 	l := cursym;
+ 	getxnext;
+ 	if curcmd <> 51 then 
+ 	    if curcmd <> 77 then begin
+ 		missingerr(61);
+ 		begin
+ 		    helpptr := 3;
+ 		    helpline[2] := 796;
+ 		    helpline[1] := 538;
+ 		    helpline[0] := 797
+ 		end;
+ 		backerror
+ 	    end;
+ 	getsymbol;
+ 	if curcmd in
+ 	    [10, 53, 44, 49] then
+ 	    case curcmd of
+ 		10, 53, 44, 49:
+ 		    mem[curmod].hh.lh := mem[curmod].hh.lh + 1
+ 	    end
+ 	else
+ 	    ;
+ 	clearsymbol(l, false);
+ 	eqtb[l].lh := curcmd;
+ 	if curcmd = 41 then 
+ 	    eqtb[l].rh := -30000
+ 	else 
+ 	    eqtb[l].rh := curmod;
+ 	getxnext
+     end; {:1035} {1036:}
+ 
+     procedure donewinternal;
+     begin
+ 	repeat
+ 	    if intptr = maxinternal then 
+ 		overflow(798, maxinternal);
+ 	    getclearsymbol;
+ 	    intptr := intptr + 1;
+ 	    eqtb[cursym].lh := 40;
+ 	    eqtb[cursym].rh := intptr;
+ 	    intname[intptr] := hash[cursym].rh;
+ 	    internal[intptr] := 0;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1036} {1040:}
+ 
+     procedure doshow;
+     begin
+ 	repeat
+ 	    getxnext;
+ 	    scanexpression;
+ 	    printnl(629);
+ 	    printexp(-30000, 2);
+ 	    flushcurexp(0)
+ 	until curcmd <> 79
+     end; {:1040} {1041:}
+ 
+     procedure disptoken;
+     begin
+ 	printnl(804);
+ 	if cursym = 0 then begin {1042:}
+ 	    if curcmd = 42 then 
+ 		printscaled(curmod)
+ 	    else if curcmd = 38 then begin
+ 		gpointer := curmod;
+ 		printcapsule
+ 	    end else begin
+ 		printchar(34);
+ 		print(curmod);
+ 		printchar(34);
+ 		begin
+ 		    if strref[curmod] < 127 then 
+ 			if strref[curmod] > 1 then 
+ 			    strref[curmod] := strref[curmod] - 1
+ 			else 
+ 			    flushstring(curmod)
+ 		end
+ 	    end
+ 	end else begin {:1042}
+ 	    print(hash[cursym].rh);
+ 	    printchar(61);
+ 	    if eqtb[cursym].lh >= 83 then 
+ 		print(805);
+ 	    printcmdmod(curcmd, curmod);
+ 	    if curcmd = 10 then begin
+ 		println;
+ 		showmacro(curmod, -30000, 100000)
+ 	    end
+ 	end
+     end; {:1041} {1044:}
+ 
+     procedure doshowtoken;
+     begin
+ 	repeat
+ 	    getnext;
+ 	    disptoken;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1044} {1045:}
+ 
+     procedure doshowstats;
+     {printint(varused);printchar(38);printint(dynused);
+     if false then}
+     begin
+ 	printnl(814);
+ 	print(228);
+ 	print(425);
+ 	printint((himemmin - lomemmax) - 1);
+ 	print(815);
+ 	println;
+ 	printnl(816);
+ 	printint(strptr - initstrptr);
+ 	printchar(38);
+ 	printint(poolptr - initpoolptr);
+ 	print(425);
+ 	printint(maxstrings - maxstrptr);
+ 	printchar(38);
+ 	printint(poolsize - maxpoolptr);
+ 	print(815);
+ 	println;
+ 	getxnext
+     end; {:1045}
+ {1046:}
+ 
+     procedure dispvar(p: halfword);
+     var
+ 	q: halfword;
+ 	n: 0..maxprintline;
+     begin
+ 	if mem[p].hh.b0 = 21 then begin {1047:}
+ 	    q := mem[p + 1].hh.lh;
+ 	    repeat
+ 		dispvar(q);
+ 		q := mem[q].hh.rh
+ 	    until q = (-29983);
+ 	    q := mem[p + 1].hh.rh;
+ 	    while mem[q].hh.b1 = 3 do begin
+ 		dispvar(q);
+ 		q := mem[q].hh.rh
+ 	    end
+ 	end else if mem[p].hh.b0 >= 22 then begin {:1047} {1048:}
+ 	    printnl(155);
+ 	    printvariablename(p);
+ 	    if mem[p].hh.b0 > 22 then 
+ 		print(530);
+ 	    print(817);
+ 	    if fileoffset >= (maxprintline - 20) then 
+ 		n := 5
+ 	    else 
+ 		n := (maxprintline - fileoffset) - 15;
+ 	    showmacro(mem[p + 1].int, -30000, n)
+ 	end else if mem[p].hh.b0 <> 0 then begin {:1048}
+ 	    printnl(155);
+ 	    printvariablename(p);
+ 	    printchar(61);
+ 	    printexp(p, 0)
+ 	end
+     end; {:1046} {1049:}
+ 
+     procedure doshowvar;
+     label
+ 	30;
+     begin
+ 	repeat
+ 	    getnext;
+ 	    if cursym > 0 then 
+ 		if cursym <= 2241 then 
+ 		    if curcmd = 41 then 
+ 			if curmod <> (-30000) then begin
+ 			    dispvar(curmod);
+ 			    goto 30
+ 			end;
+ 	    disptoken;
+     30:
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1049} {1050:}
+ 
+     procedure doshowdependencies;
+     var
+ 	p: halfword;
+     begin
+ 	p := mem[-29987].hh.rh;
+ 	while p <> (-29987) do begin
+ 	    if interesting(p) then begin
+ 		printnl(155);
+ 		printvariablename(p);
+ 		if mem[p].hh.b0 = 17 then 
+ 		    printchar(61)
+ 		else 
+ 		    print(632);
+ 		printdependency(mem[p + 1].hh.rh, mem[p].hh.b0)
+ 	    end;
+ 	    p := mem[p + 1].hh.rh;
+ 	    while mem[p].hh.lh <> (-30000) do 
+ 		p := mem[p].hh.rh;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	getxnext
+     end; {:1050} {1051:}
+ 
+     procedure doshowwhatever;
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	case curmod of
+ 	    0:
+ 		doshowtoken;
+ 	    1:
+ 		doshowstats;
+ 	    2:
+ 		doshow;
+ 	    3:
+ 		doshowvar;
+ 	    4:
+ 		doshowdependencies
+ 	end;
+ 	if internal[32] > 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(818)
+ 	    end;
+ 	    if interaction < 3 then begin
+ 		helpptr := 0;
+ 		errorcount := errorcount - 1
+ 	    end else begin
+ 		helpptr := 1;
+ 		helpline[0] := 819
+ 	    end;
+ 	    if curcmd = 80 then 
+ 		error
+ 	    else 
+ 		putgeterror
+ 	end
+     end; {:1051} {1054:}
+ 
+     function scanwith: boolean;
+     var
+ 	t: smallnumber;
+ 	result: boolean;
+     begin
+ 	t := curmod;
+ 	curtype := 1;
+ 	getxnext;
+ 	scanexpression;
+ 	result := false;
+ 	if curtype <> t then begin {1055:}
+ 	    disperr(-30000, 827);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 828;
+ 		helpline[0] := 829
+ 	    end;
+ 	    if t = 6 then 
+ 		helpline[1] := 830;
+ 	    putgetflusherror(0)
+ 	end else if curtype = 6 then  {:1055}
+ 	    result := true {1056:}
+ 	else begin
+ 	    curexp := roundunscaled(curexp);
+ 	    if (abs(curexp) < 4) and (curexp <> 0) then 
+ 		result := true
+ 	    else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(831)
+ 		end;
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 829
+ 		end;
+ 		putgetflusherror(0)
+ 	    end
+ 	end {:1056};
+ 	scanwith := result
+     end; {:1054} {1057:}
+ 
+     procedure findedgesvar(t: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	p := findvariable(t);
+ 	curedges := -30000;
+ 	if p = (-30000) then begin
+ 	    obliterated(t);
+ 	    putgeterror
+ 	end else if mem[p].hh.b0 <> 11 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(654)
+ 	    end;
+ 	    showtokenlist(t, -30000, 1000, 0);
+ 	    print(832);
+ 	    printtype(mem[p].hh.b0);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 833;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgeterror
+ 	end else 
+ 	    curedges := mem[p + 1].int;
+ 	flushnodelist(t)
+     end; {:1057} {1059:}
+ 
+     procedure doaddto;
+     label
+ 	30, 45;
+     var
+ 	lhs, rhs: halfword;
+ 	t: smallnumber;
+ 	w: integer;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	getxnext;
+ 	varflag := 68;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    lhs := curexp;
+ 	    curpathtype := curmod;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if curpathtype = 2 then begin {1061:}
+ 		findedgesvar(lhs);
+ 		if curedges = (-30000) then 
+ 		    flushcurexp(0)
+ 		else if curtype <> 11 then begin
+ 		    disperr(-30000, 839);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 840;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end else begin
+ 		    mergeedges(curexp);
+ 		    flushcurexp(0)
+ 		end
+ 	    end else begin {:1061} {1062:}
+ 		if curtype = 14 then 
+ 		    pairtopath;
+ 		if curtype <> 9 then begin
+ 		    disperr(-30000, 839);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 841;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0);
+ 		    flushtokenlist(lhs)
+ 		end else begin
+ 		    rhs := curexp;
+ 		    w := 1;
+ 		    curpen := -29997;
+ 		    {
+ 		    1063:}
+ 		    while curcmd = 66 do 
+ 			if scanwith then 
+ 			    if curtype = 16 then 
+ 				w := curexp
+ 			    else begin
+ 				if mem[curpen].hh.lh = (-30000) then 
+ 				    tosspen(curpen)
+ 				else 
+ 				    mem[curpen].hh.lh := mem[curpen].hh.lh - 1;
+ 				curpen := curexp
+ 			    end {:1063}; {1064:}
+ 		    findedgesvar(lhs);
+ 		    if curedges = (-30000) then 
+ 			tossknotlist(rhs)
+ 		    else begin
+ 			lhs := -30000;
+ 			if mem[rhs].hh.b0 = 0 then 
+ 			    if curpathtype = 0 then  {1065:}
+ 				if mem[rhs].hh.rh = rhs then begin {1066:}
+ 				    mem[rhs + 5].int := mem[rhs + 1].int;
+ 				    mem[rhs + 6].int := mem[rhs + 2].int;
+ 				    mem[rhs + 3].int := mem[rhs + 1].int;
+ 				    mem[rhs + 4].int := mem[rhs + 2].int;
+ 				    mem[rhs].hh.b0 := 1;
+ 				    mem[rhs].hh.b1 := 1
+ 				end else begin {:1066}
+ 				    p := htapypoc(rhs);
+ 				    q := mem[p].hh.rh;
+ 				    mem[pathtail + 5].int := mem[q + 5].int;
+ 				    mem[pathtail + 6].int := mem[q + 6].int;
+ 				    mem[pathtail].hh.b1 := mem[q].hh.b1;
+ 				    mem[pathtail].hh.rh := mem[q].hh.rh;
+ 				    freenode(q, 7);
+ 				    mem[p + 5].int := mem[rhs + 5].int;
+ 				    mem[p + 6].int := mem[rhs + 6].int;
+ 				    mem[p].hh.b1 := mem[rhs].hh.b1;
+ 				    mem[p].hh.rh := mem[rhs].hh.rh;
+ 				    freenode(rhs, 7);
+ 				    rhs := p
+ 				end {:1065} {1067:}
+ 			    else begin
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(842)
+ 				end;
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 843;
+ 				    helpline[0] := 834
+ 				end;
+ 				putgeterror;
+ 				tossknotlist(rhs);
+ 				goto 45
+ 			    end {:1067}
+ 			else if curpathtype = 0 then 
+ 			    lhs := htapypoc(rhs);
+ 			curwt := w;
+ 			rhs := makespec(rhs, mem[curpen + 9].int, internal[5]); {1068:}
+ 			if turningnumber <= 0 then 
+ 			    if curpathtype <> 0 then 
+ 				if internal[39] > 0 then 
+ 				    if (turningnumber < 0) and (mem[curpen].hh.rh = (-30000)) then 
+ 					curwt := -curwt
+ 				    else begin
+ 					if turningnumber = 0 then 
+ 					    if (internal[39] <= 65536) and (mem[curpen].hh.rh = (-30000)) then 
+ 						goto 30
+ 					    else 
+ 						printstrange(844)
+ 					else 
+ 					    printstrange(845);
+ 					begin
+ 					    helpptr := 3;
+ 					    helpline[2] := 846;
+ 					    helpline[1] := 847;
+ 					    helpline[0] := 848
+ 					end;
+ 					putgeterror
+ 				    end;
+     30: {:1068}
+ 			;
+ 			if mem[curpen + 9].int = 0 then 
+ 			    fillspec(rhs)
+ 			else 
+ 			    fillenvelope(rhs);
+ 			if lhs <> (-30000) then begin
+ 			    revturns := true;
+ 			    lhs := makespec(lhs, mem[curpen + 9].int, internal[5]);
+ 			    revturns := false;
+ 			    if mem[curpen + 9].int = 0 then 
+ 				fillspec(lhs)
+ 			    else 
+ 				fillenvelope(lhs)
+ 			end;
+     45: {:1064}
+ 			
+ 		    end;
+ 		    if mem[curpen].hh.lh = (-30000) then 
+ 			tosspen(curpen)
+ 		    else 
+ 			mem[curpen].hh.lh := mem[curpen].hh.lh - 1
+ 		end
+ 	    end {:1062}
+ 	end
+     end; {:1059} {1070:} {1098:}
+ 
+     function tfmcheck(m: smallnumber): scaled;
+     begin
+ 	if abs(internal[m]) >= 134217728 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(865)
+ 	    end;
+ 	    print(intname[m]);
+ 	    print(866);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 867
+ 	    end;
+ 	    putgeterror;
+ 	    if internal[m] > 0 then 
+ 		tfmcheck := 134217727
+ 	    else 
+ 		tfmcheck := -134217727
+ 	end else 
+ 	    tfmcheck := internal[m]
+     end; {:1098}
+ 
+     procedure doshipout;
+     label
+ 	10;
+     var
+ 	c: integer;
+     begin
+ 	getxnext;
+ 	varflag := 80;
+ 	scanexpression;
+ 	{1060:
+ 	}
+ 	if curtype <> 20 then 
+ 	    if curtype = 11 then 
+ 		curedges := curexp
+ 	    else begin
+ 		begin
+ 		    disperr(-30000, 835);
+ 		    begin
+ 			helpptr := 4;
+ 			helpline[3] := 836;
+ 			helpline[2] := 837;
+ 			helpline[1] := 838;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end {:1060};
+ 		goto 10
+ 	    end
+ 	else begin
+ 	    findedgesvar(curexp);
+ 	    curtype := 1
+ 	end;
+ 	if curedges <> (-30000) then begin
+ 	    c := roundunscaled(internal[18]) mod 256;
+ 	    if c < 0 then 
+ 		c := c + 256; {1099:}
+ 	    if c < bc then 
+ 		bc := c;
+ 	    if c > ec then 
+ 		ec := c;
+ 	    charexists[c] := true;
+ 	    gfdx[c] := internal[24];
+ 	    gfdy[c] := internal[25];
+ 	    tfmwidth[c] := tfmcheck(20);
+ 	    tfmheight[c] := tfmcheck(21);
+ 	    tfmdepth[c] := tfmcheck(22);
+ 	    tfmitalcorr[c] := tfmcheck(23) {:1099};
+ 	    if internal[34] >= 0 then 
+ 		shipout(c)
+ 	end;
+ 	flushcurexp(0);
+     10:
+ 	
+     end; {:1070}
+ {1071:}
+ 
+     procedure dodisplay;
+     label
+ 	45, 50, 10;
+     var
+ 	e: halfword;
+     begin
+ 	getxnext;
+ 	varflag := 73;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    e := curexp;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if curtype <> 16 then 
+ 		goto 50;
+ 	    curexp := roundunscaled(curexp);
+ 	    if curexp < 0 then 
+ 		goto 45;
+ 	    if curexp > 15 then 
+ 		goto 45;
+ 	    if not windowopen[curexp] then 
+ 		goto 45;
+ 	    findedgesvar(e);
+ 	    if curedges <> (-30000) then 
+ 		dispedges(curexp);
+ 	    goto 10;
+     45:
+ 	    curexp := curexp * 65536;
+     50:
+ 	    disperr(-30000, 849);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 850
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    flushtokenlist(e)
+ 	end;
+     10:
+ 	
+     end; { dodisplay }
+ {:1071}
+     {1072:}
+ 
+     function getpair(c: commandcode): boolean;
+     var
+ 	p: halfword;
+ 	b: boolean;
+     begin
+ 	if curcmd <> c then 
+ 	    getpair := false
+ 	else begin
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if nicepair(curexp, curtype) then begin
+ 		p := mem[curexp + 1].int;
+ 		curx := mem[p + 1].int;
+ 		cury := mem[p + 3].int;
+ 		b := true
+ 	    end else 
+ 		b := false;
+ 	    flushcurexp(0);
+ 	    getpair := b
+ 	end
+     end; {:1072} {1073:}
+ 
+     procedure doopenwindow;
+     label
+ 	45, 10;
+     var
+ 	k: integer;
+ 	r0, c0, r1, c1: scaled;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 16 then 
+ 	    goto 45;
+ 	k := roundunscaled(curexp);
+ 	if k < 0 then 
+ 	    goto 45;
+ 	if k > 15 then 
+ 	    goto 45;
+ 	if not getpair(70) then 
+ 	    goto 45;
+ 	r0 := curx;
+ 	c0 := cury;
+ 	if not getpair(71) then 
+ 	    goto 45;
+ 	r1 := curx;
+ 	c1 := cury;
+ 	if not getpair(72) then 
+ 	    goto 45;
+ 	openawindow(k, r0, c0, r1, c1, curx, cury);
+ 	goto 10;
+     45:
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(851)
+ 	end;
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 852;
+ 	    helpline[0] := 853
+ 	end;
+ 	putgeterror;
+     10:
+ 	
+     end; {:1073} {1074:}
+ 
+     procedure docull;
+     label
+ 	45, 10;
+     var
+ 	e: halfword;
+ 	keeping: 0..1;
+ 	w, win, wout: integer;
+     begin
+ 	w := 1;
+ 	getxnext;
+ 	varflag := 67;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    e := curexp;
+ 	    curtype := 1;
+ 	    keeping := curmod;
+ 	    if not getpair(67) then 
+ 		goto 45;
+ 	    while (curcmd = 66) and (curmod = 16) do 
+ 		if scanwith then 
+ 		    w := curexp; {1075:}
+ 	    if curx > cury then 
+ 		goto 45;
+ 	    if keeping = 0 then begin
+ 		if (curx > 0) or (cury < 0) then 
+ 		    goto 45;
+ 		wout := w;
+ 		win := 0
+ 	    end else begin
+ 		if (curx <= 0) and (cury >= 0) then 
+ 		    goto 45;
+ 		wout := 0;
+ 		win := w
+ 	    end {:1075};
+ 	    findedgesvar(e);
+ 	    if curedges <> (-30000) then 
+ 		culledges(floorunscaled(curx + 65535), floorunscaled(cury), wout, win);
+ 	    goto 10;
+     45:
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(854)
+ 	    end;
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 855
+ 	    end;
+ 	    putgeterror;
+ 	    flushtokenlist(e)
+ 	end;
+     10:
+ 	
+     end; {:1074} {1082:}
+ 
+     procedure domessage;
+     var
+ 	m: 0..2;
+     begin
+ 	m := curmod;
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 4 then begin
+ 	    disperr(-30000, 565);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 859
+ 	    end;
+ 	    putgeterror
+ 	end else 
+ 	    case m of
+ 		0:
+ 		    begin
+ 			printnl(155);
+ 			slowprint(curexp)
+ 		    end;
+ 		1:
+ 		    begin {1086:}
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(155)
+ 			end;
+ 			slowprint(curexp);
+ 			if errhelp <> 0 then 
+ 			    useerrhelp := true
+ 			else if longhelpseen then begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 860
+ 			end else begin
+ 			    if interaction < 3 then 
+ 				longhelpseen := true;
+ 			    begin
+ 				helpptr := 4;
+ 				helpline[3] := 861;
+ 				helpline[2] := 862;
+ 				helpline[1] := 863;
+ 				helpline[0] := 864
+ 			    end
+ 			end;
+ 			putgeterror;
+ 			useerrhelp := false
+ 		    end; {:1086}
+ 		2:
+ 		    begin {1083:}
+ 			if errhelp <> 0 then begin
+ 			    if strref[errhelp] < 127 then 
+ 				if strref[errhelp] > 1 then 
+ 				    strref[errhelp] := strref[errhelp] - 1
+ 				else 
+ 				    flushstring(errhelp)
+ 			end;
+ 			if (strstart[curexp + 1] - strstart[curexp]) = 0 then 
+ 			    errhelp := 0
+ 			else begin
+ 			    errhelp := curexp;
+ 			    begin
+ 				if strref[errhelp] < 127 then 
+ 				    strref[errhelp] := strref[errhelp] + 1
+ 			    end
+ 			end
+ 		    end
+ 	    end {:1083};
+ 	flushcurexp(0)
+     end; {:1082} {1103:}
+ 
+     function getcode: eightbits;
+     label
+ 	40;
+     var
+ 	c: integer;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype = 16 then begin
+ 	    c := roundunscaled(curexp);
+ 	    if c >= 0 then 
+ 		if c < 256 then 
+ 		    goto 40
+ 	end else if curtype = 4 then 
+ 	    if (strstart[curexp + 1] - strstart[curexp]) = 1 then begin
+ 		c := strpool[strstart[curexp]];
+ 		goto 40
+ 	    end;
+ 	disperr(-30000, 873);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 874;
+ 	    helpline[0] := 875
+ 	end;
+ 	putgetflusherror(0);
+ 	c := 0;
+     40:
+ 	getcode := c
+     end; {:1103} {1104:}
+ 
+     procedure settag(c: eightbits; t: smallnumber; r: eightbits);
+     begin
+ 	if chartag[c] = 0 then begin
+ 	    chartag[c] := t;
+ 	    charremainder[c] := r
+ 	end else begin {1105:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(876)
+ 	    end;
+ 	    if (c > 32) and (c < 128) then 
+ 		print(c)
+ 	    else begin
+ 		print(877);
+ 		printint(c)
+ 	    end;
+ 	    print(878);
+ 	    case chartag[c] of
+ 		1:
+ 		    print(879);
+ 		2:
+ 		    print(880);
+ 		3:
+ 		    print(870)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 881;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgeterror
+ 	end {:1105}
+     end; {:1104} {1106:}
+ 
+     procedure dotfmcommand;
+     label
+ 	22;
+     var
+ 	c, cc: eightbits;
+ 	k: 0..256;
+ 	j: integer;
+     begin
+ 	case curmod of
+ 	    0:
+ 		begin {1107:}
+ 		    c := getcode;
+ 		    while curcmd = 78 do begin
+ 			cc := getcode;
+ 			settag(c, 2, cc);
+ 			c := cc
+ 		    end
+ 		end; {:1107}
+ 	    1:
+ 		begin {1108:}
+     22:
+ 		    c := getcode;
+ 		    if curcmd = 78 then begin {1111:}
+ 			if nl < 256 then 
+ 			    settag(c, 1, nl)
+ 			else begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(891)
+ 			    end;
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 892
+ 			    end;
+ 			    error
+ 			end;
+ 			goto 22
+ 		    end {:1111};
+ 		    if curcmd = 76 then begin {1112:}
+ 			ligkern[nl].b1 := c - 128;
+ 			ligkern[nl].b2 := curmod - 128;
+ 			ligkern[nl].b0 := -128;
+ 			if curmod = 0 then 
+ 			    ligkern[nl].b3 := getcode - 128
+ 			else begin
+ 			    getxnext;
+ 			    scanexpression;
+ 			    if curtype <> 16 then begin
+ 				disperr(-30000, 893);
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 894;
+ 				    helpline[0] := 179
+ 				end;
+ 				putgetflusherror(0)
+ 			    end;
+ 			    kern[nk] := curexp;
+ 			    k := 0;
+ 			    while kern[k] <> curexp do 
+ 				k := k + 1;
+ 			    if k = nk then begin
+ 				if nk = 256 then 
+ 				    overflow(890, 256);
+ 				nk := nk + 1
+ 			    end;
+ 			    ligkern[nl].b3 := k - 128
+ 			end {:1112};
+ 			if nl = ligtablesize then 
+ 			    overflow(886, ligtablesize);
+ 			nl := nl + 1;
+ 			if curcmd = 79 then 
+ 			    goto 22
+ 		    end else begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(887)
+ 			end;
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 888
+ 			end;
+ 			backerror
+ 		    end;
+ 		    if nl > 0 then 
+ 			ligkern[nl - 1].b0 := 0
+ 		end; {:1108}
+ 	    2:
+ 		begin {1113:}
+ 		    if ne = 256 then 
+ 			overflow(870, 256);
+ 		    c := getcode;
+ 		    settag(c, 3, ne);
+ 		    if curcmd <> 78 then begin
+ 			missingerr(58);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b0 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b1 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b2 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b3 := getcode - 128;
+ 		    ne := ne + 1
+ 		end; {:1113}
+ 	    3, 4:
+ 		begin
+ 		    c := curmod;
+ 		    getxnext;
+ 		    scanexpression;
+ 		    if (curtype <> 16) or (curexp < 32768) then begin
+ 			disperr(-30000, 882);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 883;
+ 			    helpline[0] := 884
+ 			end;
+ 			putgeterror
+ 		    end else begin
+ 			j := roundunscaled(curexp);
+ 			if curcmd <> 78 then begin
+ 			    missingerr(58);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 885
+ 			    end;
+ 			    backerror
+ 			end;
+ 			if c = 3 then  {1114:}
+ 			    repeat
+ 				if j > headersize then 
+ 				    overflow(871, headersize);
+ 				headerbyte[j] := getcode;
+ 				j := j + 1
+ 			    until curcmd <> 79 {:1114} {1115:}
+ 			else 
+ 			    repeat
+ 				if j > maxfontdimen then 
+ 				    overflow(872, maxfontdimen);
+ 				while j > np do begin
+ 				    np := np + 1;
+ 				    param[np] := 0
+ 				end;
+ 				getxnext;
+ 				scanexpression;
+ 				if curtype <> 16 then begin
+ 				    disperr(-30000, 896);
+ 				    begin
+ 					helpptr := 1;
+ 					helpline[0] := 179
+ 				    end;
+ 				    putgetflusherror(0)
+ 				end;
+ 				param[j] := curexp;
+ 				j := j + 1
+ 			    until curcmd <> 79 {:1115}
+ 		    end
+ 		end
+ 	end
+     end; {:1106} {1177:}
+ 
+     procedure dospecial;
+     var
+ 	m: smallnumber;
+     begin
+ 	m := curmod;
+ 	getxnext;
+ 	scanexpression;
+ 	if internal[34] >= 0 then 
+ 	    if curtype <> m then begin {1178:}
+ 		disperr(-30000, 914);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 915
+ 		end;
+ 		putgeterror
+ 	    end else begin {:1178}
+ 		if outputfilename = 0 then 
+ 		    initgf;
+ 		if m = 4 then 
+ 		    gfstring(curexp, 0)
+ 		else begin
+ 		    begin
+ 			gfbuf[gfptr] := 243;
+ 			gfptr := gfptr + 1;
+ 			if gfptr = gflimit then 
+ 			    gfswap
+ 		    end;
+ 		    gffour(curexp)
+ 		end
+ 	    end;
+ 	flushcurexp(0)
+     end; {:1177} {1186:}
+     {procedure storebasefile;var k:integer;
+     p,q:halfword;x:integer;w:fourquarters;begin[1200:]selector:=5;
+     print(925);print(jobname);printchar(32);
+     printint(roundunscaled(internal[14])mod 100);printchar(46);
+     printint(roundunscaled(internal[15]));printchar(46);
+     printint(roundunscaled(internal[16]));printchar(41);
+     if interaction=0 then selector:=2 else selector:=3;
+     begin if poolptr+1>maxpoolptr then begin if poolptr+1>poolsize then
+     overflow(129,poolsize-initpoolptr);maxpoolptr:=poolptr+1;end;end;
+     baseident:=makestring;strref[baseident]:=127;packjobname(926);
+     while not wopenout(basefile)do promptfilename(927,926);printnl(928);
+     print(wmakenamestring(basefile));flushstring(strptr-1);
+     printnl(baseident)[:1200];[1190:]begin basefile^.int:=503742536;
+     put(basefile);end;begin basefile^.int:=-30000;put(basefile);end;
+     begin basefile^.int:=30000;put(basefile);end;begin basefile^.int:=2100;
+     put(basefile);end;begin basefile^.int:=1777;put(basefile);end;
+     begin basefile^.int:=6;put(basefile);end[:1190];
+     [1192:]begin basefile^.int:=poolptr;put(basefile);end;
+     begin basefile^.int:=strptr;put(basefile);end;
+     for k:=0 to strptr do begin basefile^.int:=strstart[k];put(basefile);
+     end;k:=0;while k+4<poolptr do begin w.b0:=strpool[k];w.b1:=strpool[k+1];
+     w.b2:=strpool[k+2];w.b3:=strpool[k+3];begin basefile^.qqqq:=w;
+     put(basefile);end;k:=k+4;end;k:=poolptr-4;w.b0:=strpool[k];
+     w.b1:=strpool[k+1];w.b2:=strpool[k+2];w.b3:=strpool[k+3];
+     begin basefile^.qqqq:=w;put(basefile);end;println;printint(strptr);
+     print(922);printint(poolptr)[:1192];[1194:]sortavail;varused:=0;
+     begin basefile^.int:=lomemmax;put(basefile);end;
+     begin basefile^.int:=rover;put(basefile);end;p:=-30000;q:=rover;x:=0;
+     repeat for k:=p to q+1 do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+q+2-p;varused:=varused+q-p;p:=q+mem[q].hh.lh;q:=mem[q+1].hh.rh;
+     until q=rover;varused:=varused+lomemmax-p;dynused:=memend+1-himemmin;
+     for k:=p to lomemmax do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+lomemmax+1-p;begin basefile^.int:=himemmin;put(basefile);end;
+     begin basefile^.int:=avail;put(basefile);end;
+     for k:=himemmin to memend do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+memend+1-himemmin;p:=avail;
+     while p<>-30000 do begin dynused:=dynused-1;p:=mem[p].hh.rh;end;
+     begin basefile^.int:=varused;put(basefile);end;
+     begin basefile^.int:=dynused;put(basefile);end;println;printint(x);
+     print(923);printint(varused);printchar(38);printint(dynused)[:1194];
+     [1196:]begin basefile^.int:=hashused;put(basefile);end;
+     stcount:=2228-hashused;
+     for p:=1 to hashused do if hash[p].rh<>0 then begin begin basefile^.int
+     :=p;put(basefile);end;begin basefile^.hh:=hash[p];put(basefile);end;
+     begin basefile^.hh:=eqtb[p];put(basefile);end;stcount:=stcount+1;end;
+     for p:=hashused+1 to 2241 do begin begin basefile^.hh:=hash[p];
+     put(basefile);end;begin basefile^.hh:=eqtb[p];put(basefile);end;end;
+     begin basefile^.int:=stcount;put(basefile);end;println;
+     printint(stcount);print(924)[:1196];[1198:]begin basefile^.int:=intptr;
+     put(basefile);end;
+     for k:=1 to intptr do begin begin basefile^.int:=internal[k];
+     put(basefile);end;begin basefile^.int:=intname[k];put(basefile);end;end;
+     begin basefile^.int:=startsym;put(basefile);end;
+     begin basefile^.int:=interaction;put(basefile);end;
+     begin basefile^.int:=baseident;put(basefile);end;
+     begin basefile^.int:=bgloc;put(basefile);end;begin basefile^.int:=egloc;
+     put(basefile);end;begin basefile^.int:=serialno;put(basefile);end;
+     begin basefile^.int:=69069;put(basefile);end;internal[12]:=0[:1198];
+     [1201:]wclose(basefile)[:1201];end;}
+     {:1186}
+ 
+     procedure dostatement;
+     begin
+ 	curtype := 1;
+ 	getxnext;
+ 	if curcmd > 43 then begin {990:}
+ 	    if curcmd < 80 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(733)
+ 		end;
+ 		printcmdmod(curcmd, curmod);
+ 		printchar(39);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 734;
+ 		    helpline[3] := 735;
+ 		    helpline[2] := 736;
+ 		    helpline[1] := 737;
+ 		    helpline[0] := 738
+ 		end;
+ 		backerror;
+ 		getxnext
+ 	    end
+ 	end else if curcmd > 30 then begin {:990} {993:}
+ 	    varflag := 77;
+ 	    scanexpression;
+ 	    if curcmd < 81 then begin
+ 		if curcmd = 51 then 
+ 		    doequation
+ 		else if curcmd = 77 then 
+ 		    doassignment
+ 		else if curtype = 4 then begin {994:}
+ 		    if internal[1] > 0 then begin
+ 			printnl(155);
+ 			slowprint(curexp);
+ 			{---------------------}
+ 			 auxprintnl(155);
+ 			 auxslowprint(curexp);
+ 			{---------------------}
+ 			flush(output)
+ 		    end;
+ 		    if internal[34] > 0 then begin {1179:}
+ 			if outputfilename = 0 then 
+ 			    initgf;
+ 			gfstring(916, curexp)
+ 		    end {:1179}
+ 		end else if curtype <> 1 then begin {:994}
+ 		    disperr(-30000, 743);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 744;
+ 			helpline[1] := 745;
+ 			helpline[0] := 746
+ 		    end;
+ 		    putgeterror
+ 		end;
+ 		flushcurexp(0);
+ 		curtype := 1
+ 	    end
+ 	end else begin {:993} {992:}
+ 	    if internal[7] > 0 then 
+ 		showcmdmod(curcmd, curmod);
+ 	    case curcmd of
+ 		30:
+ 		    dotypedeclaration;
+ 		16:
+ 		    if curmod > 2 then 
+ 			makeopdef
+ 		    else if curmod > 0 then 
+ 			scandef; {1020:}
+ 		24:
+ 		    dorandomseed; {:1020} {1023:}
+ 		23:
+ 		    begin
+ 			println;
+ 			interaction := curmod; {70:}
+ 			if interaction = 0 then 
+ 			    selector := 0
+ 			else 
+ 			    selector := 1 {:70};
+ 			if jobname <> 0 then 
+ 			    selector := selector + 2;
+ 			getxnext
+ 		    end; {:1023} {1026:}
+ 		21:
+ 		    doprotection; {:1026} {1030:}
+ 		27:
+ 		    defdelims; {:1030} {1033:}
+ 		12:
+ 		    repeat
+ 			getsymbol;
+ 			savevariable(cursym);
+ 			getxnext
+ 		    until curcmd <> 79;
+ 		13:
+ 		    dointerim;
+ 		14:
+ 		    dolet;
+ 		15:
+ 		    donewinternal; {:1033} {1039:}
+ 		22:
+ 		    doshowwhatever;
+ {:1039}
+ 		{1058:}
+ 		18:
+ 		    doaddto; {:1058} {1069:}
+ 		17:
+ 		    doshipout;
+ 		11:
+ 		    dodisplay;
+ 		28:
+ 		    doopenwindow;
+ 		19:
+ 		    docull; {:1069} {1076:}
+ 		26:
+ 		    begin
+ 			getsymbol;
+ 			startsym := cursym;
+ 			getxnext
+ 		    end; {:1076} {1081:}
+ 		25:
+ 		    domessage; {:1081} {1100:}
+ 		20:
+ 		    dotfmcommand; {:1100} {1175:}
+ 		29:
+ 		    dospecial
+ 	    end {:1175};
+ 	    curtype := 1
+ 	end {:992};
+ 	if curcmd < 80 then begin {991:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(739)
+ 	    end;
+ 	    begin
+ 		helpptr := 6;
+ 		helpline[5] := 740;
+ 		helpline[4] := 741;
+ 		helpline[3] := 742;
+ 		helpline[2] := 736;
+ 		helpline[1] := 737;
+ 		helpline[0] := 738
+ 	    end;
+ 	    backerror;
+ 	    scannerstatus := 2;
+ 	    repeat
+ 		getnext; {743:}
+ 		if curcmd = 39 then begin
+ 		    if strref[curmod] < 127 then 
+ 			if strref[curmod] > 1 then 
+ 			    strref[curmod] := strref[curmod] - 1
+ 			else 
+ 			    flushstring(curmod)
+ 		end {:743}
+ 	    until curcmd > 79;
+ 	    scannerstatus := 0
+ 	end {:991};
+ 	errorcount := 0
+     end; {:989}
+ {1017:}
+ 
+     procedure maincontrol;
+     begin
+ 	repeat
+ 	    dostatement;
+ 	    if curcmd = 81 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(774)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 775;
+ 		    helpline[0] := 555
+ 		end;
+ 		flusherror(0)
+ 	    end
+ 	until curcmd = 82
+     end; {:1017} {1117:}
+ 
+     function sortin(v: scaled): halfword;
+     label
+ 	40;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := 29999;
+ 	while true do begin
+ 	    q := mem[p].hh.rh;
+ 	    if v <= mem[q + 1].int then 
+ 		goto 40;
+ 	    p := q
+ 	end;
+     40:
+ 	if v < mem[q + 1].int then begin
+ 	    r := getnode(2);
+ 	    mem[r + 1].int := v;
+ 	    mem[r].hh.rh := q;
+ 	    mem[p].hh.rh := r
+ 	end;
+ 	sortin := mem[p].hh.rh
+     end; {:1117}
+ {1118:}
+ 
+     function mincover(d: scaled): integer;
+     var
+ 	p: halfword;
+ 	l: scaled;
+ 	m: integer;
+     begin
+ 	m := 0;
+ 	p := mem[29999].hh.rh;
+ 	perturbation := 2147483647;
+ 	while p <> (-29981) do begin
+ 	    m := m + 1;
+ 	    l := mem[p + 1].int;
+ 	    repeat
+ 		p := mem[p].hh.rh
+ 	    until mem[p + 1].int > (l + d);
+ 	    if (mem[p + 1].int - l) < perturbation then 
+ 		perturbation := mem[p + 1].int - l
+ 	end;
+ 	mincover := m
+     end; {:1118} {1120:}
+ 
+     function threshold(m: integer): scaled;
+     var
+ 	d: scaled;
+     begin
+ 	if mincover(0) <= m then 
+ 	    threshold := 0
+ 	else begin
+ 	    repeat
+ 		d := perturbation
+ 	    until mincover(d + d) <= m;
+ 	    while mincover(d) > m do 
+ 		d := perturbation;
+ 	    threshold := d
+ 	end
+     end; {:1120}
+ {1121:}
+ 
+     function skimp(m: integer): integer;
+     var
+ 	d: scaled;
+ 	p, q, r: halfword;
+ 	l: scaled;
+ 	v: scaled;
+     begin
+ 	d := threshold(m);
+ 	perturbation := 0;
+ 	q := 29999;
+ 	m := 0;
+ 	p := mem[29999].hh.rh;
+ 	while p <> (-29981) do begin
+ 	    m := m + 1;
+ 	    l := mem[p + 1].int;
+ 	    mem[p].hh.lh := m;
+ 	    if mem[mem[p].hh.rh + 1].int <= (l + d) then begin {1122:}
+ 		repeat
+ 		    p := mem[p].hh.rh;
+ 		    mem[p].hh.lh := m
+ 		until mem[mem[p].hh.rh + 1].int > (l + d);
+ 		v := (l + mem[p + 1].int) div 2;
+ 		if (mem[p + 1].int - v) > perturbation then 
+ 		    perturbation := mem[p + 1].int - v;
+ 		r := q;
+ 		repeat
+ 		    r := mem[r].hh.rh;
+ 		    mem[r + 1].int := v
+ 		until r = p;
+ 		mem[q].hh.rh := p
+ 	    end {:1122};
+ 	    q := p;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	skimp := m
+     end; {:1121} {1123:}
+ 
+     procedure tfmwarning(m: smallnumber);
+     begin
+ 	printnl(897);
+ 	print(intname[m]);
+ 	print(898);
+ 	printscaled(perturbation);
+ 	print(899)
+     end; { tfmwarning }
+ {:1123}
+     {1128:}
+ 
+     procedure fixdesignsize;
+     var
+ 	d: scaled;
+     begin
+ 	d := internal[26];
+ 	if (d < 65536) or (d >= 134217728) then begin
+ 	    if d <> 0 then 
+ 		printnl(900);
+ 	    d := 8388608;
+ 	    internal[26] := d
+ 	end;
+ 	if headerbyte[5] < 0 then 
+ 	    if headerbyte[6] < 0 then 
+ 		if headerbyte[7] < 0 then 
+ 		    if headerbyte[8] < 0 then begin
+ 			headerbyte[5] := d div 1048576;
+ 			headerbyte[6] := (d div 4096) mod 256;
+ 			headerbyte[7] := (d div 16) mod 256;
+ 			headerbyte[8] := (d mod 16) * 16
+ 		    end;
+ 	maxtfmdimen := (16 * internal[26]) - (internal[26] div 2097152);
+ 	if maxtfmdimen >= 134217728 then 
+ 	    maxtfmdimen := 134217727
+     end; {:1128} {1129:}
+ 
+     function dimenout(x: scaled): integer;
+     begin
+ 	if abs(x) > maxtfmdimen then begin
+ 	    tfmchanged := tfmchanged + 1;
+ 	    if x > 0 then 
+ 		x := 16777215
+ 	    else 
+ 		x := -16777215
+ 	end else 
+ 	    x := makescaled(x * 16, internal[26]);
+ 	dimenout := x
+     end; {:1129} {1131:}
+ 
+     procedure fixchecksum;
+     label
+ 	10;
+     var
+ 	k: eightbits;
+ 	b1, b2, b3, b4: eightbits;
+ 	x: integer;
+     begin
+ 	if headerbyte[1] < 0 then 
+ 	    if headerbyte[2] < 0 then 
+ 		if headerbyte[3] < 0 then 
+ 		    if headerbyte[4] < 0 then begin {1132:}
+ 			b1 := bc;
+ 			b2 := ec;
+ 			b3 := bc;
+ 			b4 := ec;
+ 			tfmchanged := 0;
+ 			for k := bc to ec do 
+ 			    if charexists[k] then begin
+ 				x := dimenout(mem[tfmwidth[k] + 1].int) + ((k + 4) * 4194304);
+ 				b1 := ((b1 + b1) + x) mod 255;
+ 				b2 := ((b2 + b2) + x) mod 253;
+ 				b3 := ((b3 + b3) + x) mod 251;
+ 				b4 := ((b4 + b4) + x) mod 247
+ 			    end {:1132};
+ 			headerbyte[1] := b1;
+ 			headerbyte[2] := b2;
+ 			headerbyte[3] := b3;
+ 			headerbyte[4] := b4;
+ 			goto 10
+ 		    end;
+ 	for k := 1 to 4 do 
+ 	    if headerbyte[k] < 0 then 
+ 		headerbyte[k] := 0;
+     10:
+ 	
+     end; {:1131}
+ {1133:}
+ 
+     procedure tfmqqqq(x: fourquarters);
+     begin
+ 	bwritebyte(tfmfile, x.b0 + 128);
+ 	bwritebyte(tfmfile, x.b1 + 128);
+ 	bwritebyte(tfmfile, x.b2 + 128);
+ 	bwritebyte(tfmfile, x.b3 + 128)
+     end; {:1133}
+ {1187:}
+     {779:}
+ 
+     function openbasefile: boolean;
+     label
+ 	40, 10;
+     var
+ 	j: 0..bufsize;
+     begin
+ 	j := curinput.locfield;
+ 	if buffer[curinput.locfield] = 38 then begin
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	    j := curinput.locfield;
+ 	    buffer[last] := 32;
+ 	    while buffer[j] <> 32 do 
+ 		j := j + 1;
+ 	    packbufferedname(0, curinput.locfield, j - 1);
+ 	    if wopenin(basefile) then 
+ 		goto 40;
+ 	    writeln(output, 'Sorry, I can''t find that base;', ' will try PLAIN.');
+ 	    flush(output)
+ 	end;
+ 	packbufferedname(5, 1, 0);
+ 	if not wopenin(basefile) then begin
+ 	    writeln(output, 'I can''t find the PLAIN base file!');
+ 	    openbasefile := false;
+ 	    goto 10
+ 	end;
+     40:
+ 	curinput.locfield := j;
+ 	openbasefile := true;
+     10:
+ 	
+     end; {:779}
+ 
+     function loadbasefile: boolean;
+     label
+ 	6666, 10;
+     var
+ 	k: integer;
+ 	p, q: halfword;
+ 	x: integer;
+ 	w: fourquarters; {1191:}
+     begin
+ 	x := basefile^.int;
+ 	if x <> 503742536 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> (-30000) then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 30000 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 2100 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 1777 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 6 then 
+ 	    goto 6666 {:1191};
+ {1193:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if x < 0 then 
+ 		goto 6666;
+ 	    if x > poolsize then begin
+ 		writeln(output, '---! Must increase the ', 'string pool size');
+ 		goto 6666
+ 	    end else 
+ 		poolptr := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if x < 0 then 
+ 		goto 6666;
+ 	    if x > maxstrings then begin
+ 		writeln(output, '---! Must increase the ', 'max strings');
+ 		goto 6666
+ 	    end else 
+ 		strptr := x
+ 	end;
+ 	for k := 0 to strptr do begin
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < 0) or (x > poolptr) then 
+ 		    goto 6666
+ 		else 
+ 		    strstart[k] := x
+ 	    end;
+ 	    strref[k] := 127
+ 	end;
+ 	k := 0;
+ 	while (k + 4) < poolptr do begin
+ 	    begin
+ 		get(basefile);
+ 		w := basefile^.qqqq
+ 	    end;
+ 	    strpool[k] := w.b0;
+ 	    strpool[k + 1] := w.b1;
+ 	    strpool[k + 2] := w.b2;
+ 	    strpool[k + 3] := w.b3;
+ 	    k := k + 4
+ 	end;
+ 	k := poolptr - 4;
+ 	begin
+ 	    get(basefile);
+ 	    w := basefile^.qqqq
+ 	end;
+ 	strpool[k] := w.b0;
+ 	strpool[k + 1] := w.b1;
+ 	strpool[k + 2] := w.b2;
+ 	strpool[k + 3] := w.b3 {:1193}; {1195:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-28978)) or (x > 29997) then 
+ 		goto 6666
+ 	    else 
+ 		lomemmax := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-29977)) or (x > lomemmax) then 
+ 		goto 6666
+ 	    else 
+ 		rover := x
+ 	end;
+ 	p := -30000;
+ 	q := rover;
+ 	x := 0;
+ 	repeat
+ 	    for k := p to q + 1 do begin
+ 		get(basefile);
+ 		mem[k] := basefile^
+ 	    end;
+ 	    p := q + mem[q].hh.lh;
+ 	    if (p > lomemmax) or ((q >= mem[q + 1].hh.rh) and (mem[q + 1].hh.rh <> rover)) then 
+ 		goto 6666;
+ 	    q := mem[q + 1].hh.rh
+ 	until q = rover;
+ 	for k := p to lomemmax do begin
+ 	    get(basefile);
+ 	    mem[k] := basefile^
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (lomemmax + 1)) or (x > 29998) then 
+ 		goto 6666
+ 	    else 
+ 		himemmin := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-30000)) or (x > 30000) then 
+ 		goto 6666
+ 	    else 
+ 		avail := x
+ 	end;
+ 	memend := 30000;
+ 	for k := himemmin to memend do begin
+ 	    get(basefile);
+ 	    mem[k] := basefile^
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    varused := basefile^.int
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    dynused := basefile^.int
+ 	end {:1195}; {1197:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2229) then 
+ 		goto 6666
+ 	    else 
+ 		hashused := x
+ 	end;
+ 	p := 0;
+ 	repeat
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < (p + 1)) or (x > hashused) then 
+ 		    goto 6666
+ 		else 
+ 		    p := x
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		hash[p] := basefile^.hh
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		eqtb[p] := basefile^.hh
+ 	    end
+ 	until p = hashused;
+ 	for p := hashused + 1 to 2241 do begin
+ 	    begin
+ 		get(basefile);
+ 		hash[p] := basefile^.hh
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		eqtb[p] := basefile^.hh
+ 	    end
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    stcount := basefile^.int
+ 	end {:1197}; {1199:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 40) or (x > maxinternal) then 
+ 		goto 6666
+ 	    else 
+ 		intptr := x
+ 	end;
+ 	for k := 1 to intptr do begin
+ 	    begin
+ 		get(basefile);
+ 		internal[k] := basefile^.int
+ 	    end;
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < 0) or (x > strptr) then 
+ 		    goto 6666
+ 		else 
+ 		    intname[k] := x
+ 	    end
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > 2229) then 
+ 		goto 6666
+ 	    else 
+ 		startsym := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > 3) then 
+ 		goto 6666
+ 	    else 
+ 		interaction := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > strptr) then 
+ 		goto 6666
+ 	    else 
+ 		baseident := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2241) then 
+ 		goto 6666
+ 	    else 
+ 		bgloc := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2241) then 
+ 		goto 6666
+ 	    else 
+ 		egloc := x
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    serialno := basefile^.int
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if (x <> 69069) or eof(basefile) then 
+ 	    goto 6666 {:1199};
+ 	loadbasefile := true;
+ 	goto 10;
+     6666:
+ 	;
+ 	writeln(output, '(Fatal base file error; I''m stymied)');
+ 	loadbasefile := false;
+     10:
+ 	
+     end; {:1187} {1202:} {823:}
+ 
+     procedure scanprimary;
+     label
+ 	20, 30, 31, 32;
+     var
+ 	p, q, r: halfword;
+ 	c: quarterword;
+ 	myvarflag: 0..82;
+ 	ldelim, rdelim: halfword; {831:}
+ 	groupline: integer; {:831} {836:}
+ 	num, denom: scaled; {:836} {843:}
+ 	prehead, posthead, tail: halfword;
+ 	tt: smallnumber;
+ 	t: halfword;
+ 	macroref: halfword; {:843}
+     begin
+ 	myvarflag := varflag;
+ 	varflag := 0;
+     20:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end; {825:}
+ {if panicking then checkmem(false);}
+ 	if interrupt <> 0 then 
+ 	    if OKtointerrupt then begin
+ 		backinput;
+ 		begin
+ 		    if interrupt <> 0 then 
+ 			pauseforinstructions
+ 		end;
+ 		getxnext
+ 	    end {:825};
+ 	if curcmd in
+ 	    [31, 32, 39, 42, 33, 34, 30, 36,
+ 	     43, 37, 35, 40, 38, 41] then
+ 	    case curcmd of
+ 		31:
+ 		    begin {826:}
+ 			ldelim := cursym;
+ 			rdelim := curmod;
+ 			getxnext;
+ 			scanexpression;
+ 			if (curcmd = 79) and (curtype >= 16) then begin {830:}
+ 			    p := getnode(2);
+ 			    mem[p].hh.b0 := 14;
+ 			    mem[p].hh.b1 := 11;
+ 			    initbignode(p);
+ 			    q := mem[p + 1].int;
+ 			    stashin(q);
+ 			    getxnext;
+ 			    scanexpression;
+ 			    if curtype < 16 then begin
+ 				disperr(-30000, 639);
+ 				begin
+ 				    helpptr := 4;
+ 				    helpline[3] := 640;
+ 				    helpline[2] := 641;
+ 				    helpline[1] := 642;
+ 				    helpline[0] := 643
+ 				end;
+ 				putgetflusherror(0)
+ 			    end;
+ 			    stashin(q + 2);
+ 			    checkdelimiter(ldelim, rdelim);
+ 			    curtype := 14;
+ 			    curexp := p
+ 			end else  {:830}
+ 			    checkdelimiter(ldelim, rdelim)
+ 		    end; {:826}
+ 		32:
+ 		    begin {832:}
+ 			groupline := line;
+ 			if internal[7] > 0 then 
+ 			    showcmdmod(curcmd, curmod);
+ 			begin
+ 			    p := getavail;
+ 			    mem[p].hh.lh := 0;
+ 			    mem[p].hh.rh := saveptr;
+ 			    saveptr := p
+ 			end;
+ 			repeat
+ 			    dostatement
+ 			until curcmd <> 80;
+ 			if curcmd <> 81 then begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(644)
+ 			    end;
+ 			    printint(groupline);
+ 			    print(645);
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 646;
+ 				helpline[0] := 647
+ 			    end;
+ 			    backerror;
+ 			    curcmd := 81
+ 			end;
+ 			unsave;
+ 			if internal[7] > 0 then 
+ 			    showcmdmod(curcmd, curmod)
+ 		    end; {:832}
+ 		39:
+ 		    begin {833:}
+ 			curtype := 4;
+ 			curexp := curmod
+ 		    end; {:833}
+ 		42:
+ 		    begin {837:}
+ 			curexp := curmod;
+ 			curtype := 16;
+ 			getxnext;
+ 			if curcmd <> 54 then begin
+ 			    num := 0;
+ 			    denom := 0
+ 			end else begin
+ 			    getxnext;
+ 			    if curcmd <> 42 then begin
+ 				backinput;
+ 				curcmd := 54;
+ 				curmod := 72;
+ 				cursym := 2233;
+ 				goto 30
+ 			    end;
+ 			    num := curexp;
+ 			    denom := curmod;
+ 			    if denom = 0 then begin {838:}
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(648)
+ 				end;
+ 				begin
+ 				    helpptr := 1;
+ 				    helpline[0] := 649
+ 				end;
+ 				error
+ 			    end else  {:838}
+ 				curexp := makescaled(num, denom);
+ 			    begin
+ 				if aritherror then 
+ 				    cleararith
+ 			    end;
+ 			    getxnext
+ 			end;
+ 			if curcmd >= 30 then 
+ 			    if curcmd < 42 then begin
+ 				p := stashcurexp;
+ 				scanprimary;
+ 				if (abs(num) >= abs(denom)) or (curtype < 14) then 
+ 				    dobinary(p, 71)
+ 				else begin
+ 				    fracmult(num, denom);
+ 				    freenode(p, 2)
+ 				end
+ 			    end;
+ 			goto 30
+ 		    end; {:837}
+ 		33: {834:}
+ 		    donullary(curmod) {:834};
+ 		34, 30, 36, 43:
+ 		    begin {835:}
+ 			c := curmod;
+ 			getxnext;
+ 			scanprimary;
+ 			dounary(c);
+ 			goto 30
+ 		    end; {:835}
+ 		37:
+ 		    begin {839:}
+ 			c := curmod;
+ 			getxnext;
+ 			scanexpression;
+ 			if curcmd <> 69 then begin
+ 			    missingerr(347);
+ 			    print(581);
+ 			    printcmdmod(37, c);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 582
+ 			    end;
+ 			    backerror
+ 			end;
+ 			p := stashcurexp;
+ 			getxnext;
+ 			scanprimary;
+ 			dobinary(p, c);
+ 			goto 30
+ 		    end; {:839}
+ 		35:
+ 		    begin {840:}
+ 			getxnext;
+ 			scansuffix;
+ 			oldsetting := selector;
+ 			selector := 5;
+ 			showtokenlist(curexp, -30000, 100000, 0);
+ 			flushtokenlist(curexp);
+ 			curexp := makestring;
+ 			selector := oldsetting;
+ 			curtype := 4;
+ 			goto 30
+ 		    end; {:840}
+ 		40:
+ 		    begin {841:}
+ 			q := curmod;
+ 			if myvarflag = 77 then begin
+ 			    getxnext;
+ 			    if curcmd = 77 then begin
+ 				curexp := getavail;
+ 				mem[curexp].hh.lh := q + 2241;
+ 				curtype := 20;
+ 				goto 30
+ 			    end;
+ 			    backinput
+ 			end;
+ 			curtype := 16;
+ 			curexp := internal[q]
+ 		    end; {:841}
+ 		38:
+ 		    makeexpcopy(curmod);
+ 		41:
+ 		    begin {844:}
+ 			begin
+ 			    prehead := avail;
+ 			    if prehead = (-30000) then 
+ 				prehead := getavail
+ 			    else begin
+ 				avail := mem[prehead].hh.rh;
+ 				mem[prehead].hh.rh := -30000
+ 			    end {dynused:=dynused+1;}
+ 			end;
+ 			tail := prehead;
+ 			posthead := -30000;
+ 			tt := 1;
+ 			while true do begin
+ 			    t := curtok;
+ 			    mem[tail].hh.rh := t;
+ 			    if tt <> 0 then begin {850:}
+ 				begin
+ 				    p := mem[prehead].hh.rh;
+ 				    q := mem[p].hh.lh;
+ 				    tt := 0;
+ 				    if (eqtb[q].lh mod 83) = 41 then begin
+ 					q := eqtb[q].rh;
+ 					if q = (-30000) then 
+ 					    goto 32;
+ 					while true do begin
+ 					    p := mem[p].hh.rh;
+ 					    if p = (-30000) then begin
+ 						tt := mem[q].hh.b0;
+ 						goto 32
+ 					    end;
+ 					    if mem[q].hh.b0 <> 21 then 
+ 						goto 32;
+ 					    q := mem[mem[q + 1].hh.lh].hh.rh;
+ 					    if p >= himemmin then begin
+ 						repeat
+ 						    q := mem[q].hh.rh
+ 						until mem[q + 2].hh.lh >= mem[p].hh.lh;
+ 						if mem[q + 2].hh.lh > mem[p].hh.lh then 
+ 						    goto 32
+ 					    end
+ 					end
+ 				    end;
+     32: {:850}
+ 				    
+ 				end;
+ 				if tt >= 22 then begin {845:}
+ 				    mem[tail].hh.rh := -30000;
+ 				    if tt > 22 then begin
+ 					posthead := getavail;
+ 					tail := posthead;
+ 					mem[tail].hh.rh := t;
+ 					tt := 0;
+ 					macroref := mem[q + 1].int;
+ 					mem[macroref].hh.lh := mem[macroref].hh.lh + 1
+ 				    end else begin {853:}
+ 					p := getavail;
+ 					mem[prehead].hh.lh := mem[prehead].hh.rh;
+ 					mem[prehead].hh.rh := p;
+ 					mem[p].hh.lh := t;
+ 					macrocall(mem[q + 1].int, prehead, -30000);
+ 					getxnext;
+ 					goto 20
+ 				    end {:853}
+ 				end {:845}
+ 			    end;
+ 			    getxnext;
+ 			    tail := t;
+ 			    if curcmd = 63 then begin {846:}
+ 				getxnext;
+ 				scanexpression;
+ 				if curcmd <> 64 then begin {847:}
+ 				    backinput;
+ 				    backexpr;
+ 				    curcmd := 63;
+ 				    curmod := 0;
+ 				    cursym := 2232
+ 				end else begin {:847}
+ 				    if curtype <> 16 then 
+ 					badsubscript;
+ 				    curcmd := 42;
+ 				    curmod := curexp;
+ 				    cursym := 0
+ 				end
+ 			    end {:846};
+ 			    if curcmd > 42 then 
+ 				goto 31;
+ 			    if curcmd < 40 then 
+ 				goto 31
+ 			end;
+     31: {852:}
+ 			if posthead <> (-30000) then begin {854:}
+ 			    backinput;
+ 			    p := getavail;
+ 			    q := mem[posthead].hh.rh;
+ 			    mem[prehead].hh.lh := mem[prehead].hh.rh;
+ 			    mem[prehead].hh.rh := posthead;
+ 			    mem[posthead].hh.lh := q;
+ 			    mem[posthead].hh.rh := p;
+ 			    mem[p].hh.lh := mem[q].hh.rh;
+ 			    mem[q].hh.rh := -30000;
+ 			    macrocall(macroref, prehead, -30000);
+ 			    mem[macroref].hh.lh := mem[macroref].hh.lh - 1;
+ 			    getxnext;
+ 			    goto 20
+ 			end {:854};
+ 			q := mem[prehead].hh.rh;
+ 			begin
+ 			    mem[prehead].hh.rh := avail;
+ 			    avail := prehead
+ 			end
+ {dynused:=dynused-1;};
+ 			if curcmd = myvarflag then begin
+ 			    curtype := 20;
+ 			    curexp := q;
+ 			    goto 30
+ 			end;
+ 			p := findvariable(q);
+ 			if p <> (-30000) then 
+ 			    makeexpcopy(p)
+ 			else begin
+ 			    obliterated(q);
+ 			    helpline[2] := 661;
+ 			    helpline[1] := 662;
+ 			    helpline[0] := 663;
+ 			    putgetflusherror(0)
+ 			end;
+ 			flushnodelist(q);
+ 			goto 30 {:852}
+ 		    end
+ 	    end
+ 	else
+ 	    begin {:844}
+ 		badexp(633);
+ 		goto 20
+ 	    end;
+ 	getxnext;
+     30:
+ 	if curcmd = 63 then 
+ 	    if curtype >= 16 then begin {859:}
+ 		p := stashcurexp;
+ 		getxnext;
+ 		scanexpression;
+ 		if curcmd <> 79 then begin {847:}
+ 		    begin
+ 			backinput;
+ 			backexpr;
+ 			curcmd := 63;
+ 			curmod := 0;
+ 			cursym := 2232
+ 		    end {:847};
+ 		    unstashcurexp(p)
+ 		end else begin
+ 		    q := stashcurexp;
+ 		    getxnext;
+ 		    scanexpression;
+ 		    if curcmd <> 64 then begin
+ 			missingerr(93);
+ 			begin
+ 			    helpptr := 3;
+ 			    helpline[2] := 665;
+ 			    helpline[1] := 666;
+ 			    helpline[0] := 563
+ 			end;
+ 			backerror
+ 		    end;
+ 		    r := stashcurexp;
+ 		    makeexpcopy(q);
+ 		    dobinary(r, 70);
+ 		    dobinary(p, 71);
+ 		    dobinary(q, 69);
+ 		    getxnext
+ 		end
+ 	    end {:859}
+     end; {:823} {860:}
+ 
+     procedure scansuffix;
+     label
+ 	30;
+     var
+ 	h, t: halfword;
+ 	p: halfword;
+     begin
+ 	h := getavail;
+ 	t := h;
+ 	while true do begin
+ 	    if curcmd = 63 then begin {861:}
+ 		getxnext;
+ 		scanexpression;
+ 		if curtype <> 16 then 
+ 		    badsubscript;
+ 		if curcmd <> 64 then begin
+ 		    missingerr(93);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 667;
+ 			helpline[1] := 666;
+ 			helpline[0] := 563
+ 		    end;
+ 		    backerror
+ 		end;
+ 		curcmd := 42;
+ 		curmod := curexp
+ 	    end {:861};
+ 	    if curcmd = 42 then 
+ 		p := newnumtok(curmod)
+ 	    else if (curcmd = 41) or (curcmd = 40) then begin
+ 		p := getavail;
+ 		mem[p].hh.lh := cursym
+ 	    end else 
+ 		goto 30;
+ 	    mem[t].hh.rh := p;
+ 	    t := p;
+ 	    getxnext
+ 	end;
+     30:
+ 	curexp := mem[h].hh.rh;
+ 	begin
+ 	    mem[h].hh.rh := avail;
+ 	    avail := h
+ 	end {dynused:=dynused-1;};
+ 	curtype := 20
+     end; {:860} {862:}
+ 
+     procedure scansecondary;
+     label
+ 	20, 22;
+     var
+ 	p, q, r: halfword;
+ 	c, d: halfword;
+ 	macname: halfword;
+     begin
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(668);
+ 	scanprimary;
+     22:
+ 	if curcmd <= 55 then 
+ 	    if curcmd >= 52 then begin
+ 		p := stashcurexp;
+ 		c := curmod;
+ 		d := curcmd;
+ 		if d = 53 then begin
+ 		    macname := cursym;
+ 		    mem[c].hh.lh := mem[c].hh.lh + 1
+ 		end;
+ 		getxnext;
+ 		scanprimary;
+ 		if d <> 53 then 
+ 		    dobinary(p, c)
+ 		else begin
+ 		    backinput;
+ 		    binarymac(p, c, macname);
+ 		    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 		    getxnext;
+ 		    goto 20
+ 		end;
+ 		goto 22
+ 	    end
+     end; {:862}
+ {864:}
+ 
+     procedure scantertiary;
+     label
+ 	20, 22;
+     var
+ 	p: halfword;
+ 	c, d: halfword;
+ 	macname: halfword;
+     begin
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(669);
+ 	scansecondary;
+ 	if curtype = 8 then 
+ 	    materializepen;
+     22:
+ 	if curcmd <= 45 then 
+ 	    if curcmd >= 43 then begin
+ 		p := stashcurexp;
+ 		c := curmod;
+ 		d := curcmd;
+ 		if d = 44 then begin
+ 		    macname := cursym;
+ 		    mem[c].hh.lh := mem[c].hh.lh + 1
+ 		end;
+ 		getxnext;
+ 		scansecondary;
+ 		if d <> 44 then 
+ 		    dobinary(p, c)
+ 		else begin
+ 		    backinput;
+ 		    binarymac(p, c, macname);
+ 		    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 		    getxnext;
+ 		    goto 20
+ 		end;
+ 		goto 22
+ 	    end
+     end; {:864}
+ {868:}
+ 
+     procedure scanexpression;
+     label
+ 	20, 30, 22, 25, 26, 10;
+     var
+ 	p, q, r, pp, qq: halfword;
+ 	c, d: halfword;
+ 	myvarflag: 0..82;
+ 	macname: halfword;
+ 	cyclehit: boolean;
+ 	x, y: scaled;
+ 	t: 0..4;
+     begin
+ 	myvarflag := varflag;
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(672);
+ 	scantertiary;
+     22:
+ 	if curcmd <= 51 then 
+ 	    if curcmd >= 46 then 
+ 		if (curcmd <> 51) or (myvarflag <> 77) then begin
+ 		    p := stashcurexp;
+ 		    c := curmod;
+ 		    d := curcmd;
+ 		    if d = 49 then begin
+ 			macname := cursym;
+ 			mem[c].hh.lh := mem[c].hh.lh + 1
+ 		    end;
+ 		    if (d < 48) or ((d = 48) and ((mem[p].hh.b0 = 14) or (mem[p].hh.b0 = 9))) then begin {869:}
+ 			cyclehit := false; {870:}
+ 			begin
+ 			    unstashcurexp(p);
+ 			    if curtype = 14 then 
+ 				p := newknot
+ 			    else if curtype = 9 then 
+ 				p := curexp
+ 			    else 
+ 				goto 10;
+ 			    q := p;
+ 			    while mem[q].hh.rh <> p do 
+ 				q := mem[q].hh.rh;
+ 			    if mem[p].hh.b0 <> 0 then begin
+ 				r := copyknot(p);
+ 				mem[q].hh.rh := r;
+ 				q := r
+ 			    end;
+ 			    mem[p].hh.b0 := 4;
+ 			    mem[q].hh.b1 := 4
+ 			end {:870};
+     25: {874:}
+ 			if curcmd = 46 then begin {879:}
+ 			    t := scandirection;
+ 			    if t <> 4 then begin
+ 				mem[q].hh.b1 := t;
+ 				mem[q + 5].int := curexp;
+ 				if mem[q].hh.b0 = 4 then begin
+ 				    mem[q].hh.b0 := t;
+ 				    mem[q + 3].int := curexp
+ 				end
+ 			    end
+ 			end {:879};
+ 			d := curcmd;
+ 			if d = 47 then begin {881:}
+ 			    getxnext;
+ 			    if curcmd = 58 then begin {882:}
+ 				getxnext;
+ 				y := curcmd;
+ 				if curcmd = 59 then 
+ 				    getxnext;
+ 				scanprimary; {883:}
+ 				if (curtype <> 16) or (curexp < 49152) then begin
+ 				    disperr(-30000, 690);
+ 				    begin
+ 					helpptr := 1;
+ 					helpline[0] := 691
+ 				    end;
+ 				    putgetflusherror(65536)
+ 				end {:883};
+ 				if y = 59 then 
+ 				    curexp := -curexp;
+ 				mem[q + 6].int := curexp;
+ 				if curcmd = 52 then begin
+ 				    getxnext;
+ 				    y := curcmd;
+ 				    if curcmd = 59 then 
+ 					getxnext;
+ 				    scanprimary; {883:}
+ 				    if (curtype <> 16) or (curexp < 49152) then begin
+ 					disperr(-30000, 690);
+ 					begin
+ 					    helpptr := 1;
+ 					    helpline[0] := 691
+ 					end;
+ 					putgetflusherror(65536)
+ 				    end {:883};
+ 				    if y = 59 then 
+ 					curexp := -curexp
+ 				end;
+ 				y := curexp
+ 			    end else if curcmd = 57 then begin {:882} {884:}
+ 				mem[q].hh.b1 := 1;
+ 				t := 1;
+ 				getxnext;
+ 				scanprimary;
+ 				knownpair;
+ 				mem[q + 5].int := curx;
+ 				mem[q + 6].int := cury;
+ 				if curcmd <> 52 then begin
+ 				    x := mem[q + 5].int;
+ 				    y := mem[q + 6].int
+ 				end else begin
+ 				    getxnext;
+ 				    scanprimary;
+ 				    knownpair;
+ 				    x := curx;
+ 				    y := cury
+ 				end
+ 			    end else begin {:884}
+ 				mem[q + 6].int := 65536;
+ 				y := 65536;
+ 				backinput;
+ 				goto 30
+ 			    end;
+ 			    if curcmd <> 47 then begin
+ 				missingerr(279);
+ 				begin
+ 				    helpptr := 1;
+ 				    helpline[0] := 689
+ 				end;
+ 				backerror
+ 			    end;
+     30: {:881}
+ 			    
+ 			end else if d <> 48 then 
+ 			    goto 26;
+ 			getxnext;
+ 			if curcmd = 46 then begin {880:}
+ 			    t := scandirection;
+ 			    if mem[q].hh.b1 <> 1 then 
+ 				x := curexp
+ 			    else 
+ 				t := 1
+ 			end else if mem[q].hh.b1 <> 1 then begin {:880}
+ 			    t := 4;
+ 			    x := 0
+ 			end {:874};
+ 			if curcmd = 36 then begin {886:}
+ 			    cyclehit := true;
+ 			    getxnext;
+ 			    pp := p;
+ 			    qq := p;
+ 			    if d = 48 then 
+ 				if p = q then begin
+ 				    d := 47;
+ 				    mem[q + 6].int := 65536;
+ 				    y := 65536
+ 				end
+ 			end else begin {:886}
+ 			    scantertiary; {885:}
+ 			    begin
+ 				if curtype <> 9 then 
+ 				    pp := newknot
+ 				else 
+ 				    pp := curexp;
+ 				qq := pp;
+ 				while mem[qq].hh.rh <> pp do 
+ 				    qq := mem[qq].hh.rh;
+ 				if mem[pp].hh.b0 <> 0 then begin
+ 				    r := copyknot(pp);
+ 				    mem[qq].hh.rh := r;
+ 				    qq := r
+ 				end;
+ 				mem[pp].hh.b0 := 4;
+ 				mem[qq].hh.b1 := 4
+ 			    end {:885}
+ 			end; {887:}
+ 			begin
+ 			    if d = 48 then 
+ 				if (mem[q + 1].int <> mem[pp + 1].int) or (mem[q + 2].int <> mem[pp + 2].int) then begin
+ 				    begin
+ 					if interaction = 3 then 
+ 					    ;
+ 					printnl(133);
+ 					print(692)
+ 				    end;
+ 				    begin
+ 					helpptr := 3;
+ 					helpline[2] := 693;
+ 					helpline[1] := 694;
+ 					helpline[0] := 695
+ 				    end;
+ 				    putgeterror;
+ 				    d := 47;
+ 				    mem[q + 6].int := 65536;
+ 				    y := 65536
+ 				end;
+ {889:}
+ 			    if mem[pp].hh.b1 = 4 then 
+ 				if (t = 3) or (t = 2) then begin
+ 				    mem[pp].hh.b1 := t;
+ 				    mem[pp + 5].int := x
+ 				end {:889};
+ 			    if d = 48 then begin {890:}
+ 				if mem[q].hh.b0 = 4 then 
+ 				    if mem[q].hh.b1 = 4 then begin
+ 					mem[q].hh.b0 := 3;
+ 					mem[q + 3].int := 65536
+ 				    end;
+ 				if mem[pp].hh.b1 = 4 then 
+ 				    if t = 4 then begin
+ 					mem[pp].hh.b1 := 3;
+ 					mem[pp + 5].int := 65536
+ 				    end;
+ 				mem[q].hh.b1 := mem[pp].hh.b1;
+ 				mem[q].hh.rh := mem[pp].hh.rh;
+ 				mem[q + 5].int := mem[pp + 5].int;
+ 				mem[q + 6].int := mem[pp + 6].int;
+ 				freenode(pp, 7);
+ 				if qq = pp then 
+ 				    qq := q
+ 			    end else begin {:890} {888:}
+ 				if mem[q].hh.b1 = 4 then 
+ 				    if (mem[q].hh.b0 = 3) or (mem[q].hh.b0 = 2) then begin
+ 					mem[q].hh.b1 := mem[q].hh.b0;
+ 					mem[q + 5].int := mem[q + 3].int
+ 				    end {:888};
+ 				mem[q].hh.rh := pp;
+ 				mem[pp + 4].int := y;
+ 				if t <> 4 then begin
+ 				    mem[pp + 3].int := x;
+ 				    mem[pp].hh.b0 := t
+ 				end
+ 			    end;
+ 			    q := qq
+ 			end {:887};
+ 			if curcmd >= 46 then 
+ 			    if curcmd <= 48 then 
+ 				if not cyclehit then 
+ 				    goto 25;
+     26: {891:}
+ 			if cyclehit then begin
+ 			    if d = 48 then 
+ 				p := q
+ 			end else begin
+ 			    mem[p].hh.b0 := 0;
+ 			    if mem[p].hh.b1 = 4 then begin
+ 				mem[p].hh.b1 := 3;
+ 				mem[p + 5].int := 65536
+ 			    end;
+ 			    mem[q].hh.b1 := 0;
+ 			    if mem[q].hh.b0 = 4 then begin
+ 				mem[q].hh.b0 := 3;
+ 				mem[q + 3].int := 65536
+ 			    end;
+ 			    mem[q].hh.rh := p
+ 			end;
+ 			makechoices(p);
+ 			curtype := 9;
+ 			curexp := p {:891}
+ 		    end else begin {:869}
+ 			getxnext;
+ 			scantertiary;
+ 			if d <> 49 then 
+ 			    dobinary(p, c)
+ 			else begin
+ 			    backinput;
+ 			    binarymac(p, c, macname);
+ 			    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 			    getxnext;
+ 			    goto 20
+ 			end
+ 		    end;
+ 		    goto 22
+ 		end;
+     10:
+ 	
+     end; {:868} {892:}
+ 
+     procedure getboolean;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 2 then begin
+ 	    disperr(-30000, 696);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 697;
+ 		helpline[0] := 698
+ 	    end;
+ 	    putgetflusherror(31);
+ 	    curtype := 2
+ 	end
+     end; {:892} {224:}
+ 
+     procedure printcapsule;
+     begin
+ 	printchar(40);
+ 	printexp(gpointer, 0);
+ 	printchar(41)
+     end;
+ 
+     procedure tokenrecycle;
+     begin
+ 	recyclevalue(gpointer)
+     end; {:224} {1205:}
+ 
+     procedure closefilesandtermina;
+     var
+ 	k: integer;
+ 	lh: integer;
+ 	p: halfword;
+ 	x: scaled;
+     {if internal[12]>0 then[1208:]if jobname>0 then begin writeln(
+     logfile,' ');
+     writeln(logfile,'Here is how much of METAFONT''s memory',' you used:');
+     write(logfile,' ',maxstrptr-initstrptr:1,' string');
+     if maxstrptr<>initstrptr+1 then write(logfile,'s');
+     writeln(logfile,' out of ',maxstrings-initstrptr:1);
+     writeln(logfile,' ',maxpoolptr-initpoolptr:1,
+     ' string characters out of ',poolsize-initpoolptr:1);
+     writeln(logfile,' ',lomemmax+30000+memend-himemmin+2:1,
+     ' words of memory out of ',memend+30001:1);
+     writeln(logfile,' ',stcount:1,' symbolic tokens out of ',2100:1);
+     writeln(logfile,' ',maxinstack:1,'i,',intptr:1,'n,',maxroundingptr:1,
+     'r,',maxparamstack:1,'p,',maxbufstack+1:1,'b stack positions out of ',
+     stacksize:1,'i,',maxinternal:1,'n,',maxwiggle:1,'r,',150:1,'p,',bufsize:
+     1,'b');end[:1208];}
+     begin
+ 	{1206:}
+ 	if (gfprevptr > 0) or (internal[33] > 0) then begin {1207:}
+ 	    rover := -29977;
+ 	    mem[rover].hh.rh := 32767;
+ 	    lomemmax := himemmin - 1;
+ 	    if (lomemmax - rover) > 32767 then 
+ 		lomemmax := 32767 + rover;
+ 	    mem[rover].hh.lh := lomemmax - rover;
+ 	    mem[rover + 1].hh.lh := rover;
+ 	    mem[rover + 1].hh.rh := rover;
+ 	    mem[lomemmax].hh.rh := -30000;
+ 	    mem[lomemmax].hh.lh := -30000 {:1207}; {1124:}
+ 	    mem[29999].hh.rh := -29981;
+ 	    for k := bc to ec do 
+ 		if charexists[k] then 
+ 		    tfmwidth[k] := sortin(tfmwidth[k]);
+ 	    nw := skimp(255) + 1;
+ 	    dimenhead[1] := mem[29999].hh.rh;
+ 	    if perturbation >= 4096 then 
+ 		tfmwarning(20) {:1124};
+ 	    fixdesignsize;
+ 	    fixchecksum;
+ 	    if internal[33] > 0 then begin {1126:}
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmheight[k] = 0 then 
+ 			    tfmheight[k] := -29985
+ 			else 
+ 			    tfmheight[k] := sortin(tfmheight[k]);
+ 		nh := skimp(15) + 1;
+ 		dimenhead[2] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(21);
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmdepth[k] = 0 then 
+ 			    tfmdepth[k] := -29985
+ 			else 
+ 			    tfmdepth[k] := sortin(tfmdepth[k]);
+ 		nd := skimp(15) + 1;
+ 		dimenhead[3] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(22);
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmitalcorr[k] = 0 then 
+ 			    tfmitalcorr[k] := -29985
+ 			else 
+ 			    tfmitalcorr[k] := sortin(tfmitalcorr[k]);
+ 		ni := skimp(63) + 1;
+ 		dimenhead[4] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(23) {:1126}; {1134:}
+ 		if jobname = 0 then 
+ 		    openlogfile;
+ 		packjobname(901);
+ 		while not bopenout(tfmfile, nameoffile) do 
+ 		    promptfilename(902, 901);
+ 		metricfilename := bmakenamestring(tfmfile); {1135:}
+ 		k := headersize;
+ 		while headerbyte[k] < 0 do 
+ 		    k := k - 1;
+ 		lh := (k + 3) div 4;
+ 		if bc > ec then 
+ 		    bc := 1;
+ 		bwrite2bytes(tfmfile, (((((((((6 + lh) + ((ec - bc) + 1)) + nw) + nh) + nd) + ni) + nl) + nk) + ne) + np);
+ 		bwrite2bytes(tfmfile, lh);
+ 		bwrite2bytes(tfmfile, bc);
+ 		bwrite2bytes(tfmfile, ec);
+ 		bwrite2bytes(tfmfile, nw);
+ 		bwrite2bytes(tfmfile, nh);
+ 		bwrite2bytes(tfmfile, nd);
+ 		bwrite2bytes(tfmfile, ni);
+ 		bwrite2bytes(tfmfile, nl);
+ 		bwrite2bytes(tfmfile, nk);
+ 		bwrite2bytes(tfmfile, ne);
+ 		bwrite2bytes(tfmfile, np);
+ 		for k := 1 to 4 * lh do begin
+ 		    if headerbyte[k] < 0 then 
+ 			headerbyte[k] := 0;
+ 		    bwritebyte(tfmfile, headerbyte[k])
+ 		end {:1135}; {1137:}
+ 		for k := bc to ec do 
+ 		    if not charexists[k] then 
+ 			bwrite4bytes(tfmfile, 0)
+ 		    else begin
+ 			bwritebyte(tfmfile, mem[tfmwidth[k]].hh.lh);
+ 			bwritebyte(tfmfile, (mem[tfmheight[k]].hh.lh * 16) + mem[tfmdepth[k]].hh.lh);
+ 			bwritebyte(tfmfile, (mem[tfmitalcorr[k]].hh.lh * 4) + chartag[k]);
+ 			bwritebyte(tfmfile, charremainder[k])
+ 		    end {:1137}; {1138:}
+ 		tfmchanged := 0;
+ 		for k := 1 to 4 do begin
+ 		    bwrite4bytes(tfmfile, 0);
+ 		    p := dimenhead[k];
+ 		    while p <> (-29981) do begin
+ 			bwrite4bytes(tfmfile, dimenout(mem[p + 1].int));
+ 			p := mem[p].hh.rh
+ 		    end
+ 		end {:1138}; {1139:}
+ 		for k := 0 to nl - 1 do 
+ 		    tfmqqqq(ligkern[k]);
+ 		for k := 0 to nk - 1 do 
+ 		    bwrite4bytes(tfmfile, dimenout(kern[k])) {:1139};
+ {1140:}
+ 		for k := 0 to ne - 1 do 
+ 		    tfmqqqq(exten[k]) {:1140}; {1141:}
+ 		for k := 1 to np do 
+ 		    if k = 1 then 
+ 			if abs(param[1]) < 134217728 then 
+ 			    bwrite4bytes(tfmfile, param[1] * 16)
+ 			else begin
+ 			    tfmchanged := tfmchanged + 1;
+ 			    if param[1] > 0 then 
+ 				bwrite4bytes(tfmfile, 2147483647)
+ 			    else 
+ 				bwrite4bytes(tfmfile, -2147483647)
+ 			end
+ 		    else 
+ 			bwrite4bytes(tfmfile, dimenout(param[k]));
+ 		if tfmchanged > 0 then begin
+ 		    if tfmchanged = 1 then 
+ 			printnl(904)
+ 		    else begin
+ 			printnl(40);
+ 			printint(tfmchanged);
+ 			print(905)
+ 		    end;
+ 		    print(906)
+ 		end {:1141};
+ {if internal[12]>0 then[1136:]begin writeln(logfile,' ');
+ writeln(logfile,'(You used ',nw:1,'w,',nh:1,'h,',nd:1,'d,',ni:1,'i,',nl:
+ 1,'l,',nk:1,'k,',ne:1,'e,',np:1,'p metric file positions');
+ writeln(logfile,'  out of ','256w,16h,16d,64i,',ligtablesize:1,
+ 'l,256k,256e,',maxfontdimen:1,'p)');end[:1136];}
+ 		printnl(903);
+ 		print(metricfilename);
+ 		bclose(tfmfile) {:1134}
+ 	    end;
+ 	    if gfprevptr > 0 then begin {1182:}
+ 		begin
+ 		    gfbuf[gfptr] := 248;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(gfprevptr);
+ 		gfprevptr := (gfoffset + gfptr) - 5;
+ 		gffour(internal[26] * 16);
+ 		for k := 1 to 4 do begin
+ 		    gfbuf[gfptr] := headerbyte[k];
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(internal[27]);
+ 		gffour(internal[28]);
+ 		gffour(gfminm);
+ 		gffour(gfmaxm);
+ 		gffour(gfminn);
+ 		gffour(gfmaxn);
+ 		for k := 0 to 255 do 
+ 		    if charexists[k] then begin
+ 			x := gfdx[k] div 65536;
+ 			if (((gfdy[k] = 0) and (x >= 0)) and (x < 256)) and (gfdx[k] = (x * 65536)) then begin
+ 			    begin
+ 				gfbuf[gfptr] := 246;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := k;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := x;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end
+ 			end else begin
+ 			    begin
+ 				gfbuf[gfptr] := 245;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := k;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    gffour(gfdx[k]);
+ 			    gffour(gfdy[k])
+ 			end;
+ 			x := mem[tfmwidth[k] + 1].int;
+ 			if abs(x) > maxtfmdimen then 
+ 			    if x > 0 then 
+ 				x := 16777215
+ 			    else 
+ 				x := -16777215
+ 			else 
+ 			    x := makescaled(x * 16, internal[26]);
+ 			gffour(x);
+ 			gffour(charptr[k])
+ 		    end;
+ 		begin
+ 		    gfbuf[gfptr] := 249;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(gfprevptr);
+ 		begin
+ 		    gfbuf[gfptr] := 131;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		k := 4 + ((gfbufsize - gfptr) mod 4);
+ 		while k > 0 do begin
+ 		    begin
+ 			gfbuf[gfptr] := 223;
+ 			gfptr := gfptr + 1;
+ 			if gfptr = gflimit then 
+ 			    gfswap
+ 		    end;
+ 		    k := k - 1
+ 		end; {1156:}
+ 		if gflimit = halfbuf then 
+ 		    bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1);
+ 		if gfptr > 0 then 
+ 		    bwritebuf(gffile, gfbuf, 0, gfptr - 1) {:1156};
+ 		printnl(917);
+ 		print(outputfilename);
+ 		print(425);
+ 		printint(totalchars);
+ 		print(918);
+ 		if totalchars <> 1 then 
+ 		    printchar(115);
+ 		print(919);
+ 		printint(gfoffset + gfptr);
+ 		print(920);
+ 		bclose(gffile)
+ 	    end {:1182}
+ 	end {:1206};
+ 	if jobname > 0 then begin
+ 	    writeln(logfile);
+ 	    aclose(logfile);
+ 	    selector := selector - 2;
+ 	    if selector = 1 then begin
+ 		printnl(929);
+ 		print(logname);
+ 		printchar(46)
+ 	    end
+ 	end;
+ 	println;
+ 	if (editnamestart <> 0) and (interaction > 0) then 
+ 	    calledit(strpool[editnamestart], editnamelength, editline)
+     end; {:1205} {1209:}
+ 
+     procedure finalcleanup;
+     label
+ 	10;
+     var
+ 	c: smallnumber;
+     begin
+ 	c := curmod;
+ 	if jobname = 0 then 
+ 	    openlogfile;
+ 	while condptr <> (-30000) do begin
+ 	    printnl(930);
+ 	    printcmdmod(2, curif);
+ 	    if ifline <> 0 then begin
+ 		print(931);
+ 		printint(ifline)
+ 	    end;
+ 	    print(932);
+ 	    ifline := mem[condptr + 1].int;
+ 	    curif := mem[condptr].hh.b1;
+ 	    condptr := mem[condptr].hh.rh
+ 	end;
+ 	if history <> 0 then 
+ 	    if (history = 1) or (interaction < 3) then 
+ 		if selector = 3 then begin
+ 		    selector := 1;
+ 		    printnl(933);
+ 		    selector := 3
+ 		end;
+ 	if c = 1 then begin {storebasefile;goto 10;}
+ 	    printnl(934);
+ 	    goto 10
+ 	end;
+     10:
+ 	
+     end; {:1209} {1210:}
+     {procedure initprim;begin[192:]primitive(280,40,1);
+     primitive(281,40,2);primitive(282,40,3);primitive(283,40,4);
+     primitive(284,40,5);primitive(285,40,6);primitive(286,40,7);
+     primitive(287,40,8);primitive(288,40,9);primitive(289,40,10);
+     primitive(290,40,11);primitive(291,40,12);primitive(292,40,13);
+     primitive(293,40,14);primitive(294,40,15);primitive(295,40,16);
+     primitive(296,40,17);primitive(297,40,18);primitive(298,40,19);
+     primitive(299,40,20);primitive(300,40,21);primitive(301,40,22);
+     primitive(302,40,23);primitive(303,40,24);primitive(304,40,25);
+     primitive(305,40,26);primitive(306,40,27);primitive(307,40,28);
+     primitive(308,40,29);primitive(309,40,30);primitive(310,40,31);
+     primitive(311,40,32);primitive(312,40,33);primitive(313,40,34);
+     primitive(314,40,35);primitive(315,40,36);primitive(316,40,37);
+     primitive(317,40,38);primitive(318,40,39);primitive(319,40,40);
+     [:192][211:]primitive(279,47,0);primitive(91,63,0);
+     eqtb[2232]:=eqtb[cursym];primitive(93,64,0);primitive(125,65,0);
+     primitive(123,46,0);primitive(58,78,0);eqtb[2234]:=eqtb[cursym];
+     primitive(329,77,0);primitive(44,79,0);primitive(59,80,0);
+     eqtb[2235]:=eqtb[cursym];primitive(92,7,0);primitive(330,18,0);
+     primitive(331,72,0);primitive(332,59,0);primitive(333,32,0);
+     bgloc:=cursym;primitive(334,57,0);primitive(335,19,0);
+     primitive(336,60,0);primitive(337,27,0);primitive(338,11,0);
+     primitive(323,81,0);eqtb[2239]:=eqtb[cursym];egloc:=cursym;
+     primitive(339,26,0);primitive(340,6,0);primitive(341,9,0);
+     primitive(342,70,0);primitive(343,73,0);primitive(344,13,0);
+     primitive(345,14,0);primitive(346,15,0);primitive(347,69,0);
+     primitive(348,28,0);primitive(349,24,0);primitive(350,12,0);
+     primitive(351,8,0);primitive(352,17,0);primitive(353,74,0);
+     primitive(354,35,0);primitive(355,58,0);primitive(356,71,0);
+     primitive(357,75,0);[:211][683:]primitive(520,16,1);primitive(521,16,2);
+     primitive(522,16,53);primitive(523,16,44);primitive(524,16,49);
+     primitive(324,16,0);eqtb[2237]:=eqtb[cursym];primitive(525,4,2242);
+     primitive(526,4,2392);primitive(527,4,1);primitive(325,4,0);
+     eqtb[2236]:=eqtb[cursym];[:683][688:]primitive(528,61,0);
+     primitive(529,61,1);primitive(64,61,2);primitive(530,61,3);
+     [:688][695:]primitive(541,56,2242);primitive(542,56,2392);
+     primitive(543,56,2542);primitive(544,56,1);primitive(545,56,2);
+     primitive(546,56,3);[:695][709:]primitive(556,3,0);primitive(482,3,1);
+     [:709][740:]primitive(583,1,1);primitive(322,2,2);
+     eqtb[2238]:=eqtb[cursym];primitive(584,2,3);primitive(585,2,4);
+     [:740][893:]primitive(218,33,30);primitive(219,33,31);
+     primitive(220,33,32);primitive(221,33,33);primitive(222,33,34);
+     primitive(223,33,35);primitive(224,33,36);primitive(225,33,37);
+     primitive(226,34,38);primitive(227,34,39);primitive(228,34,40);
+     primitive(229,34,41);primitive(230,34,42);primitive(231,34,43);
+     primitive(232,34,44);primitive(233,34,45);primitive(234,34,46);
+     primitive(235,34,47);primitive(236,34,48);primitive(237,34,49);
+     primitive(238,34,50);primitive(239,34,51);primitive(240,34,52);
+     primitive(241,34,53);primitive(242,34,54);primitive(243,34,55);
+     primitive(244,34,56);primitive(245,34,57);primitive(246,34,58);
+     primitive(247,34,59);primitive(248,34,60);primitive(249,34,61);
+     primitive(250,34,62);primitive(251,34,63);primitive(252,34,64);
+     primitive(253,34,65);primitive(254,34,66);primitive(255,34,67);
+     primitive(256,36,68);primitive(43,43,69);primitive(45,43,70);
+     primitive(42,55,71);primitive(47,54,72);eqtb[2233]:=eqtb[cursym];
+     primitive(257,45,73);primitive(181,45,74);primitive(259,52,76);
+     primitive(258,45,75);primitive(60,50,77);primitive(260,50,78);
+     primitive(62,50,79);primitive(261,50,80);primitive(61,51,81);
+     primitive(262,50,82);primitive(272,37,94);primitive(273,37,95);
+     primitive(274,37,96);primitive(275,37,97);primitive(276,37,98);
+     primitive(277,37,99);primitive(278,37,100);primitive(38,48,83);
+     primitive(263,55,84);primitive(264,55,85);primitive(265,55,86);
+     primitive(266,55,87);primitive(267,55,88);primitive(268,55,89);
+     primitive(269,55,90);primitive(270,55,91);primitive(271,45,92);
+     [:893][1013:]primitive(211,30,15);primitive(197,30,4);
+     primitive(195,30,2);primitive(202,30,9);primitive(199,30,6);
+     primitive(204,30,11);primitive(206,30,13);primitive(207,30,14);
+     [:1013][1018:]primitive(776,82,0);primitive(777,82,1);
+     [:1018][1024:]primitive(143,23,0);primitive(144,23,1);
+     primitive(145,23,2);primitive(783,23,3);
+     [:1024][1027:]primitive(784,21,0);primitive(785,21,1);
+     [:1027][1037:]primitive(799,22,0);primitive(800,22,1);
+     primitive(801,22,2);primitive(802,22,3);primitive(803,22,4);
+     [:1037][1052:]primitive(820,68,1);primitive(821,68,0);
+     primitive(822,68,2);primitive(823,66,6);primitive(824,66,16);
+     primitive(825,67,0);primitive(826,67,1);
+     [:1052][1079:]primitive(856,25,0);primitive(857,25,1);
+     primitive(858,25,2);[:1079][1101:]primitive(868,20,0);
+     primitive(869,20,1);primitive(870,20,2);primitive(871,20,3);
+     primitive(872,20,4);[:1101][1109:]primitive(889,76,0);
+     primitive(890,76,128);[:1109][1176:]primitive(912,29,4);
+     primitive(913,29,16);[:1176];end;procedure inittab;var k:integer;
+     begin[176:]rover:=-29977;mem[rover].hh.rh:=32767;mem[rover].hh.lh:=1000;
+     mem[rover+1].hh.lh:=rover;mem[rover+1].hh.rh:=rover;
+     lomemmax:=rover+1000;mem[lomemmax].hh.rh:=-30000;
+     mem[lomemmax].hh.lh:=-30000;
+     for k:=29998 to 30000 do mem[k]:=mem[lomemmax];avail:=-30000;
+     memend:=30000;himemmin:=29998;varused:=23;dynused:=-1;
+     [:176][193:]intname[1]:=280;intname[2]:=281;intname[3]:=282;
+     intname[4]:=283;intname[5]:=284;intname[6]:=285;intname[7]:=286;
+     intname[8]:=287;intname[9]:=288;intname[10]:=289;intname[11]:=290;
+     intname[12]:=291;intname[13]:=292;intname[14]:=293;intname[15]:=294;
+     intname[16]:=295;intname[17]:=296;intname[18]:=297;intname[19]:=298;
+     intname[20]:=299;intname[21]:=300;intname[22]:=301;intname[23]:=302;
+     intname[24]:=303;intname[25]:=304;intname[26]:=305;intname[27]:=306;
+     intname[28]:=307;intname[29]:=308;intname[30]:=309;intname[31]:=310;
+     intname[32]:=311;intname[33]:=312;intname[34]:=313;intname[35]:=314;
+     intname[36]:=315;intname[37]:=316;intname[38]:=317;intname[39]:=318;
+     intname[40]:=319;[:193][203:]hashused:=2229;stcount:=0;
+     hash[2240].rh:=321;hash[2238].rh:=322;hash[2239].rh:=323;
+     hash[2237].rh:=324;hash[2236].rh:=325;hash[2235].rh:=59;
+     hash[2234].rh:=58;hash[2233].rh:=47;hash[2232].rh:=91;hash[2231].rh:=41;
+     hash[2229].rh:=326;eqtb[2231].lh:=62;
+     [:203][229:]mem[-29981].hh.lh:=2242;mem[-29981].hh.rh:=-30000;
+     [:229][324:]mem[30000].hh.lh:=32767;
+     [:324][475:]mem[-29997].hh.lh:=-30000;mem[-29997].hh.rh:=-30000;
+     mem[-29996].hh.lh:=1;mem[-29996].hh.rh:=-30000;
+     for k:=-29995 to-29989 do mem[k]:=mem[-29996];mem[-29988].int:=0;
+     mem[-30000].hh.rh:=-30000;mem[-30000].hh.lh:=-30000;mem[-29999].int:=0;
+     mem[-29998].int:=0;[:475][587:]serialno:=0;mem[-29987].hh.rh:=-29987;
+     mem[-29986].hh.lh:=-29987;mem[-29987].hh.lh:=-30000;
+     mem[-29986].hh.rh:=-30000;[:587][702:]mem[-29979].hh.b1:=0;
+     mem[-29979].hh.rh:=2240;eqtb[2240].rh:=-29979;eqtb[2240].lh:=41;
+     [:702][759:]eqtb[2230].lh:=88;hash[2230].rh:=600;
+     [:759][911:]mem[-29983].hh.b1:=11;
+     [:911][1116:]mem[-29980].int:=1073741824;
+     [:1116][1127:]mem[-29984].int:=0;mem[-29985].hh.lh:=0;
+     [:1127][1185:]baseident:=921;[:1185]end;}
+ {:1210}
+ {1212:}
+ {procedure debughelp;label 888,10;var k,l,m,n:integer;
+ begin while true do begin;printnl(935);flush(output);read(input,m);
+ if m<0 then goto 10 else if m=0 then begin goto 888;
+ 888:m:=0;
+ ['BREAKPOINT']
+ end else begin read(input,n);case m of[1213:]1:printword(mem[n]);
+ 2:printint(mem[n].hh.lh);3:printint(mem[n].hh.rh);
+ 4:begin printint(eqtb[n].lh);printchar(58);printint(eqtb[n].rh);end;
+ 5:printvariablename(n);6:printint(internal[n]);7:doshowdependencies;
+ 9:showtokenlist(n,-30000,100000,0);10:print(n);11:checkmem(n>0);
+ 12:searchmem(n);13:begin read(input,l);printcmdmod(n,l);end;
+ 14:for k:=0 to n do print(buffer[k]);15:panicking:=not panicking;
+ [:1213]others:print(63)end;end;end;10:end;}
+ {:1212}
+ {:1202}
+ {1204:}
+ 
+ begin
+ {-----------------------------------}
+     init_ps(psfile);
+ {-----------------------------------}
+     history := 3;
+     setpaths;
+     if readyalready = 314159 then 
+ 	goto 1; {14:}
+     bad := 0;
+     if (halferrorline < 30) or (halferrorline > (errorline - 15)) then 
+ 	bad := 1;
+     if maxprintline < 60 then 
+ 	bad := 2;
+     if (gfbufsize mod 8) <> 0 then 
+ 	bad := 3;
+     if (-28900) > 30000 then 
+ 	bad := 4;
+     if 1777 > 2100 then 
+ 	bad := 5;
+     if (headersize mod 4) <> 0 then 
+ 	bad := 6; {:14} {154:}
+ {if memmax<>30000 then bad:=10;}
+     if memmax < 30000 then 
+ 	bad := 10;
+     if ((-128) > 0) or (127 < 127) then 
+ 	bad := 11;
+     if ((-32768) > 0) or (32767 < 32767) then 
+ 	bad := 12;
+     if ((-128) < (-32768)) or (127 > 32767) then 
+ 	bad := 13;
+     if ((-30000) < (-32768)) or (memmax >= 32767) then 
+ 	bad := 14;
+     if maxstrings > 32767 then 
+ 	bad := 15;
+     if bufsize > 32767 then 
+ 	bad := 16;
+     if (255 < 255) or (65535 < 65535) then 
+ 	bad := 17; {:154} {204:}
+     if (2241 + maxinternal) > 32767 then 
+ 	bad := 21; {:204} {214:}
+     if 2692 > 32767 then 
+ 	bad := 22; {:214} {310:}
+     if (15 * 11) > bistacksize then 
+ 	bad := 31; {:310} {553:}
+     if (20 + (17 * 45)) > bistacksize then 
+ 	bad := 32; {:553} {777:}
+     if 10 > filenamesize then 
+ 	bad := 41; {:777}
+     if bad > 0 then begin
+ 	writeln(output, 'Ouch---my internal constants have been clobbered!', '---case ', bad: 1);
+ 	{if not getstringsstarted then goto 9999;
+ 	inittab;initprim;}
+ 	goto 9999
+     end;
+     initialize;
+     readyalready := 314159;
+ 1: {55:}
+     selector := 1;
+     tally := 0;
+     termoffset := 0;
+     fileoffset := 0; {:55} {61:}
+     write(output, 'This is METAFONT, Version 1.0 for Berkeley UNIX');
+     {-----------------------------------------------------------------}
+     writeln(output);
+     writeln(output,'*** embedded METAFONT to PostScript Compiler ***');
+     {-----------------------------------------------------------------}
+     if baseident = 0 then 
+ 	writeln(output, ' (no base preloaded)')
+     else begin
+ 	print(baseident);
+ 	println
+     end;
+     flush(output); {:61} {783:}
+     jobname := 0; {:783}
+ {792:}
+     outputfilename := 0; {:792} {1211:} {657:}
+     begin
+ 	begin
+ 	    inputptr := 0;
+ 	    maxinstack := 0;
+ 	    inopen := 0;
+ 	    maxbufstack := 0;
+ 	    paramptr := 0;
+ 	    maxparamstack := 0;
+ 	    first := 1;
+ 	    curinput.startfield := 1;
+ 	    curinput.indexfield := 0;
+ 	    line := 0;
+ 	    curinput.namefield := 0;
+ 	    forceeof := false;
+ 	    if not initterminal then 
+ 		goto 9999;
+ 	    curinput.limitfield := last;
+ 	    first := last + 1
+ 	end; {:657} {660:}
+ 	scannerstatus := 0; {:660}
+ 	if (baseident = 0) or (buffer[curinput.locfield] = 38) then begin
+ 	    if baseident <> 0 then 
+ 		initialize;
+ 	    if not openbasefile then 
+ 		goto 9999;
+ 	    if not loadbasefile then begin
+ 		wclose(basefile);
+ 		goto 9999
+ 	    end;
+ 	    wclose(basefile);
+ 	    while (curinput.locfield < curinput.limitfield) and (buffer[curinput.locfield] = 32) do 
+ 		curinput.locfield := curinput.locfield + 1
+ 	end;
+ 	buffer[curinput.limitfield] := 37;
+ 	fixdateandtime;
+ 	initrandoms((internal[17] div 65536) + internal[16]); {70:}
+ 	if interaction = 0 then 
+ 	    selector := 0
+ 	else 
+ 	    selector := 1 {:70};
+ 	if curinput.locfield < curinput.limitfield then 
+ 	    if buffer[curinput.locfield] <> 92 then 
+ 		startinput
+     end {:1211};
+     initstrptr := strptr;
+     initpoolptr := poolptr;
+     maxstrptr := strptr;
+     maxpoolptr := poolptr;
+     history := 0;
+     if startsym > 0 then begin
+ 	cursym := startsym;
+ 	backinput
+     end;
+     maincontrol;
+     finalcleanup;
+ 9998:
+     closefilesandtermina;
+ 9999:
+     readyalready := 0;
+ {---------------------------------}
+ tini_ps(g);
+ {---------------------------------}
+     if (history <> 0) and (history <> 1) then 
+ 	exit(1)
+     else 
+ 	exit(0);
+ end. {:1204}
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p:1.1
*** /dev/null	Mon Feb 16 17:43:43 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p	Mon Feb 16 17:43:31 2004
***************
*** 0 ****
--- 1,9736 ----
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	Copyright (C) 1987 by Per Bergsten, Gothenburg, Sweden		  **)
+ (**									  **)
+ (**	No part of this program, or parts derived from this program,	  **)
+ (**	may be sold, hired or otherwise exploited without the author's	  **)
+ (**	written consent.						  **)
+ (**									  **)
+ (**	The program may be freely redistributed provided that:		  **)
+ (**									  **)
+ (**		1) the original program text, including this notice,	  **)
+ (**		   is reproduced unaltered,				  **)
+ (**		2) no charge (other than a nominal media cost) is	  **)
+ (**		   demanded for the copy.				  **)
+ (**									  **)
+ (**	The program may be included in a package only on the condition	  **)
+ (**	that the package as a whole is distributed at media cost.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	The program ptc is a Pascal-to-C translator.			  **)
+ (**	It accepts a correct Pascal program and creates a C program	  **)
+ (**	with the same behaviour. It is not a complete compiler in the	  **)
+ (**	sense that it does NOT do complete typechecking or error-	  **)
+ (**	reporting. Only a minimal typecheck is done so that the meaning	  **)
+ (**	of each construct can be determined. Therefore, an incorrect	  **)
+ (**	Pascal program can easily cause the translator to malfunction.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	Things which are known to be dependent on the underlying cha-	  **)
+ (**	racterset are marked with a comment containing the word	CHAR.	  **)
+ (**	Things that are known to be dependent on the host operating	  **)
+ (**	system are marked with a comment containing the word OS.	  **)
+ (**	Things known to be dependent on the cpu and/or the target C-	  **)
+ (**	implementation are marked with the word CPU.			  **)
+ (**	Things dependent on the target C-library are marked with LIB.	  **)
+ (**									  **)
+ (**	The code generated by the translator assumes that there	is a	  **)
+ (**	C-implementation with at least a reasonable <stdio> library	  **)
+ (**	since all input/output is implemented in terms of C functions	  **)
+ (**	like fprintf(), getc(), fopen(), rewind() etc.			  **)
+ (**	If the source-program uses Pascal functions like sin(), sqrt()	  **)
+ (**	etc, there must also exist such functions in the C-library.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ 
+ program	ptc(input, output);
+ 
+ label	9999;				(* end of program		*)
+ 
+ const	version		= '@(#)ptc.p	1.5  Date 87/05/01';
+ 
+ 	keytablen	= 38;		(* nr of keywords		*)
+ 	keywordlen	= 10;		(* length of a keyword		*)
+ 	othersym	= 'otherwise '; (* keyword for others		*)
+ 	externsym	= 'external  '; (* keyword for external		*)
+ 	dummysym	= '          '; (* dummy keyword		*)
+ 
+ 	(* a Pascal set is implemented as an array of "wordtype" where	*)
+ 	(* each element contains bits numbered from 0 to "setbits"	*)
+ 	wordtype	= 'unsigned short';	(* CPU *)
+ 	setbits		= 15;			(* CPU *)
+ 
+ 	(* a Pascal file is implemented as a struct which (among other	*)
+ 	(* things) contain a flag-field, currently 3 bits are used	*)
+ 	filebits	= 'unsigned short';	(* flags for files	*)
+ 	filefill	= 12;			(* 16 less used 3 bits	*)
+ 
+ 	maxsetrange	= 15;			(* nr of words in a set	*)
+ 	scalbase	= 0;	(* ordinal value of first scalar member	*)
+ 
+ 	maxprio		= 7;
+ 
+ 	maxmachdefs	= 8;	(* max nr of machine integer types	*)
+ 	machdeflen	= 16;	(* max length of machine int type name	*)
+ 
+ 	(* limit of identifier table, identifiers and strings are saved	*)
+ 	(* in an array 0 .. maxblkcnt of ^ array 0 .. maxstrblk of char	*)
+ 	maxstrblk	= 1023;
+ 	maxblkcnt	= 63;
+ 	maxstrstor	= 65535; (* maxstrstor should be ==
+ 					(maxblkcnt+1) * (maxstrblk+1) - 1 *)
+ 
+ 	maxtoknlen	= 127;	(* max size of token (i.e. identifier,
+ 				   string or number); must be > keywordlen
+ 				   and should be <= 256, see hashtokn()	*)
+ 
+ 	hashmax		= 64;	(* size of hashtable - 1		*)
+ 
+ 	null		= 0;	(* "impossible" character value, CHAR;
+ 				   a char with this value is used as delimiter
+ 				   of strings in "strstor" and in toknbuffers;
+ 				   it is also used as end-of-input marker by
+ 				   the input procedures in lexical analysis *)
+ 
+ 	minchar		= null;
+ 	maxchar		= 127;	(* greatest possible character, CHAR; limits
+ 				   the number of elements in type "char" *)
+ 
+ 	(* tmpfilename is used in the generated code to obtain names of
+ 	   temporary files for reset/rewrite, the last character is supplied
+ 	   by the reset/rewrite routine *)
+ 	tmpfilename	= '"/tmp/ptc%d%c", getpid(), '; (* OS *)
+ 
+ 	(* some frequently used characters *)
+ 	space		= ' ';
+ 	tab1		= '	';
+ 	tab2		= '		';
+ 	tab3		= '			';
+ 	tab4		= '				';
+ 	bslash		= '\';
+ 	nlchr		= '''\n''';
+ 	ffchr		= '''\f''';
+ 	nulchr		= '''\0''';
+ 	spchr		= ''' ''';
+ 	quote		= '''';
+ 	cite		= '"';
+ 	xpnent		= 'e';		(* exponent char in output. CPU	*)
+ 	percent		= '%';
+ 	uscore		= '_';
+ 	badchr		= '?';		(* CHAR *)
+ 	okchr		= quote;	(* CHAR *)
+ 
+ 	tabwidth	= 8;		(* width of a tab-stop. OS	*)
+ 
+ 	echo		= false; 	(* echo input as read		*)
+ 	diffcomm	= false; 	(* comment delimiters different	*)
+ 	lazyfor		= false; 	(* compile for-stmts a la C	*)
+ 	unionnew	= true; 	(* malloc unions for variants	*)
+ 
+ 	inttyp		= 'int';	(* for predefined functions	*)
+ 	chartyp		= 'char';
+ 	setwtyp		= 'setword';
+ 	setptyp		= 'setptr';
+ 	floattyp	= 'float';
+ 	doubletyp	= 'double';
+ 	dblcast		= '(double)';	(* for predefined functions	*)
+ 
+ 	realtyp		= doubletyp;	(* user real-vars and functions	*)
+ 
+ 	voidtyp		= 'void';	(* for procedures 		*)
+ 	voidcast	= '(void)';
+ 
+ 	intlen		= 10;		(* length of written integer	*)
+ 	fixlen		= 20;		(* length of written real	*)
+ 
+ type
+ 	hashtyp	= 0 .. hashmax;		(* index to hash-tables	*)
+ 
+ 	strindx	= 0 .. maxstrstor;	(* index to "strstor"		*)
+ 
+ 	(* string-table "strstor" is implemented as an array that is grown
+ 	   dynamically by adding blocks when needed *)
+ 	strbidx	= 0 .. maxstrblk;
+ 	strblk	= array [ strbidx ] of char;
+ 	strptr	= ^ strblk;
+ 	strbcnt	= 0 .. maxblkcnt;
+ 
+ 	(* table for stored identifiers *)
+ 	(* an identifier in any scope is represented by an idnode which is
+ 	   hooked to a slot in "idtab" as determined by a hash-function.
+ 	   whenever the input procedures find an identifier its idnode is
+ 	   immediately located, or created, if none was found; the identifier
+ 	   is then always handled though a pointer to the idnode. the actual
+ 	   text of the identifier is stored in "strstor". *)
+ 	idptr	= ^ idnode;
+ 	idnode	= record
+ 			inext	: idptr;	(* chain of idnode's	*)
+ 			inref	: 0 .. 127;	(* # of refs to this id	*)
+ 			ihash	: hashtyp;	(* its hash value	*)
+ 			istr	: strindx;	(* index to "strstor"	*)
+ 		  end;
+ 
+ 	(* toknbuf is used to handle identifiers and strings in those situations
+ 	   where the actual text is of intrest *)
+ 	toknidx	= 1 .. maxtoknlen;
+ 	toknbuf	= array [ toknidx ] of char;
+ 
+ 	(* a type to hold Pascal keywords *)
+ 	keyword	= packed array [ 1 .. keywordlen ] of char;
+ 
+ 	(* predefined identifier enumeration *)
+ 	predefs = (
+ 		dabs,		darctan,	dargc,		dargv,
+ 		dboolean,	dchar,		dchr,		dclose,
+ 		dcos,		ddispose,	deof,		deoln,
+ 		dexit,		dexp,		dfalse,		dflush,
+ 		dget,		dhalt,		dinput,		dinteger,
+ 		dln,		dmaxint,	dmessage,	dnew,
+ 		dodd,		dord,		doutput,	dpage,
+ 		dpack,		dpred,		dput,		dread,
+ 		dreadln,	dreal,		dreset,		drewrite,
+ 		dround,		dsin,		dsqr,		dsqrt,
+ 		dsucc,		dtext,		dtrue,		dtrunc,
+ 		dtan,		dwrite,		dwriteln,	dunpack,
+ 		dzinit,		dztring
+ 	);
+ 
+ 	(* lexical symbol enumeration *)
+ 	symtyp	= (
+ 	    (* keywords and eof are sorted alphabetically ...... *)
+ 		sand,		sarray,		sbegin,		scase,
+ 		sconst,		sdiv,		sdo,		sdownto,
+ 		selse,		send,		sextern,	sfile,
+ 		sfor,		sforward,	sfunc,		sgoto,
+ 		sif,		sinn,		slabel,		smod,
+ 		snil,		snot,		sof,		sor,
+ 		sother,		spacked,	sproc,		spgm,
+ 		srecord,	srepeat,	sset,		sthen,
+ 		sto,		stype,		suntil,		svar,
+ 		swhile,		swith,		seof,
+ 	    (* ...... sorted *)
+ 								sinteger,
+ 		sreal,		sstring,	schar,		sid,
+ 		splus,		sminus,		smul,		squot,
+ 		sarrow,		slpar,		srpar,		slbrack,
+ 		srbrack,	seq,		sne,		slt,
+ 		sle,		sgt,		sge,		scomma,
+ 		scolon,		ssemic,		sassign,	sdotdot,
+ 		sdot
+ 	);
+ 	symset	= set of symtyp;
+ 
+ 	(* lexical symbol definition *)
+ 	(* the lexical symbol holds a descriptor and the value of a symbol
+ 	   read by the input procedures; note that real values are represented
+ 	   as strings saved in "strstor" like ordinary strings to avoid using
+ 	   float-variables and float-arithmetic in the translator *)
+ 	lexsym	=
+ 	    record
+ 		case st : symtyp of
+ 		  sid:		(vid	: idptr);
+ 		  schar:	(vchr	: char);
+ 		  sinteger:	(vint	: integer);
+ 		  sreal:	(vflt	: strindx);
+ 		  sstring:	(vstr	: strindx);
+ 	    end;
+ 
+ 	(* enumeration of symnode variants *)
+ 	ltypes = (
+ 		lpredef,	lidentifier,	lfield,		lforward,
+ 		lpointer,	lstring,	llabel,		lforwlab,
+ 		linteger,	lreal,		lcharacter
+ 	);
+ 
+ 	declptr	= ^ declnode;
+ 	treeptr	= ^ treenode;
+ 	symptr	= ^ symnode;
+ 	(* identifier/literal symbol definition *)
+ 	(* in a given scope an identifier or a label is uniquely represented
+ 	   by a "symnode"; in order to have a uniform treatment of all objects
+ 	   occurring in the same syntactical positions (and hence in the parse-
+ 	   tree) the literal constants are represented in a similar manner *)
+ 	symnode	=
+ 	    record
+ 		lsymdecl	: treeptr;	(* symbol decl. point	*)
+ 		lnext		: symptr;	(* symtab chain pointer	*)
+ 		ldecl		: declptr;	(* backptr to symtab	*)
+ 		case lt : ltypes of
+ 		  lpredef,			(* a predefined id	*)
+ 		  lfield,			(* a record field	*)
+ 		  lpointer,			(* a pointer id		*)
+ 		  lidentifier,			(* an identifier	*)
+ 		  lforward:
+ 		    (
+ 			lid	: idptr;	(* ptr to its idnode	*)
+ 			lused	: boolean	(* true if symbol used	*)
+ 		    );
+ 		  lstring:			(* a string literal 	*)
+ 		    (
+ 			lstr	: strindx	(* index to "strstor"	*)
+ 		    );
+ 		  lreal:			(* a real literal	*)
+ 		    (
+ 			lfloat	: strindx	(* index to "strstor"	*)
+ 		    );
+ 		  lforwlab,			(* a declared label	*)
+ 		  llabel:			(* label decl & defined	*)
+ 		    (
+ 			lno	: integer;	(* label number		*)
+ 			lgo	: boolean	(* non-local usage	*)
+ 		    );
+ 		  linteger:			(* an integer literal	*)
+ 		    (
+ 			linum	: integer	(* its value		*)
+ 		    );
+ 		  lcharacter:			(* a character literal	*)
+ 		    (
+ 			lchar	: char		(* its value		*)
+ 		    )
+ 	    end;
+ 
+ 	(* symbol table definition *)
+ 	(* the symbol table consists of symnodes chained along the lnext
+ 	   field; the nodes are connected in reverse order of occurence (last
+ 	   declared, first in chain) in the slot in the declnode determined
+ 	   by the hashfunction; when a new scope is entered a new declnode is
+ 	   manufactured and the previous one is hooked to the dprev field, thus
+ 	   nested scopes are represented by a list of declnodes *)
+ 	declnode = record
+ 			dprev	: declptr;
+ 			ddecl	: array [ hashtyp ] of symptr
+ 		   end;
+ 
+ 	(* enumeration of nodes in parse tree *)
+ 	(* NOTE: the subrange [ assignment .. nil ]  have priorities *)
+ 	treetyp	= (
+ 		npredef,	npgm,		nfunc,		nproc,
+ 		nlabel,		nconst,		ntype,		nvar,
+ 		nvalpar,	nvarpar,	nparproc,	nparfunc,
+ 		nsubrange,	nvariant,	nfield,		nrecord,
+ 		narray,		nconfarr,	nfileof,	nsetof,
+ 		nbegin,		nptr,		nscalar,	nif,
+ 		nwhile,		nrepeat,	nfor,		ncase,
+ 		nchoise,	ngoto,		nwith,		nwithvar,
+ 		nempty,		nlabstmt,	nassign,	nformat,
+ 		nin,		neq,		nne,		nlt,
+ 		nle,		ngt,		nge,		nor,
+ 		nplus,		nminus,		nand,		nmul,
+ 		ndiv,		nmod,		nquot,		nnot,
+ 		numinus,	nuplus,		nset,		nrange,
+ 		nindex,		nselect,	nderef,		ncall,
+ 		nid,		nchar,		ninteger,	nreal,
+ 		nstring,	nnil,		npush,		npop,
+ 		nbreak
+ 	);
+ 
+ 	(* enumeration of predefined types *)
+ 	pretyps = (
+ 		tnone,		tboolean,	tchar,		tinteger,
+ 		treal,		tstring,	tnil,		tset,
+ 		ttext,		tpoly,		terror
+ 	);
+ 
+ 	(* enumeration of some special attributes *)
+ 	attributes = (
+ 		anone, aregister, aextern, areference
+ 	);
+ 
+ 	(* parse tree definition *)
+ 	(* the sourceprogram is represented by a treestructure built from
+ 	   treenodes where each node corresponds to one syntactic form from
+ 	   the pascal program *)
+ 	treenode =
+ 	    record
+ 		tnext,			(* ptr to next node in a list	*)
+ 		ttype,			(* pointer to nodes type	*)
+ 		tup	: treeptr;	(* ptr to parent node		*) 
+ 		case tt : treetyp of
+ 		  npredef:		(* predefined object decl	*)
+ 		    (
+ 			tdef:		(* predefined object descr.	*)
+ 				predefs;
+ 			tobtyp:		(* object type			*)
+ 				pretyps
+ 		    );
+ 		  npgm,			(* program declaration		*)
+ 		  nproc,		(* procedure declaration	*)
+ 		  nfunc:		(* function declaration		*)
+ 		    (
+ 			tsubid,		(* subr. identifier (nid)	*)
+ 			tsubpar,	(* parameter list		*)
+ 			tfuntyp,	(* function type (nid)		*)
+ 			tsublab,	(* label decl list (nlabel)	*)
+ 			tsubconst,	(* const decl list (nconst)	*)
+ 			tsubtype,	(* type decl list (ntype)	*)
+ 			tsubvar,	(* var decl list (nvar)		*)
+ 			tsubsub,	(* subr. decl (nproc/nfunc)	*)
+ 			tsubstmt:	(* stmt. list (NOT nbegin)	*)
+ 				treeptr;
+ 			tstat:		(* static declaration level	*)
+ 				integer;
+ 			tscope:		(* symbol table for local id's	*)
+ 				 declptr
+ 		    );
+ 		  nvalpar,		(* value parameter declaration	*)
+ 		  nvarpar,		(* var parameter declaration	*)
+ 		  nconst,		(* constant declaration		*)
+ 		  ntype,		(* type declaration		*)
+ 		  nfield,		(* record field declaration	*)
+ 		  nvar:			(* var declaration declaration	*)
+ 		    (
+ 			tidl,		(* list of declared id's (nid)	*)
+ 			tbind:		(* var/type-type, const-value	*)
+ 				treeptr;
+ 			tattr:		(* special attributes for vars	*)
+ 				attributes
+ 		    );
+ 		  nparproc,		(* parameter procedure		*)
+ 		  nparfunc:		(* parameter function		*)
+ 		    (
+ 			tparid,		(* parm proc/func id (nid)	*)
+ 			tparparm,	(* parm proc/func parm decl	*)
+ 			tpartyp:	(* parm func type (nid)		*)
+ 				treeptr
+ 		    );
+ 		  nptr:			(* pointer constructor		*)
+ 		    (
+ 			tptrid:		(* referenced type (nid)	*)
+ 				treeptr;
+ 			tptrflag:	(* have seen node before	*)
+ 				boolean
+ 		    );
+ 		  nscalar:		(* scalar type constructor	*)
+ 		    (
+ 			tscalid:	(* list of scalar ids (nid)	*)
+ 				treeptr
+ 		    );
+ 		  nfileof,		(* file type constructor	*)
+ 		  nsetof:		(* set type constructor		*)
+ 		    (
+ 			tof:		(* set/file component type	*)
+ 				treeptr
+ 		    );
+ 		  nsubrange:		(* subrange type constructor	*)
+ 		    (
+ 			tlo, thi:	(* subrange limits		*)
+ 				treeptr
+ 		    );
+ 		  nvariant:		(* record variant constructor	*)
+ 		    (
+ 			tselct,		(* selector list (constants)	*)
+ 			tvrnt:		(* variant field decl (nrecord)	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* the tuid field is used to attach a name to variants since
+ 		   C requires all union members to have names *)
+ 		  nrecord:		(* record/variant constructor	*)
+ 		    (
+ 			tflist,		(* fixed field list (nfield)	*)
+ 			tvlist:		(* variant list (nvariant)	*)
+ 				treeptr;
+ 			tuid:		(* variant name			*)
+ 				idptr;
+ 			trscope:	(* symbol table for local id's	*)
+ 				 declptr
+ 		    );
+ 		  nconfarr:		(* conformant array constructor	*)
+ 		    (
+ 			tcindx,		(* index declaration		*)
+ 			tindtyp,	(* conf. arr. index type (nid)	*)
+ 			tcelem:		(* array element type decl	*)
+ 				treeptr;
+ 			tcuid:		(* variant name			*)
+ 				idptr
+ 		    );
+ 		  narray:		(* array type constructor	*)
+ 		    (
+ 			taindx,		(* index declaration		*)
+ 			taelem:		(* array element type decl	*)
+ 				treeptr
+ 		    );
+ 		  nbegin:		(* begin statement		*)
+ 		    (
+ 			tbegin:		(* statement list		*)
+ 				treeptr
+ 		    );
+ 		  nlabstmt:		(* labeled statement		*)
+ 		    (
+ 			tlabno,		(* label number (nlabel)	*)
+ 			tstmt:		(* statement			*)
+ 				treeptr
+ 		    );
+ 		  ngoto:		(* goto statement		*)
+ 		    (
+ 			tlabel:		(* label to go to (nlabel)	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nassign:		(* assignment statement		*)
+ 		    (
+ 			tlhs,		(* variable			*)
+ 			trhs:		(* value			*)
+ 				treeptr
+ 		    );
+ 
+ 		(* npush/npop is used in proc/func which have local variables
+ 		   used in local proc/funcs; those variables are converted to
+ 		   global ptrs initialized to reference the local variable *)
+ 		  npush,		(* init code for proc/func	*)
+ 		  npop:			(* exit code for proc/func	*)
+ 		    (
+ 			tglob,		(* global identifier (nid)	*)
+ 			tloc,		(* local identifier (nid)	*)
+ 			ttmp:		(* temp store for global (nid)	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nbreak:
+ 		    (
+ 			tbrkid,		(* for-variable			*)
+ 			tbrkxp:		(* value for break		*)
+ 				treeptr
+ 		    );
+ 
+ 		  ncall:		(* procedure/function call	*)
+ 		    (
+ 			tcall,		(* called identifier		*)
+ 			taparm:		(* actual paramters		*)
+ 				treeptr
+ 		    );
+ 		  nif:			(* if statement			*)
+ 		    (
+ 			tifxp,		(* conditional expression	*)
+ 			tthen,		(* stmt execd if true condition	*)
+ 			telse:		(* stmt execd if true condition	*)
+ 				treeptr
+ 		    );
+ 		  nwhile:		(* while statemnet		*)
+ 		    (
+ 			twhixp,		(* conditional expression	*)
+ 			twhistmt:	(* stmt execd if true condition	*)
+ 				treeptr
+ 		    );
+ 		  nrepeat:		(* repeat statement		*)
+ 		    (
+ 			treptstmt,	(* statement list		*)
+ 			treptxp:	(* conditional expression	*)
+ 				treeptr
+ 		    );
+ 		  nfor:			(* for statement		*)
+ 		    (
+ 			tforid,		(* loop control variable (nid)	*)
+ 			tfrom,		(* initial value		*)
+ 			tto,		(* final value			*)
+ 			tforstmt:	(* stmt execd in loop		*)
+ 				treeptr;
+ 			tincr:		(* to/downto flag true <==> to	*)
+ 				boolean
+ 		    );
+ 		  ncase:		(* case statement		*)
+ 		    (
+ 			tcasxp,		(* selecting expression		*)
+ 			tcaslst,	(* list of choises		*)
+ 			tcasother:	(* default action		*)
+ 				treeptr
+ 		    );
+ 		  nchoise:		(* a choise in a case-stmt	*)
+ 		    (
+ 			tchocon,	(* list of constants		*)
+ 			tchostmt:	(* execd statement		*)
+ 				treeptr
+ 		    );
+ 		  nwith:		(* with statment		*)
+ 		    (
+ 			twithvar,	(* list of variables (nwithvar)	*)
+ 			twithstmt:	(* statement execd in new scope	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* the local symbol table holds identifiers, picked from
+ 		   the record fields, temporarily declared during parsing
+ 		   of remainder of with-statement; these identifiers are
+ 		   later converted into fields referenced through a ptr *)
+ 		  nwithvar:		(* variable in with statement	*)
+ 		    (
+ 			texpw:		(* record variable		*)
+ 				treeptr;
+ 			tenv:		(* symbol table for local scope	*)
+ 				declptr
+ 		    );
+ 
+ 		  nindex:		(* array indexing expression	*)
+ 		    (
+ 			tvariable,	(* indexed variable		*)
+ 			toffset:	(* index expression		*)
+ 				treeptr
+ 		    );
+ 		  nselect:		(* record field selection expr	*)
+ 		    (
+ 			trecord,	(* record variable		*)
+ 			tfield:		(* selected field (nid)		*)
+ 				treeptr
+ 		    );
+ 
+ 		(* binary operators or constructors *)
+ 		  nrange,		(* .. (set range)	*)
+ 		  nformat,		(* :  (write format)	*)
+ 		  nin,			(* in			*)
+ 		  neq,			(* =			*)
+ 		  nne,			(* <>			*)
+ 		  nlt,			(* <			*)
+ 		  nle,			(* <=			*)
+ 		  ngt,			(* >			*)
+ 		  nge,			(* >=			*)
+ 		  nor,			(* or			*)
+ 		  nplus,		(* +			*)
+ 		  nminus,		(* -			*)
+ 		  nand,			(* and			*)
+ 		  nmul,			(* *			*)
+ 		  ndiv,			(* div			*)
+ 		  nmod,			(* mod			*)
+ 		  nquot:		(* /			*)
+ 		    (
+ 			texpl,		(* left operand expr	*)
+ 			texpr:		(* right operand expr	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* unary operators or constructors; note that uplus is
+ 		   used to represent any parenthesized expression *)
+ 		  nderef,		(* ^ (ptr dereference)	*)
+ 		  nnot,			(* not			*)
+ 		  nset,			(* [ ] (set constr)	*)
+ 		  nuplus,		(* +			*)
+ 		  numinus:		(* -			*)
+ 		    (
+ 			texps:		(* operand expression	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nid,			(* identifier in decl or stmt	*)
+ 		  nreal,		(* literal real (decl or stmt)	*)
+ 		  ninteger,		(* literal int ( - " - )	*)
+ 		  nchar,		(* literal char ( - " - )	*)
+ 		  nstring,		(* literal string ( - " - )	*)
+ 		  nlabel:		(* label (decl, defpt or use)	*)
+ 		    (
+ 			tsym:
+ 				symptr
+ 		    );
+ 
+ 		  nnil,			(* nil (pointer constant)	*)
+ 		  nempty:		(* empty statement		*)
+ 		    ( );
+ 	    end;
+ 
+ 	(* "reserved" words and standard identifiers from C, C LIB and
+ 	    OS environment excluding those reserved in Pascal *)
+ 	cnames = (
+ 		cabort,		cbreak,		ccontinue,	cdefine,
+ 		cdefault,	cdouble,	cedata,		cenum,
+ 		cetext,		cextern,	cfgetc,		cfclose,
+ 		cfflush,	cfloat,		cfloor,		cfprintf,
+ 		cfputc,		cfread,		cfscanf,	cfwrite,
+ 		cgetc,		cgetpid,	cint,		cinclude,
+ 		clong,		clog,		cmain,		cmalloc,
+ 		cprintf,	cpower,		cputc,		cread,
+ 		creturn,	cregister,	crewind,	cscanf,
+ 		csetbits,	csetword,	csetptr,	cshort,
+ 		csigned,	csizeof,	csprintf,	cstdin,
+ 		cstdout,	cstderr,	cstrncmp,	cstrncpy,
+ 		cstruct,	cstatic,	cswitch,	ctypedef,
+ 		cundef,		cungetc,	cunion,		cunlink,
+ 		cunsigned,	cwrite
+ 	);
+ 
+ 	(* these are the detected errors. some are user-errors,
+ 	   some are internal problems and some are host system errors *)
+ 	errors	= (
+ 		ebadsymbol,	elongstring,	elongtokn,	erange,
+ 		emanytokn,	enotdeclid,	emultdeclid,	enotdecllab,
+ 		emultdecllab,	emuldeflab,	ebadstring,	enulchr,
+ 		ebadchar,	eeofcmnt,	eeofstr,	evarpar,
+ 		enew,		esetbase,	esetsize,	eoverflow,
+ 		etree,		etag,		euprconf,	easgnconf,
+ 		ecmpconf,	econfconf,	evrntfile,	evarfile,
+ 		emanymachs,	ebadmach
+ 	);
+ 
+ 	machdefstr = packed array [ 1 .. machdeflen ] of char;
+ 
+ var
+ 	usemax,			(* program needs max-function		*)
+ 	usejmps,		(* source program uses non-local gotos	*)
+ 	usecase,		(* source program has case-statement	*)
+ 	usesets,		(* source program uses set-operations	*)
+ 	useunion,
+ 	usediff,
+ 	usemksub,
+ 	useintr,
+ 	usesge,
+ 	usesle,
+ 	useseq,
+ 	usesne,
+ 	usememb,
+ 	useins,
+ 	usescpy,
+ 	usecomp,		(* source program uses string-compare	*)
+ 	usefopn,		(* source program uses reset/rewrite	*)
+ 	usescan,
+ 	usegetl,
+ 	usenilp,		(* source program uses nil-pointer 	*)
+ 	usebool	: boolean;	(* source program writes boolean-values	*)
+ 
+ 	top	: treeptr;	(* top of parsetree, result from parse	*)
+ 
+ 	setlst	: treeptr;	(* list of set-initializations		*)
+ 	setcnt	: integer;	(* counter for setlst length		*)
+ 
+ 	currsym	: lexsym;	(* current lexical symbol		*)
+ 
+ 	keytab	: array [ 0 .. keytablen ] of	(* table of keywords	*)
+ 		    record
+ 			wrd	: keyword;	(* keyword text		*)
+ 			sym	: symtyp	(* corresponding symbol	*)
+ 		    end;
+ 
+ 	strstor	: array [ strbcnt ] of strptr;	(* store for strings	*)
+ 	strfree	: strindx;			(* first free position	*)
+ 	strleft	: strbidx;			(* room in last blk	*)
+ 
+ 	idtab	: array [ hashtyp ] of idptr;	(* hashed table of id's	*)
+ 
+ 	symtab	: declptr;			(* table of symbols	*)
+ 
+ 	statlvl,				(* static decl. level	*)
+ 	maxlevel : integer;			(*  - " - maximum value	*) 
+ 
+ 	deftab	: array [ predefs ] of treeptr;	(* predefined idents.	*)
+ 	defnams	: array [ predefs ] of symptr;	(*        - " -		*)
+ 	typnods	: array [ pretyps ] of treeptr;	(* predef. types.	*)
+ 
+ 	pprio,
+ 	cprio	: array [ nassign .. nnil ] of 0 .. maxprio;
+ 
+ 	ctable	: array [ cnames ] of idptr;	(* table of C-keywords	*)
+ 
+ 	nmachdefs : 0 .. maxmachdefs;
+ 	machdefs : array [ 1 .. maxmachdefs ] of (* table of C-types	*)
+ 			record
+ 				lolim, hilim	: integer;
+ 				typstr		: strindx
+ 			end;
+ 
+ 	lineno,					(* input line number	*)
+ 	colno,					(* input column number	*)
+ 	lastcol,				(* last OK input column	*)
+ 	lastline : integer;			(* last OK input line	*)
+ 
+ 	lasttok	: toknbuf;			(* last input token	*)
+ 
+ 	varno	: integer;		(* counter for unique id's	*)
+ 
+ 	hexdig	: packed array [ 0 .. 15 ] of char;
+ 
+ (*	Prtmsg produces an error message. It asssumes that procedure	*)
+ (*	"message" (predefined) will "writeln" to user tty. OS		*)
+ procedure prtmsg(m : errors);
+ 
+ const	user	= 'Error: ';
+ 	restr	= 'Implementation restriction: ';
+ 	inter	= '* Internal error * ';
+ 	xtoklen	= 64;				(* should be <= maxtoklen *)
+ 
+ var	i	: toknidx;
+ 	xtok	: packed array [ 1 .. xtoklen ] of char;
+ 
+ begin
+ 	case m of
+ 	  ebadsymbol:
+ 		message(user, 'Unexpected symbol');
+ 	  ebadchar:
+ 		message(user, 'Bad character');
+ 	  elongstring:
+ 		message(restr, 'Too long string');
+ 	  ebadstring:
+ 		message(user, 'Newline in string or character');
+ 	  eeofstr:
+ 		message(user, 'End of file in string or character');
+ 	  eeofcmnt:
+ 		message(user, 'End of file in comment');
+ 	  elongtokn:
+ 		message(restr, 'Too long identfier');
+ 	  emanytokn:
+ 		message(restr, 'Too many strings, identifiers or real numbers');
+ 	  enotdeclid:
+ 		message(user, 'Identifier not declared');
+ 	  emultdeclid:
+ 		message(user, 'Identifier declared twice');
+ 	  enotdecllab:
+ 		message(user, 'Label not declared');
+ 	  emultdecllab:
+ 		message(user, 'Label declared twice');
+ 	  emuldeflab:
+ 		message(user, 'Label defined twice');
+ 	  evarpar:
+ 		message(user, 'Actual parameter not a variable');
+ 	  enulchr:
+ 		message(restr, 'Cannot handle nul-character in strings');
+ 	  enew:
+ 		message(restr, 'New returned a nil-pointer');
+ 	  eoverflow:
+ 		message(restr, 'Token buffer overflowed');
+ 	  esetbase:
+ 		message(restr, 'Cannot handle sets with base >> 0');
+ 	  esetsize:
+ 		message(restr, 'Cannot handle sets with very large range');
+ 	  etree:
+ 		message(inter, 'Bad tree structure');
+ 	  etag:
+ 		message(inter, 'Cannot find tag');
+ 	  evrntfile:
+ 		message(restr, 'Cannot initialize files in record variants');
+ 	  evarfile:
+ 		message(restr, 'Cannot handle files in structured variables');
+ 	  euprconf:
+ 		message(inter, 'No upper bound on conformant arrays');
+ 	  easgnconf:
+ 		message(inter, 'Cannot assign conformant arrays');
+ 	  ecmpconf:
+ 		message(inter, 'Cannot compare conformant arrays');
+ 	  econfconf:
+ 		message(restr, 'Cannot handle nested conformat arrays');
+ 	  erange:
+ 		message(inter, 'Cannot find C-type for integer-subrange');
+ 	  emanymachs:
+ 		message(restr, 'Too many machine integer types');
+ 	  ebadmach:
+ 		message(inter, 'Bad name for machine integer type');
+ 	end;(* case *)
+ 	if lastline <> 0 then
+ 	    begin
+ 		(* error detected during parsing,
+ 		    report line/column and print the offending symbol *)
+ 		message('Line ', lastline:1, ', col ', lastcol:1, ':');
+ 		if m in [enulchr, ebadchar, ebadstring, ebadsymbol,
+ 			emuldeflab, emultdecllab, enotdecllab, emultdeclid,
+ 			enotdeclid, elongtokn, elongstring] then
+ 		    begin
+ 			i := 1;
+ 			while (i < xtoklen) and (lasttok[i] <> chr(null)) do
+ 			    begin
+ 				xtok[i] := lasttok[i];
+ 				i := i + 1
+ 			    end;
+ 			while i < xtoklen do
+ 			    begin
+ 				xtok[i] := ' ';
+ 				i := i + 1
+ 			    end;
+ 			xtok[xtoklen] := ' ';
+ 			message('Current symbol: ', xtok)
+ 		    end
+ 	    end
+ end;
+ 
+ procedure fatal(m : errors);	forward;
+ procedure error(m : errors);	forward;
+ 
+ (*	Map letters to upper-case.					*)
+ (*	This function assumes a machine collating sequence where the	*)
+ (*	letters of either case form a contigous sequence, CHAR.	*)
+ function uppercase(c : char) : char;
+ 
+ begin
+ 	if (c >= 'a') and (c <= 'z') then
+ 		uppercase := chr(ord(c) + ord('A') - ord('a'))
+ 	else
+ 		uppercase := c
+ end;
+ 
+ 
+ (*	Map letters to lower-case.					*)
+ (*	This function assumes a machine collating sequence where the	*)
+ (*	letters of either case form a contigous sequence, CHAR.	*)
+ function lowercase(c : char) : char;
+ 
+ begin
+ 	if (c >= 'A') and (c <= 'Z') then
+ 		lowercase := chr(ord(c) - ord('A') + ord('a'))
+ 	else
+ 		lowercase := c
+ end;
+ 
+ (*	Retrieve a string from strstor.				*)
+ procedure gettokn(i : strindx; var t : toknbuf);
+ 
+ var	c	: char;
+ 	k	: toknidx;
+ 	j	: strbidx;
+ 	p	: strptr;
+ 
+ begin
+ 	k := 1;
+ 	(* compute block and offset in block *)
+ 	p := strstor[i div (maxstrblk + 1)];
+ 	j := i mod (maxstrblk + 1);
+ 	(* retrieve text up to null *)
+ 	repeat
+ 		c := p^[j];
+ 		t[k] := c;
+ 		j := j + 1;
+ 		k := k + 1;
+ 		if k = maxtoknlen then
+ 		    begin
+ 			c := chr(null);
+ 			t[maxtoknlen] := chr(null);
+ 			prtmsg(eoverflow)
+ 		    end
+ 	until	c = chr(null)
+ end;
+ 
+ (*	Deposit a string into strstor at a given start-position.	*)
+ procedure puttokn(i : strindx; var t : toknbuf);
+ 
+ var	c	: char;
+ 	k	: toknidx;
+ 	j	: strbidx;
+ 	p	: strptr;
+ 
+ begin
+ 	k := 1;
+ 	p := strstor[i div (maxstrblk + 1)];
+ 	j := i mod (maxstrblk + 1);
+ 	repeat
+ 		c := t[k];
+ 		p^[j] := c;
+ 		k := k + 1;
+ 		j := j + 1
+ 	until	c = chr(null)
+ end;
+ 
+ (*	Write a token on standard output.				*)
+ procedure writetok(var w : toknbuf);
+ 
+ var	j	: toknidx;
+ 
+ begin
+ 	j := 1;
+ 	while w[j] <> chr(null) do
+ 	    begin
+ 		write(w[j]);
+ 		j := j + 1
+ 	    end
+ end;
+ 
+ (*	Print a float number on standard output.			*)
+ procedure printtok(i : strindx);
+ 
+ var	w	: toknbuf;
+ 
+ begin
+ 	gettokn(i, w);
+ 	writetok(w)
+ end;
+ 
+ (*	Print an identifier on standard output.				*)
+ procedure printid(ip : idptr);
+ 
+ begin
+ 	printtok(ip^.istr)
+ end;
+ 
+ (*	Print a character on standard output with proper C-quoting.	*)
+ procedure printchr(c : char);
+ 
+ begin
+ 	if (c = quote) or (c = bslash) then
+ 		write(quote, bslash, c, quote)
+ 	else
+ 		write(quote, c, quote)
+ end;
+ 
+ (*	Print a string on standard output with proper C-quoting.	*)
+ procedure printstr(i : strindx);
+ 
+ var	k	: toknidx;
+ 	c	: char;
+ 	w	: toknbuf;
+ 
+ begin
+ 	gettokn(i, w);
+ 	write(cite);
+ 	k := 1;
+ 	while w[k] <> chr(null) do
+ 	    begin
+ 		c := w[k];
+ 		k := k + 1;
+ 		if (c = cite) or (c = bslash) then
+ 			write(bslash);
+ 		write(c)
+ 	    end;
+ 	write(cite)
+ end;
+ 
+ (*	Return a pointer to the declarationpoint of an identifier.	*)
+ function idup(ip : treeptr) : treeptr;
+ 
+ begin
+ 	idup := ip^.tsym^.lsymdecl^.tup
+ end;
+ 
+ (*	Compute a hashvalue for an identifier or a string.		*)
+ function hashtokn(var id : toknbuf) : hashtyp;
+ 
+ var	h	: integer;
+ 	i	: toknidx;
+ 
+ begin
+ 	i := 1;
+ 	h := 0;
+ 	while id[i] <> chr(null) do
+ 	    begin
+ 		(* if ord() of a character ranges from 0 to 127 then we can loop
+ 		   256 times without causing h to exceed 32767, this is safe as
+ 		   both strings and identifiers are limited in length *)
+ 		h := h + ord(id[i]);	(* CHAR, CPU *)
+ 		i := i + 1
+ 	    end;
+ 	hashtokn := h mod hashmax
+ end;
+ 
+ (*	Global string table update.					*)
+ (*	This function accepts a string and stores it in strstor.	*)
+ (*	It returns the id-number for the new string.			*)
+ function savestr(var t : toknbuf) : strindx;
+ 
+ var	k	: toknidx;
+ 	i	: strindx;
+ 	j	: strbcnt;
+ 
+ begin
+ 	(* find length of new string including null-char *)
+ 	k := 1;
+ 	while t[k] <> chr(null) do
+ 		k := k + 1;
+ 	if k > strleft then
+ 	    begin
+ 		(* out of space in strstore *)
+ 		if strstor[maxblkcnt] <> nil then	(* last slot used *)
+ 			error(emanytokn);
+ 		(* allocate a new block *)
+ 		j := (strfree + maxstrblk) div (maxstrblk + 1);
+ 		new(strstor[j]);
+ 		if strstor[j] = nil then
+ 			error(enew);
+ 		strfree := j * (maxstrblk + 1);
+ 		strleft := maxstrblk
+ 	    end;
+ 	(* copy new str, update location of last used cell,
+ 	   return starting location for new str *)
+ 	i := strfree;
+ 	strfree := strfree + k;
+ 	strleft := strleft - k;
+ 	puttokn(i, t);
+ 	savestr := i
+ end;
+ 
+ (*	Global id table lookup.						*)
+ (*	This procedure accepts an identifier and determines if it has	*)
+ (*	been seen before. If that is the case a pointer to its idnode	*)
+ (*	is returned, otherwise the identifier is saved and a pointer to	*)
+ (*	a new node is returned.						*)
+ function saveid(var id : toknbuf) : idptr;
+ 
+ label	999;
+ 
+ var	k	: toknidx;
+ 	ip	: idptr;
+ 	h	: hashtyp;
+ 	t	: toknbuf;
+ 
+ begin
+ 	h := hashtokn(id);
+ 	ip := idtab[h];				(* scan hashlist for id	*)
+ 	while ip <> nil do
+ 	    begin
+ 		gettokn(ip^.istr, t);		(* look at saved token	*)
+ 		k := 1;
+ 		while id[k] = t[k] do
+ 			if id[k] = chr(null) then
+ 				goto 999	(* found it!		*)
+ 			else
+ 				k := k + 1;	(* look at next char	*)
+ 		ip := ip^.inext
+ 	    end;
+ 
+ 	(* identifier wasn't previously seen, manufacture a new idnode,
+ 	   save index to strstor and hashvalue, insert idnode in idtab *)
+ 	new(ip);
+ 	if ip = nil then
+ 		error(enew);
+ 	ip^.inref := 0;
+ 	ip^.istr := savestr(id);
+ 	ip^.ihash := h;
+ 	ip^.inext := idtab[h];
+ 	idtab[h] := ip;
+ 
+ 999:
+ 	(* return the idnode *)
+ 	saveid := ip
+ end;
+ 
+ (*	This function creates a new variable by concatenating one name	*)
+ (*	with another injecting a given separator.			*)
+ function mkconc(sep : char; p, q : idptr) : idptr;
+ 
+ var	w, x	: toknbuf;
+ 	i, j	: toknidx;
+ 
+ begin
+ 	(* fetch second part and determine its length *)
+ 	gettokn(q^.istr, x);
+ 	j := 1;
+ 	while x[j] <> chr(null) do
+ 		j := j + 1;
+ 	(* fetch first part and locate its end *)
+ 	w[1] := chr(null);
+ 	if p <> nil then
+ 		gettokn(p^.istr, w);
+ 	i := 1;
+ 	while w[i] <> chr(null) do
+ 		i := i + 1;
+ 	(* check total length *)
+ 	if i + j + 2 >= maxtoknlen then
+ 		error(eoverflow);
+ 
+ 	(* add separators *)
+ 	if sep = '>' then
+ 	    begin
+ 		(* special case 1: > gives arrow: a->b *)
+ 		w[i] := '-';
+ 		i := i + 1
+ 	    end;
+ 	if sep <> space then
+ 	    begin
+ 		(* special case 2: space gives nothing: ab *)
+ 		w[i] := sep;
+ 		i := i + 1
+ 	    end;
+ 	(* add second part *)
+ 	j := 1;
+ 	repeat
+ 		w[i] := x[j];
+ 		i := i + 1;
+ 		j := j + 1
+ 	until w[i-1] = chr(null);
+ 	(* save new identifier *)
+ 	mkconc := saveid(w)
+ end;
+ 
+ (*	Create a new id with name-prefix from w.			*)
+ function mkuniqname(var t : toknbuf) : idptr;
+ 
+ var	i	: toknidx;
+ 
+ 	procedure dig(n : integer);
+ 	begin
+ 		if n > 0 then
+ 		    begin
+ 			dig(n div 10);
+ 			if i = maxtoknlen then
+ 				error(eoverflow);
+ 			t[i] := chr(n mod 10 + ord('0'));	(* CHAR *)
+ 			i := i + 1
+ 		    end
+ 	end;
+ 
+ begin
+ 	i := 1;
+ 	while t[i] <> chr(null) do
+ 		i := i + 1;
+ 	varno := varno + 1;
+ 	dig(varno);
+ 	t[i] := chr(null);
+ 	mkuniqname := saveid(t)
+ end;
+ 
+ (*	Make a new unique variable with given char as prefix.		*)
+ function mkvariable(c : char) : idptr;
+ 
+ var	t	: toknbuf;
+ 
+ begin
+ 	t[1] := c;
+ 	t[2] := chr(null);
+ 	mkvariable := mkuniqname(t)
+ end;
+ 
+ (*	Make a new unique variable with given char as prefix and	*)
+ (*	with a given id as tail. Commonly used for renaming id's.	*)
+ function mkrename(c : char; ip : idptr) : idptr;
+ 
+ begin
+ 	mkrename := mkconc(uscore, mkvariable(c), ip)
+ end;
+ 
+ (*	Make a name for a variant. Variants are mapped onto C unions,	*)
+ (*	which we always give the name "U", thus the name of the variant	*)
+ (*	becomes "U.Vnnn" where "nnn" is a unique number.		*)
+ function mkvrnt : idptr;
+ 
+ var	t	: toknbuf;
+ 
+ begin
+ 	t[1] := 'U';
+ 	t[2] := '.';
+ 	t[3] := 'V';
+ 	t[4] := chr(null);
+ 	mkvrnt := mkuniqname(t)
+ end;
+ 
+ procedure checksymbol(ss : symset);
+ begin
+ 	if not (currsym.st in ss) then
+ 		error(ebadsymbol);
+ end;
+ 
+ (*	Lexical analysis routine.					*)
+ (*	This procedure reads and classifies the next lexical token in	*)
+ (*	the input stream. The token is saved in the global variable	*)
+ (*	"currsym". The found symbol should be one of the symbols given	*)
+ (*	in the parameter "ss" otherwise the error routine is called.	*)
+ procedure nextsymbol(ss : symset);
+ 
+ var	lastchr	: 0 .. maxtoknlen;
+ 
+ 	(*	This function reads the next character from the input	*)
+ 	(*	and updates "lineno" and "colno" accordingly.		*)
+ 	function nextchar : char;
+ 
+ 	var	c	: char;
+ 
+ 	begin
+ 		if eof then
+ 			c := chr(null)
+ 		else begin
+ 			colno := colno + 1;
+ 			if eoln then
+ 			    begin
+ 				lineno := lineno + 1;
+ 				colno := 0
+ 			    end;
+ 			read(c);
+ 			if echo then
+ 				if colno = 0 then
+ 					writeln
+ 				else
+ 					write(c);
+ 			if c = tab1 then
+ 				colno := ((colno div tabwidth) + 1) * tabwidth
+ 		     end;
+ 		if lastchr > 0 then
+ 		    begin
+ 			lasttok[lastchr] := c;
+ 			lastchr := lastchr + 1
+ 		    end;
+ 		nextchar := c
+ 	end;
+ 
+ 	(*	This function looks at the next input character.	*)
+ 	function peekchar : char;
+ 
+ 	begin
+ 		if eof then
+ 			peekchar := chr(null)
+ 		else
+ 			peekchar := input^
+ 	end;
+ 
+ 	(*	Read and classify the next token.			*)
+ 	procedure nexttoken(realok : boolean);
+ 
+ 	var	c	: char;
+ 		n	: integer;
+ 
+ 		ready	: boolean;
+ 
+ 		wl	: toknidx;
+ 		wb	: toknbuf;
+ 
+ 		(*	Determine if c is valid in an identifier.	*)
+ 		(*	This function assumes a machine collating	*)
+ 		(*	sequence where letters and digits form conti-	*)
+ 		(*	gous sequences, CHAR.				*)
+ 		function idchar(c : char) : boolean;
+ 
+ 		begin
+ 			idchar := 
+ 				(c >= 'a') and (c <= 'z') or
+ 				    (c >= '0') and (c <= '9') or
+ 					(c >= 'A') and (c <= 'Z') or
+ 					    (c = uscore)
+ 		end;
+ 
+ 		(*	Determine if c is valid in a number. CHAR.	*)
+ 		function numchar(c : char) : boolean;
+ 
+ 		begin
+ 			numchar := (c >= '0') and (c <= '9')
+ 		end;
+ 
+ 		(*	Convert a digit to its numeric value. CHAR	*)
+ 		function numval(c : char) : integer;
+ 
+ 		begin
+ 			numval := ord(c) - ord('0')
+ 		end;
+ 
+ 		(*	Determine if the current token is a keyword.	*)
+ 		function keywordcheck(var w : toknbuf; l : toknidx) : symtyp;
+ 
+ 		var	n	: 1 .. keywordlen;
+ 			i, j, k	: 0 .. keytablen;
+ 			wrd	: keyword;
+ 			kwc	: symtyp;
+ 
+ 		begin
+ 			(* quick check on token length,
+ 			   pascal keywords range from 2 to 9 chars in length *)
+ 			if (l > 1) and (l < keywordlen) then
+ 			    begin
+ 				(* could be a keyword, initialize wrd *)
+ 				wrd := keytab[keytablen].wrd;
+ 				(* copy w to wrd *)
+ 				for n := 1 to l do
+ 					wrd[n] := w[n];
+ 
+ 				(* binary search for tokn,
+ 				   relies on symtyp being sorted *)
+ 				i := 0;
+ 				j := keytablen;
+ 				while j > i do
+ 				    begin
+ 					k := (i + j) div 2;
+ 					if keytab[k].wrd >= wrd then
+ 						j := k
+ 					else
+ 						i := k + 1
+ 				    end;
+ 				if keytab[j].wrd = wrd then
+ 					kwc := keytab[j].sym
+ 				else
+ 					kwc := sid
+ 			    end
+ 			else
+ 				kwc := sid;
+ 			keywordcheck := kwc
+ 		end;
+ 
+ 	begin	(* nexttoken *)
+ 		(* don't save blanks/comments *)
+ 		lastchr := 0;
+ 		(* read non-blank character *)
+ 		repeat
+ 			c := nextchar;
+ 			(* skip comments, the two comment delimiters of pascal
+ 			   are treated as different if "diffcomm" is true *)
+ 			if c = '{' then
+ 			    begin
+ 				repeat
+ 					c := nextchar;
+ 					if diffcomm then
+ 						ready := c = '}'
+ 					else
+ 						ready := ((c = '*') and
+ 							    (peekchar = ')'))
+ 							or (c = '}')
+ 				until ready or eof;
+ 				if eof and not ready then
+ 					error(eeofcmnt);
+ 				if (c = '*') and not eof then
+ 					c := nextchar;
+ 				c := space
+ 			    end
+ 			else if (c = '(') and (peekchar = '*')  then
+ 			    begin
+ 				c := nextchar;
+ 				repeat
+ 					c := nextchar;
+ 					if diffcomm then
+ 						ready := (c = '*') and
+ 							(peekchar = ')')
+ 					else
+ 						ready := ((c = '*') and
+ 							    (peekchar = ')'))
+ 							or (c = '}')
+ 				until ready or eof;
+ 				if eof and not ready then
+ 					error(eeofcmnt);
+ 				if (c = '*') and not eof then
+ 					c := nextchar;
+ 				c := space
+ 			    end
+ 		until	(c <> space) and (c <> tab1);
+ 
+ 		(* save characters from this token and save line- and column-
+ 		   numbers for errormessages *)
+ 		lasttok[1] := c;
+ 		lastchr := 2;
+ 		lastcol := colno;
+ 		lastline := lineno;
+ 
+ 		(* map all CHAR control characters onto "badchr" *)
+ 		if c < okchr then
+ 			c := badchr;
+ 
+ 		(* decode symbol *)
+ 		with currsym do
+ 		    if eof then
+ 			begin
+ 				lasttok[1] := '*';
+ 				lasttok[2] := 'E';
+ 				lasttok[3] := 'O';
+ 				lasttok[4] := 'F';
+ 				lasttok[5] := '*';
+ 				lastchr := 6;
+ 				st := seof
+ 			end
+ 		    else
+ 			case c of
+ 
+ 
+ 			(* CHAR, chars not in Pascal *)
+ 			  '|', '`', '~', '}',
+ 			  bslash, uscore, badchr:
+ 				error(ebadchar);
+ 
+ 			(* identifiers or keywords *)
+ 			  'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
+ 			  'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't',
+ 			  'u', 'v', 'w', 'x', 'y', 'z',
+ 			  'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
+ 			  'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
+ 			  'U', 'V', 'W', 'X', 'Y', 'Z':
+ 			    begin
+ 				(* read token into buffer *)
+ 				wb[1] := lowercase(c);
+ 				wl := 2;
+ 				while (wl < maxtoknlen) and idchar(peekchar) do
+ 				    begin
+ 					wb[wl] := lowercase(nextchar);
+ 					wl := wl + 1
+ 				    end;
+ 				if wl >= maxtoknlen then
+ 				    begin
+ 					lasttok[lastchr] := chr(null);
+ 					error(elongtokn)
+ 				    end;
+ 				(* terminate token and match *)
+ 				wb[wl] := chr(null);
+ 				(* check if keyword/identifier *)
+ 				st := keywordcheck(wb, wl-1);
+ 				if st = sid then
+ 					vid := saveid(wb)
+ 			    end;
+ 
+ 			(* integer or real numbers *)
+ 			  '0', '1', '2', '3', '4', '5', '6', '7' ,'8', '9':
+ 			    begin
+ 				(* assume integer number, save it in buffer *)
+ 				wb[1] := c;
+ 				wl := 2;
+ 				n := numval(c);
+ 				while numchar(peekchar) do
+ 				    begin
+ 					c := nextchar;
+ 					n := n * 10 + numval(c);
+ 					wb[wl] := c;
+ 					wl := wl + 1
+ 				    end;
+ 				st := sinteger;
+ 				vint := n;
+ 				if realok then
+ 				    begin
+ 					(* accept real numbers *)
+ 					if peekchar = '.' then
+ 					    begin
+ 						(* this is a real number *)
+ 						st := sreal;
+ 						wb[wl] := nextchar;
+ 						wl := wl + 1;
+ 						while numchar(peekchar) do
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end
+ 					    end;
+ 					c := peekchar;
+ 					if (c = 'e') or (c = 'E') then
+ 					    begin
+ 						(* this is a real number *)
+ 						st := sreal;
+ 						c := nextchar;
+ 						wb[wl] := xpnent;
+ 						wl := wl + 1;
+ 						c := peekchar;
+ 						if (c = '-') or (c = '+') then
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end;
+ 						while numchar(peekchar) do
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end
+ 					    end;
+ 					if st = sreal then
+ 					    begin
+ 						wb[wl] := chr(null);
+ 						vflt := savestr(wb)
+ 					    end
+ 				    end
+ 			    end;
+ 
+ 			  '(':
+ 				if peekchar = '.' then
+ 				    begin
+ 					(* some compilers on non-ascii systems
+ 					   use (. for [ and .) for ] *)
+ 					c := nextchar;
+ 					st := slbrack
+ 				    end
+ 				else
+ 					st := slpar;
+ 			  ')':
+ 				st := srpar;
+ 			  '[':
+ 				st := slbrack;
+ 			  ']':
+ 				st := srbrack;
+ 			  '.':
+ 				if peekchar = '.' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sdotdot
+ 				    end
+ 				else if peekchar = ')' then
+ 				    begin
+ 					c := nextchar;
+ 					st := srbrack
+ 				    end
+ 				else
+ 					st := sdot;
+ 			  ';':
+ 				st := ssemic;
+ 			  ':':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sassign
+ 				    end
+ 				else
+ 					st := scolon;
+ 			  ',':
+ 				st := scomma;
+ 			  '@',
+ 			  '^':
+ 				st := sarrow;
+ 			  '=':
+ 				st := seq;
+ 			  '<':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sle
+ 				    end
+ 				else if peekchar = '>' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sne
+ 				    end
+ 				else
+ 					st := slt;
+ 			  '>':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sge
+ 				    end
+ 				else
+ 					st := sgt;
+ 			  '+':
+ 				st := splus;
+ 			  '-':
+ 				st := sminus;
+ 			  '*':
+ 				st := smul;
+ 			  '/':
+ 				st := squot;
+ 			  quote:
+ 			    begin
+ 				(* assume the symbol is a literal string *)
+ 				wl := 0;
+ 				ready := false;
+ 				repeat
+ 					if eoln then
+ 					    begin
+ 						lasttok[lastchr] := chr(null);
+ 						error(ebadstring)
+ 					    end;
+ 					c := nextchar;
+ 					if c = quote then
+ 						if peekchar = quote then
+ 							c := nextchar
+ 						else
+ 							ready := true;
+ 					if c = chr(null) then
+ 					    begin
+ 						if eof then
+ 							error(eeofstr);
+ 						lasttok[lastchr] := chr(null);
+ 						error(enulchr)
+ 					    end;
+ 					if not ready then
+ 					    begin
+ 						wl := wl + 1;
+ 						if wl >= maxtoknlen then
+ 						    begin
+ 							lasttok[lastchr] :=
+ 								chr(null);
+ 							error(elongstring)
+ 						    end;
+ 						wb[wl] := c
+ 					    end
+ 				until	ready;
+ 				if wl = 1 then
+ 				    begin
+ 					(* only 1 character => not a string *)
+ 					st := schar;
+ 					vchr := wb[1]
+ 				    end
+ 				else begin
+ 					(* > 1 character => its a string *)
+ 					wl := wl + 1;
+ 					if wl >= maxtoknlen then
+ 					    begin
+ 						lasttok[lastchr] := chr(null);
+ 						error(elongstring)
+ 					    end;
+ 					wb[wl] := chr(null);
+ 					st := sstring;
+ 					vstr := savestr(wb)
+ 				     end
+ 			    end
+ 
+ 			end;(* case *)
+ 		if lastchr = 0 then
+ 			lastchr := 1;
+ 		lasttok[lastchr] := chr(null)
+ 	end;	(* nexttoken *)
+ 
+ begin	(* nextsymbol *)
+ 	nexttoken(sreal in ss);
+ 	checksymbol(ss)
+ end;	(* nextsymbol *)
+ 
+ (*	Return a pointer to the node describing the type of tp. This	*)
+ (*	function also stores the result in the node for future ref.	*)
+ function typeof(tp : treeptr) : treeptr;
+ 
+ var	tf, tq	: treeptr;
+ 
+ begin
+ 	tq := tp;
+ 	tf := tq^.ttype;
+ 	(* keep working until a type is found *)
+ 	while tf = nil do
+ 	    begin
+ 		case tq^.tt of
+ 		  nchar:
+ 			tf := typnods[tchar];
+ 
+ 		  ninteger:
+ 			tf := typnods[tinteger];
+ 
+ 		  nreal:
+ 			tf := typnods[treal];
+ 
+ 		  nstring:
+ 			tf := typnods[tstring];
+ 
+ 		  nnil:
+ 			tf := typnods[tnil];
+ 
+ 		  nid:
+ 		    begin
+ 			tq := idup(tq);
+ 			if tq = nil then
+ 				fatal(etree)
+ 		    end;
+ 
+ 		  ntype,
+ 		  nvar,
+ 		  nconst,
+ 		  nfield,
+ 		  nvalpar,
+ 		  nvarpar:
+ 			tq := tq^.tbind;
+ 
+ 		  npredef,
+ 		  nptr,
+ 		  nscalar,
+ 		  nrecord,
+ 		  nconfarr,
+ 		  narray,
+ 		  nfileof,
+ 		  nsetof:
+ 			tf := tq;	(* these nodetypes represent types *)
+ 
+ 		  nsubrange:
+ 			if tq^.tup^.tt = nconfarr then
+ 				tf := tq^.tup^.tindtyp
+ 			else
+ 				tf := tq;
+ 
+ 		  ncall:
+ 		    begin
+ 			tf := typeof(tq^.tcall);
+ 			if tf = typnods[tpoly] then
+ 				tf := typeof(tq^.taparm)
+ 		    end;
+ 
+ 		  nfunc:
+ 			tq := tq^.tfuntyp;
+ 
+ 		  nparfunc:
+ 			tq := tq^.tpartyp;
+ 
+ 		  nproc,
+ 		  nparproc:
+ 			tf := typnods[tnone];
+ 
+ 		  nvariant,
+ 		  nlabel,
+ 		  npgm,
+ 		  nempty,
+ 		  nbegin,
+ 		  nlabstmt,
+ 		  nassign,
+ 		  npush,
+ 		  npop,
+ 		  nif,
+ 		  nwhile,
+ 		  nrepeat,
+ 		  nfor,
+ 		  ncase,
+ 		  nchoise,
+ 		  ngoto,
+ 		  nwith,
+ 		  nwithvar:
+ 			fatal(etree);
+ 
+ 		  nformat,
+ 		  nrange:
+ 			tq := tq^.texpl;
+ 
+ 		  nplus,
+ 		  nminus,
+ 		  nmul:
+ 		    begin
+ 			tf := typeof(tq^.texpl);
+ 			if tf = typnods[tinteger] then
+ 				tf := typeof(tq^.texpr)
+ 			else if tf^.tt = nsetof then
+ 				tf := typnods[tset]
+ 		    end;
+ 
+ 		  numinus,
+ 		  nuplus:
+ 			tq := tq^.texps;
+ 
+ 		  nmod,
+ 		  ndiv:
+ 			tf := typnods[tinteger];
+ 
+ 		  nquot:
+ 			tf := typnods[treal];
+ 
+ 		  neq,
+ 		  nne,
+ 		  nlt,
+ 		  nle,
+ 		  ngt,
+ 		  nge,
+ 		  nin,
+ 		  nor,
+ 		  nand,
+ 		  nnot:
+ 			tf := typnods[tboolean];
+ 
+ 		  nset:
+ 			tf := typnods[tset];
+ 
+ 		  nselect:
+ 			tq := tq^.tfield;
+ 
+ 		  nderef:
+ 		    begin
+ 			tq := typeof(tq^.texps);
+ 			case tq^.tt of
+ 			  nptr:
+ 				tq := tq^.tptrid;
+ 			  nfileof:
+ 				tq := tq^.tof;
+ 			  npredef:
+ 				tf := typnods[tchar]	(* textfile *)
+ 			end (* case *)
+ 		    end;
+ 
+ 		  nindex:
+ 		    begin
+ 			tq := typeof(tq^.tvariable);
+ 			if tq^.tt = nconfarr then
+ 				tq := tq^.tcelem
+ 			else if tq = typnods[tstring] then
+ 				tf := typnods[tchar]
+ 			else
+ 				tq := tq^.taelem
+ 		    end;
+ 
+ 		end (* case *)
+ 	end;
+ 	if tp^.ttype = nil then
+ 		tp^.ttype := tf;	(* remember type for future reference *)
+ 	typeof := tf
+ end;	(* typeof *)
+ 
+ (*	Connect all nodes to their fathers.				*)
+ procedure linkup(up, tp : treeptr);
+ 
+ begin
+ 	while tp <> nil do
+ 	    begin
+ 		if tp^.tup = nil then
+ 		    begin
+ 			tp^.tup := up;
+ 			case tp^.tt of
+ 			  npgm,
+ 			  nfunc,
+ 			  nproc:
+ 			    begin
+ 				linkup(tp, tp^.tsubid);
+ 				linkup(tp, tp^.tsubpar);
+ 				linkup(tp, tp^.tfuntyp);
+ 				linkup(tp, tp^.tsublab);
+ 				linkup(tp, tp^.tsubconst);
+ 				linkup(tp, tp^.tsubtype);
+ 				linkup(tp, tp^.tsubvar);
+ 				linkup(tp, tp^.tsubsub);
+ 				linkup(tp, tp^.tsubstmt)
+ 			    end;
+ 
+ 
+ 			  nvalpar,
+ 			  nvarpar,
+ 			  nconst,
+ 			  ntype,
+ 			  nfield,
+ 			  nvar:
+ 			    begin
+ 				linkup(tp, tp^.tidl);
+ 				linkup(tp, tp^.tbind)
+ 			    end;
+ 
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				linkup(tp, tp^.tparid);
+ 				linkup(tp, tp^.tparparm);
+ 				linkup(tp, tp^.tpartyp)
+ 			    end;
+ 
+ 			  nptr:
+ 				linkup(tp, tp^.tptrid);
+ 			  nscalar:
+ 				linkup(tp, tp^.tscalid);
+ 
+ 			  nsubrange:
+ 			    begin
+ 				linkup(tp, tp^.tlo);
+ 				linkup(tp, tp^.thi)
+ 			    end;
+ 			  nvariant:
+ 			    begin
+ 				linkup(tp, tp^.tselct);
+ 				linkup(tp, tp^.tvrnt)
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				linkup(tp, tp^.tflist);
+ 				linkup(tp, tp^.tvlist)
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				linkup(tp, tp^.tcindx);
+ 				linkup(tp, tp^.tcelem);
+ 				linkup(tp, tp^.tindtyp)
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				linkup(tp, tp^.taindx);
+ 				linkup(tp, tp^.taelem)
+ 			    end;
+ 			  nfileof,
+ 			  nsetof:
+ 				linkup(tp, tp^.tof);
+ 			  nbegin:
+ 				linkup(tp, tp^.tbegin);
+ 			  nlabstmt:
+ 			    begin
+ 				linkup(tp, tp^.tlabno);
+ 				linkup(tp, tp^.tstmt)
+ 			    end;
+ 			  nassign:
+ 			    begin
+ 				linkup(tp, tp^.tlhs);
+ 				linkup(tp, tp^.trhs)
+ 			    end;
+ 			  npush,
+ 			  npop:
+ 			    begin
+ 				linkup(tp, tp^.tglob);
+ 				linkup(tp, tp^.tloc);
+ 				linkup(tp, tp^.ttmp)
+ 			    end;
+ 			  ncall:
+ 			    begin
+ 				linkup(tp, tp^.tcall);
+ 				linkup(tp, tp^.taparm )
+ 			    end;
+ 			  nif:
+ 			    begin
+ 				linkup(tp, tp^.tifxp);
+ 				linkup(tp, tp^.tthen);
+ 				linkup(tp, tp^.telse)
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				linkup(tp, tp^.twhixp);
+ 				linkup(tp, tp^.twhistmt)
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				linkup(tp, tp^.treptstmt);
+ 				linkup(tp, tp^.treptxp)
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				linkup(tp, tp^.tforid);
+ 				linkup(tp, tp^.tfrom);
+ 				linkup(tp, tp^.tto);
+ 				linkup(tp, tp^.tforstmt)
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				linkup(tp, tp^.tcasxp);
+ 				linkup(tp, tp^.tcaslst);
+ 				linkup(tp, tp^.tcasother)
+ 			    end;
+ 			  nchoise:
+ 			    begin
+ 				linkup(tp, tp^.tchocon);
+ 				linkup(tp, tp^.tchostmt)
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				linkup(tp, tp^.twithvar);
+ 				linkup(tp, tp^.twithstmt)
+ 			    end;
+ 			  nwithvar:
+ 				linkup(tp, tp^.texpw);
+ 			  nindex:
+ 			    begin
+ 				linkup(tp, tp^.tvariable);
+ 				linkup(tp, tp^.toffset)
+ 			    end;
+ 			  nselect:
+ 			    begin
+ 				linkup(tp, tp^.trecord);
+ 				linkup(tp, tp^.tfield)
+ 			    end;
+ 
+ 			  ngoto:
+ 				linkup(tp, tp^.tlabel);
+ 
+ 			  nrange, nformat,
+ 			  nin, neq,
+ 			  nne, nlt, nle,
+ 			  ngt, nge, nor,
+ 			  nplus, nminus,
+ 			  nand, nmul,
+ 			  ndiv, nmod,
+ 			  nquot:
+ 			    begin
+ 				linkup(tp, tp^.texpl);
+ 				linkup(tp, tp^.texpr)
+ 			    end;
+ 
+ 			  nderef,
+ 			  nnot, nset,
+ 			  numinus,
+ 			  nuplus:
+ 				linkup(tp, tp^.texps);
+ 
+ 			  nid,
+ 			  nnil, ninteger,
+ 			  nreal, nchar,
+ 			  nstring, npredef,
+ 			  nlabel, nempty:
+ 				(* no op *)
+ 			end (* case *)
+ 		end;
+ 		tp := tp^.tnext
+ 	    end
+ end;	(* linkup *)
+ 
+ (*	Allocate a new symbol node.					*)
+ function mksym(vt : ltypes) : symptr;
+ 
+ var	mp	: symptr;
+ 
+ begin
+ 	new(mp);
+ 	if mp = nil then
+ 		error(enew);
+ 	mp^.lt := vt;
+ 	mp^.lnext := nil;
+ 	mp^.lsymdecl := nil;
+ 	mp^.ldecl := nil;
+ 	mksym := mp
+ end;
+ 
+ (*	Enter a symbol at current declarationlevel.			*)
+ procedure declsym(sp : symptr);
+ 
+ var	h	: hashtyp;
+ 
+ begin
+ 	if sp^.lt in [lpredef, lidentifier, lfield, lforward, lpointer] then
+ 		h := sp^.lid^.ihash
+ 	else
+ 		h := hashmax;
+ 	sp^.lnext := symtab^.ddecl[h];
+ 	symtab^.ddecl[h] := sp;
+ 	sp^.ldecl := symtab
+ end;
+ 
+ (*	Create a node of selected type.					*)
+ function mknode(nt : treetyp) : treeptr;
+ 
+ var	tp	: treeptr;
+ 
+ begin
+ 	tp := nil;
+ 	case nt of
+ 	  npredef:	new(tp, npredef);
+ 	  npgm:		new(tp, npgm);
+ 	  nfunc:	new(tp, nfunc);
+ 	  nproc:	new(tp, nproc);
+ 	  nlabel:	new(tp, nlabel);
+ 	  nconst:	new(tp, nconst);
+ 	  ntype:	new(tp, ntype);
+ 	  nvar:		new(tp, nvar);
+ 	  nvalpar:	new(tp, nvalpar);
+ 	  nvarpar:	new(tp, nvarpar);
+ 	  nparproc:	new(tp, nparproc);
+ 	  nparfunc:	new(tp, nparfunc);
+ 	  nsubrange:	new(tp, nsubrange);
+ 	  nvariant:	new(tp, nvariant);
+ 	  nfield:	new(tp, nfield);
+ 	  nrecord:	new(tp, nrecord);
+ 	  nconfarr:	new(tp, nconfarr);
+ 	  narray:	new(tp, narray);
+ 	  nfileof:	new(tp, nfileof);
+ 	  nsetof:	new(tp, nsetof);
+ 	  nbegin:	new(tp, nbegin);
+ 	  nptr:		new(tp, nptr);
+ 	  nscalar:	new(tp, nscalar);
+ 	  nif:		new(tp, nif);
+ 	  nwhile:	new(tp, nwhile);
+ 	  nrepeat:	new(tp, nrepeat);
+ 	  nfor:		new(tp, nfor);
+ 	  ncase:	new(tp, ncase);
+ 	  nchoise:	new(tp, nchoise);
+ 	  ngoto:	new(tp, ngoto);
+ 	  nwith:	new(tp, nwith);
+ 	  nwithvar:	new(tp, nwithvar);
+ 	  nempty:	new(tp, nempty);
+ 	  nlabstmt:	new(tp, nlabstmt);
+ 	  nassign:	new(tp, nassign);
+ 	  nformat:	new(tp, nformat);
+ 	  nin:		new(tp, nin);
+ 	  neq:		new(tp, neq);
+ 	  nne:		new(tp, nne);
+ 	  nlt:		new(tp, nlt);
+ 	  nle:		new(tp, nle);
+ 	  ngt:		new(tp, ngt);
+ 	  nge:		new(tp, nge);
+ 	  nor:		new(tp, nor);
+ 	  nplus:	new(tp, nplus);
+ 	  nminus:	new(tp, nminus);
+ 	  nand:		new(tp, nand);
+ 	  nmul:		new(tp, nmul);
+ 	  ndiv:		new(tp, ndiv);
+ 	  nmod:		new(tp, nmod);
+ 	  nquot:	new(tp, nquot);
+ 	  nnot:		new(tp, nnot);
+ 	  numinus:	new(tp, numinus);
+ 	  nuplus:	new(tp, nuplus);
+ 	  nset:		new(tp, nset);
+ 	  nrange:	new(tp, nrange);
+ 	  nindex:	new(tp, nindex);
+ 	  nselect:	new(tp, nselect);
+ 	  nderef:	new(tp, nderef);
+ 	  ncall:	new(tp, ncall);
+ 	  nid:		new(tp, nid);
+ 	  nchar:	new(tp, nchar);
+ 	  ninteger:	new(tp, ninteger);
+ 	  nreal:	new(tp, nreal);
+ 	  nstring:	new(tp, nstring);
+ 	  nnil:		new(tp, nnil);
+ 	  npush:	new(tp, npush);
+ 	  npop:		new(tp, npop);
+ 	  nbreak:	new(tp, nbreak)
+ 	end;(* case *)
+ 	if tp = nil then
+ 		error(enew);
+ 	tp^.tt := nt;
+ 	tp^.tnext := nil;
+ 	tp^.tup := nil;
+ 	tp^.ttype := nil;
+ 	mknode := tp
+ end;
+ 
+ (*	Create a node with a literal value.				*)
+ function mklit : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	case currsym.st of
+ 	  sinteger:
+ 	    begin
+ 		sp := mksym(linteger);
+ 		sp^.linum := currsym.vint;
+ 		tp := mknode(ninteger);
+ 	    end;
+ 	  sreal:
+ 	    begin
+ 		sp := mksym(lreal);
+ 		sp^.lfloat := currsym.vflt;
+ 		tp := mknode(nreal);
+ 	    end;
+ 	  schar:
+ 	    begin
+ 		sp := mksym(lcharacter);
+ 		sp^.lchar := currsym.vchr;
+ 		tp := mknode(nchar);
+ 	    end;
+ 	  sstring:
+ 	    begin
+ 		sp := mksym(lstring);
+ 		sp^.lstr := currsym.vstr;
+ 		tp := mknode(nstring);
+ 	    end
+ 	end;(* case *)
+ 	tp^.tsym := sp;
+ 	sp^.lsymdecl := tp;
+ 	mklit := tp
+ end;
+ 
+ (*	Look up an identifier among declared symbols.			*)
+ function lookupid(ip : idptr; fieldok : boolean) : symptr;
+ 
+ label	999;
+ 
+ var	sp	: symptr;
+ 	dp	: declptr;
+ 	vs	: set of ltypes;
+ 
+ begin
+ 	lookupid := nil;
+ 	if fieldok then
+ 		vs := [lidentifier, lforward, lpointer, lfield]
+ 	else
+ 		vs := [lidentifier, lforward, lpointer];
+ 	sp := nil;
+ 
+ 	(* pick up symboltable from innermost scope *)
+ 	dp := symtab;
+ 	while dp <> nil do
+ 	    begin
+ 		(* scan linked symbols with same hasvalue *) 
+ 		sp := dp^.ddecl[ip^.ihash];
+ 		while sp <> nil do
+ 		    begin
+ 			(* break out when proper id found *)
+ 			if (sp^.lt in vs) and (sp^.lid = ip) then
+ 				goto 999;
+ 			sp := sp^.lnext
+ 		    end;
+ 		(* proceed to enclosing scope *)
+ 		dp := dp^.dprev
+ 	    end;
+ 999:
+ 	lookupid := sp
+ end;
+ 
+ (*	Look up a label.						*)
+ function lookuplabel(i : integer) : symptr;
+ 
+ label	999;
+ 
+ var	sp	: symptr;
+ 	dp	: declptr;
+ 
+ begin
+ 	sp := nil;
+ 	dp := symtab;
+ 	while dp <> nil do
+ 	    begin
+ 		sp := dp^.ddecl[hashmax];
+ 		while sp <> nil do
+ 		    begin
+ 			if (sp^.lt in [lforwlab, llabel]) and (sp^.lno = i) then
+ 				goto 999;
+ 			sp := sp^.lnext
+ 		    end;
+ 		dp := dp^.dprev
+ 	    end;
+ 999:
+ 	lookuplabel := sp
+ end;
+ 
+ (*	Create a new declaration level (a new scope) link declnode to	*)
+ (*	previous node.	dp is non-nil when a procedure/function body	*)
+ (*	is encountered for which we have seen a forward declaration.	 *)
+ procedure enterscope(dp : declptr);
+ 
+ var	h	: hashtyp;
+ 
+ begin
+ 	if dp = nil then
+ 	    begin
+ 		new(dp);
+ 		for h := 0 to hashmax do
+ 			dp^.ddecl[h] := nil
+ 	    end;
+ 	dp^.dprev := symtab;
+ 	symtab := dp
+ end;
+ 
+ (*	Return current scope (as a pointer to symbol-table).	*)
+ function currscope : declptr;
+ 
+ begin
+ 	currscope := symtab
+ end;
+ 
+ (*	Drop innermost declaration scope.				*)
+ procedure leavescope;
+ 
+ begin
+ 	symtab := symtab^.dprev
+ end;
+ 
+ (*	Create a new identifier symbol.					*)
+ function mkid(ip : idptr) : symptr;
+ 
+ var	sp	: symptr;
+ 
+ begin
+ 	sp := mksym(lidentifier);
+ 	sp^.lid := ip;
+ 	sp^.lused := false;
+ 	declsym(sp);
+ 	ip^.inref := ip^.inref + 1;
+ 	mkid := sp
+ end;
+ 
+ (*	Check that the current identifier is new then save it in the	*)
+ (*	current scope. Create and return a new node representing this	*)
+ (*	instance of the identifier.					*)
+ function newid(ip : idptr) : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	sp := lookupid(ip, false);
+ 	if sp <> nil then
+ 		if sp^.ldecl <> symtab then
+ 			sp := nil;
+ 	if sp = nil then
+ 	    begin
+ 		(* new identifier *)
+ 		tp := mknode(nid);
+ 		sp := mkid(ip);
+ 		sp^.lsymdecl := tp;
+ 		tp^.tsym := sp
+ 	    end
+ 	else if sp^.lt = lpointer then
+ 	    begin
+ 		(* previously declared as a pointer type *)
+ 		tp := mknode(nid);
+ 		tp^.tsym := sp;
+ 		sp^.lt := lidentifier;
+ 		sp^.lsymdecl := tp
+ 	    end
+ 	else if sp^.lt = lforward then
+ 	    begin
+ 		(* previously forward declared *)
+ 		sp^.lt := lidentifier;
+ 		tp := sp^.lsymdecl
+ 	    end
+ 	else
+ 		error(emultdeclid);
+ 	newid := tp
+ end;
+ 
+ (*	Check that the current identifier is already declared,	*)
+ (*	we fail unless l in [lforward, lpointer].		*)
+ (*	Create and return a new node referencing it.		*)
+ function oldid(ip : idptr; l : ltypes) : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	sp := lookupid(ip, true);
+ 	if sp = nil then
+ 	    begin
+ 		if l in [lforward, lpointer] then
+ 		    begin
+ 			tp := newid(ip);
+ 			tp^.tsym^.lt := l
+ 		    end
+ 		else
+ 			error(enotdeclid)
+ 	    end
+ 	else begin
+ 		sp^.lused := true;
+ 		tp := mknode(nid);
+ 		tp^.tsym := sp;
+ 		if (sp^.lt = lpointer) and (l = lidentifier) then
+ 		    begin
+ 			sp^.lt := lidentifier;
+ 			sp^.lsymdecl := tp
+ 		    end
+ 	     end;
+ 	oldid := tp
+ end;
+ 
+ (*	Look up a field in a record declaration.			*)
+ (*	Return nil if field isn't declared in "tp" or its variants.	*)
+ function oldfield(tp : treeptr; ip : idptr) : treeptr;
+ 
+ label	999;
+ 
+ var	tq, ti,
+ 	fp	: treeptr;
+ 
+ begin
+ 	fp := nil;
+ 	tq := tp^.tflist;
+ 	while tq <> nil do
+ 	    begin
+ 		ti := tq^.tidl;
+ 		while ti <> nil do
+ 		    begin
+ 			if ti^.tsym^.lid = ip then
+ 			    begin
+ 				fp := mknode(nid);
+ 				fp^.tsym := ti^.tsym;
+ 				goto 999
+ 			    end;
+ 			ti := ti^.tnext
+ 		    end;
+ 		tq := tq^.tnext
+ 	    end;
+ 	tq := tp^.tvlist;
+ 	while tq <> nil do
+ 	    begin
+ 		fp := oldfield(tq^.tvrnt, ip);
+ 		if fp <> nil then
+ 			tq := nil
+ 		else
+ 			tq := tq^.tnext
+ 	    end;
+ 999:
+ 	oldfield := fp
+ end;
+ 
+ (*	This is the main parsing routine. It parses a correct pascal-	*)
+ (*	program and builds a parsetree which is left in the global	*)
+ (*	variable top.							*)
+ (*	Parsing is done through recursive descent using a set of	*)
+ (*	mutually recursive functions.					*)
+ procedure parse;
+ 
+ 	function plabel : treeptr;				forward;
+ 	function pidlist(l : ltypes) : treeptr;			forward;
+ 	function pconst : treeptr;				forward;
+ 	function pconstant(realok : boolean) : treeptr;		forward;
+ 	function precord(cs : symtyp; dp : declptr) : treeptr;	forward;
+ 	function ptypedef : treeptr;				forward;
+ 	function ptype : treeptr;				forward;
+ 	function pvar : treeptr;				forward;
+ 	function psubs : treeptr;				forward;
+ 	function psubpar : treeptr;				forward;
+ 	function plabstmt : treeptr;				forward;
+ 	function pstmt : treeptr;				forward;
+ 	function psimple : treeptr;				forward;
+ 	function pvariable(varptr : treeptr) : treeptr;		forward;
+ 	function pexpr(tnp : treeptr) : treeptr;		forward;
+ 	function pcase : treeptr;				forward;
+ 	function pif : treeptr;					forward;
+ 	function pwhile : treeptr;				forward;
+ 	function prepeat : treeptr;				forward;
+ 	function pfor : treeptr;				forward;
+ 	function pwith : treeptr;				forward;
+ 	function pgoto : treeptr;				forward;
+ 	function pbegin(retain : boolean) : treeptr;		forward;
+ 
+ 	(*	Open scope of a record variable.			*)
+ 	procedure scopeup(tp : treeptr);
+ 
+ 		(*	Scan a record-declaration and add all fields to	*)
+ 		(*	current scope.					*)
+ 		procedure addfields(rp : treeptr);
+ 
+ 		var	fp, ip, vp	: treeptr;
+ 			sp		: symptr;
+ 
+ 		begin
+ 			fp := rp^.tflist;
+ 			while fp <> nil do
+ 			    begin
+ 				ip := fp^.tidl;
+ 				while ip <> nil do
+ 				    begin
+ 					sp := mksym(lfield);
+ 					sp^.lid := ip^.tsym^.lid;
+ 					sp^.lused := false;
+ 					sp^.lsymdecl := ip;
+ 					declsym(sp);
+ 					ip := ip^.tnext
+ 				    end;
+ 				fp := fp^.tnext
+ 			    end;
+ 			vp := rp^.tvlist;
+ 			while vp <> nil do
+ 			    begin
+ 				addfields(vp^.tvrnt);
+ 				vp := vp^.tnext
+ 			    end
+ 		end;
+ 	begin
+ 		addfields(typeof(tp))
+ 	end;
+ 
+ 	(*	Check that the current label is new then save it in the	*)
+ 	(*	current scope. Create and return a new node referencing	*)
+ 	(*	the label.						*)
+ 	function newlbl : treeptr;
+ 
+ 	var	sp	: symptr;
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nlabel);
+ 		sp := lookuplabel(currsym.vint);
+ 		if sp <> nil then
+ 			if sp^.ldecl <> symtab then
+ 				sp := nil;
+ 		if sp = nil then
+ 		    begin
+ 			sp := mksym(lforwlab);
+ 			sp^.lno := currsym.vint;
+ 			sp^.lgo := false;
+ 			sp^.lsymdecl := tp;
+ 			declsym(sp)
+ 		    end
+ 		else
+ 			error(emultdecllab);
+ 		tp^.tsym := sp;
+ 		newlbl := tp
+ 	end;
+ 
+ 	(*	Check that the current label is already declared.	*)
+ 	(*	Create and return a new node referencing it.		*)
+ 	function oldlbl(defpt : boolean) : treeptr;
+ 
+ 	var	sp	: symptr;
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		sp := lookuplabel(currsym.vint);
+ 		if sp = nil then
+ 		    begin
+ 			prtmsg(enotdecllab);
+ 			tp := newlbl;
+ 			sp := tp^.tsym
+ 		    end
+ 		else begin
+ 			tp := mknode(nlabel);
+ 			tp^.tsym := sp
+ 		     end;
+ 		if defpt then
+ 		    begin
+ 
+ 			if sp^.lt = lforwlab then
+ 				sp^.lt := llabel
+ 			else
+ 				error(emuldeflab);
+ 		    end;
+ 		oldlbl := tp
+ 	end;
+ 
+ 	(*	Parse declaration and statement-body for prog/subs.	*)
+ 	procedure pbody(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 
+ 	begin
+ 		statlvl := statlvl + 1;
+ 		if currsym.st = slabel then
+ 		    begin
+ 			tp^.tsublab := plabel;
+ 			linkup(tp, tp^.tsublab)
+ 		    end
+ 		else
+ 			tp^.tsublab := nil;
+ 		if currsym.st = sconst then
+ 		    begin
+ 			tp^.tsubconst := pconst;
+ 			linkup(tp, tp^.tsubconst)
+ 		    end
+ 		else
+ 			tp^.tsubconst := nil;
+ 		if currsym.st = stype then
+ 		    begin
+ 			tp^.tsubtype := ptype;
+ 			linkup(tp, tp^.tsubtype)
+ 		    end
+ 		else
+ 			tp^.tsubtype := nil;
+ 		if currsym.st = svar then
+ 		    begin
+ 			tp^.tsubvar := pvar;
+ 			linkup(tp, tp^.tsubvar)
+ 		    end
+ 		else
+ 			tp^.tsubvar := nil;
+ 		tp^.tsubsub := nil;
+ 		tq := nil;
+ 		while (currsym.st = sproc) or (currsym.st = sfunc) do
+ 		    begin
+ 			if tq = nil then
+ 			    begin
+ 				tq := psubs;
+ 				tp^.tsubsub := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := psubs;
+ 				tq := tq^.tnext
+ 			     end
+ 		    end;
+ 		linkup(tp, tp^.tsubsub);
+ 		checksymbol([sbegin, seof]);
+ 		if currsym.st = sbegin then
+ 		    begin
+ 			tp^.tsubstmt := pbegin(false);
+ 			linkup(tp, tp^.tsubstmt)
+ 		    end;
+ 		statlvl := statlvl - 1
+ 	end;
+ 
+ 	(*	Parse program-declaration.				*)
+ 	function pprogram : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 		(*	Parse a program parameter id-list.		*)
+ 		function pprmlist : treeptr;
+ 
+ 		label	999;
+ 
+ 		var	tp,
+ 			tq	: treeptr;
+ 			din,
+ 			dut	: idptr;
+ 
+ 		begin
+ 			tp := nil;
+ 			din := deftab[dinput]^.tidl^.tsym^.lid;
+ 			dut := deftab[doutput]^.tidl^.tsym^.lid;
+ 			while (currsym.vid = din) or (currsym.vid = dut) do
+ 			    begin
+ 				(* ignore input/output as parameters so that
+ 				   they will be bound to stdin/stdout unless
+ 				   declared as variables *)
+ 				if currsym.vid = din then
+ 					defnams[dinput]^.lused := true
+ 				else
+ 					defnams[doutput]^.lused := true;
+ 				nextsymbol([scomma, srpar]);
+ 				if currsym.st = srpar then
+ 					goto 999;
+ 				nextsymbol([sid])
+ 			    end;
+ 			tq := newid(currsym.vid);
+ 			tq^.tsym^.lt := lpointer;
+ 			tp := tq;
+ 			nextsymbol([scomma, srpar]);
+ 			while currsym.st = scomma do
+ 			    begin
+ 				nextsymbol([sid]);
+ 				if currsym.vid = din then
+ 					defnams[dinput]^.lused := true
+ 				else if currsym.vid = dut then
+ 					defnams[doutput]^.lused := true
+ 				else begin
+ 					tq^.tnext := newid(currsym.vid);
+ 					tq := tq^.tnext;
+ 					tq^.tsym^.lt := lpointer;
+ 				     end;
+ 				nextsymbol([scomma, srpar])
+ 			    end;
+ 		999:
+ 			pprmlist := tp
+ 		end;
+ 
+ 	begin	(* pprogram *)
+ 		enterscope(nil);
+ 		tp := mknode(npgm);
+ 		nextsymbol([sid]);
+ 		tp^.tstat := statlvl;
+ 		tp^.tsubid := mknode(nid);
+ 		tp^.tsubid^.tup := tp;
+ 		tp^.tsubid^.tsym := mksym(lidentifier);
+ 		tp^.tsubid^.tsym^.lid := currsym.vid;
+ 		tp^.tsubid^.tsym^.lsymdecl := tp^.tsubid;
+ 		linkup(tp, tp^.tsubid);
+ 		nextsymbol([slpar, ssemic]);
+ 		if currsym.st = slpar then
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tp^.tsubpar := pprmlist;
+ 			linkup(tp, tp^.tsubpar);
+ 			nextsymbol([ssemic])
+ 		    end
+ 		else
+ 			tp^.tsubpar := nil;
+ 		nextsymbol([slabel, sconst, stype, svar,
+ 						sproc, sfunc, sbegin]);
+ 		pbody(tp);
+ 		checksymbol([sdot]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		pprogram := tp
+ 	end;	(* pprogram *)
+ 
+ 	(*	Parse a module.				*)
+ 	function pmodule : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin	(* pmodule *)
+ 		enterscope(nil);
+ 		tp := mknode(npgm);
+ 		tp^.tstat := statlvl;
+ 		tp^.tsubid := nil;
+ 		tp^.tsubpar := nil;
+ 		pbody(tp);
+ 		checksymbol([ssemic]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		pmodule := tp
+ 	end;	(* pmodule *)
+ 
+ 
+ 	(*	Parse label-clause.					*)
+ 	function plabel;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			nextsymbol([sinteger]);
+ 			if tq = nil then
+ 			    begin
+ 				tq := newlbl;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := newlbl;
+ 				tq := tq^.tnext;
+ 			     end;
+ 			nextsymbol([scomma, ssemic])
+ 		until	currsym.st = ssemic;
+ 		nextsymbol([sconst, stype, svar, sbegin, sproc, sfunc]);
+ 		plabel := tp
+ 	end;
+ 
+ 	(*	Parse an id-list.					*)
+ 	function pidlist;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := newid(currsym.vid);
+ 		tq^.tsym^.lt := l;
+ 		tp := tq;
+ 		nextsymbol([scomma, scolon, seq, srpar]);
+ 		while currsym.st = scomma do
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tq^.tnext := newid(currsym.vid);
+ 			tq := tq^.tnext;
+ 			tq^.tsym^.lt := l;
+ 			nextsymbol([scomma, scolon, seq, srpar])
+ 		    end;
+ 		pidlist := tp
+ 	end;
+ 
+ 	(*	Parse const-clause.					*)
+ 	function pconst;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nconst);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nconst);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lidentifier);
+ 			checksymbol([seq]);
+ 			nextsymbol([sid, schar, sstring, sinteger, sreal,
+ 						splus, sminus]);
+ 			tq^.tbind := pconstant(true);
+ 			nextsymbol([ssemic]);
+ 			nextsymbol([sid, stype, svar, sbegin,
+ 							sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		pconst := tp
+ 	end;
+ 
+ 	(*	Parse a declared constant or a case-statment const.	*)
+ 	function pconstant;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		neg	: boolean;
+ 
+ 	begin
+ 		neg := currsym.st = sminus;
+ 		if currsym.st in [splus, sminus] then
+ 			if realok then
+ 				nextsymbol([sid, sinteger, sreal])
+ 			else
+ 				nextsymbol([sid, sinteger]);
+ 		if currsym.st = sid then
+ 			tp := oldid(currsym.vid, lidentifier)
+ 		else
+ 			tp := mklit;
+ 		if neg then
+ 		    begin
+ 			tq := mknode(numinus);
+ 			tq^.texps := tp;
+ 			tp := tq
+ 		     end;
+ 		pconstant := tp
+ 	end;
+ 
+ 	(*	Parse a record (or record-variant) declaration.		*)
+ 	(*	Cs is the expected closing symbol, dp the scope.	*)
+ 	function precord;
+ 
+ 	label	999;
+ 
+ 	var	tp,
+ 		tq,
+ 		tl,
+ 		tv	: treeptr;
+ 		tsym	: lexsym;
+ 
+ 	begin
+ 		tp := mknode(nrecord);
+ 		tp^.tflist := nil;
+ 		tp^.tvlist := nil;
+ 		tp^.tuid := nil;
+ 		tp^.trscope := nil;
+ 		if cs = send then
+ 		    begin
+ 			enterscope(dp);
+ 			dp := currscope
+ 		    end;
+ 		nextsymbol([sid, scase] + [cs]);
+ 		tq := nil;
+ 		while currsym.st = sid do
+ 		    begin
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nfield);
+ 				tq^.tattr := anone;
+ 				tp^.tflist := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nfield);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lfield);
+ 			checksymbol([scolon]);
+ 			leavescope;
+ 			tq^.tbind := ptypedef;
+ 			enterscope(dp);
+ 			if currsym.st = ssemic then
+ 				nextsymbol([sid, scase] + [cs])
+ 		    end;
+ 		if currsym.st = scase then
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tsym := currsym;
+ 			nextsymbol([scolon, sof]);
+ 			if currsym.st = scolon then
+ 			    begin
+ 				tv := newid(tsym.vid);
+ 				if tq = nil then
+ 				    begin
+ 					tq := mknode(nfield);
+ 					tp^.tflist := tq
+ 				    end
+ 				else begin
+ 					tq^.tnext := mknode(nfield);
+ 					tq := tq^.tnext
+ 				     end;
+ 				tq^.tidl := tv;
+ 				tv^.tsym^.lt := lfield;
+ 				nextsymbol([sid]);
+ 				leavescope;
+ 				tq^.tbind := oldid(currsym.vid, lidentifier);
+ 				enterscope(dp);
+ 				nextsymbol([sof])
+ 			    end;
+ 			tq := nil;
+ 			repeat
+ 				tv := nil;
+ 				repeat
+ 					nextsymbol([sid, sinteger, schar, splus,
+ 							 sminus] + [cs]);
+ 					if currsym.st = cs then
+ 						goto 999;
+ 					if tv = nil then
+ 					    begin
+ 						tv := pconstant(false);
+ 						tl := tv
+ 					    end
+ 					else begin
+ 						tv^.tnext := pconstant(false);
+ 						tv := tv^.tnext
+ 					     end;
+ 					nextsymbol([scolon, scomma])
+ 				until currsym.st = scolon;
+ 				nextsymbol([slpar]);
+ 				if tq = nil then
+ 				    begin
+ 					tq := mknode(nvariant);
+ 					tp^.tvlist := tq;
+ 				    end
+ 				else begin
+ 					tq^.tnext := mknode(nvariant);
+ 					tq := tq^.tnext;
+ 				     end;
+ 				tq^.tselct := tl;
+ 				tq^.tvrnt := precord(srpar, dp)
+ 			until	currsym.st = cs
+ 		    end;
+ 	999:
+ 		if cs = send then
+ 		    begin
+ 			tp^.trscope := dp;
+ 			leavescope
+ 		    end;
+ 		nextsymbol([ssemic, send, srpar]);
+ 		(* currsym is the symbol following record end/rpar,
+ 			(usually semicolon, sometimes enclosing end/rpar) *)
+ 		precord := tp
+ 	end;
+ 
+ 	function ptypedef;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		st	: symtyp;
+ 		ss	: symset;
+ 
+ 	begin
+ 		nextsymbol([sid, slpar, sarrow, sinteger, schar, splus, sminus,
+ 				spacked, sarray, srecord, sfile, sset]);
+ 
+ 		(* the "packed" keyword is completely ignored *)
+ 		if currsym.st = spacked then
+ 			nextsymbol([sarray, srecord, sfile, sset]);
+ 
+ 		ss := [ssemic, send, srpar, scomma, srbrack];
+ 		case currsym.st of
+ 		  splus,
+ 		  sminus,
+ 		  schar,
+ 		  sinteger,
+ 		  sid:
+ 		    begin
+ 			st := currsym.st;
+ 			tp := pconstant(false);
+ 			if st = sid then
+ 				nextsymbol([sdotdot] + ss)
+ 			else
+ 				nextsymbol([sdotdot]);
+ 			if currsym.st = sdotdot then
+ 			    begin
+ 				nextsymbol([sid, sinteger, schar,
+ 								splus, sminus]);
+ 				tq := mknode(nsubrange);
+ 				tq^.tlo := tp;
+ 				tq^.thi := pconstant(false);
+ 				tp := tq;
+ 				nextsymbol(ss)
+ 			    end
+ 		    end;
+ 		  slpar:
+ 		    begin
+ 			tp := mknode(nscalar);
+ 			nextsymbol([sid]);
+ 			tp^.tscalid := pidlist(lidentifier);
+ 			checksymbol([srpar]);
+ 			nextsymbol(ss)
+ 		    end;
+ 		  sarrow:
+ 		    begin
+ 			tp := mknode(nptr);
+ 			nextsymbol([sid]);
+ 			tp^.tptrid := oldid(currsym.vid, lpointer);
+ 			tp^.tptrflag := false;
+ 			nextsymbol([ssemic, send, srpar])
+ 		    end;
+ 		  sarray:
+ 		    begin
+ 			nextsymbol([slbrack]);
+ 			tp := mknode(narray);
+ 			tp^.taindx := ptypedef;	(* parse subrange ...	*)
+ 			tq := tp;
+ 			while currsym.st = scomma do
+ 			    begin
+ 				(* expand:   array [ A , B ] of X
+ 				   to:   array [ A ] of array [ B ] of X   *)
+ 				tq^.taelem := mknode(narray);
+ 				tq := tq^.taelem;
+ 				tq^.taindx := ptypedef	(* ... again	*)
+ 			    end;
+ 			checksymbol([srbrack]);
+ 			nextsymbol([sof]);
+ 			tq^.taelem := ptypedef
+ 		    end;
+ 		  srecord:
+ 			tp := precord(send, nil);
+ 		  sfile,
+ 		  sset:
+ 		    begin
+ 			if currsym.st = sfile then
+ 				tp := mknode(nfileof)
+ 			else begin
+ 				tp := mknode(nsetof);
+ 				usesets := true
+ 			     end;
+ 			nextsymbol([sof]);
+ 			tp^.tof := ptypedef
+ 		    end
+ 		end;
+ 		(* at this point "currsym" holds the symbol following the type
+ 		   (usually semicolon, sometimes the following end/rpar) *)
+ 		ptypedef := tp
+ 	end;
+ 
+ 	(*	Parse type-clause.					*)
+ 	function ptype;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(ntype);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(ntype);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lidentifier);
+ 			checksymbol([seq]);
+ 			tq^.tbind := ptypedef;
+ 			nextsymbol([sid, svar, sbegin, sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		ptype := tp;
+ 	end;
+ 
+ 	(*	Parse var-clause.					*)
+ 	function pvar;
+ 
+ 	var	ti,
+ 		tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nvar);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nvar);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 
+ 			ti := newid(currsym.vid);
+ 			tq^.tidl := ti;
+ 			nextsymbol([scomma, scolon]);
+ 			while currsym.st = scomma do
+ 			    begin
+ 				nextsymbol([sid]);
+ 				ti^.tnext := newid(currsym.vid);
+ 				ti := ti^.tnext;
+ 				nextsymbol([scomma, scolon])
+ 			    end;
+ 
+ 			tq^.tbind := ptypedef;
+ 			nextsymbol([sid, sbegin, sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		pvar := tp
+ 	end;
+ 
+ 	(*	Parse subroutine-declaration.				*)
+ 	function psubs;
+ 
+ 	var	tp,			(* return value		*)
+ 		tv, tq	: treeptr;	(* temporary		*)
+ 		func	: boolean;	(* true for functions	*)
+ 		colsem	: symtyp;	(* colon/semicolon	*)
+ 
+ 	begin
+ 		(* parsing function or procedure *)
+ 		func := currsym.st = sfunc;
+ 		if func then
+ 			colsem := scolon
+ 		else
+ 			colsem := ssemic;
+ 
+ 		(* parse id, it may already be forward declared *)
+ 		nextsymbol([sid]);
+ 		tq := newid(currsym.vid);
+ 		if tq^.tup = nil then
+ 		   begin
+ 			enterscope(nil);
+ 			(* id wasn't previously declared, params possible *)
+ 			if func then
+ 				tp := mknode(nfunc)
+ 			else
+ 				tp := mknode(nproc);
+ 			tp^.tstat := statlvl;
+ 			tp^.tsubid := tq;
+ 			linkup(tp, tq);
+ 			nextsymbol([slpar, colsem]);
+ 			if currsym.st = slpar then
+ 			    begin
+ 				tp^.tsubpar := psubpar;
+ 				linkup(tp, tp^.tsubpar);
+ 				nextsymbol([colsem])
+ 			    end
+ 			else
+ 				tp^.tsubpar := nil;
+ 			if func then
+ 			    begin
+ 				(* parse function type *)
+ 				nextsymbol([sid]);
+ 				tp^.tfuntyp := oldid(currsym.vid, lidentifier);
+ 				nextsymbol([ssemic])
+ 			    end
+ 			else
+ 				tp^.tfuntyp := mknode(nempty);
+ 			linkup(tp, tp^.tfuntyp);
+ 			nextsymbol([sextern, sforward,
+ 					slabel, sconst, stype, svar,
+ 							sproc, sfunc, sbegin]);
+ 		   end
+ 		else begin
+ 			(* id was forward declared =>
+ 				pick up declarations from parameterlist *)
+ 			enterscope(tq^.tup^.tscope);
+ 			if func then
+ 				tp := mknode(nfunc)
+ 			else
+ 				tp := mknode(nproc);
+ 			tp^.tfuntyp := tq^.tup^.tfuntyp;
+ 			(* steal id and params from forward decl *)
+ 			tv := tq^.tup^.tsubpar;
+ 			tp^.tsubpar := tv;
+ 			while tv <> nil do
+ 			    begin
+ 				tv^.tup := tp;
+ 				tv := tv^.tnext
+ 			    end;
+ 			tp^.tsubid := tq;
+ 			tq^.tup := tp;
+ 			(* id was forward declared =>
+ 				no params, no function type, no forward *)
+ 			nextsymbol([ssemic]);
+ 			nextsymbol([slabel, sconst, stype, svar,
+ 							sproc, sfunc, sbegin]);
+ 		     end;
+ 		if currsym.st in [sforward, sextern] then
+ 		    begin
+ 			tp^.tsubid^.tsym^.lt := lforward;
+ 			nextsymbol([ssemic]);
+ 			tp^.tsublab := nil;
+ 			tp^.tsubconst := nil;
+ 			tp^.tsubtype := nil;
+ 			tp^.tsubvar := nil;
+ 			tp^.tsubsub := nil;
+ 			tp^.tsubstmt := nil
+ 		    end
+ 		else
+ 			pbody(tp);
+ 		nextsymbol([sproc, sfunc, sbegin, seof]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		psubs := tp
+ 	end;
+ 
+ 	(*	Parse a conformant array index type.			*)
+ 	function pconfsub : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nsubrange);
+ 		nextsymbol([sid]);
+ 		tp^.tlo := newid(currsym.vid);
+ 		nextsymbol([sdotdot]);
+ 		nextsymbol([sid]);
+ 		tp^.thi := newid(currsym.vid);
+ 		nextsymbol([scolon]);
+ 		pconfsub := tp
+ 	end;
+ 
+ 	(*	Parse a conformant array-declaration.			*)
+ 	function pconform : treeptr;
+ 
+ 	var	tp, tq	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([slbrack]);
+ 		tp := mknode(nconfarr);
+ 		tp^.tcuid := mkvariable('S');
+ 		tp^.tcindx := pconfsub;	(* parse subrange ...	*)
+ 		nextsymbol([sid]);
+ 		tp^.tindtyp := oldid(currsym.vid, lidentifier);
+ 		nextsymbol([ssemic, srbrack]);
+ 		tq := tp;
+ 		while currsym.st = ssemic do
+ 		    begin
+ 			error(econfconf); (* what size does tp have *)
+ 
+ 			(* expand:   array [ A ; B ] of X
+ 			   to:   array [ A ] of array [ B ] of X   *)
+ 			tq^.tcelem := mknode(nconfarr);
+ 			tq := tq^.tcelem;
+ 			tq^.tcindx := pconfsub;	(* ... again	*)
+ 			nextsymbol([sid]);
+ 			tq^.tindtyp := oldid(currsym.vid, lidentifier);
+ 			nextsymbol([ssemic, srbrack])
+ 		    end;
+ 		nextsymbol([sof]);
+ 		nextsymbol([sid, sarray]);
+ 		case currsym.st of
+ 		  sid:
+ 			tq^.tcelem := oldid(currsym.vid, lidentifier);
+ 		  sarray: 
+ 		    begin
+ 			error(econfconf); (* what size does tp have *)
+ 
+ 			tq^.tcelem := pconform
+ 		    end;
+ 		end;(* case *)
+ 		pconform := tp
+ 	end;
+ 
+ 	(*	Parse subroutine parameter list.			*)
+ 	function psubpar;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		nt	: treetyp;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			nextsymbol([sid, svar, sfunc, sproc]);
+ 			case currsym.st of
+ 			  sid:
+ 				nt := nvalpar;
+ 			  svar:
+ 				nt := nvarpar;
+ 			  sfunc:
+ 				nt := nparfunc;
+ 			  sproc:
+ 				nt := nparproc;
+ 			end;
+ 			if nt <> nvalpar then
+ 				nextsymbol([sid]);
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nt);
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nt);
+ 				tq := tq^.tnext
+ 			     end;
+ 			case nt of
+ 			  nvarpar,
+ 			  nvalpar:
+ 			    begin
+ 				tq^.tidl := pidlist(lidentifier);
+ 				tq^.tattr := anone;
+ 				checksymbol([scolon]);
+ 				if nt = nvalpar then
+ 					nextsymbol([sid])
+ 				else
+ 					nextsymbol([sid, sarray]);
+ 				case currsym.st of
+ 				  sid:
+ 					tq^.tbind :=
+ 						oldid(currsym.vid, lidentifier);
+ 				  sarray:
+ 					tq^.tbind := pconform
+ 				end;(* case *)
+ 				nextsymbol([srpar, ssemic])
+ 			    end;
+ 			  nparproc:
+ 			    begin
+ 				tq^.tparid := newid(currsym.vid);
+ 				nextsymbol([ssemic, slpar, srpar]);
+ 				if currsym.st = slpar then
+ 				    begin
+ 					enterscope(nil);
+ 					tq^.tparparm := psubpar;
+ 					nextsymbol([ssemic, srpar]);
+ 					leavescope
+ 				    end
+ 				else
+ 					tq^.tparparm := nil;
+ 				tq^.tpartyp := nil
+ 			    end;
+ 			  nparfunc:
+ 			    begin
+ 				tq^.tparid := newid(currsym.vid);
+ 				nextsymbol([scolon, slpar]);
+ 				if currsym.st = slpar then
+ 				    begin
+ 					enterscope(nil);
+ 					tq^.tparparm := psubpar;
+ 					nextsymbol([scolon]);
+ 					leavescope
+ 				    end
+ 				else
+ 					tq^.tparparm := nil;
+ 				nextsymbol([sid]);
+ 				tq^.tpartyp := oldid(currsym.vid, lidentifier);
+ 				nextsymbol([srpar, ssemic])
+ 			    end
+ 			end (* case *)
+ 		until	currsym.st = srpar;
+ 		psubpar := tp
+ 	end;
+ 
+ 	(*	Parse a (possibly labeled) statement.			*)
+ 	function plabstmt;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([sid, sinteger, sif, swhile, srepeat, sfor, scase,
+ 				  swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 		if currsym.st = sinteger then
+ 		    begin
+ 			tp := mknode(nlabstmt);
+ 			tp^.tlabno := oldlbl(true);
+ 			nextsymbol([scolon]);
+ 			nextsymbol([sid, sif, swhile, srepeat, sfor, scase,
+ 				  swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			tp^.tstmt := pstmt
+ 		    end
+ 		else
+ 			tp := pstmt;
+ 		plabstmt := tp
+ 	end;
+ 
+ 	(*	Parse an unlabeled statement.				*)
+ 	function pstmt;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		case currsym.st of
+ 		  sid:
+ 			tp := psimple;
+ 		  sif:
+ 			tp := pif;
+ 		  swhile:
+ 			tp := pwhile;
+ 		  srepeat:
+ 			tp := prepeat;
+ 		  sfor:
+ 			tp := pfor;
+ 		  scase:
+ 			tp := pcase;
+ 		  swith:
+ 			tp := pwith;
+ 		  sbegin:
+ 			tp := pbegin(true);
+ 		  sgoto:
+ 			tp := pgoto;
+ 		  send,
+ 		  selse,
+ 		  suntil,
+ 		  ssemic:
+ 			tp := mknode(nempty);
+ 		end;
+ 		pstmt := tp
+ 	end;
+ 
+ 	(*	Parse an assignment or a procedure call.		*)
+ 	function psimple;
+ 
+ 	var	tq,
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		tp := pvariable(oldid(currsym.vid, lidentifier));
+ 		if currsym.st = sassign then
+ 		    begin
+ 			tq := mknode(nassign);
+ 			tq^.tlhs := tp;
+ 			tq^.trhs := pexpr(nil);
+ 			tp := tq
+ 		    end;
+ 		psimple := tp
+ 	end;
+ 
+ 	(*	Parse a varable-reference (or a subroutine-call).	*)
+ 	function pvariable;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([slpar, slbrack, sdot, sarrow,
+ 			sassign, ssemic, scomma, scolon, sdotdot,
+ 			splus, sminus, smul, sdiv, smod, squot,
+ 			sand, sor, sinn, srpar, srbrack,
+ 			sle, slt, seq, sge, sgt, sne,
+ 			send, suntil, sthen, selse, sdo, sdownto, sto, sof]);
+ 		if currsym.st in [slpar, slbrack, sdot, sarrow] then
+ 		    begin
+ 			case currsym.st of
+ 			  slpar:
+ 			    begin
+ 				tp := mknode(ncall);
+ 				tp^.tcall := varptr;
+ 				tq := nil;
+ 				repeat
+ 					if tq = nil then
+ 					    begin
+ 						tq := pexpr(nil);
+ 						tp^.taparm  := tq
+ 					    end
+ 					else begin
+ 						tq^.tnext := pexpr(nil);
+ 						tq := tq^.tnext
+ 					     end;
+ 				until	currsym.st = srpar
+ 			    end;
+ 			  slbrack:
+ 			    begin
+ 				tq := varptr;
+ 				repeat
+ 					tp := mknode(nindex);
+ 					tp^.tvariable := tq;
+ 					tp^.toffset := pexpr(nil);
+ 					tq := tp
+ 				until	currsym.st = srbrack
+ 			    end;
+ 			  sdot:
+ 			    begin
+ 				tp := mknode(nselect);
+ 				tp^.trecord := varptr;
+ 				nextsymbol([sid]);
+ 				tq := typeof(varptr);
+ 				enterscope(tq^.trscope);
+ 				tp^.tfield := oldid(currsym.vid, lfield);
+ 				leavescope
+ 			    end;
+ 			  sarrow:
+ 			    begin
+ 				tp := mknode(nderef);
+ 				tp^.texps := varptr
+ 			    end
+ 			end;(* case *)
+ 			tp := pvariable(tp)
+ 		    end
+ 		else begin
+ 			tp := varptr;
+ 			if tp^.tt = nid then
+ 			    begin
+ 				tq := idup(tp);
+ 				if tq <> nil then
+ 					if tq^.tt in [nfunc, nproc,
+ 							nparproc, nparfunc] then
+ 					    begin
+ 						(* subroutine-call without
+ 						   parameters *)
+ 						tp := mknode(ncall);
+ 						tp^.tcall := varptr;
+ 						tp^.taparm := nil
+ 					    end
+ 			    end
+ 		     end;
+ 		pvariable := tp
+ 	end;
+ 
+ 	(*	Parse an expression.					*)
+ 	function pexpr;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		nt	: treetyp;
+ 		next	: boolean;
+ 
+ 		function padjust(tu, tr : treeptr) : treeptr;
+ 		begin
+ 			if pprio[tu^.tt] >= pprio[tr^.tt] then
+ 			    begin
+ 				if tr^.tt in [nnot, numinus, nuplus,
+ 							nset, nderef] then
+ 					tr^.texps := padjust(tu, tr^.texps)
+ 				else
+ 					tr^.texpl := padjust(tu, tr^.texpl);
+ 				padjust := tr
+ 			    end
+ 			else begin
+ 				if tu^.tt in [nnot, numinus, nuplus,
+ 							nset, nderef] then
+ 					tu^.texps := tr
+ 				else
+ 					tu^.texpr := tr;
+ 				padjust := tu
+ 			     end
+ 		end;
+ 
+ 	begin
+ 		nextsymbol([sid, schar, sinteger, sreal, sstring, snil,
+ 				splus, sminus, snot, slpar, slbrack, srbrack]);
+ 		next := true;
+ 		case currsym.st of
+ 		  splus:
+ 		    begin
+ 			tp := mknode(nuplus);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  sminus:
+ 		    begin
+ 			tp := mknode(numinus);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  snot:
+ 		    begin
+ 			tp := mknode(nnot);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  schar,
+ 		  sinteger,
+ 		  sreal,
+ 		  sstring:
+ 			tp := mklit;
+ 		  snil:
+ 		    begin
+ 			usenilp := true;
+ 			tp := mknode(nnil);
+ 		    end;
+ 		  sid:
+ 		    begin
+ 			tp := pvariable(oldid(currsym.vid, lidentifier));
+ 			next := false
+ 		    end;
+ 		  slpar:
+ 		    begin
+ 			tp := mknode(nuplus);
+ 			tp^.texps := pexpr(nil)
+ 		    end;
+ 		  slbrack:
+ 		    begin
+ 			usesets := true;
+ 			tp := mknode(nset);
+ 			tp^.texps := nil;
+ 			tq := nil;
+ 			repeat
+ 				if tq = nil then
+ 				    begin
+ 					tq := pexpr(nil);
+ 					tp^.texps := tq
+ 				    end
+ 				else begin
+ 					tq^.tnext := pexpr(nil);
+ 					tq := tq^.tnext
+ 				     end
+ 			until	currsym.st = srbrack;
+ 		    end;
+ 		  srbrack:
+ 		    begin
+ 			tp := mknode(nempty);
+ 			next := false
+ 		    end
+ 		end;
+ 		if next then
+ 			nextsymbol([
+ 				scolon, ssemic, scomma, sdotdot, srpar, srbrack,
+ 				sle, slt, seq, sge, sgt, sne,
+ 				splus, sminus, smul, sdiv, smod, squot,
+ 				sand, sor, sinn,
+ 				send, suntil, sthen, selse, sdo, sdownto, sto,
+ 				sof, slpar, slbrack]);
+ 		case currsym.st of
+ 		  sdotdot:
+ 			nt := nrange;
+ 		  splus:
+ 			nt := nplus;
+ 		  sminus:
+ 			nt := nminus;
+ 		  smul:
+ 			nt := nmul;
+ 		  sdiv:
+ 			nt := ndiv;
+ 		  smod:
+ 			nt := nmod;
+ 		  squot:
+ 		    begin
+ 			defnams[dreal]^.lused := true;
+ 			nt := nquot;
+ 		    end;
+ 		  sand:
+ 			nt := nand;
+ 		  sor:
+ 			nt := nor;
+ 		  sinn:
+ 		    begin
+ 			nt := nin;
+ 			usesets := true
+ 		    end;
+ 		  sle:
+ 			nt := nle;
+ 		  slt:
+ 			nt := nlt;
+ 		  seq:
+ 			nt := neq;
+ 		  sge:
+ 			nt := nge;
+ 		  sgt:
+ 			nt := ngt;
+ 		  sne:
+ 			nt := nne;
+ 		  scolon:
+ 			nt := nformat;
+ 		  sid, schar, sinteger, sreal, sstring, snil,
+ 		  ssemic, scomma, slpar, slbrack, srpar, srbrack,
+ 		  send, suntil, sthen, selse, sdo, sdownto, sto, sof:
+ 			nt := nnil
+ 		end;(* case *)
+ 		if nt in [nin .. nor, nand, nnot] then
+ 			defnams[dboolean]^.lused := true;
+ 		if nt <> nnil then
+ 		    begin
+ 			(* binary operator *)
+ 			tq := mknode(nt);
+ 			tq^.texpl := tp;
+ 			tq^.texpr := nil;
+ 			tp := pexpr(tq)
+ 		    end;
+ 
+ 		(* this statement yilds proper operator precedence *)
+ 		if tnp <> nil then
+ 			tp := padjust(tnp, tp);
+ 		pexpr := tp
+ 	end;
+ 
+ 	(*	Parse a case-statement.					*)
+ 	function pcase;
+ 
+ 	label	999;
+ 
+ 	var	tp,
+ 		tq,
+ 		tv	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(ncase);
+ 		tp^.tcasxp := pexpr(nil);
+ 		checksymbol([sof]);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nchoise);
+ 				tp^.tcaslst := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nchoise);
+ 				tq := tq^.tnext
+ 			     end;
+ 			tv := nil;
+ 			repeat
+ 				nextsymbol([sid, sinteger, schar,
+ 						splus, sminus, send, sother]);
+ 				if currsym.st in [send, sother] then
+ 					goto 999;
+ 				if tv = nil then
+ 				    begin
+ 					tv := pconstant(false);
+ 					tq^.tchocon := tv
+ 				    end
+ 				else begin
+ 					tv^.tnext := pconstant(false);
+ 					tv := tv^.tnext
+ 				     end;
+ 				nextsymbol([scomma, scolon])
+ 			until	currsym.st = scolon;
+ 			tq^.tchostmt := plabstmt
+ 		until	currsym.st = send;
+ 	999:
+ 		if currsym.st = sother then
+ 		    begin
+ 			nextsymbol([scolon, sid, sif, swhile, srepeat, sfor,
+ 				    scase, swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			if currsym.st = scolon then
+ 				nextsymbol([sid, sif, swhile, srepeat, sfor,
+ 				    scase, swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			tp^.tcasother := pstmt
+ 		    end
+ 		else begin
+ 			tp^.tcasother := nil;
+ 			usecase := true
+ 		     end;
+ 		nextsymbol([ssemic, send, selse, suntil]);
+ 		pcase := tp
+ 	end;
+ 
+ 	(*	Parse an if-statement.					*)
+ 	function pif;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nif);
+ 		tp^.tifxp := pexpr(nil);
+ 		checksymbol([sthen]);
+ 		tp^.tthen := plabstmt;
+ 		if currsym.st = selse then
+ 			tp^.telse := plabstmt
+ 		else
+ 			tp^.telse := nil;
+ 		pif := tp;
+ 	end;
+ 
+ 	(*	Parse a while-statement.				*)
+ 	function pwhile;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nwhile);
+ 		tp^.twhixp := pexpr(nil);
+ 		checksymbol([sdo]);
+ 		tp^.twhistmt := plabstmt;
+ 		pwhile := tp;
+ 	end;
+ 
+ 	(*	Parse a repeat-statement.				*)
+ 	function prepeat;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nrepeat);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := plabstmt;
+ 				tp^.treptstmt := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := plabstmt;
+ 				tq := tq^.tnext
+ 			     end;
+ 			checksymbol([ssemic, suntil])
+ 		until	currsym.st = suntil;
+ 		tp^.treptxp := pexpr(nil);
+ 		prepeat := tp
+ 	end;
+ 
+ 	(*	Parse a for-statement.					*)
+ 	function pfor;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nfor);
+ 		nextsymbol([sid]);
+ 		tp^.tforid := oldid(currsym.vid, lidentifier);
+ 		nextsymbol([sassign]);
+ 		tp^.tfrom := pexpr(nil);
+ 		checksymbol([sdownto, sto]);
+ 		tp^.tincr := currsym.st = sto;
+ 		tp^.tto := pexpr(nil);
+ 		checksymbol([sdo]);
+ 		tp^.tforstmt := plabstmt;
+ 		pfor := tp
+ 	end;
+ 
+ 	(*	Parse a with-statement.					*)
+ 	function pwith;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nwith);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nwithvar);
+ 				tp^.twithvar := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nwithvar);
+ 				tq := tq^.tnext
+ 			     end;
+ 			enterscope(nil);
+ 			tq^.tenv := currscope;
+ 			tq^.texpw := pexpr(nil);
+ 			scopeup(tq^.texpw);
+ 			checksymbol([scomma, sdo])
+ 		until	currsym.st = sdo;
+ 		tp^.twithstmt := plabstmt;
+ 		tq := tp^.twithvar;
+ 		while tq <> nil do
+ 		    begin
+ 			leavescope;
+ 			tq := tq^.tnext
+ 		    end;
+ 		pwith := tp
+ 	end;
+ 
+ 	(*	Parse a goto-statement.					*)
+ 	function pgoto;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([sinteger]);
+ 		tp := mknode(ngoto);
+ 		tp^.tlabel := oldlbl(false);
+ 		nextsymbol([ssemic, send, suntil, selse]);
+ 		pgoto := tp
+ 	end;
+ 
+ 	(*	Parse a begin-statement.				*)
+ 	function pbegin;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := plabstmt;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := plabstmt;
+ 				tq := tq^.tnext
+ 			     end
+ 		until	currsym.st = send;
+ 		if retain then
+ 		    begin
+ 			tq := mknode(nbegin);
+ 			tq^.tbegin := tp;
+ 			tp := tq
+ 		    end;
+ 		nextsymbol([send, selse, suntil, sdot, ssemic]);
+ 		pbegin := tp
+ 	end;
+ 
+ begin	(* parse *)
+ 	nextsymbol([spgm, sconst, stype, svar, sproc, sfunc]);
+ 	if currsym.st = spgm then
+ 		top := pprogram
+ 	else
+ 		top := pmodule;
+ 	nextsymbol([seof]);
+ end;	(* parse *)
+ 
+ (*	Compute value for a node (which must be some kind of constant).	*)
+ function cvalof(tp : treeptr) : integer;
+ 
+ var	v	: integer;
+ 	tq	: treeptr;
+ 
+ begin
+ 	case tp^.tt of
+ 	  nuplus:
+ 		cvalof := cvalof(tp^.texps);
+ 	  numinus:
+ 		cvalof := - cvalof(tp^.texps);
+ 	  nnot:
+ 		cvalof := 1 - cvalof(tp^.texps);
+ 	  nid:
+ 	    begin
+ 		tq := idup(tp);
+ 		if tq = nil then
+ 			fatal(etree);
+ 		tp := tp^.tsym^.lsymdecl;
+ 		case tq^.tt of
+ 		  nscalar:
+ 		    begin
+ 			v := 0;
+ 			tq := tq^.tscalid;
+ 			while tq <> nil do
+ 				if tq = tp then
+ 					tq := nil
+ 				else begin
+ 					v := v + 1;
+ 					tq := tq^.tnext
+ 				     end;
+ 			cvalof := v
+ 		    end;
+ 		  nconst:
+ 			cvalof := cvalof(tq^.tbind);
+ 		end;(* case *)
+ 	    end;
+ 	  ninteger:
+ 		cvalof := tp^.tsym^.linum;
+ 	  nchar:
+ 		cvalof := ord(tp^.tsym^.lchar);
+ 	end (* case *)
+ end;	(* cvalof *)
+ 
+ (*	Compute lower value of subrange or scalar type.			*)
+ function clower(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 
+ begin
+ 	tq := typeof(tp);
+ 	if tq^.tt = nscalar then
+ 		clower := scalbase
+ 	else if tq^.tt = nsubrange then
+ 		if tq^.tup^.tt = nconfarr then
+ 			clower := 0
+ 		else
+ 			clower := cvalof(tq^.tlo)
+ 	else if tq = typnods[tchar] then
+ 		clower := 0
+ 	else if tq = typnods[tinteger] then
+ 		clower := -maxint
+ 	else
+ 		fatal(etree)
+ end;	(* clower *)
+ 
+ (*	Compute upper value of subrange or scalar type.			*)
+ function cupper(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 	i	: integer;
+ 
+ begin
+ 	tq := typeof(tp);
+ 	if tq^.tt = nscalar then
+ 	    begin
+ 		tq := tq^.tscalid;
+ 		i := scalbase;
+ 		while tq^.tnext <> nil do
+ 		    begin
+ 			i := i + 1;
+ 			tq := tq^.tnext
+ 		    end;
+ 		cupper := i
+ 	    end
+ 	else if tq^.tt = nsubrange then
+ 		if tq^.tup^.tt = nconfarr then
+ 			fatal(euprconf)
+ 		else
+ 			cupper := cvalof(tq^.thi)
+ 	else if tq = typnods[tchar] then
+ 		cupper := maxchar
+ 	else if tq = typnods[tinteger] then
+ 		cupper := maxint
+ 	else
+ 		fatal(etree)
+ end;	(* cupper *)
+ 
+ (*	Compute the number of elements in a subrange.			*)
+ function crange(tp : treeptr) : integer;
+ 
+ begin
+ 	crange := cupper(tp) - clower(tp) + 1
+ end;
+ 
+ (*	Return number of words uset to store a set.			*)
+ function csetwords(i : integer) : integer;
+ 
+ begin
+ 	i := (i+(setbits)) div (setbits+1);
+ 	if i > maxsetrange then
+ 		error(esetsize);
+ 	csetwords := i
+ end;
+ 
+ (*	Return number of words uset to store a set.			*)
+ function csetsize(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 	i	: integer;
+ 
+ begin
+ 	tq := typeof(tp^.tof);
+ 	i := clower(tq);
+ 	(* bits in sets are always numbered from 0, so we (arbitrarily)
+ 	   decide that the base must be in the first 6 words to avoid
+ 	   unnecessary waste of space *)
+ 	if (i < 0) or (i >= 6 * (setbits+1))  then
+ 		error(esetbase);
+ 	csetsize := csetwords(crange(tq)) + 1
+ end;
+ 
+ (*	Determine if tp is declared in the procedure it is used in.	*)
+ function islocal(tp : treeptr) : boolean;
+ 
+ var	tq	: treeptr;
+ 
+ begin
+ 	tq := tp^.tsym^.lsymdecl;
+ 	while not (tq^.tt in [nproc, nfunc, npgm]) do
+ 		tq := tq^.tup;
+ 	while not (tp^.tt in [nproc, nfunc, npgm]) do
+ 		tp := tp^.tup;
+ 	islocal := tp = tq
+ end;
+ 
+ (*	Perform necessary transformations on tree and identifiers	*)
+ (*	before generating code.						*)
+ procedure transform;
+ 
+ 
+ 	(*	Rename function when used as a variable.		*)
+ 	procedure renamf(tp : treeptr);
+ 
+ 	var	ip, iq	: symptr;
+ 		tq, tv	: treeptr;
+ 
+ 		(*	This procedure recursively descends the tree	*)
+ 		(*	and replaces function-assignments with variable	*)
+ 		(*	assignments.					*)
+ 		procedure crtnvar(tp : treeptr);
+ 
+ 		begin
+ 			while tp <> nil do
+ 			    begin
+ 				case tp^.tt of
+ 				  npgm:
+ 					crtnvar(tp^.tsubsub);
+ 				  nfunc,
+ 				  nproc:
+ 				    begin
+ 					crtnvar(tp^.tsubsub);
+ 					crtnvar(tp^.tsubstmt)
+ 				    end;
+ 				  nbegin:
+ 					crtnvar(tp^.tbegin);
+ 				  nif:
+ 				    begin
+ 					crtnvar(tp^.tthen);
+ 					crtnvar(tp^.telse)
+ 				    end;
+ 				  nwhile:
+ 					crtnvar(tp^.twhistmt);
+ 				  nrepeat:
+ 					crtnvar(tp^.treptstmt);
+ 				  nfor:
+ 					crtnvar(tp^.tforstmt);
+ 				  ncase:
+ 				    begin
+ 					crtnvar(tp^.tcaslst);
+ 					crtnvar(tp^.tcasother)
+ 				    end;
+ 				  nchoise:
+ 					crtnvar(tp^.tchostmt);
+ 				  nwith:
+ 					crtnvar(tp^.twithstmt);
+ 				  nlabstmt:
+ 					crtnvar(tp^.tstmt);
+ 				  nassign:
+ 				    begin
+ 					(* revoke calls in assignment lhs, (mis-
+ 					   parsed due to ambiguous syntax) *)
+ 					if tp^.tlhs^.tt = ncall then
+ 					    begin
+ 						tp^.tlhs := tp^.tlhs^.tcall;
+ 						tp^.tlhs^.tup := tp
+ 					    end;
+ 					(* function name -> variable name *)
+ 					tv := tp^.tlhs;
+ 					if tv^.tt = nid then
+ 						if tv^.tsym = ip then
+ 							tv^.tsym := iq
+ 				    end;
+ 				  nbreak,
+ 				  npush,
+ 				  npop,
+ 				  ngoto,
+ 				  nempty,
+ 				  ncall:
+ 					(* no op *)
+ 				end;(* case *)
+ 				tp := tp^.tnext
+ 			    end
+ 		end;
+ 
+ 	begin	(* renamf *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  npgm,
+ 			  nproc:
+ 				renamf(tp^.tsubsub);
+ 			  nfunc:
+ 			    begin
+ 				(* create a variable to hold return value *)
+ 				tq := mknode(nvar);
+ 				tq^.tattr := aregister;
+ 				tq^.tup := tp;
+ 				tq^.tidl := newid(mkvariable('R'));
+ 				tq^.tidl^.tup := tq;
+ 				tq^.tbind := tp^.tfuntyp;
+ 				(* put it FIRST among variables, see esubr() *)
+ 				tq^.tnext := tp^.tsubvar;
+ 				tp^.tsubvar := tq;
+ 
+ 				iq := tq^.tidl^.tsym;
+ 				ip := tp^.tsubid^.tsym;
+ 				crtnvar(tp^.tsubsub);
+ 				crtnvar(tp^.tsubstmt);
+ 				(* process inner functions *)
+ 				renamf(tp^.tsubsub)
+ 			    end;
+ 			end;(* case *)
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* renamf *)
+ 
+ 	(*	This procedure rearranges the tree such that multiple	*)
+ 	(*	vardeclarations don't have (structured) types attached	*)
+ 	(*	to them. If such a declararation is found, a new name	*)
+ 	(*	is created and the type is moved to the type section.	*)
+ 	procedure extract(tp : treeptr);
+ 
+ 	var	vp	: treeptr;
+ 
+ 		(*	Create a declaration for tp, enter in pp type-	*)
+ 		(*	list and return an identifier referencing it.	*)
+ 		function xtrit(tp, pp : treeptr; last : boolean) : treeptr;
+ 
+ 		var	np, rp	: treeptr;
+ 			ip	: idptr;
+ 
+ 		begin
+ 			(* create new declaration *)
+ 			np := mknode(ntype);
+ 			ip := mkvariable('T');
+ 			np^.tidl := newid(ip);
+ 			np^.tidl^.tup := np;
+ 
+ 			(* create substitute id *)
+ 			rp := oldid(ip, lidentifier);
+ 			rp^.tup := tp^.tup;
+ 			rp^.tnext := tp^.tnext;
+ 
+ 			(* steal type description *)
+ 			np^.tbind := tp;
+ 			tp^.tup := np;
+ 			tp^.tnext := nil;
+ 
+ 			(* add new declaration to tree *)
+ 			np^.tup := pp;
+ 			if last and (pp^.tsubtype <> nil) then
+ 			    begin
+ 				pp := pp^.tsubtype;
+ 				while pp^.tnext <> nil do
+ 					pp := pp^.tnext;
+ 				pp^.tnext := np
+ 			    end
+ 			else begin
+ 				np^.tnext := pp^.tsubtype;
+ 				pp^.tsubtype := np;
+ 			    end;
+ 
+ 			xtrit := rp;
+ 		end;
+ 
+ 		(*	Extract anonymous enumeration types.		*)
+ 		function xtrenum(tp, pp : treeptr) : treeptr;
+ 
+ 			(*	Name record-types referenced by ptrs.	*)
+ 			procedure nametype(tp : treeptr);
+ 
+ 			begin
+ 				tp := typeof(tp);
+ 				if tp^.tt = nrecord then
+ 					if tp^.tuid = nil then
+ 						tp^.tuid := mkvariable('S');
+ 			end;
+ 
+ 		begin
+ 			if tp <> nil then
+ 			    begin
+ 				case tp^.tt of
+ 				  nfield,
+ 				  ntype,
+ 				  nvar:
+ 					tp^.tbind :=
+ 						xtrenum(tp^.tbind, pp);
+ 
+ 				  nscalar:
+ 					if tp^.tup^.tt <> ntype then
+ 					    tp := xtrit(tp, pp, false);
+ 
+ 				  narray:
+ 				    begin
+ 					tp^.taindx := xtrenum(tp^.taindx, pp);
+ 					tp^.taelem := xtrenum(tp^.taelem, pp);
+ 				    end;
+ 				  nrecord:
+ 				    begin
+ 					tp^.tflist := xtrenum(tp^.tflist, pp);
+ 					tp^.tvlist := xtrenum(tp^.tvlist, pp);
+ 				    end;
+ 				  nvariant:
+ 					tp^.tvrnt := xtrenum(tp^.tvrnt, pp);
+ 				  nfileof:
+ 					tp^.tof := xtrenum(tp^.tof, pp);
+ 
+ 				  nptr:
+ 					nametype(tp^.tptrid);
+ 
+ 				  nid,
+ 				  nsubrange,
+ 				  npredef,
+ 				  nempty,
+ 				  nsetof:
+ 					(* no op *)
+ 				end;(* case *)
+ 				tp^.tnext := xtrenum(tp^.tnext, pp)
+ 			    end;
+ 			xtrenum := tp
+ 		end;
+ 
+ 	begin	(* extract *)
+ 		while tp <> nil do
+ 		    begin
+ 			(* tp points to a program/procedure/function node *)
+ 			tp^.tsubtype := xtrenum(tp^.tsubtype, tp);
+ 			tp^.tsubvar := xtrenum(tp^.tsubvar, tp);
+ 			vp := tp^.tsubvar;
+ 			while vp <> nil do
+ 			    begin
+ 				(* variables of structured unnamed types *)
+ 				if vp^.tbind^.tt in [nscalar, narray,
+ 							nrecord, nfileof] then
+ 					vp^.tbind := xtrit(vp^.tbind, tp, true);
+ 				vp := vp^.tnext
+ 			    end;
+ 			extract(tp^.tsubsub);
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* extract *)
+ 
+ 	(*	This procedure moves all local constants and types	*)
+ 	(*	used in nested procedures to the outermost declaration	*)
+ 	(*	level so that nested procedures may be extracted.	*)
+ 	procedure global(tp, dp : treeptr; depend : boolean);
+ 
+ 	label	555;
+ 
+ 	var	ip	: treeptr;
+ 		dep	: boolean;
+ 
+ 		(*	Mark all declared identifiers as unused.	*)
+ 		procedure markdecl(xp : treeptr);
+ 
+ 		begin
+ 			while xp <> nil do
+ 			    begin
+ 				case xp^.tt of
+ 				  nid:
+ 					xp^.tsym^.lused := false;
+ 				  nconst:
+ 					markdecl(xp^.tidl);
+ 				  ntype,
+ 				  nvar,
+ 				  nvalpar,
+ 				  nvarpar,
+ 				  nfield:
+ 				    begin
+ 					markdecl(xp^.tidl);
+ 					if xp^.tbind^.tt <> nid then
+ 						markdecl(xp^.tbind)
+ 				    end;
+ 				  nscalar:
+ 					markdecl(xp^.tscalid);
+ 				  nrecord:
+ 				    begin
+ 					markdecl(xp^.tflist);
+ 					markdecl(xp^.tvlist)
+ 				    end;
+ 				  nvariant:
+ 					markdecl(xp^.tvrnt);
+ 				  nconfarr:
+ 					if xp^.tcelem^.tt <> nid then
+ 						markdecl(xp^.tcelem);
+ 				  narray:
+ 					if xp^.taelem^.tt <> nid then
+ 						markdecl(xp^.taelem);
+ 				  nsetof,
+ 				  nfileof:
+ 					if xp^.tof^.tt <> nid then
+ 						markdecl(xp^.tof);
+ 				  nparproc,
+ 				  nparfunc:
+ 					markdecl(xp^.tparid);
+ 				  nptr,
+ 				  nsubrange:
+ 					(* no op *)
+ 				end;(* case *)
+ 				xp := xp^.tnext
+ 			    end
+ 		end;	(* markdecl *)
+ 
+ 		(*	Move all marked declarations to global scope.	*)
+ 		function movedecl(tp : treeptr) : treeptr;
+ 
+ 		var	ip, np	: treeptr;
+ 			sp	: symptr;
+ 			move	: boolean;
+ 
+ 		begin
+ 			if tp <> nil then
+ 			    begin
+ 				move := false;
+ 				case tp^.tt of
+ 				  nconst,
+ 				  ntype:
+ 					ip := tp^.tidl
+ 				end;(* case *)
+ 				while ip <> nil do
+ 				    begin
+ 					if ip^.tsym^.lused then
+ 					    begin
+ 						move := true;
+ 						sp := ip^.tsym;
+ 						if sp^.lid^.inref > 1 then
+ 						  begin
+ 						    sp^.lid :=
+ 							mkrename( 'M', sp^.lid);
+ 						    sp^.lid^.inref :=
+ 							    sp^.lid^.inref - 1
+ 						  end;
+ 						ip := nil
+ 					    end
+ 					else
+ 						ip := ip^.tnext
+ 				    end;
+ 				if move then
+ 				    begin
+ 					np := tp^.tnext;
+ 					tp^.tnext := nil;
+ 					ip := tp;
+ 					while ip^.tt <> npgm do
+ 						ip := ip^.tup;
+ 					tp^.tup := ip;
+ 					case tp^.tt of
+ 					  nconst:
+ 					    begin
+ 						if ip^.tsubconst = nil then
+ 							ip^.tsubconst := tp
+ 						else begin
+ 							ip := ip^.tsubconst;
+ 							while ip^.tnext <> nil
+ 							    do ip := ip^.tnext;
+ 							ip^.tnext := tp
+ 						     end
+ 					    end;
+ 					  ntype:
+ 					    begin
+ 						if ip^.tsubtype = nil then
+ 							ip^.tsubtype := tp
+ 						else begin
+ 							ip := ip^.tsubtype;
+ 							while ip^.tnext <> nil
+ 							    do ip := ip^.tnext;
+ 							ip^.tnext := tp
+ 						     end
+ 					    end
+ 					end;(* case *)
+ 					(* tp is moved, drop it and process
+ 					   remainder of declarationlist *)
+ 					tp := movedecl(np)
+ 				    end
+ 				else
+ 					tp^.tnext := movedecl(tp^.tnext)
+ 			    end;
+ 			movedecl := tp
+ 		end;	(* movedecl *)
+ 
+ 		(*	This procedure lifts out variables/parameters	*)
+ 		(*	used in nested procedures/functions.		*)
+ 		procedure movevars(tp, vp : treeptr);
+ 
+ 		label	555;
+ 
+ 		var	ep, dp, np	: treeptr;
+ 			ip		: idptr;
+ 			sp		: symptr;
+ 
+ 			(*	Move a variable	declaration to global	*)
+ 			(*	var declaration lists.			*)
+ 			procedure moveglob(tp, dp : treeptr);
+ 
+ 			begin
+ 				while tp^.tt <> npgm do
+ 					tp := tp^.tup;
+ 				dp^.tup := tp;
+ 				dp^.tnext := tp^.tsubvar;
+ 				tp^.tsubvar := dp
+ 			end;
+ 
+ 			(*	Create nodes for saving a global	*)
+ 			(*	pointer variable.			*)
+ 			function stackop(decl, glob, loc : treeptr) : treeptr;
+ 
+ 			var	op, ip, dp, tp	: treeptr;
+ 
+ 			begin
+ 				(* create a new variable to hold old value
+ 				   of the global variable during a call *)
+ 				ip := newid(mkvariable('F'));
+ 				case vp^.tt of
+ 				  nvarpar,
+ 				  nvalpar,
+ 				  nvar:
+ 				    begin
+ 					dp := mknode(nvarpar);
+ 					dp^.tattr := areference;
+ 					dp^.tidl := ip;
+ 					(* use same type as the global var *)
+ 					dp^.tbind := decl^.tbind
+ 				    end;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					dp := mknode(vp^.tt);
+ 					dp^.tparid := ip;
+ 					dp^.tparparm := nil;
+ 					dp^.tpartyp := vp^.tpartyp
+ 				    end
+ 				end;(* case *)
+ 				ip^.tup := dp;
+ 
+ 				(* add variable to declarationlists *)
+ 				tp := decl;
+ 				while not (tp^.tt in [nproc, nfunc, npgm]) do
+ 					tp := tp^.tup;
+ 				dp^.tup := tp;
+ 				if tp^.tsubvar = nil then
+ 					tp^.tsubvar := dp
+ 				else begin
+ 					tp := tp^.tsubvar;
+ 					while tp^.tnext <> nil do
+ 						tp := tp^.tnext;
+ 					tp^.tnext := dp
+ 				     end;
+ 				dp^.tnext := nil;
+ 
+ 				(* create an assignment saving value *)
+ 				op := mknode(npush);
+ 				op^.tglob := glob;
+ 				op^.tloc := loc;
+ 				op^.ttmp := ip;
+ 				stackop := op
+ 			end;
+ 
+ 			(*	Take a "push" node, create "pop" node	*)
+ 			(*	and add both to tree.			*)
+ 			procedure addcode(tp, push : treeptr);
+ 
+ 			var	pop	: treeptr;
+ 
+ 			begin
+ 				pop := mknode(npop);
+ 				(* share variables with "push"-node *)
+ 				pop^.tglob := push^.tglob;
+ 				pop^.ttmp := push^.ttmp;
+ 				pop^.tloc := nil;
+ 
+ 				(* add npush to head of statement list *)
+ 				push^.tnext := tp^.tsubstmt;
+ 				tp^.tsubstmt := push;
+ 				push^.tup := tp;
+ 
+ 				(* add npop to end of statement list *)
+ 				while push^.tnext <> nil do
+ 					push := push^.tnext;
+ 				push^.tnext := pop;
+ 				pop^.tup := tp
+ 			end;
+ 
+ 		begin	(* movevars *)
+ 			while vp <> nil do
+ 			    begin
+ 				case vp^.tt of
+ 				  nvar,
+ 				  nvalpar,
+ 				  nvarpar:
+ 					dp := vp^.tidl;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					dp := vp^.tparid;
+ 					if dp^.tsym^.lused then
+ 					    begin
+ 						(* create a var declaration *)
+ 						ep := mknode(vp^.tt);
+ 						ep^.tparparm := nil;
+ 						ep^.tpartyp := vp^.tpartyp;
+ 						np := newid(mkrename('G',
+ 								dp^.tsym^.lid));
+ 						ep^.tparid := np;
+ 						np^.tup := ep;
+ 						(* swap id's and symbols *)
+ 						sp := np^.tsym;
+ 						ip := sp^.lid;
+ 						np^.tsym^.lid := dp^.tsym^.lid;
+ 						dp^.tsym^.lid := ip;
+ 						np^.tsym := dp^.tsym;
+ 						dp^.tsym := sp;
+ 						np^.tsym^.lsymdecl := np;
+ 						dp^.tsym^.lsymdecl := dp;
+ 						(* make declaration global *)
+ 						moveglob(tp, ep);
+ 						(* add save/restore-code *)
+ 						addcode(tp, stackop(vp, np, dp))
+ 					    end;
+ 					goto 555
+ 				    end
+ 				end;(* case *)
+ 				while dp <> nil do
+ 				    begin
+ 					if dp^.tsym^.lused then
+ 					    begin
+ 						(* create a varpar declaration,
+ 						   (nvarpar will cause emit to
+ 						   treat the new identifier
+ 						   as a pointer) *)
+ 						ep := mknode(nvarpar);
+ 						ep^.tattr := areference;
+ 						np := newid(mkrename('G',
+ 								dp^.tsym^.lid));
+ 						ep^.tidl := np;
+ 						np^.tup := ep;
+ 						ep^.tbind := vp^.tbind;
+ 						if ep^.tbind^.tt = nid then
+ 							ep^.tbind^.tsym^.lused
+ 								:= true;
+ 						(* swap id's and symbols *)
+ 						sp := np^.tsym;
+ 						ip := sp^.lid;
+ 						np^.tsym^.lid := dp^.tsym^.lid;
+ 						dp^.tsym^.lid := ip;
+ 						np^.tsym := dp^.tsym;
+ 						dp^.tsym := sp;
+ 						np^.tsym^.lsymdecl := np;
+ 						dp^.tsym^.lsymdecl := dp;
+ 						(* note that dp is referenced *)
+ 						dp^.tup^.tattr := aextern;
+ 						(* make declaration global *)
+ 						moveglob(tp, ep);
+ 						(* add save/restore-code *)
+ 						addcode(tp, stackop(vp, np, dp))
+ 					    end;
+ 					dp := dp^.tnext
+ 				    end;
+ 			555:
+ 				vp := vp^.tnext
+ 			    end
+ 		end;	(* movevars *)
+ 
+ 		(*	Break out a local variable and set the register	*)
+ 		(*	attribute.					*)
+ 		procedure registervar(tp : treeptr);
+ 
+ 		var	vp, xp	: treeptr;
+ 
+ 		begin
+ 			vp := idup(tp);
+ 			tp := tp^.tsym^.lsymdecl;
+ 			(* vp points to nvar node *)
+ 			if (vp^.tidl <> tp) or (tp^.tnext <> nil) then
+ 			    begin
+ 				(* tp is not alone in list of identifiers,
+ 				   create a new nvar-node and hook up tp *)
+ 				xp := mknode(nvar);
+ 				xp^.tattr := anone;
+ 				xp^.tidl := tp;
+ 				tp^.tup := xp;
+ 				(* enter new nvar node among declarations *)
+ 				xp^.tup := vp^.tup;
+ 				xp^.tbind := vp^.tbind; (* borrow type *)
+ 				xp^.tnext := vp^.tnext;
+ 				vp^.tnext := xp;
+ 				(* break tp out of list of identifiers *)
+ 				if vp^.tidl = tp then
+ 					vp^.tidl := tp^.tnext
+ 				else begin
+ 					vp := vp^.tidl;
+ 					while vp^.tnext <> tp do
+ 						vp := vp^.tnext;
+ 					vp^.tnext := tp^.tnext
+ 				     end;
+ 				tp^.tnext := nil
+ 			    end;
+ 			(* tp is alone in this declaration, set attribute *)
+ 			if tp^.tup^.tattr = anone then
+ 				tp^.tup^.tattr := aregister
+ 		end;	(* registervar *)
+ 
+ 		(*	Check static declarationlevel for a label	*)
+ 		(*	used in a non-local goto.			*)
+ 		procedure cklevel(tp : treeptr);
+ 
+ 		begin
+ 			tp := tp^.tsym^.lsymdecl;
+ 			while not(tp^.tt in [npgm, nproc, nfunc]) do
+ 				tp := tp^.tup;
+ 			if tp^.tstat > maxlevel then
+ 				maxlevel := tp^.tstat
+ 		end;
+ 
+ 	begin	(* global *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  nproc,
+ 			  nfunc:
+ 			    begin
+ 				(* procid/parameters/const/type/var not used *)
+ 				markdecl(tp^.tsubid);
+ 				markdecl(tp^.tsubpar);
+ 				markdecl(tp^.tsubconst);
+ 				markdecl(tp^.tsubtype);
+ 				markdecl(tp^.tsubvar);
+ 
+ 				(* mark those used in nested subroutines *)
+ 				global(tp^.tsubsub, tp, false);
+ 
+ 				(* move out variables used in inner scope *)
+ 				movevars(tp, tp^.tsubpar);
+ 				movevars(tp, tp^.tsubvar);
+ 				(* move out const/type used in inner scope *)
+ 				tp^.tsubtype := movedecl(tp^.tsubtype);
+ 				tp^.tsubconst := movedecl(tp^.tsubconst);
+ 
+ 				(* mark identifiers used in this subroutine *)
+ 				global(tp^.tsubstmt, tp, true);
+ 				global(tp^.tsubpar, tp, false);
+ 				global(tp^.tsubvar, tp, false);
+ 				global(tp^.tsubtype, tp, false);
+ 				global(tp^.tfuntyp, tp, false);
+ 			    end;
+ 
+ 			  npgm:
+ 			    begin
+ 				markdecl(tp^.tsubconst);
+ 				markdecl(tp^.tsubtype);
+ 				markdecl(tp^.tsubvar);
+ 				global(tp^.tsubsub, tp, false);
+ 				global(tp^.tsubstmt, tp, true)
+ 			    end;
+ 
+ 			  nconst,
+ 			  ntype,
+ 			  nvar,
+ 			  nfield,
+ 			  nvalpar,
+ 			  nvarpar:
+ 			    begin
+ 				ip := tp^.tidl;
+ 				dep := depend;
+ 				while (ip <> nil) and not dep do
+ 				    begin
+ 					(* for all used identifiers, propagate
+ 					   the use to their bindings *)
+ 					if ip^.tsym^.lused then
+ 						dep := true;
+ 					ip := ip^.tnext
+ 				    end;
+ 				global(tp^.tbind, dp, dep);
+ 			    end;
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				global(tp^.tparparm, dp, depend);
+ 				global(tp^.tpartyp, dp, depend)
+ 			    end;
+ 			  nsubrange:
+ 			    begin
+ 				global(tp^.tlo, dp, depend);
+ 				global(tp^.thi, dp, depend)
+ 			    end;
+ 			  nvariant:
+ 			    begin
+ 				global(tp^.tselct, dp, depend);
+ 				global(tp^.tvrnt, dp, depend)
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				global(tp^.tflist, dp, depend);
+ 				global(tp^.tvlist, dp, depend)
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				global(tp^.tcindx, dp, depend);
+ 				global(tp^.tcelem, dp, depend)
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				global(tp^.taindx, dp, depend);
+ 				global(tp^.taelem, dp, depend)
+ 			    end;
+ 			  nfileof,
+ 			  nsetof:
+ 				global(tp^.tof, dp, depend);
+ 			  nptr:
+ 				global(tp^.tptrid, dp, depend);
+ 			  nscalar:
+ 				global(tp^.tscalid, dp, depend);
+ 			  nbegin:
+ 				global(tp^.tbegin, dp, depend);
+ 			  nif:
+ 			    begin
+ 				global(tp^.tifxp, dp, depend);
+ 				global(tp^.tthen, dp, depend);
+ 				global(tp^.telse, dp, depend)
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				global(tp^.twhixp, dp, depend);
+ 				global(tp^.twhistmt, dp, depend)
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				global(tp^.treptstmt, dp, depend);
+ 				global(tp^.treptxp, dp, depend)
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				ip := idup(tp^.tforid);
+ 				if ip^.tup^.tt in [nproc, nfunc] then
+ 					registervar(tp^.tforid);
+ 				global(tp^.tforid, dp, depend);
+ 				global(tp^.tfrom, dp, depend);
+ 				global(tp^.tto, dp, depend);
+ 				global(tp^.tforstmt, dp, depend)
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				global(tp^.tcasxp, dp, depend);
+ 				global(tp^.tcaslst, dp, depend);
+ 				global(tp^.tcasother, dp, depend)
+ 			    end;
+ 			  nchoise:
+ 			    begin
+ 				global(tp^.tchocon, dp, depend);
+ 				global(tp^.tchostmt, dp, depend);
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				global(tp^.twithvar, dp, depend);
+ 				global(tp^.twithstmt, dp, depend)
+ 			    end;
+ 			  nwithvar:
+ 			    begin
+ 				ip := typeof(tp^.texpw);
+ 				if ip^.tuid = nil then
+ 					ip^.tuid := mkvariable('S');
+ 				global(tp^.texpw, dp, depend);
+ 			    end;
+ 			  nlabstmt:
+ 				global(tp^.tstmt, dp, depend);
+ 			  neq, nne, nlt, nle, ngt, nge:
+ 			    begin
+ 				global(tp^.texpl, dp, depend);
+ 				global(tp^.texpr, dp, depend);
+ 				ip := typeof(tp^.texpl);
+ 				if (ip = typnods[tstring]) or
+ 							(ip^.tt = narray) then
+ 					usecomp := true;
+ 				ip := typeof(tp^.texpr);
+ 				if (ip = typnods[tstring]) or
+ 							(ip^.tt = narray) then
+ 					usecomp := true
+ 			    end;
+ 			  nin, nor, nplus, nminus,
+ 			  nand, nmul, ndiv, nmod, nquot,
+ 			  nformat, nrange:
+ 			    begin
+ 				global(tp^.texpl, dp, depend);
+ 				global(tp^.texpr, dp, depend)
+ 			    end;
+ 
+ 			  nassign:
+ 			    begin
+ 				global(tp^.tlhs, dp, depend);
+ 				global(tp^.trhs, dp, depend)
+ 			    end;
+ 
+ 			  nnot,
+ 			  numinus,
+ 			  nuplus,
+ 			  nderef:
+ 				global(tp^.texps, dp, depend);
+ 			  nset:
+ 				global(tp^.texps, dp, depend);
+ 			  nindex:
+ 			    begin
+ 				global(tp^.tvariable, dp, depend);
+ 				global(tp^.toffset, dp, depend)
+ 			    end;
+ 			  nselect:
+ 				global(tp^.trecord, dp, depend);
+ 			  ncall:
+ 			    begin
+ 				global(tp^.tcall, dp, depend);
+ 				global(tp^.taparm, dp, depend)
+ 			    end;
+ 			  nid:
+ 			    begin
+ 				(* find declaration point *)
+ 				ip := idup(tp);
+ 				if ip = nil then
+ 					goto 555;
+ 				(* ip points to nconst/ntype/nvar/nproc/nfunc/
+ 				   nvalpar/nvarpar/nparproc or nparfunc node,
+ 				   move to beginning of enclosing scope *)
+ 				repeat
+ 					ip := ip^.tup;
+ 					if ip = nil then
+ 						goto 555
+ 					(* stop only for locally declared items,
+ 					   for global or predefined identifiers
+ 					   we will have gone to label 555 *)
+ 				until	ip^.tt in [npgm, nproc, nfunc];
+ 				if dp = ip then
+ 				    begin
+ 					(* identifier used here, mark it used *)
+ 					if depend then
+ 						tp^.tsym^.lused := true
+ 				    end
+ 				else begin
+ 					(* identifier declared in enclosing
+ 					   scope, mark it used *)
+ 					tp^.tsym^.lused := true
+ 				     end;
+ 			555:
+ 			    end;
+ 			  ngoto:
+ 				if not islocal(tp^.tlabel) then
+ 				    begin
+ 					tp^.tlabel^.tsym^.lgo := true;
+ 					usejmps := true;
+ 					cklevel(tp^.tlabel)
+ 				    end;
+ 
+ 			  nbreak,
+ 			  npush,
+ 			  npop,
+ 			  npredef,
+ 			  nempty,
+ 			  nchar,
+ 			  ninteger,
+ 			  nreal,
+ 			  nstring,
+ 			  nnil:
+ 			end;(* case *)
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* global *)
+ 
+ 	(*	Rename identifiers identical to C keywords.		*)
+ 	procedure renamc;
+ 
+ 	var	ip	: idptr;
+ 		cn	: cnames;
+ 
+ 	begin
+ 		(* rename identifiers that mustn't be redefined
+ 		   if C and Pascal semantix are to be preserved *)
+ 		for cn := cabort to cwrite do
+ 		    begin
+ 			ip := mkrename('C', ctable[cn]);
+ 			ctable[cn]^.istr := ip^.istr
+ 		    end
+ 	end;
+ 
+ 	(*	Rename subroutines declared in other subroutines such	*)
+ 	(*	that they can be moved to a global scope without name-	*)
+ 	(*	clashes.						*)
+ 	procedure renamp(tp : treeptr; on : boolean);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		(* tp points to subroutine-list *)
+ 		while tp <> nil do
+ 		    begin
+ 			renamp(tp^.tsubsub, true);
+ 			if on and (tp^.tsubstmt <> nil) then
+ 			    begin
+ 				(* change name of subroutine by prefixing
+ 				   a unique name *)
+ 				sp := tp^.tsubid^.tsym;
+ 				if sp^.lid^.inref > 1 then
+ 				    begin
+ 					sp^.lid := mkrename('P', sp^.lid);
+ 					sp^.lid^.inref := sp^.lid^.inref - 1
+ 				    end
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;
+ 
+ 	(*	Add initialization-code for file-variables.		*)
+ 	procedure initcode(tp : treeptr);
+ 
+ 	var	ti, tq, tu, tv	: treeptr;
+ 
+ 		(*	Determine if a type contains a file.		*)
+ 		function filevar(tp : treeptr) : boolean;
+ 
+ 		var	fv	: boolean;
+ 			tq	: treeptr;
+ 
+ 		begin
+ 			case tp^.tt of
+ 			  npredef:
+ 				fv := tp = typnods[ttext];
+ 			  nfileof:
+ 				fv := true;
+ 			  nconfarr:
+ 				fv := filevar(typeof(tp^.tcelem));
+ 			  narray:
+ 				fv := filevar(typeof(tp^.taelem));
+ 			  nrecord:
+ 			    begin
+ 				fv := false;
+ 				tq := tp^.tvlist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(tq^.tvrnt) then
+ 						error(evrntfile);
+ 					tq := tq^.tnext
+ 				    end;
+ 				tq := tp^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(typeof(tq^.tbind)) then
+ 					    begin
+ 						fv := true;
+ 						tq := nil
+ 					    end
+ 					else
+ 						tq := tq^.tnext
+ 				    end
+ 			    end;
+ 			  nptr:
+ 			    begin
+ 				fv := false;
+ 				if not tp^.tptrflag then
+ 				    begin
+ 					tp^.tptrflag := true;
+ 					if filevar(typeof(tp^.tptrid)) then
+ 						error(evarfile);
+ 					tp^.tptrflag := false
+ 				    end
+ 			    end;
+ 			  nsubrange,
+ 			  nscalar,
+ 			  nsetof:
+ 				fv := false
+ 			end;
+ 			filevar := fv
+ 		end;
+ 
+ 		(*	Create code for initialization of files.	*)
+ 		function fileinit(ti, tq : treeptr; opn : boolean) : treeptr;
+ 
+ 		var	tx, ty, tz	: treeptr;
+ 
+ 		begin
+ 			(* create 1 statement initializing "ti" *)
+ 			case tq^.tt of
+ 			  narray:
+ 			    begin
+ 				(* create declaration for a loopvariable *)
+ 				tz := newid(mkvariable('I'));
+ 				ty := mknode(nvar);
+ 				ty^.tattr := aregister;
+ 				ty^.tidl := tz;
+ 				ty^.tbind := typeof(tq^.taindx);
+ 				tz := tq;
+ 				while not(tz^.tt in [nproc, nfunc, npgm]) do
+ 					tz := tz^.tup;
+ 				linkup(tz, ty);
+ 				if tz^.tsubvar = nil then
+ 					tz^.tsubvar := ty
+ 				else begin
+ 					tz := tz^.tsubvar;
+ 					while tz^.tnext <> nil do
+ 						tz := tz^.tnext;
+ 					tz^.tnext := ty
+ 				     end;
+ 				ty := ty^.tidl;
+ 				(* create a loop initializing tq *)
+ 				tz := mknode(nindex);
+ 				tz^.tvariable := ti;
+ 				tz^.toffset := ty;
+ 				tz := fileinit(tz, tq^.taelem, opn);
+ 				tx := mknode(nfor);
+ 				tx^.tforid := ty;
+ 				ty := typeof(tq^.taindx);
+ 				if ty^.tt = nsubrange then
+ 				    begin
+ 					tx^.tfrom := ty^.tlo;
+ 
+ 					tx^.tto := ty^.thi
+ 				    end
+ 				else if ty^.tt = nscalar then
+ 				    begin
+ 					ty := ty^.tscalid;
+ 					tx^.tfrom := ty;
+ 					while ty^.tnext <> nil do
+ 						ty := ty^.tnext;
+ 					tx^.tto := ty
+ 				    end
+ 				else if ty = typnods[tchar] then
+ 				    begin
+ 					currsym.st := schar;
+ 					currsym.vchr := chr(minchar);
+ 					tx^.tfrom := mklit;
+ 					currsym.st := schar;
+ 					currsym.vchr := chr(maxchar);
+ 					tx^.tto := mklit
+ 				    end
+ 				else if ty = typnods[tinteger] then
+ 				    begin
+ 					currsym.st := sinteger;
+ 					currsym.vint := -maxint;
+ 					tx^.tfrom := mklit;
+ 					currsym.st := sinteger;
+ 					currsym.vint := maxint;
+ 					tx^.tto := mklit
+ 				    end
+ 				else
+ 					fatal(etree);
+ 				tx^.tforstmt := tz;
+ 				tx^.tincr := true
+ 			    end;
+ 			  npredef,
+ 			  nfileof:
+ 				if opn then
+ 				    begin
+ 					(* create file-struct initialization *)
+ 					ty := mknode(nselect);
+ 					ty^.trecord := ti;
+ 					ty^.tfield :=
+ 						oldid(defnams[dzinit]^.lid,
+ 								lforward);
+ 					tx := mknode(nassign);
+ 					tx^.tlhs := ty;
+ 					currsym.st := sinteger;
+ 					currsym.vint := 0;
+ 					tx^.trhs := mklit
+ 				    end
+ 				else begin
+ 					(* create file-struct wrapup *)
+ 					tx := mknode(ncall);
+ 					tx^.tcall := 
+ 						oldid(defnams[dclose]^.lid,
+ 								lidentifier);
+ 					tx^.taparm := ti
+ 				     end;
+ 			  nrecord:
+ 			    begin
+ 				ty := nil;
+ 				tq := tq^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(typeof(tq^.tbind)) then
+ 					    begin
+ 						tz := tq^.tidl;
+ 						while tz <> nil do
+ 						    begin
+ 							tx := mknode(nselect);
+ 							tx^.trecord := ti;
+ 							tx^.tfield := tz;
+ 							tx := fileinit(tx,
+ 							    typeof(tq^.tbind),
+ 								opn);
+ 							tx^.tnext := ty;
+ 							ty := tx;
+ 							tz := tz^.tnext
+ 						    end
+ 					    end;
+ 					tq := tq^.tnext
+ 				    end;
+ 				tx := mknode(nbegin);
+ 				tx^.tbegin := ty
+ 			    end;
+ 			end;(* case *)
+ 			fileinit := tx
+ 		end;
+ 
+ 	begin	(* initcode *)
+ 		while tp <> nil do
+ 		    begin
+ 			initcode(tp^.tsubsub);
+ 			tv := tp^.tsubvar;
+ 			while tv <> nil do
+ 			    begin
+ 				tq := typeof(tv^.tbind);
+ 				if filevar(tq) then
+ 				    begin
+ 					ti := tv^.tidl;
+ 					while ti <> nil do
+ 					    begin
+ 						tu := fileinit(ti, tq, true);
+ 						linkup(tp, tu);
+ 						tu^.tnext := tp^.tsubstmt;
+ 						tp^.tsubstmt := tu;
+ 						while tu^.tnext <> nil do
+ 							tu := tu^.tnext;
+ 						tu^.tnext := fileinit(ti, tq,
+ 									false);
+ 						linkup(tp, tu^.tnext);
+ 						ti := ti^.tnext
+ 					    end
+ 				    end;
+ 				tv := tv^.tnext;
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* initcode *)
+ 
+ begin	(* transform *)
+ 	renamc;
+ 	renamp(top^.tsubsub, false);
+ 	extract(top);
+ 	renamf(top);
+ 	initcode(top^.tsubsub);
+ 	global(top, top, false)
+ end;	(* transform *)
+ 
+ (*	Emit C-code for program or module.				*)
+ procedure emit;
+ 
+ const	include	= '# include ';
+ 	define	= '# define ';
+ 	ifdef	= '# ifdef ';
+ 	ifndef	= '# ifndef ';
+ 	elsif	= '# else';
+ 	endif	= '# endif';
+ 	static	= 'static ';
+ 	xtern	= 'extern ';
+ 	typdef	= 'typedef ';
+ 	registr	= 'register ';
+ 	usigned	= 'unsigned ';
+ 	indstep	= 8;
+ 
+ var	conflag,
+ 	setused,
+ 	dropset,
+ 	donearr	: boolean;
+ 	doarrow,
+ 	indnt	: integer;
+ 
+ 	procedure increment;
+ 	begin
+ 		indnt := indnt + indstep
+ 	end;
+ 
+ 	procedure decrement;
+ 	begin
+ 		indnt := indnt - indstep
+ 	end;
+ 
+ 	(*	Write tabs/blanks to properly (?) indent C-code.	*) 
+ 	procedure indent;
+ 
+ 	var	i	: integer;
+ 
+ 	begin
+ 		i := indnt;
+ 		(* limit indent to an integral number of tabs *)
+ 		if i > 60 then
+ 			i := i div tabwidth * tabwidth;
+ 		while i >= tabwidth do
+ 		    begin
+ 			write(tab1);
+ 			i := i - tabwidth
+ 		    end;
+ 		while i > 0 do
+ 		    begin
+ 			write(space);
+ 			i := i - 1
+ 		    end;
+ 	end;
+ 
+ 	(*	Determine if tp must be cast to an integer before being	*)
+ 	(*	used in an arithmetic expression.			*)
+ 	function arithexpr(tp : treeptr) : boolean;
+ 
+ 	begin
+ 		tp := typeof(tp);
+ 		if tp^.tt = nsubrange then
+ 			if tp^.tup^.tt = nconfarr then
+ 				tp := typeof(tp^.tup^.tindtyp)
+ 			else
+ 				tp := typeof(tp^.tlo);
+ 		arithexpr := (tp = typnods[tinteger]) or
+ 				(tp = typnods[tchar]) or
+ 					(tp = typnods[treal])
+ 	end;
+ 
+ 	procedure eexpr(tp : treeptr);				forward;
+ 	procedure etypedef(tp : treeptr);			forward;
+ 
+ 	(*	Emit code to select a record member.	*)
+ 	procedure eselect(tp : treeptr);
+ 
+ 	begin
+ 		doarrow := doarrow + 1;
+ 		eexpr(tp);
+ 		doarrow := doarrow - 1;
+ 		if donearr then
+ 			donearr := false
+ 		else
+ 			write('.')
+ 	end;
+ 
+ 	(*	Emit code for call to a predefined function/procedure.	*)
+ 	procedure epredef(ts, tp : treeptr);
+ 
+ 	label	444, 555;
+ 
+ 	var	tq,
+ 		tv, tx	: treeptr;
+ 		td	: predefs;
+ 		nelems	: integer;
+ 		ch	: char;
+ 		txtfile	: boolean;
+ 
+ 		(*	Determine a format-code for fprintf.		*)
+ 		(*	Update nelems as a sideeffect.			*)
+ 		function typeletter(tp : treeptr) : char;
+ 
+ 		label	999;
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			tq := tp;
+ 			if tq^.tt = nformat then
+ 			    begin
+ 				if tq^.texpl^.tt = nformat then
+ 				    begin
+ 					typeletter := 'f';
+ 					goto 999
+ 				    end;
+ 				tq := tp^.texpl
+ 			    end;
+ 			tq := typeof(tq);
+ 			if tq^.tt = nsubrange then
+ 				tq := typeof(tq^.tlo);
+ 			if tq = typnods[tstring] then
+ 				typeletter := 's'
+ 			else if tq = typnods[tinteger] then
+ 				typeletter := 'd'
+ 			else if tq = typnods[tchar] then
+ 				typeletter := 'c'
+ 			else if tq = typnods[treal] then
+ 				if tp^.tt = nformat then
+ 					typeletter := 'e'
+ 				else
+ 					typeletter := 'g'
+ 			else if tq = typnods[tboolean] then
+ 			    begin
+ 				typeletter := 'b';
+ 				nelems := 6
+ 			    end
+ 			else if tq^.tt = narray then
+ 			    begin
+ 				typeletter := 'a';
+ 				nelems := crange(tq^.taindx)
+ 			    end
+ 			else if tq^.tt = nconfarr then
+ 			    begin
+ 				typeletter := 'v';
+ 				nelems := 0
+ 			    end
+ 			else
+ 				fatal(etree);
+ 		999:
+ 		end;	(* typeletter *)
+ 
+ 		procedure etxt(tp : treeptr);
+ 
+ 		var	w	: toknbuf;
+ 			c	: char;
+ 			i	: toknidx;
+ 
+ 		begin
+ 			case tp^.tt of
+ 			  nid:
+ 			    begin
+ 				tp := idup(tp);
+ 				if tp^.tt = nconst then
+ 					etxt(tp^.tbind)
+ 				else
+ 					fatal(etree)
+ 			    end;
+ 			  nstring:
+ 			    begin
+ 				(* printf format string *)
+ 				gettokn(tp^.tsym^.lstr, w);
+ 				i := 1;
+ 				while w[i] <> chr(null) do
+ 				    begin
+ 					c := w[i];
+ 					if (c = cite) or (c = bslash) then
+ 						write(bslash)
+ 					else if c = percent then
+ 						write(percent);
+ 					write(c);
+ 					i := i + 1
+ 				    end
+ 			    end;
+ 			  nchar:
+ 			    begin
+ 				(* single character in printf format *)
+ 				c := tp^.tsym^.lchar;
+ 				if (c = cite) or (c = bslash) then
+ 					write(bslash)
+ 				else if c = percent then
+ 					write(percent);
+ 				write(c)
+ 			    end;
+ 			end;(* case *)
+ 		end;	(* etxt *)
+ 
+ 		(*	Emit format for fprintf.			*)
+ 		procedure eformat(tq : treeptr);
+ 
+ 		var	tx	: treeptr;
+ 			i	: integer;
+ 
+ 		begin
+ 			case typeletter(tq) of
+ 			  'a':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*');
+ 				write('.', nelems:1, 's')
+ 			    end;
+ 			  'b':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*')
+ 				    end;
+ 				write('s')
+ 			    end;
+ 			  'c':
+ 				if tq^.tt = nchar then
+ 					etxt(tq)
+ 				else begin
+ 					write(percent);
+ 					if tq^.tt = nformat then
+ 						if tq^.texpr^.tt = ninteger then
+ 							eexpr(tq^.texpr)
+ 						else
+ 							write('*');
+ 					write('c')
+ 				     end;
+ 			  'd':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*')
+ 				    end
+ 				else
+ 					write(intlen:1);
+ 				write('d')
+ 			    end;
+ 			  'e':
+ 			    begin
+ 				write(percent, space);
+ 				tx := tq^.texpr;
+ 				if tx^.tt = ninteger then
+ 				    begin
+ 					i := cvalof(tx);
+ 					write(i:1, '.');
+ 					i := i - 7;
+ 					if i < 1 then
+ 						write('1')
+ 					else
+ 						write(i:1)
+ 				    end
+ 				else
+ 					write('*.*');
+ 				write('e')
+ 			    end;
+ 			  'f':
+ 			    begin
+ 				write(percent);
+ 				tx := tq^.texpl;
+ 				if tx^.texpr^.tt = ninteger then
+ 				    begin
+ 					eexpr(tx^.texpr);
+ 					write('.');
+ 					tx := tq^.texpr;
+ 					if tx^.tt = ninteger then
+ 					    begin
+ 						i := cvalof(tx);
+ 						tx := tq^.texpl^.texpr;
+ 						if i > cvalof(tx) - 1 then
+ 							write('1')
+ 						else
+ 							write(i:1)
+ 					    end
+ 					else
+ 						write('*');
+ 				    end
+ 				else
+ 					write('*.*');
+ 				write('f')
+ 			    end;
+ 			  'g':
+ 				write(percent, fixlen:1, 'e');
+ 			  's':
+ 				if tq^.tt = nstring then
+ 					etxt(tq)
+ 				else begin
+ 					write(percent);
+ 					if tq^.tt = nformat then
+ 						if tq^.texpr^.tt = ninteger then
+ 							eexpr(tq^.texpr)
+ 						else
+ 							write('*.*');
+ 					write('s')
+ 				     end
+ 			end (* case *)
+ 		end;	(* eformat *)
+ 
+ 		(*	Emit parameters to fprintf except format.	*)
+ 		procedure ewrite(tq : treeptr);
+ 
+ 		var	tx	: treeptr;
+ 
+ 		begin
+ 			case typeletter(tq) of
+ 			  'a':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 					      eexpr(tq^.texpr);
+ 					      write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				eexpr(tx);
+ 				write('.A')
+ 			    end;
+ 			  'b':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 					      eexpr(tq^.texpr);
+ 					      write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				usebool := true;
+ 				write('Bools[(int)(');
+ 				eexpr(tx);
+ 				write(')]')
+ 			    end;
+ 			  'c':
+ 			    begin
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq^.texpr)
+ 					    end;
+ 					write(', ');
+ 					eexpr(tq^.texpl)
+ 				    end
+ 				else if tq^.tt <> nchar then
+ 				    begin
+ 					write(', ');
+ 					eexpr(tq)
+ 				    end
+ 			    end;
+ 			  'd':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 						eexpr(tq^.texpr);
+ 						write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				eexpr(tx)
+ 			    end;
+ 			  'e':
+ 			    begin
+ 				write(', ');
+ 				tx := tq^.texpr;
+ 				if tx^.tt <> ninteger then
+ 				    begin
+ 					usemax := true;
+ 					eexpr(tx);
+ 					write(', Max(');
+ 					eexpr(tx);
+ 					write(' - 7, 1), ')
+ 				    end;
+ 				eexpr(tq^.texpl)
+ 			    end;
+ 			  'f':
+ 			    begin
+ 				write(', ');
+ 				tx := tq^.texpl;
+ 				if tx^.texpr^.tt <> ninteger then
+ 				    begin
+ 					eexpr(tx^.texpr);
+ 					write(', ')
+ 				    end;
+ 				if (tx^.texpr^.tt <> ninteger) or
+ 					(tq^.texpr^.tt <> ninteger) then
+ 				    begin
+ 					usemax := true;
+ 					write('Max((');
+ 					eexpr(tx^.texpr);
+ 					write(') - (');
+ 					eexpr(tq^.texpr);
+ 					write(') - 1, 1), ')
+ 				    end;
+ 				eexpr(tq^.texpl^.texpl)
+ 			    end;
+ 			  'g':
+ 			    begin
+ 				write(', ');
+ 				eexpr(tq)
+ 			    end;
+ 			  's':
+ 			    begin
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					   begin
+ 						write(', ');
+ 						eexpr(tq^.texpr);
+ 						write(', ');
+ 						eexpr(tq^.texpr)
+ 					   end;
+ 					write(', ');
+ 					eexpr(tq^.texpl)
+ 				    end
+ 				else if tq^.tt <> nstring then
+ 				    begin
+ 					write(', ');
+ 					eexpr(tq)
+ 				    end
+ 			    end
+ 			end (* case *)
+ 		end;	(* ewrite *)
+ 
+ 		(*	Emit size of *tp for call to malloc. CPU	*)
+ 		(*	There is no safe way to compute the size of a	*)
+ 		(*	particular variant of a C-union, we assume that	*)
+ 		(*	the size can be computed by taking the address	*)
+ 		(*	of the first member and subracting the address	*)
+ 		(*	of the record and then adding the size of the	*)
+ 		(*	variant containing the record.			*)
+ 		procedure enewsize(tp : treeptr);
+ 
+ 		label	555;
+ 
+ 		var	tq, tx, ty	: treeptr;
+ 			v		: integer;
+ 
+ 			(*	Emit size of union member tq.		*)
+ 			procedure esubsize(tp, tq : treeptr);
+ 
+ 			label	555, 666;
+ 
+ 			var	tx, ty	: treeptr;
+ 				addsize	: boolean;
+ 
+ 			begin
+ 				tx := tq^.tvrnt;
+ 				ty := tx^.tflist;
+ 				if ty = nil then
+ 				    begin
+ 					ty := tx^.tvlist;
+ 					while ty <> nil do
+ 					    begin
+ 						if ty^.tvrnt^.tflist <> nil then
+ 						    begin
+ 							ty := ty^.tvrnt^.tflist;
+ 							goto 555
+ 						    end;
+ 						ty := ty^.tnext
+ 					    end;
+ 				555:
+ 				    end;
+ 				addsize := true;
+ 				if ty = nil then
+ 				    begin
+ 					(* empty variant, try using another *)
+ 					addsize := false;
+ 					ty := tx^.tup^.tup^.tvlist;
+ 					while ty <> nil do
+ 					    begin
+ 						if ty^.tvrnt^.tflist <> nil then
+ 						    begin
+ 							ty := ty^.tvrnt^.tflist;
+ 							goto 666
+ 						    end;
+ 						ty := ty^.tnext
+ 					    end;
+ 				666:
+ 				    end;
+ 				if ty = nil then
+ 				    begin
+ 					(* its getting too complicated,
+ 						ignore tag value *)
+ 					write('sizeof(*');
+ 					eexpr(tp);
+ 					write(')')
+ 				    end
+ 				else begin
+ 					(* compute offset to first member of
+ 					   the selected union variant *)
+ 					write('Unionoffs(');
+ 					eexpr(tp);
+ 					write(', ');
+ 					printid(ty^.tidl^.tsym^.lid);
+ 					if addsize then
+ 					    begin
+ 						(* add the size of the selected
+ 						   union variant *)
+ 						write(') + sizeof(');
+ 						eexpr(tp);
+ 						write('->');
+ 						printid(tx^.tuid)
+ 					    end;
+ 					write(')')
+ 				     end
+ 			end;
+ 
+ 		begin	(* newsize *)
+ 			if (tp^.tnext <> nil) and unionnew then
+ 			    begin
+ 				(* tnext points to a tag-value, evaluate it *)
+ 				v := cvalof(tp^.tnext);
+ 				(* find union type *)
+ 				tq := typeof(tp);
+ 				tq := typeof(tq^.tptrid);
+ 				if tq^.tt <> nrecord then
+ 					fatal(etree);
+ 				(* find corresponding variant *)
+ 				tx := tq^.tvlist;
+ 				while tx <> nil do
+ 				    begin
+ 					ty := tx^.tselct;
+ 					while ty <> nil do
+ 					    begin
+ 						if v = cvalof(ty) then
+ 							goto 555;
+ 						ty := ty^.tnext
+ 					    end;
+ 					tx := tx^.tnext
+ 				    end;
+ 				fatal(etag);
+ 			555:
+ 				(* emit size for that variant *)
+ 				esubsize(tp, tx)
+ 			    end
+ 			else begin
+ 				write('sizeof(*');
+ 				eexpr(tp);
+ 				write(')')
+ 			     end
+ 		end;	(* newsize *)
+ 
+ 	begin	(* epredef *)
+ 		td := ts^.tsubstmt^.tdef;
+ 		case td of
+ 		  dabs:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
+ 				write('abs(')			(* LIB *)
+ 			else
+ 				write('fabs(');			(* LIB *)
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dargv:
+ 		    begin
+ 			write('Argvgt(');
+ 			eexpr(tp^.taparm);
+ 			write(', ');
+ 			eexpr(tp^.taparm^.tnext);
+ 			write('.A, sizeof(');
+ 			eexpr(tp^.taparm^.tnext);
+ 			writeln('.A));')
+ 		    end;
+ 		  dchr:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if tq^.tt = nsubrange then
+ 				if tq^.tup^.tt = nconfarr then
+ 					tq := typeof(tq^.tup^.tindtyp)
+ 				else
+ 					tq := typeof(tq^.tlo);
+ 			if (tq = typnods[tinteger]) or
+ 						(tq = typnods[tchar]) then
+ 				eexpr(tp^.taparm)
+ 			else begin
+ 				write('(char)(');
+ 				eexpr(tp^.taparm);
+ 				write(')')
+ 			     end
+ 		    end;
+ 		  ddispose:
+ 		    begin
+ 			write('free(');				(* LIB *)
+ 			eexpr(tp^.taparm);
+ 			writeln(');')
+ 		    end;
+ 		  deof:
+ 		    begin
+ 			write('Eof(');
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[dinput]^.lused := true;
+ 				printid(defnams[dinput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  deoln:
+ 		    begin
+ 			write('Eoln(');
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[dinput]^.lused := true;
+ 				printid(defnams[dinput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			write(')');
+ 		    end;
+ 		  dexit:
+ 		    begin
+ 			write('exit(');				(* OS *)
+ 			if tp^.taparm = nil then
+ 				write('0')
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dflush:
+ 		    begin
+ 			write('fflush(');			(* LIB *)
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[doutput]^.lused := true;
+ 				printid(defnams[doutput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln('.fp);')
+ 		    end;
+ 		  dpage:
+ 		    begin
+ 			(* write form-feed character *)
+ 			write('Putchr(', ffchr, ', '); (* CHAR *)
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[doutput]^.lused := true;
+ 				printid(defnams[doutput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dput,
+ 		  dget:
+ 		    begin
+ 			if typeof(tp^.taparm) = typnods[ttext] then
+ 				if td = dget then
+ 					write('Getx')
+ 				else
+ 					write('Putx')
+ 			else begin
+ 				write(voidcast);
+ 				if td = dget then
+ 					write('Get')
+ 				else
+ 					write('Put')
+ 			     end;
+ 			write('(');
+ 			eexpr(tp^.taparm);
+ 			writeln(');')
+ 		    end;
+ 		  dhalt:
+ 			writeln('abort();');			(* OS *)
+ 		  dnew:
+ 		    begin
+ 			eexpr(tp^.taparm);
+ 			write(' = (');
+ 			etypedef(typeof(tp^.taparm));
+ 			write(')malloc((unsigned)(');	(* LIB *)
+ 			enewsize(tp^.taparm);
+ 			writeln('));')
+ 		    end;
+ 		  dord:
+ 		    begin
+ 			write('(unsigned)(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dread,
+ 		  dreadln:
+ 		    begin
+ 			txtfile := false;
+ 			tq := tp^.taparm;
+ 			if tq <> nil then
+ 			    begin
+ 				tv := typeof(tq);
+ 				if tv = typnods[ttext] then
+ 				    begin
+ 					(* reading from textfile *)
+ 					txtfile := true;
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else if tv^.tt = nfileof then
+ 				    begin
+ 					(* reading from other file *)
+ 					txtfile := typeof(tv^.tof) =
+ 							typnods[tchar];
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else begin
+ 					(* reading from std-input *)
+ 					txtfile := true;
+ 					tv := nil
+ 				     end
+ 			    end
+ 			else begin
+ 				tv := nil;
+ 				txtfile := true
+ 			     end;
+ 			if txtfile then
+ 			    begin
+ 				(* check for special case *)
+ 				if tq = nil then
+ 					goto 444;
+ 				if (tq^.tt <> nformat) and
+ 						(tq^.tnext = nil) and
+ 						(typeletter(tq) = 'c') then
+ 				    begin
+ 					(* read single char *)
+ 					eexpr(tq);
+ 					write(' = ');
+ 					write('Getchr(');
+ 					if tv = nil then
+ 						printid(defnams[dinput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write(')');
+ 					if td = dreadln then
+ 						write(',');
+ 					goto 444
+ 				    end;
+ 				usescan := true;
+ 				write('Fscan(');
+ 				if tv = nil then
+ 					printid(defnams[dinput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				write('), ');
+ 				(* first pass, emit format string *)
+ 				while tq <> nil do
+ 				    begin
+ 					write('Scan(', cite);
+ 					ch := typeletter(tq);
+ 					case ch of
+ 					  'a':
+ 						write(percent, 's');
+ 					  'c':
+ 						write(percent, 'c');
+ 					  'd':
+ 						write(percent, 'ld');
+ 					  'g':
+ 						write(percent, 'le')
+ 					end;(* case *)
+ 					write(cite, ', ');
+ 					case ch of
+ 					  'a':
+ 					    begin
+ 						eexpr(tq);
+ 						write('.A')
+ 					    end;
+ 					  'c':
+ 					    begin
+ 						write('&');
+ 						eexpr(tq)
+ 					    end;
+ 					  'd':
+ 						write('&Tmplng');
+ 					  'g':
+ 						write('&Tmpdbl')
+ 					end;(* case *)
+ 					write(')');
+ 					case ch of
+ 					  'd':
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq);
+ 						write(' = Tmplng')
+ 					    end;
+ 					  'g':
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq);
+ 						write(' = Tmpdbl')
+ 					    end;
+ 					  'a',
+ 					  'c':
+ 						(* no op *)
+ 					end;(* case *)
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						write(tab1)
+ 					    end
+ 				    end;
+ 				write(', Getx(');
+ 				if tv = nil then
+ 					printid(defnams[dinput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				write(')');
+ 				if td = dreadln then
+ 					write(',');
+ 			444:
+ 				if td = dreadln then
+ 				    begin
+ 					usegetl := true;
+ 					write('Getl(&');
+ 					if tv = nil then
+ 						printid(defnams[dinput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write(')')
+ 				    end
+ 			    end
+ 			else begin
+ 				increment;
+ 				while tq <> nil do
+ 				    begin
+ 					write(voidcast, 'Fread(');
+ 					eexpr(tq);
+ 					write(', ');
+ 					eexpr(tv);
+ 					write('.fp)');
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				decrement
+ 			     end;
+ 			writeln(';')
+ 		    end;
+ 		  dwrite,
+ 		  dwriteln,
+ 		  dmessage:
+ 		    begin
+ 			txtfile := false;
+ 			tq := tp^.taparm;
+ 			if tq <> nil then
+ 			    begin
+ 				tv := typeof(tq);
+ 				if tv = typnods[ttext] then
+ 				    begin
+ 					(* writing to textfile *)
+ 					txtfile := true;
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else if tv^.tt = nfileof then
+ 				    begin
+ 					(* writing to other file *)
+ 					txtfile := typeof(tv^.tof) =
+ 							typnods[tchar];
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else begin
+ 					(* writing to std-output *)
+ 					txtfile := true;
+ 					tv := nil
+ 				     end
+ 			    end
+ 			else begin
+ 				tv := nil;
+ 				txtfile := true
+ 			     end;
+ 			if txtfile then
+ 			    begin
+ 				(* check for special case *)
+ 				if tq = nil then
+ 				    begin
+ 					(* writeln whithout parameters *)
+ 					if td in [dwriteln, dmessage] then
+ 					    begin
+ 						write('Putchr(', nlchr, ', ');
+ 						if tv = nil then
+ 							printid(
+ 							  defnams[doutput]^.lid)
+ 						else
+ 							eexpr(tv);
+ 						write(')')
+ 					    end;
+ 					writeln(';');
+ 					goto 555
+ 				    end
+ 				else if (tq^.tt <> nformat) and
+ 						(tq^.tnext = nil) then
+ 					if typeletter(tq) = 'c' then
+ 					    begin
+ 						(* print single char *)
+ 						write('Putchr(');
+ 						eexpr(tq);
+ 						write(', ');
+ 						if tv = nil then
+ 							printid(
+ 							  defnams[doutput]^.lid)
+ 						else
+ 							eexpr(tv);
+ 						write(')');
+ 						if td = dwriteln then
+ 						    begin
+ 							write(',Putchr(',
+ 							    nlchr, ', ');
+ 							if tv = nil then
+ 							 printid(
+ 							  defnams[doutput]^.lid)
+ 							else
+ 								eexpr(tv);
+ 							write(')');
+ 						    end;
+ 						writeln(';');
+ 						goto 555
+ 					    end;
+ 				tx := nil;
+ 				write(voidcast, 'fprintf(');	(* LIB *)
+ 				if td = dmessage then
+ 					write('stderr, ')
+ 				else begin
+ 					if tv = nil then
+ 						printid(defnams[doutput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write('.fp, ')
+ 				     end;
+ 				write(cite);
+ 				tx := tq;	(* remember 1:st parm *)
+ 				(* first pass, emit format string *)
+ 				while tq <> nil do
+ 				    begin
+ 					eformat(tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				if (td = dmessage) or (td = dwriteln) then
+ 					write('\n');
+ 				write(cite);
+ 				(* second pass, add parameters *)
+ 				tq := tx;
+ 				while tq <> nil do
+ 				    begin
+ 					ewrite(tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				write('), Putl(');
+ 				if tv = nil then
+ 					printid(defnams[doutput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				if td = dwrite then
+ 					write(', 0)')
+ 				else
+ 					write(', 1)')
+ 			    end
+ 			else begin
+ 				increment;
+ 				tx := typeof(tv);
+ 				if tx = typnods[ttext] then
+ 					tx := typnods[tchar]
+ 				else if tx^.tt = nfileof then
+ 					tx := typeof(tx^.tof)
+ 				else
+ 					fatal(etree);
+ 				while tq <> nil do
+ 				    begin
+ 					if (tq^.tt in [nid, nindex, nselect,
+ 							nderef]) and
+ 						(tx = typeof(tq)) then
+ 					    begin
+ 						write(voidcast, 'Fwrite(');
+ 						eexpr(tq)
+ 					    end
+ 					else begin
+ 						if tx^.tt = nsetof then
+ 						    begin
+ 							usescpy := true;
+ 							write('Setncpy(');
+ 							eselect(tv);
+ 							write('buf.S, ');
+ 							eexpr(tq);
+ 							if typeof(tp^.trhs) =
+ 							   typnods[tset] then
+ 								eexpr(tq)
+ 							else begin
+ 								eselect(tq);
+ 								write('S')
+ 							     end;
+ 							write(', sizeof(');
+ 							eexpr(tv);
+ 							write('.buf))');
+ 						    end
+ 						else begin
+ 							eexpr(tv);
+ 							write('.buf = ');
+ 							eexpr(tq)
+ 						     end;
+ 						write(', Fwrite(');
+ 						eexpr(tv);
+ 						write('.buf');
+ 					     end;
+ 					write(', ');
+ 					eexpr(tv);
+ 					write('.fp)');
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				decrement
+ 			     end;
+ 			writeln(';');
+ 		555:
+ 		    end;
+ 		  dclose:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			txtfile := tq = typnods[ttext];
+ 			if (not txtfile) and (tq^.tt = nfileof) then
+ 				if typeof(tq^.tof) = typnods[tchar] then
+ 					txtfile := true;
+ 			if txtfile then
+ 				write('Closex(')
+ 			else
+ 				write('Close(');
+ 			eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dreset,
+ 		  drewrite:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			txtfile := tq = typnods[ttext];
+ 			if (not txtfile) and (tq^.tt = nfileof) then
+ 				if typeof(tq^.tof) = typnods[tchar] then
+ 					txtfile := true;
+ 			if txtfile then
+ 				if td = dreset then
+ 					write('Resetx(')
+ 				else
+ 					write('Rewritex(')
+ 			else
+ 				if td = dreset then
+ 					write('Reset(')
+ 				else
+ 					write('Rewrite(');
+ 			eexpr(tp^.taparm);
+ 			write(', ');
+ 			tq := tp^.taparm^.tnext;
+ 			if tq = nil then
+ 				write('NULL')
+ 			else begin
+ 				tq := typeof(tq);
+ 				if tq = typnods[tchar] then
+ 				    begin
+ 					write(cite);
+ 					ch := chr(cvalof(tp^.taparm^.tnext));
+ 					if (ch = bslash) or (ch = cite) then
+ 						write(bslash);
+ 					write(ch, cite)
+ 				    end
+ 				else if tq = typnods[tstring] then
+ 					eexpr(tp^.taparm^.tnext)
+ 				else  if tq^.tt in [narray, nconfarr] then
+ 				     begin
+ 					eexpr(tp^.taparm^.tnext);
+ 					write('.A')
+ 				     end
+ 				else
+ 					fatal(etree)
+ 			     end;
+ 			writeln(');')
+ 		    end;
+ 		  darctan:
+ 		    begin
+ 			write('atan(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dln:
+ 		    begin
+ 			write('log(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dexp:
+ 		    begin
+ 			write('exp(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dcos,
+ 		  dsin,
+ 		  dsqrt:
+ 		    begin
+ 			eexpr(tp^.tcall);	(* LIB *)
+ 			write('(');
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dtan:
+ 		    begin
+ 			write('atan(');		(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dsucc,
+ 		  dpred:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if tq^.tt = nsubrange then
+ 				if tq^.tup^.tt = nconfarr then
+ 					tq := typeof(tq^.tup^.tindtyp)
+ 				else
+ 					tq := typeof(tq^.tlo);
+ 			if (tq = typnods[tinteger]) or
+ 						(tq = typnods[tchar]) then
+ 			    begin
+ 				write('((');
+ 				eexpr(tp^.taparm);
+ 				if td = dpred then
+ 					write(')-1)')
+ 				else
+ 					write(')+1)')
+ 			    end
+ 			else begin
+ 				(* some sort of scalar type, casting needed *)
+ 				write('(');
+ 				tq := tq^.tup;
+ 				if tq^.tt = ntype then
+ 				    begin
+ 					(* cast only if it is a named type *)
+ 					write('(');
+ 					printid(tq^.tidl^.tsym^.lid);
+ 					write(')')
+ 				    end;
+ 				write('((int)(');
+ 				eexpr(tp^.taparm);
+ 				if td = dpred then
+ 					write(')-1))')
+ 				else
+ 					write(')+1))')
+ 			     end
+ 		    end;
+ 		  dodd:
+ 		    begin
+ 			write('(');
+ 			printid(defnams[dboolean]^.lid);
+ 			write(')((');
+ 			eexpr(tp^.taparm);
+ 			write(') & 1)')
+ 		    end;
+ 		  dsqr:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
+ 			    begin
+ 				write('((');
+ 				eexpr(tp^.taparm);
+ 				write(') * (');
+ 				eexpr(tp^.taparm);
+ 				write('))')
+ 			    end
+ 			else begin
+ 				write('pow(');	(* LIB *)
+ 				if typeof(tp^.taparm) <> typnods[treal] then
+ 					write(dblcast);
+ 				eexpr(tp^.taparm);
+ 				write(', 2.0)')
+ 			     end
+ 		    end;
+ 		  dround:
+ 		    begin
+ 			write('Round(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dtrunc:
+ 		    begin
+ 			write('Trunc(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dpack:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			tx := typeof(tp^.taparm^.tnext^.tnext);
+ 			write('{    ', registr, inttyp, tab1, '_j, _i = ');
+ 			if not arithexpr(tp^.taparm^.tnext) then
+ 				write('(int)');
+ 			eexpr(tp^.taparm^.tnext);
+ 			if tx^.tt = narray then
+ 				write(' - ', clower(tq^.taindx):1);
+ 			writeln(';');
+ 			indent;
+ 			write('    for (_j = 0; _j < ');
+ 			if tq^.tt = nconfarr then
+ 			    begin
+ 				write('(int)(');
+ 				printid(tx^.tcindx^.thi^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				write(crange(tx^.taindx):1);
+ 			writeln('; )');
+ 			indent;
+ 			write(tab1);
+ 			eexpr(tp^.taparm^.tnext^.tnext);
+ 			write('.A[_j++] = ');
+ 			eexpr(tp^.taparm);
+ 			writeln('.A[_i++];');
+ 			indent;
+ 			writeln('}')
+ 		    end;
+ 		  dunpack:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			tx := typeof(tp^.taparm^.tnext);
+ 			write('{   ', registr, inttyp, tab1, '_j, _i = ');
+ 			if not arithexpr(tp^.taparm^.tnext^.tnext) then
+ 				write('(int)');
+ 			eexpr(tp^.taparm^.tnext^.tnext);
+ 			if tx^.tt <> nconfarr then
+ 				write(' - ', clower(tx^.taindx):1);
+ 			writeln(';');
+ 			indent;
+ 			write('    for (_j = 0; _j < ');
+ 			if tq^.tt = nconfarr then
+ 			    begin
+ 				write('(int)(');
+ 				printid(tq^.tcindx^.thi^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				write(crange(tq^.taindx):1);
+ 			writeln('; )');
+ 			indent;
+ 			write(tab1);
+ 			eexpr(tp^.taparm^.tnext);
+ 			write('.A[_i++] = ');
+ 			eexpr(tp^.taparm);
+ 			writeln('.A[_j++];');
+ 			indent;
+ 			writeln('}')
+ 		    end;
+ 		end (* case *)
+ 	end;	(* epredef *)
+ 
+ 	procedure eaddr(tp : treeptr);
+ 
+ 	begin
+ 		write('&');
+ 		if not(tp^.tt in [nid, nselect, nindex, nderef]) then
+ 			error(evarpar);
+ 		eexpr(tp)
+ 	end;
+ 
+ 	(*	Emit code for a subroutine call.			*)
+ 	procedure ecall(tp : treeptr);
+ 
+ 	var	tf, tq, tx	: treeptr;
+ 
+ 	begin
+ 		(* find first formal parameter id *)
+ 		tf := idup(tp^.tcall);
+ 		case tf^.tt of
+ 		  nproc,
+ 		  nfunc:
+ 			tf := tf^.tsubpar;
+ 		  nparproc,
+ 		  nparfunc:
+ 			tf := tf^.tparparm
+ 		end;(* case *)
+ 		if tf <> nil then
+ 		    begin
+ 			case tf^.tt of
+ 			  nvalpar,
+ 			  nvarpar:
+ 				tf := tf^.tidl;
+ 			  nparproc,
+ 			  nparfunc:
+ 				tf := tf^.tparid
+ 			end (* case *)
+ 		    end;
+ 		(* emit called function name *)
+ 		eexpr(tp^.tcall);
+ 		write('(');
+ 		(* emit actual parameters *)
+ 		tq := tp^.taparm;
+ 		while tq <> nil do
+ 		    begin
+ 			if tf^.tup^.tt in [nparfunc, nparproc] then
+ 			    begin
+ 				(* single subroutine-nid converted to ncall *)
+ 				if tq^.tt = ncall then
+ 					printid(tq^.tcall^.tsym^.lid)
+ 				else
+ 					printid(tq^.tsym^.lid)
+ 			    end
+ 			else begin
+ 				tx := typeof(tq);
+ 				if tx = typnods[tboolean] then
+ 				    begin
+ 					tx := tq;
+ 					while tx^.tt = nuplus do
+ 						tx := tx^.texps;
+ 					if tx^.tt in [nin .. nor, nand, nnot]
+ 									then
+ 					    begin
+ 						write('(');
+ 						printid(defnams[dboolean]^.lid);
+ 						write(')(');
+ 						eexpr(tq);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tq);
+ 				    end
+ 				else if (tx = typnods[tstring]) or
+ 						(tx = typnods[tset]) then
+ 				    begin
+ 					(* cast literal to proper type *)
+ 					write('*((');
+ 					etypedef(tf^.tup^.tbind);
+ 					write(' *)');
+ 					if tx = typnods[tset] then
+ 					    begin
+ 						dropset := true;
+ 						eexpr(tq);
+ 						dropset := false
+ 					    end
+ 					else
+ 						eexpr(tq);
+ 					write(')')
+ 				    end
+ 				else if tx = typnods[tnil] then
+ 				    begin
+ 					write('(');
+ 					etypedef(tf^.tup^.tbind);
+ 					write(')NIL')
+ 				    end
+ 				else if tf^.tup^.tbind^.tt = nconfarr then
+ 				    begin
+ 					write('(struct ');
+ 					printid(tf^.tup^.tbind^.tcuid);
+ 					write(' *)&');
+ 					eexpr(tq);
+ 					(* add upper bound of actual value *)
+ 					if tq^.tnext = nil then
+ 						write(', ',
+ 							crange(tx^.taindx):1)
+ 				    end
+ 				else begin
+ 					if tf^.tup^.tt = nvarpar then
+ 						eaddr(tq)
+ 					else
+ 						eexpr(tq)
+ 				     end
+ 			    end;
+ 			tq := tq^.tnext;
+ 			if tq <> nil then
+ 			    begin
+ 				write(', ');
+ 				(* next formal parameter *)
+ 				if tf^.tnext = nil then
+ 				    begin
+ 					tf := tf^.tup^.tnext;
+ 					case tf^.tt of
+ 					  nvalpar,
+ 					  nvarpar:
+ 						tf := tf^.tidl;
+ 					  nparproc,
+ 					  nparfunc:
+ 						tf := tf^.tparid
+ 					end (* case *)
+ 				    end
+ 				else
+ 					tf := tf^.tnext;
+ 			    end;
+ 		    end;
+ 		write(')')
+ 	end;	(* ecall *)
+ 
+ 	(*	Emit code for a general expression.			*)
+ 	procedure eexpr;
+ 
+ 	label	999;
+ 
+ 	var	tq	: treeptr;
+ 		flag	: boolean;
+ 
+ 		function constset(tp : treeptr) : boolean;
+ 
+ 			function constxps(tp : treeptr) : boolean;
+ 			begin
+ 				case tp^.tt of
+ 				  nrange:
+ 					if constxps(tp^.texpr) then
+ 						constxps := constxps(tp^.texpl)
+ 					else
+ 						constxps := false;
+ 				  nempty,
+ 				  ninteger,
+ 				  nchar:
+ 					constxps := true;
+ 				  nid:
+ 				    begin
+ 					tp := idup(tp);
+ 					constxps := (tp^.tt = nconst)
+ 							or (tp^.tt = nscalar)
+ 				    end;
+ 				  nin, neq, nne, nlt, nle, ngt, nge, nor,
+ 				  nplus, nminus, nand, nmul, ndiv, nmod,
+ 				  nquot, nnot, numinus, nuplus, nset,	
+ 				  nindex, nselect, nderef, ncall,
+ 				  nreal, nstring, nnil:
+ 					constxps := false
+ 				end (* case *)
+ 			end;
+ 
+ 		begin
+ 			constset := true;
+ 			while tp <> nil do
+ 				if constxps(tp) then
+ 					tp := tp^.tnext
+ 				else begin
+ 					constset := false;
+ 					tp := nil
+ 				    end
+ 		end;
+ 
+ 	begin	(* eexpr *)
+ 		donearr := false;
+ 		if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then
+ 		    begin
+ 			tq := typeof(tp^.texpl);
+ 			if (tq^.tt in [nset, nsetof]) or
+ 						(tq = typnods[tset]) then
+ 			    begin
+ 				(* set operations *)
+ 				case tp^.tt of
+ 				  nplus:
+ 				    begin
+ 					setused := true;
+ 					useunion := true;
+ 					write('Union')
+ 				    end;
+ 				  nminus:
+ 				    begin
+ 					setused := true;
+ 					usediff := true;
+ 					write('Diff')
+ 				    end;
+ 				  nmul:
+ 				    begin
+ 					setused := true;
+ 					useintr := true;
+ 					write('Inter')
+ 				    end;
+ 				  neq:
+ 				    begin
+ 					useseq := true;
+ 					write('Eq')
+ 				    end;
+ 				  nne:
+ 				    begin
+ 					usesne := true;
+ 					write('Ne')
+ 				    end;
+ 				  nge:
+ 				    begin
+ 					usesge := true;
+ 					write('Ge')
+ 				    end;
+ 				  nle:
+ 				    begin
+ 					usesle := true;
+ 					write('Le')
+ 				    end
+ 				end;(* case *)
+ 				if tp^.tt in [nplus, nminus, nmul] then
+ 					dropset := false;
+ 				write('(');
+ 				eexpr(tp^.texpl);
+ 				if tq^.tt = nsetof then
+ 					write('.S');
+ 				write(', ');
+ 				eexpr(tp^.texpr);
+ 				tq := typeof(tp^.texpr);
+ 				if tq^.tt = nsetof then
+ 					write('.S');
+ 				write(')');
+ 				goto 999
+ 			    end
+ 		    end;
+ 		if tp^.tt in [neq, nne, ngt, nlt, nge, nle] then
+ 		    begin
+ 			tq := typeof(tp^.texpl);
+ 			if tq^.tt = nconfarr then
+ 				fatal(ecmpconf);
+ 			if (tq^.tt in [nstring, narray]) or
+ 						(tq = typnods[tstring]) then
+ 			    begin
+ 				write('Cmpstr(');
+ 				eexpr(tp^.texpl);
+ 				if tq^.tt = narray then
+ 					write('.A');
+ 				write(', ');
+ 				tq := typeof(tp^.texpr);
+ 				if tq^.tt = nconfarr then
+ 					fatal(ecmpconf);
+ 				eexpr(tp^.texpr);
+ 				if tq^.tt = narray then
+ 					write('.A');
+ 				write(')');
+ 				case tp^.tt of
+ 				  neq:
+ 					write(' == ');
+ 				  nne:
+ 					write(' != ');
+ 				  ngt:
+ 					write(' > ');
+ 				  nlt:
+ 					write(' < ');
+ 				  nge:
+ 					write(' >= ');
+ 				  nle:
+ 					write(' <= ');
+ 				end;(* case *)
+ 				write('0');
+ 				goto 999
+ 			    end
+ 		    end;
+ 		case tp^.tt of
+ 		  neq, nne, nlt, nle,
+ 		  ngt, nge, nor, nand, nplus, nminus,
+ 		  nmul, ndiv, nmod, nquot:
+ 		    begin
+ 			flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
+ 			if (tp^.tt in [nlt, nle, ngt, nge]) and
+ 					not arithexpr(tp^.texpl) then
+ 			    begin
+ 				write('(int)');
+ 				flag := true
+ 			    end;
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texpl);
+ 			if flag then
+ 				write(')');
+ 			case tp^.tt of
+ 			  neq:
+ 				write(' == ');
+ 			  nne:
+ 				write(' != ');
+ 			  nlt:
+ 				write(' < ');
+ 			  nle:
+ 				write(' <= ');
+ 			  ngt:
+ 				write(' > ');
+ 			  nge:
+ 				write(' >= ');
+ 			  nor:
+ 				write(' || ');
+ 			  nand:
+ 				write(' && ');
+ 			  nplus:
+ 				write(' + ');
+ 			  nminus:
+ 				write(' - ');
+ 			  nmul:
+ 				write(' * ');
+ 			  ndiv:
+ 				write(' / ');
+ 			  nmod:
+ 				write(' % ');
+ 			  nquot:
+ 			    begin
+ 				write(' / ((');
+ 				printid(defnams[dreal]^.lid);
+ 				write(')')
+ 			    end
+ 			end;(* case *)
+ 			flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
+ 			if (tp^.tt in [nlt, nle, ngt, nge]) and
+ 					not arithexpr(tp^.texpr) then
+ 			    begin
+ 				write('(int)');
+ 				flag := true
+ 			    end;
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texpr);
+ 			if flag then
+ 				write(')');
+ 			if tp^.tt = nquot then
+ 				write(')')
+ 		    end;
+ 
+ 		  nuplus, numinus, nnot:
+ 		    begin
+ 			case tp^.tt of
+ 			  numinus:
+ 				write('-');
+ 			  nnot:
+ 				write('!');
+ 			  nuplus:
+ 			end;(* case *)
+ 			flag := cprio[tp^.tt] >= cprio[tp^.texps^.tt];
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texps);
+ 			if flag then
+ 				write(')');
+ 		    end;
+ 		  
+ 		  nin:
+ 		    begin
+ 			usememb := true;
+ 			write('Member((unsigned)(');
+ 			eexpr(tp^.texpl);
+ 			write('), ');
+ 			dropset := true;	(* no need to save set-expr *)
+ 			eexpr(tp^.texpr);
+ 			dropset := false;
+ 			tq := typeof(tp^.texpr);
+ 			if tq^.tt = nsetof then
+ 				write('.S');
+ 			write(')')
+ 		    end;
+ 
+ 		  nassign:
+ 		    begin
+ 			tq := typeof(tp^.trhs);
+ 			if tq = typnods[tstring] then
+ 			    begin
+ 				write(voidcast, 'strncpy(');
+ 				eexpr(tp^.tlhs);
+ 				write('.A, ');
+ 				eexpr(tp^.trhs);
+ 				write(', sizeof(');
+ 				eexpr(tp^.tlhs);
+ 				write('.A))')
+ 			    end
+ 			else if tq = typnods[tboolean] then
+ 			    begin
+ 				eexpr(tp^.tlhs);
+ 				write(' = ');
+ 				tq := tp^.trhs;
+ 				while tq^.tt = nuplus do
+ 					tq := tq^.texps;
+ 				if tq^.tt in [nin .. nor, nand, nnot] then
+ 				    begin
+ 					write('(');
+ 					printid(defnams[dboolean]^.lid);
+ 					write(')(');
+ 					eexpr(tq);
+ 					write(')')
+ 				    end
+ 				else
+ 					eexpr(tq)
+ 			    end
+ 			else if tq = typnods[tnil] then
+ 			    begin
+ 				eexpr(tp^.tlhs);
+ 				write(' = (');
+ 				etypedef(typeof(tp^.tlhs));
+ 				write(')NIL')
+ 			    end
+ 			else begin
+ 				tq := typeof(tp^.tlhs);
+ 				if tq^.tt = nsetof then
+ 				    begin
+ 					usescpy := true;
+ 					write('Setncpy(');
+ 					eselect(tp^.tlhs);
+ 					write('S, ');
+ 					dropset := true;
+ 					tq := typeof(tp^.trhs);
+ 					if tq = typnods[tset] then
+ 						eexpr(tp^.trhs)
+ 					else begin
+ 						eselect(tp^.trhs);
+ 						write('S')
+ 					     end;
+ 					dropset := false;
+ 					write(', sizeof(');
+ 					eselect(tp^.tlhs);
+ 					write('S))')
+ 				    end
+ 				else begin
+ 					eexpr(tp^.tlhs);
+ 					write(' = ');
+ 					eexpr(tp^.trhs)
+ 				     end
+ 			     end
+ 		    end;
+ 
+ 		  ncall:
+ 		    begin
+ 			tq := idup(tp^.tcall);
+ 			if (tq^.tt in [nfunc, nproc]) and
+ 					(tq^.tsubstmt <> nil) then
+ 				if tq^.tsubstmt^.tt = npredef then
+ 					epredef(tq, tp)
+ 				else
+ 					ecall(tp)
+ 			else
+ 				ecall(tp)
+ 		    end;
+ 
+ 		  nselect:
+ 		    begin
+ 			eselect(tp^.trecord);
+ 			eexpr(tp^.tfield)
+ 		    end;
+ 		  nindex:
+ 		    begin
+ 			eselect(tp^.tvariable);
+ 			write('A[');
+ 			tq := tp^.toffset;
+ 			if arithexpr(tq) then
+ 				eexpr(tq)
+ 			else begin
+ 				write('(int)(');
+ 				eexpr(tq);
+ 				write(')')
+ 			     end;
+ 			tq := typeof(tp^.tvariable);
+ 			if tq^.tt = narray then
+ 				if clower(tq^.taindx) <> 0 then
+ 				    begin
+ 					write(' - ');
+ 					tq := typeof(tq^.taindx);
+ 					if tq^.tt = nsubrange then
+ 						if arithexpr(tq^.tlo) then
+ 							eexpr(tq^.tlo)
+ 						else begin
+ 							write('(int)(');
+ 							eexpr(tq^.tlo);
+ 							write(')')
+ 						     end
+ 					else 
+ 						fatal(etree)
+ 				    end;
+ 			write(']')
+ 		    end;
+ 		  nderef:
+ 		    begin
+ 			tq := typeof(tp^.texps);
+ 			if (tq^.tt = nfileof) or
+ 			     ((tq^.tt = npredef) and (tq^.tdef = dtext)) then
+ 			    begin
+ 				(* using a file-variable as pointer *)
+ 				eexpr(tp^.texps);
+ 				write('.buf')
+ 			    end
+ 			else if doarrow = 0 then
+ 			    begin
+ 				write('*');
+ 				eexpr(tp^.texps)
+ 			    end
+ 			else begin
+ 				eexpr(tp^.texps);
+ 				write('->');
+ 				donearr := true
+ 			     end
+ 		    end;
+ 		  nid:
+ 		    begin
+ 			(* add pointer-dereference if this id is declared as a
+ 			   var-parameter or as a procedure-parameter *)
+ 			tq := idup(tp);
+ 			if tq^.tt = nvarpar then
+ 			    begin
+ 				if (doarrow = 0) or
+ 						(tq^.tattr = areference) then
+ 				    begin
+ 					write('(*');
+ 					printid(tp^.tsym^.lid);
+ 					write(')')
+ 				    end
+ 				else begin
+ 					printid(tp^.tsym^.lid);
+ 					write('->');
+ 					donearr := true
+ 				     end
+ 			    end
+ 			else if (tq^.tt = nconst) and conflag then
+ 				write(cvalof(tp):1)
+ 			else if tq^.tt in [nparproc, nparfunc] then
+ 			    begin
+ 				write('(*');
+ 				printid(tp^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				printid(tp^.tsym^.lid);
+ 		    end;
+ 		  nchar:
+ 			printchr(tp^.tsym^.lchar);
+ 		  ninteger:
+ 			write(tp^.tsym^.linum:1);
+ 		  nreal:
+ 			printtok(tp^.tsym^.lfloat);
+ 		  nstring:
+ 			printstr(tp^.tsym^.lstr);
+ 		  nset:
+ 			if constset(tp^.texps) then
+ 			    begin
+ 				(* save set expression for initialization *)
+ 				write('Conset[', setcnt:1, ']');
+ 				setcnt := setcnt + 1;
+ 				tq := mknode(nset);
+ 				tq^.tnext := setlst;
+ 				setlst := tq;
+ 				tq^.texps := tp^.texps
+ 			    end
+ 			else begin
+ 				increment;
+ 				flag := dropset;
+ 				(* if a set-constructor is used in an
+ 				   expression involving + - *  it will need to
+ 				   be saved temporarily (by Saveset) but often
+ 				   we can simply forget the set-value when we
+ 				   have finished using it *)
+ 				if dropset then
+ 					dropset := false
+ 				else
+ 					write('Saveset(');
+ 				write('(Tmpset = Newset(), ');
+ 				tq := tp^.texps;
+ 				while tq <> nil do
+ 				    begin
+ 					case tq^.tt of
+ 					  nrange:
+ 					    begin
+ 						usemksub := true;
+ 						write(voidcast, 'Mksubr(');
+ 						write('(unsigned)(');
+ 						eexpr(tq^.texpl);
+ 						write('), ');
+ 						write('(unsigned)(');
+ 						eexpr(tq^.texpr);
+ 						write('), Tmpset)')
+ 					    end;
+ 					  nin, neq, nne, nlt, nle, ngt, nge,
+ 					  nor, nand, nmul, ndiv, nmod, nquot,
+ 					  nplus, nminus, nnot, numinus, nuplus, 
+ 					  nindex, nselect, nderef, ncall,
+ 					  ninteger, nchar, nid:
+ 					    begin
+ 						useins := true;
+ 						write(voidcast, 'Insmem(');
+ 						write('(unsigned)(');
+ 						eexpr(tq);
+ 						write('), Tmpset)')
+ 					    end
+ 					end;(* case *)
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				write(', Tmpset)');
+ 				if not flag then
+ 				    begin
+ 					write(')');
+ 					setused := true
+ 				    end;
+ 				decrement
+ 			     end;
+ 		  nnil:
+ 		    begin
+ 			tq := tp;
+ 			repeat
+ 				tq := tq^.tup
+ 			until	tq^.tt in [neq, nne, ncall, nassign, npgm];
+ 			if tq^.tt in [neq, nne] then
+ 			    begin
+ 				if typeof(tq^.texpl) = typnods[tnil] then
+ 					tq := typeof(tq^.texpr)
+ 				else
+ 					tq := typeof(tq^.texpl);
+ 				if tq^.tt = nptr then
+ 				    begin
+ 					write('(');
+ 					etypedef(tq);
+ 					write(')')
+ 				    end
+ 			    end;
+ 			write('NIL')
+ 		    end;
+ 		end;(* case *)
+ 	999:
+ 	end;	(* eexpr *)
+ 
+ 	(*	Emit constant definitions.				*)
+ 	procedure econst(tp : treeptr);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			sp := tp^.tidl^.tsym;
+ 			if sp^.lid^.inref > 1 then
+ 				sp^.lid := mkrename('X', sp^.lid);
+ 			if tp^.tbind^.tt = nstring then
+ 			    begin
+ 				(* string constants emitted as
+ 				   static local variables *)
+ 				indent;
+ 				write(static, chartyp, tab1);
+ 				printid(sp^.lid);
+ 				write('[]	= ');
+ 				eexpr(tp^.tbind);
+ 				writeln(';')
+ 			    end
+ 			else begin
+ 				(* all other constants emitted as
+ 				   preprocessor # defines *)
+ 				write(define);
+ 				printid(sp^.lid);
+ 				write(space);
+ 				eexpr(tp^.tbind);
+ 				writeln
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* econst *)
+ 
+ 	(*	Emit a typedef.						*)
+ 	procedure etypedef;
+ 
+ 		(*	Workhorse for etypedef, this procedure also	*)
+ 		(*	renames all fields in record-unions when	*)
+ 		(*	necessary.					*)
+ 		procedure etdef(uid : idptr; tp : treeptr);
+ 
+ 		var	i	: integer;
+ 			tq	: treeptr;
+ 
+ 			(*	Emit definition for an integer subrange	*)
+ 			(*	using data from worddefs set up during	*)
+ 			(*	initialization.				*)
+ 			procedure etrange(tp : treeptr);
+ 
+ 			label	999;
+ 
+ 			var	lo, hi	: integer;
+ 				i	: 1 .. maxmachdefs;
+ 
+ 			begin
+ 				lo := clower(tp);
+ 				hi := cupper(tp);
+ 				(* scan CPU word definitions for a type
+ 				   enclosing wanted range *)
+ 				for i := 1 to nmachdefs do
+ 				    with machdefs[i] do
+ 					if (lo >= lolim) and (hi <= hilim) then
+ 					    begin
+ 						(* found it, print type name *)
+ 						printtok(typstr);
+ 						goto 999
+ 					    end;
+ 				fatal(erange);
+ 			999:
+ 			end;
+ 
+ 			(*	Print last component of identifier.	*)
+ 			procedure printsuf(ip : idptr);
+ 
+ 			var	w	: toknbuf;
+ 				i, j	: toknidx;
+ 
+ 			begin
+ 				gettokn(ip^.istr, w);
+ 				i := 1;
+ 				j := i;
+ 				while w[i] <> chr(null) do
+ 				    begin
+ 					if w[i] = '.' then
+ 						j := i;
+ 					i := i + 1
+ 				    end;
+ 				if w[j] = '.' then
+ 					j := j + 1;
+ 				while w[j] <> chr(null) do
+ 				    begin
+ 					write(w[j]);
+ 					j := j + 1
+ 				    end
+ 			end;
+ 
+ 		begin	(* etdef *)
+ 			case tp^.tt of
+ 			  nid:
+ 				printid(tp^.tsym^.lid);
+ 			  nptr:
+ 			    begin
+ 				tq := typeof(tp^.tptrid);
+ 				if tq^.tt = nrecord then
+ 				    begin
+ 					write('struct ');
+ 					printid(tq^.tuid)
+ 				    end
+ 				else
+ 					printid(tp^.tptrid^.tsym^.lid);
+ 				write(' *');
+ 			    end;
+ 			  nscalar:
+ 			    begin
+ 				write('enum { ');
+ 				increment;
+ 				tp := tp^.tscalid;
+ 
+ 				(* avoid bug in C-compiler:
+ 					   enums are mixed in same namespace *)
+ 				if tp^.tsym^.lid^.inref > 1 then
+ 					tp^.tsym^.lid :=
+ 						mkrename('E', tp^.tsym^.lid);
+ 				printid(tp^.tsym^.lid);
+ 				i := 1;
+ 				while tp^.tnext <> nil do
+ 				    begin
+ 					if i >= 4 then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						i := 1
+ 					    end
+ 					else begin
+ 						write(', ');
+ 						i := i + 1
+ 					     end;
+ 					tp := tp^.tnext;
+ 					if tp^.tsym^.lid^.inref > 1 then
+ 					    tp^.tsym^.lid :=
+ 						mkrename('E', tp^.tsym^.lid);
+ 					printid(tp^.tsym^.lid)
+ 				    end;
+ 				decrement;
+ 				write(' } ')
+ 			    end;
+ 			  nsubrange:
+ 			    begin
+ 				tq := typeof(tp^.tlo);
+ 				if tq = typnods[tinteger] then
+ 					etrange(tp)
+ 				else begin
+ 					if tq^.tup^.tt = ntype then
+ 						tq := tq^.tup^.tidl;
+ 					etdef(nil, tq)
+ 				     end
+ 			    end;
+ 			  nfield:
+ 			    begin
+ 				etdef(nil, tp^.tbind);
+ 				write(tab1);
+ 				tp := tp^.tidl;
+ 				if uid <> nil then
+ 					tp^.tsym^.lid :=
+ 						mkconc('.', uid, tp^.tsym^.lid);
+ 				printsuf(tp^.tsym^.lid);
+ 				i := 1;
+ 				while tp^.tnext <> nil do
+ 				    begin
+ 					if i >= 4 then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						write(tab1);
+ 						i := 1
+ 					    end
+ 					else begin
+ 						write(', ');
+ 						i := i + 1
+ 					     end;
+ 					tp := tp^.tnext;
+ 					if uid <> nil then
+ 					    tp^.tsym^.lid :=
+ 						mkconc('.', uid, tp^.tsym^.lid);
+ 					printsuf(tp^.tsym^.lid);
+ 				    end;
+ 				writeln(';');
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				write('struct ');
+ 				if tp^.tuid = nil then
+ 					tp^.tuid := uid
+ 				else if uid = nil then
+ 					printid(tp^.tuid);
+ 				writeln(' {');
+ 				increment;
+ 				if (tp^.tflist = nil) and
+ 							(tp^.tvlist = nil) then
+ 				    begin
+ 					(* C doesn't allow empty structures *)
+ 					indent;
+ 					writeln(inttyp, tab1, 'dummy;')
+ 				    end;
+ 				tq := tp^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					indent;
+ 					etdef(uid, tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				if tp^.tvlist <> nil then
+ 				    begin
+ 					indent;
+ 					writeln('union {');
+ 					increment;
+ 					tq := tp^.tvlist;
+ 					while tq <> nil do
+ 					    begin
+ 						if (tq^.tvrnt^.tflist <> nil) or
+ 						 (tq^.tvrnt^.tvlist <> nil) then
+ 						    begin
+ 							indent;
+ 							if uid = nil then
+ 							    etdef(mkvrnt,
+ 								tq^.tvrnt)
+ 							else
+ 							    etdef(mkconc('.',
+ 								   uid, mkvrnt),
+ 								tq^.tvrnt);
+ 							writeln(';')
+ 						    end;
+ 						tq := tq^.tnext
+ 					    end;
+ 					decrement;
+ 					indent;
+ 					writeln('} U;');
+ 				    end;
+ 				decrement;
+ 				indent;
+ 				if tp^.tup^.tt = nvariant then
+ 				    begin
+ 					write('} ');
+ 					printsuf(tp^.tuid)
+ 				    end
+ 				else
+ 					write('}');
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				write('struct ');
+ 				printid(tp^.tcuid);
+ 				write(' { ');
+ 				etdef(nil, tp^.tcelem);
+ 				write(tab1, 'A[]; }')
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				write('struct { ');
+ 				etdef(nil, tp^.taelem);
+ 				write(tab1, 'A[');
+ 				tq := typeof(tp^.taindx);
+ 				if tq^.tt = nsubrange then
+ 				    begin
+ 					if arithexpr(tq^.thi) then
+ 					    begin
+ 						eexpr(tq^.thi);
+ 						if cvalof(tq^.tlo) <> 0 then
+ 						    begin
+ 							write(' - ');
+ 							eexpr(tq^.tlo)
+ 						    end
+ 					    end
+ 					else begin
+ 						write('(int)(');
+ 						eexpr(tq^.thi);
+ 						if cvalof(tq^.tlo) <> 0 then
+ 						    begin
+ 							write(') - (int)(');
+ 							eexpr(tq^.tlo)
+ 						    end;
+ 						write(')')
+ 					     end;
+ 					write(' + 1')
+ 				    end
+ 				else
+ 					write(crange(tp^.taindx):1);
+ 				write(']; }')
+ 			    end;
+ 			  nfileof:
+ 			    begin
+ 				writeln('struct {');
+ 				indent;
+ 				writeln(tab1, 'FILE', tab1, '*fp;');
+ 				indent;
+ 				writeln(tab1, filebits, tab1, 'eoln:1,');
+ 				indent;
+ 				writeln(tab3, 'eof:1,');
+ 				indent;
+ 				writeln(tab3, 'out:1,');
+ 				indent;
+ 				writeln(tab3, 'init:1,');
+ 				indent;
+ 				writeln(tab3, ':', filefill:1, ';');
+ 				indent;
+ 				write(tab1);
+ 				etdef(nil, tp^.tof);
+ 				writeln(tab1, 'buf;');
+ 				indent;
+ 				write('} ')
+ 			    end;
+ 			  nsetof:
+ 				write('struct { ', setwtyp, tab1, 'S[',
+ 							csetsize(tp):1, ']; }');
+ 			  npredef:
+ 			    begin
+ 				case tp^.tobtyp of
+ 				  tboolean:
+ 					printid(defnams[dboolean]^.lid);
+ 				  tchar:
+ 					write(chartyp);
+ 				  tinteger:
+ 					printid(defnams[dinteger]^.lid);
+ 				  treal:
+ 					printid(defnams[dreal]^.lid);
+ 				  tstring:
+ 					write(chartyp, ' *');
+ 				  ttext:
+ 					write('text');
+ 				  tnil,
+ 				  tset,
+ 				  terror:
+ 					fatal(etree);
+ 				  tnone:
+ 					write(voidtyp);
+ 				end (* case *)
+ 			    end;
+ 			  nempty:
+ 				write(voidtyp);
+ 			end;(* case *)
+ 		end;	(* etdef *)
+ 	begin
+ 		etdef(nil, tp)
+ 	end;	(* etypedef *)
+ 
+ 	(*	Emit code for type declarations.			*)
+ 	procedure etype(tp : treeptr);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			(* if identifier used more than once we rename the type
+ 			   to avoid typedef'ing an identifier twice *)
+ 			sp := tp^.tidl^.tsym;
+ 			if sp^.lid^.inref > 1 then
+ 				sp^.lid := mkrename('Y', sp^.lid);
+ 			indent;
+ 			write(typdef);
+ 			etypedef(tp^.tbind);
+ 			write(tab1);
+ 			printid(sp^.lid);
+ 			writeln(';');
+ 			tp := tp^.tnext
+ 		    end
+ 	end;
+ 
+ 	(*	Emit code for variable declarations.			*)
+ 	procedure evar(tp : treeptr);
+ 
+ 	label	555;
+ 
+ 	var	tq	: treeptr;
+ 		i	: integer;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			indent;
+ 			case tp^.tt of
+ 			  nvar,
+ 			  nvalpar,
+ 			  nvarpar:
+ 			    begin
+ 				if tp^.tattr = aregister then
+ 					write(registr);
+ 				etypedef(tp^.tbind)
+ 			    end;
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				if tp^.tt = nparproc then
+ 					write(voidtyp)
+ 				else
+ 					etypedef(tp^.tpartyp);
+ 				tq := tp^.tparid;
+ 				write(tab1, '(*');
+ 				printid(tq^.tsym^.lid);
+ 				write(')()');
+ 				goto 555
+ 			    end
+ 			end;(* case *)
+ 			write(tab1);
+ 			tq := tp^.tidl;
+ 			i := 1;
+ 			repeat
+ 				if tp^.tt = nvarpar then
+ 					write('*');
+ 				printid(tq^.tsym^.lid);
+ 				tq := tq^.tnext;
+ 				if tq <> nil then
+ 				    begin
+ 					if i >= 6 then
+ 					    begin
+ 						i := 1;
+ 						writeln(',');
+ 						indent;
+ 						write(tab1)
+ 					    end
+ 					else begin
+ 						i := i + 1;
+ 						write(', ')
+ 					     end
+ 
+ 				    end
+ 			until	tq = nil;
+ 		555:
+ 			writeln(';');
+ 			if tp^.tt = nvarpar then
+ 				if tp^.tbind^.tt = nconfarr then
+ 				    begin
+ 					indent;
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					write(tab1);
+ 					tq := tp^.tbind^.tcindx^.thi;
+ 					printid(tq^.tsym^.lid);
+ 					writeln(';')
+ 				    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* evar *)
+ 
+ 	(*	Emit code for a statment.				*)
+ 	procedure estmt(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 		locid1,
+ 		locid2	: idptr;
+ 		stusd	: boolean;
+ 		opc1,
+ 		opc2	: char;
+ 
+ 		(*	Emit typename for with-variable.		*)
+ 		procedure ewithtype(tp : treeptr);
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			tq := typeof(tp);
+ 			write('struct ');
+ 			printid(tq^.tuid)
+ 		end;
+ 
+ 		(*	Emit code for a case-choise.		*)
+ 		procedure echoise(tp : treeptr);
+ 
+ 		var	tq	: treeptr;
+ 			i	: integer;
+ 
+ 		begin
+ 			while tp <> nil do
+ 			    begin
+ 				tq := tp^.tchocon;
+ 				i := 0;
+ 				indent;
+ 				while tq <> nil do
+ 				    begin
+ 					write('  case ');
+ 					conflag := true;
+ 					eexpr(tq);
+ 					conflag := false;
+ 					write(':');
+ 					i := i + 1;
+ 					tq := tq^.tnext;
+ 					if (tq = nil) or (i mod 4 = 0) then
+ 					    begin
+ 						writeln;
+ 						if tq <> nil then
+ 							indent;
+ 						i := 0
+ 					    end
+ 				    end;
+ 				increment;
+ 				if tp^.tchostmt^.tt = nbegin then
+ 					estmt(tp^.tchostmt^.tbegin)
+ 				else
+ 					estmt(tp^.tchostmt);
+ 				indent;
+ 				writeln('break ;');
+ 				decrement;
+ 				tp := tp^.tnext;
+ 				if tp <> nil then
+ 					if tp^.tchocon = nil then
+ 						tp := nil
+ 			    end
+ 		end;	(* echoise *)
+ 
+ 		(*	Rename all accessible record-fields to include	*)
+ 		(*	pointer name.					*)
+ 		procedure cenv(ip : idptr; dp : declptr);
+ 
+ 		var	tp	: treeptr;
+ 			sp	: symptr;
+ 			np	: idptr;
+ 			h	: hashtyp;
+ 
+ 		begin
+ 			with dp^ do
+ 			  for h := 0 to hashmax - 1 do
+ 			    begin
+ 				sp := ddecl[h];
+ 				while sp <> nil do
+ 				    begin
+ 					if sp^.lt = lfield  then
+ 					    begin
+ 						np := sp^.lid;
+ 						tp := sp^.lsymdecl^.tup^.tup;
+ 						if (tp^.tup^.tt = nvariant) and
+ 							(tp^.tuid <> nil) then
+ 							np := mkconc('.',
+ 								tp^.tuid, np);
+ 						np := mkconc('>', ip, np);
+ 						sp^.lid := np
+ 					    end;
+ 					sp := sp^.lnext
+ 				    end
+ 			    end
+ 		end;	(* cenv *)
+ 
+ 		(*	Emit identifiers for push/pop of global ptrs.	*)
+ 		procedure eglobid(tp : treeptr);
+ 
+ 		var	j	: toknidx;
+ 			w	: toknbuf;
+ 
+ 		begin
+ 			gettokn(tp^.tsym^.lid^.istr, w);
+ 			j := 1;
+ 			if w[1] = '*' then
+ 				j := 2;
+ 			while w[j] <> chr(null) do
+ 			    begin
+ 				write(w[j]);
+ 				j := j + 1
+ 			    end
+ 		end;
+ 
+ 	begin	(* estmt *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  nbegin:
+ 			    begin
+ 				if tp^.tup^.tt in [nbegin, nrepeat,
+ 						nproc, nfunc, npgm] then
+ 					indent;
+ 				writeln('{');
+ 				increment;
+ 				estmt(tp^.tbegin);
+ 				decrement;
+ 				indent;
+ 				write('}');
+ 				if tp^.tup^.tt <> nif then
+ 					writeln
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				indent;
+ 				writeln('do {');
+ 				increment;
+ 				estmt(tp^.treptstmt);
+ 				decrement;
+ 				indent;
+ 				write('} while (!(');
+ 				eexpr(tp^.treptxp);
+ 				writeln('));')
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				indent;
+ 				write('while (');
+ 				increment;
+ 				eexpr(tp^.twhixp);
+ 				stusd := setused;
+ 				if tp^.twhistmt^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.twhistmt)
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.twhistmt);
+ 					decrement
+ 				     end;
+ 				setused := stusd or setused
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				indent;
+ 				if tp^.tincr then
+ 				    begin
+ 					opc1 := '+';	(* increment variable *)
+ 					opc2 := '<'	(* test for <= *)
+ 				    end
+ 				else begin
+ 					opc1 := '-';	(* decrement variable *)
+ 					opc2 := '>';	(* test for >= *)
+ 				     end;
+ 				if not lazyfor then
+ 				    begin
+ 					locid1 := mkvariable('B');
+ 					locid2 := mkvariable('B');
+ 					writeln('{');
+ 					increment;
+ 					indent;
+ 					tq := idup(tp^.tforid);
+ 					etypedef(tq^.tbind);
+ 					tq := typeof(tq^.tbind);
+ 					write(tab1);
+ 					printid(locid1);
+ 					write(' = ');
+ 					eexpr(tp^.tfrom);
+ 					writeln(',');
+ 					indent;
+ 					write(tab1);
+ 					printid(locid2);
+ 					write(' = ');
+ 					eexpr(tp^.tto);
+ 					writeln(';');
+ 					writeln;
+ 					indent;
+ 					write('if (');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						printid(locid1);
+ 						write(')')
+ 					    end
+ 					else
+ 						printid(locid1);
+ 					write(' ', opc2, '= ');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						printid(locid2);
+ 						write(')')
+ 					    end
+ 					else
+ 						printid(locid2);
+ 					writeln(')');
+ 					increment;
+ 					indent;
+ 					tp^.tfrom := newid(locid1);
+ 					tp^.tfrom^.tup := tp
+ 				    end;
+ 				write('for (');
+ 				increment;
+ 				eexpr(tp^.tforid);
+ 				tq := typeof(tp^.tforid);
+ 				write(' = ');
+ 				eexpr(tp^.tfrom);
+ 				write('; ');
+ 				if lazyfor then
+ 				    begin
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						eexpr(tp^.tforid);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tp^.tforid);
+ 					write(' ', opc2, '= ');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						eexpr(tp^.tto);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tp^.tto)
+ 				    end;
+ 				write('; ');
+ 				eexpr(tp^.tforid);
+ 				if tq^.tt = nscalar then
+ 				    begin
+ 					write(' = (');
+ 					eexpr(tq^.tup^.tidl);
+ 					write(')((int)(');
+ 					eexpr(tp^.tforid);
+ 					write(')', opc1, '1)')
+ 				    end
+ 				else
+ 					write(opc1, opc1);
+ 				if not lazyfor then
+ 				    begin
+ 					if tp^.tforstmt^.tt <> nbegin then
+ 					    begin
+ 						(* create compund stmt *)
+ 						tq := mknode(nbegin);
+ 						tq^.tbegin := tp^.tforstmt;
+ 						tq^.tbegin^.tup := tq;
+ 						tp^.tforstmt := tq;
+ 						tq^.tup := tp
+ 					    end;
+ 					(* find end of loop *)
+ 					tq := tp^.tforstmt^.tbegin;
+ 					while tq^.tnext <> nil do
+ 						tq := tq^.tnext;
+ 					(* add break stmt *)
+ 					tq^.tnext := mknode(nbreak);
+ 					tq := tq^.tnext;
+ 					tq^.tup := tp^.tforstmt;
+ 					tq^.tbrkid := tp^.tforid;
+ 					tq^.tbrkxp := newid(locid2);
+ 					tq^.tbrkxp^.tup := tq
+ 				    end;
+ 				if tp^.tforstmt^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.tforstmt)
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.tforstmt);
+ 					decrement
+ 				     end;
+ 				if not lazyfor then
+ 				    begin
+ 					decrement;
+ 					decrement;
+ 					indent;
+ 					writeln('}')
+ 				    end
+ 			    end;
+ 			  nif:
+ 			    begin
+ 				indent;
+ 				write('if (');
+ 				increment;
+ 				eexpr(tp^.tifxp);
+ 				stusd := setused;
+ 				setused := false;
+ 				if tp^.tthen^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.tthen);
+ 					if tp^.telse <> nil then
+ 						write(space)
+ 					else
+ 						writeln
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.tthen);
+ 					decrement;
+ 					if tp^.telse <> nil then
+ 						indent
+ 				     end;
+ 				if tp^.telse <> nil then
+ 				    begin
+ 					write('else');
+ 					if tp^.telse^.tt = nbegin then
+ 					    begin
+ 						write(space);
+ 						estmt(tp^.telse);
+ 						writeln
+ 					    end
+ 					else begin
+ 						increment;
+ 						writeln;
+ 						estmt(tp^.telse);
+ 						decrement
+ 					     end;
+ 				    end;
+ 				setused := stusd or setused
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				indent;
+ 				write('switch (');
+ 				increment;
+ 				eexpr(tp^.tcasxp);
+ 				writeln(') {');
+ 				decrement;
+ 				echoise(tp^.tcaslst);
+ 				indent;
+ 				writeln('  default:');
+ 				increment;
+ 				if tp^.tcasother = nil then
+ 				    begin
+ 					indent;
+ 					writeln('Caseerror(Line);')
+ 				    end
+ 				else
+ 					estmt(tp^.tcasother);
+ 				decrement;
+ 				indent;
+ 				writeln('}')
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				indent;
+ 				writeln('{');
+ 				increment;
+ 				tq := tp^.twithvar;
+ 				while tq <> nil do
+ 				    begin
+ 					indent;
+ 					write(registr);
+ 					ewithtype(tq^.texpw);
+ 					write(' *');
+ 					locid1 := mkvariable('W');
+ 					printid(locid1);
+ 					write(' = ');
+ 					eaddr(tq^.texpw);
+ 					writeln(';');
+ 					cenv(locid1, tq^.tenv);
+ 					tq := tq^.tnext
+ 				    end;
+ 				writeln;
+ 				if tp^.twithstmt^.tt = nbegin then
+ 					estmt(tp^.twithstmt^.tbegin)
+ 				else
+ 					estmt(tp^.twithstmt);
+ 				decrement;
+ 				indent;
+ 				writeln('}')
+ 			    end;
+ 			  ngoto:
+ 			    begin
+ 				indent;
+ 				if islocal(tp^.tlabel) then
+ 					writeln('goto L',
+ 						tp^.tlabel^.tsym^.lno:1, ';')
+ 				else begin
+ 					tq := idup(tp^.tlabel);
+ 					writeln('longjmp(J[',	(* LIB *)
+ 						tq^.tstat:1, '].jb, ',
+ 						tp^.tlabel^.tsym^.lno:1, ');')
+ 				     end
+ 			    end;
+ 			  nlabstmt:
+ 			    begin
+ 				decrement;
+ 				indent;
+ 				writeln('L', tp^.tlabno^.tsym^.lno:1, ':');
+ 				increment;
+ 				estmt(tp^.tstmt)
+ 			    end;
+ 			  nassign:
+ 			    begin
+ 				indent;
+ 				eexpr(tp);
+ 				writeln(';')
+ 			    end;
+ 			  ncall:
+ 			    begin
+ 				indent;
+ 				tq := idup(tp^.tcall);
+ 				if (tq^.tt in [nfunc, nproc]) and
+ 						(tq^.tsubstmt <> nil) then
+ 					if tq^.tsubstmt^.tt = npredef then
+ 						epredef(tq, tp)
+ 					else begin
+ 						ecall(tp);
+ 						writeln(';')
+ 					     end
+ 				else begin
+ 					ecall(tp);
+ 					writeln(';')
+ 				     end
+ 			    end;
+ 			  npush:
+ 			    begin
+ 				indent;
+ 				eglobid(tp^.ttmp);
+ 				write(' = ');
+ 				eglobid(tp^.tglob);
+ 				writeln(';');
+ 				indent;
+ 				eglobid(tp^.tglob);
+ 				write(' = ');
+ 				if tp^.tloc^.tt = nid then
+ 				    begin
+ 					tq := idup(tp^.tloc);
+ 					if tq^.tt in [nparproc, nparfunc] then
+ 						printid(tp^.tloc^.tsym^.lid)
+ 					else
+ 						eaddr(tp^.tloc)
+ 				    end
+ 				else
+ 					eaddr(tp^.tloc);
+ 				writeln(';')
+ 			    end;
+ 			  npop:
+ 			    begin
+ 				indent;
+ 				eglobid(tp^.tglob);
+ 				write(' = ');
+ 				eglobid(tp^.ttmp);
+ 				writeln(';')
+ 			    end;
+ 			  nbreak:
+ 			    begin
+ 				indent;
+ 				write('if (');
+ 				eexpr(tp^.tbrkid);
+ 				write(' == ');
+ 				eexpr(tp^.tbrkxp);
+ 				writeln(') break;')
+ 			    end;
+ 			  nempty:
+ 				if not (tp^.tup^.tt in [npgm, nproc, nfunc,
+ 						nchoise, nbegin, nrepeat]) then
+ 				    begin
+ 					indent;
+ 					writeln(';')
+ 				    end
+ 			end;(* case *)
+ 			if setused and
+ 				(tp^.tup^.tt in [npgm, nproc, nfunc, nrepeat,
+ 						nbegin, nchoise, nwith]) then
+ 			    begin
+ 				indent;
+ 				writeln('Claimset();');
+ 				setused := false
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* estmt *)
+ 
+ 	(*	Emit initialization for non-local gotos.		*)
+ 	procedure elabel(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 		i	: integer;
+ 
+ 	begin
+ 		i := 0;
+ 		tq := tp^.tsublab;
+ 		while tq <> nil do
+ 		    begin
+ 			if tq^.tsym^.lgo then
+ 				i := i + 1;
+ 			tq := tq^.tnext
+ 		    end;
+ 		if i =1 then
+ 		    begin
+ 			tq := tp^.tsublab;
+ 			while not tq^.tsym^.lgo do
+ 				tq := tq^.tnext;
+ 			indent;
+ 			writeln('if (',
+ 				'setjmp(J[', tp^.tstat:1, '].jb))'); (* LIB *)
+ 			writeln(tab1, 'goto L', tq^.tsym^.lno:1, ';')
+ 		    end
+ 		else if i > 1 then
+ 		    begin
+ 			indent;
+ 			writeln('switch (',
+ 				'setjmp(J[', tp^.tstat:1, '].jb)) {'); (* LIB *)
+ 			indent;
+ 			writeln('  case 0:');
+ 			indent;
+ 			writeln(tab1, 'break');
+ 			tq := tp^.tsublab;
+ 			while tq <> nil do
+ 			    begin
+ 				if tq^.tsym^.lgo then
+ 				    begin
+ 					(* label used in non-local goto *)
+ 					indent;
+ 					writeln('  case ',
+ 							tq^.tsym^.lno:1, ':');
+ 					indent;
+ 					writeln(tab1, 'goto L',
+ 							tq^.tsym^.lno:1, ';')
+ 				    end;
+ 				tq := tq^.tnext
+ 			    end;
+ 			indent;
+ 			writeln('  default:');
+ 			indent;
+ 			writeln(tab1, 'Caseerror(Line)');
+ 			indent;
+ 			writeln('}')
+ 		    end
+ 	end;	(* elabel *)
+ 
+ 	(*	Emit declaration for lower bound of conformant array.	*)
+ 	procedure econf(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			if tp^.tt = nvarpar then
+ 				if tp^.tbind^.tt = nconfarr then
+ 				    begin
+ 					indent;
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					write(tab1);
+ 					tq := tp^.tbind^.tcindx^.tlo;
+ 					printid(tq^.tsym^.lid);
+ 					write(' = (');
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					writeln(')0;')
+ 				    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* econf *)
+ 
+ 	(*	Emit code for subroutines.				*)
+ 	procedure esubr(tp : treeptr);
+ 
+ 	label	999;
+ 
+ 	var	tq, ti	: treeptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			(* emit nested subroutines *)
+ 			if tp^.tsubsub <> nil then
+ 			    begin
+ 				(* emit forward declaration of this subroutine
+ 				   in case of recursion *)
+ 				etypedef(tp^.tfuntyp);
+ 				write(space);
+ 				printid(tp^.tsubid^.tsym^.lid);
+ 				writeln('();');
+ 				writeln;
+ 				esubr(tp^.tsubsub)
+ 			    end;
+ 			(* emit this subroutine *)
+ 			if tp^.tsubstmt = nil then
+ 			    begin
+ 				(* forward/external decl *)
+ 				if tp^.tsubid^.tsym^.lsymdecl^.tup = tp then
+ 					write(xtern);
+ 				etypedef(tp^.tfuntyp);
+ 				write(space);
+ 				printid(tp^.tsubid^.tsym^.lid);
+ 				writeln('();');
+ 				goto 999
+ 			    end;
+ 			write(space);
+ 			etypedef(tp^.tfuntyp);
+ 			writeln;
+ 			printid(tp^.tsubid^.tsym^.lid);
+ 			write('(');
+ 			tq := tp^.tsubpar;
+ 			while tq <> nil do
+ 			    begin
+ 				case tq^.tt of
+ 				  nvarpar,
+ 				  nvalpar:
+ 				    begin
+ 					ti := tq^.tidl;
+ 					while ti <> nil do
+ 					    begin
+ 						printid(ti^.tsym^.lid);
+ 						ti := ti^.tnext;
+ 						if ti <> nil then
+ 							write(', ');
+ 					    end;
+ 					if tq^.tbind^.tt = nconfarr then
+ 					    begin
+ 						(* add upper bound parameter *)
+ 						ti := tq^.tbind^.tcindx^.thi;
+ 						write(', ');
+ 						printid(ti^.tsym^.lid)
+ 					    end;
+ 				    end;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					ti := tq^.tparid;
+ 					printid(ti^.tsym^.lid)
+ 				    end
+ 				end;(* case *)
+ 				tq := tq^.tnext;
+ 				if tq <> nil then
+ 					write(', ');
+ 			    end;
+ 			writeln(')');
+ 			increment;
+ 			evar(tp^.tsubpar);
+ 			writeln('{');
+ 			econf(tp^.tsubpar);
+ 			econst(tp^.tsubconst);
+ 			etype(tp^.tsubtype);
+ 			evar(tp^.tsubvar);
+ 
+ 			if (tp^.tsubconst <> nil) or (tp^.tsubtype <> nil) or
+ 					(tp^.tsubvar <> nil) then
+ 				writeln;
+ 			elabel(tp);
+ 			estmt(tp^.tsubstmt);
+ 			if tp^.tt = nfunc then
+ 			    begin
+ 				(* return value in the FIRST variable,
+ 				   see renamf() above *)
+ 				indent;
+ 				write('return ');
+ 				printid(tp^.tsubvar^.tidl^.tsym^.lid);
+ 				writeln(';');
+ 			    end;
+ 			decrement;
+ 			writeln('}');
+ 		999:
+ 			writeln;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* esubr *)
+ 
+ 	function use(d : predefs) : boolean;
+ 
+ 	begin
+ 		use := defnams[d]^.lused
+ 	end;
+ 
+ 	(*	Emit code for main program.				*)
+ 	procedure eprogram(tp : treeptr);
+ 
+ 		(*	Symbol that sp refers to is renamed if it has	*)
+ 		(*	been redefined in source program.		*)
+ 		procedure capital(sp : symptr);
+ 
+ 		var	tb	: toknbuf;
+ 
+ 		begin
+ 			if sp^.lid^.inref > 1 then
+ 			    begin
+ 				gettokn(sp^.lid^.istr, tb);
+ 				tb[1] := uppercase(tb[1]);
+ 				sp^.lid := saveid(tb)
+ 			    end
+ 		end;
+ 
+ 		procedure etextdef;
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			write('typedef ');
+ 			tq := mknode(nfileof);
+ 			tq^.tof := typnods[tchar];
+ 			etypedef(tq);
+ 			writeln(tab1, 'text;')
+ 		end;
+ 
+ 	begin	(* eprogram *)
+ 		if tp^.tsubid <> nil then
+ 		    begin
+ 			(* program heading was seen *)
+ 			writeln('/', '*');
+ 			write('**	Code derived from program ');
+ 			printid(tp^.tsubid^.tsym^.lid);
+ 			writeln;
+ 			writeln('*', '/');
+ 			writeln(xtern, voidtyp, tab1, 'exit();')
+ 		    end;
+ 		if usecase or usesets or
+ 		   use(dinput) or use(doutput) or
+ 		   use(dwrite) or use(dwriteln) or use(dmessage) or
+ 		   use(deof) or use(deoln) or use(dflush) or use(dpage) or
+ 		   use(dread) or use(dreadln) or use(dclose) or
+ 		   use(dreset) or use(drewrite) or use(dget) or use(dput) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for i/o');
+ 			writeln('*', '/');
+ 			writeln(include, '<stdio.h>')	(* LIB *)
+ 		    end;
+ 		if use(dinput) or use(doutput) or use(dtext) then
+ 		    begin
+ 			etextdef;
+ 			if use(dinput) then
+ 			    begin
+ 				if tp^.tsubid = nil then
+ 					write(xtern);
+ 				write('text', tab1);
+ 				printid(defnams[dinput]^.lid);
+ 				if tp^.tsubid <> nil then
+ 					write(' = { stdin, 0, 0 }');
+ 				writeln(';')
+ 			    end;
+ 			if use(doutput) then
+ 			    begin
+ 				if tp^.tsubid = nil then
+ 					write(xtern);
+ 				write('text', tab1);
+ 				printid(defnams[doutput]^.lid);
+ 				if tp^.tsubid <> nil then
+ 					write(' = { stdout, 0, 0 }');
+ 				writeln(';')
+ 			    end
+ 		    end;
+ 		if use(dinput) or use(dget) or use(dread) or use(dreadln) or
+ 		   use(deof) or use(deoln) or use(dreset) or use(drewrite) then
+ 		    begin
+ 			writeln(define, 'Fread(x, f) ',
+ 				'fread((char *)&x, sizeof(x), 1, f)'); (* LIB *)
+ 			writeln(define, 'Get(f) Fread((f).buf, (f).fp)');
+ 			writeln(define, 'Getx(f) (f).init = 1, ',
+ 				'(f).eoln = (((f).buf = ',
+ 					'fgetc((f).fp)',	(* LIB *)
+ 					') == ', nlchr, ') ? (((f).buf = ',
+ 						spchr, '), 1) : 0');
+ 			writeln(define, 'Getchr(f) (f).buf, Getx(f)')
+ 		    end;
+ 		if use(dread) or use(dreadln) then
+ 		    begin
+ 			writeln(static, 'FILE', tab1, '*Tmpfil;');
+ 			writeln(static, 'long', tab1, 'Tmplng;');
+ 			writeln(static, 'double', tab1, 'Tmpdbl;');
+ 			writeln(define, 'Fscan(f) (f).init ? ',
+ 				'ungetc((f).buf, (f).fp)',	(* LIB *)
+ 					' : 0, Tmpfil = (f).fp');
+ 			writeln(define, 'Scan(p, a) ',
+ 				'Scanck(fscanf(Tmpfil, p, a))'); (* LIB *)
+ 			writeln(voidtyp, tab1, 'Scanck();');
+ 			if use(dreadln) then
+ 				writeln(voidtyp, tab1, 'Getl();');
+ 		    end;
+ 		if use(deoln) then
+ 			writeln(define, 'Eoln(f) ((f).eoln ? true : false)');
+ 		if use(deof) then
+ 			writeln(define, 'Eof(f) ',
+ 				'((((f).init == 0) ? (Get(f)) : 0, ',
+ 					'((f).eof ? 1 : ',
+ 						'feof((f).fp))) ? ', (* LIB *)
+ 							'true : false)');
+ 		if use(doutput) or use(dput) or
+ 				use(dwrite) or use(dwriteln) or
+ 				use(dreset) or use(drewrite) or use(dclose) then
+ 		    begin
+ 			writeln(define, 'Fwrite(x, f) ',
+ 				'fwrite((char *)&x, sizeof(x), 1, f)');(* LIB *)
+ 			writeln(define, 'Put(f) Fwrite((f).buf, (f).fp)');
+ 			writeln(define, 'Putx(f) (f).eoln = ((f).buf == ',
+ 			    nlchr, '), ', voidcast,
+ 				'fputc((f).buf, (f).fp)'); (* LIB *)
+ 			writeln(define, 'Putchr(c, f) (f).buf = (c), Putx(f)');
+ 			writeln(define, 'Putl(f, v) (f).eoln = v')
+ 		    end;
+ 		if use(dreset) or use(drewrite) or use(dclose) then
+ 			writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
+ 				'(Putchr(', nlchr, ', f), 0) : 0, ',
+ 					'rewind((f).fp)');	(* LIB *)
+ 		if use(dclose) then
+ 		    begin
+ 			writeln(define, 'Close(f) (f).init = ',
+ 				'((f).init ? (',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL');
+ 			writeln(define, 'Closex(f) (f).init = ',
+ 				'((f).init ? ',
+ 					'(Finish(f), ',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL')
+ 		    end;
+ 		if use(dreset) then
+ 		    begin
+ 			writeln(ifdef, 'READONLY');
+ 			writeln(static, chartyp, tab1, 'Rmode[] = "r";');
+ 			writeln(elsif);
+ 			writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
+ 			writeln(endif);
+ 			writeln(define, 'Reset(f, n) (f).init = ',
+ 			    '(f).init ? rewind((f).fp) : ',	(* LIB *)
+ 				'(((f).fp = Fopen(n, Rmode)), 1), ',
+ 					'(f).eof = (f).out = 0, Get(f)');
+ 			writeln(define, 'Resetx(f, n) (f).init = ',
+ 			    '(f).init ? (Finish(f)) : ',
+ 				'(((f).fp = Fopen(n, Rmode)), 1), ',
+ 					'(f).eof = (f).out = 0, Getx(f)');
+ 			usefopn := true
+ 		    end;
+ 		if use(drewrite) then
+ 		    begin
+ 			writeln(ifdef, 'WRITEONLY');
+ 			writeln(static, chartyp, tab1, 'Wmode[] = "w";');
+ 			writeln(elsif);
+ 			writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
+ 			writeln(endif);
+ 			writeln(define, 'Rewrite(f, n) (f).init = ',
+ 			    '(f).init ? rewind((f).fp) : ',	(* LIB *)
+ 				'(((f).fp = Fopen(n, Wmode)), 1), ',
+ 					'(f).out = (f).eof = 1');
+ 			writeln(define, 'Rewritex(f, n) (f).init = ',
+ 			    '(f).init ? (Finish(f)) : ',
+ 				'(((f).fp = Fopen(n, Wmode)), 1), ',
+ 					'(f).out = (f).eof = (f).eoln = 1');
+ 			usefopn := true
+ 		    end;
+ 		if usefopn then
+ 		    begin
+ 			writeln('FILE	*Fopen();');
+ 			writeln(define, 'MAXFILENAME 256')
+ 		    end;
+ 		if usecase or usejmps then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for case-statements');
+ 			writeln('**	and for non-local gotos');
+ 			writeln('*', '/');
+ 			writeln(define, 'Line __LINE__');
+ 			writeln(voidtyp, tab1, 'Caseerror();')
+ 		    end;
+ 		if usejmps then
+ 		    begin
+ 			writeln(include, '<setjmp.h>');	(* LIB *)
+ 			writeln(static, 'struct Jb { jmp_buf', tab1, 'jb; } J[',
+ 							(maxlevel+1):1, '];')
+ 		    end;
+ 		if use(dinteger) or use(dmaxint) or 
+ 			use(dboolean) or use(dfalse) or use(dtrue) or
+ 				use(deof) or use(deoln) or use(dexp) or
+ 				use(dln) or use(dsqr) or use(dsin) or
+ 				use(dcos) or use(dtan) or use(darctan) or
+ 				use(dsqrt) or use(dreal) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for standard types');
+ 			writeln('*', '/')
+ 		    end;
+ 		if usecomp then
+ 		    begin
+ 			writeln(xtern, inttyp, ' strncmp();');	(* LIB *)
+ 			writeln(define,
+ 				'Cmpstr(x, y) ',
+ 				'strncmp((x), (y), sizeof(x))')	(* LIB *)
+ 		    end;
+ 		if use(dboolean) or use(dfalse) or use(dtrue) or
+ 			use(deof) or use(deoln) or usesets then
+ 		    begin
+ 			capital(defnams[dboolean]);
+ 			write(typdef, chartyp, tab1);
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(';');
+ 			capital(defnams[dfalse]);
+ 			write(define);
+ 			printid(defnams[dfalse]^.lid);
+ 			write(' (');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(')0');
+ 			capital(defnams[dtrue]);
+ 			write(define);
+ 			printid(defnams[dtrue]^.lid);
+ 			write(' (');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(')1');
+ 			writeln(xtern, chartyp, tab1, '*Bools[];')
+ 		    end;
+ 		capital(defnams[dinteger]);
+ 		if use(dinteger) then
+ 		    begin
+ 			write(typdef, inttyp, tab1);
+ 			printid(defnams[dinteger]^.lid);
+ 			writeln(';')
+ 		    end;
+ 		if use(dmaxint) then
+ 			writeln(define, 'maxint', tab1, maxint:1);
+ 		capital(defnams[dreal]);
+ 		if use(dreal) then
+ 		    begin
+ 			write(typdef, realtyp, tab1);
+ 			printid(defnams[dreal]^.lid);
+ 			writeln(';')
+ 		    end;
+ 		if use(dexp) then
+ 			writeln(xtern, doubletyp, ' exp();');	(* LIB *)
+ 		if use(dln) then
+ 			writeln(xtern, doubletyp, ' log();');	(* LIB *)
+ 		if use(dsqr) then
+ 			writeln(xtern, doubletyp, ' pow();');	(* LIB *)
+ 		if use(dsin) then
+ 			writeln(xtern, doubletyp, ' sin();');	(* LIB *)
+ 		if use(dcos) then
+ 			writeln(xtern, doubletyp, ' cos();');	(* LIB *)
+ 		if use(dtan) then
+ 			writeln(xtern, doubletyp, ' tan();');	(* LIB *)
+ 		if use(darctan) then
+ 			writeln(xtern, doubletyp, ' atan();');	(* LIB *)
+ 		if use(dsqrt) then
+ 			writeln(xtern, doubletyp, ' sqrt();');	(* LIB *)
+ 		if use(dabs) and use(dreal) then
+ 			writeln(xtern, doubletyp, ' fabs();');	(* LIB *)
+ 		if use(dhalt) then
+ 			writeln(xtern, voidtyp, ' abort();');	(* LIB *)
+ 		if use(dnew) or usenilp then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for pointers');
+ 			writeln('*', '/');
+ 		    end;
+ 		if use(dnew) then
+ 		    begin
+ 			writeln(ifndef, 'Unionoffs');
+ 			writeln(define, 'Unionoffs(p, m) ',
+ 			    '(((long)(&(p)->m))-((long)(p)))');	(* CPU *)
+ 			writeln(endif)
+ 		    end;
+ 		if usenilp then
+ 			writeln(define, 'NIL 0');		(* CPU *)
+ 		if use(dnew) then
+ 			writeln(xtern, chartyp, ' *malloc();');	(* LIB *)
+ 		if use(ddispose) then
+ 			writeln(xtern, voidtyp, ' free();');	(* LIB *)
+ 		if usesets then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for set-operations');
+ 			writeln('*', '/');
+ 			writeln(define, 'Claimset() ',
+ 				voidcast, 'Currset(0, (', setptyp, ')0)');
+ 			writeln(define, 'Newset() ',
+ 					'Currset(1, (', setptyp, ')0)');
+ 			writeln(define, 'Saveset(s) Currset(2, s)');
+ 			writeln(define, 'setbits ', setbits:1);
+ 			writeln(typdef, wordtype, tab1, setwtyp, ';');
+ 			writeln(typdef, setwtyp, ' *', tab1, setptyp, ';');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(tab1, 'Member(), Le(), Ge(), Eq(), Ne();');
+ 			writeln(setptyp, tab1, 'Union(), Diff();');
+ 			writeln(setptyp, tab1, 'Insmem(), Mksubr();');
+ 			writeln(setptyp, tab1, 'Currset(), Inter();');
+ 			writeln(static, setptyp, tab1, 'Tmpset;');
+ 			writeln(xtern, setptyp, tab1, 'Conset[];');
+ 			writeln(voidtyp, tab1, 'Setncpy();')
+ 		    end;
+ 		writeln(xtern, chartyp, ' *strncpy();');	(* LIB *)
+ 		if use(dargc) or use(dargv) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for argv-operations');
+ 			writeln('*', '/');
+ 			writeln(inttyp, tab1, 'argc;');		(* OS *)
+ 			writeln(chartyp, tab1, '**argv;');
+ 			writeln(' void');
+ 			writeln('Argvgt(n, cp, l)');
+ 			writeln(inttyp, tab1, 'n;');
+ 			writeln(registr, inttyp, tab1, 'l;');
+ 			writeln(registr, chartyp, tab1, '*cp;');
+ 			writeln('{');
+ 			writeln(tab1, registr, chartyp, tab1, '*sp;');
+ 			writeln;
+ 			writeln(tab1, 'for (sp = argv[n]; l > 0 && *sp; l--)');
+ 			writeln(tab2, '*cp++ = *sp++;');
+ 			writeln(tab1, 'while (l-- > 0)');
+ 			writeln(tab2, '*cp++ = ', spchr, ';');
+ 			writeln('}');
+ 		    end;
+ 		if (tp^.tsubconst <> nil) or (tp^.tsubtype<> nil) or
+ 			(tp^.tsubvar <> nil) or (tp^.tsubsub <> nil) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Start of program definitions');
+ 			writeln('*', '/');
+ 		    end;
+ 		econst(tp^.tsubconst);
+ 		etype(tp^.tsubtype);
+ 		evar(tp^.tsubvar);
+ 		if tp^.tsubsub <> nil then
+ 			writeln;
+ 		esubr(tp^.tsubsub);
+ 		if tp^.tsubid <> nil then
+ 		    begin
+ 			(* program heading was seen *)
+ 			writeln('/', '*');
+ 			writeln('**	Start of program code');
+ 			writeln('*', '/');
+ 			if use(dargc) or use(dargv) then
+ 			    begin
+ 				writeln('main(_ac, _av)');	(* OS *)
+ 				writeln(inttyp, tab1, '_ac;');
+ 				writeln(chartyp, tab1, '*_av[];');
+ 				writeln('{');
+ 				writeln;
+ 				writeln(tab1, 'argc = _ac;');
+ 				writeln(tab1, 'argv = _av;')
+ 			    end
+ 			else begin
+ 				writeln('main()');
+ 				writeln('{')
+ 			     end;
+ 			increment;
+ 			elabel(tp);
+ 			estmt(tp^.tsubstmt);
+ 			indent;
+ 			writeln('exit(0);');
+ 			decrement;
+ 			writeln('}');
+ 			writeln('/', '*');
+ 			writeln('**	End of program code');
+ 			writeln('*', '/')
+ 		    end
+ 	end;	(* eprogram *)
+ 
+ 	(*	Emit definitions for constant sets	*)
+ 	procedure econset(tp : treeptr; len : integer);
+ 
+ 	var	i	: integer;
+ 
+ 		function size(tp : treeptr) : integer;
+ 
+ 		var	r, x	: integer;
+ 
+ 		begin
+ 			r := 0;
+ 			while tp <> nil do
+ 			    begin
+ 				if tp^.tt = nrange then
+ 					x := cvalof(tp^.texpr)
+ 				else if tp^.tt = nempty then
+ 					x := 0
+ 				else
+ 					x := cvalof(tp);
+ 				if x > r then
+ 					r := x;
+ 				tp := tp^.tnext
+ 			    end;
+ 			size := csetwords(r+1)
+ 		end;
+ 
+ 		(*	Emit bits in a constant set	*)
+ 		procedure ebits(tp : treeptr);
+ 
+ 		type	bitset	= set of 0 .. setbits;
+ 
+ 		var	sets	: array [ 0 .. maxsetrange ] of bitset;
+ 			s, m, n	: integer;
+ 
+ 			procedure eword(s : bitset);
+ 
+ 			const	bitshex	= 4;	(* nr of bits in a hex-digit *)
+ 
+ 			var	n, i	: integer;
+ 				x	: 0 .. setbits;
+ 
+ 			begin
+ 				n := 0;
+ 				while n <= setbits do
+ 					n := n + bitshex;
+ 				n := n - bitshex;
+ 				while n >= 0 do
+ 				    begin
+ 					(* compute 1 hexdigit *)
+ 					x := 0;
+ 					for i := 0 to bitshex - 1 do
+ 						if (n + i) in s then
+ 							case i of
+ 							  0:	x := x + 1;
+ 							  1:	x := x + 2;
+ 							  2:	x := x + 4;
+ 							  3:	x := x + 8
+ 							end;(* case *)
+ 					(* print it *)
+ 					write(hexdig[x]);
+ 					n := n - bitshex
+ 				    end
+ 			end;
+ 
+ 		begin
+ 			s := size(tp);
+ 			for n := 0 to s - 1 do
+ 				sets[n] := [];
+ 			while tp <> nil do
+ 			    begin
+ 				if tp^.tt = nrange then
+ 					for m := cvalof(tp^.texpl) to
+ 							cvalof(tp^.texpr) do
+ 					    begin
+ 						n := m div (setbits+1);
+ 						sets[n] := sets[n] +
+ 							[m mod (setbits+1)]
+ 					    end
+ 				else if tp^.tt <> nempty then
+ 				    begin
+ 					m := cvalof(tp);
+ 					n := m div (setbits+1);
+ 					sets[n] := sets[n] +
+ 						[m mod (setbits+1)]
+ 				    end;
+ 				tp := tp^.tnext
+ 			    end;
+ 			write(tab1, s:1);
+ 			for n := 0 to s - 1 do
+ 			    begin
+ 				write(',');
+ 				if n mod 6 = 0 then
+ 					writeln;
+ 				write(tab1, '0x');
+ 				eword(sets[n]);
+ 			    end;
+ 			writeln
+ 		end;
+ 
+ 	begin
+ 		i := 0;
+ 		while tp <> nil do
+ 		    begin
+ 			writeln(static, setwtyp, tab1, 'Q', i:1, '[] = {');
+ 			ebits(tp^.texps);
+ 			writeln('};');
+ 			i := i + 1;
+ 			tp := tp^.tnext
+ 		    end;
+ 		writeln(static, setwtyp, tab1, '*Conset[] = {');
+ 		for i := len - 1 downto 1 do
+ 		    begin
+ 			write(tab1, 'Q', i:1, ',');
+ 			if i mod 6 = 5 then
+ 				writeln
+ 		    end;
+ 		writeln(tab1, 'Q0');
+ 		writeln('};');
+ 	end;
+ 
+ begin	(* emit *)
+ 	indnt := 0;
+ 	varno := 0;
+ 	conflag := false;
+ 	setused := false;
+ 	dropset := false;
+ 	doarrow := 0;
+ 	eprogram(top);
+ 	if usebool then
+ 		writeln(chartyp, tab1, '*Bools[] = { "false", "true" };');
+ 	if usescan then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Scanck(n)');
+ 		writeln(inttyp, tab1, 'n;');
+ 		writeln('{');
+ 		writeln(tab1, 'if (n != 1) {');
+ 		writeln(tab2, voidcast, 'fprintf(stderr, "Bad input\n");');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln('}')
+ 	    end;
+ 	if usegetl then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Getl(f)');
+ 		writeln(' text', tab1, '*f;');
+ 		writeln('{');
+ 		writeln(tab1, 'while (f->eoln == 0)');
+ 		writeln(tab2, 'Getx(*f);');
+ 		writeln(tab1, 'Getx(*f);');
+ 		writeln('}')
+ 	    end;
+ 	if usefopn then
+ 	    begin
+ 		writeln;
+ 		writeln(static, 'FILE *');
+ 		writeln('Fopen(n, m)');
+ 		writeln(chartyp, tab1, '*n, *m;');
+ 		writeln('{');
+ 		writeln(tab1, 'FILE', tab2, '*f;');
+ 		writeln(tab1, registr, chartyp, tab1, '*s;');
+ 		writeln(tab1, static, chartyp, tab1, 'ch = ',
+ 						quote, 'A', quote, ';');
+ 		writeln(tab1, static, chartyp, tab1, 'tmp[MAXFILENAME];');
+ 		writeln(tab1, xtern , inttyp, tab1, 'unlink();'); (* OS *)
+ 		writeln;
+ 		writeln(tab1, 'if (n == NULL)');
+ 		writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
+ 		writeln(tab1, 'else {');
+ 		writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
+ 		writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
+ 			spchr, ' || *s == ', nulchr, '; )');
+ 		writeln(tab3, '*s-- = ', nulchr, ';');
+ 		writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
+ 		writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
+ 			quote, '%s', quote, '\n", n);');
+ 		writeln(tab3, 'exit(1);');
+ 		writeln(tab2, '}');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 's = tmp;');
+ 		writeln(tab1, 'if ((f = fopen(s, m)) == NULL) {');
+ 		writeln(tab2, voidcast,
+ 				'fprintf(stderr, "Cannot open: %s\n", s);');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'if (n == NULL)');
+ 		writeln(tab2, 'unlink(tmp);');	(* OS *)
+ 		writeln(tab1, 'return (f);');
+ 		writeln('}');
+ 		writeln(xtern, inttyp, tab1, 'rewind();')
+ 	    end;
+ 	if setcnt > 0 then
+ 		econset(setlst, setcnt);
+ 	if useunion then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Union(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'j = *p1;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'if (j > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, 'else');
+ 		writeln(tab2, '*p3 = *p2;');
+ 		writeln(tab1, 'k = *p1 - *p2;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ | *p2++);');
+ 		writeln(tab1, 'while (k > 0) {');
+ 		writeln(tab2, '*p3++ = *p1++;');
+ 		writeln(tab2, 'k--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (k < 0) {');
+ 		writeln(tab2, '*p3++ = *p2++;');
+ 		writeln(tab2, 'k++;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if usediff then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Diff(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'j = *p1;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'if (j > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, 'k = *p1 - *p2;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ & ~ (*p2++));');
+ 		writeln(tab1, 'while (k > 0) {');
+ 		writeln(tab2, '*p3++ = *p1++;');
+ 		writeln(tab2, 'k--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if useintr then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Inter(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'if ((j = *p1) > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ & *p2++);');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if usememb then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Member(m, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, usigned, inttyp,
+ 					tab1, 'i = m / (setbits+1) + 1;');
+ 		writeln;
+ 		writeln(tab1, 'if ((i <= *sp) &&',
+ 					' (sp[i] & (1 << (m % (setbits+1)))))');
+ 		write(tab2, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if useseq or usesne then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Eq(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if (*p1++ != *p2++)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (i != 0) {');
+ 		writeln(tab2, 'if (*p1++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (j != 0) {');
+ 		writeln(tab2, 'if (*p2++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'j--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usesne then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Ne(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		write(tab1, 'return (!Eq(p1, p2));');
+ 		writeln('}')
+ 	    end;
+ 	if usesle then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Le(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if ((*p1++ & ~ *p2++) != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (i != 0) {');
+ 		writeln(tab2, 'if (*p1++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usesge then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Ge(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if ((*p2++ & ~ *p1++) != 0)');
+ 		writeln(tab3, 'return (false);');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (j != 0) {');
+ 		writeln(tab2, 'if (*p2++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'j--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usemksub then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Mksubr(lo, hi, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'lo, hi;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, k;');
+ 		writeln;
+ 		writeln(tab1, 'if (hi < lo)');
+ 		writeln(tab2, 'return (sp);');
+ 		writeln(tab1, 'i = hi / (setbits+1) + 1;');
+ 		writeln(tab1, 'for (k = *sp + 1; k <= i; k++)');
+ 		writeln(tab2, 'sp[k] = 0;');
+ 		writeln(tab1, 'if (*sp < i)');
+ 		writeln(tab2, '*sp = i;');
+ 		writeln(tab1, 'for (k = lo; k <= hi; k++)');
+ 		writeln(tab2, 'sp[k / (setbits+1) + 1] |= ',
+ 						'(1 << (k % (setbits+1)));');
+ 		writeln(tab1, 'return (sp);');
+ 		writeln('}')
+ 	    end;
+ 	if useins then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Insmem(m, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i,');
+ 		writeln(tab3, tab1, 'j = m / (setbits+1) + 1;');
+ 		writeln;
+ 		writeln(tab1, 'if (*sp < j)');
+ 		writeln(tab2, 'for (i = *sp + 1, *sp = j; i <= *sp; i++)');
+ 		writeln(tab3, 'sp[i] = 0;');
+ 		writeln(tab1, 'sp[j] |= (1 << (m % (setbits+1)));');
+ 		writeln(tab1, 'return (sp);');
+ 		writeln('}')
+ 	    end;
+ 	if usesets then
+ 	    begin
+ 		writeln;
+ 		writeln(ifndef, 'SETSPACE');
+ 		writeln(define, 'SETSPACE 256');
+ 		writeln(endif);
+ 		writeln(static, setptyp);
+ 		writeln('Currset(n,sp)');
+ 		writeln(tab1, inttyp, tab1, 'n;');
+ 		writeln(tab1, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, static, setwtyp, tab1, 'Space[SETSPACE];');
+ 		writeln(tab1, static, setptyp, tab1, 'Top = Space;');
+ 		writeln;
+ 		writeln(tab1, 'switch (n) {');
+ 		writeln(tab1, '  case 0:');
+ 		writeln(tab2, 'Top = Space;');
+ 		writeln(tab2, 'return (0);');
+ 		writeln(tab1, '  case 1:');
+ 		writeln(tab2, 'if (&Space[SETSPACE] - Top <= ',
+ 							maxsetrange:1, ') {');
+ 		writeln(tab3,
+ 			voidcast, 'fprintf(stderr, "Set-space exhausted\n");');
+ 		writeln(tab3, 'exit(1);');
+ 		writeln(tab2, '}');
+ 		writeln(tab2, '*Top = 0;');
+ 		writeln(tab2, 'return (Top);');
+ 		writeln(tab1, '  case 2:');
+ 		writeln(tab2, 'if (Top <= &sp[*sp])');
+ 		writeln(tab3, 'Top = &sp[*sp + 1];');
+ 		writeln(tab2, 'return (sp);');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, '/', '* NOTREACHED *', '/');
+ 		writeln('}')
+ 	    end;
+ 	if usescpy then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Setncpy(S1, S2, N)');
+ 		writeln(tab1, registr, setptyp, tab1, 'S1, S2;');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'N;');
+ 		writeln('{');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln;
+ 		writeln(tab1, 'N /= sizeof(', setwtyp, ');');
+ 		writeln(tab1, '*S1++ = --N;');
+ 		writeln(tab1, 'm = *S2++;');
+ 		writeln(tab1, 'while (m != 0 && N != 0) {');
+ 		writeln(tab2, '*S1++ = *S2++;');
+ 		writeln(tab2, '--N;');
+ 		writeln(tab2, '--m;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (N-- != 0)');
+ 		writeln(tab2, '*S1++ = 0;');
+ 		writeln('}')
+ 	    end;
+ 	if usecase then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Caseerror(n)');
+ 		writeln(tab1, inttyp, tab1, 'n;');
+ 		writeln('{');
+ 		writeln(tab1, voidcast,
+ 			'fprintf(stderr, "Missing case limb: line %d\n", n);');
+ 		writeln(tab1, 'exit(1);');
+ 		writeln('}')
+ 	    end;
+ 	if usemax then
+ 	    begin
+ 		writeln;
+ 		writeln(static, inttyp);
+ 		writeln('Max(m, n)');
+ 		writeln(tab1, inttyp, tab1, 'm, n;');
+ 		writeln('{');
+ 		writeln(tab1, 'if (m > n)');
+ 		writeln(tab2, 'return (m);');
+ 		writeln(tab1, 'return (n);');
+ 		writeln('}')
+ 	    end;
+ 	if use(dtrunc) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Trunc(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, 'return f;');
+ 		writeln('}')
+ 	    end;
+ 	if use(dround) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Round(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, xtern, doubletyp, ' floor();');	(* LIB *)
+ 		writeln(tab1,
+ 			'return floor(', dblcast, '(0.5+f));');	(* LIB *)
+ 		writeln('}')
+ 	    end
+ end;	(* emit *)
+ 
+ (*	Initialize all global structures used in translator.		*)
+ procedure initialize;
+ 
+ var	s	: hashtyp;
+ 	t	: pretyps;
+ 	d	: predefs;
+ 
+ 	(*	Define names in ctable.					*)
+ 	procedure defname(cn : cnames; str : keyword);
+ 
+ 	label	999;
+ 
+ 	var	w	: toknbuf;
+ 		i	: toknidx;
+ 
+ 	begin
+ 		unpack(str, w, 1);
+ 		for i := 1 to keywordlen do
+ 			if w[i] = space then
+ 			    begin
+ 				w[i] := chr(null);
+ 				goto 999
+ 			    end;
+ 		w[keywordlen+1] := chr(null);
+ 	999:
+ 		ctable[cn] := saveid(w)
+ 	end;
+ 
+ 	(*	Define predefined identifiers.				*)
+ 	procedure defid(nt : treetyp; did : predefs; str : keyword);
+ 
+ 	label	999;
+ 
+ 	var	w	: toknbuf;
+ 		i	: toknidx;
+ 		tp, tq,
+ 		tv	: treeptr;
+ 
+ 	begin
+ 		for i := 1 to keywordlen do
+ 			if str[i] = space then
+ 			    begin
+ 				w[i] := chr(null);
+ 				goto 999
+ 			    end
+ 			else
+ 				w[i] := str[i];
+ 		w[keywordlen+1] := chr(null);
+ 	999:
+ 		tp := newid(saveid(w));
+ 		defnams[did] := tp^.tsym;
+ 		if nt in [ntype, nfunc, nproc] then
+ 		    begin
+ 			(* predefined types, procedures and functions
+ 				are marked with a particular node *)
+ 			tv := mknode(npredef);
+ 			tv^.tdef := did;
+ 			tv^.tobtyp := tnone
+ 		    end
+ 		else
+ 			tv := nil; (* predefined constants and variables will
+ 					eventually be bound to something *)
+ 		case nt of
+ 		  nscalar:
+ 		    begin
+ 			tv := mknode(nscalar);
+ 			tv^.tscalid := nil;
+ 			tq := mknode(ntype);
+ 			tq^.tbind := tv;
+ 			tq^.tidl := tp;
+ 			tp := tq
+ 		    end;
+ 		  nconst,
+ 		  ntype,
+ 		  nfield,
+ 		  nvar:
+ 		    begin
+ 			tq := mknode(nt);
+ 			tq^.tbind := tv;
+ 			tq^.tidl := tp;
+ 			tq^.tattr := anone;
+ 			tp := tq
+ 		    end;
+ 		  nfunc,
+ 		  nproc:
+ 		    begin
+ 			tq := mknode(nt);
+ 			tq^.tsubid := tp;
+ 			tq^.tsubstmt := tv;
+ 			tq^.tfuntyp := nil;
+ 			tq^.tsubpar := nil;
+ 			tq^.tsublab := nil;
+ 			tq^.tsubconst := nil;
+ 			tq^.tsubtype := nil;
+ 			tq^.tsubvar := nil;
+ 			tq^.tsubsub := nil;
+ 			tq^.tscope := nil;
+ 			tq^.tstat := 0;
+ 			tp := tq
+ 		    end;
+ 		  nid:
+ 		end;(* case *)
+ 		deftab[did] := tp
+ 	end;	(* defid *)
+ 
+ 	(*	Define keywords.					*)
+ 	procedure defkey(s : symtyp; w : keyword);
+ 
+ 	var	i	: 1 .. keywordlen;
+ 
+ 	begin
+ 		for i := 1 to keywordlen do
+ 			if w[i] = space then
+ 				w[i] := chr(null);
+ 		(* relies on symtyp being sorted *)
+ 		with keytab[ord(s)] do
+ 		    begin
+ 			wrd := w;
+ 			sym := s
+ 		    end;
+ 	end;
+ 
+ 	procedure fixinit(i : strindx);
+ 
+ 	var	t	: toknbuf;
+ 
+ 	begin
+ 		gettokn(i, t);
+ 		t[1] := 'i';
+ 		puttokn(i, t);
+ 	end;
+ 
+ 	(*	Add a cpu word type description.			*)
+ 	(*	Parameters lo and hi gives the range of a machine-	*)
+ 	(*	dependant integer type. Parameter str gives the corres-	*)
+ 	(*	ponding C-language type-name.				*)
+ 	procedure defmach(lo, hi : integer; str : machdefstr);
+ 
+ 	label	999;
+ 
+ 	var	i	: toknidx;
+ 		w	: toknbuf;
+ 
+ 	begin
+ 		unpack(str, w, 1);
+ 		if w[machdeflen] <> space then
+ 			error(ebadmach);
+ 		for i := machdeflen - 1 downto 1 do
+ 			if w[i] <> space then
+ 			    begin
+ 				w[i+1] := chr(null);
+ 				goto 999
+ 			    end;
+ 		error(ebadmach);
+ 	999:
+ 		if nmachdefs >= maxmachdefs then
+ 			error(emanymachs);
+ 		nmachdefs := nmachdefs + 1;
+ 		with machdefs[nmachdefs] do
+ 		    begin
+ 			lolim := lo;
+ 			hilim := hi;
+ 			typstr := savestr(w)
+ 		    end
+ 	end;
+ 
+ 	procedure initstrstore;
+ 
+ 	var	i	: strbcnt;
+ 
+ 	begin
+ 		for i := 1 to maxblkcnt do
+ 			strstor[i] := nil;
+ 		new(strstor[0]);
+ 		strstor[0]^[0] := chr(null);
+ 		strfree := 1;
+ 		strleft := maxstrblk
+ 	end;
+ 
+ begin	(* initialize *)
+ 	lineno := 1;
+ 	colno := 0;
+ 
+ 	initstrstore;
+ 
+ 	setlst := nil;
+ 	setcnt := 0;
+ 	hexdig := '0123456789ABCDEF';
+ 
+ 	symtab := nil;
+ 	statlvl := 0;
+ 	maxlevel := -1;
+ 	enterscope(nil);
+ 	varno:= 0;
+ 
+ 	usenilp := false;
+ 
+ 	usesets := false;
+ 	useunion := false;
+ 	usediff := false;
+ 	usemksub := false;
+ 	useintr := false;
+ 	usesge := false;
+ 	usesle := false;
+ 	usesne := false;
+ 	useseq := false;
+ 	usememb := false;
+ 	useins := false;
+ 	usescpy := false;
+ 	usefopn := false;
+ 	usescan := false;
+ 	usegetl := false;
+ 
+ 	usecase := false;
+ 	usejmps := false;
+ 
+ 	usebool := false;
+ 
+ 	usecomp := false;
+ 	usemax	:= false;
+ 
+ 	for s := 0 to hashmax do
+ 		idtab[s] := nil;
+ 	for d := dabs to dztring do
+ 	    begin
+ 		deftab[d] := nil;
+ 		defnams[d] := nil
+ 	    end;
+ 
+ 	(* Pascal keywords *)
+ 	defkey(sand,	'and       ');
+ 	defkey(sarray,	'array     ');
+ 	defkey(sbegin,	'begin     ');
+ 	defkey(scase,	'case      ');
+ 	defkey(sconst,	'const     ');
+ 	defkey(sdiv,	'div       ');
+ 	defkey(sdo,	'do        ');
+ 	defkey(sdownto,	'downto    ');
+ 	defkey(selse,	'else      ');
+ 	defkey(send,	'end       ');
+ 	defkey(sextern,	externsym);	(* non-standard *)
+ 	defkey(sfile,	'file      ');
+ 	defkey(sfor,	'for       ');
+ 	defkey(sforward,'forward   ');
+ 	defkey(sfunc,	'function  ');
+ 	defkey(sgoto,	'goto      ');
+ 	defkey(sif,	'if        ');
+ 	defkey(sinn,	'in        ');
+ 	defkey(slabel,	'label     ');
+ 	defkey(smod,	'mod       ');
+ 	defkey(snil,	'nil       ');
+ 	defkey(snot,	'not       ');
+ 	defkey(sof,	'of        ');
+ 	defkey(sor,	'or        ');
+ 	defkey(sother,	othersym);	(* non-standard *)
+ 	defkey(spacked,	'packed    ');
+ 	defkey(sproc,	'procedure ');
+ 	defkey(spgm,	'program   ');
+ 	defkey(srecord,	'record    ');
+ 	defkey(srepeat,	'repeat    ');
+ 	defkey(sset,	'set       ');
+ 	defkey(sthen,	'then      ');
+ 	defkey(sto,	'to        ');
+ 	defkey(stype,	'type      ');
+ 	defkey(suntil,	'until     ');
+ 	defkey(svar,	'var       ');
+ 	defkey(swhile,	'while     ');
+ 	defkey(swith,	'with      ');
+ 	defkey(seof,	dummysym);	(* dummy entry *)
+ 
+ 	(* C language operator priorities *)
+ 	cprio[nformat]	:= 0;
+ 	cprio[nrange]	:= 0;
+ 	cprio[nin]	:= 0;
+ 	cprio[nset]	:= 0;
+ 	cprio[nassign]	:= 0;
+ 	cprio[nor]	:= 1;
+ 	cprio[nand]	:= 2;
+ 	cprio[neq]	:= 3;
+ 	cprio[nne]	:= 3;
+ 	cprio[nlt]	:= 3;
+ 	cprio[nle]	:= 3;
+ 	cprio[ngt]	:= 3;
+ 	cprio[nge]	:= 3;
+ 	cprio[nplus]	:= 4;
+ 	cprio[nminus]	:= 4;
+ 	cprio[nmul]	:= 5;
+ 	cprio[ndiv]	:= 5;
+ 	cprio[nmod]	:= 5;
+ 	cprio[nquot]	:= 5;
+ 	cprio[nnot]	:= 6;
+ 	cprio[numinus]	:= 6;
+ 	cprio[nuplus]	:= 7;
+ 	cprio[nindex]	:= 7;
+ 	cprio[nselect]	:= 7;
+ 	cprio[nderef]	:= 7;
+ 	cprio[ncall]	:= 7;
+ 	cprio[nid]	:= 7;
+ 	cprio[nchar]	:= 7;
+ 	cprio[ninteger]	:= 7;
+ 	cprio[nreal]	:= 7;
+ 	cprio[nstring]	:= 7;
+ 	cprio[nnil]	:= 7;
+ 
+ 	(* Pascal language operator priorities *)
+ 	pprio[nassign]	:= 0;
+ 	pprio[nformat]	:= 0;
+ 	pprio[nrange]	:= 1;
+ 	pprio[nin]	:= 1;
+ 	pprio[neq]	:= 1;
+ 	pprio[nne]	:= 1;
+ 	pprio[nlt]	:= 1;
+ 	pprio[nle]	:= 1;
+ 	pprio[ngt]	:= 1;
+ 	pprio[nge]	:= 1;
+ 	pprio[nor]	:= 2;
+ 	pprio[nplus]	:= 2;
+ 	pprio[nminus]	:= 2;
+ 	pprio[nand]	:= 3;
+ 	pprio[nmul]	:= 3;
+ 	pprio[ndiv]	:= 3;
+ 	pprio[nmod]	:= 3;
+ 	pprio[nquot]	:= 3;
+ 	pprio[nnot]	:= 4;
+ 	pprio[numinus]	:= 4;
+ 	pprio[nuplus]	:= 5;
+ 	pprio[nset]	:= 6;
+ 	pprio[nindex]	:= 6;
+ 	pprio[nselect]	:= 6;
+ 	pprio[nderef]	:= 6;
+ 	pprio[ncall]	:= 6;
+ 	pprio[nid]	:= 6;
+ 	pprio[nchar]	:= 6;
+ 	pprio[ninteger]	:= 6;
+ 	pprio[nreal]	:= 6;
+ 	pprio[nstring]	:= 6;
+ 	pprio[nnil]	:= 6;
+ 
+ 	(* table of C keywords/functions (which Pascal doesn't know about) *)
+ 	defname(cabort,		'abort     ');	(* OS *)
+ 	defname(cbreak,		'break     ');
+ 	defname(ccontinue,	'continue  ');
+ 	defname(cdefine,	'define    ');
+ 	defname(cdefault,	'default   ');
+ 	defname(cdouble,	'double    ');
+ 	defname(cedata,		'edata     ');	(* OS *)
+ 	defname(cenum,		'enum      ');
+ 	defname(cetext,		'etext     ');	(* OS *)
+ 	defname(cextern,	'extern    ');
+ 	defname(cfclose,	'fclose    ');	(* LIB *)
+ 	defname(cfflush,	'fflush    ');	(* LIB *)
+ 	defname(cfgetc,		'fgetc     ');	(* LIB *)
+ 	defname(cfloat,		'float     ');
+ 	defname(cfloor,		'floor     ');	(* OS *)
+ 	defname(cfprintf,	'fprintf   ');	(* LIB *)
+ 	defname(cfputc,		'fputc     ');	(* LIB *)
+ 	defname(cfread,		'fread     ');	(* LIB *)
+ 	defname(cfscanf,	'fscanf    ');	(* LIB *)
+ 	defname(cfwrite,	'fwrite    ');	(* LIB *)
+ 	defname(cgetc,		'getc      ');	(* OS *)
+ 	defname(cgetpid,	'getpid    ');	(* OS *)
+ 	defname(cint,		'int       ');
+ 	defname(cinclude,	'include   ');
+ 	defname(clong,		'long      ');
+ 	defname(clog,		'log       ');	(* OS *)
+ 	defname(cmain,		'main      ');
+ 	defname(cmalloc,	'malloc    ');	(* LIB *)
+ 	defname(cprintf,	'printf    ');	(* LIB *)
+ 	defname(cpower,		'pow       ');	(* OS *)
+ 	defname(cputc,		'putc      ');	(* LIB *)
+ 	defname(cread,		'read      ');	(* OS *)
+ 	defname(creturn,	'return    ');
+ 	defname(cregister,	'register  ');
+ 	defname(crewind,	'rewind    ');	(* LIB *)
+ 	defname(cscanf,		'scanf     ');	(* LIB *)
+ 	defname(csetbits,	'setbits   ');
+ 	defname(csetword,	'setword   ');
+ 	defname(csetptr,	'setptr    ');
+ 	defname(cshort,		'short     ');
+ 	defname(csigned,	'signed    ');
+ 	defname(csizeof,	'sizeof    ');
+ 	defname(csprintf,	'sprintf   ');	(* LIB *)
+ 	defname(cstatic,	'static    ');
+ 	defname(cstdin,		'stdin     ');	(* LIB *)
+ 	defname(cstdout,	'stdout    ');	(* LIB *)
+ 	defname(cstderr,	'stderr    ');	(* LIB *)
+ 	defname(cstrncmp,	'strncmp   ');	(* OS *)
+ 	defname(cstrncpy,	'strncpy   ');	(* OS *)
+ 	defname(cstruct,	'struct    ');
+ 	defname(cswitch,	'switch    ');
+ 	defname(ctypedef,	'typedef   ');
+ 	defname(cundef,		'undef     ');
+ 	defname(cungetc,	'ungetc    ');	(* LIB *)
+ 	defname(cunion,		'union     ');
+ 	defname(cunlink,	'unlink    ');	(* OS *)
+ 	defname(cunsigned,	'unsigned  ');
+ 	defname(cwrite,		'write     ');	(* OS *)
+ 
+ 	(* create predefined identifiers *)
+ 	defid(nfunc,	dabs,		'abs       ');
+ 	defid(nfunc,	darctan,	'arctan    ');
+ 	defid(nvar,	dargc,		'argc      ');	(* OS *)
+ 	defid(nproc,	dargv,		'argv      ');	(* OS *)
+ 	defid(nscalar,	dboolean,	'boolean   ');
+ 	defid(ntype,	dchar,		'char      ');
+ 	defid(nfunc,	dchr,		'chr       ');
+ 	defid(nproc,	dclose,		'close     ');	(* OS *)
+ 	defid(nfunc,	dcos,		'cos       ');
+ 	defid(nproc,	ddispose,	'dispose   ');
+ 	defid(nid,	dfalse,		'false     ');
+ 	defid(nfunc,	deof,		'eof       ');
+ 	defid(nfunc,	deoln,		'eoln      ');
+ 	defid(nproc,	dexit,		'exit      ');	(* OS *)
+ 	defid(nfunc,	dexp,		'exp       ');
+ 	defid(nproc,	dflush,		'flush     ');	(* OS *)
+ 	defid(nproc,	dget,		'get       ');
+ 	defid(nproc,	dhalt,		'halt      ');	(* OS *)
+ 	defid(nvar,	dinput,		'input     ');
+ 	defid(ntype,	dinteger,	'integer   ');
+ 	defid(nfunc,	dln,		'ln        ');
+ 	defid(nconst,	dmaxint,	'maxint    ');
+ 	defid(nproc,	dmessage,	'message   ');	(* OS *)
+ 	defid(nproc,	dnew,		'new       ');
+ 	defid(nfunc,	dodd,		'odd       ');
+ 	defid(nfunc,	dord,		'ord       ');
+ 	defid(nvar,	doutput,	'output    ');
+ 	defid(nproc,	dpack,		'pack      ');
+ 	defid(nproc,	dpage,		'page      ');
+ 	defid(nfunc,	dpred,		'pred      ');
+ 	defid(nproc,	dput,		'put       ');
+ 	defid(nproc,	dread,		'read      ');
+ 	defid(nproc,	dreadln,	'readln    ');
+ 	defid(ntype,	dreal,		'real      ');
+ 	defid(nproc,	dreset,		'reset     ');
+ 	defid(nproc,	drewrite,	'rewrite   ');
+ 	defid(nfunc,	dround,		'round     ');
+ 	defid(nfunc,	dsin,		'sin       ');
+ 	defid(nfunc,	dsqr,		'sqr       ');
+ 	defid(nfunc,	dsqrt,		'sqrt      ');
+ 	defid(nfunc,	dsucc,		'succ      ');
+ 	defid(ntype,	dtext,		'text      ');
+ 	defid(nid,	dtrue,		'true      ');
+ 	defid(nfunc,	dtrunc,		'trunc     ');
+ 	defid(nfunc,	dtan,		'tan       ');
+ 	defid(nproc,	dunpack,	'unpack    ');
+ 	defid(nproc,	dwrite,		'write     ');
+ 	defid(nproc,	dwriteln,	'writeln   ');
+ 
+ 	defid(nfield,	dzinit,		'$nit      ');	(* for internal use *)
+ 	defid(ntype,	dztring,	'$ztring   ');
+ 
+ 	(* bind constants and variables *)
+ 	deftab[dboolean]^.tbind^.tscalid := deftab[dfalse];
+ 	deftab[dfalse]^.tnext := deftab[dtrue];
+ 	currsym.st := sinteger;
+ 	currsym.vint := maxint;
+ 	deftab[dmaxint]^.tbind := mklit;
+ 	deftab[dargc]^.tbind := deftab[dinteger]^.tbind;
+ 	deftab[dinput]^.tbind := deftab[dtext]^.tbind;
+ 	deftab[doutput]^.tbind := deftab[dtext]^.tbind;
+ 
+ 	for t := tnone to terror do
+ 	    begin
+ 		(* for predefined types: set up pointers to "npredef" nodes
+ 		   describing type, fill in constant identifying type *)
+ 		case t of
+ 		  tboolean:
+ 			typnods[t] := deftab[dboolean]; (* scalar type *)
+ 		  tchar:
+ 			typnods[t] := deftab[dchar]^.tbind;
+ 		  tinteger:
+ 			typnods[t] := deftab[dinteger]^.tbind;
+ 		  treal:
+ 			typnods[t] := deftab[dreal]^.tbind;
+ 		  ttext:
+ 			typnods[t] := deftab[dtext]^.tbind;
+ 		  tstring:
+ 			typnods[t] := deftab[dztring]^.tbind;
+ 		  tnil,
+ 		  tset,
+ 		  tpoly,
+ 		  tnone:
+ 			typnods[t] := mknode(npredef);
+ 		  terror:
+ 			(* no op *)
+ 		end;(* case *)
+ 		if t in [tchar, tinteger, treal, ttext, tnone, tpoly,
+ 						tstring, tnil, tset] then
+ 			typnods[t]^.tobtyp := t
+ 	    end;
+ 
+ 	(* fix name and type of field "init" *)
+ 	fixinit(defnams[dzinit]^.lid^.istr);
+ 	deftab[dzinit]^.tbind := deftab[dinteger]^.tbind;
+ 
+ 	for d := dabs to dztring do
+ 		linkup(nil, deftab[d]);
+ 
+ 	deftab[dchr]^.tfuntyp := typnods[tchar];
+ 
+ 	deftab[deof]^.tfuntyp := typnods[tboolean];
+ 	deftab[deoln]^.tfuntyp := typnods[tboolean];
+ 	deftab[dodd]^.tfuntyp := typnods[tboolean];
+ 
+ 	deftab[dord]^.tfuntyp := typnods[tinteger];
+ 	deftab[dround]^.tfuntyp := typnods[tinteger];
+ 	deftab[dtrunc]^.tfuntyp := typnods[tinteger];
+ 
+ 	deftab[darctan]^.tfuntyp := typnods[treal];
+ 	deftab[dcos]^.tfuntyp := typnods[treal];
+ 	deftab[dsin]^.tfuntyp := typnods[treal];
+ 	deftab[dtan]^.tfuntyp := typnods[treal];
+ 	deftab[dsqrt]^.tfuntyp := typnods[treal];
+ 	deftab[dexp]^.tfuntyp := typnods[treal];
+ 	deftab[dln]^.tfuntyp := typnods[treal];
+ 
+ 	deftab[dsqr]^.tfuntyp := typnods[tpoly];
+ 	deftab[dabs]^.tfuntyp := typnods[tpoly];
+ 	deftab[dpred]^.tfuntyp := typnods[tpoly];
+ 	deftab[dsucc]^.tfuntyp := typnods[tpoly];
+ 
+ 	deftab[dargv]^.tfuntyp := typnods[tnone];
+ 	deftab[ddispose]^.tfuntyp := typnods[tnone];
+ 	deftab[dexit]^.tfuntyp := typnods[tnone];
+ 	deftab[dget]^.tfuntyp := typnods[tnone];
+ 	deftab[dhalt]^.tfuntyp := typnods[tnone];
+ 	deftab[dnew]^.tfuntyp := typnods[tnone];
+ 	deftab[dpack]^.tfuntyp := typnods[tnone];
+ 	deftab[dput]^.tfuntyp := typnods[tnone];
+ 	deftab[dread]^.tfuntyp := typnods[tnone];
+ 	deftab[dreadln]^.tfuntyp := typnods[tnone];
+ 	deftab[dreset]^.tfuntyp := typnods[tnone];
+ 	deftab[drewrite]^.tfuntyp := typnods[tnone];
+ 	deftab[dwrite]^.tfuntyp := typnods[tnone];
+ 	deftab[dwriteln]^.tfuntyp := typnods[tnone];
+ 	deftab[dmessage]^.tfuntyp := typnods[tnone];
+ 	deftab[dunpack]^.tfuntyp := typnods[tnone];
+ 
+ 	(* set up definitions for integer subranges *)
+ 	nmachdefs := 0;
+ 	defmach(0,		255,		'unsigned char   '); (* CPU *)
+ 	defmach(-128,		127,		'char            '); (* CPU *)
+ 	defmach(0,		65535,		'unsigned short  '); (* CPU *)
+ 	defmach(-32768,		32767,		'short           '); (* CPU *)
+ 	defmach(-2147483647,	2147483647,	'long            '); (* CPU *)
+ {	defmach(0,		4294967295,	'unsigned long   ');}(* CPU *)
+ end;	(* initialize *)
+ 
+ procedure exit(i : integer); external;	(* OS *)
+ 
+ (*	Action to take when an error is detected.			*)
+ procedure error;
+ 
+ begin
+ 	prtmsg(m);
+ 	exit(1);	(* OS *)
+ 	goto 9999
+ end;
+ 
+ (*	Action to take when a fatal error is detected.			*)
+ procedure fatal;
+ 
+ begin
+ 	prtmsg(m);
+ 	halt		(* OS *)
+ 	(* goto 9999	*)
+ end;
+ 
+ 
+ begin	(* program *)
+ 	initialize;
+ 	if echo then
+ 		writeln('# ifdef PASCAL');
+ 	parse;
+ 	if echo then
+ 		writeln('# else');
+ 	lineno := 0; lastline := 0;
+ 	transform;
+ 	emit;
+ 	if echo then
+ 		writeln('# endif');
+ 9999:
+ 	(* the very *)
+ end.
+ 




From criswell at cs.uiuc.edu  Mon Feb 16 17:45:14 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:45:14 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT Makefile citmods.c comment.c decl.c dir.c expr.c funcs.c hpmods.c lex.c libp2c.a loc.p2clib.c makeproto out.c p2c.h parse.c pexpr.c stuff.c trans.c trans.h
Message-ID: <200402162343.RAA30995@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c:

LICENSE.TXT added (r1.1)
Makefile added (r1.1)
citmods.c added (r1.1)
comment.c added (r1.1)
decl.c added (r1.1)
dir.c added (r1.1)
expr.c added (r1.1)
funcs.c added (r1.1)
hpmods.c added (r1.1)
lex.c added (r1.1)
libp2c.a added (r1.1)
loc.p2clib.c added (r1.1)
makeproto added (r1.1)
out.c added (r1.1)
p2c.h added (r1.1)
parse.c added (r1.1)
pexpr.c added (r1.1)
stuff.c added (r1.1)
trans.c added (r1.1)
trans.h added (r1.1)

---
Log message:

Initial commit of the p2c benchmark (part of the Malloc Benchmark).



---
Diffs of the changes:  (+36196 -0)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,10 ----
+ p2c - Part of the Malloc Benchmark Suite
+ -------------------------------------------------------------------------------
+ All files are licensed under the LLVM license with the following additions:
+ 
+ These files are licensed to you under the GNU General Public License (any
+ version).  Redistribution must follow the additional restrictions required by
+ the GPL.
+ 
+ Please see individiual files for additional copyright information.
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,5 ----
+ LEVEL = ../../../../../..
+ PROG = p2c
+ RUN_OPTIONS = -v
+ STDIN_FILENAME = $(SourceDir)/INPUT/mf.p
+ include ../../../Makefile.multisrc


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,1153 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_CITMODS_C
+ #include "trans.h"
+ 
+ 
+ 
+ /* The following functions define special translations for several
+  * HP Pascal modules developed locally at Caltech.  For non-Caltech
+  * readers this file will serve mainly as a body of examples.
+  *
+  * The FuncMacro mechanism (introduced after this file was written)
+  * provides a simpler method for cases where the function translates
+  * into some fixed C equivalent.
+  */
+ 
+ 
+ 
+ 
+ /* NEWASM functions */
+ 
+ 
+ /* na_fillbyte: equivalent to memset, though convert_size is used to
+  * generalize the size a bit:  na_fillbyte(a, 0, 80) where a is an array
+  * of integers (4 bytes in HP Pascal) will be translated to
+  * memset(a, 0, 20 * sizeof(int)).
+  */
+ 
+ Static Stmt *proc_na_fillbyte(ex)
+ Expr *ex;
+ {
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILLBYTE");
+     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+                                            ex->args[0],
+                                            makeexpr_arglong(ex->args[1], 0),
+                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ /* This function fills with a 32-bit pattern.  If all four bytes of the
+  * pattern are equal, memset is used, otherwise the na_fill call is
+  * left unchanged.
+  */
+ 
+ Static Stmt *proc_na_fill(ex)
+ Expr *ex;
+ {
+     unsigned long ul;
+     Symbol *sym;
+ 
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILL");
+     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_FILLP")) {
+         sym = findsymbol("NA_FILL");
+         if (sym->mbase)
+             ex->val.i = (long)sym->mbase;
+     }
+     if (isliteralconst(ex->args[1], NULL) != 2)
+         return makestmt_call(ex);
+     ul = ex->args[1]->val.i;
+     if ((((ul >> 16) ^ ul) & 0xffff) ||    /* all four bytes must be the same */
+         (((ul >> 8) ^ ul) & 0xff))
+         return makestmt_call(ex);
+     ex->args[1]->val.i &= 0xff;
+     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+                                            ex->args[0],
+                                            makeexpr_arglong(ex->args[1], 0),
+                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_move(ex)
+ Expr *ex;
+ {
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);   /* source */
+     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);   /* dest */
+     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+                                           argbasetype(ex->args[1])), ex->args[2], "NA_MOVE");
+     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+                                            ex->args[1],
+                                            ex->args[0],
+                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ /* This just generalizes the size and leaves the function call alone,
+  * except that na_exchp (a version using pointer args) is transformed
+  * to na_exch (a version using VAR args, equivalent in C).
+  */
+ 
+ Static Stmt *proc_na_exch(ex)
+ Expr *ex;
+ {
+     Symbol *sym;
+ 
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
+     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+                                           argbasetype(ex->args[1])), ex->args[2], "NA_EXCH");
+     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_EXCHP")) {
+         sym = findsymbol("NA_EXCH");
+         if (sym->mbase)
+             ex->val.i = (long)sym->mbase;
+     }
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_na_comp(ex)
+ Expr *ex;
+ {
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
+     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+                                           argbasetype(ex->args[1])), ex->args[2], "NA_COMP");
+     return makeexpr_bicall_3("memcmp", tp_int,
+                              ex->args[0],
+                              ex->args[1],
+                              makeexpr_arglong(ex->args[2], (size_t_long != 0)));
+ }
+ 
+ 
+ 
+ Static Expr *func_na_scaneq(ex)
+ Expr *ex;
+ {
+     Symbol *sym;
+ 
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANEQ");
+     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANEQP")) {
+         sym = findsymbol("NA_SCANEQ");
+         if (sym->mbase)
+             ex->val.i = (long)sym->mbase;
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_na_scanne(ex)
+ Expr *ex;
+ {
+     Symbol *sym;
+ 
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANNE");
+     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANNEP")) {
+         sym = findsymbol("NA_SCANNE");
+         if (sym->mbase)
+             ex->val.i = (long)sym->mbase;
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_new(ex)
+ Expr *ex;
+ {
+     Expr *vex, *ex2, *sz = NULL;
+     Stmt *sp;
+ 
+     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+     ex2 = ex->args[1];
+     if (vex->val.type->kind == TK_POINTER)
+         ex2 = convert_size(vex->val.type->basetype, ex2, "NA_NEW");
+     if (alloczeronil)
+         sz = copyexpr(ex2);
+     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
+     sp = makestmt_assign(copyexpr(vex), ex2);
+     if (malloccheck) {
+         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
+                                           makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int, 
+                                                                           makeexpr_long(-2))),
+                                           NULL));
+     }
+     if (sz && !isconstantexpr(sz)) {
+         if (alloczeronil == 2)
+             note("Called NA_NEW with variable argument [500]");
+         sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
+                          sp,
+                          makestmt_assign(vex, makeexpr_nil()));
+     } else
+         freeexpr(vex);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_dispose(ex)
+ Expr *ex;
+ {
+     Stmt *sp;
+     Expr *vex;
+ 
+     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+     sp = makestmt_call(makeexpr_bicall_1(freename, tp_void, copyexpr(vex)));
+     if (alloczeronil) {
+         sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
+                          sp, NULL);
+     } else
+         freeexpr(vex);
+     return sp;
+ }
+ 
+ 
+ 
+ /* These functions provide functionality similar to alloca; we just warn
+  * about them here since alloca would not have been portable enough for
+  * our purposes anyway.
+  */
+ 
+ Static Stmt *proc_na_alloc(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     note("Call to NA_ALLOC [501]");
+     ex->args[0] = eatcasts(ex->args[0]);
+     ex2 = ex->args[0];
+     if (ex2->val.type->kind == TK_POINTER &&
+ 	ex2->val.type->basetype->kind == TK_POINTER)
+         ex->args[1] = convert_size(ex2->val.type->basetype->basetype,
+ 				   ex->args[1], "NA_ALLOC");
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_outeralloc(ex)
+ Expr *ex;
+ {
+     note("Call to NA_OUTERALLOC [502]");
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_free(ex)
+ Expr *ex;
+ {
+     note("Call to NA_FREE [503]");
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ 
+ Static Expr *func_na_memavail(ex)
+ Expr *ex;
+ {
+     freeexpr(ex);
+     return makeexpr_bicall_0("memavail", tp_integer);
+ }
+ 
+ 
+ 
+ 
+ /* A simple collection of bitwise operations. */
+ 
+ Static Expr *func_na_and(ex)
+ Expr *ex;
+ {
+     Expr *ex0, *ex1;
+ 
+     ex0 = makeexpr_unlongcast(ex->args[0]);
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     return makeexpr_bin(EK_BAND, tp_integer, ex0, ex1);
+ }
+ 
+ 
+ 
+ Static Expr *func_na_bic(ex)
+ Expr *ex;
+ {
+     Expr *ex0, *ex1;
+ 
+     ex0 = makeexpr_unlongcast(ex->args[0]);
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     return makeexpr_bin(EK_BAND, tp_integer, 
+                         ex0,
+                         makeexpr_un(EK_BNOT, ex1->val.type, ex1));
+ }
+ 
+ 
+ 
+ Static Expr *func_na_or(ex)
+ Expr *ex;
+ {
+     Expr *ex0, *ex1;
+ 
+     ex0 = makeexpr_unlongcast(ex->args[0]);
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     return makeexpr_bin(EK_BOR, tp_integer, ex0, ex1);
+ }
+ 
+ 
+ 
+ Static Expr *func_na_xor(ex)
+ Expr *ex;
+ {
+     Expr *ex0, *ex1;
+ 
+     ex0 = makeexpr_unlongcast(ex->args[0]);
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     return makeexpr_bin(EK_BXOR, tp_integer, ex0, ex1);
+ }
+ 
+ 
+ 
+ Static Expr *func_na_not(ex)
+ Expr *ex;
+ {
+     ex = makeexpr_unlongcast(grabarg(ex, 0));
+     return makeexpr_un(EK_BNOT, ex->val.type, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_na_mask(ex)
+ Expr *ex;
+ {
+     Expr *ex0, *ex1;
+ 
+     ex0 = makeexpr_unlongcast(ex->args[0]);
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     ex = makeexpr_bin(EK_BAND, tp_integer, ex0, ex1);
+     return makeexpr_rel(EK_NE, ex, makeexpr_long(0));
+ }
+ 
+ 
+ 
+ Static int check0_31(ex)
+ Expr *ex;
+ {
+     if (isliteralconst(ex, NULL) == 2)
+         return (ex->val.i >= 0 && ex->val.i <= 31);
+     else
+         return (assumebits != 0);
+ }
+ 
+ 
+ 
+ /* This function is defined to test a bit of an integer, returning false
+  * if the bit number is out of range.  It is only safe to use C bitwise
+  * ops if we can prove the bit number is always in range, or if the
+  * user has asked us to assume that it is.  Lacking flow analysis,
+  * we settle for checking constants only.
+  */
+ 
+ Static Expr *func_na_test(ex)
+ Expr *ex;
+ {
+     Expr *ex1;
+     int longness;
+ 
+     if (!check0_31(ex->args[0]))
+         return ex;
+     ex1 = makeexpr_unlongcast(ex->args[1]);
+     longness = (exprlongness(ex1) != 0);
+     return makeexpr_rel(EK_NE,
+                         makeexpr_bin(EK_BAND, tp_integer,
+                                      ex1,
+                                      makeexpr_bin(EK_LSH, tp_integer,
+                                                   makeexpr_longcast(makeexpr_long(1), longness),
+                                                   makeexpr_unlongcast(ex->args[0]))),
+                         makeexpr_long(0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_set(ex)
+ Expr *ex;
+ {
+     Stmt *sp;
+     Expr *vex;
+     Meaning *tvar;
+ 
+     if (!check0_31(ex->args[0]))
+         return makestmt_call(ex);
+     if (!nosideeffects(ex->args[1], 1)) {
+         tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
+         sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
+         vex = makeexpr_hat(makeexpr_var(tvar), 0);
+     } else {
+         sp = NULL;
+         vex = makeexpr_hat(ex->args[1], 0);
+     }
+     sp = makestmt_seq(sp,
+                       makestmt_assign(vex,
+                                       makeexpr_bin(EK_BOR, tp_integer,
+                                                    copyexpr(vex),
+                                                    makeexpr_bin(EK_LSH, tp_integer,
+                                                                 makeexpr_longcast(makeexpr_long(1), 1),
+                                                                 makeexpr_unlongcast(ex->args[0])))));
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_clear(ex)
+ Expr *ex;
+ {
+     Stmt *sp;
+     Expr *vex;
+     Meaning *tvar;
+ 
+     if (!check0_31(ex->args[0]))
+         return makestmt_call(ex);
+     if (!nosideeffects(ex->args[1], 1)) {
+         tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
+         sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
+         vex = makeexpr_hat(makeexpr_var(tvar), 0);
+     } else {
+         sp = NULL;
+         vex = makeexpr_hat(ex->args[1], 0);
+     }
+     sp = makestmt_seq(sp,
+                       makestmt_assign(vex,
+                                       makeexpr_bin(EK_BAND, tp_integer,
+                                                    copyexpr(vex),
+                                                    makeexpr_un(EK_BNOT, tp_integer,
+                                                        makeexpr_bin(EK_LSH, tp_integer,
+                                                                     makeexpr_longcast(makeexpr_long(1), 1),
+                                                                     makeexpr_unlongcast(ex->args[0]))))));
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *func_na_po2(ex)
+ Expr *ex;
+ {
+     if (!check0_31(ex->args[0]))
+         return ex;
+     return makeexpr_bin(EK_LSH, tp_integer,
+                         makeexpr_longcast(makeexpr_long(1), 1),
+                         makeexpr_unlongcast(grabarg(ex, 0)));
+ }
+ 
+ 
+ 
+ Static Expr *func_na_lobits(ex)
+ Expr *ex;
+ {
+     if (!check0_31(ex->args[0]))
+         return ex;
+     return makeexpr_un(EK_BNOT, tp_integer,
+                        makeexpr_bin(EK_LSH, tp_integer,
+                                     makeexpr_longcast(makeexpr_long(-1), 1),
+                                     makeexpr_unlongcast(grabarg(ex, 0))));
+ }
+ 
+ 
+ 
+ Static Expr *func_na_hibits(ex)
+ Expr *ex;
+ {
+     if (!check0_31(ex->args[0]))
+         return ex;
+     return makeexpr_bin(EK_LSH, tp_integer,
+                         makeexpr_longcast(makeexpr_long(-1), 1),
+                         makeexpr_minus(makeexpr_long(32),
+                                        makeexpr_unlongcast(grabarg(ex, 0))));
+ }
+ 
+ 
+ 
+ /* This function does an arithmetic shift left, or right for negative shift
+  * count.  We translate into a C shift only if we are confident of the
+  * sign of the shift count.
+  */
+ 
+ Static Expr *func_na_asl(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
+     if (expr_is_neg(ex2)) {
+         if (signedshift == 0 || signedshift == 2)
+             return ex;
+ 	if (possiblesigns(ex2) & 4) {
+             if (assumesigns)
+                 note("Assuming count for NA_ASL is negative [504]");
+             else
+                 return ex;
+         }
+         if (signedshift != 1)
+             note("Assuming >> is an arithmetic shift [505]");
+         return makeexpr_bin(EK_RSH, tp_integer,
+ 			    grabarg(ex, 1), makeexpr_neg(ex2));
+     } else {
+ 	if (possiblesigns(ex2) & 1) {
+             if (assumesigns)
+                 note("Assuming count for NA_ASL is positive [504]");
+             else
+                 return ex;
+         }
+         return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_na_lsl(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
+     if (expr_is_neg(ex2)) {
+ 	if (possiblesigns(ex2) & 4) {
+             if (assumesigns)
+                 note("Assuming count for NA_LSL is negative [506]");
+             else
+                 return ex;
+         }
+         return makeexpr_bin(EK_RSH, tp_integer, 
+                             force_unsigned(grabarg(ex, 1)),
+ 			    makeexpr_neg(ex2));
+     } else {
+ 	if (possiblesigns(ex2) & 1) {
+             if (assumesigns)
+                 note("Assuming count for NA_LSL is positive [506]");
+             else
+                 return ex;
+         }
+         return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
+     }
+ }
+ 
+ 
+ 
+ /* These bit-field operations were generalized slightly on the way to C;
+  * they used to perform D &= S and now perform D = S1 & S2.
+  */
+ 
+ Static Stmt *proc_na_bfand(ex)
+ Expr *ex;
+ {
+     Stmt *sp;
+     Meaning *tvar;
+ 
+     if (!nosideeffects(ex->args[2], 1)) {
+         tvar = makestmttempvar(ex->args[2]->val.type, name_TEMP);
+         sp = makestmt_assign(makeexpr_var(tvar), ex->args[2]);
+         ex->args[2] = makeexpr_var(tvar);
+     } else
+         sp = NULL;
+     insertarg(&ex, 1, copyexpr(ex->args[2]));
+     return makestmt_seq(sp, makestmt_call(ex));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_bfbic(ex)
+ Expr *ex;
+ {
+     return proc_na_bfand(ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_bfor(ex)
+ Expr *ex;
+ {
+     return proc_na_bfand(ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_na_bfxor(ex)
+ Expr *ex;
+ {
+     return proc_na_bfand(ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_imin(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_2("P_imin2", tp_integer,
+                              ex->args[0], ex->args[1]);
+ }
+ 
+ 
+ 
+ Static Expr *func_imax(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_2("P_imax2", tp_integer,
+                              ex->args[0], ex->args[1]);
+ }
+ 
+ 
+ 
+ /* Unsigned non-overflowing arithmetic functions in Pascal; we translate
+  * into plain arithmetic in C and assume C doesn't check for overflow.
+  * (A valid assumption in the case when this was used.)
+  */
+ 
+ Static Expr *func_na_add(ex)
+ Expr *ex;
+ {
+     return makeexpr_plus(makeexpr_unlongcast(ex->args[0]),
+                          makeexpr_unlongcast(ex->args[1]));
+ }
+ 
+ 
+ 
+ Static Expr *func_na_sub(ex)
+ Expr *ex;
+ {
+     return makeexpr_minus(makeexpr_unlongcast(ex->args[0]),
+                           makeexpr_unlongcast(ex->args[1]));
+ }
+ 
+ 
+ 
+ extern Stmt *proc_exit();    /* from funcs.c */
+ 
+ Static Stmt *proc_return()
+ {
+     return proc_exit();
+ }
+ 
+ 
+ 
+ Static Expr *func_charupper(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("toupper", tp_char,
+                              grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_charlower(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("tolower", tp_char,
+                              grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ /* Convert an integer to its string representation.  We produce a sprintf
+  * into a temporary variable; the temporary will probably be eliminated
+  * as the surrounding code is translated.
+  */
+ 
+ Static Expr *func_strint(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     ex2 = makeexpr_forcelongness(ex->args[1]);
+     return makeexpr_bicall_3("sprintf", ex->val.type,
+                              ex->args[0],
+                              makeexpr_string((exprlongness(ex2) > 0) ? "%ld" : "%d"),
+                              ex2);
+ }
+ 
+ 
+ 
+ Static Expr *func_strint2(ex)
+ Expr *ex;
+ {
+     Expr *ex2, *len, *fmt;
+ 
+     if (checkconst(ex->args[2], 0) || checkconst(ex->args[2], 1))
+         return func_strint(ex);
+     if (expr_is_neg(ex->args[2])) {
+ 	if (possiblesigns(ex->args[2]) & 4) {
+             if (assumesigns)
+                 note("Assuming width for STRINT2 is negative [507]");
+             else
+                 return ex;
+         }
+         ex2 = makeexpr_forcelongness(ex->args[1]);
+         fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%0*ld" : "%0*d");
+         len = makeexpr_neg(makeexpr_longcast(ex->args[2], 0));
+     } else {
+ 	if (possiblesigns(ex->args[2]) & 1) {
+             if (assumesigns)
+                 note("Assuming width for STRINT2 is positive [507]");
+             else
+                 return ex;
+         }
+         ex2 = makeexpr_forcelongness(ex->args[1]);
+         fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%*ld" : "%*d");
+         len = makeexpr_longcast(ex->args[2], 0);
+     }
+     ex = makeexpr_bicall_4("sprintf", ex->val.type,
+                            ex->args[0], fmt, len, ex2);
+     return cleansprintf(ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_strhex(ex)
+ Expr *ex;
+ {
+     Expr *ex2, *ex3;
+     Value val;
+ 
+     if (isliteralconst(ex->args[2], &val) == 2) {
+         ex2 = makeexpr_forcelongness(ex->args[1]);
+         if (val.i < 1 || val.i > 8) {
+             ex = makeexpr_bicall_3("sprintf", ex->val.type,
+                                    ex->args[0],
+                                    makeexpr_string((exprlongness(ex2) > 0) ? "%lX" : "%X"),
+                                    ex2);
+         } else {
+             if (val.i < 8) {
+                 ex3 = makeexpr_long((1 << (val.i*4)) - 1);
+                 insertarg(&ex3, 0, makeexpr_name("%#lx", tp_integer));
+                 ex2 = makeexpr_bin(EK_BAND, ex2->val.type, ex2, ex3);
+             }
+             ex = makeexpr_bicall_3("sprintf", ex->val.type,
+                                    ex->args[0],
+                                    makeexpr_string(format_d((exprlongness(ex2) > 0) ? "%%.%ldlX" :
+                                                                                       "%%.%ldX",
+                                                             val.i)),
+                                    ex2);
+         }
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_strreal(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_3("sprintf", ex->val.type,
+                              ex->args[0],
+                              makeexpr_string("%g"),
+                              ex->args[1]);
+ }
+ 
+ 
+ 
+ Static Expr *func_strchar(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_3("sprintf", ex->val.type,
+                              ex->args[0],
+                              makeexpr_string("%c"),
+                              ex->args[1]);
+ }
+ 
+ 
+ 
+ Static Expr *func_strreadint(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_3("strtol", tp_integer,
+                              grabarg(ex, 0), 
+                              makeexpr_nil(),
+                              makeexpr_long(0));
+ }
+ 
+ 
+ 
+ Static Expr *func_strreadreal(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("atof", tp_longreal,
+                              grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strappendc(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     ex2 = makeexpr_hat(ex->args[0], 0);
+     return makestmt_assign(ex2, makeexpr_concat(copyexpr(ex2), ex->args[1], 0));
+ }
+ 
+ 
+ 
+ /* Check if a string begins with a given prefix; this is easy if the
+  * prefix is known at compile-time.
+  */
+ 
+ Static Expr *func_strbegins(ex)
+ Expr *ex;
+ {
+     Expr *ex1, *ex2;
+ 
+     ex1 = ex->args[0];
+     ex2 = ex->args[1];
+     if (ex2->kind == EK_CONST) {
+         if (ex2->val.i == 1) {
+             return makeexpr_rel(EK_EQ,
+                                 makeexpr_hat(ex1, 0),
+                                 makeexpr_char(ex2->val.s[0]));
+         } else {
+             return makeexpr_rel(EK_EQ,
+                                 makeexpr_bicall_3("strncmp", tp_int,
+                                                   ex1,
+                                                   ex2,
+                                                   makeexpr_arglong(makeexpr_long(ex2->val.i), (size_t_long != 0))),
+                                 makeexpr_long(0));
+         }
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_strcontains(ex)
+ Expr *ex;
+ {
+     return makeexpr_rel(EK_NE,
+                         makeexpr_bicall_2("strpbrk", tp_strptr,
+                                           ex->args[0],
+                                           ex->args[1]),
+                         makeexpr_nil());
+ }
+ 
+ 
+ 
+ /* Extract a substring of a string.  If arguments are out-of-range, extract
+  * an empty or shorter substring.  Here, the length=infinity and constant
+  * starting index cases are handled specially.
+  */
+ 
+ Static Expr *func_strsub(ex)
+ Expr *ex;
+ {
+     if (isliteralconst(ex->args[3], NULL) == 2 &&
+         ex->args[3]->val.i >= stringceiling) {
+         return makeexpr_bicall_3("sprintf", ex->val.type,
+                                  ex->args[0],
+                                  makeexpr_string("%s"),
+                                  bumpstring(ex->args[1],
+                                             makeexpr_unlongcast(ex->args[2]), 1));
+     }
+     if (checkconst(ex->args[2], 1)) {
+         return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
+                                                 ex->args[2], ex->args[3]));
+     }
+     ex->args[2] = makeexpr_arglong(ex->args[2], 0);
+     ex->args[3] = makeexpr_arglong(ex->args[3], 0);
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_strpart(ex)
+ Expr *ex;
+ {
+     return func_strsub(ex);     /* all the special cases match */
+ }
+ 
+ 
+ 
+ Static Expr *func_strequal(ex)
+ Expr *ex;
+ {
+     if (!*strcicmpname)
+         return ex;
+     return makeexpr_rel(EK_EQ, 
+                         makeexpr_bicall_2(strcicmpname, tp_int,
+                                           ex->args[0], ex->args[1]),
+                         makeexpr_long(0));
+ }
+ 
+ 
+ 
+ Static Expr *func_strcmp(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_2("strcmp", tp_int, ex->args[0], ex->args[1]);
+ }
+ 
+ 
+ 
+ Static Expr *func_strljust(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_4("sprintf", ex->val.type,
+                              ex->args[0],
+                              makeexpr_string("%-*s"),
+                              makeexpr_longcast(ex->args[2], 0),
+                              ex->args[1]);
+ }
+ 
+ 
+ 
+ Static Expr *func_strrjust(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_4("sprintf", ex->val.type,
+                              ex->args[0],
+                              makeexpr_string("%*s"),
+                              makeexpr_longcast(ex->args[2], 0),
+                              ex->args[1]);
+ }
+ 
+ 
+ 
+ 
+ /* The procedure strnew(p,s) is converted into an assignment p = strdup(s). */
+ 
+ Static Stmt *proc_strnew(ex)
+ Expr *ex;
+ {
+     return makestmt_assign(makeexpr_hat(ex->args[0], 0),
+                            makeexpr_bicall_1("strdup", ex->args[1]->val.type,
+                                              ex->args[1]));
+ }
+ 
+ 
+ 
+ /* These procedures are also changed to functions returning a result. */
+ 
+ Static Stmt *proc_strlist_add(ex)
+ Expr *ex;
+ {
+     return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+                            makeexpr_bicall_2("strlist_add", ex->args[0]->val.type->basetype,
+                                              ex->args[0],
+                                              ex->args[2]));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strlist_append(ex)
+ Expr *ex;
+ {
+     return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+                            makeexpr_bicall_2("strlist_append", ex->args[0]->val.type->basetype,
+                                              ex->args[0],
+                                              ex->args[2]));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strlist_insert(ex)
+ Expr *ex;
+ {
+     return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+                            makeexpr_bicall_2("strlist_insert", ex->args[0]->val.type->basetype,
+                                              ex->args[0],
+                                              ex->args[2]));
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* NEWCI functions */
+ 
+ 
+ Static Stmt *proc_fixfname(ex)
+ Expr *ex;
+ {
+     if (ex->args[1]->kind == EK_CONST)
+ 	lwc(ex->args[1]->val.s);    /* Unix uses lower-case suffixes */
+     return makestmt_call(ex);
+ }
+ 
+ 
+ Static Stmt *proc_forcefname(ex)
+ Expr *ex;
+ {
+     return proc_fixfname(ex);
+ }
+ 
+ 
+ /* In Pascal these were variables of type pointer-to-text; we translate
+  * them as, e.g., &stdin.  Note that even though &stdin is not legal in
+  * many systems, in the common usage of writeln(stdin^) the & will
+  * cancel out in a later stage of the translation.
+  */
+ 
+ Static Expr *func_stdin()
+ {
+     return makeexpr_addr(makeexpr_var(mp_input));
+ }
+ 
+ 
+ Static Expr *func_stdout()
+ {
+     return makeexpr_addr(makeexpr_var(mp_output));
+ }
+ 
+ 
+ Static Expr *func_stderr()
+ {
+     return makeexpr_addr(makeexpr_var(mp_stderr));
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* MYLIB functions */
+ 
+ 
+ Static Stmt *proc_m_color(ex)
+ Expr *ex;
+ {
+     int i;
+     long val;
+ 
+     if (ex->kind == EK_PLUS) {
+         for (i = 0; i < ex->nargs; i++) {
+             if (isconstexpr(ex->args[i], &val)) {
+                 if (val > 0 && (val & 15) == 0) {
+                     note("M_COLOR called with suspicious argument [508]");
+                 }
+             }
+         }
+     } else if (ex->kind == EK_CONST) {
+         if (ex->val.i >= 16 && ex->val.i < 255) {    /* accept true colors and m_trans */
+             note("M_COLOR called with suspicious argument [508]");
+         }
+     }
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ void citmods(name, defn)
+ char *name;
+ int defn;
+ {
+     if (!strcmp(name, "NEWASM")) {
+         makestandardproc("na_fillbyte", proc_na_fillbyte);
+         makestandardproc("na_fill", proc_na_fill);
+         makestandardproc("na_fillp", proc_na_fill);
+         makestandardproc("na_move", proc_na_move);
+         makestandardproc("na_movep", proc_na_move);
+         makestandardproc("na_exch", proc_na_exch);
+         makestandardproc("na_exchp", proc_na_exch);
+         makestandardfunc("na_comp", func_na_comp);
+         makestandardfunc("na_compp", func_na_comp);
+         makestandardfunc("na_scaneq", func_na_scaneq);
+         makestandardfunc("na_scaneqp", func_na_scaneq);
+         makestandardfunc("na_scanne", func_na_scanne);
+         makestandardfunc("na_scannep", func_na_scanne);
+         makestandardproc("na_new", proc_na_new);
+         makestandardproc("na_dispose", proc_na_dispose);
+         makestandardproc("na_alloc", proc_na_alloc);
+         makestandardproc("na_outeralloc", proc_na_outeralloc);
+         makestandardproc("na_free", proc_na_free);
+         makestandardfunc("na_memavail", func_na_memavail);
+         makestandardfunc("na_and", func_na_and);
+         makestandardfunc("na_bic", func_na_bic);
+         makestandardfunc("na_or", func_na_or);
+         makestandardfunc("na_xor", func_na_xor);
+         makestandardfunc("na_not", func_na_not);
+         makestandardfunc("na_mask", func_na_mask);
+         makestandardfunc("na_test", func_na_test);
+         makestandardproc("na_set", proc_na_set);
+         makestandardproc("na_clear", proc_na_clear);
+         makestandardfunc("na_po2", func_na_po2);
+         makestandardfunc("na_hibits", func_na_hibits);
+         makestandardfunc("na_lobits", func_na_lobits);
+         makestandardfunc("na_asl", func_na_asl);
+         makestandardfunc("na_lsl", func_na_lsl);
+         makestandardproc("na_bfand", proc_na_bfand);
+         makestandardproc("na_bfbic", proc_na_bfbic);
+         makestandardproc("na_bfor", proc_na_bfor);
+         makestandardproc("na_bfxor", proc_na_bfxor);
+         makestandardfunc("imin", func_imin);
+         makestandardfunc("imax", func_imax);
+         makestandardfunc("na_add", func_na_add);
+         makestandardfunc("na_sub", func_na_sub);
+         makestandardproc("return", proc_return);
+         makestandardfunc("charupper", func_charupper);
+         makestandardfunc("charlower", func_charlower);
+         makestandardfunc("strint", func_strint);
+         makestandardfunc("strint2", func_strint2);
+         makestandardfunc("strhex", func_strhex);
+         makestandardfunc("strreal", func_strreal);
+         makestandardfunc("strchar", func_strchar);
+         makestandardfunc("strreadint", func_strreadint);
+         makestandardfunc("strreadreal", func_strreadreal);
+         makestandardproc("strappendc", proc_strappendc);
+         makestandardfunc("strbegins", func_strbegins);
+         makestandardfunc("strcontains", func_strcontains);
+         makestandardfunc("strsub", func_strsub);
+         makestandardfunc("strpart", func_strpart);
+         makestandardfunc("strequal", func_strequal);
+         makestandardfunc("strcmp", func_strcmp);
+         makestandardfunc("strljust", func_strljust);
+         makestandardfunc("strrjust", func_strrjust);
+         makestandardproc("strnew", proc_strnew);
+         makestandardproc("strlist_add", proc_strlist_add);
+         makestandardproc("strlist_append", proc_strlist_append);
+         makestandardproc("strlist_insert", proc_strlist_insert);
+     } else if (!strcmp(name, "NEWCI")) {
+ 	makestandardproc("fixfname", proc_fixfname);
+ 	makestandardproc("forcefname", proc_forcefname);
+         makestandardfunc("stdin", func_stdin);
+         makestandardfunc("stdout", func_stdout);
+         makestandardfunc("stderr", func_stderr);
+     } else if (!strcmp(name, "MYLIB")) {
+         makestandardproc("m_color", proc_m_color);
+     }
+ }
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,466 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_COMMENT_C
+ #include "trans.h"
+ 
+ 
+ 
+ Static int cmttablesize;
+ Static uchar *cmttable;
+ 
+ Static int grabbed_comment;
+ 
+ 
+ 
+ 
+ /* Special comment forms:
+ 
+    \001\001\001...      Blank line(s), one \001 char per blank line
+    \002text...          Additional line for previous comment
+    \003text...          Additional comment line, absolutely indented
+    \004text...		Note or warning line, unindented
+ 
+ */
+ 
+ 
+ 
+ 
+ void setup_comment()
+ {
+     curcomments = NULL;
+     cmttablesize = 200;
+     cmttable = ALLOC(cmttablesize, uchar, misc);
+     grabbed_comment = 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ int commentlen(cmt)
+ Strlist *cmt;
+ {
+     if (cmt)
+ 	if (*(cmt->s))
+ 	    return strlen(cmt->s) + 4;
+ 	else
+ 	    return 5;
+     else
+ 	return 0;
+ }
+ 
+ 
+ int commentvisible(cmt)
+ Strlist *cmt;
+ {
+     return (cmt &&
+ 	    getcommentkind(cmt) != CMT_DONE &&
+ 	    ((eatcomments != 1 && eatcomments != 2) ||
+ 	     isembedcomment(cmt)));
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* If preceding statement's POST comments include blank lines,
+    steal all comments after longest stretch of blank lines as
+    PRE comments for the next statement. */
+ 
+ void steal_comments(olds, news, always)
+ long olds, news;
+ int always;
+ {
+     Strlist *cmt, *cmtfirst = NULL, *cmtblank = NULL;
+     int len, longest;
+ 
+     for (cmt = curcomments; cmt; cmt = cmt->next) {
+ 	if ((cmt->value & CMT_MASK) == olds &&
+ 	    getcommentkind(cmt) == CMT_POST) {
+ 	    if (!cmtfirst)
+ 		cmtfirst = cmt;
+ 	} else {
+ 	    cmtfirst = NULL;
+ 	}
+     }
+     if (cmtfirst) {
+ 	if (!always) {
+ 	    longest = 0;
+ 	    for (cmt = cmtfirst; cmt; cmt = cmt->next) {
+ 		if (cmt->s[0] == '\001') {   /* blank line(s) */
+ 		    len = strlen(cmt->s);
+ 		    if (len > longest) {
+ 			longest = len;
+ 			cmtblank = cmt;
+ 		    }
+ 		}
+ 	    }
+ 	    if (longest > 0) {
+ 		if (blankafter)
+ 		    cmtfirst = cmtblank->next;
+ 		else
+ 		    cmtfirst = cmtblank;
+ 	    } else if (commentafter == 1)
+ 		cmtfirst = NULL;
+ 	}
+ 	changecomments(cmtfirst, CMT_POST, olds, CMT_PRE, news);
+     }
+ }
+ 
+ 
+ 
+ Strlist *fixbeginendcomment(cmt)
+ Strlist *cmt;
+ {
+     char *cp, *cp2;
+ 
+     if (!cmt)
+ 	return NULL;
+     cp = cmt->s;
+     while (isspace(*cp))
+ 	cp++;
+     if (!strcincmp(cp, "procedure ", 10)) {    /* remove "PROCEDURE" keyword */
+ 	strcpy(cp, cp+10);
+     } else if (!strcincmp(cp, "function ", 9)) {
+ 	strcpy(cp, cp+9);
+     }
+     while (isspace(*cp))
+ 	cp++;
+     if (!*cp)
+ 	return NULL;
+     if (getcommentkind(cmt) == CMT_ONBEGIN) {
+ 	cp2 = curctx->sym->name;
+ 	while (*cp2) {
+ 	    if (toupper(*cp2++) != toupper(*cp++))
+ 		break;
+ 	}
+ 	while (isspace(*cp))
+ 	    cp++;
+ 	if (!*cp2 && !*cp)
+ 	    return NULL;     /* eliminate function-begin comment */
+     }
+     return cmt;
+ }
+ 
+ 
+ 
+ 
+ Static void attach_mark(sp)
+ Stmt *sp;
+ {
+     long serial;
+ 
+     while (sp) {
+ 	serial = sp->serial;
+ 	if (serial >= 0 && serial < cmttablesize) {
+ 	    cmttable[serial]++;
+ 	    if (sp->kind == SK_IF && serial+1 < cmttablesize)
+ 		cmttable[serial+1]++;   /* the "else" branch */
+ 	}
+ 	attach_mark(sp->stm1);
+ 	attach_mark(sp->stm2);
+ 	sp = sp->next;
+     }
+ }
+ 
+ 
+ 
+ void attach_comments(sbase)
+ Stmt *sbase;
+ {
+     Strlist *cmt;
+     long serial, i, j;
+     int kind;
+ 
+     if (spitorphancomments)
+ 	return;
+     if (serialcount >= cmttablesize) {
+ 	cmttablesize = serialcount + 100;
+ 	cmttable = REALLOC(cmttable, cmttablesize, uchar);
+     }
+     for (i = 0; i < cmttablesize; i++)
+ 	cmttable[i] = 0;
+     attach_mark(sbase);
+     for (cmt = curcomments; cmt; cmt = cmt->next) {
+ 	serial = cmt->value & CMT_MASK;
+ 	kind = getcommentkind(cmt);
+ 	if (serial < 0 || serial >= cmttablesize || cmttable[serial])
+ 	    continue;
+ 	i = 0;
+ 	j = 0;
+ 	do {
+ 	    if (commentafter == 1) {
+ 		j++;
+ 		if (j % 3 == 0)
+ 		    i++;
+ 	    } else if (commentafter == 0) {
+ 		i++;
+ 		if (i % 3 == 0)
+ 		    j++;
+ 	    } else {
+ 		i++;
+ 		j++;
+ 	    }
+ 	    if (serial+i < cmttablesize && cmttable[serial+i]) {
+ 		setcommentkind(cmt, CMT_PRE);
+ 		cmt->value += i;
+ 		break;
+ 	    }
+ 	    if (serial-j > 0 && cmttable[serial-j]) {
+ 		setcommentkind(cmt, CMT_POST);
+ 		cmt->value -= j;
+ 		break;
+ 	    }
+ 	} while (serial+i < cmttablesize || serial-j > 0);
+     }
+ }
+ 
+ 
+ 
+ 
+ void setcommentkind(cmt, kind)
+ Strlist *cmt;
+ int kind;
+ {
+     cmt->value = (cmt->value & CMT_MASK) | (kind << CMT_SHIFT);
+ }
+ 
+ 
+ 
+ void commentline(kind)
+ int kind;
+ {
+     char *cp;
+     Strlist *sl;
+ 
+     if (grabbed_comment) {
+ 	grabbed_comment = 0;
+ 	return;
+     }
+     if (blockkind == TOK_IMPORT || skipping_module)
+ 	return;
+     if (eatcomments == 1)
+ 	return;
+     for (cp = curtokbuf; (cp = my_strchr(cp, '*')) != NULL; ) {
+ 	if (*++cp == '/') {
+ 	    cp[-1] = '%';
+ 	    note("Changed \"* /\" to \"% /\" in comment [140]");
+ 	}
+     }
+     sl = strlist_append(&curcomments, curtokbuf);
+     sl->value = curserial;
+     setcommentkind(sl, kind);
+ }
+ 
+ 
+ 
+ void addnote(msg, serial)
+ char *msg;
+ long serial;
+ {
+     int len1, len2, xextra, extra;
+     int defer = (notephase > 0 && spitcomments == 0);
+     Strlist *sl, *base = NULL, **pbase = (defer) ? &curcomments : &base;
+     char *prefix;
+ 
+     if (defer && (outf != stdout || !quietmode))
+ 	printf("%s, line %d: %s\n", infname, inf_lnum, msg);
+     else if (outf != stdout)
+ 	printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+     if (verbose)
+ 	fprintf(logf, "%s, %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+     if (notephase == 2 || regression)
+ 	prefix = format_s("\004 p2c: %s:", infname);
+     else
+ 	prefix = format_sd("\004 p2c: %s, line %d:", infname, inf_lnum);
+     len1 = strlen(prefix);
+     len2 = strlen(msg) + 2;
+     if (len1 + len2 < linewidth-4) {
+ 	msg = format_ss("%s %s ", prefix, msg);
+     } else {
+ 	extra = xextra = 0;
+ 	while (len2 - extra > linewidth-6) {
+ 	    while (extra < len2 && !isspace(msg[extra]))
+ 		extra++;
+ 	    xextra = extra;
+ 	    while (extra < len2 && isspace(msg[extra]))
+ 		extra++;
+ 	}
+ 	prefix = format_sds("%s %.*s", prefix, xextra, msg);
+ 	msg += extra;
+ 	sl = strlist_append(pbase, prefix);
+ 	sl->value = serial;
+ 	setcommentkind(sl, CMT_POST);
+ 	msg = format_s("\003 * %s ", msg);
+     }
+     sl = strlist_append(pbase, msg);
+     sl->value = serial;
+     setcommentkind(sl, CMT_POST);
+     outputmode++;
+     outcomments(base);
+     outputmode--;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* Grab a comment off the end of the current line */
+ Strlist *grabcomment(kind)
+ int kind;
+ {
+     char *cp, *cp2;
+     Strlist *cmt, *savecmt;
+ 
+     if (grabbed_comment || spitcomments == 1)
+ 	return NULL;
+     cp = inbufptr;
+     while (isspace(*cp))
+ 	cp++;
+     if (*cp == ';' || *cp == ',' || *cp == '.')
+ 	cp++;
+     while (isspace(*cp))
+ 	cp++;
+     cp2 = curtokbuf;
+     if (*cp == '{') {
+ 	cp++;
+ 	while (*cp && *cp != '}')
+ 	    *cp2++ = *cp++;
+ 	if (!*cp)
+ 	    return NULL;
+ 	cp++;
+     } else if (*cp == '(' && cp[1] == '*') {
+ 	cp += 2;
+ 	while (*cp && (*cp != '*' || cp[1] != ')'))
+ 	    *cp2++ = *cp++;
+ 	if (!*cp)
+ 	    return NULL;
+ 	cp += 2;
+     } else
+ 	return NULL;
+     while (isspace(*cp))
+ 	cp++;
+     if (*cp)
+ 	return NULL;
+     *cp2 = 0;
+     savecmt = curcomments;
+     curcomments = NULL;
+     commentline(kind);
+     cmt = curcomments;
+     curcomments = savecmt;
+     grabbed_comment = 1;
+     if (cmtdebug > 1)
+ 	fprintf(outf, "Grabbed comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
+     return cmt;
+ }
+ 
+ 
+ 
+ int matchcomment(cmt, kind, stamp)
+ Strlist *cmt;
+ int kind, stamp;
+ {
+     if (spitcomments == 1 && (cmt->value & CMT_MASK) != 10000 &&
+ 	*cmt->s != '\001' && (kind >= 0 || stamp >= 0))
+ 	return 0;
+     if (!cmt || getcommentkind(cmt) == CMT_DONE)
+ 	return 0;
+     if (stamp >= 0 && (cmt->value & CMT_MASK) != stamp)
+ 	return 0;
+     if (kind >= 0) {
+ 	if (kind & CMT_NOT) {
+ 	    if (getcommentkind(cmt) == kind - CMT_NOT)
+ 		return 0;
+ 	} else {
+ 	    if (getcommentkind(cmt) != kind)
+ 		return 0;
+ 	}
+     }
+     return 1;
+ }
+ 
+ 
+ 
+ Strlist *findcomment(cmt, kind, stamp)
+ Strlist *cmt;
+ int kind, stamp;
+ {
+     while (cmt && !matchcomment(cmt, kind, stamp))
+ 	cmt = cmt->next;
+     if (cmt && cmtdebug > 1)
+ 	fprintf(outf, "Found comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
+     return cmt;
+ }
+ 
+ 
+ 
+ Strlist *extractcomment(cmt, kind, stamp)
+ Strlist **cmt;
+ int kind, stamp;
+ {
+     Strlist *base, **last, *sl;
+ 
+     last = &base;
+     while ((sl = *cmt)) {
+ 	if (matchcomment(sl, kind, stamp)) {
+ 	    if (cmtdebug > 1)
+ 		fprintf(outf, "Extracted comment [%d] \"%s\"\n",
+ 		        sl->value & CMT_MASK, sl->s);
+ 	    *cmt = sl->next;
+ 	    *last = sl;
+ 	    last = &sl->next;
+ 	} else
+ 	    cmt = &sl->next;
+     }
+     *last = NULL;
+     return base;
+ }
+ 
+ 
+ void changecomments(cmt, okind, ostamp, kind, stamp)
+ Strlist *cmt;
+ int okind, ostamp, kind, stamp;
+ {
+     while (cmt) {
+ 	if (matchcomment(cmt, okind, ostamp)) {
+ 	    if (cmtdebug > 1)
+ 		fprintf(outf, "Changed comment [%s:%d] \"%s\" ",
+ 			CMT_NAMES[getcommentkind(cmt)],
+ 			cmt->value & CMT_MASK, cmt->s);
+ 	    if (kind >= 0)
+ 		setcommentkind(cmt, kind);
+ 	    if (stamp >= 0)
+ 		cmt->value = (cmt->value & ~CMT_MASK) | stamp;
+ 	    if (cmtdebug > 1)
+ 		fprintf(outf, " to [%s:%d]\n",
+ 			CMT_NAMES[getcommentkind(cmt)], cmt->value & CMT_MASK);
+ 	}
+ 	cmt = cmt->next;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,5444 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_DECL_C
+ #include "trans.h"
+ 
+ 
+ 
+ #define MAXIMPORTS 100
+ 
+ 
+ 
+ Static struct ptrdesc {
+     struct ptrdesc *next;
+     Symbol *sym;
+     Type *tp;
+ } *ptrbase;
+ 
+ Static struct ctxstack {
+     struct ctxstack *next;
+     Meaning *ctx, *ctxlast;
+     struct tempvarlist *tempvars;
+     int tempvarcount, importmark;
+ } *ctxtop;
+ 
+ Static struct tempvarlist {
+     struct tempvarlist *next;
+     Meaning *tvar;
+     int active;
+ } *tempvars, *stmttempvars;
+ 
+ Static int tempvarcount;
+ 
+ Static int stringtypecachesize;
+ Static Type **stringtypecache;
+ 
+ Static Meaning *importlist[MAXIMPORTS];
+ Static int firstimport;
+ 
+ Static Type *tp_special_anyptr;
+ 
+ Static int wasaliased;
+ Static int deferallptrs;
+ Static int anydeferredptrs;
+ Static int silentalreadydef;
+ Static int nonloclabelcount;
+ 
+ Static Strlist *varstructdecllist;
+ 
+ 
+ 
+ 
+ Static Meaning *findstandardmeaning(kind, name)
+ enum meaningkind kind;
+ char *name;
+ {
+     Meaning *mp;
+     Symbol *sym;
+ 
+     sym = findsymbol(fixpascalname(name));
+     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
+     if (mp) {
+ 	if (mp->kind == kind)
+ 	    mp->refcount = 1;
+ 	else
+ 	    mp = NULL;
+     }
+     return mp;
+ }
+ 
+ 
+ Static Meaning *makestandardmeaning(kind, name)
+ enum meaningkind kind;
+ char *name;
+ {
+     Meaning *mp;
+     Symbol *sym;
+ 
+     sym = findsymbol(fixpascalname(name));
+     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
+     if (!mp) {
+         mp = addmeaning(sym, kind);
+         strchange(&mp->name, name);
+         if (debug < 4)
+             mp->dumped = partialdump;     /* prevent irrelevant dumping */
+     } else {
+         mp->kind = kind;
+     }
+     mp->refcount = 1;
+     return mp;
+ }
+ 
+ 
+ Static Type *makestandardtype(kind, mp)
+ enum typekind kind;
+ Meaning *mp;
+ {
+     Type *tp;
+ 
+     tp = maketype(kind);
+     tp->meaning = mp;
+     if (mp)
+         mp->type = tp;
+     return tp;
+ }
+ 
+ 
+ 
+ 
+ Static Stmt *nullspecialproc(mp)
+ Meaning *mp;
+ {
+     warning(format_s("Procedure %s not yet supported [118]", mp->name));
+     if (curtok == TOK_LPAR)
+         skipparens();
+     return NULL;
+ }
+ 
+ Meaning *makespecialproc(name, handler)
+ char *name;
+ Stmt *(*handler)();
+ {
+     Meaning *mp;
+ 
+     if (!handler)
+         handler = nullspecialproc;
+     mp = makestandardmeaning(MK_SPECIAL, name);
+     mp->handler = (Expr *(*)())handler;
+     return mp;
+ }
+ 
+ 
+ 
+ Static Stmt *nullstandardproc(ex)
+ Expr *ex;
+ {
+     warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
+     return makestmt_call(ex);
+ }
+ 
+ Meaning *makestandardproc(name, handler)
+ char *name;
+ Stmt *(*handler)();
+ {
+     Meaning *mp;
+ 
+     if (!handler)
+         handler = nullstandardproc;
+     mp = findstandardmeaning(MK_FUNCTION, name);
+     if (mp) {
+ 	mp->handler = (Expr *(*)())handler;
+ 	if (mp->isfunction) {
+ 	    warning(format_s("Procedure %s was declared as a function [119]", name));
+ 	    mp->isfunction = 0;
+ 	}
+     } else if (debug > 0)
+ 	warning(format_s("Procedure %s was never declared [120]", name));
+     return mp;
+ }
+ 
+ 
+ 
+ Static Expr *nullspecialfunc(mp)
+ Meaning *mp;
+ {
+     warning(format_s("Function %s not yet supported [121]", mp->name));
+     if (curtok == TOK_LPAR)
+         skipparens();
+     return makeexpr_long(0);
+ }
+ 
+ Meaning *makespecialfunc(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+     Meaning *mp;
+ 
+     if (!handler)
+         handler = nullspecialfunc;
+     mp = makestandardmeaning(MK_SPECIAL, name);
+     mp->isfunction = 1;
+     mp->handler = handler;
+     return mp;
+ }
+ 
+ 
+ 
+ Static Expr *nullstandardfunc(ex)
+ Expr *ex;
+ {
+     warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
+     return ex;
+ }
+ 
+ Meaning *makestandardfunc(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+     Meaning *mp;
+ 
+     if (!handler)
+         handler = nullstandardfunc;
+     mp = findstandardmeaning(MK_FUNCTION, name);
+     if (mp) {
+ 	mp->handler = handler;
+ 	if (!mp->isfunction) {
+ 	    warning(format_s("Function %s was declared as a procedure [122]", name));
+ 	    mp->isfunction = 1;
+ 	}
+     } else if (debug > 0)
+ 	warning(format_s("Function %s was never declared [123]", name));
+     return mp;
+ }
+ 
+ 
+ 
+ 
+ Static Expr *nullspecialvar(mp)
+ Meaning *mp;
+ {
+     warning(format_s("Variable %s not yet supported [124]", mp->name));
+     if (curtok == TOK_LPAR || curtok == TOK_LBR)
+         skipparens();
+     return makeexpr_var(mp);
+ }
+ 
+ Meaning *makespecialvar(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+     Meaning *mp;
+ 
+     if (!handler)
+         handler = nullspecialvar;
+     mp = makestandardmeaning(MK_SPVAR, name);
+     mp->handler = handler;
+     return mp;
+ }
+ 
+ 
+ 
+ 
+ 
+ void setup_decl()
+ {
+     Meaning *mp, *mp2, *mp_turbo_shortint;
+     Symbol *sym;
+     Type *tp;
+     int i;
+ 
+     numimports = 0;
+     firstimport = 0;
+     permimports = NULL;
+     stringceiling = stringceiling | 1;   /* round up to odd */
+     stringtypecachesize = (stringceiling + 1) >> 1;
+     stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
+     curctxlast = NULL;
+     curctx = NULL;   /* the meta-ctx has no parent ctx */
+     curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
+     strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
+     ptrbase = NULL;
+     tempvars = NULL;
+     stmttempvars = NULL;
+     tempvarcount = 0;
+     deferallptrs = 0;
+     silentalreadydef = 0;
+     varstructdecllist = NULL;
+     nonloclabelcount = -1;
+     for (i = 0; i < stringtypecachesize; i++)
+         stringtypecache[i] = NULL;
+ 
+     tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
+                      (integer16) ? "LONGINT" : "INTEGER"));
+     tp_integer->smin = makeexpr_long(MININT);             /* "long" */
+     tp_integer->smax = makeexpr_long(MAXINT);
+ 
+     if (sizeof_int >= 32) {
+         tp_int = tp_integer;                              /* "int" */
+     } else {
+         tp_int = makestandardtype(TK_INTEGER,
+                      (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
+ 				     : NULL);
+         tp_int->smin = makeexpr_long(min_sshort);
+         tp_int->smax = makeexpr_long(max_sshort);
+     }
+     mp = makestandardmeaning(MK_TYPE, "C_INT");
+     mp->type = tp_int;
+     if (!tp_int->meaning)
+ 	tp_int->meaning = mp;
+ 
+     mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
+     tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
+     tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
+     tp_unsigned->smax = makeexpr_long(MAXINT);
+ 
+     if (sizeof_int >= 32) {
+         tp_uint = tp_unsigned;                            /* "unsigned int" */
+ 	mp_uint = mp_unsigned;
+     } else {
+ 	mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
+         tp_uint = makestandardtype(TK_INTEGER, mp_uint);
+         tp_uint->smin = makeexpr_long(0);
+         tp_uint->smax = makeexpr_long(MAXINT);
+     }
+ 
+     tp_sint = makestandardtype(TK_INTEGER, NULL);
+     tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
+     tp_sint->smax = copyexpr(tp_int->smax);
+ 
+     tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
+     if (unsignedchar == 0) {
+ 	tp_char->smin = makeexpr_long(-128);              /* "char" */
+ 	tp_char->smax = makeexpr_long(127);
+     } else {
+ 	tp_char->smin = makeexpr_long(0);
+ 	tp_char->smax = makeexpr_long(255);
+     }
+ 
+     tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
+     tp_charptr->basetype = tp_char;
+     tp_char->pointertype = tp_charptr;
+ 
+     mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
+     tp_schar = makestandardtype(TK_CHAR, mp_schar);
+     tp_schar->smin = makeexpr_long(-128);
+     tp_schar->smax = makeexpr_long(127);
+ 
+     mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
+     tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
+     tp_uchar->smin = makeexpr_long(0);
+     tp_uchar->smax = makeexpr_long(255);
+ 
+     tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
+     tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
+     tp_boolean->smax = makeexpr_long(1);
+ 
+     sym = findsymbol("Boolean");
+     sym->flags |= SSYNONYM;
+     strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
+ 
+     tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
+                                                           /* "float" or "double" */
+     mp = makestandardmeaning(MK_TYPE, "LONGREAL");
+     if (doublereals)
+ 	mp->type = tp_longreal = tp_real;
+     else
+ 	tp_longreal = makestandardtype(TK_REAL, mp);
+ 
+     tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */
+ 
+     mp = makestandardmeaning(MK_TYPE, "SINGLE");
+     if (doublereals)
+ 	makestandardtype(TK_REAL, mp);
+     else
+ 	mp->type = tp_real;
+     makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
+     mp = makestandardmeaning(MK_TYPE, "DOUBLE");
+     mp->type = tp_longreal;
+     mp = makestandardmeaning(MK_TYPE, "EXTENDED");
+     mp->type = tp_longreal;   /* good enough */
+     mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
+     mp->type = tp_longreal;   /* good enough */
+ 
+     tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
+                   (integer16 == 1) ? "INTEGER" : "SWORD"));
+     tp_sshort->basetype = tp_integer;                     /* "short" */
+     tp_sshort->smin = makeexpr_long(min_sshort);
+     tp_sshort->smax = makeexpr_long(max_sshort);
+ 
+     if (integer16) {
+ 	if (integer16 != 2) {
+ 	    mp = makestandardmeaning(MK_TYPE, "SWORD");
+ 	    mp->type = tp_sshort;
+ 	}
+     } else {
+ 	mp = makestandardmeaning(MK_TYPE, "LONGINT");
+ 	mp->type = tp_integer;
+     }
+ 
+     tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
+     tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
+     tp_ushort->smin = makeexpr_long(0);
+     tp_ushort->smax = makeexpr_long(max_ushort);
+ 
+     mp = makestandardmeaning(MK_TYPE, "CARDINAL");
+     mp->type = (integer16) ? tp_ushort : tp_unsigned;
+     mp = makestandardmeaning(MK_TYPE, "LONGCARD");
+     mp->type = tp_unsigned;
+ 
+     if (modula2) {
+ 	mp = makestandardmeaning(MK_TYPE, "WORD");
+ 	mp->type = tp_integer;
+     } else {
+ 	makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
+     }
+ 
+     tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
+     tp_sbyte->basetype = tp_integer;
+     tp_sbyte->smin = makeexpr_long(min_schar);
+     tp_sbyte->smax = makeexpr_long(max_schar);
+ 
+     mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
+     mp = makestandardmeaning(MK_TYPE, "SBYTE");
+     if (needsignedbyte || signedchars == 1 || hassignedchar) {
+ 	mp->type = tp_sbyte;
+ 	if (mp_turbo_shortint)
+ 	    mp_turbo_shortint->type = tp_sbyte;
+ 	tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
+     } else {
+ 	mp->type = tp_sshort;
+ 	if (mp_turbo_shortint)
+ 	    mp_turbo_shortint->type = tp_sshort;
+     }
+ 
+     tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
+     tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
+     tp_ubyte->smin = makeexpr_long(0);
+     tp_ubyte->smax = makeexpr_long(max_uchar);
+ 
+     if (signedchars == 1)
+         tp_abyte = tp_sbyte;                              /* "char" */
+     else if (signedchars == 0)
+         tp_abyte = tp_ubyte;
+     else {
+         tp_abyte = makestandardtype(TK_SUBR, NULL);
+         tp_abyte->basetype = tp_integer;
+         tp_abyte->smin = makeexpr_long(0);
+         tp_abyte->smax = makeexpr_long(max_schar);
+     }
+ 
+     mp = makestandardmeaning(MK_TYPE, "POINTER");
+     mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
+     tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
+     ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
+     tp_anyptr->basetype = tp_void;                        /* "void *" */
+     tp_void->pointertype = tp_anyptr;
+ 
+     if (useAnyptrMacros == 1) {
+         tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
+         tp_special_anyptr->basetype = tp_integer;
+         tp_special_anyptr->smin = makeexpr_long(0);
+         tp_special_anyptr->smax = makeexpr_long(max_schar);
+     } else
+         tp_special_anyptr = NULL;
+ 
+     tp_proc = maketype(TK_PROCPTR);
+     tp_proc->basetype = maketype(TK_FUNCTION);
+     tp_proc->basetype->basetype = tp_void;
+     tp_proc->escale = 1;   /* saved "hasstaticlinks" */
+ 
+     tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
+     tp_str255->basetype = tp_char;
+     tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
+     tp_str255->indextype->basetype = tp_integer;
+     tp_str255->indextype->smin = makeexpr_long(0);
+     tp_str255->indextype->smax = makeexpr_long(stringceiling);
+ 
+     tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
+     tp_str255->pointertype = tp_strptr;
+     tp_strptr->basetype = tp_str255;
+ 
+     mp_string = makestandardmeaning(MK_TYPE, "STRING");
+     tp = makestandardtype(TK_STRING, mp_string);
+     tp->basetype = tp_char;
+     tp->indextype = tp_str255->indextype;
+ 
+     tp_smallset = maketype(TK_SMALLSET);
+     tp_smallset->basetype = tp_integer;
+     tp_smallset->indextype = tp_boolean;
+ 
+     tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
+     tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
+     tp_text->basetype->basetype = tp_char;
+     tp_text->basetype->pointertype = tp_text;
+ 
+     tp_bigtext = makestandardtype(TK_BIGFILE, makestandardmeaning(MK_TYPE, "BIGTEXT"));
+     tp_bigtext->basetype = tp_char;
+     tp_bigtext->meaning->name = stralloc("_TEXT");
+     tp_bigtext->meaning->wasdeclared = 1;
+ 
+     tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
+ 
+     mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
+     mp->type = tp_text;
+ 
+     mp = makestandardmeaning(MK_TYPE, "BITSET");
+     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
+ 					    makeexpr_long(setbits-1)));
+     mp->type->meaning = mp;
+ 
+     mp = makestandardmeaning(MK_TYPE, "INTSET");
+     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
+ 					    makeexpr_long(defaultsetsize-1)));
+     mp->type->meaning = mp;
+ 
+     mp_input = makestandardmeaning(MK_VAR, "INPUT");
+     mp_input->type = tp_text;
+     mp_input->name = stralloc("stdin");
+     ex_input = makeexpr_var(mp_input);
+ 
+     mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
+     mp_output->type = tp_text;
+     mp_output->name = stralloc("stdout");
+     ex_output = makeexpr_var(mp_output);
+ 
+     mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
+     mp_stderr->type = tp_text;
+     mp_stderr->name = stralloc("stderr");
+ 
+     mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
+     mp_escapecode->type = tp_sshort;
+     mp_escapecode->name = stralloc(name_ESCAPECODE);
+ 
+     mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
+     mp_ioresult->type = tp_integer;
+     mp_ioresult->name = stralloc(name_IORESULT);
+ 
+     mp_false = makestandardmeaning(MK_CONST, "FALSE");
+     mp_false->type = mp_false->val.type = tp_boolean;
+     mp_false->val.i = 0;
+ 
+     mp_true = makestandardmeaning(MK_CONST, "TRUE");
+     mp_true->type = mp_true->val.type = tp_boolean;
+     mp_true->val.i = 1;
+ 
+     mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
+     mp_maxint->type = mp_maxint->val.type = tp_integer;
+     mp_maxint->val.i = MAXINT;
+     mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
+                                (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
+ 
+     mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
+     mp->type = mp->val.type = tp_integer;
+     mp->val.i = MAXINT;
+     mp->name = stralloc("LONG_MAX");
+ 
+     mp_minint = makestandardmeaning(MK_CONST, "MININT");
+     mp_minint->type = mp_minint->val.type = tp_integer;
+     mp_minint->val.i = MININT;
+     mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
+                                (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
+ 
+     mp = makestandardmeaning(MK_CONST, "MAXCHAR");
+     mp->type = mp->val.type = tp_char;
+     mp->val.i = 127;
+     mp->name = stralloc("CHAR_MAX");
+ 
+     mp = makestandardmeaning(MK_CONST, "MINCHAR");
+     mp->type = mp->val.type = tp_char;
+     mp->val.i = 0;
+     mp->anyvarflag = 1;
+ 
+     mp = makestandardmeaning(MK_CONST, "BELL");
+     mp->type = mp->val.type = tp_char;
+     mp->val.i = 7;
+     mp->anyvarflag = 1;
+ 
+     mp = makestandardmeaning(MK_CONST, "TAB");
+     mp->type = mp->val.type = tp_char;
+     mp->val.i = 9;
+     mp->anyvarflag = 1;
+ 
+     mp_str_hp = mp_str_turbo = NULL;
+     mp_val_modula = mp_val_turbo = NULL;
+     mp_blockread_ucsd = mp_blockread_turbo = NULL;
+     mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
+     mp_dec_dec = mp_dec_turbo = NULL;
+ }
+ 
+ 
+ 
+ /* This makes sure that if A imports B and then C, C's interface is not
+    parsed in the environment of B */
+ int push_imports()
+ {
+     int mark = firstimport;
+     Meaning *mp;
+ 
+     while (firstimport < numimports) {
+ 	if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
+ 	    for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
+ 		mp->isactive = 0;
+ 	}
+         firstimport++;
+     }
+     return mark;
+ }
+ 
+ 
+ 
+ void pop_imports(mark)
+ int mark;
+ {
+     Meaning *mp;
+ 
+     while (firstimport > mark) {
+         firstimport--;
+         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
+             mp->isactive = 1;
+     }
+ }
+ 
+ 
+ 
+ void import_ctx(ctx)
+ Meaning *ctx;
+ {
+     Meaning *mp;
+     int i;
+ 
+     for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
+     if (i >= numimports) {
+         if (numimports == MAXIMPORTS)
+             error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
+         importlist[numimports++] = ctx;
+     }
+     for (mp = ctx->cbase; mp; mp = mp->cnext) {
+         if (mp->exported)
+             mp->isactive = 1;
+     }
+ }
+ 
+ 
+ 
+ void perm_import(ctx)
+ Meaning *ctx;
+ {
+     Meaning *mp;
+ 
+     /* Import permanently, as in Turbo's "system" unit */
+     for (mp = ctx->cbase; mp; mp = mp->cnext) {
+         if (mp->exported)
+             mp->isactive = 1;
+     }
+ }
+ 
+ 
+ 
+ void unimport(mark)
+ int mark;
+ {
+     Meaning *mp;
+ 
+     while (numimports > mark) {
+         numimports--;
+ 	if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
+ 	    for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
+ 		mp->isactive = 0;
+ 	}
+     }
+ }
+ 
+ 
+ 
+ 
+ void activatemeaning(mp)
+ Meaning *mp;
+ {
+     Meaning *mp2;
+ 
+     if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
+     mp->isactive = 1;
+     if (mp->sym->mbase != mp) {     /* move to front of symbol list */
+         mp2 = mp->sym->mbase;
+         for (;;) {
+             if (!mp2) {
+ 		/* Not on symbol list: must be a special kludge meaning */
+                 return;
+             }
+             if (mp2->snext == mp)
+                 break;
+             mp2 = mp2->snext;
+         }
+         mp2->snext = mp->snext;
+         mp->snext = mp->sym->mbase;
+         mp->sym->mbase = mp;
+     }
+ }
+ 
+ 
+ 
+ void pushctx(ctx)
+ Meaning *ctx;
+ {
+     struct ctxstack *top;
+ 
+     top = ALLOC(1, struct ctxstack, ctxstacks);
+     top->ctx = curctx;
+     top->ctxlast = curctxlast;
+     top->tempvars = tempvars;
+     top->tempvarcount = tempvarcount;
+     top->importmark = numimports;
+     top->next = ctxtop;
+     ctxtop = top;
+     curctx = ctx;
+     curctxlast = ctx->cbase;
+     if (curctxlast) {
+         activatemeaning(curctxlast);
+         while (curctxlast->cnext) {
+             curctxlast = curctxlast->cnext;
+             activatemeaning(curctxlast);
+         }
+     }
+     tempvars = NULL;
+     tempvarcount = 0;
+     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
+ 	progress();
+ }
+ 
+ 
+ 
+ void popctx()
+ {
+     struct ctxstack *top;
+     struct tempvarlist *tv;
+     Meaning *mp;
+ 
+     if (!strlist_cifind(permimports, curctx->sym->name)) {
+ 	for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ 	    if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
+ 	    mp->isactive = 0;
+ 	}
+     }
+     top = ctxtop;
+     ctxtop = top->next;
+     curctx = top->ctx;
+     curctxlast = top->ctxlast;
+     while (tempvars) {
+         tv = tempvars->next;
+         FREE(tempvars);
+         tempvars = tv;
+     }
+     tempvars = top->tempvars;
+     tempvarcount = top->tempvarcount;
+     unimport(top->importmark);
+     FREE(top);
+     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
+ 	progress();
+ }
+ 
+ 
+ 
+ void forget_ctx(ctx, all)
+ Meaning *ctx;
+ int all;
+ {
+     register Meaning *mp, **mpprev, *mp2, **mpp2;
+ 
+     if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
+ 	mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
+     else
+ 	mpprev = &ctx->cbase;
+     while ((mp = *mpprev) != NULL) {
+ 	if (all ||
+ 	    (mp->kind != MK_PARAM &&
+ 	     mp->kind != MK_VARPARAM)) {
+ 	    *mpprev = mp->cnext;
+ 	    mpp2 = &mp->sym->mbase;
+ 	    while ((mp2 = *mpp2) != NULL && mp2 != mp)
+ 		mpp2 = &mp2->snext;
+ 	    if (mp2)
+ 		*mpp2 = mp2->snext;
+ 	    if (mp->kind == MK_CONST)
+ 		free_value(&mp->val);
+ 	    freeexpr(mp->constdefn);
+ 	    if (mp->cbase)
+ 		forget_ctx(mp, 1);
+ 	    if (mp->kind == MK_FUNCTION && mp->val.i)
+ 		free_stmt((Stmt *)mp->val.i);
+ 	    strlist_empty(&mp->comments);
+ 	    if (mp->name)
+ 		FREE(mp->name);
+ 	    if (mp->othername)
+ 		FREE(mp->othername);
+ 	    FREE(mp);
+ 	} else
+ 	    mpprev = &mp->cnext;
+     }
+ }
+ 
+ 
+ 
+ 
+ void handle_nameof()
+ {
+     Strlist *sl, *sl2;
+     Symbol *sp;
+     char *cp;
+ 
+     for (sl = nameoflist; sl; sl = sl->next) {
+         cp = my_strchr(sl->s, '.');
+         if (cp) {
+             sp = findsymbol(fixpascalname(cp + 1));
+             sl2 = strlist_add(&sp->symbolnames, 
+                               format_ds("%.*s", (int)(cp - sl->s), sl->s));
+         } else {
+             sp = findsymbol(fixpascalname(sl->s));
+             sl2 = strlist_add(&sp->symbolnames, "");
+         }
+         sl2->value = sl->value;
+         if (debug > 0)
+             fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
+                           sp->name, sl2->s, sl2->value);
+     }
+     strlist_empty(&nameoflist);
+ }
+ 
+ 
+ 
+ Static void initmeaning(mp)
+ Meaning *mp;
+ {
+ /*    mp->serial = curserial = ++serialcount;    */
+     mp->cbase = NULL;
+     mp->xnext = NULL;
+     mp->othername = NULL;
+     mp->type = NULL;
+     mp->dtype = NULL;
+     mp->needvarstruct = 0;
+     mp->varstructflag = 0;
+     mp->wasdeclared = 0;
+     mp->isforward = 0;
+     mp->isfunction = 0;
+     mp->istemporary = 0;
+     mp->volatilequal = 0;
+     mp->constqual = 0;
+     mp->warnifused = (warnnames > 0);
+     mp->constdefn = NULL;
+     mp->val.i = 0;
+     mp->val.s = NULL;
+     mp->val.type = NULL;
+     mp->refcount = 1;
+     mp->anyvarflag = 0;
+     mp->isactive = 1;
+     mp->exported = 0;
+     mp->handler = NULL;
+     mp->dumped = 0;
+     mp->isreturn = 0;
+     mp->fakeparam = 0;
+     mp->namedfile = 0;
+     mp->bufferedfile = 0;
+     mp->comments = NULL;
+ }
+ 
+ 
+ 
+ int issafename(sp, isglobal, isdefine)
+ Symbol *sp;
+ int isglobal, isdefine;
+ {
+     if (isdefine && curctx->kind != MK_FUNCTION) {
+ 	if (sp->flags & FWDPARAM)
+ 	    return 0;
+     }
+     if ((sp->flags & AVOIDNAME) ||
+ 	(isdefine && (sp->flags & AVOIDFIELD)) ||
+         (isglobal && (sp->flags & AVOIDGLOB)))
+         return 0;
+     else
+         return 1;
+ }
+ 
+ 
+ 
+ static Meaning *enum_tname;
+ 
+ void setupmeaning(mp, sym, kind, namekind)
+ Meaning *mp;
+ Symbol *sym;
+ enum meaningkind kind, namekind;
+ {
+     char *name, *symfmt, *editfmt, *cp, *cp2;
+     int altnum, isglobal, isdefine;
+     Symbol *sym2;
+     Strlist *sl;
+ 
+     if (!sym)
+ 	sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
+     if (sym->mbase && sym->mbase->ctx == curctx &&
+ 	curctx != NULL && !silentalreadydef)
+         alreadydef(sym);
+     mp->sym = sym;
+     mp->snext = sym->mbase;
+     sym->mbase = mp;
+     if (sym == curtoksym) {
+ 	sym->kwtok = TOK_NONE;
+ 	sym->flags &= ~KWPOSS;
+     }
+     mp->ctx = curctx;
+     mp->kind = kind;
+     if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
+ 	strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
+ 	Meaning *mp2;
+ 	if (islower(sym->name[0]))
+ 	    sym2 = findsymbol(strupper(sym->name));
+ 	else
+ 	    sym2 = findsymbol(strlower(sym->name));
+ 	mp2 = addmeaning(sym2, MK_SYNONYM);
+ 	mp2->xnext = mp;
+     }
+     if (kind == MK_VAR) {
+         sl = strlist_find(varmacros, sym->name);
+         if (sl) {
+             kind = namekind = MK_VARMAC;
+             mp->constdefn = (Expr *)sl->value;
+             strlist_delete(&varmacros, sl);
+         }
+     }
+     if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
+         sl = strlist_find(funcmacros, sym->name);
+         if (sl) {
+             mp->constdefn = (Expr *)sl->value;
+             strlist_delete(&funcmacros, sl);
+         }
+     }
+     if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
+ 	kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
+         mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
+ 	if (blockkind == TOK_IMPORT)
+ 	    mp->wasdeclared = 1;   /* suppress future declaration */
+     } else
+         mp->exported = 0;
+     if (sym == curtoksym)
+         name = curtokcase;
+     else
+         name = sym->name;
+     isdefine = (namekind == MK_CONST || (namekind == MK_VARIANT && !useenum));
+     isglobal = (!curctx ||
+ 		curctx->kind != MK_FUNCTION ||
+                 namekind == MK_FUNCTION ||
+ 		namekind == MK_TYPE ||
+ 		namekind == MK_VARIANT ||
+                 isdefine) &&
+                (curctx != nullctx);
+     mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
+     if (namekind == MK_SYNONYM)
+ 	return;
+     if (!mp->exported || !*exportsymbol)
+         symfmt = "";
+     else if (*export_symbol && my_strchr(name, '_'))
+         symfmt = export_symbol;
+     else
+         symfmt = exportsymbol;
+     wasaliased = 0;
+     if (*externalias && !my_strchr(externalias, '%')) {
+         register int i;
+         name = format_s("%s", externalias);
+         i = numparams;
+         while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
+         if (i < 0 || !undooption(i, ""))
+             *externalias = 0;
+         wasaliased = 1;
+     } else if (sym->symbolnames) {
+         if (curctx) {
+             if (debug > 2)
+                 fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
+             sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
+             if (sl) {
+                 if (debug > 2)
+                     fprintf(outf, "found \"%s\"\n", sl->value);
+                 name = (char *)sl->value;
+                 wasaliased = 1;
+             }
+         }
+         if (!wasaliased) {
+             if (debug > 2)
+                 fprintf(outf, "checking for \"\" of %s\n", sym->name);
+             sl = strlist_find(sym->symbolnames, "");
+             if (sl) {
+                 if (debug > 2)
+                     fprintf(outf, "found \"%s\"\n", sl->value);
+                 name = (char *)sl->value;
+                 wasaliased = 1;
+             }
+         }
+     }
+     if (!*symfmt || wasaliased)
+ 	symfmt = "%s";
+     altnum = -1;
+     do {
+         altnum++;
+         cp = format_ss(symfmt, name, curctx ? curctx->name : "");
+ 	switch (namekind) {
+ 
+ 	  case MK_CONST:
+ 	    editfmt = constformat;
+ 	    break;
+ 
+ 	  case MK_MODULE:
+ 	    editfmt = moduleformat;
+ 	    break;
+ 
+ 	  case MK_FUNCTION:
+ 	    editfmt = functionformat;
+ 	    break;
+ 
+ 	  case MK_VAR:
+ 	  case MK_VARPARAM:
+ 	  case MK_VARREF:
+ 	  case MK_VARMAC:
+ 	  case MK_SPVAR:
+ 	    editfmt = varformat;
+ 	    break;
+ 
+ 	  case MK_TYPE:
+ 	    editfmt = typeformat;
+ 	    break;
+ 
+ 	  case MK_VARIANT:   /* A true kludge! */
+ 	    editfmt = enumformat;
+ 	    if (!*editfmt)
+ 		editfmt = useenum ? varformat : constformat;
+ 	    break;
+ 
+ 	  default:
+ 	    editfmt = "";
+ 	}
+ 	if (!*editfmt)
+ 	    editfmt = symbolformat;
+ 	if (*editfmt)
+ 	    if (editfmt == enumformat)
+ 		cp = format_ss(editfmt, cp,
+ 			       enum_tname ? enum_tname->name : "ENUM");
+ 	    else
+ 		cp = format_ss(editfmt, cp,
+ 			       curctx ? curctx->name : "");
+ 	if (dollar_idents == 2) {
+ 	    for (cp2 = cp; *cp2; cp2++)
+ 		if (*cp2 == '$' || *cp2 == '%')
+ 		    *cp2 = '_';
+ 	}
+         sym2 = findsymbol(findaltname(cp, altnum));
+     } while (!issafename(sym2, isglobal, isdefine) &&
+ 	     namekind != MK_MODULE && !wasaliased);
+     mp->name = stralloc(sym2->name);
+     if (sym2->flags & WARNNAME)
+         note(format_s("A symbol named %s was defined [100]", mp->name));
+     if (isglobal) {
+         switch (namekind) {     /* prevent further name conflicts */
+ 
+             case MK_CONST:
+ 	    case MK_VARIANT:
+             case MK_TYPE:
+                 sym2->flags |= AVOIDNAME;
+                 break;
+ 
+             case MK_VAR:
+             case MK_VARREF:
+             case MK_FUNCTION:
+                 sym2->flags |= AVOIDGLOB;
+                 break;
+ 
+ 	    default:
+ 		/* name is completely local */
+ 		break;
+         }
+     }
+     if (debug > 4)
+ 	fprintf(outf, "Created meaning %s\n", mp->name);
+ }
+ 
+ 
+ 
+ Meaning *addmeaningas(sym, kind, namekind)
+ Symbol *sym;
+ enum meaningkind kind, namekind;
+ {
+     Meaning *mp;
+ 
+     mp = ALLOC(1, Meaning, meanings);
+     initmeaning(mp);
+     setupmeaning(mp, sym, kind, namekind);
+     mp->cnext = NULL;
+     if (curctx) {
+         if (curctxlast)
+             curctxlast->cnext = mp;
+         else
+             curctx->cbase = mp;
+         curctxlast = mp;
+     }
+     return mp;
+ }
+ 
+ 
+ 
+ Meaning *addmeaning(sym, kind)
+ Symbol *sym;
+ enum meaningkind kind;
+ {
+     return addmeaningas(sym, kind, kind);
+ }
+ 
+ 
+ 
+ Meaning *addmeaningafter(mpprev, sym, kind)
+ Meaning *mpprev;
+ Symbol *sym;
+ enum meaningkind kind;
+ {
+     Meaning *mp;
+ 
+     if (!mpprev->cnext && mpprev->ctx == curctx)
+         return addmeaning(sym, kind);
+     mp = ALLOC(1, Meaning, meanings);
+     initmeaning(mp);
+     setupmeaning(mp, sym, kind, kind);
+     mp->ctx = mpprev->ctx;
+     mp->cnext = mpprev->cnext;
+     mpprev->cnext = mp;
+     return mp;
+ }
+ 
+ 
+ void unaddmeaning(mp)
+ Meaning *mp;
+ {
+     Meaning *prev;
+ 
+     prev = mp->ctx;
+     while (prev && prev != mp)
+ 	prev = prev->cnext;
+     if (prev)
+ 	prev->cnext = mp->cnext;
+     else
+ 	mp->ctx = mp->cnext;
+     if (!mp->cnext && mp->ctx == curctx)
+ 	curctxlast = prev;
+ }
+ 
+ 
+ void readdmeaning(mp)
+ Meaning *mp;
+ {
+     mp->cnext = NULL;
+     if (curctx) {
+         if (curctxlast)
+             curctxlast->cnext = mp;
+         else
+             curctx->cbase = mp;
+         curctxlast = mp;
+     }
+ }
+ 
+ 
+ Meaning *addfield(sym, flast, rectype, tname)
+ Symbol *sym;
+ Meaning ***flast;
+ Type *rectype;
+ Meaning *tname;
+ {
+     Meaning *mp;
+     int altnum;
+     Symbol *sym2;
+     Strlist *sl;
+     char *name, *name2;
+ 
+     mp = ALLOC(1, Meaning, meanings);
+     initmeaning(mp);
+     mp->sym = sym;
+     if (sym) {
+         mp->snext = sym->fbase;
+         sym->fbase = mp;
+         if (sym == curtoksym)
+             name2 = curtokcase;
+         else
+             name2 = sym->name;
+ 	name = name2;
+         if (tname)
+             sl = strlist_find(fieldmacros,
+                               format_ss("%s.%s", tname->sym->name, sym->name));
+         else
+             sl = NULL;
+         if (sl) {
+             mp->constdefn = (Expr *)sl->value;
+             strlist_delete(&fieldmacros, sl);
+             altnum = 0;
+         } else {
+             altnum = -1;
+             do {
+                 altnum++;
+ 		if (*fieldformat)
+ 		    name = format_ss(fieldformat, name2,
+ 				     tname && tname->name ? tname->name
+ 				                          : "FIELD");
+                 sym2 = findsymbol(findaltname(name, altnum));
+             } while (!issafename(sym2, 0, 0) ||
+ 		     ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
+ 	    sym2->flags |= AVOIDFIELD;
+         }
+         mp->kind = MK_FIELD;
+         mp->name = stralloc(findaltname(name, altnum));
+     } else {
+         mp->name = stralloc("(variant)");
+         mp->kind = MK_VARIANT;
+     }
+     mp->cnext = NULL;
+     **flast = mp;
+     *flast = &(mp->cnext);
+     mp->ctx = NULL;
+     mp->rectype = rectype;
+     mp->val.i = 0;
+     return mp;
+ }
+ 
+ 
+ 
+ 
+ 
+ int isfiletype(type, big)
+ Type *type;
+ int big;   /* 0=TK_FILE, 1=TK_BIGFILE, -1=either */
+ {
+     return ((type->kind == TK_POINTER &&
+ 	     type->basetype->kind == TK_FILE && big != 1) ||
+ 	    (type->kind == TK_BIGFILE && big != 0));
+ }
+ 
+ 
+ Meaning *isfilevar(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (ex->kind == EK_VAR) {
+ 	mp = (Meaning *)ex->val.i;
+ 	if (mp->kind == MK_VAR)
+ 	    return mp;
+     } else if (ex->kind == EK_DOT) {
+ 	mp = (Meaning *)ex->val.i;
+ 	if (mp && mp->kind == MK_FIELD)
+ 	    return mp;
+     }
+     return NULL;
+ }
+ 
+ 
+ Type *filebasetype(type)
+ Type *type;
+ {
+     if (type->kind == TK_BIGFILE)
+ 	return type->basetype;
+     else
+ 	return type->basetype->basetype;
+ }
+ 
+ 
+ Expr *filebasename(ex)
+ Expr *ex;
+ {
+     if (ex->val.type->kind == TK_BIGFILE)
+ 	return makeexpr_dotq(ex, "f", ex->val.type);
+     else
+ 	return ex;
+ }
+ 
+ 
+ Expr *filenamepart(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (ex->val.type->kind == TK_BIGFILE)
+ 	return makeexpr_dotq(copyexpr(ex), "name", tp_str255);
+     else if ((mp = isfilevar(ex)) && mp->namedfile)
+ 	return makeexpr_name(format_s(name_FNVAR, mp->name), tp_str255);
+     else
+ 	return NULL;
+ }
+ 
+ 
+ int fileisbuffered(ex, maybe)
+ Expr *ex;
+ int maybe;
+ {
+     Meaning *mp;
+ 
+     return (ex->val.type->kind == TK_BIGFILE ||
+ 	    ((mp = isfilevar(ex)) && (maybe || mp->bufferedfile)));
+ }
+ 
+ 
+ 
+ Type *findbasetype_(type, flags)
+ Type *type;
+ int flags;
+ {
+     long smin, smax;
+     static Type typename;
+ 
+     for (;;) {
+ 	if (type->preserved && (type->kind != TK_POINTER) &&
+ 	    !(flags & ODECL_NOPRES))
+ 	    return type;
+         switch (type->kind) {
+ 
+             case TK_POINTER:
+ 	        if (type->smin)    /* unresolved forward */
+ 		    return type;
+                 if (type->basetype == tp_void) {     /* ANYPTR */
+                     if (tp_special_anyptr)
+                         return tp_special_anyptr;   /* write "Anyptr" */
+                     if (!voidstar)
+                         return tp_abyte;    /* write "char *", not "void *" */
+                 }
+                 switch (type->basetype->kind) {
+ 
+                     case TK_ARRAY:       /* use basetype's basetype: */
+                     case TK_STRING:      /* ^array[5] of array[3] of integer */
+                     case TK_SET:         /*  => int (*a)[3]; */
+ 		        if (stararrays == 1 ||
+ 			    !(flags & ODECL_FREEARRAY) ||
+ 			    type->basetype->structdefd) {
+ 			    type = type->basetype->basetype;
+ 			    flags &= ~ODECL_CHARSTAR;
+ 			    continue;
+ 			}
+                         break;
+ 
+ 		    default:
+ 			break;
+                 }
+ 		if (type->preserved && !(flags & ODECL_NOPRES))
+ 		    return type;
+ 		if (type->fbase && type->fbase->wasdeclared &&
+ 		    (flags & ODECL_DECL)) {
+ 		    typename.meaning = type->fbase;
+ 		    typename.preserved = 1;
+ 		    return &typename;
+ 		}
+                 break;
+ 
+             case TK_FUNCTION:
+             case TK_STRING:
+             case TK_SET:
+             case TK_SMALLSET:
+             case TK_SMALLARRAY:
+                 if (!type->basetype)
+                     return type;
+                 break;
+ 
+             case TK_ARRAY:
+                 if (type->meaning && type->meaning->kind == MK_TYPE &&
+                     type->meaning->wasdeclared)
+                     return type;
+ 		if (type->fbase && type->fbase->wasdeclared &&
+ 		    (flags & ODECL_DECL)) {
+ 		    typename.meaning = type->fbase;
+ 		    typename.preserved = 1;
+ 		    return &typename;
+ 		}
+                 break;
+ 
+             case TK_FILE:
+                 return tp_text->basetype;
+ 
+             case TK_PROCPTR:
+ 		return tp_proc;
+ 
+ 	    case TK_CPROCPTR:
+ 		type = type->basetype->basetype;
+ 		continue;
+ 
+             case TK_ENUM:
+                 if (useenum)
+                     return type;
+                 else if (!enumbyte ||
+ 			 type->smax->kind != EK_CONST ||
+ 			 type->smax->val.i > 255)
+ 		    return tp_sshort;
+ 		else if (type->smax->val.i > 127)
+                     return tp_ubyte;
+ 		else
+                     return tp_abyte;
+ 
+             case TK_BOOLEAN:
+                 if (*name_BOOLEAN)
+                     return type;
+                 else
+                     return tp_ubyte;
+ 
+             case TK_SUBR:
+                 if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
+                     type == tp_ushort || type == tp_sshort) {
+                     return type;
+                 } else if ((type->basetype->kind == TK_ENUM && useenum) ||
+                            type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
+                     return type->basetype;
+                 } else {
+                     if (ord_range(type, &smin, &smax)) {
+                         if (squeezesubr != 0) {
+                             if (smin >= 0 && smax <= max_schar)
+                                 return tp_abyte;
+                             else if (smin >= 0 && smax <= max_uchar)
+                                 return tp_ubyte;
+                             else if (smin >= min_schar && smax <= max_schar &&
+ 				     (signedchars == 1 || hassignedchar))
+                                 return tp_sbyte;
+                             else if (smin >= min_sshort && smax <= max_sshort)
+                                 return tp_sshort;
+                             else if (smin >= 0 && smax <= max_ushort)
+                                 return tp_ushort;
+                             else
+                                 return tp_integer;
+                         } else {
+                             if (smin >= min_sshort && smax <= max_sshort)
+                                 return tp_sshort;
+                             else
+                                 return tp_integer;
+                         }
+                     } else
+                         return tp_integer;
+                 }
+ 
+ 	    case TK_CHAR:
+ 		if (type == tp_schar &&
+ 		    (signedchars != 1 && !hassignedchar)) {
+ 		    return tp_sshort;
+ 		}
+ 		return type;
+ 
+             default:
+                 return type;
+         }
+         type = type->basetype;
+     }
+ }
+ 
+ 
+ Type *findbasetype(type, flags)
+ Type *type;
+ int flags;
+ {
+     if (debug>1) {
+ 	fprintf(outf, "findbasetype(");
+ 	dumptypename(type, 1);
+ 	fprintf(outf, ",%d) = ", flags);
+ 	type = findbasetype_(type, flags);
+ 	dumptypename(type, 1);
+ 	fprintf(outf, "\n");
+ 	return type;
+     }
+     return findbasetype_(type, flags);
+ }
+ 
+ 
+ 
+ Expr *arraysize(tp, incskipped)
+ Type *tp;
+ int incskipped;
+ {
+     Expr *ex, *minv, *maxv;
+     int denom;
+ 
+     ord_range_expr(tp->indextype, &minv, &maxv);
+     if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
+ 	!exprdependsvar(minv, mp_maxint)) {
+         return NULL;
+     } else {
+         ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
+                                           copyexpr(minv)),
+                            makeexpr_long(1));
+         if (tp->smin && !incskipped) {
+             ex = makeexpr_minus(ex, copyexpr(tp->smin));
+         }
+         if (tp->smax) {
+             denom = (tp->basetype == tp_sshort) ? 16 : 8;
+             denom >>= tp->escale;
+             ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
+                               makeexpr_long(denom));
+         }
+         return ex;
+     }
+ }
+ 
+ 
+ 
+ Type *promote_type(tp)
+ Type *tp;
+ {
+     Type *tp2;
+ 
+     if (tp->kind == TK_ENUM) {
+ 	if (promote_enums == 0 ||
+ 	    (promote_enums < 0 &&
+ 	     (useenum)))
+ 	    return tp;
+     }
+     if (tp->kind == TK_ENUM ||
+          tp->kind == TK_SUBR ||
+          tp->kind == TK_INTEGER ||
+          tp->kind == TK_CHAR ||
+          tp->kind == TK_BOOLEAN) {
+         tp2 = findbasetype(tp, ODECL_NOPRES);
+ 	if (tp2 == tp_ushort && sizeof_int == 16)
+ 	    return tp_uint;
+         else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
+ 		 tp2 == tp_abyte || tp2 == tp_char ||
+ 		 tp2 == tp_sshort || tp2 == tp_ushort ||
+ 		 tp2 == tp_boolean || tp2->kind == TK_ENUM) {
+             return tp_int;
+         }
+     }
+     if (tp == tp_real)
+ 	return tp_longreal;
+     return tp;
+ }
+ 
+ 
+ Type *promote_type_bin(t1, t2)
+ Type *t1, *t2;
+ {
+     t1 = promote_type(t1);
+     t2 = promote_type(t2);
+     if (t1 == tp_longreal || t2 == tp_longreal)
+ 	return tp_longreal;
+     if (t1 == tp_unsigned || t2 == tp_unsigned)
+ 	return tp_unsigned;
+     if (t1 == tp_integer || t2 == tp_integer) {
+ 	if ((t1 == tp_uint || t2 == tp_uint) &&
+ 	    sizeof_int > 0 &&
+ 	    sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
+ 	    return tp_uint;
+ 	return tp_integer;
+     }
+     if (t1 == tp_uint || t2 == tp_uint)
+ 	return tp_uint;
+     return t1;
+ }
+ 
+ 
+ 
+ #if 0
+ void predeclare_varstruct(mp)
+ Meaning *mp;
+ {
+     if (mp->ctx &&
+ 	 mp->ctx->kind == MK_FUNCTION &&
+ 	 mp->ctx->varstructflag &&
+ 	 (usePPMacros != 0 || prototypes != 0) &&
+ 	 !strlist_find(varstructdecllist, mp->ctx->name)) {
+ 	output("struct ");
+ 	output(format_s(name_LOC, mp->ctx->name));
+ 	output(" ;\n");
+ 	strlist_insert(&varstructdecllist, mp->ctx->name);
+     }
+ }
+ #endif
+ 
+ 
+ Static void declare_args(type, isheader, isforward)
+ Type *type;
+ int isheader, isforward;
+ {
+     Meaning *mp = type->fbase;
+     Type *tp;
+     int firstflag = 0;
+     int usePP, dopromote, proto, showtypes, shownames;
+     int staticlink;
+     char *name;
+ 
+ #if 1   /* This seems to work better! */
+     isforward = !isheader;
+ #endif
+     usePP = (isforward && usePPMacros != 0);
+     dopromote = (promoteargs == 1 ||
+ 		 (promoteargs < 0 && (usePP || !fullprototyping)));
+     if (ansiC == 1 && blockkind != TOK_EXPORT)
+ 	usePP = 0;
+     if (usePP)
+         proto = (prototypes) ? prototypes : 1;
+     else
+         proto = (isforward || fullprototyping) ? prototypes : 0;
+     showtypes = (proto > 0);
+     shownames = (proto == 1 || isheader);
+     staticlink = (type->issigned ||
+                   (type->meaning &&
+                    type->meaning->ctx->kind == MK_FUNCTION &&
+                    type->meaning->ctx->varstructflag));
+     if (mp || staticlink) {
+         if (usePP)
+             output(" PP(");
+ 	else if (spacefuncs)
+ 	    output(" ");
+         output("(");
+         if (showtypes || shownames) {
+             firstflag = 0;
+             while (mp) {
+                 if (firstflag++)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 name = (mp->othername && isheader) ? mp->othername : mp->name;
+                 tp = (mp->othername) ? mp->rectype : mp->type;
+                 if (!showtypes) {
+                     output(name);
+                 } else {
+ 		    output(storageclassname(varstorageclass(mp)));
+ 		    if (!shownames || (isforward && *name == '_')) {
+ 			out_type(tp, 1);
+ 		    } else {
+ 			if (dopromote)
+ 			    tp = promote_type(tp);
+ 			outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
+ 			output(" ");
+ 			outdeclarator(tp, name,
+ 				      ODECL_CHARSTAR|ODECL_FREEARRAY);
+ 		    }
+ 		}
+                 if (isheader)
+                     mp->wasdeclared = showtypes;
+                 if (mp->type == tp_strptr && mp->anyvarflag) {     /* VAR STRING parameter */
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                     if (showtypes) {
+ 			if (useAnyptrMacros == 1 || useconsts == 2)
+ 			    output("Const ");
+ 			else if (ansiC > 0)
+ 			    output("const ");
+                         output("int");
+ 		    }
+                     if (shownames) {
+                         if (showtypes)
+                             output(" ");
+                         output(format_s(name_STRMAX, mp->name));
+                     }
+                 }
+                 mp = mp->xnext;
+             }
+             if (staticlink) {     /* sub-procedure with static link */
+                 if (firstflag++)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 if (type->issigned) {
+                     if (showtypes)
+ 			if (tp_special_anyptr)
+ 			    output("Anyptr ");
+ 			else if (voidstar)
+ 			    output("void *");
+ 			else
+ 			    output("char *");
+                     if (shownames)
+                         output("_link");
+                 } else {
+                     mp = type->meaning->ctx;
+                     if (showtypes) {
+                         output("struct ");
+                         output(format_s(name_LOC, mp->name));
+                         output(" *");
+                     }
+                     if (shownames) {
+                         output(format_s(name_LINK, mp->name));
+                     }
+                 }
+             }
+         }
+         output(")");
+         if (usePP)
+             output(")");
+     } else {
+         if (usePP)
+             output(" PV()");
+         else {
+ 	    if (spacefuncs)
+ 		output(" ");
+ 	    if (void_args)
+ 		output("(void)");
+ 	    else
+ 		output("()");
+ 	}
+     }
+ }
+ 
+ 
+ 
+ void outdeclarator(type, name, flags)
+ Type *type;
+ char *name;
+ int flags;
+ {
+     int i, depth, anyptrs, anyarrays;
+     Expr *dimen[30];
+     Expr *ex, *maxv;
+     Type *tp, *functype, *basetype;
+     Expr funcdummy;   /* yow */
+ 
+     anyptrs = 0;
+     anyarrays = 0;
+     functype = NULL;
+     basetype = findbasetype(type, flags);
+     for (depth = 0, tp = type; tp && tp != basetype; tp = tp->basetype) {
+         switch (tp->kind) {
+ 
+             case TK_POINTER:
+                 if (tp->basetype) {
+                     switch (tp->basetype->kind) {
+ 
+ 		        case TK_VOID:
+ 			    if (tp->basetype == tp_void &&
+ 				tp_special_anyptr) {
+ 				tp = tp_special_anyptr;
+ 				continue;
+ 			    }
+ 			    break;
+ 
+                         case TK_ARRAY:    /* ptr to array of x => ptr to x */
+                         case TK_STRING:   /*                or => array of x */
+                         case TK_SET:
+ 			    if (stararrays == 1 ||
+ 				!(flags & ODECL_FREEARRAY) ||
+ 				(tp->basetype->structdefd &&
+ 				 stararrays != 2)) {
+ 				tp = tp->basetype;
+ 				flags &= ~ODECL_CHARSTAR;
+ 			    } else {
+ 				continue;
+ 			    }
+                             break;
+ 
+ 			default:
+ 			    break;
+                     }
+                 }
+                 dimen[depth++] = NULL;
+                 anyptrs++;
+ 		if (tp->kind == TK_POINTER &&
+ 		    tp->fbase && tp->fbase->wasdeclared)
+ 		    break;
+                 continue;
+ 
+             case TK_ARRAY:
+ 		flags &= ~ODECL_CHARSTAR;
+                 if (tp->meaning && tp->meaning->kind == MK_TYPE &&
+                     tp->meaning->wasdeclared)
+                     break;
+ 		if (tp->structdefd) {    /* conformant array */
+ 		    if (!variablearrays &&
+ 			!(tp->basetype->kind == TK_ARRAY &&
+ 			  tp->basetype->structdefd))   /* avoid mult. notes */
+ 			note("Conformant array code may not work in all compilers [101]");
+ 		}
+                 ex = arraysize(tp, 1);
+                 if (!ex)
+                     ex = makeexpr_name("", tp_integer);
+                 dimen[depth++] = ex;
+ 		anyarrays++;
+ 		if (tp->fbase && tp->fbase->wasdeclared)
+ 		    break;
+                 continue;
+ 
+             case TK_SET:
+                 ord_range_expr(tp->indextype, NULL, &maxv);
+                 maxv = enum_to_int(copyexpr(maxv));
+                 if (ord_type(maxv->val.type)->kind == TK_CHAR)
+                     maxv->val.type = tp_integer;
+                 dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
+                                                makeexpr_long(2));
+                 break;
+ 
+             case TK_STRING:
+                 if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
+                     dimen[depth++] = NULL;
+                 } else {
+                     ord_range_expr(tp->indextype, NULL, &maxv);
+                     dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
+                 }
+                 continue;
+ 
+             case TK_FILE:
+                 break;
+ 
+ 	    case TK_CPROCPTR:
+ 		dimen[depth++] = NULL;
+ 		anyptrs++;
+ 		if (procptrprototypes)
+ 		    continue;
+                 dimen[depth++] = &funcdummy;
+ 		break;
+ 
+             case TK_FUNCTION:
+                 dimen[depth++] = &funcdummy;
+                 if (!functype)
+                     functype = tp;
+                 continue;
+ 
+ 	    default:
+ 		break;
+         }
+         break;
+     }
+     if (!*name && depth && (spaceexprs > 0 ||
+                             (spaceexprs != 0 && !dimen[depth-1])))
+         output(" ");    /* spacing for abstract declarator */
+     if ((flags & ODECL_FUNCTION) && anyptrs)
+         output(" ");
+     if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
+ 	output("\003");
+     for (i = depth; --i >= 0; ) {
+         if (!dimen[i])
+             output("*");
+         if (i > 0 &&
+             ((dimen[i] && !dimen[i-1]) ||
+              (dimen[i-1] && !dimen[i] && extraparens > 0)))
+             output("(");
+     }
+     if (flags & ODECL_FUNCTION)
+         output("\n");
+     if (anyarrays > 1 && (flags & ODECL_FUNCTION))
+ 	output("\003");
+     output(name);
+     for (i = 0; i < depth; i++) {
+         if (i > 0 &&
+             ((dimen[i] && !dimen[i-1]) ||
+              (dimen[i-1] && !dimen[i] && extraparens > 0)))
+             output(")");
+         if (dimen[i]) {
+             if (dimen[i] == &funcdummy) {
+ 		if (lookback(1) == ')')
+ 		    output("\002");
+ 		if (functype)
+ 		    declare_args(functype, (flags & ODECL_HEADER) != 0,
+ 				           (flags & ODECL_FORWARD) != 0);
+ 		else if (spacefuncs)
+ 		    output(" ()");
+ 		else
+ 		    output("()");
+             } else {
+ 		if (lookback(1) == ']')
+ 		    output("\002");
+                 output("[");
+                 if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
+                     out_expr(dimen[i]);
+                 freeexpr(dimen[i]);
+                 output("]");
+             }
+         }
+     }
+     if (anyarrays > 1)
+ 	output("\004");
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Find out if types t1 and t2 will work out to be the same C type,
+    for purposes of type-casting */
+ 
+ Type *canonicaltype(type)
+ Type *type;
+ {
+     if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
+         type->kind == TK_PROCPTR)
+         type = findbasetype(type, 0);
+     if (type == tp_char)
+         return tp_ubyte;
+     if (type->kind == TK_POINTER) {
+ 	if (type->smin)
+ 	    return type;
+         else if (type->basetype->kind == TK_ARRAY ||
+ 		 type->basetype->kind == TK_STRING ||
+ 		 type->basetype->kind == TK_SET)
+             return makepointertype(canonicaltype(type->basetype->basetype));
+         else if (type->basetype == tp_void)
+             return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
+         else if (type->basetype->kind == TK_FILE)
+             return tp_text;
+         else
+             return makepointertype(canonicaltype(type->basetype));
+     }
+     return type;
+ }
+ 
+ 
+ int identicaltypes(t1, t2)
+ Type *t1, *t2;
+ {
+     if (t1 == t2)
+ 	return 1;
+     if (t1->kind == t2->kind) {
+ 	if (t1->kind == TK_SUBR)
+ 	    return (identicaltypes(t1->basetype, t2->basetype) &&
+ 		    exprsame(t1->smin, t2->smin, 2) &&
+ 		    exprsame(t1->smax, t2->smax, 2));
+ 	if (t1->kind == TK_SET ||
+ 	    t1->kind == TK_SMALLSET)
+ 	    return (exprsame(t1->indextype->smax,
+ 			     t2->indextype->smax, 2));
+ 	if (t1->kind == TK_ARRAY ||
+ 	    t1->kind == TK_STRING ||
+ 	    t1->kind == TK_SMALLARRAY)
+ 	    return (identicaltypes(t1->basetype, t2->basetype) &&
+ 		    identicaltypes(t1->indextype, t2->indextype) &&
+ 		    t1->structdefd == t2->structdefd &&
+ 		    ((!t1->smin && !t2->smin) ||
+ 		     (t1->smin && t2->smin &&
+ 		      exprsame(t1->smin, t2->smin, 2))) &&
+ 		    ((!t1->smax && !t2->smax) ||
+ 		     (t1->smax && t2->smax &&
+ 		      exprsame(t1->smax, t2->smax, 2) &&
+ 		      t1->escale == t2->escale &&
+ 		      t1->issigned == t2->issigned)));
+     }
+     return 0;
+ }
+ 
+ 
+ int similartypes(t1, t2)
+ Type *t1, *t2;
+ {
+     if (debug > 3) { fprintf(outf, "similartypes("); dumptypename(t1,1); fprintf(outf, ","); dumptypename(t2,1); fprintf(outf, ") = %d\n", identicaltypes(t1, t2)); }
+     if (identicaltypes(t1, t2))
+ 	return 1;
+     t1 = canonicaltype(t1);
+     t2 = canonicaltype(t2);
+     return (t1 == t2);
+ }
+ 
+ 
+ 
+ 
+ 
+ Static int checkstructconst(mp)
+ Meaning *mp;
+ {
+     return (mp->kind == MK_VAR &&
+ 	    mp->constdefn &&
+             mp->constdefn->kind == EK_CONST &&
+             (mp->constdefn->val.type->kind == TK_ARRAY ||
+              mp->constdefn->val.type->kind == TK_RECORD));
+ }
+ 
+ 
+ Static int mixable(mp1, mp2, args, flags)
+ Meaning *mp1, *mp2;
+ int args, flags;
+ {
+     Type *tp1 = mp1->type, *tp2 = mp2->type;
+ 
+     if (mixvars == 0)
+         return 0;
+     if (mp1->kind == MK_FIELD &&
+         (mp1->val.i || mp2->val.i) && mixfields == 0)
+         return 0;
+     if (checkstructconst(mp1) || checkstructconst(mp2))
+         return 0;
+     if (mp1->comments) {
+ 	if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
+ 	    return 0;
+     }
+     if (mp2->comments) {
+ 	if (findcomment(mp2->comments, CMT_PRE, -1))
+ 	    return 0;
+     }
+     if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
+ 	(mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
+         if (mixinits == 0)
+             return 0;
+         if (mixinits != 1 &&
+             (!mp1->constdefn || !mp2->constdefn))
+             return 0;
+     }
+     if (args) {
+         if (mp1->kind == MK_PARAM && mp1->othername)
+             tp1 = mp1->rectype;
+         if (mp2->kind == MK_PARAM && mp2->othername)
+             tp2 = mp2->rectype;
+     }
+     if (tp1 == tp2)
+         return 1;
+     switch (mixtypes) {
+         case 0:
+             return 0;
+         case 1:
+             return (findbasetype(tp1, flags) == findbasetype(tp2, flags));
+         default:
+             if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
+ 		return 0;
+             while (tp1->kind == TK_POINTER && !tp1->smin && tp1->basetype)
+                 tp1 = tp1->basetype;
+             while (tp2->kind == TK_POINTER && !tp2->smin && tp2->basetype)
+                 tp2 = tp2->basetype;
+             return (tp1 == tp2);
+     }
+ }
+ 
+ 
+ 
+ void declarefiles(fnames)
+ Strlist *fnames;
+ {
+     Meaning *mp;
+     char *cp;
+ 
+     while (fnames) {
+ 	mp = (Meaning *)fnames->value;
+ 	if (mp->kind == MK_VAR || mp->kind == MK_FIELD) {
+ 	    if (mp->namedfile) {
+ 		output(storageclassname(varstorageclass(mp)));
+ 		output(format_ss("%s %s", charname,
+ 				 format_s(name_FNVAR, fnames->s)));
+ 		output(format_s("[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
+ 	    }
+ 	    if (mp->bufferedfile && *declbufname) {
+ 		cp = format_s("%s", storageclassname(varstorageclass(mp)));
+ 		if (*cp && isspace(cp[strlen(cp)-1]))
+ 		  cp[strlen(cp)-1] = 0;
+ 		if (*cp || !*declbufncname) {
+ 		    output(declbufname);
+ 		    output("(");
+ 		    output(fnames->s);
+ 		    output(",");
+ 		    output(cp);
+ 		} else {
+ 		    output(declbufncname);
+ 		    output("(");
+ 		    output(fnames->s);
+ 		}
+ 		output(",");
+ 		out_type(mp->type->basetype->basetype, 1);
+ 		output(");\n");
+ 	    }
+ 	}
+ 	strlist_eat(&fnames);
+     }
+ }
+ 
+ 
+ 
+ char *variantfieldname(num)
+ int num;
+ {
+     if (num >= 0)
+         return format_d("U%d", num);
+     else
+         return format_d("UM%d", -num);
+ }
+ 
+ 
+ int record_is_union(tp)
+ Type *tp;
+ {
+     return (tp->kind == TK_RECORD &&
+ 	    tp->fbase && tp->fbase->kind == MK_VARIANT);
+ }
+ 
+ 
+ void outfieldlist(mp)
+ Meaning *mp;
+ {
+     Meaning *mp0;
+     int num, only_union, empty, saveindent, saveindent2;
+     Strlist *fnames, *fn;
+ 
+     if (!mp) {
+ 	output("int empty_struct;   /* Pascal record was empty */\n");
+ 	return;
+     }
+     only_union = (mp && mp->kind == MK_VARIANT);
+     fnames = NULL;
+     while (mp && mp->kind == MK_FIELD) {
+ 	flushcomments(&mp->comments, CMT_PRE, -1);
+ 	output(storageclassname(varstorageclass(mp) & 0x10));
+ 	if (mp->dtype)
+ 	    output(mp->dtype->name);
+ 	else
+ 	    outbasetype(mp->type, 0);
+         output(" \005");
+ 	for (;;) {
+ 	    if (mp->dtype)
+ 		output(mp->name);
+ 	    else
+ 		outdeclarator(mp->type, mp->name, 0);
+ 	    if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
+ 		output(format_d(" : %d", mp->val.i));
+ 	    if (isfiletype(mp->type, 0)) {
+ 		fn = strlist_append(&fnames, mp->name);
+ 		fn->value = (long)mp;
+ 	    }
+ 	    mp->wasdeclared = 1;
+ 	    if (!mp->cnext || mp->cnext->kind != MK_FIELD ||
+ 		mp->dtype != mp->cnext->dtype ||
+ 		varstorageclass(mp) != varstorageclass(mp->cnext) ||
+ 		!mixable(mp, mp->cnext, 0, 0))
+ 		break;
+             mp = mp->cnext;
+ 	    if (spacecommas)
+ 		output(",\001 ");
+ 	    else
+ 		output(",\001");
+         }
+         output(";");
+ 	outtrailcomment(mp->comments, -1, declcommentindent);
+ 	flushcomments(&mp->comments, -1, -1);
+         mp = mp->cnext;
+     }
+     declarefiles(fnames);
+     if (mp) {
+ 	saveindent = outindent;
+ 	empty = 1;
+         if (!only_union) {
+             output("union {\n");
+ 	    moreindent(tabsize);
+ 	    moreindent(structindent);
+         }
+         while (mp) {
+             mp0 = mp->ctx;
+             num = ord_value(mp->val);
+             while (mp && mp->ctx == mp0)
+                 mp = mp->cnext;
+             if (mp0) {
+ 		empty = 0;
+                 if (!mp0->cnext && mp0->kind == MK_FIELD) {
+ 		    mp0->val.i = 0;   /* no need for bit fields in a union! */
+                     outfieldlist(mp0);
+                 } else {
+                     if (mp0->kind == MK_VARIANT)
+                         output("union {\n");
+                     else
+                         output("struct {\n");
+ 		    saveindent2 = outindent;
+ 		    moreindent(tabsize);
+ 		    moreindent(structindent);
+                     outfieldlist(mp0);
+ 		    outindent = saveindent2;
+                     output("} ");
+                     output(format_s(name_VARIANT, variantfieldname(num)));
+                     output(";\n");
+                 }
+ 		flushcomments(&mp0->comments, -1, -1);
+             }
+         }
+ 	if (empty)
+ 	    output("int empty_union;   /* Pascal variant record was empty */\n");
+         if (!only_union) {
+             outindent = saveindent;
+             output("} ");
+             output(format_s(name_UNION, ""));
+             output(";\n");
+         }
+     }
+ }
+ 
+ 
+ 
+ void declarebigfile(type)
+ Type *type;
+ {
+     output("FILE *f;\n");
+     if (!*declbufncname) {
+ 	output(declbufname);
+ 	output("(f,,");
+     } else {
+ 	output(declbufncname);
+ 	output("(f,");
+     }
+     out_type(type->basetype, 1);
+     output(");\n");
+     output(charname);
+     output(format_s(" name[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
+ }
+ 
+ 
+ 
+ void outbasetype(type, flags)
+ Type *type;
+ int flags;
+ {
+     Meaning *mp;
+     int saveindent;
+ 
+     type = findbasetype(type, flags | ODECL_DECL);
+     if (type->preserved && type->meaning->wasdeclared) {
+ 	output(type->meaning->name);
+ 	return;
+     }
+     switch (type->kind) {
+ 
+         case TK_INTEGER:
+             if (type == tp_uint) {
+                 output("unsigned");
+             } else if (type == tp_sint) {
+                 if (useAnyptrMacros == 1)
+                     output("Signed int");
+                 else if (hassignedchar)
+                     output("signed int");
+                 else
+                     output("int");   /* will sign-extend by hand */
+             } else if (type == tp_unsigned) {
+                 output("unsigned long");
+             } else if (type != tp_int)
+                 output(integername);
+             else
+                 output("int");
+             break;
+ 
+         case TK_SUBR:
+             if (type == tp_special_anyptr) {
+                 output("Anyptr");
+             } else if (type == tp_abyte) {
+                 output("char");
+             } else if (type == tp_ubyte) {
+                 output(ucharname);
+             } else if (type == tp_sbyte) {
+                 output(scharname);
+                 if (signedchars != 1 && !hassignedchar)
+                     note("'signed char' may not be valid in all compilers [102]");
+             } else {
+                 if (type == tp_ushort)
+                     output("unsigned ");
+                 output("short");
+             }
+             break;
+ 
+         case TK_CHAR:
+             if (type == tp_uchar) {
+                 output(ucharname);
+             } else if (type == tp_schar) {
+                 output(scharname);
+                 if (signedchars != 1 && !hassignedchar)
+                     note("'signed char' may not be valid in all compilers [102]");
+ 	    } else
+ 		output(charname);
+             break;
+ 
+         case TK_BOOLEAN:
+             output((*name_BOOLEAN) ? name_BOOLEAN : ucharname);
+             break;
+ 
+         case TK_REAL:
+ 	    if (type == tp_longreal)
+ 		output("double");
+ 	    else
+ 		output("float");
+             break;
+ 
+         case TK_VOID:
+             if (ansiC == 0)
+                 output("int");
+             else if (useAnyptrMacros == 1)
+                 output("Void");
+             else
+                 output("void");
+             break;
+ 
+         case TK_PROCPTR:
+ 	    output(name_PROCEDURE);
+ 	    break;
+ 
+         case TK_FILE:
+             output("FILE");
+             break;
+ 
+ 	case TK_SPECIAL:
+ 	    if (type == tp_jmp_buf)
+ 		output("jmp_buf");
+ 	    break;
+ 
+         default:
+ 	    if (type->kind == TK_POINTER && type->smin) {
+ 		note("Forward pointer reference assumes struct type [323]");
+ 		output("struct ");
+ 		output(format_s(name_STRUCT, type->smin->val.s));
+ 	    } else if (type->meaning && type->meaning->kind == MK_TYPE &&
+                 type->meaning->wasdeclared) {
+                 output(type->meaning->name);
+             } else {
+                 switch (type->kind) {
+ 
+                     case TK_ENUM:
+                         output("enum {\n");
+ 			saveindent = outindent;
+ 			moreindent(tabsize);
+ 			moreindent(structindent);
+                         mp = type->fbase;
+                         while (mp) {
+                             output(mp->name);
+                             mp = mp->xnext;
+                             if (mp)
+ 				if (spacecommas)
+ 				    output(",\001 ");
+ 				else
+ 				    output(",\001");
+                         }
+                         outindent = saveindent;
+                         output("\n}");
+                         break;
+ 
+                     case TK_RECORD:
+                     case TK_BIGFILE:
+                         if (record_is_union(type))
+                             output("union ");
+                         else
+                             output("struct ");
+                         if (type->meaning)
+                             output(format_s(name_STRUCT, type->meaning->name));
+ 			if (!type->structdefd) {
+ 			    if (type->meaning) {
+ 				type->structdefd = 1;
+ 				output(" ");
+ 			    }
+                             output("{\n");
+ 			    saveindent = outindent;
+ 			    moreindent(tabsize);
+ 			    moreindent(structindent);
+ 			    if (type->kind == TK_BIGFILE)
+ 				declarebigfile(type);
+ 			    else
+ 				outfieldlist(type->fbase);
+                             outindent = saveindent;
+                             output("}");
+                         }
+ 			break;
+ 
+ 		    default:
+ 			break;
+ 
+                 }
+             }
+             break;
+     }
+ }
+ 
+ 
+ 
+ void out_type(type, witharrays)
+ Type *type;
+ int witharrays;
+ {
+     if (!witharrays && type->kind == TK_ARRAY)
+         type = makepointertype(type->basetype);
+     outbasetype(type, 0);
+     outdeclarator(type, "", 0);    /* write an "abstract declarator" */
+ }
+ 
+ 
+ 
+ 
+ int varstorageclass(mp)
+ Meaning *mp;
+ {
+     int sclass;
+ 
+     if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
+ 	mp->kind == MK_FIELD)
+ 	sclass = 0;
+     else if (blockkind == TOK_EXPORT)
+         if (usevextern)
+ 	    if (mp->constdefn &&
+ 		(mp->kind == MK_VAR ||
+ 		 mp->kind == MK_VARREF))
+ 		sclass = 2;    /* extern */
+ 	    else
+ 		sclass = 1;    /* vextern */
+         else
+             sclass = 0;                         /* (plain) */
+     else if (mp->isfunction && mp->kind != MK_FUNCTION)
+ 	sclass = 2;   /* extern */
+     else if (mp->ctx->kind == MK_MODULE &&
+ 	     (var_static != 0 ||
+ 	      (findsymbol(mp->name)->flags & NEEDSTATIC)) &&
+ 	     !mp->exported && !mp->istemporary && blockkind != TOK_END)
+         sclass = (useAnyptrMacros) ? 4 : 3;     /* (private) */
+     else if (mp->isforward)
+         sclass = 3;   /* static */
+     else
+ 	sclass = 0;   /* (plain) */
+     if (mp->volatilequal)
+ 	sclass |= 0x10;
+     if (mp->constqual)
+ 	sclass |= 0x20;
+     if (debug>2) fprintf(outf, "varstorageclass(%s) = %d\n", mp->name, sclass);
+     return sclass;
+ }
+ 
+ 
+ char *storageclassname(i)
+ int i;
+ {
+     char *scname;
+ 
+     switch (i & 0xf) {
+         case 1:
+             scname = "vextern ";
+ 	    break;
+         case 2:
+             scname = "extern ";
+ 	    break;
+         case 3:
+             scname = "static ";
+ 	    break;
+         case 4:
+             scname = "Static ";
+ 	    break;
+         default:
+             scname = "";
+ 	    break;
+     }
+     if (i & 0x10)
+ 	if (useAnyptrMacros == 1)
+ 	    scname = format_s("%sVolatile ", scname);
+ 	else if (ansiC > 0)
+ 	    scname = format_s("%svolatile ", scname);
+     if (i & 0x20)
+ 	if (useAnyptrMacros == 1)
+ 	    scname = format_s("%sConst ", scname);
+ 	else if (ansiC > 0)
+ 	    scname = format_s("%sconst ", scname);
+     return scname;
+ }
+ 
+ 
+ 
+ Static int var_mixable;
+ 
+ void declarevar(mp, which)
+ Meaning *mp;
+ int which;    /* 0x1=header, 0x2=body, 0x4=trailer, 0x8=in varstruct */
+ {
+     int isstatic, isstructconst, saveindent, i;
+     Strlist *sl;
+ 
+     isstructconst = checkstructconst(mp);
+     isstatic = varstorageclass(mp);
+     if (which & 0x8)
+ 	isstatic &= 0x10;   /* clear all but Volatile flags */
+     flushcomments(&mp->comments, CMT_PRE, -1);
+     if (which & 0x1) {
+         if (isstructconst)
+             outsection(minorspace);
+         output(storageclassname(isstatic));
+ 	if (mp->dtype)
+ 	    output(mp->dtype->name);
+         else
+ 	    outbasetype(mp->type, 0);
+         output(" \005");
+     }
+     if (which & 0x2) {
+ 	if (mp->dtype)
+ 	    output(mp->name);
+ 	else
+ 	    outdeclarator(mp->type, mp->name, 0);
+         if (mp->constdefn && blockkind != TOK_EXPORT &&
+ 	    (mp->kind == MK_VAR || mp->kind == MK_VARREF)) {
+             if (mp->varstructflag) {    /* move init code into function body */
+                 intwarning("declarevar",
+                     format_s("Variable %s initializer not removed [125]", mp->name));
+             } else {
+                 if (isstructconst) {
+                     output(" = {\n");
+ 		    saveindent = outindent;
+ 		    moreindent(tabsize);
+ 		    moreindent(structinitindent);
+                     out_expr((Expr *)mp->constdefn->val.i);
+                     outindent = saveindent;
+                     output("\n}");
+ 		    var_mixable = 0;
+ 		} else if (mp->type->kind == TK_ARRAY &&
+ 			   mp->constdefn->val.type->kind == TK_STRING &&
+ 			   !initpacstrings) {
+ 		    if (mp->ctx->kind == MK_MODULE) {
+ 			sl = strlist_append(&initialcalls,
+ 					    format_sss("memcpy(%s,\002 %s,\002 sizeof(%s))",
+ 						       mp->name,
+ 						       makeCstring(mp->constdefn->val.s,
+ 								   mp->constdefn->val.i),
+ 						       mp->name));
+ 			sl->value = 1;
+ 		    } else if (mp->isforward) {
+ 			output(" = {\005");
+ 			for (i = 0; i < mp->constdefn->val.i; i++) {
+ 			    if (i > 0)
+ 				output(",\001");
+ 			    output(makeCchar(mp->constdefn->val.s[i]));
+ 			}
+ 			output("}");
+ 			mp->constdefn = NULL;
+ 			var_mixable = 0;
+ 		    }
+                 } else {
+ 		    output(" = ");
+                     out_expr(mp->constdefn);
+ 		}
+             }
+         }
+     }
+     if (which & 0x4) {
+         output(";");
+ 	outtrailcomment(mp->comments, -1, declcommentindent);
+ 	flushcomments(&mp->comments, -1, -1);
+         if (isstructconst)
+             outsection(minorspace);
+     }
+ }
+ 
+ 
+ 
+ 
+ Static int checkvarmacdef(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+     int i;
+ 
+     if ((ex->kind == EK_NAME || ex->kind == EK_BICALL) &&
+ 	!strcmp(ex->val.s, mp->name)) {
+ 	ex->kind = EK_VAR;
+ 	ex->val.i = (long)mp;
+ 	ex->val.type = mp->type;
+ 	return 1;
+     }
+     if (ex->kind == EK_VAR && ex->val.i == (long)mp)
+ 	return 1;
+     i = ex->nargs;
+     while (--i >= 0)
+ 	if (checkvarmacdef(ex->args[i], mp))
+ 	    return 1;
+     return 0;
+ }
+ 
+ 
+ int checkvarmac(mp)
+ Meaning *mp;
+ {
+     if (mp->kind != MK_VARMAC && mp->kind != MK_FUNCTION)
+ 	return 0;
+     if (!mp->constdefn)
+ 	return 0;
+     return checkvarmacdef(mp->constdefn, mp);
+ }
+ 
+ 
+ 
+ #define varkind(k) ((k)==MK_VAR||(k)==MK_VARREF||(k)==MK_PARAM||(k)==MK_VARPARAM)
+ 
+ int declarevars(ctx, invarstruct)
+ Meaning *ctx;
+ int invarstruct;
+ {
+     Meaning *mp, *mp0, *mp2;
+     Strlist *fnames, *fn;
+     int flag, first;
+ 
+     if (ctx->kind == MK_FUNCTION && ctx->varstructflag && !invarstruct) {
+         output("struct ");
+         output(format_s(name_LOC, ctx->name));
+         output(" ");
+         output(format_s(name_VARS, ctx->name));
+         output(";\n");
+         flag = 1;
+     } else
+         flag = 0;
+     if (debug>2) {
+         fprintf(outf,"declarevars:\n");
+         for (mp = ctx->cbase; mp; mp = mp->xnext) {
+             fprintf(outf, "  %-22s%-15s%3d", mp->name,
+                                              meaningkindname(mp->kind),
+                                              mp->refcount);
+             if (mp->wasdeclared)
+                 fprintf(outf, " [decl]");
+             if (mp->varstructflag)
+                 fprintf(outf, " [struct]");
+             fprintf(outf, "\n");
+         }
+     }
+     fnames = NULL;
+     for (;;) {
+         mp = ctx->cbase;
+         while (mp && (!(varkind(mp->kind) || checkvarmac(mp)) ||
+ 		      mp->wasdeclared || mp->varstructflag != invarstruct ||
+ 		      mp->refcount <= 0))
+             mp = mp->cnext;
+         if (!mp)
+             break;
+         flag = 1;
+         first = 1;
+         mp0 = mp2 = mp;
+ 	var_mixable = 1;
+         while (mp) {
+             if ((varkind(mp->kind) || checkvarmac(mp)) &&
+ 		!mp->wasdeclared && var_mixable &&
+ 		mp->dtype == mp0->dtype &&
+                 varstorageclass(mp) == varstorageclass(mp0) &&
+                 mp->varstructflag == invarstruct && mp->refcount > 0) {
+                 if (mixable(mp2, mp, 0, 0) || first) {
+                     if (!first)
+ 			if (spacecommas)
+ 			    output(",\001 ");
+ 			else
+ 			    output(",\001");
+                     declarevar(mp, (first ? 0x3 : 0x2) |
+ 			           (invarstruct ? 0x8 : 0));
+ 		    mp2 = mp;
+                     mp->wasdeclared = 1;
+                     if (isfiletype(mp->type, 0)) {
+                         fn = strlist_append(&fnames, mp->name);
+                         fn->value = (long)mp;
+                     }
+                     first = 0;
+                 } else
+                     if (mixvars != 1)
+                         break;
+             }
+ 	    if (first) {
+ 		intwarning("declarevars",
+ 			   format_s("Unable to declare %s [126]", mp->name));
+ 		mp->wasdeclared = 1;
+ 		first = 0;
+ 	    }
+             if (mixvars == 0)
+                 break;
+             mp = mp->cnext;
+         }
+         declarevar(mp2, 0x4);
+     }
+     declarefiles(fnames);
+     return flag;
+ }
+ 
+ 
+ 
+ void redeclarevars(ctx)
+ Meaning *ctx;
+ {
+     Meaning *mp;
+ 
+     for (mp = ctx->cbase; mp; mp = mp->cnext) {
+         if ((mp->kind == MK_VAR || mp->kind == MK_VARREF) &&
+             mp->constdefn) {
+             mp->wasdeclared = 0;    /* mark for redeclaration, this time */
+         }                           /*  with its initializer */
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ void out_argdecls(ftype)
+ Type *ftype;
+ {
+     Meaning *mp, *mp0;
+     Type *tp;
+     int done;
+     int flag = 1;
+     char *name;
+ 
+     done = 0;
+     do {
+         mp = ftype->fbase;
+         while (mp && mp->wasdeclared)
+             mp = mp->xnext;
+         if (mp) {
+             if (flag)
+                 output("\n");
+             flag = 0;
+             mp0 = mp;
+             outbasetype(mp->othername ? mp->rectype : mp->type,
+ 			ODECL_CHARSTAR|ODECL_FREEARRAY);
+             output(" \005");
+             while (mp) {
+                 if (!mp->wasdeclared) {
+                     if (mp == mp0 ||
+ 			mixable(mp0, mp, 1, ODECL_CHARSTAR|ODECL_FREEARRAY)) {
+                         if (mp != mp0)
+ 			    if (spacecommas)
+ 				output(",\001 ");
+ 			    else
+ 				output(",\001");
+                         name = (mp->othername) ? mp->othername : mp->name;
+                         tp = (mp->othername) ? mp->rectype : mp->type;
+                         outdeclarator(tp, name,
+ 				      ODECL_CHARSTAR|ODECL_FREEARRAY);
+                         mp->wasdeclared = 1;
+                     } else
+                         if (mixvars != 1)
+                             break;
+                 }
+                 mp = mp->xnext;
+             }
+             output(";\n");
+         } else
+             done = 1;
+     } while (!done);
+     for (mp0 = ftype->fbase; mp0 && (mp0->type != tp_strptr ||
+                                      !mp0->anyvarflag); mp0 = mp0->xnext) ;
+     if (mp0) {
+         output("int ");
+         for (mp = mp0; mp; mp = mp->xnext) {
+             if (mp->type == tp_strptr && mp->anyvarflag) {
+                 if (mp != mp0) {
+                     if (mixvars == 0)
+                         output(";\nint ");
+                     else if (spacecommas)
+                         output(",\001 ");
+ 		    else
+                         output(",\001");
+                 }
+                 output(format_s(name_STRMAX, mp->name));
+             }
+         }
+         output(";\n");
+     }
+     if (ftype->meaning && ftype->meaning->ctx->kind == MK_FUNCTION &&
+                           ftype->meaning->ctx->varstructflag) {
+         if (flag)
+             output("\n");
+         output("struct ");
+         output(format_s(name_LOC, ftype->meaning->ctx->name));
+         output(" *");
+         output(format_s(name_LINK, ftype->meaning->ctx->name));
+         output(";\n");
+     }
+ }
+ 
+ 
+ 
+ 
+ void makevarstruct(func)
+ Meaning *func;
+ {
+     int flag = 0;
+     int saveindent;
+ 
+     outsection(minfuncspace);
+     output(format_s("\n/* Local variables for %s: */\n", func->name));
+     output("struct ");
+     output(format_s(name_LOC, func->name));
+     output(" {\n");
+     saveindent = outindent;
+     moreindent(tabsize);
+     moreindent(structindent);
+     if (func->ctx->kind == MK_FUNCTION && func->ctx->varstructflag) {
+         output("struct ");
+         output(format_s(name_LOC, func->ctx->name));
+         output(" *");
+         output(format_s(name_LINK, func->ctx->name));
+         output(";\n");
+         flag++;
+     }
+     flag += declarevars(func, 1);
+     if (!flag)                       /* Avoid generating an empty struct */
+         output("int _meef_;\n");     /* (I don't think this will ever happen) */
+     outindent = saveindent;
+     output("} ;\n");
+     outsection(minfuncspace);
+     strlist_insert(&varstructdecllist, func->name);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ Type *maketype(kind)
+ enum typekind kind;
+ {
+     Type *tp;
+     tp = ALLOC(1, Type, types);
+     tp->kind = kind;
+     tp->basetype = NULL;
+     tp->indextype = NULL;
+     tp->pointertype = NULL;
+     tp->meaning = NULL;
+     tp->fbase = NULL;
+     tp->smin = NULL;
+     tp->smax = NULL;
+     tp->issigned = 0;
+     tp->dumped = 0;
+     tp->structdefd = 0;
+     tp->preserved = 0;
+     return tp;
+ }
+ 
+ 
+ 
+ 
+ Type *makesubrangetype(type, smin, smax)
+ Type *type;
+ Expr *smin, *smax;
+ {
+     Type *tp;
+ 
+     if (type->kind == TK_SUBR)
+         type = type->basetype;
+     tp = maketype(TK_SUBR);
+     tp->basetype = type;
+     tp->smin = smin;
+     tp->smax = smax;
+     return tp;
+ }
+ 
+ 
+ 
+ Type *makesettype(setof)
+ Type *setof;
+ {
+     Type *tp;
+     long smax;
+ 
+     if (ord_range(setof, NULL, &smax) && smax < setbits && smallsetconst >= 0)
+         tp = maketype(TK_SMALLSET);
+     else
+         tp = maketype(TK_SET);
+     tp->basetype = tp_integer;
+     tp->indextype = setof;
+     return tp;
+ }
+ 
+ 
+ 
+ Type *makestringtype(len)
+ int len;
+ {
+     Type *type;
+     int index;
+ 
+     len |= 1;
+     if (len >= stringceiling)
+         type = tp_str255;
+     else {
+         index = (len-1) / 2;
+         if (stringtypecache[index])
+             return stringtypecache[index];
+         type = maketype(TK_STRING);
+         type->basetype = tp_char;
+         type->indextype = makesubrangetype(tp_integer, 
+                                            makeexpr_long(0), 
+                                            makeexpr_long(len));
+         stringtypecache[index] = type;
+     }
+     return type;
+ }
+ 
+ 
+ 
+ Type *makepointertype(type)
+ Type *type;
+ {
+     Type *tp;
+ 
+     if (type->pointertype)
+         return type->pointertype;
+     tp = maketype(TK_POINTER);
+     tp->basetype = type;
+     type->pointertype = tp;
+     return tp;
+ }
+ 
+ 
+ 
+ 
+ 
+ Value p_constant(type)
+ Type *type;
+ {
+     Value val;
+     Expr *ex;
+ 
+     ex = p_expr(type);
+     if (type)
+         ex = gentle_cast(ex, type);
+     val = eval_expr(ex);
+     freeexpr(ex);
+     if (!val.type) {
+         warning("Expected a constant [127]");
+         val.type = (type) ? type : tp_integer;
+     }
+     return val;
+ }
+ 
+ 
+ 
+ 
+ int typebits(smin, smax)
+ long smin, smax;
+ {
+     unsigned long size;
+     int bits;
+ 
+     if (smin >= 0 || (smin == -1 && smax == 0)) {
+         bits = 1;
+         size = smax;
+     } else {
+         bits = 2;
+         smin = -1L - smin;
+         if (smin >= smax)
+             size = smin;
+         else
+             size = smax;
+     }
+     while (size > 1) {
+         bits++;
+         size >>= 1;
+     }
+     return bits;
+ }
+ 
+ 
+ int packedsize(fname, typep, sizep, mode)
+ char *fname;
+ Type **typep;
+ long *sizep;
+ int mode;
+ {
+     Type *tp = *typep;
+     long smin, smax;
+     int res, issigned;
+     short savefold;
+     long size;
+ 
+     if (packing == 0)   /* suppress packing */
+         return 0;
+     if (tp->kind != TK_SUBR && tp->kind != TK_INTEGER && tp->kind != TK_ENUM &&
+         tp->kind != TK_CHAR && tp->kind != TK_BOOLEAN)
+         return 0;
+     if (tp == tp_unsigned)
+ 	return 0;
+     if (!ord_range(tp, &smin, &smax)) {
+         savefold = foldconsts;
+         foldconsts = 1;
+         res = ord_range(tp, &smin, &smax);
+         foldconsts = savefold;
+         if (res) {
+             note(format_s("Field width for %s is based on expansion of #defines [103]",
+                           fname));
+         } else {
+             note(format_ss("Cannot compute size of field %s; assuming %s [104]",
+                            fname, integername));
+             return 0;
+         }
+     } else {
+         if (tp->kind == TK_ENUM)
+             note(format_ssd("Field width for %s assumes enum%s has %d elements [105]",
+                             fname,
+                             (tp->meaning) ? format_s(" %s", tp->meaning->name) : "",
+                             smax + 1));
+     }
+     issigned = (smin < 0);
+     size = typebits(smin, smax);
+     if (size >= ((sizeof_long > 0) ? sizeof_long : 32))
+         return 0;
+     if (packing != 1) {
+         if (size <= 8)
+             size = 8;
+         else if (size <= 16)
+             size = 16;
+         else
+             return 0;
+     }
+     if (!issigned) {
+         *typep = (mode == 0) ? tp_int : tp_uint;
+     } else {
+         if (mode == 2 && !hassignedchar && !*signextname)
+             return 0;
+         *typep = (mode == 1) ? tp_int : tp_sint;
+     }
+     *sizep = size;
+     return issigned;
+ }
+ 
+ 
+ 
+ Static void fielddecl(mp, type, tp2, val, ispacked, aligned)
+ Meaning *mp;
+ Type **type, **tp2;
+ long *val;
+ int ispacked, *aligned;
+ {
+     long smin, smax, smin2, smax2;
+ 
+     *tp2 = *type;
+     *val = 0;
+     if (ispacked && !mp->constdefn && *type != tp_unsigned) {
+         (void)packedsize(mp->sym->name, tp2, val, signedfield);
+         if (*aligned && *val &&
+             (ord_type(*type)->kind == TK_CHAR ||
+              ord_type(*type)->kind == TK_INTEGER) &&
+             ord_range(findbasetype(*type, 0), &smin, &smax)) {
+ 	    if (ord_range(*type, &smin2, &smax2)) {
+ 		if (typebits(smin, smax) == 16 &&
+ 		    typebits(smin2, smax2) == 8 && *val == 8) {
+ 		    *tp2 = tp_abyte;
+ 		}
+ 	    }
+ 	    if (typebits(smin, smax) == *val &&
+ 		*val != 7) {    /* don't be fooled by tp_abyte */
+ 		/* don't need to use a bit-field for this field */
+ 		/* so not specifying one may make it more efficient */
+ 		/* (and also helps to simulate HP's $allow_packed$ mode) */
+ 		*val = 0;
+ 		*tp2 = *type;
+ 	    } 
+         }
+         if (*aligned && *val == 8 &&
+             (ord_type(*type)->kind == TK_BOOLEAN ||
+              ord_type(*type)->kind == TK_ENUM)) {
+             *val = 0;
+             *tp2 = tp_ubyte;
+         }
+     }
+     if (*val != 8 && *val != 16)
+ 	*aligned = (*val == 0);
+ }
+ 
+ 
+ 
+ /* This function locates byte-sized fields which were unaligned, but which
+    are followed by aligned quantities so that they can be made aligned
+    with no loss in storage efficiency. */
+ 
+ Static void realignfields(firstmp, stopmp)
+ Meaning *firstmp, *stopmp;
+ {
+     Meaning *mp;
+ 
+     for (mp = firstmp; mp && mp != stopmp; mp = mp->cnext) {
+ 	if (mp->kind == MK_FIELD) {
+ 	    if (mp->val.i == 16) {
+ 		if (mp->type == tp_uint)
+ 		    mp->type = tp_ushort;
+ 		else
+ 		    mp->type = tp_sshort;
+ 		mp->val.i = 0;
+ 	    } else if (mp->val.i == 8) {
+ 		if (mp->type == tp_uint) {
+ 		    mp->type = tp_ubyte;
+ 		    mp->val.i = 0;
+ 		} else if (hassignedchar || signedchars == 1) {
+ 		    mp->type = tp_sbyte;
+ 		    mp->val.i = 0;
+ 		} else
+ 		    mp->type = tp_abyte;
+ 	    }
+ 	}
+     }
+ }
+ 
+ static void tryrealignfields(firstmp)
+ Meaning *firstmp;
+ {
+     Meaning *mp, *head;
+ 
+     head = NULL;
+     for (mp = firstmp; mp; mp = mp->cnext) {
+ 	if (mp->kind == MK_FIELD) {
+ 	    if ((mp->val.i == 8 &&
+ 		 (mp->type == tp_uint ||
+ 		  hassignedchar || signedchars == 1)) ||
+ 		mp->val.i == 16) {
+ 		if (!head)
+ 		    head = mp;
+ 	    } else {
+ 		if (mp->val.i == 0)
+ 		    realignfields(head, mp);
+ 		head = NULL;
+ 	    }
+ 	}
+     }
+     realignfields(head, NULL);
+ }
+ 
+ 
+ 
+ void decl_comments(mp)
+ Meaning *mp;
+ {
+     Strlist *cmt;
+ 
+     if (spitcomments != 1) {
+ 	changecomments(curcomments, -1, -1, CMT_PRE, 0);
+ 	strlist_mix(&mp->comments, curcomments);
+ 	curcomments = NULL;
+ 	cmt = grabcomment(CMT_TRAIL);
+ 	if (cmt) {
+ 	    changecomments(mp->comments, CMT_TRAIL, -1, CMT_PRE, -1);
+ 	    strlist_mix(&mp->comments, cmt);
+ 	}
+ 	if (mp->comments)
+ 	    mp->refcount++;   /* force it to be included if it has comments */
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ Static void p_fieldlist(tp, flast, ispacked, tname)
+ Type *tp;
+ Meaning **flast;
+ int ispacked;
+ Meaning *tname;
+ {
+     Meaning *firstm, *lastm, *veryfirstm, *dtype;
+     Symbol *sym;
+     Type *type, *tp2;
+     long li1, li2;
+     int aligned, constflag, volatileflag;
+     short saveskipind;
+     Strlist *l1;
+ 
+     saveskipind = skipindices;
+     skipindices = 0;
+     aligned = 1;
+     lastm = NULL;
+     veryfirstm = NULL;
+     while (curtok == TOK_IDENT) {
+         firstm = addfield(curtoksym, &flast, tp, tname);
+ 	if (!veryfirstm)
+ 	    veryfirstm = firstm;
+         lastm = firstm;
+         gettok();
+ 	decl_comments(lastm);
+         while (curtok == TOK_COMMA) {
+             gettok();
+             if (wexpecttok(TOK_IDENT))
+ 		lastm = addfield(curtoksym, &flast, tp, tname);
+             gettok();
+ 	    decl_comments(lastm);
+         }
+         if (wneedtok(TOK_COLON)) {
+ 	    constflag = volatileflag = 0;
+ 	    p_attributes();
+ 	    if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ 		constflag = 1;
+ 		strlist_delete(&attrlist, l1);
+ 	    }
+ 	    if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ 		volatileflag = 1;
+ 		strlist_delete(&attrlist, l1);
+ 	    }
+ 	    dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ 	    type = p_type(firstm);
+ 	    decl_comments(lastm);
+ 	    fielddecl(firstm, &type, &tp2, &li1, ispacked, &aligned);
+ 	    dtype = validatedtype(dtype, type);
+ 	    for (;;) {
+ 		firstm->type = tp2;
+ 		firstm->dtype = dtype;
+ 		firstm->val.type = type;
+ 		firstm->val.i = li1;
+ 		firstm->constqual = constflag;
+ 		firstm->volatilequal = volatileflag;
+ 		tp->meaning = tname;
+ 		setupfilevar(firstm);
+ 		tp->meaning = NULL;
+ 		if (firstm == lastm)
+ 		    break;
+ 		firstm = firstm->cnext;
+ 	    }
+ 	} else
+ 	    skiptotoken2(TOK_SEMI, TOK_CASE);
+         if (curtok == TOK_SEMI)
+             gettok();
+     }
+     if (curtok == TOK_CASE) {
+         gettok();
+ 	if (curtok == TOK_COLON)
+ 	    gettok();
+ 	wexpecttok(TOK_IDENT);
+ 	sym = curtoksym;
+ 	if (curtokmeaning)
+ 	    type = curtokmeaning->type;
+ 	gettok();
+         if (curtok == TOK_COLON) {
+             firstm = addfield(sym, &flast, tp, tname);
+ 	    if (!veryfirstm)
+ 		veryfirstm = firstm;
+             gettok();
+ 	    firstm->isforward = 1;
+             firstm->val.type = type = p_type(firstm);
+             fielddecl(firstm, &firstm->val.type, &firstm->type, &firstm->val.i, 
+                       ispacked, &aligned);
+         } else {
+ 	    firstm = NULL;
+ 	}
+         if (!wneedtok(TOK_OF)) {
+ 	    skiptotoken2(TOK_END, TOK_RPAR);
+ 	    goto bounce;
+ 	}
+ 	if (firstm)
+ 	    decl_comments(firstm);
+ 	while (curtok == TOK_VBAR)
+ 	    gettok();
+         while (curtok != TOK_END && curtok != TOK_RPAR) {
+             firstm = NULL;
+             for (;;) {
+ 		lastm = addfield(NULL, &flast, tp, tname);
+ 		if (!firstm)
+ 		    firstm = lastm;
+ 		checkkeyword(TOK_OTHERWISE);
+ 		if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
+ 		    lastm->val = make_ord(type, 999);
+ 		    break;
+ 		} else {
+ 		    lastm->val = p_constant(type);
+ 		    if (curtok == TOK_DOTS) {
+ 			gettok();
+ 			li1 = ord_value(lastm->val);
+ 			li2 = ord_value(p_constant(type));
+ 			while (++li1 <= li2) {
+ 			    lastm = addfield(NULL, &flast, tp, tname);
+ 			    lastm->val = make_ord(type, li1);
+ 			}
+ 		    }
+ 		}
+                 if (curtok == TOK_COMMA)
+                     gettok();
+                 else
+                     break;
+             }
+ 	    if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
+ 		gettok();
+             } else if (!wneedtok(TOK_COLON) ||
+ 		     (!modula2 && !wneedtok(TOK_LPAR))) {
+ 		skiptotoken2(TOK_END, TOK_RPAR);
+ 		goto bounce;
+ 	    }
+             p_fieldlist(tp, &lastm->ctx, ispacked, tname);
+             while (firstm != lastm) {
+                 firstm->ctx = lastm->ctx;
+                 firstm = firstm->cnext;
+             }
+ 	    if (modula2) {
+ 		while (curtok == TOK_VBAR)
+ 		    gettok();
+ 	    } else {
+ 		if (!wneedtok(TOK_RPAR))
+ 		    skiptotoken(TOK_RPAR);
+ 	    }
+             if (curtok == TOK_SEMI)
+                 gettok();
+         }
+ 	if (modula2) {
+ 	    wneedtok(TOK_END);
+ 	    if (curtok == TOK_IDENT) {
+ 		note("Record variants supported only at end of record [106]");
+ 		p_fieldlist(tp, &lastm->ctx, ispacked, tname);
+ 	    }
+ 	}
+     }
+     tryrealignfields(veryfirstm);
+     if (lastm && curtok == TOK_END) {
+ 	strlist_mix(&lastm->comments, curcomments);
+ 	curcomments = NULL;
+     }
+ 
+   bounce:
+     skipindices = saveskipind;
+ }
+ 
+ 
+ 
+ Static Type *p_arraydecl(tname, ispacked, confp)
+ char *tname;
+ int ispacked;
+ Meaning ***confp;
+ {
+     Type *tp, *tp2;
+     Meaning *mp;
+     Expr *ex;
+     long size, smin, smax, bitsize, fullbitsize;
+     int issigned, bpower, hasrange;
+ 
+     tp = maketype(TK_ARRAY);
+     if (confp == NULL) {
+ 	tp->indextype = p_type(NULL);
+ 	if (tp->indextype->kind == TK_SUBR) {
+ 	    if (ord_range(tp->indextype, &smin, NULL) &&
+ 		smin > 0 && smin <= skipindices && !ispacked) {
+ 		tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
+ 		ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
+ 		tp->indextype = makesubrangetype(tp->indextype->basetype,
+ 						 ex,
+ 						 copyexpr(tp->indextype->smax));
+ 	    }
+ 	}
+     } else {
+ 	if (modula2) {
+ 	    **confp = mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
+ 	    mp->fakeparam = 1;
+ 	    mp->constqual = 1;
+ 	    mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
+ 	    mp->xnext->fakeparam = 1;
+ 	    mp->xnext->constqual = 1;
+ 	    *confp = &mp->xnext->xnext;
+ 	    tp2 = maketype(TK_SUBR);
+ 	    tp2->basetype = tp_integer;
+ 	    mp->type = tp_integer;
+ 	    mp->xnext->type = mp->type;
+ 	    tp2->smin = makeexpr_long(0);
+ 	    tp2->smax = makeexpr_minus(makeexpr_var(mp->xnext),
+ 				       makeexpr_var(mp));
+ 	    tp->indextype = tp2;
+ 	    tp->structdefd = 1;
+ 	} else {
+ 	    wexpecttok(TOK_IDENT);
+ 	    tp2 = maketype(TK_SUBR);
+ 	    if (peeknextchar() != ',' &&
+ 		(!curtokmeaning || curtokmeaning->kind != MK_TYPE)) {
+ 		mp = addmeaning(curtoksym, MK_PARAM);
+ 		gettok();
+ 		wneedtok(TOK_DOTS);
+ 		wexpecttok(TOK_IDENT);
+ 		mp->xnext = addmeaning(curtoksym, MK_PARAM);
+ 		gettok();
+ 		if (wneedtok(TOK_COLON)) {
+ 		    tp2->basetype = p_type(NULL);
+ 		} else {
+ 		    tp2->basetype = tp_integer;
+ 		}
+ 	    } else {
+ 		mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
+ 		mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
+ 		tp2->basetype = p_type(NULL);
+ 	    }
+ 	    mp->fakeparam = 1;
+ 	    mp->constqual = 1;
+ 	    mp->xnext->fakeparam = 1;
+ 	    mp->xnext->constqual = 1;
+ 	    **confp = mp;
+ 	    *confp = &mp->xnext->xnext;
+ 	    mp->type = tp2->basetype;
+ 	    mp->xnext->type = tp2->basetype;
+ 	    tp2->smin = makeexpr_var(mp);
+ 	    tp2->smax = makeexpr_var(mp->xnext);
+ 	    tp->indextype = tp2;
+ 	    tp->structdefd = 1;     /* conformant array flag */
+ 	}
+     }
+     if (curtok == TOK_COMMA || curtok == TOK_SEMI) {
+         gettok();
+         tp->basetype = p_arraydecl(tname, ispacked, confp);
+         return tp;
+     } else {
+ 	if (!modula2) {
+ 	    if (!wneedtok(TOK_RBR))
+ 		skiptotoken(TOK_OF);
+ 	}
+         if (!wneedtok(TOK_OF))
+ 	    skippasttotoken(TOK_OF, TOK_COMMA);
+ 	checkkeyword(TOK_VARYING);
+ 	if (confp != NULL &&
+ 	    (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
+ 	     curtok == TOK_VARYING)) {
+ 	    tp->basetype = p_conformant_array(tname, confp);
+ 	} else {
+ 	    tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ 	    tp->basetype = p_type(NULL);
+ 	    tp->fbase = validatedtype(tp->fbase, tp->basetype);
+ 	}
+         if (!ispacked)
+             return tp;
+         size = 0;
+         tp2 = tp->basetype;
+         if (!tname)
+             tname = "array";
+         issigned = packedsize(tname, &tp2, &size, 1);
+         if (!size || size > 8 ||
+             (issigned && !packsigned) ||
+             (size > 4 &&
+              (!issigned || (signedchars == 1 || hassignedchar))))
+             return tp;
+         bpower = 0;
+         while ((1<<bpower) < size)
+             bpower++;        /* round size up to power of two */
+         size = 1<<bpower;    /* size = # bits in an array element */
+         tp->escale = bpower;
+         tp->issigned = issigned;
+         hasrange = ord_range(tp->indextype, &smin, &smax) &&
+                    (smax < 100000);    /* don't be confused by giant arrays */
+         if (hasrange &&
+ 	    (bitsize = (smax - smin + 1) * size)
+ 	        <= ((sizeof_integer > 0) ? sizeof_integer : 32)) {
+             if (bitsize > ((sizeof_short > 0) ? sizeof_short : 16)) {
+                 tp2 = (issigned) ? tp_integer : tp_unsigned;
+                 fullbitsize = ((sizeof_integer > 0) ? sizeof_integer : 32);
+             } else if (bitsize > ((sizeof_char > 0) ? sizeof_char : 8) ||
+                        (issigned && !(signedchars == 1 || hassignedchar))) {
+                 tp2 = (issigned) ? tp_sshort : tp_ushort;
+                 fullbitsize = ((sizeof_short > 0) ? sizeof_short : 16);
+             } else {
+                 tp2 = (issigned) ? tp_sbyte : tp_ubyte;
+                 fullbitsize = ((sizeof_char > 0) ? sizeof_char : 8);
+             }
+             tp->kind = TK_SMALLARRAY;
+             if (ord_range(tp->indextype, &smin, NULL) &&
+                 smin > 0 && smin <= fullbitsize - bitsize) {
+                 tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
+ 		ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
+                 tp->indextype = makesubrangetype(tp->indextype->basetype, ex,
+                                                  copyexpr(tp->indextype->smax));
+             }
+         } else {
+             if (!issigned)
+                 tp2 = tp_ubyte;
+             else if (signedchars == 1 || hassignedchar)
+                 tp2 = tp_sbyte;
+             else
+                 tp2 = tp_sshort;
+         }
+         tp->smax = makeexpr_type(tp->basetype);
+         tp->basetype = tp2;
+         return tp;
+     }
+ }
+ 
+ 
+ 
+ Static Type *p_conformant_array(tname, confp)
+ char *tname;
+ Meaning ***confp;
+ {
+     int ispacked;
+     Meaning *mp;
+     Type *tp, *tp2;
+ 
+     p_attributes();
+     ignore_attributes();
+     if (curtok == TOK_PACKED) {
+ 	ispacked = 1;
+ 	gettok();
+     } else
+ 	ispacked = 0;
+     checkkeyword(TOK_VARYING);
+     if (curtok == TOK_VARYING) {
+ 	gettok();
+ 	wneedtok(TOK_LBR);
+ 	wexpecttok(TOK_IDENT);
+ 	mp = addmeaning(curtoksym, MK_PARAM);
+ 	mp->fakeparam = 1;
+ 	mp->constqual = 1;
+ 	**confp = mp;
+ 	*confp = &mp->xnext;
+ 	mp->type = tp_integer;
+ 	tp2 = maketype(TK_SUBR);
+ 	tp2->basetype = tp_integer;
+ 	tp2->smin = makeexpr_long(1);
+ 	tp2->smax = makeexpr_var(mp);
+ 	tp = maketype(TK_STRING);
+ 	tp->indextype = tp2;
+ 	tp->basetype = tp_char;
+ 	tp->structdefd = 1;     /* conformant array flag */
+ 	gettok();
+ 	wneedtok(TOK_RBR);
+ 	skippasttoken(TOK_OF);
+ 	tp->basetype = p_type(NULL);
+ 	return tp;
+     }
+     if (wneedtok(TOK_ARRAY) &&
+ 	(modula2 || wneedtok(TOK_LBR))) {
+ 	return p_arraydecl(tname, ispacked, confp);
+     } else {
+ 	return tp_integer;
+     }
+ }
+ 
+ 
+ 
+ 
+ /* VAX Pascal: */
+ void p_attributes()
+ {
+     Strlist *l1;
+ 
+     if (modula2)
+ 	return;
+     while (curtok == TOK_LBR) {
+ 	implementationmodules = 1;    /* auto-detect VAX Pascal */
+ 	do {
+ 	    gettok();
+ 	    if (!wexpecttok(TOK_IDENT)) {
+ 		skippasttoken(TOK_RBR);
+ 		return;
+ 	    }
+ 	    l1 = strlist_append(&attrlist, strupper(curtokbuf));
+ 	    l1->value = -1;
+ 	    gettok();
+ 	    if (curtok == TOK_LPAR) {
+ 		gettok();
+ 		if (!strcmp(l1->s, "CHECK") ||
+ 		    !strcmp(l1->s, "OPTIMIZE") ||
+ 		    !strcmp(l1->s, "KEY") ||
+ 		    !strcmp(l1->s, "COMMON") ||
+ 		    !strcmp(l1->s, "PSECT") ||
+ 		    !strcmp(l1->s, "EXTERNAL") ||
+ 		    !strcmp(l1->s, "GLOBAL") ||
+ 		    !strcmp(l1->s, "WEAK_EXTERNAL") ||
+ 		    !strcmp(l1->s, "WEAK_GLOBAL")) {
+ 		    l1->value = (long)stralloc(curtokbuf);
+ 		    gettok();
+ 		    while (curtok == TOK_COMMA) {
+ 			gettok();
+ 			gettok();
+ 		    }
+ 		} else if (!strcmp(l1->s, "INHERIT") ||
+ 			   !strcmp(l1->s, "IDENT") ||
+ 			   !strcmp(l1->s, "ENVIRONMENT")) {
+ 		    p_expr(NULL);
+ 		    while (curtok == TOK_COMMA) {
+ 			gettok();
+ 			p_expr(NULL);
+ 		    }
+ 		} else {
+ 		    l1->value = ord_value(p_constant(tp_integer));
+ 		    while (curtok == TOK_COMMA) {
+ 			gettok();
+ 			p_expr(NULL);
+ 		    }
+ 		}
+ 		if (!wneedtok(TOK_RPAR)) {
+ 		    skippasttotoken(TOK_RPAR, TOK_LBR);
+ 		}
+ 	    }
+ 	} while (curtok == TOK_COMMA);
+ 	if (!wneedtok(TOK_RBR)) {
+ 	    skippasttoken(TOK_RBR);
+ 	}
+     }
+ }
+ 
+ 
+ void ignore_attributes()
+ {
+     while (attrlist) {
+ 	if (strcmp(attrlist->s, "HIDDEN") &&
+ 	    strcmp(attrlist->s, "INHERIT") &&
+ 	    strcmp(attrlist->s, "ENVIRONMENT"))
+ 	    warning(format_s("Type attribute %s ignored [128]", attrlist->s));
+ 	strlist_eat(&attrlist);
+     }
+ }
+ 
+ 
+ int size_attributes()
+ {
+     int size = -1;
+     Strlist *l1;
+ 
+     if ((l1 = strlist_find(attrlist, "BIT")) != NULL)
+ 	size = 1;
+     else if ((l1 = strlist_find(attrlist, "BYTE")) != NULL)
+ 	size = 8;
+     else if ((l1 = strlist_find(attrlist, "WORD")) != NULL)
+ 	size = 16;
+     else if ((l1 = strlist_find(attrlist, "LONG")) != NULL)
+ 	size = 32;
+     else if ((l1 = strlist_find(attrlist, "QUAD")) != NULL)
+ 	size = 64;
+     else if ((l1 = strlist_find(attrlist, "OCTA")) != NULL)
+ 	size = 128;
+     else
+ 	return -1;
+     if (l1->value >= 0)
+ 	size *= l1->value;
+     strlist_delete(&attrlist, l1);
+     return size;
+ }
+ 
+ 
+ void p_mech_spec(doref)
+ int doref;
+ {
+     if (curtok == TOK_IDENT && doref &&
+ 	!strcicmp(curtokbuf, "%REF")) {
+ 	note("Mechanism specified %REF treated like VAR [107]");
+ 	curtok = TOK_VAR;
+ 	return;
+     }
+     if (curtok == TOK_IDENT &&
+ 	(!strcicmp(curtokbuf, "%REF") ||
+ 	 !strcicmp(curtokbuf, "%IMMED") ||
+ 	 !strcicmp(curtokbuf, "%DESCR") ||
+ 	 !strcicmp(curtokbuf, "%STDESCR"))) {
+ 	note(format_s("Mechanism specifier %s ignored [108]", curtokbuf));
+ 	gettok();
+     }
+ }
+ 
+ 
+ Type *p_modula_subrange(basetype)
+ Type *basetype;
+ {
+     Type *tp;
+     Value val;
+ 
+     wneedtok(TOK_LBR);
+     tp = maketype(TK_SUBR);
+     tp->smin = p_ord_expr();
+     if (basetype)
+ 	tp->smin = gentle_cast(tp->smin, basetype);
+     if (wexpecttok(TOK_DOTS)) {
+ 	gettok();
+ 	tp->smax = p_ord_expr();
+ 	if (tp->smax->val.type->kind == TK_REAL &&
+ 	    tp->smax->kind == EK_CONST &&
+ 	    strlen(tp->smax->val.s) == 12 &&
+ 	    strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
+ 	    strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
+ 	    tp = tp_unsigned;
+ 	} else if (basetype) {
+ 	    tp->smin = gentle_cast(tp->smin, basetype);
+ 	    tp->basetype = basetype;
+ 	} else {
+ 	    basetype = ord_type(tp->smin->val.type);
+ 	    if (basetype->kind == TK_INTEGER) {
+ 		val = eval_expr(tp->smin);
+ 		if (val.type && val.i >= 0)
+ 		    basetype = tp_unsigned;
+ 		else
+ 		    basetype = tp_integer;
+ 	    }
+ 	    tp->basetype = basetype;
+ 	}
+     } else {
+ 	tp = tp_integer;
+     }
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     return tp;
+ }
+ 
+ 
+ void makefakestruct(tp, tname)
+ Type *tp;
+ Meaning *tname;
+ {
+     Symbol *sym;
+ 
+     if (!tname || blockkind == TOK_IMPORT)
+ 	return;
+     while (tp && (tp->kind == TK_ARRAY || tp->kind == TK_FILE))
+ 	tp = tp->basetype;
+     if (tp && tp->kind == TK_RECORD && !tp->meaning) {
+ 	sym = findsymbol(format_s(name_FAKESTRUCT, tname->name));
+ 	silentalreadydef++;
+ 	tp->meaning = addmeaning(sym, MK_TYPE);
+ 	silentalreadydef--;
+ 	tp->meaning->type = tp;
+ 	tp->meaning->refcount++;
+ 	declaretype(tp->meaning);
+     }
+ }
+ 
+ 
+ Type *p_type(tname)
+ Meaning *tname;
+ {
+     Type *tp;
+     int ispacked = 0;
+     Meaning **flast;
+     Meaning *mp;
+     Strlist *sl;
+     int num, isfunc, saveind, savenotephase, sizespec;
+     Expr *ex;
+     Value val;
+     static int proctypecount = 0;
+ 
+     p_attributes();
+     sizespec = size_attributes();
+     ignore_attributes();
+     tp = tp_integer;
+     if (curtok == TOK_PACKED) {
+         ispacked = 1;
+         gettok();
+     }
+     checkkeyword(TOK_VARYING);
+     if (modula2)
+ 	checkkeyword(TOK_POINTER);
+     switch (curtok) {
+ 
+         case TOK_RECORD:
+             gettok();
+ 	    savenotephase = notephase;
+ 	    notephase = 1;
+             tp = maketype(TK_RECORD);
+             p_fieldlist(tp, &(tp->fbase), ispacked, tname);
+ 	    notephase = savenotephase;
+             if (!wneedtok(TOK_END)) {
+ 		skippasttoken(TOK_END);
+ 	    }
+             break;
+ 
+         case TOK_ARRAY:
+             gettok();
+ 	    if (!modula2) {
+ 		if (!wneedtok(TOK_LBR))
+ 		    break;
+ 	    }
+ 	    tp = p_arraydecl(tname ? tname->name : NULL, ispacked, NULL);
+ 	    makefakestruct(tp, tname);
+             break;
+ 
+ 	case TOK_VARYING:
+ 	    gettok();
+ 	    tp = maketype(TK_STRING);
+ 	    if (wneedtok(TOK_LBR)) {
+ 		ex = p_ord_expr();
+ 		if (!wneedtok(TOK_RBR))
+ 		    skippasttoken(TOK_RBR);
+ 	    } else
+ 		ex = makeexpr_long(stringdefault);
+ 	    if (wneedtok(TOK_OF))
+ 		tp->basetype = p_type(NULL);
+ 	    else
+ 		tp->basetype = tp_char;
+ 	    val = eval_expr(ex);
+ 	    if (val.type) {
+ 		if (val.i > 255 && val.i > stringceiling) {
+ 		    note(format_d("Strings longer than %d may have problems [109]",
+ 				  stringceiling));
+ 		}
+ 		if (stringceiling != 255 &&
+ 		    (val.i >= 255 || val.i > stringceiling)) {
+ 		    freeexpr(ex);
+ 		    ex = makeexpr_long(stringceiling);
+ 		}
+ 	    }
+ 	    tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
+ 	    break;
+ 
+         case TOK_SET:
+             gettok();
+             if (!wneedtok(TOK_OF))
+ 		break;
+ 	    tp = p_type(NULL);
+ 	    if (tp == tp_integer || tp == tp_unsigned)
+ 		tp = makesubrangetype(tp, makeexpr_long(0),
+ 				      makeexpr_long(defaultsetsize-1));
+ 	    if (tp->kind == TK_ENUM && !tp->meaning && useenum) {
+ 		outbasetype(tp, 0);
+ 		output(";");
+ 	    }
+             tp = makesettype(tp);
+             break;
+ 
+         case TOK_FILE:
+             gettok();
+ 	    if (structfilesflag ||
+ 		(tname && strlist_cifind(structfiles, tname->name)))
+ 		tp = maketype(TK_BIGFILE);
+ 	    else
+ 		tp = maketype(TK_FILE);
+             if (curtok == TOK_OF) {
+                 gettok();
+                 tp->basetype = p_type(NULL);
+             } else {
+                 tp->basetype = tp_abyte;
+             }
+ 	    if (tp->basetype->kind == TK_CHAR && charfiletext) {
+ 		if (tp->kind == TK_FILE)
+ 		    tp = tp_text;
+ 		else
+ 		    tp = tp_bigtext;
+ 	    } else {
+ 		if (tp->kind == TK_FILE) {
+ 		    makefakestruct(tp, tname);
+ 		    tp = makepointertype(tp);
+ 		}
+ 	    }
+             break;
+ 
+         case TOK_PROCEDURE:
+ 	case TOK_FUNCTION:
+ 	    isfunc = (curtok == TOK_FUNCTION);
+             gettok();
+ 	    if (curtok != TOK_LPAR && !isfunc && hasstaticlinks == 1) {
+ 		tp = tp_proc;
+ 		break;
+ 	    }
+ 	    proctypecount++;
+ 	    mp = addmeaning(findsymbol(format_d("__PROCPTR%d",
+ 						proctypecount)),
+ 			    MK_FUNCTION);
+ 	    pushctx(mp);
+ 	    tp = maketype((hasstaticlinks != 0) ? TK_PROCPTR : TK_CPROCPTR);
+ 	    tp->basetype = p_funcdecl(&isfunc, 1);
+ 	    tp->fbase = mp;   /* (saved, but not currently used) */
+ 	    tp->escale = hasstaticlinks;
+ 	    popctx();
+             break;
+ 
+         case TOK_HAT:
+ 	case TOK_ADDR:
+ 	case TOK_POINTER:
+ 	    if (curtok == TOK_POINTER) {
+ 		gettok();
+ 		wneedtok(TOK_TO);
+ 		if (curtok == TOK_IDENT && !strcmp(curtokbuf, "WORD")) {
+ 		    tp = tp_anyptr;
+ 		    gettok();
+ 		    break;
+ 		}
+ 	    } else
+ 		gettok();
+ 	    p_attributes();
+ 	    ignore_attributes();
+             tp = maketype(TK_POINTER);
+             if (curtok == TOK_IDENT &&
+ 		(!curtokmeaning || curtokmeaning->kind != MK_TYPE ||
+ 		 (deferallptrs && curtokmeaning->ctx != curctx &&
+ 		  curtokmeaning->ctx != nullctx))) {
+                 struct ptrdesc *pd;
+                 pd = ALLOC(1, struct ptrdesc, ptrdescs);
+                 pd->sym = curtoksym;
+                 pd->tp = tp;
+                 pd->next = ptrbase;
+                 ptrbase = pd;
+                 tp->basetype = tp_abyte;
+ 		tp->smin = makeexpr_name(curtokcase, tp_integer);
+ 		anydeferredptrs = 1;
+                 gettok();
+             } else {
+ 		tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+                 tp->basetype = p_type(NULL);
+ 		tp->fbase = validatedtype(tp->fbase, tp->basetype);
+                 if (!tp->basetype->pointertype)
+                     tp->basetype->pointertype = tp;
+             }
+             break;
+ 
+         case TOK_LPAR:
+             if (!useenum)
+                 outsection(minorspace);
+ 	    enum_tname = tname;
+             tp = maketype(TK_ENUM);
+             flast = &(tp->fbase);
+             num = 0;
+             do {
+                 gettok();
+                 if (!wexpecttok(TOK_IDENT)) {
+ 		    skiptotoken(TOK_RPAR);
+ 		    break;
+ 		}
+                 sl = strlist_find(constmacros, curtoksym->name);
+                 mp = addmeaningas(curtoksym, MK_CONST, MK_VARIANT);
+                 mp->val.type = tp;
+                 mp->val.i = num++;
+                 mp->type = tp;
+                 if (sl) {
+                     mp->constdefn = (Expr *)sl->value;
+                     mp->anyvarflag = 1;    /* Make sure constant is folded */
+                     strlist_delete(&constmacros, sl);
+                     if (mp->constdefn->kind == EK_NAME)
+                         strchange(&mp->name, mp->constdefn->val.s);
+                 } else {
+                     if (!useenum) {
+ 			output(format_s("#define %s", mp->name));
+ 			mp->isreturn = 1;
+ 			out_spaces(constindent, 0, 0, 0);
+ 			saveind = outindent;
+ 			outindent = cur_column();
+ 			output(format_d("%d\n", mp->val.i));
+ 			outindent = saveind;
+ 		    }
+ 		}
+                 *flast = mp;
+                 flast = &(mp->xnext);
+                 gettok();
+             } while (curtok == TOK_COMMA);
+ 	    if (!wneedtok(TOK_RPAR))
+ 		skippasttoken(TOK_RPAR);
+             tp->smin = makeexpr_long(0);
+             tp->smax = makeexpr_long(num-1);
+             if (!useenum)
+                 outsection(minorspace);
+             break;
+ 
+ 	case TOK_LBR:
+ 	    tp = p_modula_subrange(NULL);
+ 	    break;
+ 
+         case TOK_IDENT:
+             if (!curtokmeaning) {
+                 undefsym(curtoksym);
+                 tp = tp_integer;
+                 mp = addmeaning(curtoksym, MK_TYPE);
+                 mp->type = tp;
+                 gettok();
+                 break;
+             } else if (curtokmeaning == mp_string) {
+                 gettok();
+                 tp = maketype(TK_STRING);
+                 tp->basetype = tp_char;
+                 if (curtok == TOK_LBR) {
+                     gettok();
+                     ex = p_ord_expr();
+                     if (!wneedtok(TOK_RBR))
+ 			skippasttoken(TOK_RBR);
+                 } else {
+ 		    ex = makeexpr_long(stringdefault);
+                 }
+                 val = eval_expr(ex);
+                 if (val.type && stringceiling != 255 &&
+                     (val.i >= 255 || val.i > stringceiling)) {
+                     freeexpr(ex);
+                     ex = makeexpr_long(stringceiling);
+                 }
+                 tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
+                 break;
+             } else if (curtokmeaning->kind == MK_TYPE) {
+                 tp = curtokmeaning->type;
+ 		if (sizespec > 0) {
+ 		    if (ord_type(tp)->kind == TK_INTEGER && sizespec <= 32) {
+ 			if (checkconst(tp->smin, 0)) {
+ 			    if (sizespec == 32)
+ 				tp = tp_unsigned;
+ 			    else
+ 				tp = makesubrangetype(tp_unsigned,
+ 					 makeexpr_long(0),
+ 				         makeexpr_long((1L << sizespec) - 1));
+ 			} else {
+ 			    tp = makesubrangetype(tp_integer,
+ 				     makeexpr_long(- ((1L << (sizespec-1)))),
+ 				     makeexpr_long((1L << (sizespec-1)) - 1));
+ 			}
+ 			sizespec = -1;
+ 		    }
+ 		}
+                 gettok();
+ 		if (curtok == TOK_LBR) {
+ 		    if (modula2) {
+ 			tp = p_modula_subrange(tp);
+ 		    } else {
+ 			gettok();
+ 			ex = p_expr(tp_integer);
+ 			note("UCSD size spec ignored; using 'long int' [110]");
+ 			if (ord_type(tp)->kind == TK_INTEGER)
+ 			    tp = tp_integer;
+ 			if (!wneedtok(TOK_RBR))
+ 			    skippasttotoken(TOK_RBR, TOK_SEMI);
+ 		    }
+ 		}
+ 		if (tp == tp_text &&
+ 		    (structfilesflag ||
+ 		     (tname && strlist_cifind(structfiles, tname->name))))
+ 		    tp = tp_bigtext;
+                 break;
+             }
+ 
+         /* fall through */
+         default:
+             tp = maketype(TK_SUBR);
+             tp->smin = p_ord_expr();
+ 	    if (curtok == TOK_COLON)
+ 		curtok = TOK_DOTS;    /* UCSD Pascal */
+ 	    if (wexpecttok(TOK_DOTS)) {
+ 		gettok();
+ 		tp->smax = p_ord_expr();
+ 		if (tp->smax->val.type->kind == TK_REAL &&
+ 		    tp->smax->kind == EK_CONST &&
+ 		    strlen(tp->smax->val.s) == 12 &&
+ 		    strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
+ 		    strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
+ 		    tp = tp_unsigned;
+ 		    break;
+ 		}
+ 		tp->basetype = ord_type(tp->smin->val.type);
+ 		if (sizespec >= 0) {
+ 		    long smin, smax;
+ 		    if (ord_range(tp, &smin, &smax) &&
+ 			typebits(smin, smax) == sizespec)
+ 			sizespec = -1;
+ 		}
+ 	    } else {
+ 		tp = tp_integer;
+ 	    }
+             break;
+     }
+     if (sizespec >= 0)
+ 	note(format_d("Don't know how to interpret size = %d bits [111]", sizespec));
+     return tp;
+ }
+ 
+ 
+ 
+ 
+ 
+ Type *p_funcdecl(isfunc, istype)
+ int *isfunc, istype;
+ {
+     Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm;
+     Type *type, *tp;
+     enum meaningkind parkind;
+     int anyvarflag, constflag, volatileflag, num = 0;
+     Symbol *sym;
+     Expr *defval;
+     Token savetok;
+     Strlist *l1;
+ 
+     if (*isfunc || modula2) {
+         sym = findsymbol(format_s(name_RETV, curctx->name));
+         retmp = addmeaning(sym, MK_VAR);
+ 	retmp->isreturn = 1;
+     }
+     type = maketype(TK_FUNCTION);
+     if (curtok == TOK_LPAR) {
+         prevm = &type->fbase;
+         do {
+             gettok();
+ 	    if (curtok == TOK_RPAR)
+ 		break;
+ 	    p_mech_spec(1);
+ 	    p_attributes();
+ 	    checkkeyword(TOK_ANYVAR);
+             if (curtok == TOK_VAR || curtok == TOK_ANYVAR) {
+                 parkind = MK_VARPARAM;
+                 anyvarflag = (curtok == TOK_ANYVAR);
+                 gettok();
+             } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) {
+ 		savetok = curtok;
+ 		gettok();
+ 		wexpecttok(TOK_IDENT);
+ 		*prevm = firstmp = addmeaning(curtoksym, MK_PARAM);
+ 		prevm = &firstmp->xnext;
+ 		firstmp->anyvarflag = 0;
+ 		curtok = savetok;   /* rearrange tokens to a proc ptr type! */
+ 		firstmp->type = p_type(firstmp);
+ 		continue;
+             } else {
+                 parkind = MK_PARAM;
+                 anyvarflag = 0;
+             }
+ 	    oldprevm = prevm;
+ 	    if (modula2 && istype) {
+ 		firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind);
+ 	    } else {
+ 		wexpecttok(TOK_IDENT);
+ 		firstmp = addmeaning(curtoksym, parkind);
+ 		gettok();
+ 	    }
+             *prevm = firstmp;
+             prevm = &firstmp->xnext;
+             firstmp->isactive = 0;   /* nit-picking Turbo compatibility */
+ 	    lastmp = firstmp;
+             while (curtok == TOK_COMMA) {
+                 gettok();
+                 if (wexpecttok(TOK_IDENT)) {
+ 		    *prevm = lastmp = addmeaning(curtoksym, parkind);
+ 		    prevm = &lastmp->xnext;
+ 		    lastmp->isactive = 0;
+ 		}
+                 gettok();
+             }
+ 	    constflag = volatileflag = 0;
+ 	    defval = NULL;
+             if (curtok != TOK_COLON && !modula2) {
+ 		if (parkind != MK_VARPARAM)
+ 		    wexpecttok(TOK_COLON);
+ 		parkind = MK_VARPARAM;
+                 tp = tp_anyptr;
+                 anyvarflag = 1;
+             } else {
+ 		if (curtok == TOK_COLON)
+ 		    gettok();
+ 		if (curtok == TOK_IDENT && !curtokmeaning &&
+ 		    !strcicmp(curtokbuf, "UNIV")) {
+ 		    if (parkind == MK_PARAM)
+ 			note("UNIV may not work for non-VAR parameters [112]");
+ 		    anyvarflag = 1;
+ 		    gettok();
+ 		}
+ 		p_attributes();
+ 		if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ 		    constflag = 1;
+ 		    strlist_delete(&attrlist, l1);
+ 		}
+ 		if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ 		    volatileflag = 1;
+ 		    strlist_delete(&attrlist, l1);
+ 		}
+ 		if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL &&
+ 		    parkind == MK_VARPARAM) {
+ 		    anyvarflag = 1;
+ 		    strlist_delete(&attrlist, l1);
+ 		}
+ 		if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) {
+ 		    note("REFERENCE attribute treated like VAR [107]");
+ 		    parkind = MK_VARPARAM;
+ 		    strlist_delete(&attrlist, l1);
+ 		}
+ 		checkkeyword(TOK_VARYING);
+                 if (curtok == TOK_IDENT && curtokmeaning == mp_string &&
+                     !anyvarflag && parkind == MK_VARPARAM) {
+                     anyvarflag = (varstrings > 0);
+                     tp = tp_str255;
+                     gettok();
+ 		    if (curtok == TOK_LBR) {
+ 			wexpecttok(TOK_SEMI);
+ 			skipparens();
+ 		    }
+ 		} else if (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
+ 			   curtok == TOK_VARYING) {
+ 		    prevm = oldprevm;
+ 		    tp = p_conformant_array(firstmp->name, &prevm);
+ 		    *prevm = firstmp;
+ 		    while (*prevm)
+ 			prevm = &(*prevm)->xnext;
+                 } else {
+                     tp = p_type(firstmp);
+                 }
+                 if (!varfiles && isfiletype(tp, 0))
+                     parkind = MK_PARAM;
+                 if (parkind == MK_VARPARAM)
+                     tp = makepointertype(tp);
+             }
+ 	    if (curtok == TOK_ASSIGN) {    /* check for parameter default */
+ 		gettok();
+ 		p_mech_spec(0);
+ 		defval = gentle_cast(p_expr(tp), tp);
+ 		if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) &&
+ 		    tp->basetype->kind == TK_CHAR &&
+ 		    tp->structdefd &&     /* conformant string */
+ 		    defval->val.type->kind == TK_STRING) {
+ 		    mp = *oldprevm;
+ 		    if (tp->kind == TK_ARRAY) {
+ 			mp->constdefn = makeexpr_long(1);
+ 			mp = mp->xnext;
+ 		    }
+ 		    mp->constdefn = strmax_func(defval);
+ 		}
+ 	    }
+             while (firstmp) {
+                 firstmp->type = tp;
+                 firstmp->kind = parkind;    /* in case it changed */
+                 firstmp->isactive = 1;
+                 firstmp->anyvarflag = anyvarflag;
+ 		firstmp->constqual = constflag;
+ 		firstmp->volatilequal = volatileflag;
+ 		if (defval) {
+ 		    if (firstmp == lastmp)
+ 			firstmp->constdefn = defval;
+ 		    else
+ 			firstmp->constdefn = copyexpr(defval);
+ 		}
+                 if (parkind == MK_PARAM &&
+                     (tp->kind == TK_STRING ||
+                      tp->kind == TK_ARRAY ||
+                      tp->kind == TK_SET ||
+                      ((tp->kind == TK_RECORD ||
+ 		       tp->kind == TK_BIGFILE ||
+ 		       tp->kind == TK_PROCPTR) && copystructs < 2))) {
+                     firstmp->othername = stralloc(format_s(name_COPYPAR,
+ 							   firstmp->name));
+                     firstmp->rectype = makepointertype(tp);
+                 }
+ 		if (firstmp == lastmp)
+ 		    break;
+                 firstmp = firstmp->xnext;
+             }
+         } while (curtok == TOK_SEMI || curtok == TOK_COMMA);
+         if (!wneedtok(TOK_RPAR))
+ 	    skippasttotoken(TOK_RPAR, TOK_SEMI);
+     }
+     if (modula2) {
+ 	if (curtok == TOK_COLON) {
+ 	    *isfunc = 1;
+ 	} else {
+ 	    unaddmeaning(retmp);
+ 	}
+     }
+     if (*isfunc) {
+         if (wneedtok(TOK_COLON)) {
+ 	    retmp->type = type->basetype = p_type(NULL);
+ 	    switch (retmp->type->kind) {
+ 		
+ 	      case TK_RECORD:
+ 	      case TK_BIGFILE:
+ 	      case TK_PROCPTR:
+                 if (copystructs >= 3)
+                     break;
+ 		
+ 		/* fall through */
+ 	      case TK_ARRAY:
+ 	      case TK_STRING:
+ 	      case TK_SET:
+                 type->basetype = retmp->type = makepointertype(retmp->type);
+                 retmp->kind = MK_VARPARAM;
+                 retmp->anyvarflag = 0;
+                 retmp->xnext = type->fbase;
+                 type->fbase = retmp;
+                 retmp->refcount++;
+                 break;
+ 
+ 	      default:
+ 		break;
+ 	    }
+ 	} else
+ 	    retmp->type = type->basetype = tp_integer;
+     } else
+         type->basetype = tp_void;
+     return type;
+ }
+ 
+ 
+ 
+ 
+ 
+ Symbol *findlabelsym()
+ {
+     if (curtok == TOK_IDENT && 
+         curtokmeaning && curtokmeaning->kind == MK_LABEL) {
+ #if 0
+ 	if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
+ 	    curtokmeaning->val.i = --nonloclabelcount;
+ #endif
+     } else if (curtok == TOK_INTLIT) {
+         strcpy(curtokcase, curtokbuf);
+         curtoksym = findsymbol(curtokbuf);
+         curtokmeaning = curtoksym->mbase;
+         while (curtokmeaning && !curtokmeaning->isactive)
+             curtokmeaning = curtokmeaning->snext;
+         if (!curtokmeaning || curtokmeaning->kind != MK_LABEL)
+             return NULL;
+ #if 0
+ 	if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
+ 	    if (curtokint == 0)
+ 		curtokmeaning->val.i = -1;
+ 	    else
+ 		curtokmeaning->val.i = curtokint;
+ #endif
+     } else
+ 	return NULL;
+     return curtoksym;
+ }
+ 
+ 
+ void p_labeldecl()
+ {
+     Symbol *sp;
+     Meaning *mp;
+ 
+     do {
+         gettok();
+         if (curtok != TOK_IDENT)
+             wexpecttok(TOK_INTLIT);
+         sp = findlabelsym();
+         mp = addmeaning(curtoksym, MK_LABEL);
+ 	mp->val.i = 0;
+ 	mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR,
+ 						   mp->name)),
+ 			       MK_VAR);
+ 	mp->xnext->type = tp_jmp_buf;
+ 	mp->xnext->refcount = 0;
+         gettok();
+     } while (curtok == TOK_COMMA);
+     if (!wneedtok(TOK_SEMI))
+ 	skippasttoken(TOK_SEMI);
+ }
+ 
+ 
+ 
+ 
+ 
+ Meaning *findfieldname(sym, variants, nvars)
+ Symbol *sym;
+ Meaning **variants;
+ int *nvars;
+ {
+     Meaning *mp, *mp0;
+ 
+     mp = variants[*nvars-1];
+     while (mp && mp->kind == MK_FIELD) {
+         if (mp->sym == sym) {
+             return mp;
+         }
+         mp = mp->cnext;
+     }
+     while (mp) {
+         variants[(*nvars)++] = mp->ctx;
+         mp0 = findfieldname(sym, variants, nvars);
+         if (mp0)
+             return mp0;
+         (*nvars)--;
+         while (mp->cnext && mp->cnext->ctx == mp->ctx)
+             mp = mp->cnext;
+         mp = mp->cnext;
+     }
+     return NULL;
+ }
+ 
+ 
+ 
+ 
+ Expr *p_constrecord(type, style)
+ Type *type;
+ int style;   /* 0=HP, 1=Turbo, 2=Oregon+VAX */
+ {
+     Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield;
+     Symbol *sym;
+     Value val;
+     Expr *ex, *cex;
+     int i, j, nvars, newnvars, varcounts[20];
+ 
+     if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
+ 	return makeexpr_long(0);
+     cex = makeexpr(EK_STRUCTCONST, 0);
+     nvars = 0;
+     varcounts[0] = 0;
+     curfield = type->fbase;
+     for (;;) {
+ 	if (style == 2) {
+ 	    if (curfield) {
+ 		mp = curfield;
+ 		if (mp->kind == MK_VARIANT || mp->isforward) {
+ 		    val = p_constant(mp->type);
+ 		    if (mp->kind == MK_FIELD) {
+ 			insertarg(&cex, cex->nargs, makeexpr_val(val));
+ 			mp = mp->cnext;
+ 		    }
+ 		    val.type = mp->val.type;
+ 		    if (!valuesame(val, mp->val)) {
+ 			while (mp && !valuesame(val, mp->val))
+ 			    mp = mp->cnext;
+ 			if (mp) {
+ 			    note("Attempting to initialize union member other than first [113]");
+ 			    curfield = mp->ctx;
+ 			} else {
+ 			    warning("Tag value does not exist in record [129]");
+ 			    curfield = NULL;
+ 			}
+ 		    } else
+ 			curfield = mp->ctx;
+ 		    goto ignorefield;
+ 		} else {
+ 		    i = cex->nargs;
+ 		    insertarg(&cex, i, NULL);
+ 		    if (mp->isforward && curfield->cnext)
+ 			curfield = curfield->cnext->ctx;
+ 		    else
+ 			curfield = curfield->cnext;
+ 		}
+ 	    } else {
+ 		warning("Too many fields in record constructor [130]");
+ 		ex = p_expr(NULL);
+ 		freeexpr(ex);
+ 		goto ignorefield;
+ 	    }
+ 	} else {
+ 	    if (!wexpecttok(TOK_IDENT)) {
+ 		skiptotoken2(TOK_RPAR, TOK_RBR);
+ 		break;
+ 	    }
+ 	    sym = curtoksym;
+ 	    gettok();
+ 	    if (!wneedtok(TOK_COLON)) {
+ 		skiptotoken2(TOK_RPAR, TOK_RBR);
+ 		break;
+ 	    }
+ 	    newnvars = 1;
+ 	    newvariants[0] = type->fbase;
+ 	    mp = findfieldname(sym, newvariants, &newnvars);
+ 	    if (!mp) {
+ 		warning(format_s("Field %s not in record [131]", sym->name));
+ 		ex = p_expr(NULL);   /* good enough */
+ 		freeexpr(ex);
+ 		goto ignorefield;
+ 	    }
+ 	    for (i = 0; i < nvars && i < newnvars; i++) {
+ 		if (variants[i] != newvariants[i]) {
+ 		    warning("Fields are members of incompatible variants [132]");
+ 		    ex = p_subconst(mp->type, style);
+ 		    freeexpr(ex);
+ 		    goto ignorefield;
+ 		}
+ 	    }
+ 	    while (nvars < newnvars) {
+ 		variants[nvars] = newvariants[nvars];
+ 		if (nvars > 0) {
+ 		    for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ;
+ 		    if (mp0->ctx != variants[nvars])
+ 			note("Attempting to initialize union member other than first [113]");
+ 		}
+ 		i = varcounts[nvars];
+ 		for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext)
+ 		    i++;
+ 		nvars++;
+ 		varcounts[nvars] = i;
+ 		while (cex->nargs < i)
+ 		    insertarg(&cex, cex->nargs, NULL);
+ 	    }
+ 	    i = varcounts[newnvars-1];
+ 	    for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext)
+ 		i++;
+ 	    if (cex->args[i])
+ 		warning(format_s("Two constructors for %s [133]", mp->name));
+ 	}
+ 	ex = p_subconst(mp->type, style);
+ 	if (ex->kind == EK_CONST &&
+ 	    (ex->val.type->kind == TK_RECORD ||
+ 	     ex->val.type->kind == TK_ARRAY))
+ 	    ex = (Expr *)ex->val.i;
+ 	cex->args[i] = ex;
+ ignorefield:
+         if (curtok == TOK_COMMA || curtok == TOK_SEMI)
+             gettok();
+         else
+             break;
+     }
+     if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
+ 	skippasttoken2(TOK_RPAR, TOK_RBR);
+     if (style != 2) {
+ 	j = 0;
+ 	mp = variants[0];
+ 	for (i = 0; i < cex->nargs; i++) {
+ 	    while (!mp || mp->kind != MK_FIELD)
+ 		mp = variants[++j];
+ 	    if (!cex->args[i]) {
+ 		warning(format_s("No constructor for %s [134]", mp->name));
+ 		cex->args[i] = makeexpr_name("<oops>", mp->type);
+ 	    }
+ 	    mp = mp->cnext;
+ 	}
+     }
+     val.type = type;
+     val.i = (long)cex;
+     val.s = NULL;
+     return makeexpr_val(val);
+ }
+ 
+ 
+ 
+ 
+ Expr *p_constarray(type, style)
+ Type *type;
+ int style;
+ {
+     Value val;
+     Expr *ex, *cex;
+     int nvals, skipped;
+     long smin, smax;
+ 
+     if (type->kind == TK_SMALLARRAY)
+         warning("Small-array constructors not yet implemented [135]");
+     if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
+ 	return makeexpr_long(0);
+     if (type->smin && type->smin->kind == EK_CONST)
+         skipped = type->smin->val.i;
+     else
+         skipped = 0;
+     cex = NULL;
+     for (;;) {
+         if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) {
+             ex = p_subconst(type->basetype, style);
+             nvals = 1;
+ 	} else if (curtok == TOK_REPEAT) {
+ 	    gettok();
+ 	    ex = p_expr(type->basetype);
+ 	    if (ord_range(type->indextype, &smin, &smax)) {
+ 		nvals = smax - smin + 1;
+ 		if (cex)
+ 		    nvals -= cex->nargs;
+ 	    } else {
+ 		nvals = 1;
+ 		note("REPEAT not translatable for non-constant array bounds [114]");
+ 	    }
+             ex = gentle_cast(ex, type->basetype);
+         } else {
+             ex = p_expr(type->basetype);
+             if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
+                 ex->val.i > 1 && !skipped && style == 0 && !cex &&
+                 type->basetype->kind == TK_CHAR &&
+                 checkconst(type->indextype->smin, 1)) {
+                 if (!wneedtok(TOK_RBR))
+ 		    skippasttoken2(TOK_RBR, TOK_RPAR);
+                 return ex;   /* not quite right, but close enough */
+             }
+             if (curtok == TOK_OF) {
+                 ex = gentle_cast(ex, tp_integer);
+                 val = eval_expr(ex);
+                 freeexpr(ex);
+                 if (!val.type)
+                     warning("Expected a constant [127]");
+                 nvals = val.i;
+                 gettok();
+                 ex = p_expr(type->basetype);
+             } else
+                 nvals = 1;
+             ex = gentle_cast(ex, type->basetype);
+         }
+         nvals += skipped;
+         skipped = 0;
+         if (ex->kind == EK_CONST &&
+             (ex->val.type->kind == TK_RECORD ||
+              ex->val.type->kind == TK_ARRAY))
+             ex = (Expr *)ex->val.i;
+         if (nvals != 1) {
+             ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex);
+             ex->val.i = nvals;
+         }
+         if (cex)
+             insertarg(&cex, cex->nargs, ex);
+         else
+             cex = makeexpr_un(EK_STRUCTCONST, type, ex);
+         if (curtok == TOK_COMMA)
+             gettok();
+         else
+             break;
+     }
+     if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
+ 	skippasttoken2(TOK_RPAR, TOK_RBR);
+     val.type = type;
+     val.i = (long)cex;
+     val.s = NULL;
+     return makeexpr_val(val);
+ }
+ 
+ 
+ 
+ 
+ Expr *p_conststring(type, style)
+ Type *type;
+ int style;
+ {
+     Expr *ex;
+     Token close = (style ? TOK_RPAR : TOK_RBR);
+ 
+     if (curtok != (style ? TOK_LPAR : TOK_LBR))
+ 	return p_expr(type);
+     gettok();
+     ex = p_expr(tp_integer);  /* should handle "OF" and "," for constructors */
+     if (curtok == TOK_OF || curtok == TOK_COMMA) {
+         warning("Multi-element string constructors not yet supported [136]");
+ 	skiptotoken(close);
+     }
+     if (!wneedtok(close))
+ 	skippasttoken(close);
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Expr *p_subconst(type, style)
+ Type *type;
+ int style;
+ {
+     Value val;
+ 
+     if (curtok == TOK_IDENT && curtokmeaning &&
+ 	curtokmeaning->kind == MK_TYPE) {
+ 	if (curtokmeaning->type != type)
+ 	    warning("Type conflict in constant [137]");
+ 	gettok();
+     }
+     if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
+ 	!curtokmeaning) {   /* VAX Pascal foolishness */
+ 	gettok();
+ 	if (type->kind == TK_STRING)
+ 	    return makeexpr_string("");
+ 	if (type->kind == TK_REAL)
+ 	    return makeexpr_real("0.0");
+ 	val.type = type;
+ 	if (type->kind == TK_RECORD || type->kind == TK_ARRAY ||
+ 	    type->kind == TK_SET)
+ 	    val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0));
+ 	else
+ 	    val.i = 0;
+ 	val.s = NULL;
+ 	return makeexpr_val(val);
+     }
+     switch (type->kind) {
+ 	
+       case TK_RECORD:
+ 	if (curtok == (style ? TOK_LPAR : TOK_LBR))
+ 	    return p_constrecord(type, style);
+ 	break;
+ 	
+       case TK_SMALLARRAY:
+       case TK_ARRAY:
+ 	if (curtok == (style ? TOK_LPAR : TOK_LBR))
+ 	    return p_constarray(type, style);
+ 	break;
+ 	
+       case TK_SMALLSET:
+       case TK_SET:
+ 	if (curtok == TOK_LBR)
+ 	    return p_setfactor(type, 1);
+ 	break;
+ 	
+       default:
+ 	break;
+ 	
+     }
+     return gentle_cast(p_expr(type), type);
+ }
+ 
+ 
+ 
+ void p_constdecl()
+ {
+     Meaning *mp;
+     Expr *ex, *ex2;
+     Type *oldtype;
+     char savetokcase[sizeof(curtokcase)];
+     Symbol *savetoksym;
+     Strlist *sl;
+     int i, saveindent, outflag = (blockkind != TOK_IMPORT);
+ 
+     if (outflag)
+         outsection(majorspace);
+     flushcomments(NULL, -1, -1);
+     gettok();
+     oldtype = NULL;
+     while (curtok == TOK_IDENT) {
+         strcpy(savetokcase, curtokcase);
+         savetoksym = curtoksym;
+         gettok();
+         strcpy(curtokcase, savetokcase);   /* what a kludge! */
+         curtoksym = savetoksym;
+         if (curtok == TOK_COLON) {     /* Turbo Pascal typed constant */
+             mp = addmeaning(curtoksym, MK_VAR);
+ 	    decl_comments(mp);
+             gettok();
+             mp->type = p_type(mp);
+             if (wneedtok(TOK_EQ)) {
+ 		if (mp->kind == MK_VARMAC) {
+ 		    freeexpr(p_subconst(mp->type, 1));
+ 		    note("Initializer ignored for variable with VarMacro [115]");
+ 		} else {
+ 		    mp->constdefn = p_subconst(mp->type, 1);
+ 		    if (blockkind == TOK_EXPORT) {
+ 			/*  nothing  */
+ 		    } else {
+ 			mp->isforward = 1;   /* static variable */
+ 		    }
+ 		}
+ 	    }
+ 	    decl_comments(mp);
+         } else {
+             sl = strlist_find(constmacros, curtoksym->name);
+             if (sl) {
+                 mp = addmeaning(curtoksym, MK_VARMAC);
+                 mp->constdefn = (Expr *)sl->value;
+                 strlist_delete(&constmacros, sl);
+             } else {
+                 mp = addmeaning(curtoksym, MK_CONST);
+             }
+ 	    decl_comments(mp);
+             if (!wexpecttok(TOK_EQ)) {
+ 		skippasttoken(TOK_SEMI);
+ 		continue;
+ 	    }
+ 	    mp->isactive = 0;   /* A fine point indeed (see below) */
+ 	    gettok();
+ 	    if (curtok == TOK_IDENT &&
+ 		curtokmeaning && curtokmeaning->kind == MK_TYPE &&
+ 		(curtokmeaning->type->kind == TK_RECORD ||
+ 		 curtokmeaning->type->kind == TK_SMALLARRAY ||
+ 		 curtokmeaning->type->kind == TK_ARRAY)) {
+ 		oldtype = curtokmeaning->type;
+ 		gettok();
+ 		ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2);
+ 	    } else {
+ 		ex = p_expr(NULL);
+ 		if (charconsts)
+ 		    ex = makeexpr_charcast(ex);
+ 	    }
+ 	    mp->isactive = 1;   /* Re-enable visibility of the new constant */
+             if (mp->kind == MK_CONST)
+                 mp->constdefn = ex;
+             if (ord_type(ex->val.type)->kind == TK_INTEGER) {
+                 i = exprlongness(ex);
+                 if (i > 0)
+                     ex->val.type = tp_integer;
+ 		else if (i < 0)
+                     ex->val.type = tp_int;
+             }
+ 	    decl_comments(mp);
+             mp->type = ex->val.type;
+             mp->val = eval_expr(ex);
+             if (mp->kind == MK_CONST) {
+                 switch (ex->val.type->kind) {
+ 
+                     case TK_INTEGER:
+                     case TK_BOOLEAN:
+                     case TK_CHAR:
+                     case TK_ENUM:
+                     case TK_SUBR:
+                     case TK_REAL:
+                         if (foldconsts > 0)
+                             mp->anyvarflag = 1;
+                         break;
+ 
+                     case TK_STRING:
+                         if (foldstrconsts > 0)
+                             mp->anyvarflag = 1;
+                         break;
+ 
+ 		    default:
+ 			break;
+                 }
+             }
+ 	    flushcomments(&mp->comments, CMT_PRE, -1);
+             if (ex->val.type->kind == TK_SET) {
+                 mp->val.type = NULL;
+ 		if (mp->kind == MK_CONST) {
+ 		    ex2 = makeexpr(EK_MACARG, 0);
+ 		    ex2->val.type = ex->val.type;
+ 		    mp->constdefn = makeexpr_assign(ex2, ex);
+ 		}
+             } else if (mp->kind == MK_CONST && outflag) {
+                 if (ex->val.type != oldtype) {
+                     outsection(minorspace);
+                     oldtype = ex->val.type;
+                 }
+                 switch (ex->val.type->kind) {
+ 
+                     case TK_ARRAY:
+                     case TK_RECORD:
+                         select_outfile(codef);
+                         outsection(minorspace);
+                         if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM)
+                             output("static ");
+                         if (useAnyptrMacros == 1 || useconsts == 2)
+                             output("Const ");
+                         else if (useconsts > 0)
+                             output("const ");
+                         outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY);
+                         output(" ");
+                         outdeclarator(mp->type, mp->name,
+ 				      ODECL_CHARSTAR|ODECL_FREEARRAY);
+                         output(" = {");
+ 			outtrailcomment(mp->comments, -1, declcommentindent);
+ 			saveindent = outindent;
+ 			moreindent(tabsize);
+ 			moreindent(structinitindent);
+                      /*   if (mp->val.s)
+                             output(mp->val.s);
+                         else  */
+                             out_expr((Expr *)mp->val.i);
+                         outindent = saveindent;
+                         output("\n};\n");
+                         outsection(minorspace);
+                         if (blockkind == TOK_EXPORT) {
+                             select_outfile(hdrf);
+                             if (usevextern)
+                                 output("vextern ");
+                             if (useAnyptrMacros == 1 || useconsts == 2)
+                                 output("Const ");
+                             else if (useconsts > 0)
+                                 output("const ");
+                             outbasetype(mp->type, ODECL_CHARSTAR);
+                             output(" ");
+                             outdeclarator(mp->type, mp->name, ODECL_CHARSTAR);
+                             output(";\n");
+                         }
+                         break;
+ 
+                     default:
+                         if (foldconsts > 0) break;
+                         output(format_s("#define %s", mp->name));
+ 			mp->isreturn = 1;
+                         out_spaces(constindent, 0, 0, 0);
+ 			saveindent = outindent;
+ 			outindent = cur_column();
+                         out_expr_factor(ex);
+ 			outindent = saveindent;
+ 			outtrailcomment(mp->comments, -1, declcommentindent);
+                         break;
+ 
+                 }
+             }
+ 	    flushcomments(&mp->comments, -1, -1);
+             if (mp->kind == MK_VARMAC)
+                 freeexpr(ex);
+             mp->wasdeclared = 1;
+         }
+         if (!wneedtok(TOK_SEMI))
+ 	    skippasttoken(TOK_SEMI);
+     }
+     if (outflag)
+         outsection(majorspace);
+ }
+ 
+ 
+ 
+ 
+ void declaresubtypes(mp)
+ Meaning *mp;
+ {
+     Meaning *mp2;
+     Type *tp;
+     struct ptrdesc *pd;
+ 
+     while (mp) {
+ 	if (mp->kind == MK_VARIANT) {
+ 	    declaresubtypes(mp->ctx);
+ 	} else {
+ 	    tp = mp->type;
+ 	    while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER)
+ 		tp = tp->basetype;
+ 	    if (tp->meaning && !tp->meaning->wasdeclared &&
+ 		(tp->kind == TK_RECORD || tp->kind == TK_ENUM) &&
+ 		tp->meaning->ctx && tp->meaning->ctx != nullctx) {
+ 		pd = ptrbase;   /* Do this now, just in case */
+ 		while (pd) {
+ 		    if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
+ 			pd->tp->smin = NULL;
+ 			mp2 = pd->sym->mbase;
+ 			while (mp2 && !mp2->isactive)
+ 			    mp2 = mp2->snext;
+ 			if (mp2 && mp2->kind == MK_TYPE) {
+ 			    pd->tp->basetype = mp2->type;
+ 			    pd->tp->fbase = mp2;
+ 			    if (!mp2->type->pointertype)
+ 				mp2->type->pointertype = pd->tp;
+ 			}
+ 		    }
+ 		    pd = pd->next;
+ 		}
+ 		declaretype(tp->meaning);
+ 	    }
+ 	}
+ 	mp = mp->cnext;
+     }
+ }
+ 
+ 
+ void declaretype(mp)
+ Meaning *mp;
+ {
+     int saveindent, pres;
+ 
+     switch (mp->type->kind) {
+ 	
+       case TK_RECORD:
+       case TK_BIGFILE:
+ 	if (mp->type->meaning != mp) {
+ 	    output(format_ss("typedef %s %s;",
+ 			     mp->type->meaning->name,
+ 			     mp->name));
+ 	} else {
+ 	    declaresubtypes(mp->type->fbase);
+ 	    outsection(minorspace);
+ 	    if (record_is_union(mp->type))
+ 		output("typedef union ");
+ 	    else
+ 		output("typedef struct ");
+ 	    output(format_s("%s {\n", format_s(name_STRUCT, mp->name)));
+ 	    saveindent = outindent;
+ 	    moreindent(tabsize);
+ 	    moreindent(structindent);
+ 	    if (mp->type->kind == TK_BIGFILE)
+ 		declarebigfile(mp->type);
+ 	    else
+ 		outfieldlist(mp->type->fbase);
+ 	    outindent = saveindent;
+ 	    output(format_s("} %s;", mp->name));
+ 	}
+ 	outtrailcomment(mp->comments, -1, declcommentindent);
+ 	mp->type->structdefd = 1;
+ 	if (mp->type->meaning == mp)
+ 	    outsection(minorspace);
+ 	break;
+ 	
+       case TK_ARRAY:
+       case TK_SMALLARRAY:
+ 	output("typedef ");
+ 	if (mp->type->meaning != mp) {
+ 	    output(format_ss("%s %s",
+ 			     mp->type->meaning->name,
+ 			     mp->name));
+ 	} else {
+ 	    outbasetype(mp->type, 0);
+ 	    output(" ");
+ 	    outdeclarator(mp->type, mp->name, 0);
+ 	}
+ 	output(";");
+ 	outtrailcomment(mp->comments, -1, declcommentindent);
+ 	break;
+ 	
+       case TK_ENUM:
+ 	if (useenum) {
+ 	    output("typedef ");
+ 	    if (mp->type->meaning != mp)
+ 		output(mp->type->meaning->name);
+ 	    else
+ 		outbasetype(mp->type, 0);
+ 	    output(" ");
+ 	    output(mp->name);
+ 	    output(";");
+ 	    outtrailcomment(mp->comments, -1,
+ 			    declcommentindent);
+ 	}
+ 	break;
+ 	
+       default:
+ 	pres = preservetypes;
+ 	if (mp->type->kind == TK_POINTER && preservepointers >= 0)
+ 	    pres = preservepointers;
+ 	if (mp->type->kind == TK_STRING && preservestrings >= 0)
+ 	    if (preservestrings == 2)
+ 		pres = mp->type->indextype->smax->kind != EK_CONST;
+ 	    else
+ 		pres = preservestrings;
+ 	if (pres) {
+ 	    output("typedef ");
+ 	    mp->type->preserved = 0;
+ 	    outbasetype(mp->type, 0);
+ 	    output(" ");
+ 	    outdeclarator(mp->type, mp->name, 0);
+ 	    output(";\n");
+ 	    mp->type->preserved = 1;
+ 	    outtrailcomment(mp->comments, -1, declcommentindent);
+ 	}
+ 	break;
+     }
+     mp->wasdeclared = 1;
+ }
+ 
+ 
+ 
+ void declaretypes(outflag)
+ int outflag;
+ {
+     Meaning *mp;
+ 
+     for (mp = curctx->cbase; mp; mp = mp->cnext) {
+         if (mp->kind == MK_TYPE && !mp->wasdeclared) {
+             if (outflag) {
+ 		flushcomments(&mp->comments, CMT_PRE, -1);
+ 		declaretype(mp);
+ 		flushcomments(&mp->comments, -1, -1);
+             }
+             mp->wasdeclared = 1;
+         }
+     }
+ }
+ 
+ 
+ 
+ void p_typedecl()
+ {
+     Meaning *mp;
+     int outflag = (blockkind != TOK_IMPORT);
+     struct ptrdesc *pd;
+ 
+     if (outflag)
+         outsection(majorspace);
+     flushcomments(NULL, -1, -1);
+     gettok();
+     outsection(minorspace);
+     deferallptrs = 1;
+     anydeferredptrs = 0;
+     notephase = 1;
+     while (curtok == TOK_IDENT) {
+         mp = addmeaning(curtoksym, MK_TYPE);
+ 	mp->type = tp_integer;    /* in case of syntax errors */
+         gettok();
+ 	decl_comments(mp);
+ 	if (curtok == TOK_SEMI) {
+ 	    mp->type = tp_anyptr;    /* Modula-2 opaque type */
+ 	} else {
+ 	    if (!wneedtok(TOK_EQ)) {
+ 		skippasttoken(TOK_SEMI);
+ 		continue;
+ 	    }
+ 	    mp->type = p_type(mp);
+ 	    decl_comments(mp);
+ 	    if (!mp->type->meaning)
+ 		mp->type->meaning = mp;
+ 	    if (mp->type->kind == TK_RECORD ||
+ 		mp->type->kind == TK_BIGFILE)
+ 		mp->type->structdefd = 1;
+ 	    if (!anydeferredptrs)
+ 		declaretypes(outflag);
+ 	}
+ 	if (!wneedtok(TOK_SEMI))
+ 	    skippasttoken(TOK_SEMI);
+     }
+     notephase = 0;
+     deferallptrs = 0;
+     while (ptrbase) {
+         pd = ptrbase;
+ 	if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
+ 	    pd->tp->smin = NULL;
+ 	    mp = pd->sym->mbase;
+ 	    while (mp && !mp->isactive)
+ 		mp = mp->snext;
+ 	    if (!mp || mp->kind != MK_TYPE) {
+ 		warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name));
+ 	    } else {
+ 		pd->tp->basetype = mp->type;
+ 		pd->tp->fbase = mp;
+ 		if (!mp->type->pointertype)
+ 		    mp->type->pointertype = pd->tp;
+ 	    }
+         }
+         ptrbase = ptrbase->next;
+         FREE(pd);
+     }
+     declaretypes(outflag);
+     outsection(minorspace);
+     flushcomments(NULL, -1, -1);
+     if (outflag)
+         outsection(majorspace);
+ }
+ 
+ 
+ 
+ 
+ 
+ Static void nameexternalvar(mp, name)
+ Meaning *mp;
+ char *name;
+ {
+     if (!wasaliased) {
+ 	if (*externalias && my_strchr(externalias, '%'))
+ 	    strchange(&mp->name, format_s(externalias, name));
+ 	else
+ 	    strchange(&mp->name, name);
+     }
+ }
+ 
+ 
+ Static void handlebrackets(mp, skip, wasaliased)
+ Meaning *mp;
+ int skip, wasaliased;
+ {
+     Expr *ex;
+ 
+     checkkeyword(TOK_ORIGIN);
+     if (curtok == TOK_ORIGIN) {
+ 	gettok();
+ 	ex = p_expr(tp_integer);
+ 	mp->kind = MK_VARREF;
+ 	mp->constdefn = gentle_cast(ex, tp_integer);
+     } else if (curtok == TOK_LBR) {
+         gettok();
+         ex = p_expr(tp_integer);
+         if (!wneedtok(TOK_RBR))
+ 	    skippasttotoken(TOK_RBR, TOK_SEMI);
+         if (skip) {
+             freeexpr(ex);
+             return;
+         }
+         if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+ 	    nameexternalvar(mp, ex->val.s);
+ 	    mp->isfunction = 1;   /* make it extern */
+         } else {
+             note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
+             mp->kind = MK_VARREF;
+             mp->constdefn = gentle_cast(ex, tp_integer);
+         }
+     }
+ }
+ 
+ 
+ 
+ Static void handleabsolute(mp, skip)
+ Meaning *mp;
+ int skip;
+ {
+     Expr *ex;
+     Value val;
+     long i;
+ 
+     checkkeyword(TOK_ABSOLUTE);
+     if (curtok == TOK_ABSOLUTE) {
+         gettok();
+         if (skip) {
+             freeexpr(p_expr(tp_integer));
+             if (curtok == TOK_COLON) {
+                 gettok();
+                 freeexpr(p_expr(tp_integer));
+             }
+             return;
+         }
+         note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
+         mp->kind = MK_VARREF;
+         if (curtok == TOK_IDENT && 
+             curtokmeaning && (curtokmeaning->kind != MK_CONST ||
+                               ord_type(curtokmeaning->type)->kind != TK_INTEGER)) {
+             mp->constdefn = makeexpr_addr(p_expr(NULL));
+ 	    mp->isfunction = 1;   /* make it extern */
+         } else {
+             ex = gentle_cast(p_expr(tp_integer), tp_integer);
+             if (curtok == TOK_COLON) {
+                 val = eval_expr(ex);
+                 if (!val.type)
+                     warning("Expected a constant [127]");
+                 i = val.i & 0xffff;
+                 gettok();
+                 val = p_constant(tp_integer);
+                 i = (i<<16) | (val.i & 0xffff);   /* as good a notation as any! */
+                 ex = makeexpr_long(i);
+                 insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+             }
+             mp->constdefn = ex;
+         }
+     }
+ }
+ 
+ 
+ 
+ void setupfilevar(mp)
+ Meaning *mp;
+ {
+     if (mp->kind != MK_VARMAC) {
+ 	if (isfiletype(mp->type, 0)) {
+ 	    if (storefilenames && *name_FNVAR)
+ 		mp->namedfile = 1;
+ 	    if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp))
+ 		mp->bufferedfile = 1;
+ 	} else if (isfiletype(mp->type, 1)) {
+ 	    mp->namedfile = 1;
+ 	    mp->bufferedfile = 1;
+ 	}
+     }
+ }
+ 
+ 
+ 
+ Meaning *validatedtype(dtype, type)
+ Meaning *dtype;
+ Type *type;
+ {
+     if (dtype &&
+ 	(!type->preserved || !type->meaning ||
+ 	 dtype->kind != MK_TYPE || dtype->type != type ||
+ 	 type->meaning == dtype))
+ 	return NULL;
+     return dtype;
+ }
+ 
+ 
+ void p_vardecl()
+ {
+     Meaning *firstmp, *lastmp, *dtype;
+     Type *tp;
+     int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag;
+     Strlist *l1;
+     Expr *initexpr;
+ 
+     gettok();
+     notephase = 1;
+     while (curtok == TOK_IDENT) {
+         firstmp = lastmp = addmeaning(curtoksym, MK_VAR);
+ 	lastmp->type = tp_integer;    /* in case of syntax errors */
+         aliasflag = wasaliased;
+         gettok();
+         handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
+ 	decl_comments(lastmp);
+         while (curtok == TOK_COMMA) {
+             gettok();
+             if (wexpecttok(TOK_IDENT)) {
+ 		lastmp = addmeaning(curtoksym, MK_VAR);
+ 		lastmp->type = tp_integer;
+ 		aliasflag = wasaliased;
+ 		gettok();
+ 		handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
+ 		decl_comments(lastmp);
+ 	    }
+         }
+         if (!wneedtok(TOK_COLON)) {
+ 	    skippasttoken(TOK_SEMI);
+ 	    continue;
+ 	}
+ 	p_attributes();
+ 	volatileflag = constflag = staticflag = globalflag = externflag = 0;
+ 	if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ 	    constflag = 1;
+ 	    strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ 	    volatileflag = 1;
+ 	    strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) {
+ 	    staticflag = 1;
+ 	    strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) {
+ 	    /* This is the default! */
+ 	    strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "AT")) != NULL) {
+             note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name));
+             lastmp->kind = MK_VARREF;
+             lastmp->constdefn = makeexpr_long(l1->value);
+ 	    strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL ||
+ 	    (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) {
+ 	    globalflag = 1;
+ 	    if (l1->value != -1)
+ 		nameexternalvar(lastmp, (char *)l1->value);
+ 	    if (l1->s[0] != 'W')
+ 		strlist_delete(&attrlist, l1);
+ 	}
+ 	if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL ||
+ 	    (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) {
+ 	    externflag = 1;
+ 	    if (l1->value != -1)
+ 		nameexternalvar(lastmp, (char *)l1->value);
+ 	    if (l1->s[0] != 'W')
+ 		strlist_delete(&attrlist, l1);
+ 	}
+ 	dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+         tp = p_type(firstmp);
+ 	decl_comments(lastmp);
+         handleabsolute(lastmp, (lastmp->kind != MK_VAR));
+ 	initexpr = NULL;
+ 	if (curtok == TOK_ASSIGN) {    /* VAX Pascal initializer */
+ 	    gettok();
+ 	    initexpr = p_subconst(tp, 2);
+ 	    if (lastmp->kind == MK_VARMAC) {
+ 		freeexpr(initexpr);
+ 		initexpr = NULL;
+ 		note("Initializer ignored for variable with VarMacro [115]");
+ 	    }
+ 	}
+ 	dtype = validatedtype(dtype, tp);
+         for (;;) {
+             if (firstmp->kind == MK_VARREF) {
+                 firstmp->type = makepointertype(tp);
+                 firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type);
+             } else {
+                 firstmp->type = tp;
+ 		setupfilevar(firstmp);
+ 		if (initexpr) {
+ 		    if (firstmp == lastmp)
+ 			firstmp->constdefn = initexpr;
+ 		    else
+ 			firstmp->constdefn = copyexpr(initexpr);
+ 		}
+             }
+ 	    firstmp->dtype = dtype;
+ 	    firstmp->volatilequal = volatileflag;
+ 	    firstmp->constqual = constflag;
+ 	    firstmp->isforward |= staticflag;
+ 	    firstmp->isfunction |= externflag;
+ 	    firstmp->exported |= globalflag;
+ 	    if (globalflag && (curctx->kind != MK_MODULE || mainlocals))
+ 		declarevar(firstmp, -1);
+             if (firstmp == lastmp)
+                 break;
+             firstmp = firstmp->cnext;
+         }
+         if (!wneedtok(TOK_SEMI))
+ 	    skippasttoken(TOK_SEMI);
+     }
+     notephase = 0;
+ }
+ 
+ 
+ 
+ 
+ void p_valuedecl()
+ {
+     Meaning *mp;
+ 
+     gettok();
+     while (curtok == TOK_IDENT) {
+ 	if (!curtokmeaning ||
+ 	    curtokmeaning->kind != MK_VAR) {
+ 	    warning(format_s("Initializer ignored for variable %s [139]",
+ 			     curtokbuf));
+ 	    skippasttoken(TOK_SEMI);
+ 	} else {
+ 	    mp = curtokmeaning;
+ 	    gettok();
+ 	    if (curtok == TOK_DOT || curtok == TOK_LBR) {
+ 		note("Partial structure initialization not supported [117]");
+ 		skippasttoken(TOK_SEMI);
+ 	    } else if (wneedtok(TOK_ASSIGN)) {
+ 		mp->constdefn = p_subconst(mp->type, 2);
+ 		if (!wneedtok(TOK_SEMI))
+ 		    skippasttoken(TOK_SEMI);
+ 	    } else
+ 		skippasttoken(TOK_SEMI);
+ 	}
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Make a temporary variable that must be freed manually (or at the end of
+    the current function by default) */
+ 
+ Meaning *maketempvar(type, name)
+ Type *type;
+ char *name;
+ {
+     struct tempvarlist *tv, **tvp;
+     Symbol *sym;
+     Meaning *mp;
+     char *fullname;
+ 
+     tvp = &tempvars;   /* find a freed but allocated temporary */
+     while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) ||
+                            tv->tvar->refcount == 0 ||
+                            strcmp(tv->tvar->val.s, name)))
+         tvp = &(tv->next);
+     if (!tv) {
+         tvp = &tempvars;    /* take over a now-cancelled temporary */
+         while ((tv = *tvp) && (tv->tvar->refcount > 0 || 
+                                strcmp(tv->tvar->val.s, name)))
+             tvp = &(tv->next);
+     }
+     if (tv) {
+         tv->tvar->type = type;
+         *tvp = tv->next;
+         mp = tv->tvar;
+         FREE(tv);
+         mp->refcount++;
+         if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); }
+     } else {
+         tempvarcount = 0;    /***/  /* experimental... */
+         for (;;) {
+             if (tempvarcount)
+                 fullname = format_s(name, format_d("%d", tempvarcount));
+             else
+                 fullname = format_s(name, "");
+             ++tempvarcount;
+             sym = findsymbol(fullname);
+             mp = sym->mbase;
+             while (mp && !mp->isactive)
+                 mp = mp->snext;
+             if (!mp)
+                 break;
+             if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); }
+         }
+ 	mp = addmeaning(sym, MK_VAR);
+         mp->istemporary = 1;
+         mp->type = type;
+         mp->refcount = 1;
+         mp->val.s = stralloc(name);
+         if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); }
+     }
+     return mp;
+ }
+ 
+ 
+ 
+ /* Make a temporary variable that will be freed at the end of this statement
+    (rather than at the end of the function) by default */
+ 
+ Meaning *makestmttempvar(type, name)
+ Type *type;
+ char *name;
+ {
+     struct tempvarlist *tv;
+     Meaning *tvar;
+ 
+     tvar = maketempvar(type, name);
+     tv = ALLOC(1, struct tempvarlist, tempvars);
+     tv->tvar = tvar;
+     tv->active = 1;
+     tv->next = stmttempvars;
+     stmttempvars = tv;
+     return tvar;
+ }
+ 
+ 
+ 
+ Meaning *markstmttemps()
+ {
+     return (stmttempvars) ? stmttempvars->tvar : NULL;
+ }
+ 
+ 
+ void freestmttemps(mark)
+ Meaning *mark;
+ {
+     struct tempvarlist *tv;
+ 
+     while ((tv = stmttempvars) && tv->tvar != mark) {
+         if (tv->active)
+             freetempvar(tv->tvar);
+         stmttempvars = tv->next;
+         FREE(tv);
+     }
+ }
+ 
+ 
+ 
+ /* This temporary variable is no longer used */
+ 
+ void freetempvar(tvar)
+ Meaning *tvar;
+ {
+     struct tempvarlist *tv;
+ 
+     if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); }
+     tv = stmttempvars;
+     while (tv && tv->tvar != tvar)
+         tv = tv->next;
+     if (tv)
+         tv->active = 0;
+     tv = ALLOC(1, struct tempvarlist, tempvars);
+     tv->tvar = tvar;
+     tv->next = tempvars;
+     tempvars = tv;
+ }
+ 
+ 
+ 
+ /* The code that used this temporary variable has been deleted */
+ 
+ void canceltempvar(tvar)
+ Meaning *tvar;
+ {
+     if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); }
+     tvar->refcount--;
+     freetempvar(tvar);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,257 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define define_parameters
+ #define PROTO_DIR_C
+ #include "trans.h"
+ 
+ 
+ /* This file is user-modifiable.  It is the "directory" of C functions
+    for compiling in-line various Pascal library routines. */
+ 
+ 
+ 
+ extern void setup_module_hp();
+ extern void setup_module_cit();
+ extern void setup_module_tanner();
+ 
+ 
+ 
+ 
+ /* This function is called once when p2c is starting up, before
+    the p2crc file has been read.
+ */
+ 
+ void init_dir()
+ {
+ 
+ 
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This function is called once when p2c is starting up, after
+    the p2crc file has been read.
+ */
+ 
+ void setup_dir()
+ {
+ 
+ 
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This procedure is called after reading the import text for a module,
+    where "name" is the module name, in upper-case letters.  Calls to
+    "addmeaning", "makestandardfunc", etc. will annotate the context of
+    the module.  Note that this will be called if the module is searched,
+    even if it is never actually imported.
+ */
+ 
+ #if 0
+ Static void _setup(name, defn)
+ char *name;
+ int defn;
+ {
+     /* this is a dummy procedure which may be called by setup_module */
+ }
+ #endif
+ 
+ #define _setup(a,b)
+ 
+ void setup_module(name, defn)
+ char *name;
+ int defn;
+ {
+     if (!strcicmp(name, "SYSTEM"))
+ 	decl_builtins();
+ #ifdef CUST1
+     CUST1(name, defn);
+ #endif
+ #ifdef CUST2
+     CUST2(name, defn);
+ #endif
+ #ifdef CUST3
+     CUST3(name, defn);
+ #endif
+ #ifdef CUST4
+     CUST4(name, defn);
+ #endif
+ #ifdef CUST5
+     CUST5(name, defn);
+ #endif
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This procedure is called once after the p2crc file has been
+    read and the built-in parameters have been "fixed".  It should
+    check ranges and add defaults for any newly introduced parameters
+    in the "rctable" (see "trans.h").
+ */
+ 
+ void fix_parameters()
+ {
+ 
+ 
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This function is called during a traversal of the tree of statements for
+    a procedure.  Ordinarily it returns its argument; it may instead return
+    an arbitrary other statement or sequence of statements, which will then
+    be spliced in to replace the original one.  It may return NULL to delete
+    the statement altogether.
+ */
+ 
+ Stmt *fix_statement(sp)
+ Stmt *sp;
+ {
+     return sp;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This is the analogous function for expression traversals.  It is
+    called after the arguments have been (recursively) fixed and all
+    built-in fixes have been performed.
+ */
+ 
+ Expr *fix_expression(ex, env)
+ Expr *ex;
+ int env;
+ {
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This procedure is called when fixing an expression of type
+    EK_BICALL.  It is called before the arguments are fixed.  If
+    it recognizes the BICALL, it should fix the arguments, then
+    return a (possibly modified) fixed expression, which may or
+    may not be a BICALL.  That expression will then be sent to
+    fix_expression() as usual, but other standard fixes will not
+    automatically be performed on it.  If the BICALL is not
+    recognized, the function should return NULL.
+ */
+ 
+ Expr *fix_bicall(ex, env)
+ Expr *ex;
+ int env;
+ {
+     return NULL;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This function returns nonzero if the built-in function "name"
+    should be written "if (f(x))" rather than "if (f(x) != 0)"
+    when used as a boolean.  The call does *not* necessarily have
+    to return a 1-or-0 value.
+ */
+ 
+ int boolean_bicall(name)
+ char *name;
+ {
+     return (!strcmp(name, "strcmp") ||
+             !strcmp(name, "strncmp") ||
+             !strcmp(name, "memcmp") ||
+             !strcmp(name, "feof") ||
+             !strcmp(name, "feoln"));
+ }
+ 
+ 
+ 
+ 
+ 
+ /* The function "name" promises not to change certain of its
+    VAR-style parameters.  For each of arguments i = 0 through 15,
+    if bit 1<<i of the return value of this function is set, and
+    the i'th parameter is a pointer to an object, then the function
+    guarantees not to change that object.
+ */
+ 
+ unsigned int safemask_bicall(name)
+ char *name;
+ {
+     Symbol *sp;
+ 
+     sp = findsymbol_opt(name);
+     if (sp) {
+ 	if (sp->flags & (STRUCTF|STRLAPF))
+ 	    return ~1;
+ 	if (sp->flags & (NOSIDEEFF|DETERMF))
+ 	    return ~0;
+     }
+     if (!strcmp(name, "fwrite") ||
+         !strcmp(name, "memchr"))
+         return 1;
+     if (!strcmp(name, "memcpy") ||
+         !strcmp(name, "memmove"))
+         return 2;
+     if (!strcmp(name, "memcmp"))
+         return 3;
+     if (!strcmp(name, "sprintf") ||
+         !strcmp(name, "fprintf"))
+         return ~1;
+     if (!strcmp(name, "printf"))
+         return ~0;
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* The function "name" has side effects that could affect other variables
+    in the program besides those that are explicitly mentioned.
+ */
+ 
+ int sideeffects_bicall(name)
+ char *name;
+ {
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c:1.1
*** /dev/null	Mon Feb 16 17:43:39 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,5574 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_EXPR_C
+ #include "trans.h"
+ 
+ 
+ 
+ 
+ 
+ void free_value(val)
+ Value *val;
+ {
+     if (!val || !val->type)
+ 	return;
+     switch (val->type->kind) {
+ 
+         case TK_STRING:
+         case TK_REAL:
+         case TK_ARRAY:
+         case TK_RECORD:
+         case TK_SET:
+             if (val->s)
+                 FREE(val->s);
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+ }
+ 
+ 
+ Value copyvalue(val)
+ Value val;
+ {
+     char *cp;
+ 
+     switch (val.type->kind) {
+ 
+         case TK_STRING:
+         case TK_SET:
+             if (val.s) {
+                 cp = ALLOC(val.i+1, char, literals);
+                 memcpy(cp, val.s, val.i);
+ 		cp[val.i] = 0;
+                 val.s = cp;
+             }
+             break;
+ 
+         case TK_REAL:
+         case TK_ARRAY:
+         case TK_RECORD:
+             if (val.s)
+                 val.s = stralloc(val.s);
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     return val;
+ }
+ 
+ 
+ int valuesame(a, b)
+ Value a, b;
+ {
+     if (a.type != b.type)
+         return 0;
+     switch (a.type->kind) {
+ 
+         case TK_INTEGER:
+         case TK_CHAR:
+         case TK_BOOLEAN:
+         case TK_ENUM:
+         case TK_SMALLSET:
+         case TK_SMALLARRAY:
+             return (a.i == b.i);
+ 
+         case TK_STRING:
+         case TK_SET:
+             return (a.i == b.i && !memcmp(a.s, b.s, a.i));
+ 
+         case TK_REAL:
+         case TK_ARRAY:
+         case TK_RECORD:
+             return (!strcmp(a.s, b.s));
+ 
+         default:
+             return 1;
+     }
+ }
+ 
+ 
+ 
+ char *value_name(val, intfmt, islong)
+ Value val;
+ char *intfmt;
+ int islong;
+ {
+     Meaning *mp;
+     Type *type = val.type;
+ 
+     if (type->kind == TK_SUBR)
+ 	type = type->basetype;
+     switch (type->kind) {
+ 
+         case TK_INTEGER:
+         case TK_SMALLSET:
+         case TK_SMALLARRAY:
+             if (!intfmt)
+ 		intfmt = "%ld";
+ 	    if (*intfmt == '\'') {
+ 		if (val.i >= -'~' && val.i <= -' ') {
+ 		    intfmt = format_s("-%s", intfmt);
+ 		    val.i = -val.i;
+ 		}
+ 		if (val.i < ' ' || val.i > '~' || islong)
+ 		    intfmt = "%ld";
+ 	    }
+             if (islong)
+                 intfmt = format_s("%sL", intfmt);
+             return format_d(intfmt, val.i);
+ 
+         case TK_REAL:
+             return val.s;
+ 
+         case TK_ARRAY:    /* obsolete */
+         case TK_RECORD:   /* obsolete */
+             return val.s;
+ 
+         case TK_STRING:
+             return makeCstring(val.s, val.i);
+ 
+         case TK_BOOLEAN:
+             if (!intfmt)
+                 if (val.i == 1 && *name_TRUE &&
+ 		    strcmp(name_TRUE, "1") && !islong)
+                     intfmt = name_TRUE;
+                 else if (val.i == 0 && *name_FALSE &&
+ 			 strcmp(name_FALSE, "0") && !islong)
+                     intfmt = name_FALSE;
+                 else
+                     intfmt = "%ld";
+             if (islong)
+                 intfmt = format_s("%sL", intfmt);
+             return format_d(intfmt, val.i);
+ 
+         case TK_CHAR:
+             if (islong)
+                 return format_d("%ldL", val.i);
+ 	    else if ((val.i < 0 || val.i > 127) && highcharints)
+ 		return format_d("%ld", val.i);
+             else
+                 return makeCchar(val.i);
+ 
+         case TK_POINTER:
+             return (*name_NULL) ? name_NULL : "NULL";
+ 
+         case TK_ENUM:
+             mp = val.type->fbase;
+             while (mp && mp->val.i != val.i)
+                 mp = mp->xnext;
+             if (!mp) {
+                 intwarning("value_name", "bad enum value [152]");
+                 return format_d("%ld", val.i);
+             }
+             return mp->name;
+ 
+         default:
+             intwarning("value_name", format_s("bad type for constant: %s [153]",
+                                               typekindname(type->kind)));
+             return "<spam>";
+     }
+ }
+ 
+ 
+ 
+ 
+ Value value_cast(val, type)
+ Value val;
+ Type *type;
+ {
+     char buf[20];
+ 
+     if (type->kind == TK_SUBR)
+         type = type->basetype;
+     if (val.type == type)
+         return val;
+     if (type && val.type) {
+         switch (type->kind) {
+ 
+             case TK_REAL:
+                 if (ord_type(val.type)->kind == TK_INTEGER) {
+                     sprintf(buf, "%d.0", val.i);
+                     val.s = stralloc(buf);
+                     val.type = tp_real;
+                     return val;
+                 }
+                 break;
+ 
+             case TK_CHAR:
+                 if (val.type->kind == TK_STRING) {
+                     if (val.i != 1)
+                         if (val.i > 0)
+                             warning("Char constant with more than one character [154]");
+                         else
+                             warning("Empty char constant [155]");
+                     val.i = val.s[0] & 0xff;
+                     val.s = NULL;
+                     val.type = tp_char;
+                     return val;
+                 }
+ 
+             case TK_POINTER:
+                 if (val.type == tp_anyptr && castnull != 1) {
+                     val.type = type;
+                     return val;
+                 }
+ 
+ 	    default:
+ 		break;
+         }
+     }
+     val.type = NULL;
+     return val;
+ }
+ 
+ 
+ 
+ Type *ord_type(tp)
+ Type *tp;
+ {
+     if (!tp) {
+         warning("Expected a constant [127]");
+         return tp_integer;
+     }
+     switch (tp->kind) {
+ 
+         case TK_SUBR:
+             tp = tp->basetype;
+             break;
+ 
+         case TK_STRING:
+             if (!CHECKORDEXPR(tp->indextype->smax, 1))
+                 tp = tp_char;
+             break;
+ 
+ 	default:
+ 	    break;
+ 
+     }
+     return tp;
+ }
+ 
+ 
+ 
+ int long_type(tp)
+ Type *tp;
+ {
+     switch (tp->kind) {
+ 
+         case TK_INTEGER:
+             return (tp != tp_int && tp != tp_uint && tp != tp_sint);
+ 
+         case TK_SUBR:
+             return (findbasetype(tp, ODECL_NOPRES) == tp_integer);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ Value make_ord(type, i)
+ Type *type;
+ long i;
+ {
+     Value val;
+ 
+     if (type->kind == TK_ENUM)
+         type = findbasetype(type, ODECL_NOPRES);
+     if (type->kind == TK_SUBR)
+         type = type->basetype;
+     val.type = type;
+     val.i = i;
+     val.s = NULL;
+     return val;
+ }
+ 
+ 
+ 
+ long ord_value(val)
+ Value val;
+ {
+     switch (val.type->kind) {
+ 
+         case TK_INTEGER:
+         case TK_ENUM:
+         case TK_CHAR:
+         case TK_BOOLEAN:
+             return val.i;
+ 
+         case TK_STRING:
+             if (val.i == 1)
+                 return val.s[0] & 0xff;
+ 
+         /* fall through */
+         default:
+             warning("Expected an ordinal type [156]");
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ void ord_range_expr(type, smin, smax)
+ Type *type;
+ Expr **smin, **smax;
+ {
+     if (!type) {
+         warning("Expected a constant [127]");
+         type = tp_integer;
+     }
+     if (type->kind == TK_STRING)
+         type = tp_char;
+     switch (type->kind) {
+ 
+         case TK_SUBR:
+         case TK_INTEGER:
+         case TK_ENUM:
+         case TK_CHAR:
+         case TK_BOOLEAN:
+             if (smin) *smin = type->smin;
+             if (smax) *smax = type->smax;
+             break;
+ 
+         default:
+             warning("Expected an ordinal type [156]");
+             if (smin) *smin = makeexpr_long(0);
+             if (smax) *smax = makeexpr_long(1);
+             break;
+     }
+ }
+ 
+ 
+ int ord_range(type, smin, smax)
+ Type *type;
+ long *smin, *smax;
+ {
+     Expr *emin, *emax;
+     Value vmin, vmax;
+ 
+     ord_range_expr(type, &emin, &emax);
+     if (smin) {
+         vmin = eval_expr(emin);
+         if (!vmin.type)
+             return 0;
+     }
+     if (smax) {
+         vmax = eval_expr(emax);
+         if (!vmax.type)
+             return 0;
+     }
+     if (smin) *smin = ord_value(vmin);
+     if (smax) *smax = ord_value(vmax);
+     return 1;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ void freeexpr(ex)
+ register Expr *ex;
+ {
+     register int i;
+ 
+     if (ex) {
+         for (i = 0; i < ex->nargs; i++)
+             freeexpr(ex->args[i]);
+         switch (ex->kind) {
+ 
+             case EK_CONST:
+             case EK_LONGCONST:
+                 free_value(&ex->val);
+                 break;
+ 
+             case EK_DOT:
+             case EK_NAME:
+             case EK_BICALL:
+                 if (ex->val.s)
+                     FREE(ex->val.s);
+                 break;
+ 
+ 	    default:
+ 		break;
+         }
+         FREE(ex);
+     }
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr(kind, n)
+ enum exprkind kind;
+ int n;
+ {
+     Expr *ex;
+ 
+     ex = ALLOCV(sizeof(Expr) + (n-1)*sizeof(Expr *), Expr, exprs);
+     ex->val.i = 0;
+     ex->val.s = NULL;
+     ex->kind = kind;
+     ex->nargs = n;
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_un(kind, type, arg1)
+ enum exprkind kind;
+ Type *type;
+ Expr *arg1;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(kind, 1);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     if (debug>2) { fprintf(outf,"makeexpr_un returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bin(kind, type, arg1, arg2)
+ enum exprkind kind;
+ Type *type;
+ Expr *arg1, *arg2;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(kind, 2);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     ex->args[1] = arg2;
+     if (debug>2) { fprintf(outf,"makeexpr_bin returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_val(val)
+ Value val;
+ {
+     Expr *ex;
+ 
+     if (val.type->kind == TK_INTEGER &&
+         (val.i < -32767 || val.i > 32767) &&
+         sizeof_int < 32)
+         ex = makeexpr(EK_LONGCONST, 0);
+     else
+         ex = makeexpr(EK_CONST, 0);
+     ex->val = val;
+     if (debug>2) { fprintf(outf,"makeexpr_val returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_char(c)
+ int c;
+ {
+     return makeexpr_val(make_ord(tp_char, c));
+ }
+ 
+ 
+ Expr *makeexpr_long(i)
+ long i;
+ {
+     return makeexpr_val(make_ord(tp_integer, i));
+ }
+ 
+ 
+ Expr *makeexpr_real(r)
+ char *r;
+ {
+     Value val;
+ 
+     val.type = tp_real;
+     val.i = 0;
+     val.s = stralloc(r);
+     return makeexpr_val(val);
+ }
+ 
+ 
+ Expr *makeexpr_lstring(msg, len)
+ char *msg;
+ int len;
+ {
+     Value val;
+ 
+     val.type = tp_str255;
+     val.i = len;
+     val.s = ALLOC(len+1, char, literals);
+     memcpy(val.s, msg, len);
+     val.s[len] = 0;
+     return makeexpr_val(val);
+ }
+ 
+ 
+ Expr *makeexpr_string(msg)
+ char *msg;
+ {
+     Value val;
+ 
+     val.type = tp_str255;
+     val.i = strlen(msg);
+     val.s = stralloc(msg);
+     return makeexpr_val(val);
+ }
+ 
+ 
+ int checkstring(ex, msg)
+ Expr *ex;
+ char *msg;
+ {
+     if (!ex || ex->val.type->kind != TK_STRING || ex->kind != EK_CONST)
+         return 0;
+     if (ex->val.i != strlen(msg))
+         return 0;
+     return memcmp(ex->val.s, msg, ex->val.i) == 0;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_var(mp)
+ Meaning *mp;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_VAR, 0);
+     ex->val.i = (long) mp;
+     ex->val.type = mp->type;
+     if (debug>2) { fprintf(outf,"makeexpr_var returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_name(name, type)
+ char *name;
+ Type *type;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_NAME, 0);
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     if (debug>2) { fprintf(outf,"makeexpr_name returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_setbits()
+ {
+     if (*name_SETBITS)
+         return makeexpr_name(name_SETBITS, tp_integer);
+     else
+         return makeexpr_long(setbits);
+ }
+ 
+ 
+ 
+ /* Note: BICALL's to the following functions should obey the ANSI standard. */
+ /*       Non-ANSI transformations occur while writing the expression. */
+ /*              char *sprintf(buf, fmt, ...)   [returns buf]  */
+ /*              void *memcpy(dest, src, size)  [returns dest] */
+ 
+ Expr *makeexpr_bicall_0(name, type)
+ char *name;
+ Type *type;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_0", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 0);
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bicall_1(name, type, arg1)
+ char *name;
+ Type *type;
+ Expr *arg1;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_1", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 1);
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bicall_2(name, type, arg1, arg2)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_2", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 2);
+     if (!strcmp(name, "~SETIO"))
+         name = (iocheck_flag) ? "~~SETIO" : name_SETIO;
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     ex->args[1] = arg2;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bicall_3(name, type, arg1, arg2, arg3)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_3", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 3);
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     ex->args[1] = arg2;
+     ex->args[2] = arg3;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bicall_4(name, type, arg1, arg2, arg3, arg4)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3, *arg4;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_4", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 4);
+     if (!strcmp(name, "~CHKIO"))
+         name = (iocheck_flag) ? "~~CHKIO" : name_CHKIO;
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     ex->args[1] = arg2;
+     ex->args[2] = arg3;
+     ex->args[3] = arg4;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_bicall_5(name, type, arg1, arg2, arg3, arg4, arg5)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3, *arg4, *arg5;
+ {
+     Expr *ex;
+ 
+     if (!name || !*name) {
+         intwarning("makeexpr_bicall_5", "Required name of built-in procedure is missing [157]");
+         name = "MissingProc";
+     }
+     ex = makeexpr(EK_BICALL, 5);
+     ex->val.s = stralloc(name);
+     ex->val.type = type;
+     ex->args[0] = arg1;
+     ex->args[1] = arg2;
+     ex->args[2] = arg3;
+     ex->args[3] = arg4;
+     ex->args[4] = arg5;
+     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Expr *copyexpr(ex)
+ register Expr *ex;
+ {
+     register int i;
+     register Expr *ex2;
+ 
+     if (ex) {
+         ex2 = makeexpr(ex->kind, ex->nargs);
+         for (i = 0; i < ex->nargs; i++)
+             ex2->args[i] = copyexpr(ex->args[i]);
+         switch (ex->kind) {
+ 
+             case EK_CONST:
+             case EK_LONGCONST:
+                 ex2->val = copyvalue(ex->val);
+                 break;
+ 
+             case EK_DOT:
+             case EK_NAME:
+             case EK_BICALL:
+                 ex2->val.type = ex->val.type;
+                 ex2->val.i = ex->val.i;
+                 if (ex->val.s)
+                     ex2->val.s = stralloc(ex->val.s);
+                 break;
+ 
+             default:
+                 ex2->val = ex->val;
+                 break;
+         }
+         return ex2;
+     } else
+         return NULL;
+ }
+ 
+ 
+ 
+ int exprsame(a, b, strict)
+ register Expr *a, *b;
+ int strict;
+ {
+     register int i;
+ 
+     if (!a)
+         return (!b);
+     if (!b)
+         return 0;
+     if (a->val.type != b->val.type && strict != 2) {
+         if (strict ||
+ 	    !((a->val.type->kind == TK_POINTER &&
+ 	       a->val.type->basetype == b->val.type) ||
+ 	      (b->val.type->kind == TK_POINTER &&
+ 	       b->val.type->basetype == a->val.type)))
+         return 0;
+     }
+     if (a->kind != b->kind || a->nargs != b->nargs)
+         return 0;
+     switch (a->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             if (!valuesame(a->val, b->val))
+                 return 0;
+             break;
+ 
+         case EK_BICALL:
+         case EK_NAME:
+             if (strcmp(a->val.s, b->val.s))
+                 return 0;
+             break;
+ 
+         case EK_VAR:
+         case EK_FUNCTION:
+         case EK_CTX:
+         case EK_MACARG:
+             if (a->val.i != b->val.i)
+                 return 0;
+             break;
+ 
+         case EK_DOT:
+             if (a->val.i != b->val.i ||
+                 (!a->val.i && strcmp(a->val.s, b->val.s)))
+                 return 0;
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     i = a->nargs;
+     while (--i >= 0)
+         if (!exprsame(a->args[i], b->args[i], (strict == 2) ? 1 : strict))
+             return 0;
+     return 1;
+ }
+ 
+ 
+ 
+ int exprequiv(a, b)
+ register Expr *a, *b;
+ {
+     register int i, j, k;
+     enum exprkind kind2;
+ 
+     if (!a)
+         return (!b);
+     if (!b)
+         return 0;
+     switch (a->kind) {
+ 
+         case EK_PLUS:
+         case EK_TIMES:
+         case EK_BAND:
+         case EK_BOR:
+         case EK_BXOR:
+         case EK_EQ:
+         case EK_NE:
+             if (b->kind != a->kind || b->nargs != a->nargs ||
+                 b->val.type != a->val.type)
+                 return 0;
+             if (a->nargs > 3)
+                 break;
+             for (i = 0; i < b->nargs; i++) {
+                 if (exprequiv(a->args[0], b->args[i])) {
+                     for (j = 0; j < b->nargs; j++) {
+                         if (j != i &&
+                             exprequiv(a->args[1], b->args[i])) {
+                             if (a->nargs == 2)
+                                 return 1;
+                             for (k = 0; k < b->nargs; k++) {
+                                 if (k != i && k != j &&
+                                     exprequiv(a->args[2], b->args[k]))
+                                     return 1;
+                             }
+                         }
+                     }
+                 }
+             }
+             break;
+ 
+         case EK_LT:
+         case EK_GT:
+         case EK_LE:
+         case EK_GE:
+             switch (a->kind) {
+                 case EK_LT:  kind2 = EK_GT; break;
+                 case EK_GT:  kind2 = EK_LT; break;
+                 case EK_LE:  kind2 = EK_GE; break;
+                 default:     kind2 = EK_LE; break;
+             }
+             if (b->kind != kind2 || b->val.type != a->val.type)
+                 break;
+             if (exprequiv(a->args[0], b->args[1]) &&
+                 exprequiv(a->args[1], b->args[0])) {
+                 return 1;
+             }
+             break;
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+         case EK_BICALL:
+         case EK_NAME:
+         case EK_VAR:
+         case EK_FUNCTION:
+         case EK_CTX:
+         case EK_DOT:
+             return exprsame(a, b, 0);
+ 
+ 	default:
+ 	    break;
+     }
+     if (b->kind != a->kind || b->nargs != a->nargs ||
+         b->val.type != a->val.type)
+         return 0;
+     i = a->nargs;
+     while (--i >= 0)
+         if (!exprequiv(a->args[i], b->args[i]))
+             return 0;
+     return 1;
+ }
+ 
+ 
+ 
+ void deletearg(ex, n)
+ Expr **ex;
+ register int n;
+ {
+     register Expr *ex1 = *ex, *ex2;
+     register int i;
+ 
+     if (debug>2) { fprintf(outf,"deletearg("); dumpexpr(*ex); fprintf(outf,", %d)\n", n); }
+     if (n < 0 || n >= (*ex)->nargs) {
+         intwarning("deletearg", "argument number out of range [158]");
+         return;
+     }
+     ex2 = makeexpr(ex1->kind, ex1->nargs-1);
+     ex2->val = ex1->val;
+     for (i = 0; i < n; i++)
+         ex2->args[i] = ex1->args[i];
+     for (; i < ex2->nargs; i++)
+         ex2->args[i] = ex1->args[i+1];
+     *ex = ex2;
+     FREE(ex1);
+     if (debug>2) { fprintf(outf,"deletearg returns "); dumpexpr(*ex); fprintf(outf,"\n"); }
+ }
+ 
+ 
+ 
+ void insertarg(ex, n, arg)
+ Expr **ex;
+ Expr *arg;
+ register int n;
+ {
+     register Expr *ex1 = *ex, *ex2;
+     register int i;
+ 
+     if (debug>2) { fprintf(outf,"insertarg("); dumpexpr(*ex); fprintf(outf,", %d)\n", n); }
+     if (n < 0 || n > (*ex)->nargs) {
+         intwarning("insertarg", "argument number out of range [159]");
+         return;
+     }
+     ex2 = makeexpr(ex1->kind, ex1->nargs+1);
+     ex2->val = ex1->val;
+     for (i = 0; i < n; i++)
+         ex2->args[i] = ex1->args[i];
+     ex2->args[n] = arg;
+     for (; i < ex1->nargs; i++)
+         ex2->args[i+1] = ex1->args[i];
+     *ex = ex2;
+     FREE(ex1);
+     if (debug>2) { fprintf(outf,"insertarg returns "); dumpexpr(*ex); fprintf(outf,"\n"); }
+ }
+ 
+ 
+ 
+ Expr *grabarg(ex, n)
+ Expr *ex;
+ int n;
+ {
+     Expr *ex2;
+ 
+     if (n < 0 || n >= ex->nargs) {
+         intwarning("grabarg", "argument number out of range [160]");
+         return ex;
+     }
+     ex2 = ex->args[n];
+     ex->args[n] = makeexpr_long(0);   /* placeholder */
+     freeexpr(ex);
+     return ex2;
+ }
+ 
+ 
+ 
+ void delsimparg(ep, n)
+ Expr **ep;
+ int n;
+ {
+     if (n < 0 || n >= (*ep)->nargs) {
+         intwarning("delsimparg", "argument number out of range [161]");
+         return;
+     }
+     deletearg(ep, n);
+     switch ((*ep)->kind) {
+ 
+         case EK_PLUS:
+         case EK_TIMES:
+         case EK_COMMA:
+             if ((*ep)->nargs == 1)
+                 *ep = grabarg(*ep, 0);
+             break;
+ 
+ 	default:
+ 	    break;
+ 
+     }
+ }
+ 
+ 
+ 
+ 
+ Expr *resimplify(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+     Type *type;
+     int i;
+ 
+     if (debug>2) { fprintf(outf,"resimplify("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (!ex)
+         return NULL;
+     type = ex->val.type;
+     switch (ex->kind) {
+ 
+         case EK_PLUS:
+             ex2 = ex->args[0];
+             for (i = 1; i < ex->nargs; i++)
+                 ex2 = makeexpr_plus(ex2, ex->args[i]);
+             FREE(ex);
+             return ex2;
+ 
+         case EK_TIMES:
+             ex2 = ex->args[0];
+             for (i = 1; i < ex->nargs; i++)
+                 ex2 = makeexpr_times(ex2, ex->args[i]);
+             FREE(ex);
+             return ex2;
+ 
+         case EK_NEG:
+             ex = makeexpr_neg(grabarg(ex, 0));
+             ex->val.type = type;
+             return ex;
+ 
+         case EK_NOT:
+             ex = makeexpr_not(grabarg(ex, 0));
+             ex->val.type = type;
+             return ex;
+ 
+         case EK_HAT:
+             ex = makeexpr_hat(grabarg(ex, 0), 0);
+ 	    if (ex->kind == EK_HAT)
+ 		ex->val.type = type;
+             return ex;
+ 
+         case EK_ADDR:
+             ex = makeexpr_addr(grabarg(ex, 0));
+             ex->val.type = type;
+             return ex;
+ 
+ 	case EK_ASSIGN:
+ 	    ex2 = makeexpr_assign(ex->args[0], ex->args[1]);
+ 	    FREE(ex);
+ 	    return ex2;
+ 
+ 	default:
+ 	    break;
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ int realzero(s)
+ register char *s;
+ {
+     if (*s == '-') s++;
+     while (*s == '0' || *s == '.') s++;
+     return (!isdigit(*s));
+ }
+ 
+ int realint(s, i)
+ register char *s;
+ int i;
+ {
+     if (i == 0)
+ 	return realzero(s);
+     if (*s == '-') {
+ 	s++;
+ 	i = -i;
+     }
+     if (i < 0 || i > 9) return 0;   /* we don't care about large values here */
+     while (*s == '0') s++;
+     if (*s++ != i + '0') return 0;
+     if (*s == '.')
+ 	while (*++s == '0') ;
+     return (!isdigit(*s));
+ }
+ 
+ 
+ int checkconst(ex, val)
+ Expr *ex;
+ long val;
+ {
+     Meaning *mp;
+     Value exval;
+ 
+     if (!ex)
+         return 0;
+     if (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
+         ex = ex->args[0];
+     if (ex->kind == EK_CONST || ex->kind == EK_LONGCONST)
+         exval = ex->val;
+     else if (ex->kind == EK_VAR &&
+              (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ 	     mp->val.type &&
+              foldconsts != 0)
+         exval = mp->val;
+     else
+         return 0;
+     switch (exval.type->kind) {
+ 
+         case TK_BOOLEAN:
+         case TK_INTEGER:
+         case TK_CHAR:
+         case TK_ENUM:
+         case TK_SUBR:
+         case TK_SMALLSET:
+         case TK_SMALLARRAY:
+             return exval.i == val;
+ 
+         case TK_POINTER:
+         case TK_STRING:
+             return (val == 0 && exval.i == 0);
+ 
+         case TK_REAL:
+             return realint(exval.s, val);
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ 
+ int isliteralconst(ex, valp)
+ Expr *ex;
+ Value *valp;
+ {
+     Meaning *mp;
+ 
+     if (ex) {
+         switch (ex->kind) {
+ 
+             case EK_CONST:
+             case EK_LONGCONST:
+                 if (valp)
+                     *valp = ex->val;
+                 return 2;
+ 
+             case EK_VAR:
+                 mp = (Meaning *)ex->val.i;
+                 if (mp->kind == MK_CONST) {
+                     if (valp) {
+                         if (foldconsts == 0)
+                             valp->type = NULL;
+                         else
+                             *valp = mp->val;
+                     }
+                     return 1;
+                 }
+                 break;
+ 
+ 	    default:
+ 		break;
+         }
+     }
+     if (valp)
+         valp->type = NULL;
+     return 0;
+ }
+ 
+ 
+ 
+ int isconstexpr(ex, valp)
+ Expr *ex;
+ long *valp;
+ {
+     Value exval;
+ 
+     if (debug>2) { fprintf(outf,"isconstexpr("); dumpexpr(ex); fprintf(outf,")\n"); }
+     exval = eval_expr(ex);
+     if (exval.type) {
+         if (valp)
+             *valp = exval.i;
+         return 1;
+     } else
+         return 0;
+ }
+ 
+ 
+ 
+ int isconstantexpr(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     int i;
+ 
+     switch (ex->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+         case EK_SIZEOF:
+             return 1;
+ 
+         case EK_ADDR:
+             if (ex->args[0]->kind == EK_VAR) {
+                 mp = (Meaning *)ex->val.i;
+                 return (!mp->ctx || mp->ctx->kind == MK_MODULE);
+             }
+             return 0;
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+             return (mp->kind == MK_CONST);
+ 
+         case EK_BICALL:
+         case EK_FUNCTION:
+             if (!deterministic_func(ex))
+                 return 0;
+ 
+         /* fall through */
+         case EK_EQ:
+         case EK_NE:
+         case EK_LT:
+         case EK_GT:
+         case EK_LE:
+         case EK_GE:
+         case EK_PLUS:
+         case EK_NEG:
+         case EK_TIMES:
+         case EK_DIVIDE:
+         case EK_DIV:
+         case EK_MOD:
+         case EK_AND:
+         case EK_OR:
+         case EK_NOT:
+         case EK_BAND:
+         case EK_BOR:
+         case EK_BXOR:
+         case EK_BNOT:
+         case EK_LSH:
+         case EK_RSH:
+         case EK_CAST:
+         case EK_ACTCAST:
+         case EK_COND:
+             for (i = 0; i < ex->nargs; i++) {
+                 if (!isconstantexpr(ex->args[i]))
+                     return 0;
+             }
+             return 1;
+ 
+         case EK_COMMA:
+             return isconstantexpr(ex->args[ex->nargs-1]);
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ Static Expr *docast(a, type)
+ Expr *a;
+ Type *type;
+ {
+     Value val;
+     Meaning *mp;
+     int i;
+     Expr *ex;
+ 
+     if (a->val.type->kind == TK_SMALLSET && type->kind == TK_SET) {
+         mp = makestmttempvar(type, name_SET);
+         return makeexpr_bicall_2(setexpandname, type,
+                                  makeexpr_var(mp),
+                                  makeexpr_arglong(a, 1));
+     } else if (a->val.type->kind == TK_SET && type->kind == TK_SMALLSET) {
+         return packset(a, type);
+     }
+     switch (a->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *) a->val.i;
+             if (mp->kind == MK_CONST) {
+                 if (mp->val.type && mp->val.type->kind == TK_STRING &&
+ 		    type->kind == TK_CHAR) {
+                     val = value_cast(mp->val, type);
+                     a->kind = EK_CONST;
+                     a->val = val;
+                     return a;
+                 }
+             }
+             break;
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             val = value_cast(a->val, type);
+             if (val.type) {
+                 a->val = val;
+                 return a;
+             }
+             break;
+ 
+         case EK_PLUS:
+         case EK_NEG:
+         case EK_TIMES:
+             if (type->kind == TK_REAL) {
+                 for (i = 0; i < a->nargs; i++) {
+                     ex = docast(a->args[i], type);
+                     if (ex) {
+                         a->args[i] = ex;
+                         a->val.type = type;
+                         return a;
+                     }
+                 }
+             }
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     return NULL;
+ }
+ 
+ 
+ 
+ /* Make an "active" cast, i.e., one that performs an explicit operation */
+ Expr *makeexpr_actcast(a, type)
+ Expr *a;
+ Type *type;
+ {
+     if (debug>2) { fprintf(outf,"makeexpr_actcast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+ 
+     if (similartypes(a->val.type, type)) {
+         a->val.type = type;
+         return a;
+     }
+     return makeexpr_un(EK_ACTCAST, type, a);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_cast(a, type)
+ Expr *a;
+ Type *type;
+ {
+     Expr *ex;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+     if (a->val.type == type)
+         return a;
+     ex = docast(a, type);
+     if (ex)
+         return ex;
+     if (a->kind == EK_CAST &&
+         a->args[0]->val.type->kind == TK_POINTER &&
+         similartypes(type, a->args[0]->val.type)) {
+         a = grabarg(a, 0);
+         a->val.type = type;
+         return a;
+     }
+     if ((a->kind == EK_CAST &&
+          ((a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) ||
+           (ord_type(a->val.type)->kind == TK_INTEGER && ord_type(type)->kind == TK_INTEGER))) ||
+         similartypes(type, a->val.type)) {
+         a->val.type = type;
+         return a;
+     }
+     return makeexpr_un(EK_CAST, type, a);
+ }
+ 
+ 
+ 
+ Expr *gentle_cast(a, type)
+ Expr *a;
+ Type *type;
+ {
+     Expr *ex;
+     Type *btype;
+     long smin, smax;
+     Value val;
+     char c;
+ 
+     if (debug>2) { fprintf(outf,"gentle_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+     if (!type) {
+ 	intwarning("gentle_cast", "type == NULL");
+ 	return a;
+     }
+     if (a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) {
+         if (voidstar && (type == tp_anyptr || a->val.type == tp_anyptr)) {
+             if (type == tp_anyptr && a->kind == EK_CAST &&
+                 a->args[0]->val.type->kind == TK_POINTER)
+                 return a->args[0];    /* remove explicit cast since casting implicitly */
+             return a;                 /* casting to/from "void *" */
+         }
+         return makeexpr_cast(a, type);
+     }
+     if (type->kind == TK_STRING)
+         return makeexpr_stringify(a);
+     if (type->kind == TK_ARRAY &&
+ 	(a->val.type->kind == TK_STRING ||
+ 	 a->val.type->kind == TK_CHAR) &&
+         isliteralconst(a, &val) && val.type &&
+ 	ord_range(type->indextype, &smin, &smax)) {
+ 	smax = smax - smin + 1;
+ 	if (a->val.type->kind == TK_CHAR) {
+ 	    val.s = &c;
+ 	    c = val.i;
+ 	    val.i = 1;
+ 	}
+ 	if (val.i > smax) {
+ 	    warning("Too many characters for packed array of char [162]");
+ 	} else if (val.i < smax || a->val.type->kind == TK_CHAR) {
+ 	    ex = makeexpr_lstring(val.s, smax);
+ 	    while (smax > val.i)
+ 		ex->val.s[--smax] = ' ';
+ 	    freeexpr(a);
+ 	    return ex;
+ 	}
+     }
+     btype = (type->kind == TK_SUBR) ? type->basetype : type;
+     if ((a->kind == EK_CAST || a->kind == EK_ACTCAST) &&
+         btype->kind == TK_INTEGER &&
+         ord_type(a->val.type)->kind == TK_INTEGER)
+         return makeexpr_longcast(a, long_type(type));
+     if (a->val.type == btype)
+         return a;
+     ex = docast(a, btype);
+     if (ex)
+         return ex;
+     if (btype->kind == TK_CHAR && a->val.type->kind == TK_STRING)
+         return makeexpr_hat(a, 0);
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_charcast(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
+         ex->val.i == 1) {
+         ex->val.type = tp_char;
+         ex->val.i = ex->val.s[0] & 0xff;
+         ex->val.s = NULL;
+     }
+     if (ex->kind == EK_VAR &&
+ 	(mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ 	mp->val.type &&
+ 	mp->val.type->kind == TK_STRING &&
+ 	mp->val.i == 1) {
+       ex->kind = EK_CONST;
+       ex->val.type = tp_char;
+       ex->val.i = mp->val.s[0] & 0xff;
+       ex->val.s = NULL;
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_stringcast(ex)
+ Expr *ex;
+ {
+     char ch;
+ 
+     if (ex->kind == EK_CONST && ord_type(ex->val.type)->kind == TK_CHAR) {
+         ch = ex->val.i;
+         freeexpr(ex);
+         ex = makeexpr_lstring(&ch, 1);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* 0/1 = force to int/long, 2/3 = check if int/long */
+ 
+ Static Expr *dolongcast(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+     Meaning *mp;
+     Expr *ex;
+     Type *type;
+     int i;
+ 
+     switch (a->kind) {
+ 
+         case EK_DOT:
+             if (!a->val.i) {
+                 if (long_type(a->val.type) == (tolong&1))
+                     return a;
+                 break;
+             }
+ 
+         /* fall through */
+         case EK_VAR:
+             mp = (Meaning *)a->val.i;
+             if (mp->kind == MK_FIELD && mp->val.i) {
+                 if (mp->val.i <= ((sizeof_int > 0) ? sizeof_int : 16) &&
+                     !(tolong&1))
+                     return a;
+             } else if (mp->kind == MK_VAR ||
+                        mp->kind == MK_VARREF ||
+                        mp->kind == MK_PARAM ||
+                        mp->kind == MK_VARPARAM ||
+                        mp->kind == MK_FIELD) {
+                 if (long_type(mp->type) == (tolong&1))
+                     return a;
+             }
+             break;
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)a->val.i;
+             if (long_type(mp->type->basetype) == (tolong&1))
+                 return a;
+             break;
+ 
+         case EK_BICALL:
+             if (!strcmp(a->val.s, signextname) && *signextname) {
+                 i = 0;
+                 goto unary;
+             }
+ 	    if (!strcmp(a->val.s, "strlen"))
+ 		goto size_t_case;
+             /* fall through */
+ 
+         case EK_HAT:      /* get true type from a->val.type */
+         case EK_INDEX:
+         case EK_SPCALL:
+         case EK_NAME:
+             if (long_type(a->val.type) == (tolong&1))
+                 return a;
+             break;
+ 
+         case EK_ASSIGN:   /* destination determines type, */
+         case EK_POSTINC:  /*  but must not be changed */
+         case EK_POSTDEC:
+             return dolongcast(a->args[0], tolong|2);
+ 
+         case EK_CAST:
+             if (ord_type(a->val.type)->kind == TK_INTEGER &&
+                  long_type(a->val.type) == (tolong&1))
+                 return a;
+             if (tolong == 0) {
+                 a->val.type = tp_int;
+                 return a;
+             } else if (tolong == 1) {
+                 a->val.type = tp_integer;
+                 return a;
+             }
+             break;
+ 
+         case EK_ACTCAST:
+             if (ord_type(a->val.type)->kind == TK_INTEGER &&
+                  long_type(a->val.type) == (tolong&1))
+                 return a;
+             break;
+ 
+         case EK_CONST:
+             type = ord_type(a->val.type);
+             if (type->kind == TK_INTEGER || type->kind == TK_SMALLSET) {
+                 if (tolong == 1)
+                     a->kind = EK_LONGCONST;
+                 if (tolong != 3)
+                     return a;
+             }
+             break;
+ 
+         case EK_LONGCONST:
+             if (tolong == 0) {
+                 if (a->val.i >= -32767 && a->val.i <= 32767)
+                     a->kind = EK_CONST;
+                 else
+                     return NULL;
+             }
+             if (tolong != 2)
+                 return a;
+             break;
+ 
+         case EK_SIZEOF:
+ 	size_t_case:
+             if (size_t_long > 0 && tolong&1)
+                 return a;
+             if (size_t_long == 0 && !(tolong&1))
+                 return a;
+             break;
+ 
+         case EK_PLUS:     /* usual arithmetic conversions apply */
+         case EK_TIMES:
+         case EK_DIV:
+         case EK_MOD:
+         case EK_BAND:
+         case EK_BOR:
+         case EK_BXOR:
+         case EK_COND:
+             i = (a->kind == EK_COND) ? 1 : 0;
+             if (tolong&1) {
+                 for (; i < a->nargs; i++) {
+                     ex = dolongcast(a->args[i], tolong);
+                     if (ex) {
+                         a->args[i] = ex;
+                         return a;
+                     }
+                 }
+             } else {
+                 for (; i < a->nargs; i++) {
+                     if (!dolongcast(a->args[i], tolong))
+                         return NULL;
+                 }
+                 return a;
+             }
+             break;
+ 
+         case EK_BNOT:     /* single argument defines result type */
+         case EK_NEG:
+         case EK_LSH:
+         case EK_RSH:
+         case EK_COMMA:
+             i = (a->kind == EK_COMMA) ? a->nargs-1 : 0;
+ unary:
+             if (tolong&1) {
+                 ex = dolongcast(a->args[i], tolong);
+                 if (ex) {
+                     a->args[i] = ex;
+                     return a;
+                 }
+             } else {
+                 if (dolongcast(a->args[i], tolong))
+                     return a;
+             }
+             break;
+ 
+         case EK_AND:  /* operators which always return int */
+         case EK_OR:
+         case EK_EQ:
+         case EK_NE:
+         case EK_LT:
+         case EK_GT:
+         case EK_LE:
+         case EK_GE:
+             if (tolong&1)
+                 break;
+             return a;
+ 
+ 	default:
+ 	    break;
+     }
+     return NULL;
+ }
+ 
+ 
+ /* Return -1 if short int or plain int, 1 if long, 0 if can't tell */
+ int exprlongness(ex)
+ Expr *ex;
+ {
+     if (sizeof_int >= 32)
+         return -1;
+     return (dolongcast(ex, 3) != NULL) -
+            (dolongcast(ex, 2) != NULL);
+ }
+ 
+ 
+ Expr *makeexpr_longcast(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+     Expr *ex;
+     Type *type;
+ 
+     if (sizeof_int >= 32)
+         return a;
+     type = ord_type(a->val.type);
+     if (type->kind != TK_INTEGER && type->kind != TK_SMALLSET)
+         return a;
+     a = makeexpr_unlongcast(a);
+     if (tolong) {
+         ex = dolongcast(a, 1);
+     } else {
+         ex = dolongcast(copyexpr(a), 0);
+         if (ex) {
+             if (!dolongcast(ex, 2)) {
+                 freeexpr(ex);
+                 ex = NULL;
+             }
+         }
+     }
+     if (ex)
+         return ex;
+     return makeexpr_un(EK_CAST, (tolong) ? tp_integer : tp_int, a);
+ }
+ 
+ 
+ Expr *makeexpr_arglong(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+     int cast = castlongargs;
+     if (cast < 0)
+ 	cast = castargs;
+     if (cast > 0 || (cast < 0 && prototypes == 0)) {
+ 	return makeexpr_longcast(a, tolong);
+     }
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_unlongcast(a)
+ Expr *a;
+ {
+     switch (a->kind) {
+ 
+         case EK_LONGCONST:
+             if (a->val.i >= -32767 && a->val.i <= 32767)
+                 a->kind = EK_CONST;
+             break;
+ 
+         case EK_CAST:
+             if ((a->val.type == tp_integer ||
+                  a->val.type == tp_int) &&
+                 ord_type(a->args[0]->val.type)->kind == TK_INTEGER) {
+                 a = grabarg(a, 0);
+             }
+             break;
+ 
+         default:
+ 	    break;
+ 
+     }
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_forcelongness(a)    /* force a to have a definite longness */
+ Expr *a;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr_unlongcast(copyexpr(a));
+     if (exprlongness(ex)) {
+         freeexpr(a);
+         return ex;
+     }
+     freeexpr(ex);
+     if (exprlongness(a) == 0)
+         return makeexpr_longcast(a, 1);
+     else
+         return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_ord(ex)
+ Expr *ex;
+ {
+     ex = makeexpr_charcast(ex);
+     switch (ord_type(ex->val.type)->kind) {
+ 
+         case TK_ENUM:
+             return makeexpr_cast(ex, tp_int);
+ 
+         case TK_CHAR:
+             if (ex->kind == EK_CONST &&
+                 (ex->val.i >= 32 && ex->val.i < 127)) {
+                 insertarg(&ex, 0, makeexpr_name("'%lc'", tp_integer));
+             }
+             ex->val.type = tp_int;
+             return ex;
+ 
+         case TK_BOOLEAN:
+             ex->val.type = tp_int;
+             return ex;
+ 
+         case TK_POINTER:
+             return makeexpr_cast(ex, tp_integer);
+ 
+         default:
+             return ex;
+     }
+ }
+ 
+ 
+ 
+ 
+ /* Tell whether an expression "looks" negative */
+ int expr_looks_neg(ex)
+ Expr *ex;
+ {
+     int i;
+ 
+     switch (ex->kind) {
+ 
+         case EK_NEG:
+             return 1;
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             switch (ord_type(ex->val.type)->kind) {
+                 case TK_INTEGER:
+                 case TK_CHAR:
+                     return (ex->val.i < 0);
+                 case TK_REAL:
+                     return (ex->val.s && ex->val.s[0] == '-');
+                 default:
+                     return 0;
+             }
+ 
+         case EK_TIMES:
+         case EK_DIVIDE:
+             for (i = 0; i < ex->nargs; i++) {
+                 if (expr_looks_neg(ex->args[i]))
+                     return 1;
+             }
+             return 0;
+ 
+         case EK_CAST:
+             return expr_looks_neg(ex->args[0]);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ /* Tell whether an expression is probably negative */
+ int expr_is_neg(ex)
+ Expr *ex;
+ {
+     int i;
+ 
+     i = possiblesigns(ex) & (1|4);
+     if (i == 1)
+ 	return 1;    /* if expression really is negative! */
+     if (i == 4)
+ 	return 0;    /* if expression is definitely positive. */
+     return expr_looks_neg(ex);
+ }
+ 
+ 
+ 
+ int expr_neg_cost(a)
+ Expr *a;
+ {
+     int i, c;
+ 
+     switch (a->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             switch (ord_type(a->val.type)->kind) {
+                 case TK_INTEGER:
+                 case TK_CHAR:
+                 case TK_REAL:
+                     return 0;
+ 		default:
+ 		    return 1;
+             }
+ 
+         case EK_NEG:
+             return -1;
+ 
+         case EK_TIMES:
+         case EK_DIVIDE:
+             for (i = 0; i < a->nargs; i++) {
+                 c = expr_neg_cost(a->args[i]);
+                 if (c <= 0)
+                     return c;
+             }
+             return 1;
+ 
+         case EK_PLUS:
+             for (i = 0; i < a->nargs; i++) {
+                 if (expr_looks_neg(a->args[i]))
+                     return 0;
+             }
+             return 1;
+ 
+         default:
+             return 1;
+     }
+ }
+ 
+ 
+ 
+ Expr *enum_to_int(a)
+ Expr *a;
+ {
+     if (ord_type(a->val.type)->kind == TK_ENUM) {
+         if (a->kind == EK_CAST &&
+              ord_type(a->args[0]->val.type)->kind == TK_INTEGER)
+             return grabarg(a, 0);
+         else
+             return makeexpr_cast(a, tp_integer);
+     } else
+         return a;
+ }
+ 
+ 
+ 
+ Expr *neg_inside_sum(a)
+ Expr *a;
+ {
+     int i;
+ 
+     for (i = 0; i < a->nargs; i++)
+         a->args[i] = makeexpr_neg(a->args[i]);
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_neg(a)
+ Expr *a;
+ {
+     int i;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_neg("); dumpexpr(a); fprintf(outf,")\n"); }
+     a = enum_to_int(a);
+     switch (a->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             switch (ord_type(a->val.type)->kind) {
+ 
+                 case TK_INTEGER:
+                 case TK_CHAR:
+                     if (a->val.i == MININT)
+                         valrange();
+                     else
+                         a->val.i = - a->val.i;
+                     return a;
+ 
+                 case TK_REAL:
+                     if (!realzero(a->val.s)) {
+                         if (a->val.s[0] == '-')
+                             strchange(&a->val.s, a->val.s+1);
+                         else
+                             strchange(&a->val.s, format_s("-%s", a->val.s));
+                     }
+                     return a;
+ 
+ 		default:
+ 		    break;
+             }
+             break;
+ 
+         case EK_PLUS:
+             if (expr_neg_cost(a) <= 0)
+                 return neg_inside_sum(a);
+             break;
+ 
+         case EK_TIMES:
+         case EK_DIVIDE:
+             for (i = 0; i < a->nargs; i++) {
+                 if (expr_neg_cost(a->args[i]) <= 0) {
+                     a->args[i] = makeexpr_neg(a->args[i]);
+                     return a;
+                 }
+             }
+             break;
+ 
+         case EK_CAST:
+             if (a->val.type != tp_unsigned &&
+                  a->val.type != tp_uint &&
+                  a->val.type != tp_ushort &&
+                  a->val.type != tp_ubyte &&
+                  a->args[0]->val.type != tp_unsigned &&
+                  a->args[0]->val.type != tp_uint &&
+                  a->args[0]->val.type != tp_ushort &&
+                  a->args[0]->val.type != tp_ubyte &&
+                  expr_looks_neg(a->args[0])) {
+                 a->args[0] = makeexpr_neg(a->args[0]);
+                 return a;
+             }
+             break;
+ 
+         case EK_NEG:
+             return grabarg(a, 0);
+ 
+ 	default:
+ 	    break;
+     }
+     return makeexpr_un(EK_NEG, promote_type(a->val.type), a);
+ }
+ 
+ 
+ 
+ 
+ #define ISCONST(kind) ((kind)==EK_CONST || (kind)==EK_LONGCONST)
+ #define MOVCONST(ex) (ISCONST((ex)->kind) && (ex)->val.type->kind != TK_STRING)
+ #define COMMUTATIVE (kind != EK_COMMA && type->kind != TK_REAL)
+ 
+ Type *true_type(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Type *type, *tp;
+ 
+     while (ex->kind == EK_CAST)
+ 	ex = ex->args[0];
+     type = ex->val.type;
+     if (ex->kind == EK_VAR || ex->kind == EK_FUNCTION || ex->kind == EK_DOT) {
+ 	mp = (Meaning *)ex->val.i;
+ 	if (mp && mp->type && mp->type->kind != TK_VOID)
+ 	    type = mp->type;
+     }
+     if (ex->kind == EK_INDEX) {
+ 	tp = true_type(ex->args[0]);
+ 	if ((tp->kind == TK_ARRAY || tp->kind == TK_SMALLARRAY ||
+ 	     tp->kind == TK_STRING) &&
+ 	    tp->basetype && tp->basetype->kind != TK_VOID)
+ 	    type = tp->basetype;
+     }
+     if (type->kind == TK_SUBR)
+ 	type = findbasetype(type, ODECL_NOPRES);
+     return type;
+ }
+ 
+ int ischartype(ex)
+ Expr *ex;
+ {
+     if (ord_type(ex->val.type)->kind == TK_CHAR)
+ 	return 1;
+     if (true_type(ex)->kind == TK_CHAR)
+ 	return 1;
+     if (ISCONST(ex->kind) && ex->nargs > 0 &&
+ 	ex->args[0]->kind == EK_NAME &&
+ 	ex->args[0]->val.s[0] == '\'')
+ 	return 1;
+     return 0;
+ }
+ 
+ Static Expr *commute(a, b, kind)
+ Expr *a, *b;
+ enum exprkind kind;
+ {
+     int i, di;
+     Type *type;
+ 
+     if (debug>2) { fprintf(outf,"commute("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ #if 1
+     type = promote_type_bin(a->val.type, b->val.type);
+ #else
+     type = a->val.type;
+     if (b->val.type->kind == TK_REAL)
+         type = b->val.type;
+ #endif
+     if (MOVCONST(a) && !MOVCONST(b) && COMMUTATIVE)
+         swapexprs(a, b);                /* put constant last */
+     if (a->kind == kind) {
+         di = (MOVCONST(a->args[a->nargs-1]) && COMMUTATIVE) ? -1 : 0;
+         if (b->kind == kind) {
+             for (i = 0; i < b->nargs; i++)
+                 insertarg(&a, a->nargs + di, b->args[i]);
+             FREE(b);
+         } else
+             insertarg(&a, a->nargs + di, b);
+         a->val.type = type;
+     } else if (b->kind == kind) {
+         if (MOVCONST(a) && COMMUTATIVE)
+             insertarg(&b, b->nargs, a);
+         else
+             insertarg(&b, 0, a);
+         a = b;
+         a->val.type = type;
+     } else {
+         a = makeexpr_bin(kind, type, a, b);
+     }
+     if (debug>2) { fprintf(outf,"commute returns "); dumpexpr(a); fprintf(outf,"\n"); }
+     return a;
+ }
+ 
+ 
+ Expr *makeexpr_plus(a, b)
+ Expr *a, *b;
+ {
+     int i, j, k, castdouble = 0;
+     Type *type;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_plus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (!a)
+         return b;
+     if (!b)
+         return a;
+     if (a->kind == EK_NEG && a->args[0]->kind == EK_PLUS)
+         a = neg_inside_sum(grabarg(a, 0));
+     if (b->kind == EK_NEG && b->args[0]->kind == EK_PLUS)
+         b = neg_inside_sum(grabarg(b, 0));
+     a = commute(enum_to_int(a), enum_to_int(b), EK_PLUS);
+     type = NULL;
+     for (i = 0; i < a->nargs; i++) {
+         if (ord_type(a->args[i]->val.type)->kind == TK_CHAR ||
+             a->args[i]->val.type->kind == TK_POINTER ||
+             a->args[i]->val.type->kind == TK_STRING) {   /* for string literals */
+             if (type == ord_type(a->args[i]->val.type))
+                 type = tp_integer;   /* 'z'-'a' and p1-p2 are integers */
+             else
+                 type = ord_type(a->args[i]->val.type);
+         }
+     }
+     if (type)
+         a->val.type = type;
+     for (i = 0; i < a->nargs && !ISCONST(a->args[i]->kind); i++) ;
+     if (i < a->nargs-1) {
+         for (j = i+1; j < a->nargs; j++) {
+             if (ISCONST(a->args[j]->kind)) {
+                 if ((ord_type(a->args[i]->val.type) == ord_type(a->args[j]->val.type) ||
+ 		     ord_type(a->args[i]->val.type)->kind == TK_INTEGER ||
+ 		     ord_type(a->args[j]->val.type)->kind == TK_INTEGER) &&
+ 		    (!(ischartype(a->args[i]) || ischartype(a->args[j])) ||
+ 		     a->args[i]->val.i == - a->args[j]->val.i ||
+ 		     a->args[i]->val.i == 0 || a->args[j]->val.i == 0) &&
+                     (a->args[i]->val.type->kind != TK_REAL &&
+                      a->args[i]->val.type->kind != TK_STRING &&
+                      a->args[j]->val.type->kind != TK_REAL &&
+                      a->args[j]->val.type->kind != TK_STRING)) {
+                     a->args[i]->val.i += a->args[j]->val.i;
+                     delfreearg(&a, j);
+                     j--;
+                 } else if (a->args[i]->val.type->kind == TK_STRING &&
+                            ord_type(a->args[j]->val.type)->kind == TK_INTEGER &&
+                            a->args[j]->val.i < 0 &&
+                            a->args[j]->val.i >= -stringleaders) {
+                     /* strictly speaking, the following is illegal pointer arithmetic */
+                     a->args[i] = makeexpr_lstring(a->args[i]->val.s + a->args[j]->val.i,
+                                                   a->args[i]->val.i - a->args[j]->val.i);
+                     for (k = 0; k < - a->args[j]->val.i; k++)
+                         a->args[i]->val.s[k] = '>';
+                     delfreearg(&a, j);
+                     j--;
+                 }
+             }
+         }
+     }
+     if (checkconst(a->args[a->nargs-1], 0)) {
+ 	if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ 	    a->args[0]->val.type->kind != TK_REAL)
+ 	    castdouble = 1;
+         delfreearg(&a, a->nargs-1);
+     }
+     for (i = 0; i < a->nargs; i++) {
+         if (a->args[i]->kind == EK_NEG && nosideeffects(a->args[i], 1)) {
+             for (j = 0; j < a->nargs; j++) {
+                 if (exprsame(a->args[j], a->args[i]->args[0], 1)) {
+                     delfreearg(&a, i);
+                     if (i < j) j--; else i--;
+                     delfreearg(&a, j);
+                     i--;
+                     break;
+                 }
+             }
+         }
+     }
+     if (a->nargs == 0) {
+ 	type = a->val.type;
+ 	FREE(a);
+ 	a = gentle_cast(makeexpr_long(0), type);
+ 	a->val.type = type;
+ 	return a;
+     } else if (a->nargs == 1) {
+ 	b = a->args[0];
+ 	FREE(a);
+ 	a = b;
+     } else {
+ 	if (a->nargs == 2 && ISCONST(a->args[1]->kind) &&
+ 	    a->args[1]->val.i <= -127 &&
+ 	    true_type(a->args[0]) == tp_char && signedchars != 0) {
+ 	    a->args[0] = force_unsigned(a->args[0]);
+ 	}
+ 	if (a->nargs > 2 &&
+ 	    ISCONST(a->args[a->nargs-1]->kind) &&
+ 	    ISCONST(a->args[a->nargs-2]->kind) &&
+ 	    ischartype(a->args[a->nargs-1]) &&
+ 	    ischartype(a->args[a->nargs-2])) {
+ 	    i = a->args[a->nargs-1]->val.i;
+ 	    j = a->args[a->nargs-2]->val.i;
+ 	    if ((i == 'a' || i == 'A' || i == -'a' || i == -'A') &&
+ 		(j == 'a' || j == 'A' || j == -'a' || j == -'A')) {
+ 		if (abs(i+j) == 32) {
+ 		    delfreearg(&a, a->nargs-1);
+ 		    delsimpfreearg(&a, a->nargs-1);
+ 		    a = makeexpr_bicall_1((i+j > 0) ? "_tolower" : "_toupper",
+ 					  tp_char, a);
+ 		}
+ 	    }
+ 	}
+     }
+     if (castdouble)
+ 	a = makeexpr_cast(a, tp_real);
+     return a;
+ }
+ 
+ 
+ Expr *makeexpr_minus(a, b)
+ Expr *a, *b;
+ {
+     int okneg;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_minus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (ISCONST(b->kind) && b->val.i == 0 &&       /* kludge for array indexing */
+         ord_type(b->val.type)->kind == TK_ENUM) {
+         b->val.type = tp_integer;
+     }
+     okneg = (a->kind != EK_PLUS && b->kind != EK_PLUS);
+     a = makeexpr_plus(a, makeexpr_neg(b));
+     if (okneg && a->kind == EK_PLUS)
+         a->val.i = 1;   /* this flag says to write as "a-b" if possible */
+     return a;
+ }
+ 
+ 
+ Expr *makeexpr_inc(a, b)
+ Expr *a, *b;
+ {
+     Type *type;
+ 
+     type = a->val.type;
+     a = makeexpr_plus(makeexpr_charcast(a), b);
+     if (ord_type(type)->kind != TK_INTEGER &&
+ 	ord_type(type)->kind != TK_CHAR)
+ 	a = makeexpr_cast(a, type);
+     return a;
+ }
+ 
+ 
+ 
+ /* Apply the distributive law for a sum of products */
+ Expr *distribute_plus(ex)
+ Expr *ex;
+ {
+     int i, j, icom;
+     Expr *common, *outer, *ex2, **exp;
+ 
+     if (debug>2) { fprintf(outf,"distribute_plus("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (ex->kind != EK_PLUS)
+         return ex;
+     for (i = 0; i < ex->nargs; i++)
+         if (ex->args[i]->kind == EK_TIMES)
+             break;
+     if (i == ex->nargs)
+         return ex;
+     outer = NULL;
+     icom = 0;
+     for (;;) {
+ 	ex2 = ex->args[0];
+ 	if (ex2->kind == EK_NEG)
+ 	    ex2 = ex2->args[0];
+         if (ex2->kind == EK_TIMES) {
+ 	    if (icom >= ex2->nargs)
+ 		break;
+             common = ex2->args[icom];
+ 	    if (common->kind == EK_NEG)
+ 		common = common->args[0];
+         } else {
+ 	    if (icom > 0)
+ 		break;
+             common = ex2;
+ 	    icom++;
+ 	}
+         for (i = 1; i < ex->nargs; i++) {
+ 	    ex2 = ex->args[i];
+ 	    if (ex2->kind == EK_NEG)
+ 		ex2 = ex2->args[i];
+             if (ex2->kind == EK_TIMES) {
+                 for (j = ex2->nargs; --j >= 0; ) {
+                     if (exprsame(ex2->args[j], common, 1) ||
+ 			(ex2->args[j]->kind == EK_NEG &&
+ 			 exprsame(ex2->args[j]->args[0], common, 1)))
+                         break;
+                 }
+                 if (j < 0)
+                     break;
+             } else {
+                 if (!exprsame(ex2, common, 1))
+                     break;
+             }
+         }
+         if (i == ex->nargs) {
+             if (debug>2) { fprintf(outf,"distribute_plus does "); dumpexpr(common); fprintf(outf,"\n"); }
+ 	    common = copyexpr(common);
+             for (i = 0; i < ex->nargs; i++) {
+ 		if (ex->args[i]->kind == EK_NEG)
+ 		    ex2 = *(exp = &ex->args[i]->args[0]);
+ 		else
+ 		    ex2 = *(exp = &ex->args[i]);
+ 		if (ex2->kind == EK_TIMES) {
+                     for (j = ex2->nargs; --j >= 0; ) {
+                         if (exprsame(ex2->args[j], common, 1)) {
+                             delsimpfreearg(exp, j);
+                             break;
+                         } else if (ex2->args[j]->kind == EK_NEG &&
+ 				   exprsame(ex2->args[j]->args[0], common,1)) {
+ 			    freeexpr(ex2->args[j]);
+ 			    ex2->args[j] = makeexpr_long(-1);
+ 			    break;
+ 			}
+                     }
+ 		} else {
+ 		    freeexpr(ex2);
+ 		    *exp = makeexpr_long(1);
+                 }
+ 		ex->args[i] = resimplify(ex->args[i]);
+             }
+             outer = makeexpr_times(common, outer);
+         } else
+ 	    icom++;
+     }
+     return makeexpr_times(resimplify(ex), outer);
+ }
+ 
+ 
+ 
+ 
+ 
+ Expr *makeexpr_times(a, b)
+ Expr *a, *b;
+ {
+     int i, n, castdouble = 0;
+     Type *type;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_times("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (!a)
+         return b;
+     if (!b)
+         return a;
+     a = commute(a, b, EK_TIMES);
+     if (a->val.type->kind == TK_INTEGER) {
+         i = a->nargs-1;
+         if (i > 0 && ISCONST(a->args[i-1]->kind)) {
+             a->args[i-1]->val.i *= a->args[i]->val.i;
+             delfreearg(&a, i);
+         }
+     }
+     for (i = n = 0; i < a->nargs; i++) {
+         if (expr_neg_cost(a->args[i]) < 0)
+             n++;
+     }
+     if (n & 1) {
+         for (i = 0; i < a->nargs; i++) {
+             if (ISCONST(a->args[i]->kind) &&
+                 expr_neg_cost(a->args[i]) >= 0) {
+                 a->args[i] = makeexpr_neg(a->args[i]);
+                 n++;
+                 break;
+             }
+         }
+     } else
+         n++;
+     for (i = 0; i < a->nargs && n >= 2; i++) {
+         if (expr_neg_cost(a->args[i]) < 0) {
+             a->args[i] = makeexpr_neg(a->args[i]);
+             n--;
+         }
+     }
+     if (checkconst(a->args[a->nargs-1], 1)) {
+ 	if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ 	    a->args[0]->val.type->kind != TK_REAL)
+ 	    castdouble = 1;
+         delfreearg(&a, a->nargs-1);
+     } else if (checkconst(a->args[a->nargs-1], -1)) {
+ 	if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ 	    a->args[0]->val.type->kind != TK_REAL)
+ 	    castdouble = 1;
+         delfreearg(&a, a->nargs-1);
+ 	a->args[0] = makeexpr_neg(a->args[0]);
+     } else if (checkconst(a->args[a->nargs-1], 0) && nosideeffects(a, 1)) {
+ 	if (a->args[a->nargs-1]->val.type->kind == TK_REAL)
+ 	    type = a->args[a->nargs-1]->val.type;
+ 	else
+ 	    type = a->val.type;
+         return makeexpr_cast(grabarg(a, a->nargs-1), type);
+     }
+     if (a->nargs < 2) {
+         if (a->nargs < 1) {
+             FREE(a);
+             a = makeexpr_long(1);
+         } else {
+             b = a->args[0];
+             FREE(a);
+             a = b;
+         }
+     }
+     if (castdouble)
+ 	a = makeexpr_cast(a, tp_real);
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_sqr(ex, cube)
+ Expr *ex;
+ int cube;
+ {
+     Expr *ex2;
+     Meaning *tvar;
+     Type *type;
+ 
+     if (exprspeed(ex) <= 2 && nosideeffects(ex, 0)) {
+ 	ex2 = NULL;
+     } else {
+ 	type = (ex->val.type->kind == TK_REAL) ? tp_longreal : tp_integer;
+ 	tvar = makestmttempvar(type, name_TEMP);
+ 	ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
+ 	ex = makeexpr_var(tvar);
+     }
+     if (cube)
+ 	ex = makeexpr_times(ex, makeexpr_times(copyexpr(ex), copyexpr(ex)));
+     else
+ 	ex = makeexpr_times(ex, copyexpr(ex));
+     return makeexpr_comma(ex2, ex);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_divide(a, b)
+ Expr *a, *b;
+ {
+     Expr *ex;
+     int p;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_divide("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (a->val.type->kind != TK_REAL &&
+ 	b->val.type->kind != TK_REAL) {     /* must do a real division */
+         ex = docast(a, tp_longreal);
+         if (ex)
+             a = ex;
+         else {
+             ex = docast(b, tp_longreal);
+             if (ex)
+                 b = ex;
+             else
+                 a = makeexpr_cast(a, tp_longreal);
+         }
+     }
+     if (a->kind == EK_TIMES) {
+ 	for (p = 0; p < a->nargs; p++)
+ 	    if (exprsame(a->args[p], b, 1))
+ 		break;
+ 	if (p < a->nargs) {
+ 	    delfreearg(&a, p);
+ 	    freeexpr(b);
+ 	    if (a->nargs == 1)
+ 		return grabarg(a, 0);
+ 	    else
+ 		return a;
+ 	}
+     }
+     if (expr_neg_cost(a) < 0 && expr_neg_cost(b) < 0) {
+         a = makeexpr_neg(a);
+         b = makeexpr_neg(b);
+     }
+     if (checkconst(b, 0))
+         warning("Division by zero [163]");
+     return makeexpr_bin(EK_DIVIDE, tp_longreal, a, b);
+ }
+ 
+ 
+ 
+ 
+ int gcd(a, b)
+ int a, b;
+ {
+     if (a < 0) a = -a;
+     if (b < 0) b = -b;
+     while (a != 0) {
+ 	b %= a;
+ 	if (b != 0)
+ 	    a %= b;
+ 	else
+ 	    return a;
+     }
+     return b;
+ }
+ 
+ 
+ 
+ /* possible signs of ex: 1=may be neg, 2=may be zero, 4=may be pos */
+ 
+ int negsigns(mask)
+ int mask;
+ {
+     return (mask & 2) |
+ 	   ((mask & 1) << 2) |
+ 	   ((mask & 4) >> 2);
+ }
+ 
+ 
+ int possiblesigns(ex)
+ Expr *ex;
+ {
+     Value val;
+     Type *tp;
+     char *cp;
+     int i, mask, mask2;
+ 
+     if (isliteralconst(ex, &val) && val.type) {
+ 	if (val.type == tp_real || val.type == tp_longreal) {
+ 	    if (realzero(val.s))
+ 		return 2;
+ 	    if (*val.s == '-')
+ 		return 1;
+ 	    return 4;
+ 	} else
+ 	    return (val.i < 0) ? 1 : (val.i == 0) ? 2 : 4;
+     }
+     if (ex->kind == EK_CAST &&
+ 	similartypes(ex->val.type, ex->args[0]->val.type))
+ 	return possiblesigns(ex->args[0]);
+     if (ex->kind == EK_NEG)
+ 	return negsigns(possiblesigns(ex->args[0]));
+     if (ex->kind == EK_TIMES || ex->kind == EK_DIVIDE) {
+ 	mask = possiblesigns(ex->args[0]);
+ 	for (i = 1; i < ex->nargs; i++) {
+ 	    mask2 = possiblesigns(ex->args[i]);
+ 	    if (mask2 & 2)
+ 		mask |= 2;
+ 	    if ((mask2 & (1|4)) == 1)
+ 		mask = negsigns(mask);
+ 	    else if ((mask2 & (1|4)) != 4)
+ 		mask = 1|2|4;
+ 	}
+ 	return mask;
+     }
+     if (ex->kind == EK_DIV || ex->kind == EK_MOD) {
+ 	mask = possiblesigns(ex->args[0]);
+ 	mask2 = possiblesigns(ex->args[1]);
+ 	if (!((mask | mask2) & 1))
+ 	    return 2|4;
+     }
+     if (ex->kind == EK_PLUS) {
+ 	mask = 0;
+ 	for (i = 0; i < ex->nargs; i++) {
+ 	    mask2 = possiblesigns(ex->args[i]);
+ 	    if ((mask & negsigns(mask2)) & (1|4))
+ 		mask |= (1|2|4);
+ 	    else
+ 		mask |= mask2;
+ 	}
+ 	return mask;
+     }
+     if (ex->kind == EK_COND) {
+ 	return possiblesigns(ex->args[1]) | possiblesigns(ex->args[2]);
+     }
+     if (ex->kind == EK_EQ || ex->kind == EK_LT || ex->kind == EK_GT ||
+ 	ex->kind == EK_NE || ex->kind == EK_LE || ex->kind == EK_GE ||
+ 	ex->kind == EK_AND || ex->kind == EK_OR || ex->kind == EK_NOT)
+ 	return 2|4;
+     if (ex->kind == EK_BICALL) {
+ 	cp = ex->val.s;
+ 	if (!strcmp(cp, "strlen") ||
+ 	    !strcmp(cp, "abs") ||
+ 	    !strcmp(cp, "labs") ||
+ 	    !strcmp(cp, "fabs"))
+ 	    return 2|4;
+     }
+     tp = (ex->kind == EK_VAR) ? ((Meaning *)ex->val.i)->type : ex->val.type;
+     if (ord_range(ex->val.type, &val.i, NULL)) {
+ 	if (val.i > 0)
+ 	    return 4;
+ 	if (val.i >= 0)
+ 	    return 2|4;
+     }
+     if (ord_range(ex->val.type, NULL, &val.i)) {
+ 	if (val.i < 0)
+ 	    return 1;
+ 	if (val.i <= 0)
+ 	    return 1|2;
+     }
+     return 1|2|4;
+ }
+ 
+ 
+ 
+ 
+ 
+ Expr *dodivmod(funcname, ekind, a, b)
+ char *funcname;
+ enum exprkind ekind;
+ Expr *a, *b;
+ {
+     Meaning *tvar;
+     Type *type;
+     Expr *asn;
+     int sa, sb;
+ 
+     type = promote_type_bin(a->val.type, b->val.type);
+     tvar = NULL;
+     sa = possiblesigns(a);
+     sb = possiblesigns(b);
+     if ((sa & 1) || (sb & 1)) {
+ 	if (*funcname) {
+ 	    asn = NULL;
+ 	    if (*funcname == '*') {
+ 		if (exprspeed(a) >= 5 || !nosideeffects(a, 0)) {
+ 		    tvar = makestmttempvar(a->val.type, name_TEMP);
+ 		    asn = makeexpr_assign(makeexpr_var(tvar), a);
+ 		    a = makeexpr_var(tvar);
+ 		}
+ 		if (exprspeed(b) >= 5 || !nosideeffects(b, 0)) {
+ 		    tvar = makestmttempvar(b->val.type, name_TEMP);
+ 		    asn = makeexpr_comma(asn,
+ 					 makeexpr_assign(makeexpr_var(tvar),
+ 							 b));
+ 		    b = makeexpr_var(tvar);
+ 		}
+ 	    }
+ 	    return makeexpr_comma(asn,
+ 				  makeexpr_bicall_2(funcname, type, a, b));
+ 	} else {
+ 	    if ((sa & 1) && (ekind == EK_MOD))
+ 		note("Using % for possibly-negative arguments [317]");
+ 	    return makeexpr_bin(ekind, type, a, b);
+ 	}
+     } else
+ 	return makeexpr_bin(ekind, type, a, b);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_div(a, b)
+ Expr *a, *b;
+ {
+     Meaning *mp;
+     Type *type;
+     long i;
+     int p;
+ 
+     if (ISCONST(a->kind) && ISCONST(b->kind)) {
+         if (a->val.i >= 0 && b->val.i > 0) {
+ 	    a->val.i /= b->val.i;
+ 	    freeexpr(b);
+ 	    return a;
+ 	}
+ 	i = gcd(a->val.i, b->val.i);
+ 	if (i >= 0) {
+ 	    a->val.i /= i;
+ 	    b->val.i /= i;
+ 	}
+     }
+     if (((b->kind == EK_CONST && (i = b->val.i)) ||
+          (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
+ 	  mp->val.type && (i = mp->val.i) && foldconsts != 0)) && i > 0) {
+         if (i == 1)
+             return a;
+         if (div_po2 > 0) {
+             p = 0;
+             while (!(i&1))
+                 p++, i >>= 1;
+             if (i == 1) {
+ 		type = promote_type_bin(a->val.type, b->val.type);
+                 return makeexpr_bin(EK_RSH, type, a, makeexpr_long(p));
+             }
+         }
+     }
+     if (a->kind == EK_TIMES) {
+ 	for (p = 0; p < a->nargs; p++) {
+ 	    if (exprsame(a->args[p], b, 1)) {
+ 		delfreearg(&a, p);
+ 		freeexpr(b);
+ 		if (a->nargs == 1)
+ 		    return grabarg(a, 0);
+ 		else
+ 		    return a;
+ 	    } else if (ISCONST(a->args[p]->kind) && ISCONST(b->kind)) {
+ 		i = gcd(a->args[p]->val.i, b->val.i);
+ 		if (i > 1) {
+ 		    a->args[p]->val.i /= i;
+ 		    b->val.i /= i;
+ 		    i = a->args[p]->val.i;
+ 		    delfreearg(&a, p);
+ 		    a = makeexpr_times(a, makeexpr_long(i));   /* resimplify */
+ 		    p = -1;   /* start the loop over */
+ 		}
+ 	    }
+ 	}
+     }
+     if (checkconst(b, 1)) {
+         freeexpr(b);
+         return a;
+     } else if (checkconst(b, -1)) {
+         freeexpr(b);
+         return makeexpr_neg(a);
+     } else {
+         if (checkconst(b, 0))
+             warning("Division by zero [163]");
+         return dodivmod(divname, EK_DIV, a, b);
+     }
+ }
+ 
+ 
+ 
+ Expr *makeexpr_mod(a, b)
+ Expr *a, *b;
+ {
+     Meaning *mp;
+     Type *type;
+     long i;
+ 
+     if (a->kind == EK_CONST && b->kind == EK_CONST &&
+         a->val.i >= 0 && b->val.i > 0) {
+         a->val.i %= b->val.i;
+         freeexpr(b);
+         return a;
+     }
+     if (((b->kind == EK_CONST && (i = b->val.i)) ||
+          (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
+ 	  mp->val.type && (i = mp->val.i) && foldconsts != 0)) && i > 0) {
+         if (i == 1)
+             return makeexpr_long(0);
+         if (mod_po2 != 0) {
+             while (!(i&1))
+                 i >>= 1;
+             if (i == 1) {
+ 		type = promote_type_bin(a->val.type, b->val.type);
+                 return makeexpr_bin(EK_BAND, type, a,
+                                     makeexpr_minus(b, makeexpr_long(1)));
+             }
+         }
+     }
+     if (checkconst(b, 0))
+         warning("Division by zero [163]");
+     return dodivmod(modname, EK_MOD, a, b);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_rem(a, b)
+ Expr *a, *b;
+ {
+     if (!(possiblesigns(a) & 1) && !(possiblesigns(b) & 1))
+ 	return makeexpr_mod(a, b);
+     if (checkconst(b, 0))
+         warning("Division by zero [163]");
+     if (!*remname)
+ 	note("Translating REM same as MOD [141]");
+     return dodivmod(*remname ? remname : modname, EK_MOD, a, b);
+ }
+ 
+ 
+ 
+ 
+ 
+ int expr_not_cost(a)
+ Expr *a;
+ {
+     int i, c;
+ 
+     switch (a->kind) {
+ 
+         case EK_CONST:
+             return 0;
+ 
+         case EK_NOT:
+             return -1;
+ 
+         case EK_EQ:
+         case EK_NE:
+         case EK_LT:
+         case EK_GT:
+         case EK_LE:
+         case EK_GE:
+             return 0;
+ 
+         case EK_AND:
+         case EK_OR:
+             c = 0;
+             for (i = 0; i < a->nargs; i++)
+                 c += expr_not_cost(a->args[i]);
+             return (c > 1) ? 1 : c;
+ 
+         case EK_BICALL:
+             if (!strcmp(a->val.s, oddname) ||
+                 !strcmp(a->val.s, evenname))
+                 return 0;
+             return 1;
+ 
+         default:
+             return 1;
+     }
+ }
+ 
+ 
+ 
+ Expr *makeexpr_not(a)
+ Expr *a;
+ {
+     Expr *ex;
+     int i;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_not("); dumpexpr(a); fprintf(outf,")\n"); }
+     switch (a->kind) {
+ 
+         case EK_CONST:
+             if (a->val.type == tp_boolean) {
+                 a->val.i = !a->val.i;
+                 return a;
+             }
+             break;
+ 
+         case EK_EQ:
+             a->kind = EK_NE;
+             return a;
+ 
+         case EK_NE:
+             a->kind = EK_EQ;
+             return a;
+ 
+         case EK_LT:
+             a->kind = EK_GE;
+             return a;
+ 
+         case EK_GT:
+             a->kind = EK_LE;
+             return a;
+ 
+         case EK_LE:
+             a->kind = EK_GT;
+             return a;
+ 
+         case EK_GE:
+             a->kind = EK_LT;
+             return a;
+ 
+         case EK_AND:
+         case EK_OR:
+             if (expr_not_cost(a) > 0)
+                 break;
+             a->kind = (a->kind == EK_OR) ? EK_AND : EK_OR;
+             for (i = 0; i < a->nargs; i++)
+                 a->args[i] = makeexpr_not(a->args[i]);
+             return a;
+ 
+         case EK_NOT:
+             ex = a->args[0];
+             FREE(a);
+             ex->val.type = tp_boolean;
+             return ex;
+ 
+         case EK_BICALL:
+             if (!strcmp(a->val.s, oddname) && *evenname) {
+                 strchange(&a->val.s, evenname);
+                 return a;
+             } else if (!strcmp(a->val.s, evenname)) {
+                 strchange(&a->val.s, oddname);
+                 return a;
+             }
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     return makeexpr_un(EK_NOT, tp_boolean, a);
+ }
+ 
+ 
+ 
+ 
+ Type *mixsets(ep1, ep2)
+ Expr **ep1, **ep2;
+ {
+     Expr *ex1 = *ep1, *ex2 = *ep2;
+     Meaning *tvar;
+     long min1, max1, min2, max2;
+     Type *type;
+ 
+     if (ex1->val.type->kind == TK_SMALLSET &&
+         ex2->val.type->kind == TK_SMALLSET)
+         return ex1->val.type;
+     if (ex1->val.type->kind == TK_SMALLSET) {
+         tvar = makestmttempvar(ex2->val.type, name_SET);
+         ex1 = makeexpr_bicall_2(setexpandname, ex2->val.type,
+                                 makeexpr_var(tvar),
+                                 makeexpr_arglong(ex1, 1));
+     }
+     if (ex2->val.type->kind == TK_SMALLSET) {
+         tvar = makestmttempvar(ex1->val.type, name_SET);
+         ex2 = makeexpr_bicall_2(setexpandname, ex1->val.type,
+                                 makeexpr_var(tvar),
+                                 makeexpr_arglong(ex2, 1));
+     }
+     if (ord_range(ex1->val.type->indextype, &min1, &max1) &&
+         ord_range(ex2->val.type->indextype, &min2, &max2)) {
+         if (min1 <= min2 && max1 >= max2)
+             type = ex1->val.type;
+         else if (min2 <= min1 && max2 >= max1)
+             type = ex2->val.type;
+         else {
+             if (min2 < min1) min1 = min2;
+             if (max2 > max1) max1 = max2;
+             type = maketype(TK_SET);
+             type->basetype = tp_integer;
+             type->indextype = maketype(TK_SUBR);
+             type->indextype->basetype = ord_type(ex1->val.type->indextype);
+             type->indextype->smin = makeexpr_long(min1);
+             type->indextype->smax = makeexpr_long(max1);
+         }
+     } else
+ 	type = ex1->val.type;
+     *ep1 = ex1, *ep2 = ex2;
+     return type;
+ }
+ 
+ 
+ 
+ Meaning *istempprocptr(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (debug>2) { fprintf(outf,"istempprocptr("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (ex->kind == EK_COMMA && ex->nargs == 3) {
+         if ((mp = istempvar(ex->args[2])) != NULL &&
+ 	    mp->type->kind == TK_PROCPTR &&
+ 	    ex->args[0]->kind == EK_ASSIGN &&
+ 	    ex->args[0]->args[0]->kind == EK_DOT &&
+ 	    exprsame(ex->args[0]->args[0]->args[0], ex->args[2], 1) &&
+ 	    ex->args[1]->kind == EK_ASSIGN &&
+ 	    ex->args[1]->args[0]->kind == EK_DOT &&
+ 	    exprsame(ex->args[1]->args[0]->args[0], ex->args[2], 1))
+ 	    return mp;
+     }
+     if (ex->kind == EK_COMMA && ex->nargs == 2) {
+         if ((mp = istempvar(ex->args[1])) != NULL &&
+ 	    mp->type->kind == TK_CPROCPTR &&
+ 	    ex->args[0]->kind == EK_ASSIGN &&
+ 	    exprsame(ex->args[0]->args[0], ex->args[1], 1))
+ 	    return mp;
+     }
+     return NULL;
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_stringify(ex)
+ Expr *ex;
+ {
+     ex = makeexpr_stringcast(ex);
+     if (ex->val.type->kind == TK_STRING)
+         return ex;
+     return makeexpr_sprintfify(ex);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_rel(rel, a, b)
+ enum exprkind rel;
+ Expr *a, *b;
+ {
+     int i, sign;
+     Expr *ex, *ex2;
+     Meaning *mp;
+     char *name;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_rel(%s,", exprkindname(rel)); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ 
+     a = makeexpr_unlongcast(a);
+     b = makeexpr_unlongcast(b);
+     if ((compenums == 0 || (compenums < 0 && ansiC <= 0)) &&
+ 	(rel != EK_EQ && rel != EK_NE)){
+ 	a = enum_to_int(a);
+ 	b = enum_to_int(b);
+     }
+     if (a->val.type != b->val.type) {
+         if (a->val.type->kind == TK_STRING &&
+             a->kind != EK_CONST) {
+             b = makeexpr_stringify(b);
+         } else if (b->val.type->kind == TK_STRING &&
+                    b->kind != EK_CONST) {
+ 	    a = makeexpr_stringify(a);
+         } else if (ord_type(a->val.type)->kind == TK_CHAR ||
+                    a->val.type->kind == TK_ARRAY) {
+             b = gentle_cast(b, ord_type(a->val.type));
+         } else if (ord_type(b->val.type)->kind == TK_CHAR ||
+                    b->val.type->kind == TK_ARRAY) {
+             a = gentle_cast(a, ord_type(b->val.type));
+         } else if (a->val.type == tp_anyptr && !voidstar) {
+             a = gentle_cast(a, b->val.type);
+         } else if (b->val.type == tp_anyptr && !voidstar) {
+             b = gentle_cast(b, a->val.type);
+         }
+     }
+     if (useisspace && b->val.type->kind == TK_CHAR && checkconst(b, ' ')) {
+         if (rel == EK_EQ) {
+             freeexpr(b);
+             return makeexpr_bicall_1("isspace", tp_boolean, a);
+         } else if (rel == EK_NE) {
+             freeexpr(b);
+             return makeexpr_not(makeexpr_bicall_1("isspace", tp_boolean, a));
+         }
+     }
+     if (rel == EK_LT || rel == EK_GE)
+         sign = 1;
+     else if (rel == EK_GT || rel == EK_LE)
+         sign = -1;
+     else
+         sign = 0;
+     if (ord_type(b->val.type)->kind == TK_INTEGER ||
+ 	ord_type(b->val.type)->kind == TK_CHAR) {
+         for (;;) {
+             if (a->kind == EK_PLUS && ISCONST(a->args[a->nargs-1]->kind) &&
+                  a->args[a->nargs-1]->val.i &&
+                  (ISCONST(b->kind) ||
+                   (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind)))) {
+                 b = makeexpr_minus(b, copyexpr(a->args[a->nargs-1]));
+                 a = makeexpr_minus(a, copyexpr(a->args[a->nargs-1]));
+                 continue;
+             }
+             if (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind) &&
+                  b->args[b->nargs-1]->val.i &&
+                  ISCONST(a->kind)) {
+                 a = makeexpr_minus(a, copyexpr(b->args[b->nargs-1]));
+                 b = makeexpr_minus(b, copyexpr(b->args[b->nargs-1]));
+                 continue;
+             }
+             if (b->kind == EK_PLUS && sign &&
+ 	         ISCONST(b->args[b->nargs-1]->kind) &&
+                  checkconst(b->args[b->nargs-1], sign)) {
+                 b = makeexpr_plus(b, makeexpr_long(-sign));
+                 switch (rel) {
+                     case EK_LT:
+                         rel = EK_LE;
+                         break;
+                     case EK_GT:
+                         rel = EK_GE;
+                         break;
+                     case EK_LE:
+                         rel = EK_LT;
+                         break;
+                     case EK_GE:
+                         rel = EK_GT;
+                         break;
+ 		    default:
+ 			break;
+                 }
+                 sign = -sign;
+                 continue;
+             }
+             if (a->kind == EK_TIMES && checkconst(b, 0) && !sign) {
+                 for (i = 0; i < a->nargs; i++) {
+                     if (ISCONST(a->args[i]->kind) && a->args[i]->val.i)
+                         break;
+                     if (a->args[i]->kind == EK_SIZEOF)
+                         break;
+                 }
+                 if (i < a->nargs) {
+                     delfreearg(&a, i);
+                     continue;
+                 }
+             }
+             break;
+         }
+         if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen") &&
+             checkconst(b, 0)) {
+             if (rel == EK_LT || rel == EK_GE) {
+                 note("Unusual use of STRLEN encountered [142]");
+             } else {
+                 freeexpr(b);
+                 a = makeexpr_hat(grabarg(a, 0), 0);
+                 b = makeexpr_char(0);      /* "strlen(a) = 0" => "*a == 0" */
+                 if (rel == EK_EQ || rel == EK_LE)
+                     return makeexpr_rel(EK_EQ, a, b);
+                 else
+                     return makeexpr_rel(EK_NE, a, b);
+             }
+         }
+         if (ISCONST(a->kind) && ISCONST(b->kind)) {
+             if ((a->val.i == b->val.i && (rel == EK_EQ || rel == EK_GE || rel == EK_LE)) ||
+                 (a->val.i <  b->val.i && (rel == EK_NE || rel == EK_LE || rel == EK_LT)) ||
+                 (a->val.i >  b->val.i && (rel == EK_NE || rel == EK_GE || rel == EK_GT)))
+                 return makeexpr_val(make_ord(tp_boolean, 1));
+             else
+                 return makeexpr_val(make_ord(tp_boolean, 0));
+         }
+ 	if ((a->val.type == tp_char || true_type(a) == tp_char) &&
+ 	    ISCONST(b->kind) && signedchars != 0) {
+ 	    i = (b->val.i == 128 && sign == 1) ||
+ 		(b->val.i == 127 && sign == -1);
+ 	    if (highcharbits && (highcharbits > 0 || signedchars < 0) && i) {
+ 		if (highcharbits == 2)
+ 		    b = makeexpr_long(128);
+ 		else
+ 		    b = makeexpr_un(EK_BNOT, tp_integer, makeexpr_long(127));
+ 		return makeexpr_rel((rel == EK_GE || rel == EK_GT)
+ 				    ? EK_NE : EK_EQ,
+ 				    makeexpr_bin(EK_BAND, tp_integer,
+ 						 eatcasts(a), b),
+ 				    makeexpr_long(0));
+ 	    } else if (signedchars == 1 && i) {
+ 		return makeexpr_rel((rel == EK_GE || rel == EK_GT)
+ 				    ? EK_LT : EK_GE,
+ 				    eatcasts(a), makeexpr_long(0));
+ 	    } else if (signedchars == 1 && b->val.i >= 128 && sign == 0) {
+ 		b->val.i -= 256;
+ 	    } else if (b->val.i >= 128 ||
+ 		       (b->val.i == 127 && sign != 0)) {
+ 		if (highcharbits && (highcharbits > 0 || signedchars < 0))
+ 		    a = makeexpr_bin(EK_BAND, a->val.type, eatcasts(a),
+ 				     makeexpr_long(255));
+ 		else
+ 		    a = force_unsigned(a);
+ 	    }
+ 	}
+     } else if (a->val.type->kind == TK_STRING &&
+                b->val.type->kind == TK_STRING) {
+         if (b->kind == EK_CONST && b->val.i == 0 && !sign) {
+             a = makeexpr_hat(a, 0);
+             b = makeexpr_char(0);      /* "a = ''" => "*a == 0" */
+         } else {
+             a = makeexpr_bicall_2("strcmp", tp_int, a, b);
+             b = makeexpr_long(0);
+         }
+     } else if ((a->val.type->kind == TK_ARRAY ||
+ 		a->val.type->kind == TK_STRING ||
+ 		a->val.type->kind == TK_RECORD) &&
+ 	       (b->val.type->kind == TK_ARRAY ||
+ 		b->val.type->kind == TK_STRING ||
+ 		b->val.type->kind == TK_RECORD)) {
+         if (a->val.type->kind == TK_ARRAY) {
+             if (b->val.type->kind == TK_ARRAY) {
+                 ex = makeexpr_sizeof(copyexpr(a), 0);
+                 ex2 = makeexpr_sizeof(copyexpr(b), 0);
+                 if (!exprsame(ex, ex2, 1))
+                     warning("Incompatible array sizes [164]");
+                 freeexpr(ex2);
+             } else {
+                 ex = makeexpr_sizeof(copyexpr(a), 0);
+             }
+         } else
+             ex = makeexpr_sizeof(copyexpr(b), 0);
+ 	name = (usestrncmp &&
+ 		a->val.type->kind == TK_ARRAY &&
+ 		a->val.type->basetype->kind == TK_CHAR) ? "strncmp" : "memcmp";
+         a = makeexpr_bicall_3(name, tp_int,
+ 			      makeexpr_addr(a),
+ 			      makeexpr_addr(b), ex);
+         b = makeexpr_long(0);
+     } else if (a->val.type->kind == TK_SET ||
+                a->val.type->kind == TK_SMALLSET) {
+         if (rel == EK_GE) {
+             swapexprs(a, b);
+             rel = EK_LE;
+         }
+         if (mixsets(&a, &b)->kind == TK_SMALLSET) {
+             if (rel == EK_LE) {
+                 a = makeexpr_bin(EK_BAND, tp_integer,
+                                  a, makeexpr_un(EK_BNOT, tp_integer, b));
+                 b = makeexpr_long(0);
+                 rel = EK_EQ;
+             }
+         } else if (b->kind == EK_BICALL &&
+                    !strcmp(b->val.s, setexpandname) &&
+                    (mp = istempvar(b->args[0])) != NULL &&
+                    checkconst(b->args[1], 0)) {
+             canceltempvar(mp);
+             a = makeexpr_hat(a, 0);
+             b = grabarg(b, 1);
+             if (rel == EK_LE)
+                 rel = EK_EQ;
+         } else {
+             ex = makeexpr_bicall_2((rel == EK_LE) ? subsetname : setequalname,
+                                    tp_boolean, a, b);
+             return (rel == EK_NE) ? makeexpr_not(ex) : ex;
+         }
+     } else if (a->val.type->kind == TK_PROCPTR ||
+ 	       a->val.type->kind == TK_CPROCPTR) {
+         /* we compare proc only (not link) -- same as Pascal compiler! */
+ 	if (a->val.type->kind == TK_PROCPTR)
+ 	    a = makeexpr_dotq(a, "proc", tp_anyptr);
+         if ((mp = istempprocptr(b)) != NULL) {
+             canceltempvar(mp);
+ 	    b = grabarg(grabarg(b, 0), 1);
+             if (!voidstar)
+                 b = makeexpr_cast(b, tp_anyptr);
+         } else if (b->val.type->kind == TK_PROCPTR)
+             b = makeexpr_dotq(b, "proc", tp_anyptr);
+     }
+     return makeexpr_bin(rel, tp_boolean, a, b);
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_and(a, b)
+ Expr *a, *b;
+ {
+     Expr *ex, **exp, *low;
+ 
+     if (!a)
+         return b;
+     if (!b)
+         return a;
+     for (exp = &a; (ex = *exp)->kind == EK_AND; exp = &ex->args[1]) ;
+     if ((b->kind == EK_LT || b->kind == EK_LE) &&
+         ((ex->kind == EK_LE && exprsame(ex->args[1], b->args[0], 1)) ||
+          (ex->kind == EK_GE && exprsame(ex->args[0], b->args[0], 1)))) {
+         low = (ex->kind == EK_LE) ? ex->args[0] : ex->args[1];
+         if (unsignedtrick && checkconst(low, 0)) {
+             freeexpr(ex);
+             b->args[0] = force_unsigned(b->args[0]);
+             *exp = b;
+             return a;
+         }
+         if (b->args[1]->val.type->kind == TK_CHAR && useisalpha) {
+             if (checkconst(low, 'A') && checkconst(b->args[1], 'Z')) {
+                 freeexpr(ex);
+                 *exp = makeexpr_bicall_1("isupper", tp_boolean, grabarg(b, 0));
+                 return a;
+             }
+             if (checkconst(low, 'a') && checkconst(b->args[1], 'z')) {
+                 freeexpr(ex);
+                 *exp = makeexpr_bicall_1("islower", tp_boolean, grabarg(b, 0));
+                 return a;
+             }
+             if (checkconst(low, '0') && checkconst(b->args[1], '9')) {
+                 freeexpr(ex);
+                 *exp = makeexpr_bicall_1("isdigit", tp_boolean, grabarg(b, 0));
+                 return a;
+             }
+         }
+     }
+     return makeexpr_bin(EK_AND, tp_boolean, a, b);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_or(a, b)
+ Expr *a, *b;
+ {
+     Expr *ex, **exp, *low;
+ 
+     if (!a)
+         return b;
+     if (!b)
+         return a;
+     for (exp = &a; (ex = *exp)->kind == EK_OR; exp = &ex->args[1]) ;
+     if (((b->kind == EK_BICALL && !strcmp(b->val.s, "isdigit") &&
+           ex->kind == EK_BICALL && !strcmp(ex->val.s, "isalpha")) ||
+          (b->kind == EK_BICALL && !strcmp(b->val.s, "isalpha") &&
+           ex->kind == EK_BICALL && !strcmp(ex->val.s, "isdigit"))) &&
+         exprsame(ex->args[0], b->args[0], 1)) {
+         strchange(&ex->val.s, "isalnum");
+         freeexpr(b);
+         return a;
+     }
+     if (((b->kind == EK_BICALL && !strcmp(b->val.s, "islower") &&
+           ex->kind == EK_BICALL && !strcmp(ex->val.s, "isupper")) ||
+          (b->kind == EK_BICALL && !strcmp(b->val.s, "isupper") &&
+           ex->kind == EK_BICALL && !strcmp(ex->val.s, "islower"))) &&
+         exprsame(ex->args[0], b->args[0], 1)) {
+         strchange(&ex->val.s, "isalpha");
+         freeexpr(b);
+         return a;
+     }
+     if ((b->kind == EK_GT || b->kind == EK_GE) &&
+         ((ex->kind == EK_GT && exprsame(ex->args[1], b->args[0], 1)) ||
+          (ex->kind == EK_LT && exprsame(ex->args[0], b->args[0], 1)))) {
+         low = (ex->kind == EK_GT) ? ex->args[0] : ex->args[1];
+         if (unsignedtrick && checkconst(low, 0)) {
+             freeexpr(ex);
+             b->args[0] = force_unsigned(b->args[0]);
+             *exp = b;
+             return a;
+         }
+     }
+     return makeexpr_bin(EK_OR, tp_boolean, a, b);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_range(ex, exlow, exhigh, higheq)
+ Expr *ex, *exlow, *exhigh;
+ int higheq;
+ {
+     Expr *ex2;
+     enum exprkind rel = (higheq) ? EK_LE : EK_LT;
+ 
+     if (exprsame(exlow, exhigh, 1) && higheq)
+         return makeexpr_rel(EK_EQ, ex, exlow);
+     ex2 = makeexpr_rel(rel, copyexpr(ex), exhigh);
+     if (lelerange)
+         return makeexpr_and(makeexpr_rel(EK_LE, exlow, ex), ex2);
+     else
+         return makeexpr_and(makeexpr_rel(EK_GE, ex, exlow), ex2);
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_cond(c, a, b)
+ Expr *c, *a, *b;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_COND, 3);
+     ex->val.type = a->val.type;
+     ex->args[0] = c;
+     ex->args[1] = a;
+     ex->args[2] = b;
+     if (debug>2) { fprintf(outf,"makeexpr_cond returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ int expr_is_lvalue(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+             return (mp->kind == MK_VAR || mp->kind == MK_PARAM ||
+ 		    mp->kind == MK_VARPARAM ||
+                     (mp->kind == MK_CONST &&
+                      (mp->type->kind == TK_ARRAY ||
+                       mp->type->kind == TK_RECORD ||
+                       mp->type->kind == TK_SET)));
+ 
+         case EK_HAT:
+         case EK_NAME:
+             return 1;
+ 
+         case EK_INDEX:
+ 	case EK_DOT:
+ 	    return expr_is_lvalue(ex->args[0]);
+ 
+ 	case EK_COMMA:
+ 	    return expr_is_lvalue(ex->args[ex->nargs-1]);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ int expr_has_address(ex)
+ Expr *ex;
+ {
+     if (ex->kind == EK_DOT &&
+ 	((Meaning *)ex->val.i)->val.i)
+ 	return 0;    /* bit fields do not have an address */
+     return expr_is_lvalue(ex);
+ }
+ 
+ 
+ 
+ Expr *checknil(ex)
+ Expr *ex;
+ {
+     if (nilcheck == 1) {
+         if (singlevar(ex)) {
+             ex = makeexpr_un(EK_CHECKNIL, ex->val.type, ex);
+         } else {
+             ex = makeexpr_bin(EK_CHECKNIL, ex->val.type, ex,
+                               makeexpr_var(makestmttempvar(ex->val.type,
+                                                            name_PTR)));
+         }
+     }
+     return ex;
+ }
+ 
+ 
+ int checkvarinlists(yes, no, def, mp)
+ Strlist *yes, *no;
+ int def;
+ Meaning *mp;
+ {
+     char *cp;
+     Meaning *ctx;
+ 
+     if (mp->kind == MK_FIELD)
+ 	ctx = mp->rectype->meaning;
+     else
+ 	ctx = mp->ctx;
+     if (ctx && ctx->name)
+ 	cp = format_ss("%s.%s", ctx->name, mp->name);
+     else
+ 	cp = NULL;
+     if (strlist_cifind(yes, cp))
+ 	return 1;
+     if (strlist_cifind(no, cp))
+ 	return 0;
+     if (strlist_cifind(yes, mp->name))
+ 	return 1;
+     if (strlist_cifind(no, mp->name))
+ 	return 0;
+     if (strlist_cifind(yes, "1"))
+ 	return 1;
+     if (strlist_cifind(no, "1"))
+ 	return 0;
+     return def;
+ }
+ 
+ 
+ void requirefilebuffer(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (!isfiletype(ex->val.type, 0))
+ 	return;
+     mp = isfilevar(ex);
+     if (!mp) {
+ 	if (ex->kind == EK_HAT)
+ 	    ex = ex->args[0];
+ 	if (ex->kind == EK_VAR) {
+ 	    mp = (Meaning *)ex->val.i;
+ 	    if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)
+ 		note(format_s("File parameter %s can't access buffers (try StructFiles = 1) [318]",
+ 			      mp->name));
+ 	}
+     } else if (!mp->bufferedfile &&
+ 	       checkvarinlists(bufferedfiles, unbufferedfiles, 1, mp)) {
+ 	if (mp->wasdeclared)
+ 	    note(format_s("Discovered too late that %s should be buffered [143]",
+ 			  mp->name));
+ 	mp->bufferedfile = 1;
+     }
+ }
+ 
+ 
+ Expr *makeexpr_hat(a, check)
+ Expr *a;
+ int check;
+ {
+     Expr *ex;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_hat("); dumpexpr(a); fprintf(outf,")\n"); }
+     if (isfiletype(a->val.type, -1)) {
+ 	requirefilebuffer(a);
+ 	if (*chargetfbufname &&
+ 	    filebasetype(a->val.type)->kind == TK_CHAR)
+ 	    return makeexpr_bicall_1(chargetfbufname,
+ 				     filebasetype(a->val.type),
+ 				     filebasename(a));
+ 	else if (*arraygetfbufname &&
+ 		 filebasetype(a->val.type)->kind == TK_ARRAY)
+ 	    return makeexpr_bicall_2(arraygetfbufname,
+ 				     filebasetype(a->val.type),
+ 				     filebasename(a),
+ 				     makeexpr_type(filebasetype(a->val.type)));
+ 	else
+ 	    return makeexpr_bicall_2(getfbufname,
+ 				     filebasetype(a->val.type),
+ 				     filebasename(a),
+ 				     makeexpr_type(filebasetype(a->val.type)));
+     }
+     if (a->kind == EK_PLUS &&
+                (ex = a->args[0])->val.type->kind == TK_POINTER &&
+                (ex->val.type->basetype->kind == TK_ARRAY ||
+                 ex->val.type->basetype->kind == TK_STRING ||
+                 ex->val.type->basetype->kind == TK_SET)) {
+         ex->val.type = ex->val.type->basetype;   /* convert *(a+n) to a[n] */
+         deletearg(&a, 0);
+         if (a->nargs == 1)
+             a = grabarg(a, 0);
+         return makeexpr_bin(EK_INDEX, ex->val.type->basetype, ex, a);
+     }
+     if (a->val.type->kind == TK_STRING ||
+         a->val.type->kind == TK_ARRAY ||
+         a->val.type->kind == TK_SET) {
+         if (starindex == 0)
+             return makeexpr_bin(EK_INDEX, a->val.type->basetype, a, makeexpr_long(0));
+         else
+             return makeexpr_un(EK_HAT, a->val.type->basetype, a);
+     }
+     if (a->val.type->kind != TK_POINTER || !a->val.type->basetype) {
+         warning("bad pointer dereference [165]");
+         return a;
+     }
+     if (a->kind == EK_CAST &&
+ 	a->val.type->basetype->kind == TK_POINTER &&
+ 	a->args[0]->val.type->kind == TK_POINTER &&
+ 	a->args[0]->val.type->basetype->kind == TK_POINTER) {
+ 	return makeexpr_cast(makeexpr_hat(a->args[0], 0),
+ 			     a->val.type->basetype);
+     }
+     switch (a->val.type->basetype->kind) {
+ 
+       case TK_ARRAY:
+       case TK_STRING:
+       case TK_SET:
+ 	if (a->kind != EK_HAT || 1 ||
+ 	    a->val.type == a->args[0]->val.type->basetype) {
+ 	    a->val.type = a->val.type->basetype;
+ 	    return a;
+ 	}
+ 
+       default:
+ 	if (a->kind == EK_ADDR) {
+ 	    ex = a->args[0];
+ 	    FREE(a);
+ 	    return ex;
+ 	} else {
+ 	    if (check)
+ 		ex = checknil(a);
+ 	    else
+ 		ex = a;
+ 	    return makeexpr_un(EK_HAT, a->val.type->basetype, ex);
+         }
+     }
+ }
+ 
+ 
+ 
+ Expr *un_sign_extend(a)
+ Expr *a;
+ {
+     if (a->kind == EK_BICALL &&
+         !strcmp(a->val.s, signextname) && *signextname) {
+         return grabarg(a, 0);
+     }
+     return a;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_addr(a)
+ Expr *a;
+ {
+     Expr *ex;
+     Type *type;
+     Meaning *mp;
+ 
+     a = un_sign_extend(a);
+     type = makepointertype(a->val.type);
+     if (debug>2) { fprintf(outf,"makeexpr_addr("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+     if (a->kind == EK_CONST && a->val.type->kind == TK_STRING) {
+         return a;     /* kludge to help assignments */
+     } else if (a->kind == EK_INDEX &&
+ 	       (a->val.type->kind != TK_ARRAY &&
+ 		a->val.type->kind != TK_SET &&
+ 		a->val.type->kind != TK_STRING) &&
+ 	       (addindex == 1 ||
+ 		(addindex != 0 && checkconst(a->args[1], 0)))) {
+         ex = makeexpr_plus(makeexpr_addr(a->args[0]), a->args[1]);
+         FREE(a);
+         ex->val.type = type;
+         return ex;
+     } else if (a->kind == EK_CAST) {
+ 	return makeexpr_cast(makeexpr_addr(a->args[0]), type);
+     } else if (a->kind == EK_ACTCAST) {
+ 	return makeexpr_actcast(makeexpr_addr(a->args[0]), type);
+     } else if (a->kind == EK_LITCAST) {
+ 	if (a->args[0]->kind == EK_NAME) {
+ 	    if (my_strchr(a->args[0]->val.s, '(') ||
+ 		my_strchr(a->args[0]->val.s, '['))
+ 		note("Constructing pointer type by adding '*' may be incorrect [322]");
+ 	    return makeexpr_bin(EK_LITCAST, tp_integer,
+ 				makeexpr_name(format_s("%s*",
+ 						       a->args[0]->val.s),
+ 					      tp_integer),
+ 				makeexpr_addr(a->args[1]));
+ 	} else
+ 	    return makeexpr_bin(EK_LITCAST, tp_integer, makeexpr_type(type),
+ 				makeexpr_addr(a->args[1]));
+     } else {
+         switch (a->val.type->kind) {
+ 
+ 	  case TK_ARRAY:
+ 	  case TK_STRING:
+ 	  case TK_SET:
+ 	    if (a->val.type->smin) {
+ 		return makeexpr_un(EK_ADDR, type,
+ 				   makeexpr_index(a,
+ 						  copyexpr(a->val.type->smin),
+ 						  NULL));
+ 	    }
+ 	    a->val.type = type;
+ 	    return a;
+ 
+ 	  default:
+ 	    if (a->kind == EK_HAT) {
+ 		ex = a->args[0];
+ 		FREE(a);
+ 		return ex;
+ 	    } else if (a->kind == EK_ACTCAST)
+ 		return makeexpr_actcast(makeexpr_addr(grabarg(a, 0)), type);
+ 	    else if (a->kind == EK_CAST)
+ 		return makeexpr_cast(makeexpr_addr(grabarg(a, 0)), type);
+ 	    else {
+ 		if (a->kind == EK_VAR &&
+ 		    (mp = (Meaning *)a->val.i)->kind == MK_PARAM &&
+ 		    mp->type != promote_type(mp->type) &&
+ 		    fixpromotedargs) {
+ 		    note(format_s("Taking & of possibly promoted param %s [324]",
+ 				  mp->name));
+ 		    if (fixpromotedargs == 1) {
+ 			mp->varstructflag = 1;
+ 			mp->ctx->varstructflag = 1;
+ 		    }
+ 		}
+ 		return makeexpr_un(EK_ADDR, type, a);
+ 	    }
+ 	}
+     }
+ }
+ 
+ 
+ 
+ Expr *makeexpr_addrstr(a)
+ Expr *a;
+ {
+     if (debug>2) { fprintf(outf,"makeexpr_addrstr("); dumpexpr(a); fprintf(outf,")\n"); }
+     if (a->val.type->kind == TK_POINTER)
+ 	return a;
+     return makeexpr_addr(a);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_addrf(a)
+ Expr *a;
+ {
+     Meaning *mp, *tvar;
+ 
+     mp = (Meaning *)a->val.i;
+     if (is_std_file(a)) {
+         if (addrstdfiles == 0) {
+             note(format_s("Taking address of %s; consider setting VarFiles = 0 [144]",
+                           (a->kind == EK_VAR) ? ((Meaning *)a->val.i)->name
+                                               : a->val.s));
+             tvar = makestmttempvar(tp_text, name_TEMP);
+             return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), a),
+                                   makeexpr_addr(makeexpr_var(tvar)));
+         }
+     }
+     if ((a->kind == EK_VAR &&
+          mp->kind == MK_FIELD && mp->val.i) ||
+         (a->kind == EK_BICALL &&
+          !strcmp(a->val.s, getbitsname))) {
+         warning("Can't take the address of a bit-field [166]");
+     }
+     return makeexpr_addr(a);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_index(a, b, offset)
+ Expr *a, *b, *offset;
+ {
+     Type *indextype, *btype;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_index("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b);
+                                                                  fprintf(outf,", "); dumpexpr(offset); fprintf(outf,")\n"); }
+     indextype = (a->val.type->kind == TK_ARRAY) ? a->val.type->indextype
+                                                 : tp_integer;
+     b = gentle_cast(b, indextype);
+     if (!offset)
+         offset = makeexpr_long(0);
+     b = makeexpr_minus(b, gentle_cast(offset, indextype));
+     btype = a->val.type;
+     if (btype->basetype)
+ 	btype = btype->basetype;
+     if (checkconst(b, 0) && starindex == 1)
+         return makeexpr_un(EK_HAT, btype, a);
+     else
+         return makeexpr_bin(EK_INDEX, btype, a,
+                             gentle_cast(b, indextype));
+ }
+ 
+ 
+ 
+ Expr *makeexpr_type(type)
+ Type *type;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_TYPENAME, 0);
+     ex->val.type = type;
+     return ex;
+ }
+ 
+ 
+ Expr *makeexpr_sizeof(ex, incskipped)
+ Expr *ex;
+ int incskipped;
+ {
+     Expr *ex2, *ex3;
+     Type *btype;
+     char *name;
+ 
+     if (ex->val.type->meaning) {
+ 	name = find_special_variant(ex->val.type->meaning->name,
+ 				    "SpecialSizeOf", specialsizeofs, 1);
+ 	if (name) {
+ 	    freeexpr(ex);
+ 	    return pc_expr_str(name);
+ 	}
+     }
+     switch (ex->val.type->kind) {
+ 
+         case TK_CHAR:
+         case TK_BOOLEAN:
+             freeexpr(ex);
+             return makeexpr_long(1);
+ 
+         case TK_SUBR:
+ 	    btype = findbasetype(ex->val.type, ODECL_NOPRES);
+ 	    if (btype->kind == TK_CHAR || btype == tp_abyte) {
+ 		freeexpr(ex);
+ 		return makeexpr_long(1);
+ 	    }
+ 	    break;
+ 
+         case TK_STRING:
+         case TK_ARRAY:
+             if (!ex->val.type->meaning || ex->val.type->kind == TK_STRING ||
+ 		(!incskipped && ex->val.type->smin)) {
+                 ex3 = arraysize(ex->val.type, incskipped);
+                 return makeexpr_times(ex3,
+                                       makeexpr_sizeof(makeexpr_type(
+                                            ex->val.type->basetype), 1));
+             }
+             break;
+ 
+         case TK_SET:
+             ord_range_expr(ex->val.type->indextype, NULL, &ex2);
+             freeexpr(ex);
+             return makeexpr_times(makeexpr_plus(makeexpr_div(copyexpr(ex2),
+                                                              makeexpr_setbits()),
+                                                 makeexpr_long(2)),
+                                   makeexpr_sizeof(makeexpr_type(tp_integer), 0));
+ 
+ 	default:
+ 	    break;
+     }
+     if (ex->kind != EK_CONST &&
+         (findbasetype(ex->val.type,0)->meaning || /* if type has a name... */
+          ex->val.type->kind == TK_STRING ||       /* if C sizeof(expr) will give wrong answer */
+          ex->val.type->kind == TK_ARRAY ||
+          ex->val.type->kind == TK_SET)) {
+         ex2 = makeexpr_type(ex->val.type);
+         freeexpr(ex);
+         ex = ex2;
+     }
+     return makeexpr_un(EK_SIZEOF, tp_integer, ex);
+ }
+ 
+ 
+ 
+ 
+ /* Compute a measure of how fast or slow the expression is likely to be.
+    0 is a constant, 1 is a variable, extra points added per "operation". */
+ 
+ int exprspeed(ex)
+ Expr *ex;
+ {
+     Meaning *mp, *mp2;
+     int i, cost, speed;
+ 
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+             if (mp->kind == MK_CONST)
+                 return 0;
+             if (!mp->ctx || mp->ctx->kind == MK_FUNCTION)
+                 return 1;
+             i = 1;
+             for (mp2 = curctx; mp2 && mp2 != mp->ctx; mp2 = mp2->ctx)
+                 i++;    /* cost of following static links */
+             return (i);
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+         case EK_SIZEOF:
+             return 0;
+ 
+         case EK_ADDR:
+             speed = exprspeed(ex->args[0]);
+             return (speed > 1) ? speed : 0;
+ 
+         case EK_DOT:
+             return exprspeed(ex->args[0]);
+ 
+         case EK_NEG:
+             return exprspeed(ex->args[0]) + 1;
+ 
+         case EK_CAST:
+         case EK_ACTCAST:
+             i = (ord_type(ex->val.type)->kind == TK_REAL) !=
+                 (ord_type(ex->args[0]->val.type)->kind == TK_REAL);
+             return (i + exprspeed(ex->args[0]));
+ 
+         case EK_COND:
+             return 2 + exprspeed(ex->args[0]) +
+                    MAX(exprspeed(ex->args[1]), exprspeed(ex->args[2]));
+ 
+         case EK_AND:
+         case EK_OR:
+         case EK_COMMA:
+             speed = 2;
+             for (i = 0; i < ex->nargs; i++)
+                 speed += exprspeed(ex->args[i]);
+             return speed;
+ 
+         case EK_FUNCTION:
+         case EK_BICALL:
+         case EK_SPCALL:
+             return 1000;
+ 
+         case EK_ASSIGN:
+         case EK_POSTINC:
+         case EK_POSTDEC:
+             return 100 + exprspeed(ex->args[0]) + exprspeed(ex->args[1]);
+ 
+         default:
+             cost = (ex->kind == EK_PLUS) ? 1 : 2;
+             if (ex->val.type->kind == TK_REAL)
+                 cost *= 2;
+             speed = -cost;
+             for (i = 0; i < ex->nargs; i++) {
+                 if (!isliteralconst(ex->args[i], NULL) ||
+                     ex->val.type->kind == TK_REAL)
+                     speed += exprspeed(ex->args[i]) + cost;
+             }
+             return MAX(speed, 0);
+     }
+ }
+ 
+ 
+ 
+ 
+ int noargdependencies(ex, vars)
+ Expr *ex;
+ int vars;
+ {
+     int i;
+ 
+     for (i = 0; i < ex->nargs; i++) {
+         if (!nodependencies(ex->args[i], vars))
+             return 0;
+     }
+     return 1;
+ }
+ 
+ 
+ int nodependencies(ex, vars)
+ Expr *ex;
+ int vars;   /* 1 if explicit dependencies on vars count as dependencies */
+ {           /* 2 if global but not local vars count as dependencies */
+     Meaning *mp;
+ 
+     if (debug>2) { fprintf(outf,"nodependencies("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (!noargdependencies(ex, vars))
+         return 0;
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+ 	    if (mp->kind == MK_CONST)
+ 		return 1;
+ 	    if (vars == 2 &&
+ 		mp->ctx == curctx &&
+ 		mp->ctx->kind == MK_FUNCTION &&
+ 		!mp->varstructflag)
+ 		return 1;
+             return (mp->kind == MK_CONST ||
+ 		    (!vars &&
+ 		     (mp->kind == MK_VAR || mp->kind == MK_VARREF ||
+ 		      mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)));
+ 
+         case EK_BICALL:
+             return nosideeffects_func(ex);
+ 
+         case EK_FUNCTION:
+         case EK_SPCALL:
+         case EK_ASSIGN:
+         case EK_POSTINC:
+         case EK_POSTDEC:
+         case EK_HAT:
+         case EK_INDEX:
+             return 0;
+ 
+         default:
+             return 1;
+     }
+ }
+ 
+ 
+ 
+ int exprdependsvar(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+     int i;
+ 
+     i = ex->nargs;
+     while (--i >= 0)
+ 	if (exprdependsvar(ex->args[i], mp))
+ 	    return 1;
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+ 	    return ((Meaning *)ex->val.i == mp);
+ 
+ 	case EK_BICALL:
+ 	    if (nodependencies(ex, 1))
+ 		return 0;
+ 
+ 	/* fall through */
+ 	case EK_FUNCTION:
+ 	case EK_SPCALL:
+ 	    return (mp->ctx != curctx ||
+ 		    mp->ctx->kind != MK_FUNCTION ||
+ 		    mp->varstructflag);
+ 
+ 	case EK_HAT:
+ 	    return 1;
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ int exprdepends(ex, ex2)
+ Expr *ex, *ex2;     /* Expression ex somehow depends on value of ex2 */
+ {
+     switch (ex2->kind) {
+ 
+         case EK_VAR:
+ 	    return exprdependsvar(ex, (Meaning *)ex2->val.i);
+ 
+ 	case EK_CONST:
+ 	case EK_LONGCONST:
+ 	    return 0;
+ 
+ 	case EK_INDEX:
+ 	case EK_DOT:
+ 	    return exprdepends(ex, ex2->args[0]);
+ 
+ 	default:
+ 	    return !nodependencies(ex, 1);
+     }
+ }
+ 
+ 
+ int nosideeffects_func(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Symbol *sp;
+ 
+     switch (ex->kind) {
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)ex->val.i;
+             sp = findsymbol_opt(mp->name);
+             return sp && (sp->flags & (NOSIDEEFF|DETERMF));
+ 
+         case EK_BICALL:
+             sp = findsymbol_opt(ex->val.s);
+             return sp && (sp->flags & (NOSIDEEFF|DETERMF));
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ int deterministic_func(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Symbol *sp;
+ 
+     switch (ex->kind) {
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)ex->val.i;
+             sp = findsymbol_opt(mp->name);
+             return sp && (sp->flags & DETERMF);
+ 
+         case EK_BICALL:
+             sp = findsymbol_opt(ex->val.s);
+             return sp && (sp->flags & DETERMF);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ 
+ int noargsideeffects(ex, mode)
+ Expr *ex;
+ int mode;
+ {
+     int i;
+ 
+     for (i = 0; i < ex->nargs; i++) {
+         if (!nosideeffects(ex->args[i], mode))
+             return 0;
+     }
+     return 1;
+ }
+ 
+ 
+ /* mode=0: liberal about bicall's: safe unless sideeffects_bicall() */
+ /* mode=1: conservative about bicall's: must be explicitly NOSIDEEFF */
+ 
+ int nosideeffects(ex, mode)
+ Expr *ex;
+ int mode;
+ {
+     if (debug>2) { fprintf(outf,"nosideeffects("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (!noargsideeffects(ex, mode))
+         return 0;
+     switch (ex->kind) {
+ 
+         case EK_BICALL:
+             if (mode == 0)
+                 return !sideeffects_bicall(ex->val.s);
+ 
+         /* fall through */
+         case EK_FUNCTION:
+             return nosideeffects_func(ex);
+ 
+         case EK_SPCALL:
+         case EK_ASSIGN:
+         case EK_POSTINC:
+         case EK_POSTDEC:
+             return 0;
+ 
+         default:
+             return 1;
+     }
+ }
+ 
+ 
+ 
+ int exproccurs(ex, ex2)
+ Expr *ex, *ex2;
+ {
+     int i, count = 0;
+ 
+     if (debug>2) { fprintf(outf,"exproccurs("); dumpexpr(ex); fprintf(outf,", "); dumpexpr(ex2); fprintf(outf,")\n"); }
+     for (i = 0; i < ex->nargs; i++)
+         count += exproccurs(ex->args[i], ex2);
+     if (exprsame(ex, ex2, 0))
+         count++;
+     return count;
+ }
+ 
+ 
+ 
+ Expr *singlevar(ex)
+ Expr *ex;
+ {
+     if (debug>2) { fprintf(outf,"singlevar("); dumpexpr(ex); fprintf(outf,")\n"); }
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+         case EK_MACARG:
+             return ex;
+ 
+         case EK_HAT:
+         case EK_ADDR:
+         case EK_DOT:
+             return singlevar(ex->args[0]);
+ 
+         case EK_INDEX:
+ #if 0
+             if (!nodependencies(ex->args[1], 1))
+                 return NULL;
+ #endif
+             return singlevar(ex->args[0]);
+ 
+ 	default:
+ 	    return NULL;
+     }
+ }
+ 
+ 
+ 
+ /* Is "ex" a function which takes a return buffer pointer as its
+    first argument, and returns a copy of that pointer? */
+ 
+ int structuredfunc(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Symbol *sp;
+ 
+     if (debug>2) { fprintf(outf,"structuredfunc("); dumpexpr(ex); fprintf(outf,")\n"); }
+     switch (ex->kind) {
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)ex->val.i;
+             if (mp->isfunction && mp->cbase && mp->cbase->kind == MK_VARPARAM)
+                 return 1;
+             sp = findsymbol_opt(mp->name);
+             return sp && (sp->flags & (STRUCTF|STRLAPF));
+ 
+         case EK_BICALL:
+             sp = findsymbol_opt(ex->val.s);
+             return sp && (sp->flags & (STRUCTF|STRLAPF));
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ 
+ int strlapfunc(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Symbol *sp;
+ 
+     switch (ex->kind) {
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)ex->val.i;
+             sp = findsymbol_opt(mp->name);
+             return sp && (sp->flags & STRLAPF);
+ 
+         case EK_BICALL:
+             sp = findsymbol_opt(ex->val.s);
+             return sp && (sp->flags & STRLAPF);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ Meaning *istempvar(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (debug>2) { fprintf(outf,"istempvar("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (ex->kind == EK_VAR) {
+         mp = (Meaning *)ex->val.i;
+         if (mp->istemporary)
+             return mp;
+         else
+             return NULL;
+     }
+     return NULL;
+ }
+ 
+ 
+ Meaning *totempvar(ex)
+ Expr *ex;
+ {
+     while (structuredfunc(ex))
+ 	ex = ex->args[0];
+     return istempvar(ex);
+ }
+ 
+ 
+ 
+ Meaning *isretvar(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+ 
+     if (debug>2) { fprintf(outf,"isretvar("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (ex->kind == EK_HAT)
+         ex = ex->args[0];
+     if (ex->kind == EK_VAR) {
+         mp = (Meaning *)ex->val.i;
+         if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
+             mp->ctx->isfunction && mp == mp->ctx->cbase)
+             return mp;
+         else
+             return NULL;
+     }
+     return NULL;
+ }
+ 
+ 
+ 
+ Expr *bumpstring(ex, index, offset)
+ Expr *ex, *index;
+ int offset;
+ {
+     if (checkconst(index, offset)) {
+         freeexpr(index);
+         return ex;
+     }
+     if (addindex != 0)
+         ex = makeexpr_plus(makeexpr_addrstr(ex),
+ 			   makeexpr_minus(index, makeexpr_long(offset)));
+     else
+         ex = makeexpr_addr(makeexpr_index(ex, index, makeexpr_long(offset)));
+     ex->val.type = tp_str255;
+     return ex;
+ }
+ 
+ 
+ 
+ long po2m1(n)
+ int n;
+ {
+     if (n == 32)
+         return -1;
+     else if (n == 31)
+         return 0x7fffffff;
+     else
+         return (1<<n) - 1;
+ }
+ 
+ 
+ 
+ int isarithkind(kind)
+ enum exprkind kind;
+ {
+     return (kind == EK_EQ || kind == EK_LT || kind == EK_GT ||
+ 	    kind == EK_NE || kind == EK_LE || kind == EK_GE ||
+ 	    kind == EK_PLUS || kind == EK_TIMES || kind == EK_DIVIDE ||
+ 	    kind == EK_DIV || kind == EK_MOD || kind == EK_NEG ||
+ 	    kind == EK_AND || kind == EK_OR || kind == EK_NOT ||
+ 	    kind == EK_BAND || kind == EK_BOR || kind == EK_BXOR ||
+ 	    kind == EK_LSH || kind == EK_RSH || kind == EK_BNOT ||
+ 	    kind == EK_FUNCTION || kind == EK_BICALL);
+ }
+ 
+ 
+ Expr *makeexpr_assign(a, b)
+ Expr *a, *b;
+ {
+     int i, j;
+     Expr *ex, *ex2, *ex3, **ep;
+     Meaning *mp;
+     Type *tp;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_assign("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (stringtrunclimit > 0 &&
+ 	a->val.type->kind == TK_STRING &&
+ 	(i = strmax(a)) <= stringtrunclimit &&
+ 	strmax(b) > i) {
+ 	note("Possible string truncation in assignment [145]");
+     }
+     a = un_sign_extend(a);
+     b = gentle_cast(b, a->val.type);
+     if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
+          (mp = istempvar(b->args[0])) != NULL &&
+          b->nargs >= 2 &&
+          b->args[1]->kind == EK_CONST &&              /* all this handles string appending */
+          b->args[1]->val.i > 2 &&                     /*   of the form, "s := s + ..." */
+          !strncmp(b->args[1]->val.s, "%s", 2) &&
+          exprsame(a, b->args[2], 1) &&
+          nosideeffects(a, 0) &&
+          (ex = singlevar(a)) != NULL) {
+         ex2 = copyexpr(b);
+         delfreearg(&ex2, 2);
+         freeexpr(ex2->args[1]);
+         ex2->args[1] = makeexpr_lstring(b->args[1]->val.s+2,
+                                         b->args[1]->val.i-2);
+         if (/*(ex = singlevar(a)) != NULL && */
+            /* noargdependencies(ex2) && */ !exproccurs(ex2, ex)) {
+             freeexpr(b);
+             if (ex2->args[1]->val.i == 2 &&     /* s := s + s2 */
+                 !strncmp(ex2->args[1]->val.s, "%s", 2)) {
+                 canceltempvar(mp);
+ 		tp = ex2->val.type;
+                 return makeexpr_bicall_2("strcat", tp,
+                                          makeexpr_addrstr(a), grabarg(ex2, 2));
+             } else if (sprintflength(ex2, 0) >= 0) {    /* s := s + 's2' */
+ 		tp = ex2->val.type;
+                 return makeexpr_bicall_2("strcat", tp,
+                                          makeexpr_addrstr(a),
+                                          makeexpr_unsprintfify(ex2));
+             } else {                            /* general case */
+                 canceltempvar(mp);
+                 freeexpr(ex2->args[0]);
+                 ex = makeexpr_bicall_1("strlen", tp_int, copyexpr(a));
+                 ex2->args[0] = bumpstring(a, ex, 0);
+                 return ex2;
+             }
+         } else
+             freeexpr(ex2);
+     }
+     if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
+          istempvar(b->args[0]) &&
+          (ex = singlevar(a)) != NULL) {
+         j = -1;     /* does lhs var appear exactly once on rhs? */
+         for (i = 2; i < b->nargs; i++) {
+             if (exprsame(b->args[i], ex, 1) && j < 0)
+                 j = i;
+             else if (exproccurs(b->args[i], ex))
+                 break;
+         }
+         if (i == b->nargs && j > 0) {
+             b->args[j] = makeexpr_bicall_2("strcpy", tp_str255,
+                                            makeexpr_addrstr(b->args[0]),
+                                            makeexpr_addrstr(b->args[j]));
+             b->args[0] = makeexpr_addrstr(a);
+             return b;
+         }
+     }
+     if (structuredfunc(b) && (ex2 = singlevar(a)) != NULL) {
+ 	ep = &b->args[0];
+ 	i = strlapfunc(b);
+ 	while (structuredfunc((ex = *ep))) {
+ 	    i = i && strlapfunc(ex);
+ 	    ep = &ex->args[0];
+ 	}
+ 	if ((mp = istempvar(ex)) != NULL &&
+ 	    (i || !exproccurs(b, ex2))) {
+ 	    canceltempvar(mp);
+ 	    freeexpr(*ep);
+ 	    *ep = makeexpr_addrstr(a);
+ 	    return b;
+ 	}
+     }
+     if (a->val.type->kind == TK_PROCPTR &&
+         (mp = istempprocptr(b)) != NULL &&
+         nosideeffects(a, 0)) {
+         freeexpr(b->args[0]->args[0]->args[0]);
+         b->args[0]->args[0]->args[0] = copyexpr(a);
+ 	if (b->nargs == 3) {
+ 	    freeexpr(b->args[1]->args[0]->args[0]);
+ 	    b->args[1]->args[0]->args[0] = a;
+ 	    delfreearg(&b, 2);
+ 	} else {
+ 	    freeexpr(b->args[1]);
+ 	    b->args[1] = makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
+ 					 makeexpr_nil());
+ 	}
+         canceltempvar(mp);
+         return b;
+     }
+     if (a->val.type->kind == TK_PROCPTR &&
+ 	(b->val.type->kind == TK_CPROCPTR ||
+ 	 checkconst(b, 0))) {
+ 	ex = makeexpr_dotq(copyexpr(a), "proc", tp_anyptr);
+ 	b = makeexpr_comma(makeexpr_assign(ex, b),
+ 			   makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
+ 					   makeexpr_nil()));
+ 	return b;
+     }
+     if (a->val.type->kind == TK_CPROCPTR &&
+ 	(mp = istempprocptr(b)) != NULL &&
+ 	nosideeffects(a, 0)) {
+ 	freeexpr(b->args[0]->args[0]);
+ 	b->args[0]->args[0] = a;
+ 	if (b->nargs == 3)
+ 	    delfreearg(&b, 1);
+ 	delfreearg(&b, 1);
+ 	canceltempvar(mp);
+ 	return b;
+     }
+     if (a->val.type->kind == TK_CPROCPTR &&
+ 	b->val.type->kind == TK_PROCPTR) {
+ 	b = makeexpr_dotq(b, "proc", tp_anyptr);
+     }
+     if (a->val.type->kind == TK_STRING) {
+         if (b->kind == EK_CONST && b->val.i == 0 && !isretvar(a)) {
+                 /* optimizing retvar would mess up "return" optimization */
+             return makeexpr_assign(makeexpr_hat(a, 0),
+                                    makeexpr_char(0));
+         }
+         a = makeexpr_addrstr(a);
+         b = makeexpr_addrstr(b);
+         return makeexpr_bicall_2("strcpy", a->val.type, a, b);
+     }
+     if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen")) {
+         if (b->kind == EK_CAST &&
+              ord_type(b->args[0]->val.type)->kind == TK_INTEGER) {
+             b = grabarg(b, 0);
+         }
+         j = (b->kind == EK_PLUS &&      /* handle "s[0] := xxx" */
+              b->args[0]->kind == EK_BICALL &&
+              !strcmp(b->args[0]->val.s, "strlen") &&
+              exprsame(a->args[0], b->args[0]->args[0], 0) &&
+              isliteralconst(b->args[1], NULL) == 2);
+         if (j && b->args[1]->val.i > 0 &&
+                  b->args[1]->val.i <= 5) {     /* lengthening the string */
+             a = grabarg(a, 0);
+             i = b->args[1]->val.i;
+             freeexpr(b);
+             if (i == 1)
+                 b = makeexpr_string(" ");
+             else
+                 b = makeexpr_lstring("12345", i);
+             return makeexpr_bicall_2("strcat", a->val.type, a, b);
+         } else {      /* maybe shortening the string */
+             if (!j && !isconstexpr(b, NULL))
+                 note("Modification of string length may translate incorrectly [146]");
+             a = grabarg(a, 0);
+             b = makeexpr_ord(b);
+             return makeexpr_assign(makeexpr_index(a, b, NULL),
+                                    makeexpr_char(0));
+         }
+     }
+     if (a->val.type->kind == TK_ARRAY ||
+ 	(a->val.type->kind == TK_PROCPTR && copystructs < 1) ||
+ 	(a->val.type->kind == TK_RECORD &&
+ 	 (copystructs < 1 || a->val.type != b->val.type))) {
+         ex = makeexpr_sizeof(copyexpr(a), 0);
+         ex2 = makeexpr_sizeof(copyexpr(b), 0);
+         if (!exprsame(ex, ex2, 1)) {
+ 	    if (a->val.type->kind == TK_ARRAY &&
+ 		b->val.type->kind == TK_ARRAY &&
+ 		a->val.type->basetype->kind == TK_CHAR &&
+ 		(!ISCONST(ex->kind) || !ISCONST(ex2->kind) ||
+ 		 ex->val.i > ex2->val.i)) {
+ 		ex = makeexpr_arglong(ex, (size_t_long != 0));
+ 		ex2 = makeexpr_arglong(ex2, (size_t_long != 0));
+ 		a = makeexpr_addrstr(a);
+ 		b = makeexpr_addrstr(b);
+ 		b = makeexpr_bicall_3("memcpy", a->val.type,
+ 				      copyexpr(a), b, copyexpr(ex2));
+ 		ex3 = copyexpr(ex2);
+ 		return makeexpr_comma(b,
+ 				      makeexpr_bicall_3("memset", a->val.type,
+ 							makeexpr_plus(a, ex3),
+ 							makeexpr_char(' '),
+ 							makeexpr_minus(ex,
+ 								       ex2)));
+ 	    } else if (!(a->val.type->kind == TK_ARRAY &&
+ 			 b->val.type->kind != TK_ARRAY))
+ 		warning("Incompatible types or sizes [167]");
+ 	}
+         freeexpr(ex2);
+         ex = makeexpr_arglong(ex, (size_t_long != 0));
+         a = makeexpr_addrstr(a);
+         b = makeexpr_addrstr(b);
+         return makeexpr_bicall_3("memcpy", a->val.type, a, b, ex);
+     }
+     if (a->val.type->kind == TK_SET) {
+         a = makeexpr_addrstr(a);
+         b = makeexpr_addrstr(b);
+         return makeexpr_bicall_2(setcopyname, a->val.type, a, b);
+     }
+     for (ep = &a; (ex3 = *ep); ) {
+         if (ex3->kind == EK_COMMA)
+             ep = &ex3->args[ex3->nargs-1];
+         else if (ex3->kind == EK_CAST || ex3->kind == EK_ACTCAST)
+             ep = &ex3->args[0];
+         else
+             break;
+     }
+     if (ex3->kind == EK_BICALL) {
+         if (!strcmp(ex3->val.s, getbitsname)) {
+ 	    tp = ex3->args[0]->val.type;
+ 	    if (tp->kind == TK_ARRAY)
+ 		ex3->args[0] = makeexpr_addr(ex3->args[0]);
+             ex3->val.type = tp_void;
+             if (checkconst(b, 0) && *clrbitsname) {
+                 strchange(&ex3->val.s, clrbitsname);
+             } else if (*putbitsname &&
+                        ((ISCONST(b->kind) &&
+                          (b->val.i | ~((1 << (1 << tp->escale)) - 1)) == -1) ||
+                         checkconst(b, (1 << (1 << tp->escale)) - 1))) {
+                 strchange(&ex3->val.s, putbitsname);
+                 insertarg(ep, 2, makeexpr_arglong(makeexpr_ord(b), 0));
+             } else {
+                 b = makeexpr_arglong(makeexpr_ord(b), 0);
+                 if (*storebitsname) {
+                     strchange(&ex3->val.s, storebitsname);
+                     insertarg(ep, 2, b);
+                 } else {
+                     if (exproccurs(b, ex3->args[0])) {
+                         mp = makestmttempvar(b->val.type, name_TEMP);
+                         ex2 = makeexpr_assign(makeexpr_var(mp), b);
+                         b = makeexpr_var(mp);
+                     } else
+                         ex2 = NULL;
+                     ex = copyexpr(ex3);
+                     strchange(&ex3->val.s, putbitsname);
+                     insertarg(&ex3, 2, b);
+                     strchange(&ex->val.s, clrbitsname);
+                     *ep = makeexpr_comma(ex2, makeexpr_comma(ex, ex3));
+                 }
+             }
+             return a;
+         } else if (!strcmp(ex3->val.s, getfbufname)) {
+ 	    ex3->val.type = tp_void;
+ 	    strchange(&ex3->val.s, putfbufname);
+ 	    insertarg(ep, 2, b);
+ 	    return a;
+         } else if (!strcmp(ex3->val.s, chargetfbufname)) {
+ 	    ex3->val.type = tp_void;
+ 	    if (*charputfbufname) {
+ 		strchange(&ex3->val.s, charputfbufname);
+ 		insertarg(ep, 1, b);
+ 	    } else {
+ 		strchange(&ex3->val.s, putfbufname);
+ 		insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
+ 		insertarg(ep, 2, b);
+ 	    }
+ 	    return a;
+         } else if (!strcmp(ex3->val.s, arraygetfbufname)) {
+ 	    ex3->val.type = tp_void;
+ 	    if (*arrayputfbufname) {
+ 		strchange(&ex3->val.s, arrayputfbufname);
+ 		insertarg(ep, 1, b);
+ 	    } else {
+ 		strchange(&ex3->val.s, putfbufname);
+ 		insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
+ 		insertarg(ep, 2, b);
+ 	    }
+ 	    return a;
+ 	}
+     }
+     while (a->kind == EK_CAST || a->kind == EK_ACTCAST ||
+ 	   a->kind == EK_LITCAST) {
+ 	if (a->kind == EK_LITCAST) {
+ 	    b = makeexpr_cast(b, a->args[1]->val.type);
+ 	    a = grabarg(a, 1);
+ 	} else if (ansiC < 2 ||    /* in GNU C, a cast is an lvalue */
+ 		   isarithkind(a->args[0]->kind) ||
+ 		   (a->val.type->kind == TK_POINTER &&
+ 		    a->args[0]->val.type->kind == TK_POINTER)) {
+ 	    if (a->kind == EK_CAST)
+ 		b = makeexpr_cast(b, a->args[0]->val.type);
+ 	    else
+ 		b = makeexpr_actcast(b, a->args[0]->val.type);
+ 	    a = grabarg(a, 0);
+ 	} else
+ 	    break;
+     }
+     if (a->kind == EK_NEG)
+ 	return makeexpr_assign(grabarg(a, 0), makeexpr_neg(b));
+     if (a->kind == EK_NOT)
+ 	return makeexpr_assign(grabarg(a, 0), makeexpr_not(b));
+     if (a->kind == EK_BNOT)
+ 	return makeexpr_assign(grabarg(a, 0),
+ 			       makeexpr_un(EK_BNOT, b->val.type, b));
+     if (a->kind == EK_PLUS) {
+ 	for (i = 0; i < a->nargs && a->nargs > 1; ) {
+ 	    if (isconstantexpr(a->args[i])) {
+ 		b = makeexpr_minus(b, a->args[i]);
+ 		deletearg(&a, i);
+ 	    } else
+ 		i++;
+ 	}
+ 	if (a->nargs == 1)
+ 	    return makeexpr_assign(grabarg(a, 0), b);
+     }
+     if (a->kind == EK_TIMES) {
+ 	for (i = 0; i < a->nargs && a->nargs > 1; ) {
+ 	    if (isconstantexpr(a->args[i])) {
+ 		if (a->val.type->kind == TK_REAL)
+ 		    b = makeexpr_divide(b, a->args[i]);
+ 		else {
+ 		    if (ISCONST(b->kind) && ISCONST(a->args[i]->kind) &&
+ 			(b->val.i % a->args[i]->val.i) != 0) {
+ 			break;
+ 		    }
+ 		    b = makeexpr_div(b, a->args[i]);
+ 		}
+ 		deletearg(&a, i);
+ 	    } else
+ 		i++;
+ 	}
+ 	if (a->nargs == 1)
+ 	    return makeexpr_assign(grabarg(a, 0), b);
+     }
+     if ((a->kind == EK_DIVIDE || a->kind == EK_DIV) &&
+ 	 isconstantexpr(a->args[1])) {
+ 	b = makeexpr_times(b, a->args[1]);
+ 	return makeexpr_assign(a->args[0], b);
+     }
+     if (a->kind == EK_LSH && isconstantexpr(a->args[1])) {
+ 	if (ISCONST(b->kind) && ISCONST(a->args[1]->kind)) {
+ 	    if ((b->val.i & ((1L << a->args[1]->val.i)-1)) == 0) {
+ 		b->val.i >>= a->args[1]->val.i;
+ 		return makeexpr_assign(grabarg(a, 0), b);
+ 	    }
+ 	} else {
+ 	    b = makeexpr_bin(EK_RSH, b->val.type, b, a->args[1]);
+ 	    return makeexpr_assign(a->args[0], b);
+ 	}
+     }
+     if (a->kind == EK_RSH && isconstantexpr(a->args[1])) {
+ 	if (ISCONST(b->kind) && ISCONST(a->args[1]->kind))
+ 	    b->val.i <<= a->args[1]->val.i;
+ 	else
+ 	    b = makeexpr_bin(EK_LSH, b->val.type, b, a->args[1]);
+ 	return makeexpr_assign(a->args[0], b);
+     }
+     if (isarithkind(a->kind))
+ 	warning("Invalid assignment [168]");
+     return makeexpr_bin(EK_ASSIGN, a->val.type, a, makeexpr_unlongcast(b));
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_comma(a, b)
+ Expr *a, *b;
+ {
+     Type *type;
+ 
+     if (!a || nosideeffects(a, 1))
+         return b;
+     if (!b)
+         return a;
+     type = b->val.type;
+     a = commute(a, b, EK_COMMA);
+     a->val.type = type;
+     return a;
+ }
+ 
+ 
+ 
+ 
+ int strmax(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     long smin, smax;
+     Value val;
+     Type *type;
+ 
+     type = ex->val.type;
+     if (type->kind == TK_POINTER)
+         type = type->basetype;
+     if (type->kind == TK_CHAR)
+         return 1;
+     if (type->kind == TK_ARRAY && type->basetype->kind == TK_CHAR) {
+         if (ord_range(type->indextype, &smin, &smax))
+             return smax - smin + 1;
+         else
+             return stringceiling;
+     }
+     if (type->kind != TK_STRING) {
+         intwarning("strmax", "strmax encountered a non-string value [169]");
+         return stringceiling;
+     }
+     if (ex->kind == EK_CONST)
+         return ex->val.i;
+     if (ex->kind == EK_VAR && foldstrconsts != 0 &&
+         (mp = (Meaning *)(ex->val.i))->kind == MK_CONST && mp->val.type)
+         return mp->val.i;
+     if (ex->kind == EK_BICALL) {
+ 	if (!strcmp(ex->val.s, strsubname)) {
+ 	    if (isliteralconst(ex->args[3], &val) && val.type)
+ 		return val.i;
+ 	}
+     }
+     if (ord_range(type->indextype, NULL, &smax))
+         return smax;
+     else
+         return stringceiling;
+ }
+ 
+ 
+ 
+ 
+ int strhasnull(val)
+ Value val;
+ {
+     int i;
+ 
+     for (i = 0; i < val.i; i++) {
+         if (!val.s[i])
+             return (i == val.i-1) ? 1 : 2;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ int istempsprintf(ex)
+ Expr *ex;
+ {
+     return (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+             ex->nargs >= 2 &&
+             istempvar(ex->args[0]) &&
+             ex->args[1]->kind == EK_CONST &&
+             ex->args[1]->val.type->kind == TK_STRING);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_sprintfify(ex)
+ Expr *ex;
+ {
+     Meaning *tvar;
+     char stringbuf[500];
+     char *cp, ch;
+     int j, nnulls;
+     Expr *ex2;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_sprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (istempsprintf(ex))
+         return ex;
+     ex = makeexpr_stringcast(ex);
+     tvar = makestmttempvar(tp_str255, name_STRING);
+     if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+         cp = stringbuf;
+         nnulls = 0;
+         for (j = 0; j < ex->val.i; j++) {
+             ch = ex->val.s[j];
+             if (!ch) {
+                 if (j < ex->val.i-1)
+                     note("Null character in sprintf control string [147]");
+                 else
+                     note("Null character at end of sprintf control string [148]");
+                 if (keepnulls) {
+                     *cp++ = '%';
+                     *cp++ = 'c';
+                     nnulls++;
+                 }
+             } else {
+                 *cp++ = ch;
+                 if (ch == '%')
+                     *cp++ = ch;
+             }
+         }
+         *cp = 0;
+         ex = makeexpr_bicall_2("sprintf", tp_str255,
+                                makeexpr_var(tvar),
+                                makeexpr_string(stringbuf));
+         while (--nnulls >= 0)
+             insertarg(&ex, 2, makeexpr_char(0));
+         return ex;
+     } else if (ex->val.type->kind == TK_ARRAY &&
+                ex->val.type->basetype->kind == TK_CHAR) {
+         ex2 = arraysize(ex->val.type, 0);
+         return cleansprintf(
+                 makeexpr_bicall_4("sprintf", tp_str255,
+                                   makeexpr_var(tvar),
+                                   makeexpr_string("%.*s"),
+                                   ex2,
+                                   makeexpr_addrstr(ex)));
+     } else {
+         if (ord_type(ex->val.type)->kind == TK_CHAR)
+             cp = "%c";
+         else if (ex->val.type->kind == TK_STRING)
+             cp = "%s";
+         else {
+             warning("Mixing non-strings with strings [170]");
+             return ex;
+         }
+         return makeexpr_bicall_3("sprintf", tp_str255,
+                                  makeexpr_var(tvar),
+                                  makeexpr_string(cp),
+                                  ex);
+     }
+ }
+ 
+ 
+ 
+ Expr *makeexpr_unsprintfify(ex)
+ Expr *ex;
+ {
+     char stringbuf[500];
+     char *cp, ch;
+     int i;
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_unsprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
+     if (!istempsprintf(ex))
+         return ex;
+     canceltempvar(istempvar(ex->args[0]));
+     for (i = 2; i < ex->nargs; i++) {
+         if (ex->args[i]->val.type->kind != TK_CHAR ||
+             !checkconst(ex, 0))
+             return ex;
+     }
+     cp = stringbuf;
+     for (i = 0; i < ex->args[1]->val.i; i++) {
+         ch = ex->args[1]->val.s[i];
+         *cp++ = ch;
+         if (ch == '%') {
+             if (++i == ex->args[1]->val.i)
+                 return ex;
+             ch = ex->args[1]->val.s[i];
+             if (ch == 'c')
+                 cp[-1] = 0;
+             else if (ch != '%')
+                 return ex;
+         }
+     }
+     freeexpr(ex);
+     return makeexpr_lstring(stringbuf, cp - stringbuf);
+ }
+ 
+ 
+ 
+ /* Returns >= 0 iff unsprintfify would return a string constant */
+ 
+ int sprintflength(ex, allownulls)
+ Expr *ex;
+ int allownulls;
+ {
+     int i, len;
+ 
+     if (!istempsprintf(ex))
+         return -1;
+     for (i = 2; i < ex->nargs; i++) {
+         if (!allownulls ||
+             ex->args[i]->val.type->kind != TK_CHAR ||
+             !checkconst(ex, 0))
+             return -1;
+     }
+     len = 0;
+     for (i = 0; i < ex->args[1]->val.i; i++) {
+         len++;
+         if (ex->args[1]->val.s[i] == '%') {
+             if (++i == ex->args[1]->val.i)
+                 return -1;
+             if (ex->args[1]->val.s[i] != 'c' &&
+                 ex->args[1]->val.s[i] != '%')
+                 return -1;
+         }
+     }
+     return len;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_concat(a, b, usesprintf)
+ Expr *a, *b;
+ int usesprintf;
+ {
+     int i, ii, j, len, nargs;
+     Type *type;
+     Meaning *mp, *tvar;
+     Expr *ex, *args[2];
+     int akind[2];
+     Value val, val1, val2;
+     char formatstr[300];
+ 
+     if (debug>2) { fprintf(outf,"makeexpr_concat("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+     if (!a)
+         return b;
+     if (!b)
+         return a;
+     a = makeexpr_stringcast(a);
+     b = makeexpr_stringcast(b);
+     if (checkconst(a, 0)) {
+         freeexpr(a);
+         return b;
+     }
+     if (checkconst(b, 0)) {
+         freeexpr(b);
+         return a;
+     }
+     len = strmax(a) + strmax(b);
+     type = makestringtype(len);
+     if (a->kind == EK_CONST && b->kind == EK_CONST) {
+         val1 = a->val;
+         val2 = b->val;
+         val.i = val1.i + val2.i;
+         val.s = ALLOC(val.i+1, char, literals);
+ 	val.s[val.i] = 0;
+         val.type = type;
+         memcpy(val.s, val1.s, val1.i);
+         memcpy(val.s + val1.i, val2.s, val2.i);
+         freeexpr(a);
+         freeexpr(b);
+         return makeexpr_val(val);
+     }
+     tvar = makestmttempvar(type, name_STRING);
+     if (sprintf_value != 2 || usesprintf) {
+         nargs = 2;                 /* Generate a call to sprintf(), unfolding */
+         args[0] = a;               /*  nested sprintf()'s. */
+         args[1] = b;
+         *formatstr = 0;
+         for (i = 0; i < 2; i++) {
+ #if 1
+             ex = args[i] = makeexpr_sprintfify(args[i]);
+ 	    if (!ex->args[1] || !ex->args[1]->val.s)
+ 		intwarning("makeexpr_concat", "NULL in ex->args[1]");
+ 	    else
+ 		strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
+             canceltempvar(istempvar(ex->args[0]));
+             nargs += (ex->nargs - 2);
+             akind[i] = 0;      /* now obsolete */
+ #else
+             ex = args[i];
+             if (ex->kind == EK_CONST)
+                 ex = makeexpr_sprintfify(ex);
+             if (istempsprintf(ex)) {
+                 strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
+                 canceltempvar(istempvar(ex->args[0]));
+                 nargs += (ex->nargs - 2);
+                 akind[i] = 0;
+             } else {
+                 strcat(formatstr, "%s");
+                 nargs++;
+                 akind[i] = 1;
+             }
+ #endif
+         }
+         ex = makeexpr(EK_BICALL, nargs);
+         ex->val.type = type;
+         ex->val.s = stralloc("sprintf");
+         ex->args[0] = makeexpr_var(tvar);
+         ex->args[1] = makeexpr_string(formatstr);
+         j = 2;
+         for (i = 0; i < 2; i++) {
+             switch (akind[i]) {
+                 case 0:   /* flattened sub-sprintf */
+                     for (ii = 2; ii < args[i]->nargs; ii++)
+                         ex->args[j++] = copyexpr(args[i]->args[ii]);
+                     freeexpr(args[i]);
+                     break;
+                 case 1:   /* included string expr */
+                     ex->args[j++] = args[i];
+                     break;
+             }
+         }
+     } else {
+         ex = a;
+         while (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcat"))
+             ex = ex->args[0];
+         if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcpy") &&
+             (mp = istempvar(ex->args[0])) != NULL) {
+             canceltempvar(mp);
+             freeexpr(ex->args[0]);
+             ex->args[0] = makeexpr_var(tvar);
+         } else {
+             a = makeexpr_bicall_2("strcpy", type, makeexpr_var(tvar), a);
+         }
+         ex = makeexpr_bicall_2("strcat", type, a, b);
+     }
+     if (debug>2) { fprintf(outf,"makeexpr_concat returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *cleansprintf(ex)
+ Expr *ex;
+ {
+     int fidx, i, j, k, len, changed = 0;
+     char *cp, *bp;
+     char fmtbuf[300];
+ 
+     if (ex->kind != EK_BICALL)
+ 	return ex;
+     if (!strcmp(ex->val.s, "printf"))
+ 	fidx = 0;
+     else if (!strcmp(ex->val.s, "sprintf") ||
+ 	     !strcmp(ex->val.s, "fprintf"))
+ 	fidx = 1;
+     else
+ 	return ex;
+     len = ex->args[fidx]->val.i;
+     cp = ex->args[fidx]->val.s;      /* printf("%*d",17,x)  =>  printf("%17d",x) */
+     bp = fmtbuf;
+     j = fidx + 1;
+     for (i = 0; i < len; i++) {
+         *bp++ = cp[i];
+         if (cp[i] == '%') {
+ 	    if (cp[i+1] == 's' && ex->args[j]->kind == EK_CONST) {
+ 		bp--;
+ 		for (k = 0; k < ex->args[j]->val.i; k++)
+ 		    *bp++ = ex->args[j]->val.s[k];
+ 		delfreearg(&ex, j);
+ 		changed = 1;
+ 		i++;
+ 		continue;
+ 	    }
+             for (i++; i < len &&
+                       !(isalpha(cp[i]) && cp[i] != 'l'); i++) {
+                 if (cp[i] == '*') {
+                     if (isliteralconst(ex->args[j], NULL) == 2) {
+                         sprintf(bp, "%ld", ex->args[j]->val.i);
+                         bp += strlen(bp);
+                         delfreearg(&ex, j);
+                         changed = 1;
+                     } else {
+                         *bp++ = cp[i];
+                         j++;
+                     }
+                 } else
+                     *bp++ = cp[i];
+             }
+             if (i < len)
+                 *bp++ = cp[i];
+             j++;
+         }
+     }
+     *bp = 0;
+     if (changed) {
+         freeexpr(ex->args[fidx]);
+         ex->args[fidx] = makeexpr_string(fmtbuf);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_substring(vex, ex, exi, exj)
+ Expr *vex, *ex, *exi, *exj;
+ {
+     exi = makeexpr_unlongcast(exi);
+     exj = makeexpr_longcast(exj, 0);
+     ex = bumpstring(ex, exi, 1);
+     return cleansprintf(makeexpr_bicall_4("sprintf", tp_str255,
+                                           vex,
+                                           makeexpr_string("%.*s"),
+                                           exj,
+                                           ex));
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_dot(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+     Type *ot1, *ot2;
+     Expr *ex2, *ex3, *nex;
+     Meaning *tvar;
+ 
+     if (ex->kind == EK_FUNCTION && copystructfuncs > 0) {
+         tvar = makestmttempvar(ex->val.type, name_TEMP);
+         ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
+         ex = makeexpr_var(tvar);
+     } else
+         ex2 = NULL;
+     if (mp->constdefn) {
+         nex = makeexpr(EK_MACARG, 0);
+         nex->val.type = tp_integer;
+         ex3 = replaceexprexpr(copyexpr(mp->constdefn), nex, ex, 0);
+         freeexpr(ex);
+         freeexpr(nex);
+         ex = gentle_cast(ex3, mp->val.type);
+     } else {
+         ex = makeexpr_un(EK_DOT, mp->type, ex);
+         ex->val.i = (long)mp;
+         ot1 = ord_type(mp->type);
+         ot2 = ord_type(mp->val.type);
+         if (ot1->kind != ot2->kind && ot2->kind == TK_ENUM && ot2->meaning && useenum)
+             ex = makeexpr_cast(ex, mp->val.type);
+         else if (mp->val.i && !hassignedchar &&
+ 		 (mp->type == tp_sint || mp->type == tp_abyte)) {
+             if (*signextname) {
+                 ex = makeexpr_bicall_2(signextname, tp_integer,
+                                        ex, makeexpr_long(mp->val.i));
+             } else
+                 note(format_s("Unable to sign-extend field %s [149]", mp->name));
+         }
+     }
+     ex->val.type = mp->val.type;
+     return makeexpr_comma(ex2, ex);
+ }
+ 
+ 
+ 
+ Expr *makeexpr_dotq(ex, name, type)
+ Expr *ex;
+ char *name;
+ Type *type;
+ {
+     ex = makeexpr_un(EK_DOT, type, ex);
+     ex->val.s = stralloc(name);
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *strmax_func(ex)
+ Expr *ex;
+ {
+     Meaning *mp;
+     Expr *ex2;
+     Type *type;
+ 
+     type = ex->val.type;
+     if (type->kind == TK_POINTER) {
+         intwarning("strmax_func", "got a pointer instead of a string [171]");
+         type = type->basetype;
+     }
+     if (type->kind == TK_CHAR)
+         return makeexpr_long(1);
+     if (type->kind != TK_STRING) {
+         warning("STRMAX of non-string value [172]");
+         return makeexpr_long(stringceiling);
+     }
+     if (ex->kind == EK_CONST)
+ 	return makeexpr_long(ex->val.i);
+     if (ex->kind == EK_VAR &&
+ 	(mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ 	mp->type == tp_str255 && mp->val.type)
+ 	return makeexpr_long(mp->val.i);
+     if (ex->kind == EK_VAR &&
+         (mp = (Meaning *)ex->val.i)->kind == MK_VARPARAM &&
+         mp->type == tp_strptr) {
+ 	if (mp->anyvarflag) {
+ 	    if (mp->ctx != curctx && mp->ctx->kind == MK_FUNCTION)
+ 		note(format_s("Reference to STRMAX of parent proc's \"%s\" must be fixed [150]",
+ 			      mp->name));
+ 	    return makeexpr_name(format_s(name_STRMAX, mp->name), tp_int);
+ 	} else
+ 	    note(format_s("STRMAX of \"%s\" wants VarStrings=1 [151]", mp->name));
+     }
+     ord_range_expr(type->indextype, NULL, &ex2);
+     return copyexpr(ex2);
+ }
+ 
+ 
+ 
+ 
+ Expr *makeexpr_nil()
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_CONST, 0);
+     ex->val.type = tp_anyptr;
+     ex->val.i = 0;
+     ex->val.s = NULL;
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *makeexpr_ctx(ctx)
+ Meaning *ctx;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr(EK_CTX, 0);
+     ex->val.type = tp_text;     /* handy pointer type */
+     ex->val.i = (long)ctx;
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Expr *force_signed(ex)
+ Expr *ex;
+ {
+     Type *tp;
+ 
+     if (isliteralconst(ex, NULL) == 2 && ex->nargs == 0)
+         return ex;
+     tp = true_type(ex);
+     if (tp == tp_ushort || tp == tp_ubyte || tp == tp_uchar)
+ 	return makeexpr_cast(ex, tp_sshort);
+     else if (tp == tp_unsigned || tp == tp_uint) {
+ 	if (exprlongness(ex) < 0)
+ 	    return makeexpr_cast(ex, tp_sint);
+ 	else
+ 	    return makeexpr_cast(ex, tp_integer);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *force_unsigned(ex)
+ Expr *ex;
+ {
+     Type *tp;
+ 
+     if (isliteralconst(ex, NULL) == 2 && !expr_is_neg(ex))
+         return ex;
+     tp = true_type(ex);
+     if (tp == tp_unsigned || tp == tp_uint || tp == tp_ushort ||
+ 	tp == tp_ubyte || tp == tp_uchar)
+         return ex;
+     if (tp->kind == TK_CHAR)
+ 	return makeexpr_actcast(ex, tp_uchar);
+     else if (exprlongness(ex) < 0)
+         return makeexpr_cast(ex, tp_uint);
+     else
+         return makeexpr_cast(ex, tp_unsigned);
+ }
+ 
+ 
+ 
+ 
+ #define CHECKSIZE(size) (((size) > 0 && (size)%charsize == 0) ? (size)/charsize : 0)
+ 
+ long type_sizeof(type, pasc)
+ Type *type;
+ int pasc;
+ {
+     long s1, smin, smax;
+     int charsize = (sizeof_char) ? sizeof_char : CHAR_BIT;      /* from <limits.h> */
+ 
+     switch (type->kind) {
+ 
+         case TK_INTEGER:
+             if (type == tp_integer ||
+                 type == tp_unsigned)
+                 return pasc ? 4 : CHECKSIZE(sizeof_integer);
+             else
+                 return pasc ? 2 : CHECKSIZE(sizeof_short);
+ 
+         case TK_CHAR:
+         case TK_BOOLEAN:
+             return 1;
+ 
+         case TK_SUBR:
+             type = findbasetype(type, ODECL_NOPRES);
+             if (pasc) {
+                 if (type == tp_integer || type == tp_unsigned)
+                     return 4;
+                 else
+                     return 2;
+             } else {
+                 if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte)
+                     return 1;
+                 else if (type == tp_ushort || type == tp_sshort)
+                     return CHECKSIZE(sizeof_short);
+                 else
+                     return CHECKSIZE(sizeof_integer);
+             }
+ 
+         case TK_POINTER:
+             return pasc ? 4 : CHECKSIZE(sizeof_pointer);
+ 
+         case TK_REAL:
+ 	    if (type == tp_longreal)
+ 		return pasc ? (which_lang == LANG_TURBO ? 6 : 8) : CHECKSIZE(sizeof_double);
+ 	    else
+ 		return pasc ? 4 : CHECKSIZE(sizeof_float);
+ 
+         case TK_ENUM:
+ 	    if (!pasc)
+ 		return CHECKSIZE(sizeof_enum);
+ 	    type = findbasetype(type, ODECL_NOPRES);
+             return type->kind != TK_ENUM ? type_sizeof(type, pasc)
+ 		   : CHECKSIZE(pascalenumsize);
+ 
+         case TK_SMALLSET:
+         case TK_SMALLARRAY:
+             return pasc ? 0 : type_sizeof(type->basetype, pasc);
+ 
+         case TK_ARRAY:
+             s1 = type_sizeof(type->basetype, pasc);
+             if (s1 && ord_range(type->indextype, &smin, &smax))
+                 return s1 * (smax - smin + 1);
+             else
+                 return 0;
+ 
+         case TK_RECORD:
+             if (pasc && type->meaning) {
+                 if (!strcmp(type->meaning->sym->name, "NA_WORD"))
+                     return 2;
+                 else if (!strcmp(type->meaning->sym->name, "NA_LONGWORD"))
+                     return 4;
+                 else if (!strcmp(type->meaning->sym->name, "NA_QUADWORD"))
+                     return 8;
+                 else
+                     return 0;
+             } else
+                 return 0;
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ Static Value eval_expr_either(ex, pasc)
+ Expr *ex;
+ int pasc;
+ {
+     Value val, val2;
+     Meaning *mp;
+     int i;
+ 
+     if (debug>2) { fprintf(outf,"eval_expr("); dumpexpr(ex); fprintf(outf,")\n"); }
+     switch (ex->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+             return ex->val;
+ 
+         case EK_VAR:
+             mp = (Meaning *) ex->val.i;
+             if (mp->kind == MK_CONST &&
+                 (foldconsts != 0 ||
+                  mp == mp_maxint || mp == mp_minint))
+                 return mp->val;
+             break;
+ 
+         case EK_SIZEOF:
+             i = type_sizeof(ex->args[0]->val.type, pasc);
+             if (i)
+                 return make_ord(tp_integer, i);
+             break;
+ 
+         case EK_PLUS:
+             val = eval_expr_either(ex->args[0], pasc);
+             if (!val.type || ord_type(val.type)->kind != TK_INTEGER)
+                 val.type = NULL;
+             for (i = 1; val.type && i < ex->nargs; i++) {
+                 val2 = eval_expr_either(ex->args[i], pasc);
+                 if (!val2.type || ord_type(val2.type)->kind != TK_INTEGER)
+                     val.type = NULL;
+                 else {
+                     val.i += val2.i;
+ 		    val.type = tp_integer;
+ 		}
+             }
+             return val;
+ 
+         case EK_TIMES:
+             val = eval_expr_either(ex->args[0], pasc);
+             if (!val.type || ord_type(val.type)->kind != TK_INTEGER)
+                 val.type = NULL;
+             for (i = 1; val.type && i < ex->nargs; i++) {
+                 val2 = eval_expr_either(ex->args[i], pasc);
+                 if (!val2.type || ord_type(val2.type)->kind != TK_INTEGER)
+                     val.type = NULL;
+                 else {
+                     val.i *= val2.i;
+ 		    val.type = tp_integer;
+ 		}
+             }
+             return val;
+ 
+         case EK_DIV:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && ord_type(val.type)->kind == TK_INTEGER &&
+                 val2.type && ord_type(val2.type)->kind == TK_INTEGER &&
+ 		val2.i) {
+                 val.i /= val2.i;
+ 		val.type = tp_integer;
+                 return val;
+             }
+             break;
+ 
+         case EK_MOD:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && ord_type(val.type)->kind == TK_INTEGER &&
+                 val2.type && ord_type(val2.type)->kind == TK_INTEGER &&
+ 		val2.i) {
+                 val.i %= val2.i;
+ 		val.type = tp_integer;
+                 return val;
+             }
+             break;
+ 
+         case EK_NEG:
+             val = eval_expr_either(ex->args[0], pasc);
+             if (val.type) {
+                 val.i = -val.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_LSH:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && val2.type) {
+                 val.i <<= val2.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_RSH:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && val2.type) {
+                 val.i >>= val2.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_BAND:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && val2.type) {
+                 val.i &= val2.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_BOR:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && val2.type) {
+                 val.i |= val2.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_BXOR:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type && val2.type) {
+                 val.i ^= val2.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_BNOT:
+             val = eval_expr_either(ex->args[0], pasc);
+             if (val.type) {
+                 val.i = ~val.i;
+                 return val;
+             }
+             break;
+ 
+         case EK_EQ:
+         case EK_NE:
+         case EK_GT:
+         case EK_LT:
+         case EK_GE:
+         case EK_LE:
+             val = eval_expr_either(ex->args[0], pasc);
+             val2 = eval_expr_either(ex->args[1], pasc);
+             if (val.type) {
+                 if (val.i == val2.i)
+                     val.i = (ex->kind == EK_EQ || ex->kind == EK_GE || ex->kind == EK_LE);
+                 else if (val.i < val2.i)
+                     val.i = (ex->kind == EK_LT || ex->kind == EK_LE || ex->kind == EK_NE);
+                 else
+                     val.i = (ex->kind == EK_GT || ex->kind == EK_GE || ex->kind == EK_NE);
+                 val.type = tp_boolean;
+                 return val;
+             }
+             break;
+ 
+         case EK_NOT:
+             val = eval_expr_either(ex->args[0], pasc);
+             if (val.type)
+                 val.i = !val.i;
+             return val;
+ 
+         case EK_AND:
+             for (i = 0; i < ex->nargs; i++) {
+                 val = eval_expr_either(ex->args[i], pasc);
+                 if (!val.type || !val.i)
+                     return val;
+             }
+             return val;
+ 
+         case EK_OR:
+             for (i = 0; i < ex->nargs; i++) {
+                 val = eval_expr_either(ex->args[i], pasc);
+                 if (!val.type || val.i)
+                     return val;
+             }
+             return val;
+ 
+         case EK_COMMA:
+             return eval_expr_either(ex->args[ex->nargs-1], pasc);
+ 
+ 	default:
+ 	    break;
+     }
+     val.type = NULL;
+     return val;
+ }
+ 
+ 
+ Value eval_expr(ex)
+ Expr *ex;
+ {
+     return eval_expr_either(ex, 0);
+ }
+ 
+ 
+ Value eval_expr_consts(ex)
+ Expr *ex;
+ {
+     Value val;
+     short save_fold = foldconsts;
+ 
+     foldconsts = 1;
+     val = eval_expr_either(ex, 0);
+     foldconsts = save_fold;
+     return val;
+ }
+ 
+ 
+ Value eval_expr_pasc(ex)
+ Expr *ex;
+ {
+     return eval_expr_either(ex, 1);
+ }
+ 
+ 
+ 
+ int expr_is_const(ex)
+ Expr *ex;
+ {
+     int i;
+ 
+     switch (ex->kind) {
+ 
+         case EK_CONST:
+         case EK_LONGCONST:
+         case EK_SIZEOF:
+             return 1;
+ 
+         case EK_VAR:
+             return (((Meaning *)ex->val.i)->kind == MK_CONST);
+ 
+         case EK_HAT:
+         case EK_ASSIGN:
+         case EK_POSTINC:
+         case EK_POSTDEC:
+             return 0;
+ 
+         case EK_ADDR:
+             if (ex->args[0]->kind == EK_VAR)
+                 return 1;
+             return 0;   /* conservative */
+ 
+         case EK_FUNCTION:
+             if (!nosideeffects_func(ex))
+                 return 0;
+             break;
+ 
+         case EK_BICALL:
+             if (!nosideeffects_func(ex))
+                 return 0;
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     for (i = 0; i < ex->nargs; i++) {
+         if (!expr_is_const(ex->args[i]))
+             return 0;
+     }
+     return 1;
+ }
+ 
+ 
+ 
+ 
+ 
+ Expr *eatcasts(ex)
+ Expr *ex;
+ {
+     while (ex->kind == EK_CAST)
+         ex = grabarg(ex, 0);
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c:1.1
*** /dev/null	Mon Feb 16 17:43:40 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,5405 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_FUNCS_C
+ #include "trans.h"
+ 
+ 
+ 
+ 
+ Static Strlist *enumnames;
+ Static int enumnamecount;
+ 
+ 
+ 
+ void setup_funcs()
+ {
+     enumnames = NULL;
+     enumnamecount = 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ int isvar(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+     return (ex->kind == EK_VAR && (Meaning *)ex->val.i == mp);
+ }
+ 
+ 
+ 
+ 
+ char *getstring(ex)
+ Expr *ex;
+ {
+     ex = makeexpr_stringify(ex);
+     if (ex->kind != EK_CONST || ex->val.type->kind != TK_STRING) {
+         intwarning("getstring", "Not a string literal [206]");
+ 	return "";
+     }
+     return ex->val.s;
+ }
+ 
+ 
+ 
+ 
+ Expr *p_parexpr(target)
+ Type *target;
+ {
+     Expr *ex;
+ 
+     if (wneedtok(TOK_LPAR)) {
+ 	ex = p_expr(target);
+ 	if (!wneedtok(TOK_RPAR))
+ 	    skippasttotoken(TOK_RPAR, TOK_SEMI);
+     } else
+ 	ex = p_expr(target);
+     return ex;
+ }
+ 
+ 
+ 
+ Type *argbasetype(ex)
+ Expr *ex;
+ {
+     if (ex->kind == EK_CAST)
+         ex = ex->args[0];
+     if (ex->val.type->kind == TK_POINTER)
+         return ex->val.type->basetype;
+     else
+         return ex->val.type;
+ }
+ 
+ 
+ 
+ Type *choosetype(t1, t2)
+ Type *t1, *t2;
+ {
+     if (t1 == tp_void ||
+         (type_sizeof(t2, 1) && !type_sizeof(t1, 1)))
+         return t2;
+     else
+         return t1;
+ }
+ 
+ 
+ 
+ Expr *convert_offset(type, ex2)
+ Type *type;
+ Expr *ex2;
+ {
+     long size;
+     int i;
+     Value val;
+     Expr *ex3;
+ 
+     if (type->kind == TK_POINTER ||
+         type->kind == TK_ARRAY ||
+         type->kind == TK_SET ||
+         type->kind == TK_STRING)
+         type = type->basetype;
+     size = type_sizeof(type, 1);
+     if (size == 1)
+         return ex2;
+     val = eval_expr_pasc(ex2);
+     if (val.type) {
+         if (val.i == 0)
+             return ex2;
+         if (size && val.i % size == 0) {
+             freeexpr(ex2);
+             return makeexpr_long(val.i / size);
+         }
+     } else {     /* look for terms like "n*sizeof(foo)" */
+ 	while (ex2->kind == EK_CAST || ex2->kind == EK_ACTCAST)
+ 	    ex2 = ex2->args[0];
+         if (ex2->kind == EK_TIMES) {
+ 	    for (i = 0; i < ex2->nargs; i++) {
+ 		ex3 = convert_offset(type, ex2->args[i]);
+ 		if (ex3) {
+ 		    ex2->args[i] = ex3;
+ 		    return resimplify(ex2);
+ 		}
+ 	    }
+             for (i = 0;
+                  i < ex2->nargs && ex2->args[i]->kind != EK_SIZEOF;
+                  i++) ;
+             if (i < ex2->nargs) {
+                 if (ex2->args[i]->args[0]->val.type == type) {
+                     delfreearg(&ex2, i);
+                     if (ex2->nargs == 1)
+                         return ex2->args[0];
+                     else
+                         return ex2;
+                 }
+             }
+         } else if (ex2->kind == EK_PLUS) {
+ 	    ex3 = copyexpr(ex2);
+ 	    for (i = 0; i < ex2->nargs; i++) {
+ 		ex3->args[i] = convert_offset(type, ex3->args[i]);
+ 		if (!ex3->args[i]) {
+ 		    freeexpr(ex3);
+ 		    return NULL;
+ 		}
+ 	    }
+ 	    freeexpr(ex2);
+ 	    return resimplify(ex3);
+         } else if (ex2->kind == EK_SIZEOF) {
+             if (ex2->args[0]->val.type == type) {
+                 freeexpr(ex2);
+                 return makeexpr_long(1);
+             }
+         } else if (ex2->kind == EK_NEG) {
+ 	    ex3 = convert_offset(type, ex2->args[0]);
+ 	    if (ex3)
+                 return makeexpr_neg(ex3);
+         }
+     }
+     return NULL;
+ }
+ 
+ 
+ 
+ Expr *convert_size(type, ex, name)
+ Type *type;
+ Expr *ex;
+ char *name;
+ {
+     long size;
+     Expr *ex2;
+     int i, okay;
+     Value val;
+ 
+     if (debug>2) { fprintf(outf,"convert_size("); dumpexpr(ex); fprintf(outf,")\n"); }
+     while (type->kind == TK_ARRAY || type->kind == TK_STRING)
+         type = type->basetype;
+     if (type == tp_void)
+         return ex;
+     size = type_sizeof(type, 1);
+     if (size == 1)
+         return ex;
+     while (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
+ 	ex = ex->args[0];
+     switch (ex->kind) {
+ 
+         case EK_TIMES:
+             for (i = 0; i < ex->nargs; i++) {
+                 ex2 = convert_size(type, ex->args[i], NULL);
+                 if (ex2) {
+                     ex->args[i] = ex2;
+                     return resimplify(ex);
+                 }
+             }
+             break;
+ 
+         case EK_PLUS:
+             okay = 1;
+             for (i = 0; i < ex->nargs; i++) {
+                 ex2 = convert_size(type, ex->args[i], NULL);
+                 if (ex2)
+                     ex->args[i] = ex2;
+                 else
+                     okay = 0;
+             }
+             ex = distribute_plus(ex);
+             if ((ex->kind != EK_TIMES || !okay) && name)
+                 note(format_s("Suspicious mixture of sizes in %s [173]", name));
+             return ex;
+ 
+         case EK_SIZEOF:
+             return ex;
+ 
+ 	default:
+ 	    break;
+     }
+     val = eval_expr_pasc(ex);
+     if (val.type) {
+         if (val.i == 0)
+             return ex;
+         if (size && val.i % size == 0) {
+             freeexpr(ex);
+             return makeexpr_times(makeexpr_long(val.i / size),
+                                   makeexpr_sizeof(makeexpr_type(type), 0));
+         }
+     }
+     if (name) {
+         note(format_s("Can't interpret size in %s [174]", name));
+         return ex;
+     } else
+         return NULL;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ Static Expr *func_abs()
+ {
+     Expr *ex;
+     Meaning *tvar;
+     int lness;
+ 
+     ex = p_parexpr(tp_integer);
+     if (ex->val.type->kind == TK_REAL)
+         return makeexpr_bicall_1("fabs", tp_longreal, ex);
+     else {
+         lness = exprlongness(ex);
+         if (lness < 0)
+             return makeexpr_bicall_1("abs", tp_int, ex);
+         else if (lness > 0 && *absname) {
+             if (ansiC > 0) {
+                 return makeexpr_bicall_1("labs", tp_integer, ex);
+             } else if (*absname == '*' && (exprspeed(ex) >= 5 || !nosideeffects(ex, 0))) {
+                 tvar = makestmttempvar(tp_integer, name_TEMP);
+                 return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar),
+                                                       ex),
+                                       makeexpr_bicall_1(absname, tp_integer,
+                                                         makeexpr_var(tvar)));
+             } else {
+                 return makeexpr_bicall_1(absname, tp_integer, ex);
+             }
+         } else if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
+             return makeexpr_cond(makeexpr_rel(EK_LT, copyexpr(ex),
+                                                      makeexpr_long(0)),
+                                  makeexpr_neg(copyexpr(ex)),
+                                  ex);
+         } else {
+             tvar = makestmttempvar(tp_integer, name_TEMP);
+             return makeexpr_cond(makeexpr_rel(EK_LT, makeexpr_assign(makeexpr_var(tvar),
+                                                                      ex),
+                                                      makeexpr_long(0)),
+                                  makeexpr_neg(makeexpr_var(tvar)),
+                                  makeexpr_var(tvar));
+         }
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_addr()
+ {
+     Expr *ex, *ex2, *ex3;
+     Type *type, *tp2;
+     int haspar;
+ 
+     haspar = wneedtok(TOK_LPAR);
+     ex = p_expr(tp_proc);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         ex2 = p_expr(tp_integer);
+         ex3 = convert_offset(ex->val.type, ex2);
+         if (checkconst(ex3, 0)) {
+             ex = makeexpr_addrf(ex);
+         } else {
+             ex = makeexpr_addrf(ex);
+             if (ex3) {
+                 ex = makeexpr_plus(ex, ex3);
+             } else {
+                 note("Don't know how to reduce offset for ADDR [175]");
+                 type = makepointertype(tp_abyte);
+ 		tp2 = ex->val.type;
+                 ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
+             }
+         }
+     } else {
+ 	if ((ex->val.type->kind != TK_PROCPTR &&
+ 	     ex->val.type->kind != TK_CPROCPTR) ||
+ 	    (ex->kind == EK_VAR &&
+ 	     ex->val.type == ((Meaning *)ex->val.i)->type))
+ 	    ex = makeexpr_addrf(ex);
+     }
+     if (haspar) {
+ 	if (!wneedtok(TOK_RPAR))
+ 	    skippasttotoken(TOK_RPAR, TOK_SEMI);
+     }
+     return ex;
+ }
+ 
+ 
+ Static Expr *func_iaddress()
+ {
+     return makeexpr_cast(func_addr(), tp_integer);
+ }
+ 
+ 
+ 
+ Static Expr *func_addtopointer()
+ {
+     Expr *ex, *ex2, *ex3;
+     Type *type, *tp2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_anyptr);
+     if (skipcomma()) {
+ 	ex2 = p_expr(tp_integer);
+     } else
+ 	ex2 = makeexpr_long(0);
+     skipcloseparen();
+     ex3 = convert_offset(ex->val.type, ex2);
+     if (!checkconst(ex3, 0)) {
+ 	if (ex3) {
+ 	    ex = makeexpr_plus(ex, ex3);
+ 	} else {
+ 	    note("Don't know how to reduce offset for ADDTOPOINTER [175]");
+ 	    type = makepointertype(tp_abyte);
+ 	    tp2 = ex->val.type;
+ 	    ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
+ 	}
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Stmt *proc_assert()
+ {
+     Expr *ex;
+ 
+     ex = p_parexpr(tp_boolean);
+     return makestmt_call(makeexpr_bicall_1("assert", tp_void, ex));
+ }
+ 
+ 
+ 
+ Stmt *wrapopencheck(sp, fex)
+ Stmt *sp;
+ Expr *fex;
+ {
+     Stmt *sp2;
+ 
+     if (FCheck(checkfileisopen) && !is_std_file(fex)) {
+         sp2 = makestmt(SK_IF);
+         sp2->exp1 = makeexpr_rel(EK_NE, filebasename(fex), makeexpr_nil());
+         sp2->stm1 = sp;
+         if (iocheck_flag) {
+             sp2->stm2 = makestmt_call(makeexpr_bicall_1(name_ESCIO, tp_integer,
+ 							makeexpr_name(filenotopenname, tp_int)));
+         } else {
+             sp2->stm2 = makestmt_assign(makeexpr_var(mp_ioresult),
+ 					makeexpr_name(filenotopenname, tp_int));
+         }
+         return sp2;
+     } else {
+         freeexpr(fex);
+         return sp;
+     }
+ }
+ 
+ 
+ 
+ Static Expr *checkfilename(nex)
+ Expr *nex;
+ {
+     Expr *ex;
+ 
+     nex = makeexpr_stringcast(nex);
+     if (nex->kind == EK_CONST && nex->val.type->kind == TK_STRING) {
+         switch (which_lang) {
+ 
+             case LANG_HP:
+                 if (!strncmp(nex->val.s, "#1:", 3) ||
+                     !strncmp(nex->val.s, "console:", 8) ||
+                     !strncmp(nex->val.s, "CONSOLE:", 8)) {
+                     freeexpr(nex);
+                     nex = makeexpr_string("/dev/tty");
+                 } else if (!strncmp(nex->val.s, "#2:", 3) ||
+                            !strncmp(nex->val.s, "systerm:", 8) ||
+                            !strncmp(nex->val.s, "SYSTERM:", 8)) {
+                     freeexpr(nex);
+                     nex = makeexpr_string("/dev/tty");     /* should do more? */
+                 } else if (!strncmp(nex->val.s, "#6:", 3) ||
+                            !strncmp(nex->val.s, "printer:", 8) ||
+                            !strncmp(nex->val.s, "PRINTER:", 8)) {
+                     note("Opening a file named PRINTER: [176]");
+                 } else if (my_strchr(nex->val.s, ':')) {
+                     note("Opening a file whose name contains a ':' [177]");
+                 }
+                 break;
+ 
+             case LANG_TURBO:
+                 if (checkstring(nex, "con") ||
+                     checkstring(nex, "CON") ||
+                     checkstring(nex, "")) {
+                     freeexpr(nex);
+                     nex = makeexpr_string("/dev/tty");
+                 } else if (checkstring(nex, "nul") ||
+                            checkstring(nex, "NUL")) {
+                     freeexpr(nex);
+                     nex = makeexpr_string("/dev/null");
+                 } else if (checkstring(nex, "lpt1") ||
+                            checkstring(nex, "LPT1") ||
+                            checkstring(nex, "lpt2") ||
+                            checkstring(nex, "LPT2") ||
+                            checkstring(nex, "lpt3") ||
+                            checkstring(nex, "LPT3") ||
+                            checkstring(nex, "com1") ||
+                            checkstring(nex, "COM1") ||
+                            checkstring(nex, "com2") ||
+                            checkstring(nex, "COM2")) {
+                     note("Opening a DOS device file name [178]");
+                 }
+                 break;
+ 
+ 	    default:
+ 		break;
+         }
+     } else {
+ 	if (*filenamefilter && strcmp(filenamefilter, "0")) {
+ 	    ex = makeexpr_sizeof(copyexpr(nex), 0);
+ 	    nex = makeexpr_bicall_2(filenamefilter, tp_str255, nex, ex);
+ 	} else
+ 	    nex = makeexpr_stringify(nex);
+     }
+     return nex;
+ }
+ 
+ 
+ 
+ Static Stmt *assignfilename(fex, nex)
+ Expr *fex, *nex;
+ {
+     Meaning *mp;
+     Expr *nvex;
+ 
+     nvex = filenamepart(fex);
+     if (nvex) {
+         freeexpr(fex);
+         return makestmt_call(makeexpr_assign(nvex, nex));
+     } else {
+ 	mp = isfilevar(fex);
+         if (mp)
+             warning("Don't know how to ASSIGN to a non-explicit file variable [207]");
+         else
+             note("Encountered an ASSIGN statement [179]");
+         return makestmt_call(makeexpr_bicall_2("assign", tp_void, fex, nex));
+     }
+ }
+ 
+ 
+ 
+ Static Stmt *proc_assign()
+ {
+     Expr *fex, *nex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     nex = checkfilename(p_expr(tp_str255));
+     skipcloseparen();
+     return assignfilename(fex, nex);
+ }
+ 
+ 
+ 
+ Static Stmt *handleopen(code)
+ int code;
+ {
+     Stmt *sp, *sp1, *sp2, *spassign;
+     Expr *fex, *nex, *ex, *truenex, *nvex;
+     Meaning *fmp;
+     int needcheckopen = 1;
+     char modebuf[5], *cp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     fmp = isfilevar(fex);
+     nvex = filenamepart(fex);
+     truenex = NULL;
+     spassign = NULL;
+     if (curtok == TOK_COMMA) {
+         gettok();
+         ex = p_expr(tp_str255);
+     } else
+         ex = NULL;
+     if (ex && (ex->val.type->kind == TK_STRING ||
+ 	       ex->val.type->kind == TK_ARRAY)) {
+         nex = checkfilename(ex);
+         if (nvex) {
+             spassign = assignfilename(copyexpr(fex), nex);
+             nex = nvex;
+         }
+ 	truenex = nex;
+         if (curtok == TOK_COMMA) {
+             gettok();
+             ex = p_expr(tp_str255);
+         } else
+             ex = NULL;
+     } else if (nvex) {
+         nex = nvex;
+     } else {
+ 	switch (code) {
+ 	    case 0:
+ 	        if (ex)
+ 		    note("Can't interpret name argument in RESET [180]");
+ 		break;
+   	    case 1:
+ 	        note("REWRITE does not specify a name [181]");
+ 		break;
+ 	    case 2:
+ 		note("OPEN does not specify a name [181]");
+ 		break;
+ 	    case 3:
+ 		note("APPEND does not specify a name [181]");
+ 		break;
+ 	}
+ 	nex = NULL;
+     }
+     if (ex) {
+         if (ord_type(ex->val.type)->kind == TK_INTEGER) {
+ 	    if (!checkconst(ex, 1))
+ 		note("Ignoring block size in binary file [182]");
+             freeexpr(ex);
+         } else {
+ 	    if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+ 		cp = getstring(ex);
+ 		if (strcicmp(cp, "SHARED"))
+ 		    note(format_s("Ignoring option string \"%s\" in open [183]", cp));
+ 	    } else
+ 		note("Ignoring option string in open [183]");
+         }
+     }
+     switch (code) {
+ 
+         case 0:  /* reset */
+             strcpy(modebuf, "r");
+             break;
+ 
+         case 1:  /* rewrite */
+             strcpy(modebuf, "w");
+             break;
+ 
+         case 2:  /* open */
+             strcpy(modebuf, openmode);
+             break;
+ 
+         case 3:  /* append */
+             strcpy(modebuf, "a");
+             break;
+ 
+     }
+     if (!*modebuf) {
+         strcpy(modebuf, "r+");
+     }
+     if (readwriteopen == 2 ||
+ 	(readwriteopen &&
+ 	 fex->val.type != tp_text &&
+ 	 fex->val.type != tp_bigtext)) {
+ 	if (!my_strchr(modebuf, '+'))
+ 	    strcat(modebuf, "+");
+     }
+     if (fex->val.type != tp_text &&
+ 	fex->val.type != tp_bigtext &&
+ 	binarymode != 0) {
+         if (binarymode == 1)
+             strcat(modebuf, "b");
+         else
+             note("Opening a binary file [184]");
+     }
+     if (!nex && fmp &&
+ 	!is_std_file(fex) &&
+ 	literalfilesflag > 0 &&
+ 	(literalfilesflag == 1 ||
+ 	 strlist_cifind(literalfiles, fmp->name))) {
+ 	nex = makeexpr_string(fmp->name);
+     }
+     sp1 = NULL;
+     sp2 = NULL;
+     if (!nex || (isfiletype(fex->val.type, 1) && !truenex)) {
+ 	if (isvar(fex, mp_output)) {
+ 	    note("RESET/REWRITE ignored for file OUTPUT [319]");
+ 	} else {
+ 	    sp1 = makestmt_call(makeexpr_bicall_1("rewind", tp_void,
+ 						  filebasename(copyexpr(fex))));
+ 	    if (code == 0 || is_std_file(fex)) {
+ 		sp1 = wrapopencheck(sp1, copyexpr(fex));
+ 		needcheckopen = 0;
+ 	    } else
+ 		sp1 = makestmt_if(makeexpr_rel(EK_NE,
+ 					       filebasename(copyexpr(fex)),
+ 					       makeexpr_nil()),
+ 				 sp1,
+ 				 makestmt_assign(filebasename(copyexpr(fex)),
+ 						 makeexpr_bicall_0("tmpfile",
+ 								   tp_text)));
+ 	}
+     }
+     if (nex || isfiletype(fex->val.type, 1)) {
+ 	needcheckopen = 1;
+ 	if (!strcmp(freopenname, "fclose") ||
+ 	    !strcmp(freopenname, "fopen")) {
+ 	    sp2 = makestmt_assign(filebasename(copyexpr(fex)),
+ 				  makeexpr_bicall_2("fopen", tp_text,
+ 						    copyexpr(nex),
+ 						    makeexpr_string(modebuf)));
+ 	    if (!strcmp(freopenname, "fclose")) {
+ 		sp2 = makestmt_seq(makestmt_if(makeexpr_rel(EK_NE,
+ 							    filebasename(copyexpr(fex)),
+ 							    makeexpr_nil()),
+ 					       makestmt_call(makeexpr_bicall_1("fclose", tp_void,
+ 									       filebasename(copyexpr(fex)))),
+ 					       NULL),
+ 				   sp2);
+ 	    }
+ 	} else {
+ 	    sp2 = makestmt_assign(filebasename(copyexpr(fex)),
+ 				 makeexpr_bicall_3((*freopenname) ? freopenname : "freopen",
+ 						   tp_text,
+ 						   copyexpr(nex),
+ 						   makeexpr_string(modebuf),
+ 						   filebasename(copyexpr(fex))));
+ 	    if (!*freopenname) {
+ 		sp2 = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
+ 					       makeexpr_nil()),
+ 				  sp2,
+ 				  makestmt_assign(filebasename(copyexpr(fex)),
+ 						  makeexpr_bicall_2("fopen", tp_text,
+ 								    copyexpr(nex),
+ 								    makeexpr_string(modebuf))));
+ 	    }
+ 	}
+     }
+     if (!sp1)
+ 	sp = sp2;
+     else if (!sp2)
+ 	sp = sp1;
+     else {
+ 	sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(nex),
+ 				      makeexpr_string("")),
+ 			 sp2, sp1);
+     }
+     if (code == 2 && !*openmode && nex) {
+         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
+ 						       filebasename(copyexpr(fex)),
+ 						       makeexpr_nil()),
+                                           makestmt_assign(filebasename(copyexpr(fex)),
+                                                           makeexpr_bicall_2("fopen", tp_text,
+                                                                             copyexpr(nex),
+                                                                             makeexpr_string("w+"))),
+                                           NULL));
+     }
+     if (nex)
+ 	freeexpr(nex);
+     if (FCheck(checkfileopen) && needcheckopen) {
+         sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
+                                                               makeexpr_rel(EK_NE, filebasename(copyexpr(fex)), makeexpr_nil()),
+ 							      makeexpr_name(filenotfoundname, tp_int))));
+     }
+     sp = makestmt_seq(spassign, sp);
+     cp = (code == 0) ? resetbufname : setupbufname;
+     if (*cp &&   /* (may be eaten later, if buffering isn't needed) */
+ 	fileisbuffered(fex, 1))
+ 	sp = makestmt_seq(sp,
+ 	         makestmt_call(
+                      makeexpr_bicall_2(cp, tp_void, filebasename(fex),
+ 			 makeexpr_type(filebasetype(fex->val.type)))));
+     else
+ 	freeexpr(fex);
+     skipcloseparen();
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_append()
+ {
+     return handleopen(3);
+ }
+ 
+ 
+ 
+ Static Expr *func_arccos(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("acos", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ Static Expr *func_arcsin(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("asin", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ Static Expr *func_arctan(ex)
+ Expr *ex;
+ {
+     ex = grabarg(ex, 0);
+     if (atan2flag && ex->kind == EK_DIVIDE)
+         return makeexpr_bicall_2("atan2", tp_longreal, 
+                                  ex->args[0], ex->args[1]);
+     return makeexpr_bicall_1("atan", tp_longreal, ex);
+ }
+ 
+ 
+ Static Expr *func_arctanh(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("atanh", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_argv()
+ {
+     Expr *ex, *aex, *lex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (skipcomma()) {
+ 	aex = p_expr(tp_str255);
+     } else
+ 	return NULL;
+     skipcloseparen();
+     lex = makeexpr_sizeof(copyexpr(aex), 0);
+     aex = makeexpr_addrstr(aex);
+     return makestmt_call(makeexpr_bicall_3("P_sun_argv", tp_void,
+ 					   aex, lex, makeexpr_arglong(ex, 0)));
+ }
+ 
+ 
+ Static Expr *func_asr()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (skipcomma()) {
+         if (signedshift == 0 || signedshift == 2) {
+             ex = makeexpr_bicall_2("P_asr", ex->val.type, ex,
+ 				   p_expr(tp_unsigned));
+ 	} else {
+ 	    ex = force_signed(ex);
+ 	    ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
+ 	    if (signedshift != 1)
+ 		note("Assuming >> is an arithmetic shift [320]");
+ 	}
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ Static Expr *func_lsl()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (skipcomma()) {
+ 	ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_expr(tp_unsigned));
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ Static Expr *func_lsr()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (skipcomma()) {
+ 	ex = force_unsigned(ex);
+ 	ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_bin()
+ {
+     note("Using %b for binary printf format [185]");
+     return handle_vax_hex(NULL, "b", 1);
+ }
+ 
+ 
+ 
+ Static Expr *func_binary(ex)
+ Expr *ex;
+ {
+     char *cp;
+ 
+     ex = grabarg(ex, 0);
+     if (ex->kind == EK_CONST) {
+         cp = getstring(ex);
+         ex = makeexpr_long(my_strtol(cp, NULL, 2));
+         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+         return ex;
+     } else {
+         return makeexpr_bicall_3("strtol", tp_integer, 
+                                  ex, makeexpr_nil(), makeexpr_long(2));
+     }
+ }
+ 
+ 
+ 
+ Static Expr *handle_bitsize(next)
+ int next;
+ {
+     Expr *ex;
+     Type *type;
+     int lpar;
+     long psize;
+ 
+     lpar = (curtok == TOK_LPAR);
+     if (lpar)
+ 	gettok();
+     if (curtok == TOK_IDENT && curtokmeaning &&
+ 	curtokmeaning->kind == MK_TYPE) {
+         ex = makeexpr_type(curtokmeaning->type);
+         gettok();
+     } else
+         ex = p_expr(NULL);
+     type = ex->val.type;
+     if (lpar)
+ 	skipcloseparen();
+     psize = 0;
+     packedsize(NULL, &type, &psize, 0);
+     if (psize > 0 && psize < 32 && next) {
+ 	if (psize > 16)
+ 	    psize = 32;
+ 	else if (psize > 8)
+ 	    psize = 16;
+ 	else if (psize > 4)
+ 	    psize = 8;
+ 	else if (psize > 2)
+ 	    psize = 4;
+ 	else if (psize > 1)
+ 	    psize = 2;
+ 	else
+ 	    psize = 1;
+     }
+     if (psize)
+ 	return makeexpr_long(psize);
+     else
+ 	return makeexpr_times(makeexpr_sizeof(ex, 0),
+ 			      makeexpr_long(sizeof_char ? sizeof_char : 8));
+ }
+ 
+ 
+ Static Expr *func_bitsize()
+ {
+     return handle_bitsize(0);
+ }
+ 
+ 
+ Static Expr *func_bitnext()
+ {
+     return handle_bitsize(1);
+ }
+ 
+ 
+ 
+ Static Expr *func_blockread()
+ {
+     Expr *ex, *ex2, *vex, *sex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         sex = p_expr(tp_integer);
+ 	sex = doseek(copyexpr(fex),
+ 		     makeexpr_times(sex, makeexpr_long(512)))->exp1;
+     } else
+         sex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fread", tp_integer,
+ 			   makeexpr_addr(vex),
+ 			   makeexpr_long(512),
+ 			   convert_size(type, ex2, "BLOCKREAD"),
+ 			   filebasename(copyexpr(fex)));
+     return makeexpr_comma(sex, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_blockwrite()
+ {
+     Expr *ex, *ex2, *vex, *sex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         sex = p_expr(tp_integer);
+ 	sex = doseek(copyexpr(fex),
+ 		     makeexpr_times(sex, makeexpr_long(512)))->exp1;
+     } else
+         sex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fwrite", tp_integer,
+ 			   makeexpr_addr(vex),
+ 			   makeexpr_long(512),
+ 			   convert_size(type, ex2, "BLOCKWRITE"),
+ 			   filebasename(copyexpr(fex)));
+     return makeexpr_comma(sex, ex);
+ }
+ 
+ 
+ 
+ 
+ Static Stmt *proc_blockread()
+ {
+     Expr *ex, *ex2, *vex, *rex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         rex = p_expr(tp_integer);
+     } else
+         rex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     if (rex) {
+         ex = makeexpr_bicall_4("fread", tp_integer,
+                                makeexpr_addr(vex),
+                                makeexpr_long(1),
+                                convert_size(type, ex2, "BLOCKREAD"),
+                                filebasename(copyexpr(fex)));
+         ex = makeexpr_assign(rex, ex);
+         if (!iocheck_flag)
+             ex = makeexpr_comma(ex,
+                                 makeexpr_assign(makeexpr_var(mp_ioresult),
+                                                 makeexpr_long(0)));
+     } else {
+         ex = makeexpr_bicall_4("fread", tp_integer,
+                                makeexpr_addr(vex),
+                                convert_size(type, ex2, "BLOCKREAD"),
+                                makeexpr_long(1),
+                                filebasename(copyexpr(fex)));
+         if (checkeof(fex)) {
+             ex = makeexpr_bicall_2(name_SETIO, tp_void,
+                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ 				   makeexpr_name(endoffilename, tp_int));
+         }
+     }
+     return wrapopencheck(makestmt_call(ex), fex);
+ }
+ 
+ 
+ 
+ 
+ Static Stmt *proc_blockwrite()
+ {
+     Expr *ex, *ex2, *vex, *rex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         rex = p_expr(tp_integer);
+     } else
+         rex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     if (rex) {
+         ex = makeexpr_bicall_4("fwrite", tp_integer,
+                                makeexpr_addr(vex),
+                                makeexpr_long(1),
+                                convert_size(type, ex2, "BLOCKWRITE"),
+                                filebasename(copyexpr(fex)));
+         ex = makeexpr_assign(rex, ex);
+         if (!iocheck_flag)
+             ex = makeexpr_comma(ex,
+                                 makeexpr_assign(makeexpr_var(mp_ioresult),
+                                                 makeexpr_long(0)));
+     } else {
+         ex = makeexpr_bicall_4("fwrite", tp_integer,
+                                makeexpr_addr(vex),
+                                convert_size(type, ex2, "BLOCKWRITE"),
+                                makeexpr_long(1),
+                                filebasename(copyexpr(fex)));
+         if (FCheck(checkfilewrite)) {
+             ex = makeexpr_bicall_2(name_SETIO, tp_void,
+                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ 				   makeexpr_name(filewriteerrorname, tp_int));
+         }
+     }
+     return wrapopencheck(makestmt_call(ex), fex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_bclr()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makestmt_assign(ex,
+ 			   makeexpr_bin(EK_BAND, ex->val.type,
+ 					copyexpr(ex),
+ 					makeexpr_un(EK_BNOT, ex->val.type,
+ 					makeexpr_bin(EK_LSH, tp_integer,
+ 						     makeexpr_arglong(
+ 						         makeexpr_long(1), 1),
+ 						     ex2))));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_bset()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makestmt_assign(ex,
+ 			   makeexpr_bin(EK_BOR, ex->val.type,
+ 					copyexpr(ex),
+ 					makeexpr_bin(EK_LSH, tp_integer,
+ 						     makeexpr_arglong(
+ 						         makeexpr_long(1), 1),
+ 						     ex2)));
+ }
+ 
+ 
+ 
+ Static Expr *func_bsl()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makeexpr_bin(EK_LSH, tp_integer, ex, ex2);
+ }
+ 
+ 
+ 
+ Static Expr *func_bsr()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makeexpr_bin(EK_RSH, tp_integer, force_unsigned(ex), ex2);
+ }
+ 
+ 
+ 
+ Static Expr *func_btst()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makeexpr_rel(EK_NE,
+ 			makeexpr_bin(EK_BAND, tp_integer,
+ 				     ex,
+ 				     makeexpr_bin(EK_LSH, tp_integer,
+ 						  makeexpr_arglong(
+ 						      makeexpr_long(1), 1),
+ 						  ex2)),
+ 			makeexpr_long(0));
+ }
+ 
+ 
+ 
+ Static Expr *func_byteread()
+ {
+     Expr *ex, *ex2, *vex, *sex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         sex = p_expr(tp_integer);
+ 	sex = doseek(copyexpr(fex), sex)->exp1;
+     } else
+         sex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fread", tp_integer,
+ 			   makeexpr_addr(vex),
+ 			   makeexpr_long(1),
+ 			   convert_size(type, ex2, "BYTEREAD"),
+ 			   filebasename(copyexpr(fex)));
+     return makeexpr_comma(sex, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_bytewrite()
+ {
+     Expr *ex, *ex2, *vex, *sex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         sex = p_expr(tp_integer);
+ 	sex = doseek(copyexpr(fex), sex)->exp1;
+     } else
+         sex = NULL;
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fwrite", tp_integer,
+ 			   makeexpr_addr(vex),
+ 			   makeexpr_long(1),
+ 			   convert_size(type, ex2, "BYTEWRITE"),
+ 			   filebasename(copyexpr(fex)));
+     return makeexpr_comma(sex, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_byte_offset()
+ {
+     Type *tp;
+     Meaning *mp;
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     tp = p_type(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     if (!wexpecttok(TOK_IDENT))
+ 	return NULL;
+     mp = curtoksym->fbase;
+     while (mp && mp->rectype != tp)
+ 	mp = mp->snext;
+     if (!mp)
+ 	ex = makeexpr_name(curtokcase, tp_integer);
+     else
+ 	ex = makeexpr_name(mp->name, tp_integer);
+     gettok();
+     skipcloseparen();
+     return makeexpr_bicall_2("OFFSETOF", (size_t_long) ? tp_integer : tp_int,
+ 			     makeexpr_type(tp), ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_call()
+ {
+     Expr *ex, *ex2, *ex3;
+     Type *type, *tp;
+     Meaning *mp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex2 = p_expr(tp_proc);
+     type = ex2->val.type;
+     if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
+         warning("CALL requires a procedure variable [208]");
+ 	type = tp_proc;
+     }
+     ex = makeexpr(EK_SPCALL, 1);
+     ex->val.type = tp_void;
+     ex->args[0] = copyexpr(ex2);
+     if (type->escale != 0)
+ 	ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
+ 				    makepointertype(type->basetype));
+     mp = type->basetype->fbase;
+     if (mp) {
+         if (wneedtok(TOK_COMMA))
+ 	    ex = p_funcarglist(ex, mp, 0, 0);
+     }
+     skipcloseparen();
+     if (type->escale != 1 || hasstaticlinks == 2) {
+ 	freeexpr(ex2);
+ 	return makestmt_call(ex);
+     }
+     ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+     ex3 = copyexpr(ex);
+     insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+     tp = maketype(TK_FUNCTION);
+     tp->basetype = type->basetype->basetype;
+     tp->fbase = type->basetype->fbase;
+     tp->issigned = 1;
+     ex3->args[0]->val.type = makepointertype(tp);
+     return makestmt_if(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+                        makestmt_call(ex3),
+                        makestmt_call(ex));
+ }
+ 
+ 
+ 
+ Static Expr *func_chr()
+ {
+     Expr *ex;
+ 
+     ex = p_expr(tp_integer);
+     if ((exprlongness(ex) < 0 || ex->kind == EK_CAST) && ex->kind != EK_ACTCAST)
+         ex->val.type = tp_char;
+     else
+         ex = makeexpr_cast(ex, tp_char);
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_close()
+ {
+     Stmt *sp;
+     Expr *fex, *ex;
+     char *opt;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     sp = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
+ 				  makeexpr_nil()),
+                      makestmt_call(makeexpr_bicall_1("fclose", tp_void,
+                                                      filebasename(copyexpr(fex)))),
+                      (FCheck(checkfileisopen))
+ 		         ? makestmt_call(
+ 			     makeexpr_bicall_1(name_ESCIO,
+ 					       tp_integer,
+ 					       makeexpr_name(filenotopenname,
+ 							     tp_int)))
+                          : NULL);
+     if (curtok == TOK_COMMA) {
+         gettok();
+ 	opt = "";
+ 	if (curtok == TOK_IDENT &&
+ 	    (!strcicmp(curtokbuf, "LOCK") ||
+ 	     !strcicmp(curtokbuf, "PURGE") ||
+ 	     !strcicmp(curtokbuf, "NORMAL") ||
+ 	     !strcicmp(curtokbuf, "CRUNCH"))) {
+ 	    opt = stralloc(curtokbuf);
+ 	    gettok();
+ 	} else {
+ 	    ex = p_expr(tp_str255);
+ 	    if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING)
+ 		opt = ex->val.s;
+ 	}
+ 	if (!strcicmp(opt, "PURGE")) {
+ 	    note("File is being closed with PURGE option [186]");
+         }
+     }
+     sp = makestmt_seq(sp, makestmt_assign(filebasename(fex), makeexpr_nil()));
+     skipcloseparen();
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *func_concat()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return makeexpr_string("oops");
+     ex = p_expr(tp_str255);
+     while (curtok == TOK_COMMA) {
+         gettok();
+         ex = makeexpr_concat(ex, p_expr(tp_str255), 0);
+     }
+     skipcloseparen();
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_copy(ex)
+ Expr *ex;
+ {
+     if (isliteralconst(ex->args[3], NULL) == 2 &&
+         ex->args[3]->val.i >= stringceiling) {
+         return makeexpr_bicall_3("sprintf", ex->val.type,
+                                  ex->args[0],
+                                  makeexpr_string("%s"),
+                                  bumpstring(ex->args[1], 
+                                             makeexpr_unlongcast(ex->args[2]), 1));
+     }
+     if (checkconst(ex->args[2], 1)) {
+         return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
+                                                 ex->args[2], ex->args[3]));
+     }
+     return makeexpr_bicall_4(strsubname, ex->val.type,
+                              ex->args[0],
+                              ex->args[1],
+                              makeexpr_arglong(ex->args[2], 0),
+                              makeexpr_arglong(ex->args[3], 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_cos(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("cos", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ Static Expr *func_cosh(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("cosh", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_cycle()
+ {
+     return makestmt(SK_CONTINUE);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_date()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_str255);
+     skipcloseparen();
+     return makestmt_call(makeexpr_bicall_1("VAXdate", tp_integer, ex));
+ }
+ 
+ 
+ Static Stmt *proc_dec()
+ {
+     Expr *vex, *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         ex = p_expr(tp_integer);
+     } else
+         ex = makeexpr_long(1);
+     skipcloseparen();
+     return makestmt_assign(vex, makeexpr_minus(copyexpr(vex), ex));
+ }
+ 
+ 
+ 
+ Static Expr *func_dec()
+ {
+     return handle_vax_hex(NULL, "d", 0);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_delete(ex)
+ Expr *ex;
+ {
+     if (ex->nargs == 1)   /* Kludge for Oregon Software Pascal's delete(f) */
+ 	return makestmt_call(makeexpr_bicall_1(strdeletename, tp_void, ex->args[0]));
+     return makestmt_call(makeexpr_bicall_3(strdeletename, tp_void,
+                                            ex->args[0], 
+                                            makeexpr_arglong(ex->args[1], 0),
+                                            makeexpr_arglong(ex->args[2], 0)));
+ }
+ 
+ 
+ 
+ void parse_special_variant(tp, buf)
+ Type *tp;
+ char *buf;
+ {
+     char *cp;
+     Expr *ex;
+ 
+     if (!tp)
+ 	intwarning("parse_special_variant", "tp == NULL");
+     if (!tp || tp->meaning == NULL) {
+ 	*buf = 0;
+ 	if (curtok == TOK_COMMA) {
+ 	    skiptotoken(TOK_RPAR);
+ 	}
+ 	return;
+     }
+     strcpy(buf, tp->meaning->name);
+     while (curtok == TOK_COMMA) {
+ 	gettok();
+ 	cp = buf + strlen(buf);
+ 	*cp++ = '.';
+ 	if (curtok == TOK_MINUS) {
+ 	    *cp++ = '-';
+ 	    gettok();
+ 	}
+ 	if (curtok == TOK_INTLIT ||
+ 	    curtok == TOK_HEXLIT ||
+ 	    curtok == TOK_OCTLIT) {
+ 	    sprintf(cp, "%ld", curtokint);
+ 	    gettok();
+ 	} else if (curtok == TOK_HAT || curtok == TOK_STRLIT) {
+ 	    ex = makeexpr_charcast(accumulate_strlit());
+ 	    if (ex->kind == EK_CONST) {
+ 		if (ex->val.i <= 32 || ex->val.i > 126 ||
+ 		    ex->val.i == '\'' || ex->val.i == '\\' ||
+ 		    ex->val.i == '=' || ex->val.i == '}')
+ 		    sprintf(cp, "%ld", ex->val.i);
+ 		else
+ 		    strcpy(cp, makeCchar(ex->val.i));
+ 	    } else {
+ 		*buf = 0;
+ 		*cp = 0;
+ 	    }
+ 	    freeexpr(ex);
+ 	} else {
+ 	    if (!wexpecttok(TOK_IDENT)) {
+ 		skiptotoken(TOK_RPAR);
+ 		return;
+ 	    }
+ 	    if (curtokmeaning)
+ 		strcpy(cp, curtokmeaning->name);
+ 	    else
+ 		strcpy(cp, curtokbuf);
+ 	    gettok();
+ 	}
+     }
+ }
+ 
+ 
+ char *find_special_variant(buf, spname, splist, need)
+ char *buf, *spname;
+ Strlist *splist;
+ int need;
+ {
+     Strlist *best = NULL;
+     int len, bestlen = -1;
+     char *cp, *cp2;
+ 
+     if (!*buf)
+ 	return NULL;
+     while (splist) {
+ 	cp = splist->s;
+ 	cp2 = buf;
+ 	while (*cp && toupper(*cp) == toupper(*cp2))
+ 	    cp++, cp2++;
+ 	len = cp2 - buf;
+ 	if (!*cp && (!*cp2 || *cp2 == '.') && len > bestlen) {
+ 	    best = splist;
+ 	    bestlen = len;
+ 	}
+ 	splist = splist->next;
+     }
+     if (bestlen != strlen(buf) && my_strchr(buf, '.')) {
+ 	if ((need & 1) || bestlen >= 0) {
+ 	    if (need & 2)
+ 		return NULL;
+ 	    if (spname)
+ 		note(format_ss("No %s form known for %s [187]",
+ 			       spname, strupper(buf)));
+ 	}
+     }
+     if (bestlen >= 0)
+ 	return (char *)best->value;
+     else
+ 	return NULL;
+ }
+ 
+ 
+ 
+ Static char *choose_free_func(ex)
+ Expr *ex;
+ {
+     if (!*freename) {
+ 	if (!*freervaluename)
+ 	    return "free";
+ 	else
+ 	    return freervaluename;
+     }
+     if (!*freervaluename)
+ 	return freervaluename;
+     if (expr_is_lvalue(ex))
+ 	return freename;
+     else
+ 	return freervaluename;
+ }
+ 
+ 
+ Static Stmt *proc_dispose()
+ {
+     Expr *ex;
+     Type *type;
+     char *name, vbuf[1000];
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_anyptr);
+     type = ex->val.type->basetype;
+     parse_special_variant(type, vbuf);
+     skipcloseparen();
+     name = find_special_variant(vbuf, "SpecialFree", specialfrees, 0);
+     if (!name)
+ 	name = choose_free_func(ex);
+     return makestmt_call(makeexpr_bicall_1(name, tp_void, ex));
+ }
+ 
+ 
+ 
+ Static Expr *func_exp(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("exp", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_expo(ex)
+ Expr *ex;
+ {
+     Meaning *tvar;
+ 
+     tvar = makestmttempvar(tp_int, name_TEMP);
+     return makeexpr_comma(makeexpr_bicall_2("frexp", tp_longreal,
+ 					    grabarg(ex, 0),
+ 					    makeexpr_addr(makeexpr_var(tvar))),
+ 			  makeexpr_var(tvar));
+ }
+ 
+ 
+ 
+ int is_std_file(ex)
+ Expr *ex;
+ {
+     return isvar(ex, mp_input) || isvar(ex, mp_output) ||
+            isvar(ex, mp_stderr);
+ }
+ 
+ 
+ 
+ Static Expr *iofunc(ex, code)
+ Expr *ex;
+ int code;
+ {
+     Expr *ex2 = NULL, *ex3 = NULL;
+     Meaning *tvar = NULL;
+ 
+     if (FCheck(checkfileisopen) && !is_std_file(ex)) {
+         if (isfiletype(ex->val.type, 1) ||
+ 	    (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
+             ex2 = filebasename(copyexpr(ex));
+ 	} else {
+             ex3 = ex;
+             tvar = makestmttempvar(ex->val.type, name_TEMP);
+             ex2 = makeexpr_var(tvar);
+             ex = makeexpr_var(tvar);
+         }
+     }
+     ex = filebasename(ex);
+     switch (code) {
+ 
+         case 0:  /* eof */
+             if (fileisbuffered(ex, 0) && *eofbufname)
+ 		ex = makeexpr_bicall_1(eofbufname, tp_boolean, ex);
+ 	    else if (*eofname)
+ 		ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
+ 	    else
+ 		ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
+ 				         makeexpr_long(0));
+             break;
+ 
+         case 1:  /* eoln */
+             ex = makeexpr_bicall_1(eolnname, tp_boolean, ex);
+             break;
+ 
+         case 2:  /* position or filepos */
+             if (fileisbuffered(ex, 0) && *fileposbufname)
+ 		ex = makeexpr_bicall_1(fileposbufname, tp_integer, ex);
+ 	    else
+ 		ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
+             break;
+ 
+         case 3:  /* maxpos or filesize */
+             ex = makeexpr_bicall_1(maxposname, tp_integer, ex);
+             break;
+ 
+     }
+     if (ex2) {
+         ex = makeexpr_bicall_4("~CHKIO",
+                                (code == 0 || code == 1) ? tp_boolean : tp_integer,
+                                makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ 			       makeexpr_name("FileNotOpen", tp_int),
+                                ex, makeexpr_long(0));
+     }
+     if (ex3)
+         ex = makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex3), ex);
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_eof()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR)
+         ex = p_parexpr(tp_text);
+     else
+         ex = makeexpr_var(mp_input);
+     return iofunc(ex, 0);
+ }
+ 
+ 
+ 
+ Static Expr *func_eoln()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR)
+         ex = p_parexpr(tp_text);
+     else
+         ex = makeexpr_var(mp_input);
+     return iofunc(ex, 1);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_escape()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR)
+         ex = p_parexpr(tp_integer);
+     else
+         ex = makeexpr_long(0);
+     return makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int, 
+                                            makeexpr_arglong(ex, 0)));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_excl()
+ {
+     Expr *vex, *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(vex->val.type->indextype);
+     skipcloseparen();
+     if (vex->val.type->kind == TK_SMALLSET)
+ 	return makestmt_assign(vex, makeexpr_bin(EK_BAND, vex->val.type,
+ 						 copyexpr(vex),
+ 						 makeexpr_un(EK_BNOT, vex->val.type,
+ 							     makeexpr_bin(EK_LSH, vex->val.type,
+ 									  makeexpr_longcast(makeexpr_long(1), 1),
+ 									  ex))));
+     else
+ 	return makestmt_call(makeexpr_bicall_2(setremname, tp_void, vex,
+ 					       makeexpr_arglong(enum_to_int(ex), 0)));
+ }
+ 
+ 
+ 
+ Stmt *proc_exit()
+ {
+     Stmt *sp;
+ 
+     if (modula2) {
+ 	return makestmt(SK_BREAK);
+     }
+     if (curtok == TOK_LPAR) {
+         gettok();
+ 	if (curtok == TOK_PROGRAM ||
+ 	    (curtok == TOK_IDENT && curtokmeaning->kind == MK_MODULE)) {
+ 	    gettok();
+ 	    skipcloseparen();
+ 	    return makestmt_call(makeexpr_bicall_1("exit", tp_void,
+ 						   makeexpr_name("EXIT_SUCCESS",
+ 								 tp_integer)));
+ 	}
+         if (curtok != TOK_IDENT || !curtokmeaning || curtokmeaning != curctx)
+             note("Attempting to EXIT beyond this function [188]");
+         gettok();
+ 	skipcloseparen();
+     }
+     sp = makestmt(SK_RETURN);
+     if (curctx->kind == MK_FUNCTION && curctx->isfunction) {
+         sp->exp1 = makeexpr_var(curctx->cbase);
+         curctx->cbase->refcount++;
+     }
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *file_iofunc(code, base)
+ int code;
+ long base;
+ {
+     Expr *ex;
+     Type *basetype;
+ 
+     if (curtok == TOK_LPAR)
+ 	ex = p_parexpr(tp_text);
+     else
+ 	ex = makeexpr_var(mp_input);
+     if (!ex->val.type || !ex->val.type->basetype ||
+ 	!filebasetype(ex->val.type))
+ 	basetype = tp_char;
+     else
+ 	basetype = filebasetype(ex->val.type);
+     return makeexpr_plus(makeexpr_div(iofunc(ex, code),
+                                       makeexpr_sizeof(makeexpr_type(basetype), 0)),
+                          makeexpr_long(base));
+ }
+ 
+ 
+ 
+ Static Expr *func_fcall()
+ {
+     Expr *ex, *ex2, *ex3;
+     Type *type, *tp;
+     Meaning *mp, *tvar = NULL;
+     int firstarg = 0;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex2 = p_expr(tp_proc);
+     type = ex2->val.type;
+     if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
+         warning("FCALL requires a function variable [209]");
+ 	type = tp_proc;
+     }
+     ex = makeexpr(EK_SPCALL, 1);
+     ex->val.type = type->basetype->basetype;
+     ex->args[0] = copyexpr(ex2);
+     if (type->escale != 0)
+ 	ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
+ 				    makepointertype(type->basetype));
+     mp = type->basetype->fbase;
+     if (mp && mp->isreturn) {    /* pointer to buffer for return value */
+         tvar = makestmttempvar(ex->val.type->basetype,
+             (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+         insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
+         mp = mp->xnext;
+ 	firstarg++;
+     }
+     if (mp) {
+         if (wneedtok(TOK_COMMA))
+ 	    ex = p_funcarglist(ex, mp, 0, 0);
+     }
+     if (tvar)
+ 	ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
+     skipcloseparen();
+     if (type->escale != 1 || hasstaticlinks == 2) {
+ 	freeexpr(ex2);
+ 	return ex;
+     }
+     ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+     ex3 = copyexpr(ex);
+     insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+     tp = maketype(TK_FUNCTION);
+     tp->basetype = type->basetype->basetype;
+     tp->fbase = type->basetype->fbase;
+     tp->issigned = 1;
+     ex3->args[0]->val.type = makepointertype(tp);
+     return makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ 			 ex3, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_filepos()
+ {
+     return file_iofunc(2, seek_base);
+ }
+ 
+ 
+ 
+ Static Expr *func_filesize()
+ {
+     return file_iofunc(3, 1L);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_fillchar()
+ {
+     Expr *vex, *ex, *cex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = gentle_cast(makeexpr_addr(p_expr(NULL)), tp_anyptr);
+     if (!skipcomma())
+ 	return NULL;
+     ex = convert_size(argbasetype(vex), p_expr(tp_integer), "FILLCHAR");
+     if (!skipcomma())
+ 	return NULL;
+     cex = makeexpr_charcast(p_expr(tp_integer));
+     skipcloseparen();
+     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+                                            vex,
+                                            makeexpr_arglong(cex, 0),
+                                            makeexpr_arglong(ex, (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ Static Expr *func_sngl()
+ {
+     Expr *ex;
+ 
+     ex = p_parexpr(tp_real);
+     return makeexpr_cast(ex, tp_real);
+ }
+ 
+ 
+ 
+ Static Expr *func_float()
+ {
+     Expr *ex;
+ 
+     ex = p_parexpr(tp_longreal);
+     return makeexpr_cast(ex, tp_longreal);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_flush()
+ {
+     Expr *ex;
+     Stmt *sp;
+ 
+     ex = p_parexpr(tp_text);
+     sp = makestmt_call(makeexpr_bicall_1("fflush", tp_void, filebasename(ex)));
+     if (iocheck_flag)
+         sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(mp_ioresult), 
+                                               makeexpr_long(0)));
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *func_frac(ex)
+ Expr *ex;
+ {
+     Meaning *tvar;
+ 
+     tvar = makestmttempvar(tp_longreal, name_DUMMY);
+     return makeexpr_bicall_2("modf", tp_longreal, 
+                              grabarg(ex, 0),
+                              makeexpr_addr(makeexpr_var(tvar)));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_freemem(ex)
+ Expr *ex;
+ {
+     Stmt *sp;
+     Expr *vex;
+ 
+     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+     sp = makestmt_call(makeexpr_bicall_1(choose_free_func(vex),
+ 					 tp_void, copyexpr(vex)));
+     if (alloczeronil) {
+         sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
+                          sp, NULL);
+     } else
+         freeexpr(vex);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_get()
+ {
+     Expr *ex;
+     Type *type;
+ 
+     if (curtok == TOK_LPAR)
+ 	ex = p_parexpr(tp_text);
+     else
+ 	ex = makeexpr_var(mp_input);
+     requirefilebuffer(ex);
+     type = ex->val.type;
+     if (isfiletype(type, -1) && *chargetname &&
+ 	filebasetype(type)->kind == TK_CHAR)
+ 	return makestmt_call(makeexpr_bicall_1(chargetname, tp_void,
+ 					       filebasename(ex)));
+     else if (isfiletype(type, -1) && *arraygetname &&
+ 	     filebasetype(type)->kind == TK_ARRAY)
+ 	return makestmt_call(makeexpr_bicall_2(arraygetname, tp_void,
+ 					       filebasename(ex),
+ 					       makeexpr_type(filebasetype(type))));
+     else
+ 	return makestmt_call(makeexpr_bicall_2(getname, tp_void,
+ 					       filebasename(ex),
+ 					       makeexpr_type(filebasetype(type))));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_getmem(ex)
+ Expr *ex;
+ {
+     Expr *vex, *ex2, *sz = NULL;
+     Stmt *sp;
+ 
+     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+     ex2 = ex->args[1];
+     if (vex->val.type->kind == TK_POINTER)
+         ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM");
+     if (alloczeronil)
+         sz = copyexpr(ex2);
+     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
+     sp = makestmt_assign(copyexpr(vex), ex2);
+     if (malloccheck) {
+         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
+                                           makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
+                                           NULL));
+     }
+     if (sz && !isconstantexpr(sz)) {
+         if (alloczeronil == 2)
+             note("Called GETMEM with variable argument [189]");
+         sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
+                          sp,
+                          makestmt_assign(vex, makeexpr_nil()));
+     } else
+         freeexpr(vex);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_gotoxy(ex)
+ Expr *ex;
+ {
+     return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
+                                            makeexpr_arglong(ex->args[0], 0),
+                                            makeexpr_arglong(ex->args[1], 0)));
+ }
+ 
+ 
+ 
+ Static Expr *handle_vax_hex(ex, fmt, scale)
+ Expr *ex;
+ char *fmt;
+ int scale;
+ {
+     Expr *lex, *dex, *vex;
+     Meaning *tvar;
+     Type *tp;
+     long smin, smax;
+     int bits;
+ 
+     if (!ex) {
+ 	if (!skipopenparen())
+ 	    return NULL;
+ 	ex = p_expr(tp_integer);
+     }
+     tp = true_type(ex);
+     if (ord_range(tp, &smin, &smax))
+ 	bits = typebits(smin, smax);
+     else
+ 	bits = 32;
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	if (curtok != TOK_COMMA)
+ 	    lex = makeexpr_arglong(p_expr(tp_integer), 0);
+ 	else
+ 	    lex = NULL;
+     } else
+ 	lex = NULL;
+     if (!lex) {
+ 	if (!scale)
+ 	    lex = makeexpr_long(11);
+ 	else
+ 	    lex = makeexpr_long((bits+scale-1) / scale + 1);
+     }
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	dex = makeexpr_arglong(p_expr(tp_integer), 0);
+     } else {
+ 	if (!scale)
+ 	    dex = makeexpr_long(10);
+ 	else
+ 	    dex = makeexpr_long((bits+scale-1) / scale);
+     }
+     if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
+ 	lex->val.i < dex->val.i)
+ 	lex = NULL;
+     skipcloseparen();
+     tvar = makestmttempvar(tp_str255, name_STRING);
+     vex = makeexpr_var(tvar);
+     ex = makeexpr_forcelongness(ex);
+     if (exprlongness(ex) > 0)
+ 	fmt = format_s("l%s", fmt);
+     if (checkconst(lex, 0) || checkconst(lex, 1))
+ 	lex = NULL;
+     if (checkconst(dex, 0) || checkconst(dex, 1))
+ 	dex = NULL;
+     if (lex) {
+ 	if (dex)
+ 	    ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+ 				   makeexpr_string(format_s("%%*.*%s", fmt)),
+ 				   lex, dex, ex);
+ 	else
+ 	    ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ 				   makeexpr_string(format_s("%%*%s", fmt)),
+ 				   lex, ex);
+     } else {
+ 	if (dex)
+ 	    ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ 				   makeexpr_string(format_s("%%.*%s", fmt)),
+ 				   dex, ex);
+ 	else
+ 	    ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ 				   makeexpr_string(format_s("%%%s", fmt)),
+ 				   ex);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Static Expr *func_hex()
+ {
+     Expr *ex;
+     char *cp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = makeexpr_stringcast(p_expr(tp_integer));
+     if ((ex->val.type->kind == TK_STRING ||
+ 	 ex->val.type == tp_strptr) &&
+ 	curtok != TOK_COMMA) {
+ 	skipcloseparen();
+ 	if (ex->kind == EK_CONST) {    /* HP Pascal */
+ 	    cp = getstring(ex);
+ 	    ex = makeexpr_long(my_strtol(cp, NULL, 16));
+ 	    insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ 	    return ex;
+ 	} else {
+ 	    return makeexpr_bicall_3("strtol", tp_integer, 
+ 				     ex, makeexpr_nil(), makeexpr_long(16));
+ 	}
+     } else {    /* VAX Pascal */
+ 	return handle_vax_hex(ex, "x", 4);
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_hi()
+ {
+     Expr *ex;
+ 
+     ex = force_unsigned(p_parexpr(tp_integer));
+     return makeexpr_bin(EK_RSH, tp_ubyte,
+                         ex, makeexpr_long(8));
+ }
+ 
+ 
+ 
+ Static Expr *func_high()
+ {
+     Expr *ex;
+     Type *type;
+ 
+     ex = p_parexpr(tp_integer);
+     type = ex->val.type;
+     if (type->kind == TK_POINTER)
+ 	type = type->basetype;
+     if (type->kind == TK_ARRAY ||
+ 	type->kind == TK_SMALLARRAY) {
+ 	ex = makeexpr_minus(copyexpr(type->indextype->smax),
+ 			    copyexpr(type->indextype->smin));
+     } else {
+ 	warning("HIGH requires an array name parameter [210]");
+ 	ex = makeexpr_bicall_1("HIGH", tp_int, ex);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_hiword()
+ {
+     Expr *ex;
+ 
+     ex = force_unsigned(p_parexpr(tp_unsigned));
+     return makeexpr_bin(EK_RSH, tp_unsigned,
+                         ex, makeexpr_long(16));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_inc()
+ {
+     Expr *vex, *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         ex = p_expr(tp_integer);
+     } else
+         ex = makeexpr_long(1);
+     skipcloseparen();
+     return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_incl()
+ {
+     Expr *vex, *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(vex->val.type->indextype);
+     skipcloseparen();
+     if (vex->val.type->kind == TK_SMALLSET)
+ 	return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type,
+ 						 copyexpr(vex),
+ 						 makeexpr_bin(EK_LSH, vex->val.type,
+ 							      makeexpr_longcast(makeexpr_long(1), 1),
+ 							      ex)));
+     else
+ 	return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
+ 					       makeexpr_arglong(enum_to_int(ex), 0)));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_insert(ex)
+ Expr *ex;
+ {
+     return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
+                                            ex->args[0], 
+                                            ex->args[1],
+                                            makeexpr_arglong(ex->args[2], 0)));
+ }
+ 
+ 
+ 
+ Static Expr *func_int()
+ {
+     Expr *ex;
+     Meaning *tvar;
+ 
+     ex = p_parexpr(tp_integer);
+     if (ex->val.type->kind == TK_REAL) {    /* Turbo Pascal INT */
+ 	tvar = makestmttempvar(tp_longreal, name_TEMP);
+ 	return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
+ 						grabarg(ex, 0),
+ 						makeexpr_addr(makeexpr_var(tvar))),
+ 			      makeexpr_var(tvar));
+     } else {     /* VAX Pascal INT */
+ 	return makeexpr_ord(ex);
+     }
+ }
+ 
+ 
+ Static Expr *func_uint()
+ {
+     Expr *ex;
+ 
+     ex = p_parexpr(tp_integer);
+     return makeexpr_cast(ex, tp_unsigned);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_leave()
+ {
+     return makestmt(SK_BREAK);
+ }
+ 
+ 
+ 
+ Static Expr *func_lo()
+ {
+     Expr *ex;
+ 
+     ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
+     return makeexpr_bin(EK_BAND, tp_ubyte,
+                         ex, makeexpr_long(255));
+ }
+ 
+ 
+ Static Expr *func_loophole()
+ {
+     Type *type;
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     type = p_type(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     skipcloseparen();
+     return pascaltypecast(type, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_lower()
+ {
+     Expr *ex;
+     Value val;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	val = p_constant(tp_integer);
+ 	if (!val.type || val.i != 1)
+ 	    note("LOWER(v,n) not supported for n>1 [190]");
+     }
+     skipcloseparen();
+     return copyexpr(ex->val.type->indextype->smin);
+ }
+ 
+ 
+ 
+ Static Expr *func_loword()
+ {
+     Expr *ex;
+ 
+     ex = p_parexpr(tp_integer);
+     return makeexpr_bin(EK_BAND, tp_ushort,
+                         ex, makeexpr_long(65535));
+ }
+ 
+ 
+ 
+ Static Expr *func_ln(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_log(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_max()
+ {
+     Type *tp;
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     if (curtok == TOK_IDENT && curtokmeaning &&
+ 	curtokmeaning->kind == MK_TYPE) {
+ 	tp = curtokmeaning->type;
+ 	gettok();
+ 	skipcloseparen();
+ 	return copyexpr(tp->smax);
+     }
+     ex = p_expr(tp_integer);
+     while (curtok == TOK_COMMA) {
+ 	gettok();
+ 	ex2 = p_expr(ex->val.type);
+ 	if (ex->val.type->kind == TK_REAL) {
+ 	    tp = ex->val.type;
+ 	    if (ex2->val.type->kind != TK_REAL)
+ 		ex2 = makeexpr_cast(ex2, tp);
+ 	} else {
+ 	    tp = ex2->val.type;
+ 	    if (ex->val.type->kind != TK_REAL)
+ 		ex = makeexpr_cast(ex, tp);
+ 	}
+ 	ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
+ 			       tp, ex, ex2);
+     }				
+     skipcloseparen();
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_maxavail(ex)
+ Expr *ex;
+ {
+     freeexpr(ex);
+     return makeexpr_bicall_0("maxavail", tp_integer);
+ }
+ 
+ 
+ 
+ Static Expr *func_maxpos()
+ {
+     return file_iofunc(3, seek_base);
+ }
+ 
+ 
+ 
+ Static Expr *func_memavail(ex)
+ Expr *ex;
+ {
+     freeexpr(ex);
+     return makeexpr_bicall_0("memavail", tp_integer);
+ }
+ 
+ 
+ 
+ Static Expr *var_mem()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!wneedtok(TOK_LBR))
+ 	return makeexpr_name("MEM", tp_integer);
+     ex = p_expr(tp_integer);
+     if (curtok == TOK_COLON) {
+ 	gettok();
+ 	ex2 = p_expr(tp_integer);
+ 	ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
+     } else {
+ 	ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
+     }
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     note("Reference to MEM [191]");
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *var_memw()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!wneedtok(TOK_LBR))
+ 	return makeexpr_name("MEMW", tp_integer);
+     ex = p_expr(tp_integer);
+     if (curtok == TOK_COLON) {
+ 	gettok();
+ 	ex2 = p_expr(tp_integer);
+ 	ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
+     } else {
+ 	ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
+     }
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     note("Reference to MEMW [191]");
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *var_meml()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!wneedtok(TOK_LBR))
+ 	return makeexpr_name("MEML", tp_integer);
+     ex = p_expr(tp_integer);
+     if (curtok == TOK_COLON) {
+ 	gettok();
+ 	ex2 = p_expr(tp_integer);
+ 	ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
+     } else {
+ 	ex = makeexpr_bicall_1("MEML", tp_integer, ex);
+     }
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     note("Reference to MEML [191]");
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_min()
+ {
+     Type *tp;
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     if (curtok == TOK_IDENT && curtokmeaning &&
+ 	curtokmeaning->kind == MK_TYPE) {
+ 	tp = curtokmeaning->type;
+ 	gettok();
+ 	skipcloseparen();
+ 	return copyexpr(tp->smin);
+     }
+     ex = p_expr(tp_integer);
+     while (curtok == TOK_COMMA) {
+ 	gettok();
+ 	ex2 = p_expr(ex->val.type);
+ 	if (ex->val.type->kind == TK_REAL) {
+ 	    tp = ex->val.type;
+ 	    if (ex2->val.type->kind != TK_REAL)
+ 		ex2 = makeexpr_cast(ex2, tp);
+ 	} else {
+ 	    tp = ex2->val.type;
+ 	    if (ex->val.type->kind != TK_REAL)
+ 		ex = makeexpr_cast(ex, tp);
+ 	}
+ 	ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
+ 			       tp, ex, ex2);
+     }				
+     skipcloseparen();
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_move(ex)
+ Expr *ex;
+ {
+     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);    /* source */
+     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);    /* dest */
+     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+                                           argbasetype(ex->args[1])), ex->args[2], "MOVE");
+     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+                                            ex->args[1],
+                                            ex->args[0],
+                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_move_fast()
+ {
+     Expr *ex, *ex2, *ex3, *ex4;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
+     ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
+     if (!skipcomma())
+ 	return NULL;
+     ex3 = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
+     ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
+     skipcloseparen();
+     ex = convert_size(choosetype(argbasetype(ex2),
+ 				 argbasetype(ex3)), ex, "MOVE_FAST");
+     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+ 					   makeexpr_addr(ex3),
+ 					   makeexpr_addr(ex2),
+ 					   makeexpr_arglong(ex, (size_t_long != 0))));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_new()
+ {
+     Expr *ex, *ex2;
+     Stmt *sp, **spp;
+     Type *type;
+     char *name, *name2 = NULL, vbuf[1000];
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_anyptr);
+     type = ex->val.type;
+     if (type->kind == TK_POINTER)
+ 	type = type->basetype;
+     parse_special_variant(type, vbuf);
+     skipcloseparen();
+     name = find_special_variant(vbuf, NULL, specialmallocs, 3);
+     if (!name) {
+         name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
+ 	if (!name2) {
+ 	    name = find_special_variant(vbuf, NULL, specialmallocs, 1);
+ 	    name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
+ 	    if (name || !name2)
+ 		name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
+ 	    else
+ 		name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
+ 	}
+     }
+     if (name) {
+ 	ex2 = makeexpr_bicall_0(name, ex->val.type);
+     } else if (name2) {
+ 	ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
+     } else {
+ 	ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
+ 				makeexpr_sizeof(makeexpr_type(type), 1));
+     }
+     sp = makestmt_assign(copyexpr(ex), ex2);
+     if (malloccheck) {
+         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
+ 						       copyexpr(ex),
+ 						       makeexpr_nil()),
+                                           makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
+                                           NULL));
+     }
+     spp = &sp->next;
+     while (*spp)
+ 	spp = &(*spp)->next;
+     if (type->kind == TK_RECORD)
+ 	initfilevars(type->fbase, &spp, makeexpr_hat(ex, 0));
+     else if (isfiletype(type, -1))
+ 	sp = makestmt_seq(sp, makestmt_call(initfilevar(makeexpr_hat(ex, 0))));
+     else
+ 	freeexpr(ex);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *func_oct()
+ {
+     return handle_vax_hex(NULL, "o", 3);
+ }
+ 
+ 
+ 
+ Static Expr *func_octal(ex)
+ Expr *ex;
+ {
+     char *cp;
+ 
+     ex = grabarg(ex, 0);
+     if (ex->kind == EK_CONST) {
+         cp = getstring(ex);
+         ex = makeexpr_long(my_strtol(cp, NULL, 8));
+         insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer));
+         return ex;
+     } else {
+         return makeexpr_bicall_3("strtol", tp_integer, 
+                                  ex, makeexpr_nil(), makeexpr_long(8));
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_odd(ex)
+ Expr *ex;
+ {
+     ex = makeexpr_unlongcast(grabarg(ex, 0));
+     if (*oddname)
+         return makeexpr_bicall_1(oddname, tp_boolean, ex);
+     else
+         return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_open()
+ {
+     return handleopen(2);
+ }
+ 
+ 
+ 
+ Static Expr *func_ord()
+ {
+     Expr *ex;
+ 
+     if (wneedtok(TOK_LPAR)) {
+ 	ex = p_ord_expr();
+ 	skipcloseparen();
+     } else
+ 	ex = p_ord_expr();
+     return makeexpr_ord(ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_ord4()
+ {
+     Expr *ex;
+ 
+     if (wneedtok(TOK_LPAR)) {
+ 	ex = p_ord_expr();
+ 	skipcloseparen();
+     } else
+ 	ex = p_ord_expr();
+     return makeexpr_longcast(makeexpr_ord(ex), 1);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_pack()
+ {
+     Expr *exs, *exd, *exi, *mind;
+     Meaning *tvar;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     exs = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_ord_expr();
+     if (!skipcomma())
+ 	return NULL;
+     exd = p_expr(NULL);
+     skipcloseparen();
+     if (exs->val.type->kind != TK_ARRAY ||
+ 	(exd->val.type->kind != TK_ARRAY &&
+ 	 exd->val.type->kind != TK_SMALLARRAY)) {
+ 	warning("Bad argument types for PACK/UNPACK [325]");
+ 	return makestmt_call(makeexpr_bicall_3("pack", tp_void,
+ 					       exs, exi, exd));
+     }
+     if (exs->val.type->smax || exd->val.type->smax) {
+ 	tvar = makestmttempvar(exd->val.type->indextype, name_TEMP);
+ 	sp = makestmt(SK_FOR);
+ 	if (exd->val.type->smin)
+ 	    mind = exd->val.type->smin;
+ 	else
+ 	    mind = exd->val.type->indextype->smin;
+ 	sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
+ 				   copyexpr(mind));
+ 	sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
+ 				copyexpr(exd->val.type->indextype->smax));
+ 	sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
+ 				   makeexpr_plus(makeexpr_var(tvar),
+ 						 makeexpr_long(1)));
+ 	exi = makeexpr_minus(exi, copyexpr(mind));
+ 	sp->stm1 = makestmt_assign(p_index(exd, makeexpr_var(tvar)),
+ 				   p_index(exs,
+ 					   makeexpr_plus(makeexpr_var(tvar),
+ 							 exi)));
+ 	return sp;
+     } else {
+ 	exi = gentle_cast(exi, exs->val.type->indextype);
+ 	return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
+ 					       exd,
+ 					       makeexpr_addr(p_index(exs, exi)),
+ 					       makeexpr_sizeof(copyexpr(exd), 0)));
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_pad(ex)
+ Expr *ex;
+ {
+     if (checkconst(ex->args[1], 0) ||    /* "s" is null string */
+ 	checkconst(ex->args[2], ' ')) {
+         return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
+                                  makeexpr_string("%*s"),
+                                  makeexpr_longcast(ex->args[3], 0),
+                                  makeexpr_string(""));
+     }
+     return makeexpr_bicall_4(strpadname, tp_strptr,
+ 			     ex->args[0], ex->args[1], ex->args[2],
+ 			     makeexpr_arglong(ex->args[3], 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_page()
+ {
+     Expr *fex, *ex;
+ 
+     if (curtok == TOK_LPAR) {
+         fex = p_parexpr(tp_text);
+         ex = makeexpr_bicall_2("fprintf", tp_int,
+                                filebasename(copyexpr(fex)),
+                                makeexpr_string("\f"));
+     } else {
+         fex = makeexpr_var(mp_output);
+         ex = makeexpr_bicall_1("printf", tp_int,
+                                makeexpr_string("\f"));
+     }
+     if (FCheck(checkfilewrite)) {
+         ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
+ 			       makeexpr_name(filewriteerrorname, tp_int));
+     }
+     return wrapopencheck(makestmt_call(ex), fex);
+ }
+ 
+ 
+ 
+ Static Expr *func_paramcount(ex)
+ Expr *ex;
+ {
+     freeexpr(ex);
+     return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
+                           makeexpr_long(1));
+ }
+ 
+ 
+ 
+ Static Expr *func_paramstr(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+ 
+     ex2 = makeexpr_index(makeexpr_name(name_ARGV,
+ 				       makepointertype(tp_strptr)),
+ 			 makeexpr_unlongcast(ex->args[1]),
+ 			 makeexpr_long(0));
+     ex2->val.type = tp_str255;
+     return makeexpr_bicall_3("sprintf", tp_strptr,
+ 			     ex->args[0],
+ 			     makeexpr_string("%s"),
+ 			     ex2);
+ }
+ 
+ 
+ 
+ Static Expr *func_pi()
+ {
+     return makeexpr_name("M_PI", tp_longreal);
+ }
+ 
+ 
+ 
+ Static Expr *var_port()
+ {
+     Expr *ex;
+ 
+     if (!wneedtok(TOK_LBR))
+ 	return makeexpr_name("PORT", tp_integer);
+     ex = p_expr(tp_integer);
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     note("Reference to PORT [191]");
+     return makeexpr_bicall_1("PORT", tp_ubyte, ex);
+ }
+ 
+ 
+ 
+ Static Expr *var_portw()
+ {
+     Expr *ex;
+ 
+     if (!wneedtok(TOK_LBR))
+ 	return makeexpr_name("PORTW", tp_integer);
+     ex = p_expr(tp_integer);
+     if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     note("Reference to PORTW [191]");
+     return makeexpr_bicall_1("PORTW", tp_ushort, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_pos(ex)
+ Expr *ex;
+ {
+     char *cp;
+ 
+     cp = strposname;
+     if (!*cp) {
+         note("POS function used [192]");
+         cp = "POS";
+     } 
+     return makeexpr_bicall_3(cp, tp_int,
+                              ex->args[1], 
+                              ex->args[0],
+                              makeexpr_long(1));
+ }
+ 
+ 
+ 
+ Static Expr *func_ptr(ex)
+ Expr *ex;
+ {
+     note("PTR function was used [193]");
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_position()
+ {
+     return file_iofunc(2, seek_base);
+ }
+ 
+ 
+ 
+ Static Expr *func_pred()
+ {
+     Expr *ex;
+ 
+     if (wneedtok(TOK_LPAR)) {
+ 	ex = p_ord_expr();
+ 	skipcloseparen();
+     } else
+ 	ex = p_ord_expr();
+ #if 1
+     ex = makeexpr_inc(ex, makeexpr_long(-1));
+ #else
+     ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
+ #endif
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_put()
+ {
+     Expr *ex;
+     Type *type;
+ 
+     if (curtok == TOK_LPAR)
+ 	ex = p_parexpr(tp_text);
+     else
+ 	ex = makeexpr_var(mp_output);
+     requirefilebuffer(ex);
+     type = ex->val.type;
+     if (isfiletype(type, -1) && *charputname &&
+ 	filebasetype(type)->kind == TK_CHAR)
+ 	return makestmt_call(makeexpr_bicall_1(charputname, tp_void,
+ 					       filebasename(ex)));
+     else if (isfiletype(type, -1) && *arrayputname &&
+ 	     filebasetype(type)->kind == TK_ARRAY)
+ 	return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void,
+ 					       filebasename(ex),
+ 					       makeexpr_type(filebasetype(type))));
+     else
+ 	return makestmt_call(makeexpr_bicall_2(putname, tp_void,
+ 					       filebasename(ex),
+ 					       makeexpr_type(filebasetype(type))));
+ }
+ 
+ 
+ 
+ Static Expr *func_pwroften(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_2("pow", tp_longreal,
+ 			     makeexpr_real("10.0"), grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_reset()
+ {
+     return handleopen(0);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_rewrite()
+ {
+     return handleopen(1);
+ }
+ 
+ 
+ 
+ 
+ Stmt *doseek(fex, ex)
+ Expr *fex, *ex;
+ {
+     Expr *ex2;
+     Type *basetype = filebasetype(fex->val.type);
+ 
+     if (ansiC == 1)
+         ex2 = makeexpr_name("SEEK_SET", tp_int);
+     else
+         ex2 = makeexpr_long(0);
+     ex = makeexpr_bicall_3("fseek", tp_int,
+                            filebasename(copyexpr(fex)),
+                            makeexpr_arglong(
+                                makeexpr_times(makeexpr_minus(ex,
+                                                              makeexpr_long(seek_base)),
+                                               makeexpr_sizeof(makeexpr_type(basetype), 0)),
+                                1),
+                            ex2);
+     if (FCheck(checkfileseek)) {
+         ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
+ 			       makeexpr_name(endoffilename, tp_int));
+     }
+     return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ 
+ Static Expr *makegetchar(fex)
+ Expr *fex;
+ {
+     if (isvar(fex, mp_input))
+         return makeexpr_bicall_0("getchar", tp_char);
+     else
+         return makeexpr_bicall_1("getc", tp_char, filebasename(copyexpr(fex)));
+ }
+ 
+ 
+ 
+ Static Stmt *fixscanf(sp, fex)
+ Stmt *sp;
+ Expr *fex;
+ {
+     int nargs, i, isstrread;
+     char *cp;
+     Expr *ex;
+     Stmt *sp2;
+ 
+     isstrread = (fex->val.type->kind == TK_STRING);
+     if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
+         !strcmp(sp->exp1->val.s, "scanf")) {
+         if (sp->exp1->args[0]->kind == EK_CONST &&
+             !(sp->exp1->args[0]->val.i&1) && !isstrread) {
+             cp = sp->exp1->args[0]->val.s;    /* scanf("%c%c") -> getchar;getchar */
+             for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
+                 i += 2;
+                 if (i == sp->exp1->args[0]->val.i) {
+                     sp2 = NULL;
+                     for (i = 1; i < sp->exp1->nargs; i++) {
+                         ex = makeexpr_hat(sp->exp1->args[i], 0);
+                         sp2 = makestmt_seq(sp2,
+                                            makestmt_assign(copyexpr(ex),
+                                                            makegetchar(fex)));
+                         if (checkeof(fex)) {
+                             sp2 = makestmt_seq(sp2,
+                                 makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
+                                                                 makeexpr_rel(EK_NE,
+                                                                              ex,
+                                                                              makeexpr_name("EOF", tp_char)),
+ 								makeexpr_name(endoffilename, tp_int))));
+                         } else
+                             freeexpr(ex);
+                     }
+                     return sp2;
+                 }
+             }
+         }
+         nargs = sp->exp1->nargs - 1;
+         if (isstrread) {
+             strchange(&sp->exp1->val.s, "sscanf");
+             insertarg(&sp->exp1, 0, copyexpr(fex));
+         } else if (!isvar(fex, mp_input)) {
+             strchange(&sp->exp1->val.s, "fscanf");
+             insertarg(&sp->exp1, 0, filebasename(copyexpr(fex)));
+         }
+         if (FCheck(checkreadformat)) {
+             if (checkeof(fex) && !isstrread)
+                 ex = makeexpr_cond(makeexpr_rel(EK_NE,
+                                                 makeexpr_bicall_1("feof",
+ 								  tp_int,
+ 								  filebasename(copyexpr(fex))),
+                                                 makeexpr_long(0)),
+ 				   makeexpr_name(endoffilename, tp_int),
+ 				   makeexpr_name(badinputformatname, tp_int));
+             else
+ 		ex = makeexpr_name(badinputformatname, tp_int);
+             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
+                                          makeexpr_rel(EK_EQ,
+                                                       sp->exp1,
+                                                       makeexpr_long(nargs)),
+                                          ex);
+         } else if (checkeof(fex) && !isstrread) {
+             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
+                                          makeexpr_rel(EK_NE,
+                                                       sp->exp1,
+                                                       makeexpr_name("EOF", tp_int)),
+ 					 makeexpr_name(endoffilename, tp_int));
+         }
+     }
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *makefgets(vex, lex, fex)
+ Expr *vex, *lex, *fex;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr_bicall_3("fgets", tp_strptr,
+                            vex,
+                            lex,
+                            filebasename(copyexpr(fex)));
+     if (checkeof(fex)) {
+         ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                makeexpr_rel(EK_NE, ex, makeexpr_nil()),
+ 			       makeexpr_name(endoffilename, tp_int));
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *skipeoln(fex)
+ Expr *fex;
+ {
+     Meaning *tvar;
+     Expr *ex;
+ 
+     if (!strcmp(readlnname, "fgets")) {
+         tvar = makestmttempvar(tp_str255, name_STRING);
+         return makestmt_call(makefgets(makeexpr_var(tvar),
+                                        makeexpr_long(stringceiling+1),
+                                        filebasename(fex)));
+     } else if (!strcmp(readlnname, "scanf") || !*readlnname) {
+         if (checkeof(fex))
+             ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                    makeexpr_rel(EK_NE,
+                                                 makegetchar(fex),
+                                                 makeexpr_name("EOF", tp_char)),
+ 				   makeexpr_name(endoffilename, tp_int));
+         else
+             ex = makegetchar(fex);
+         return makestmt_seq(fixscanf(
+                     makestmt_call(makeexpr_bicall_1("scanf", tp_int,
+                                                     makeexpr_string("%*[^\n]"))), fex),
+                     makestmt_call(ex));
+     } else {
+         return makestmt_call(makeexpr_bicall_1(readlnname, tp_void,
+                                                filebasename(copyexpr(fex))));
+     }
+ }
+ 
+ 
+ 
+ Static Stmt *handleread_text(fex, var, isreadln)
+ Expr *fex, *var;
+ int isreadln;
+ {
+     Stmt *spbase, *spafter, *sp;
+     Expr *ex = NULL, *exj = NULL;
+     Type *type;
+     Meaning *tvar, *tempcp, *mp;
+     int i, isstrread, scanfmode, readlnflag, varstring, maxstring;
+     int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling;
+     long rmin, rmax;
+     char *fmt;
+ 
+     spbase = NULL;
+     spafter = NULL;
+     sp = NULL;
+     tempcp = NULL;
+     if (fex->val.type->kind == TK_ARRAY)
+ 	fex = makeexpr_sprintfify(fex);
+     isstrread = (fex->val.type->kind == TK_STRING);
+     if (isstrread) {
+         exj = var;
+         var = p_expr(NULL);
+     }
+     scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread;
+     for (;;) {
+         readlnflag = isreadln && curtok == TOK_RPAR;
+         if (var->val.type->kind == TK_STRING && !isstrread) {
+             if (sp)
+                 spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+             spbase = makestmt_seq(spbase, spafter);
+             varstring = (varstrings && var->kind == EK_VAR &&
+                          (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM &&
+                          mp->type == tp_strptr);
+             maxstring = (strmax(var) >= longstrsize && !varstring);
+             if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) {
+                 spbase = makestmt_seq(spbase,
+                                       makestmt_call(makeexpr_bicall_1("gets", tp_str255,
+                                                                       makeexpr_addr(var))));
+                 isreadln = 0;
+             } else if (scanfmode && !varstring &&
+                        (*readlnname || !isreadln)) {
+                 spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0),
+                                                               makeexpr_char(0)));
+                 if (maxstring && usegets)
+                     ex = makeexpr_string("%[^\n]");
+                 else
+                     ex = makeexpr_string(format_d("%%%d[^\n]", strmax(var)));
+                 ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var));
+                 spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex));
+                 if (readlnflag && maxstring && usegets) {
+                     spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex)));
+                     isreadln = 0;
+                 }
+             } else {
+                 ex = makeexpr_plus(strmax_func(var), makeexpr_long(1));
+                 spbase = makestmt_seq(spbase,
+                                       makestmt_call(makefgets(makeexpr_addr(copyexpr(var)),
+                                                               ex,
+                                                               fex)));
+                 if (!tempcp)
+                     tempcp = makestmttempvar(tp_charptr, name_TEMP);
+                 spbase = makestmt_seq(spbase,
+                                       makestmt_assign(makeexpr_var(tempcp),
+                                                       makeexpr_bicall_2("strchr", tp_charptr,
+                                                                         makeexpr_addr(copyexpr(var)),
+                                                                         makeexpr_char('\n'))));
+                 sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0),
+                                      makeexpr_long(0));
+                 if (readlnflag)
+                     isreadln = 0;
+                 else
+                     sp = makestmt_seq(sp,
+                                       makestmt_call(makeexpr_bicall_2("ungetc", tp_void,
+                                                                       makeexpr_char('\n'),
+                                                                       filebasename(copyexpr(fex)))));
+                 spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE,
+                                                                        makeexpr_var(tempcp),
+                                                                        makeexpr_nil()),
+                                                           sp,
+                                                           NULL));
+             }
+             sp = NULL;
+             spafter = NULL;
+         } else if (var->val.type->kind == TK_ARRAY && !isstrread) {
+             if (sp)
+                 spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+             spbase = makestmt_seq(spbase, spafter);
+ 	    ex = makeexpr_sizeof(copyexpr(var), 0);
+ 	    if (readlnflag) {
+ 		spbase = makestmt_seq(spbase,
+ 		     makestmt_call(
+ 			 makeexpr_bicall_3("P_readlnpaoc", tp_void,
+ 					   filebasename(copyexpr(fex)),
+ 					   makeexpr_addr(var),
+ 					   makeexpr_arglong(ex, 0))));
+ 		isreadln = 0;
+ 	    } else {
+ 		spbase = makestmt_seq(spbase,
+ 		     makestmt_call(
+ 			 makeexpr_bicall_3("P_readpaoc", tp_void,
+ 					   filebasename(copyexpr(fex)),
+ 					   makeexpr_addr(var),
+ 					   makeexpr_arglong(ex, 0))));
+ 	    }
+             sp = NULL;
+             spafter = NULL;
+         } else {
+             switch (ord_type(var->val.type)->kind) {
+ 
+                 case TK_INTEGER:
+ 		    fmt = "d";
+ 		    if (curtok == TOK_COLON) {
+ 			gettok();
+ 			if (curtok == TOK_IDENT &&
+ 			    !strcicmp(curtokbuf, "HEX")) {
+ 			    fmt = "x";
+ 			} else if (curtok == TOK_IDENT &&
+ 			    !strcicmp(curtokbuf, "OCT")) {
+ 			    fmt = "o";
+ 			} else if (curtok == TOK_IDENT &&
+ 			    !strcicmp(curtokbuf, "BIN")) {
+ 			    fmt = "b";
+ 			    note("Using %b for binary format in scanf [194]");
+ 			} else
+ 			    warning("Unrecognized format specified in READ [212]");
+ 			gettok();
+ 		    }
+                     type = findbasetype(var->val.type, ODECL_NOPRES);
+                     if (exprlongness(var) > 0)
+                         ex = makeexpr_string(format_s("%%l%s", fmt));
+                     else if (type == tp_integer || type == tp_int ||
+                              type == tp_uint || type == tp_sint)
+                         ex = makeexpr_string(format_s("%%%s", fmt));
+                     else if (type == tp_sshort || type == tp_ushort)
+                         ex = makeexpr_string(format_s("%%h%s", fmt));
+                     else {
+                         tvar = makestmttempvar(tp_int, name_TEMP);
+                         spafter = makestmt_seq(spafter,
+                                                makestmt_assign(var,
+                                                                makeexpr_var(tvar)));
+                         var = makeexpr_var(tvar);
+                         ex = makeexpr_string(format_s("%%%s", fmt));
+                     }
+                     break;
+ 
+                 case TK_CHAR:
+                     ex = makeexpr_string("%c");
+                     if (newlinespace && !isstrread) {
+                         spafter = makestmt_seq(spafter,
+                                                makestmt_if(makeexpr_rel(EK_EQ,
+                                                                         copyexpr(var),
+                                                                         makeexpr_char('\n')),
+                                                            makestmt_assign(copyexpr(var),
+                                                                            makeexpr_char(' ')),
+                                                            NULL));
+                     }
+                     break;
+ 
+                 case TK_BOOLEAN:
+                     tvar = makestmttempvar(tp_str255, name_STRING);
+                     spafter = makestmt_seq(spafter,
+                         makestmt_assign(var,
+                                         makeexpr_or(makeexpr_rel(EK_EQ,
+                                                                  makeexpr_hat(makeexpr_var(tvar), 0),
+                                                                  makeexpr_char('T')),
+                                                     makeexpr_rel(EK_EQ,
+                                                                  makeexpr_hat(makeexpr_var(tvar), 0),
+                                                                  makeexpr_char('t')))));
+                     var = makeexpr_var(tvar);
+                     ex = makeexpr_string(" %[a-zA-Z]");
+                     break;
+ 
+                 case TK_ENUM:
+                     warning("READ on enumerated types not yet supported [213]");
+                     if (useenum)
+                         ex = makeexpr_string("%d");
+                     else
+                         ex = makeexpr_string("%hd");
+                     break;
+ 
+                 case TK_REAL:
+ 		    if (var->val.type == tp_longreal)
+ 			ex = makeexpr_string("%lg");
+ 		    else
+ 			ex = makeexpr_string("%g");
+                     break;
+ 
+                 case TK_STRING:     /* strread only */
+                     ex = makeexpr_string(format_d("%%%lds", strmax(fex)));
+                     break;
+ 
+                 case TK_ARRAY:      /* strread only */
+                     if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) {
+                         rmin = 1;
+                         rmax = 1;
+                         note("Can't determine length of packed array of chars [195]");
+                     }
+                     ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1));
+                     break;
+ 
+                 default:
+                     note("Element has wrong type for WRITE statement [196]");
+                     ex = NULL;
+                     break;
+ 
+             }
+             if (ex) {
+                 var = makeexpr_addr(var);
+                 if (sp) {
+                     sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0);
+                     insertarg(&sp->exp1, sp->exp1->nargs, var);
+                 } else {
+                     sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var));
+                 }
+             }
+         }
+         if (curtok == TOK_COMMA) {
+             gettok();
+             var = p_expr(NULL);
+         } else
+             break;
+     }
+     if (sp) {
+         if (isstrread && !FCheck(checkreadformat) &&
+             ((i=0, checkstring(sp->exp1->args[0], "%d")) ||
+              (i++, checkstring(sp->exp1->args[0], "%ld")) ||
+              (i++, checkstring(sp->exp1->args[0], "%hd")) ||
+              (i++, checkstring(sp->exp1->args[0], "%lg")))) {
+             if (fullstrread != 0 && exj) {
+                 tvar = makestmttempvar(tp_strptr, name_STRING);
+                 sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
+                                            (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal,
+                                                                         copyexpr(fex),
+                                                                         makeexpr_addr(makeexpr_var(tvar)))
+                                                     : makeexpr_bicall_3("strtol", tp_integer,
+                                                                         copyexpr(fex),
+                                                                         makeexpr_addr(makeexpr_var(tvar)),
+                                                                         makeexpr_long(10)));
+ 		spafter = makestmt_seq(spafter,
+ 				       makestmt_assign(copyexpr(exj),
+ 						       makeexpr_minus(makeexpr_var(tvar),
+ 								      makeexpr_addr(copyexpr(fex)))));
+             } else {
+                 sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
+                                            makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi",
+                                                              (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int,
+                                                              copyexpr(fex)));
+             }
+         } else if (isstrread && fullstrread != 0 && exj) {
+             sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
+                                                 makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0);
+             insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj)));
+         } else if (isreadln && scanfmode && !FCheck(checkreadformat)) {
+             isreadln = 0;
+             sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
+                                                 makeexpr_string("%*[^\n]"), 0);
+             spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter);
+         }
+         spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+     }
+     spbase = makestmt_seq(spbase, spafter);
+     if (isreadln)
+         spbase = makestmt_seq(spbase, skipeoln(fex));
+     return spbase;
+ }
+ 
+ 
+ 
+ Static Stmt *handleread_bin(fex, var)
+ Expr *fex, *var;
+ {
+     Type *basetype;
+     Stmt *sp;
+     Expr *ex, *tvardef = NULL;
+ 
+     sp = NULL;
+     basetype = filebasetype(fex->val.type);
+     for (;;) {
+         ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
+                                                     makeexpr_sizeof(makeexpr_type(basetype), 0),
+                                                     makeexpr_long(1),
+                                                     filebasename(copyexpr(fex)));
+         if (checkeof(fex)) {
+             ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ 				   makeexpr_name(endoffilename, tp_int));
+         }
+         sp = makestmt_seq(sp, makestmt_call(ex));
+         if (curtok == TOK_COMMA) {
+             gettok();
+             var = p_expr(NULL);
+         } else
+             break;
+     }
+     freeexpr(tvardef);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_read()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(NULL);
+     if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
+         fex = ex;
+         ex = p_expr(NULL);
+     } else {
+         fex = makeexpr_var(mp_input);
+     }
+     if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
+         sp = handleread_text(fex, ex, 0);
+     else
+         sp = handleread_bin(fex, ex);
+     skipcloseparen();
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_readdir()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     sp = doseek(fex, ex);
+     if (!skipopenparen())
+ 	return sp;
+     sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL)));
+     skipcloseparen();
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_readln()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (curtok != TOK_LPAR) {
+         fex = makeexpr_var(mp_input);
+         return wrapopencheck(skipeoln(copyexpr(fex)), fex);
+     } else {
+         gettok();
+         ex = p_expr(NULL);
+         if (isfiletype(ex->val.type, -1)) {
+             fex = ex;
+             if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
+                 skippasttotoken(TOK_RPAR, TOK_SEMI);
+                 return wrapopencheck(skipeoln(copyexpr(fex)), fex);
+             } else {
+                 ex = p_expr(NULL);
+             }
+         } else {
+             fex = makeexpr_var(mp_input);
+         }
+         sp = handleread_text(fex, ex, 1);
+         skipcloseparen();
+     }
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_readv()
+ {
+     Expr *vex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     sp = handleread_text(vex, NULL, 0);
+     skipcloseparen();
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strread()
+ {
+     Expr *vex, *exi, *exj, *exjj, *ex;
+     Stmt *sp, *sp2;
+     Meaning *tvar, *jvar;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(tp_str255);
+     if (vex->kind != EK_VAR) {
+         tvar = makestmttempvar(tp_str255, name_STRING);
+         sp = makestmt_assign(makeexpr_var(tvar), vex);
+         vex = makeexpr_var(tvar);
+     } else
+         sp = NULL;
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     exj = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) {
+         sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi));
+         exi = copyexpr(exj);
+     }
+     if (fullstrread != 0 &&
+         ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) {
+         jvar = makestmttempvar(exj->val.type, name_TEMP);
+         exjj = makeexpr_var(jvar);
+     } else {
+         exjj = copyexpr(exj);
+         jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL;
+     }
+     sp2 = handleread_text(bumpstring(copyexpr(vex),
+                                      copyexpr(exi), 1),
+                           exjj, 0);
+     sp = makestmt_seq(sp, sp2);
+     skipcloseparen();
+     if (fullstrread == 0) {
+         sp = makestmt_seq(sp, makestmt_assign(exj,
+                                               makeexpr_plus(makeexpr_bicall_1("strlen", tp_int,
+                                                                               vex),
+                                                             makeexpr_long(1))));
+         freeexpr(exjj);
+         freeexpr(exi);
+     } else {
+         sp = makestmt_seq(sp, makestmt_assign(exj,
+                                               makeexpr_plus(exjj, exi)));
+         if (fullstrread == 2)
+             note("STRREAD was used [197]");
+         freeexpr(vex);
+     }
+     return mixassignments(sp, jvar);
+ }
+ 
+ 
+ 
+ 
+ Static Expr *func_random()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR) {
+         gettok();
+         ex = p_expr(tp_integer);
+         skipcloseparen();
+         return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1));
+     } else {
+         return makeexpr_bicall_0(randrealname, tp_longreal);
+     }
+ }
+ 
+ 
+ 
+ Static Stmt *proc_randomize()
+ {
+     if (*randomizename)
+         return makestmt_call(makeexpr_bicall_0(randomizename, tp_void));
+     else
+         return NULL;
+ }
+ 
+ 
+ 
+ Static Expr *func_round(ex)
+ Expr *ex;
+ {
+     Meaning *tvar;
+ 
+     ex = grabarg(ex, 0);
+     if (ex->val.type->kind != TK_REAL)
+ 	return ex;
+     if (*roundname) {
+         if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
+             return makeexpr_bicall_1(roundname, tp_integer, ex);
+         } else {
+             tvar = makestmttempvar(tp_longreal, name_TEMP);
+             return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex),
+                                   makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar)));
+         }
+     } else {
+         return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
+ 						  makeexpr_plus(ex, makeexpr_real("0.5"))),
+                                 tp_integer);
+     }
+ }
+ 
+ 
+ 
+ Static Stmt *proc_unpack()
+ {
+     Expr *exs, *exd, *exi, *mins;
+     Meaning *tvar;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     exs = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     exd = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_ord_expr();
+     skipcloseparen();
+     if (exd->val.type->kind != TK_ARRAY ||
+ 	(exs->val.type->kind != TK_ARRAY &&
+ 	 exs->val.type->kind != TK_SMALLARRAY)) {
+ 	warning("Bad argument types for PACK/UNPACK [325]");
+ 	return makestmt_call(makeexpr_bicall_3("unpack", tp_void,
+ 					       exs, exd, exi));
+     }
+     if (exs->val.type->smax || exd->val.type->smax) {
+ 	tvar = makestmttempvar(exs->val.type->indextype, name_TEMP);
+ 	sp = makestmt(SK_FOR);
+ 	if (exs->val.type->smin)
+ 	    mins = exs->val.type->smin;
+ 	else
+ 	    mins = exs->val.type->indextype->smin;
+ 	sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
+ 				   copyexpr(mins));
+ 	sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
+ 				copyexpr(exs->val.type->indextype->smax));
+ 	sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
+ 				   makeexpr_plus(makeexpr_var(tvar),
+ 						 makeexpr_long(1)));
+ 	exi = makeexpr_minus(exi, copyexpr(mins));
+ 	sp->stm1 = makestmt_assign(p_index(exd,
+ 					   makeexpr_plus(makeexpr_var(tvar),
+ 							 exi)),
+ 				   p_index(exs, makeexpr_var(tvar)));
+ 	return sp;
+     } else {
+ 	exi = gentle_cast(exi, exs->val.type->indextype);
+ 	return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
+ 					       exd,
+ 					       makeexpr_addr(p_index(exs, exi)),
+ 					       makeexpr_sizeof(copyexpr(exd), 0)));
+     }
+ }
+ 
+ 
+ 
+ Static Expr *func_uround(ex)
+ Expr *ex;
+ {
+     ex = grabarg(ex, 0);
+     if (ex->val.type->kind != TK_REAL)
+ 	return ex;
+     return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
+ 					      makeexpr_plus(ex, makeexpr_real("0.5"))),
+ 			    tp_unsigned);
+ }
+ 
+ 
+ 
+ Static Expr *func_scan()
+ {
+     Expr *ex, *ex2, *ex3;
+     char *name;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     if (curtok == TOK_EQ)
+ 	name = "P_scaneq";
+     else 
+ 	name = "P_scanne";
+     gettok();
+     ex2 = p_expr(tp_char);
+     if (!skipcomma())
+ 	return NULL;
+     ex3 = p_expr(tp_str255);
+     skipcloseparen();
+     return makeexpr_bicall_3(name, tp_int,
+ 			     makeexpr_arglong(ex, 0),
+ 			     makeexpr_charcast(ex2), ex3);
+ }
+ 
+ 
+ 
+ Static Expr *func_scaneq(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_3("P_scaneq", tp_int,
+ 			     makeexpr_arglong(ex->args[0], 0),
+ 			     makeexpr_charcast(ex->args[1]),
+ 			     ex->args[2]);
+ }
+ 
+ 
+ Static Expr *func_scanne(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_3("P_scanne", tp_int,
+ 			     makeexpr_arglong(ex->args[0], 0),
+ 			     makeexpr_charcast(ex->args[1]),
+ 			     ex->args[2]);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_seek()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     skipcloseparen();
+     sp = wrapopencheck(doseek(fex, ex), copyexpr(fex));
+     if (*setupbufname && fileisbuffered(fex, 1))
+ 	sp = makestmt_seq(sp,
+ 		 makestmt_call(
+ 		     makeexpr_bicall_2(setupbufname, tp_void,
+ 				       filebasename(fex),
+ 				       makeexpr_type(filebasetype(fex->val.type)))));
+     else
+ 	freeexpr(fex);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Expr *func_seekeof()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR)
+         ex = p_parexpr(tp_text);
+     else
+         ex = makeexpr_var(mp_input);
+     if (*skipspacename)
+         ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
+     else
+         note("SEEKEOF was used [198]");
+     return iofunc(ex, 0);
+ }
+ 
+ 
+ 
+ Static Expr *func_seekeoln()
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_LPAR)
+         ex = p_parexpr(tp_text);
+     else
+         ex = makeexpr_var(mp_input);
+     if (*skipspacename)
+         ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
+     else
+         note("SEEKEOLN was used [199]");
+     return iofunc(ex, 1);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_setstrlen()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex),
+                            ex2);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_settextbuf()
+ {
+     Expr *fex, *bex, *sex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     bex = p_expr(NULL);
+     if (curtok == TOK_COMMA) {
+         gettok();
+         sex = p_expr(tp_integer);
+     } else
+         sex = makeexpr_sizeof(copyexpr(bex), 0);
+     skipcloseparen();
+     note("Make sure setvbuf() call occurs when file is open [200]");
+     return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void,
+                                            filebasename(fex),
+                                            makeexpr_addr(bex),
+                                            makeexpr_name("_IOFBF", tp_integer),
+                                            sex));
+ }
+ 
+ 
+ 
+ Static Expr *func_sin(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("sin", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ Static Expr *func_sinh(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("sinh", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_sizeof()
+ {
+     Expr *ex;
+     Type *type;
+     char *name, vbuf[1000];
+     int lpar;
+ 
+     lpar = (curtok == TOK_LPAR);
+     if (lpar)
+ 	gettok();
+     if (curtok == TOK_IDENT && curtokmeaning && curtokmeaning->kind == MK_TYPE) {
+         ex = makeexpr_type(curtokmeaning->type);
+         gettok();
+     } else
+         ex = p_expr(NULL);
+     type = ex->val.type;
+     parse_special_variant(type, vbuf);
+     if (lpar)
+ 	skipcloseparen();
+     name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
+     if (name) {
+ 	freeexpr(ex);
+ 	return pc_expr_str(name);
+     } else
+ 	return makeexpr_sizeof(ex, 0);
+ }
+ 
+ 
+ 
+ Static Expr *func_statusv()
+ {
+     return makeexpr_name(name_IORESULT, tp_integer);
+ }
+ 
+ 
+ 
+ Static Expr *func_str_hp(ex)
+ Expr *ex;
+ {
+     return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
+                                             ex->args[2], ex->args[3]));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strappend()
+ {
+     Expr *ex, *ex2;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_str255);
+     skipcloseparen();
+     return makestmt_assign(ex, makeexpr_concat(copyexpr(ex), ex2, 0));
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strdelete()
+ {
+     Meaning *tvar = NULL, *tvari;
+     Expr *ex, *ex2, *ex3, *ex4, *exi, *exn;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	exn = p_expr(tp_integer);
+     } else
+ 	exn = makeexpr_long(1);
+     skipcloseparen();
+     if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
+         sp = NULL;
+     else {
+         tvari = makestmttempvar(tp_int, name_TEMP);
+         sp = makestmt_assign(makeexpr_var(tvari), exi);
+         exi = makeexpr_var(tvari);
+     }
+     ex3 = bumpstring(copyexpr(ex), copyexpr(exi), 1);
+     ex4 = bumpstring(copyexpr(ex), makeexpr_plus(exi, exn), 1);
+     if (strcpyleft) {
+         ex2 = ex3;
+     } else {
+         tvar = makestmttempvar(tp_str255, name_STRING);
+         ex2 = makeexpr_var(tvar);
+     }
+     sp = makestmt_seq(sp, makestmt_assign(ex2, ex4));
+     if (!strcpyleft)
+         sp = makestmt_seq(sp, makestmt_assign(ex3, makeexpr_var(tvar)));
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strinsert()
+ {
+     Meaning *tvari;
+     Expr *exs, *exd, *exi;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     exs = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exd = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_expr(tp_integer);
+     skipcloseparen();
+ #if 0
+     if (checkconst(exi, 1)) {
+         freeexpr(exi);
+         return makestmt_assign(exd,
+                                makeexpr_concat(exs, copyexpr(exd)));
+     }
+ #endif
+     if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
+         sp = NULL;
+     else {
+         tvari = makestmttempvar(tp_int, name_TEMP);
+         sp = makestmt_assign(makeexpr_var(tvari), exi);
+         exi = makeexpr_var(tvari);
+     }
+     exd = bumpstring(exd, exi, 1);
+     sp = makestmt_seq(sp, makestmt_assign(exd,
+                                           makeexpr_concat(exs, copyexpr(exd), 0)));
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_strmove()
+ {
+     Expr *exlen, *exs, *exsi, *exd, *exdi;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     exlen = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     exs = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exsi = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     exd = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exdi = p_expr(tp_integer);
+     skipcloseparen();
+     exsi = makeexpr_arglong(exsi, 0);
+     exdi = makeexpr_arglong(exdi, 0);
+     return makestmt_call(makeexpr_bicall_5(strmovename, tp_str255,
+ 					   exlen, exs, exsi, exd, exdi));
+ }
+ 
+ 
+ 
+ Static Expr *func_strlen(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("strlen", tp_int, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_strltrim(ex)
+ Expr *ex;
+ {
+     return makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+                            makeexpr_bicall_1(strltrimname, tp_str255, ex->args[1]));
+ }
+ 
+ 
+ 
+ Static Expr *func_strmax(ex)
+ Expr *ex;
+ {
+     return strmax_func(grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_strpos(ex)
+ Expr *ex;
+ {
+     char *cp;
+ 
+     if (!switch_strpos)
+         swapexprs(ex->args[0], ex->args[1]);
+     cp = strposname;
+     if (!*cp) {
+         note("STRPOS function used [201]");
+         cp = "STRPOS";
+     } 
+     return makeexpr_bicall_3(cp, tp_int,
+                              ex->args[0], 
+                              ex->args[1],
+                              makeexpr_long(1));
+ }
+ 
+ 
+ 
+ Static Expr *func_strrpt(ex)
+ Expr *ex;
+ {
+     if (ex->args[1]->kind == EK_CONST &&
+         ex->args[1]->val.i == 1 && ex->args[1]->val.s[0] == ' ') {
+         return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
+                                  makeexpr_string("%*s"),
+                                  makeexpr_longcast(ex->args[2], 0),
+                                  makeexpr_string(""));
+     } else
+         return makeexpr_bicall_3(strrptname, tp_strptr, ex->args[0], ex->args[1],
+                                  makeexpr_arglong(ex->args[2], 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_strrtrim(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1(strrtrimname, tp_strptr,
+                              makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+                                              ex->args[1]));
+ }
+ 
+ 
+ 
+ Static Expr *func_succ()
+ {
+     Expr *ex;
+ 
+     if (wneedtok(TOK_LPAR)) {
+ 	ex = p_ord_expr();
+ 	skipcloseparen();
+     } else
+ 	ex = p_ord_expr();
+ #if 1
+     ex = makeexpr_inc(ex, makeexpr_long(1));
+ #else
+     ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(1)), ex->val.type);
+ #endif
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_sqr()
+ {
+     return makeexpr_sqr(p_parexpr(tp_integer), 0);
+ }
+ 
+ 
+ 
+ Static Expr *func_sqrt(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("sqrt", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_swap(ex)
+ Expr *ex;
+ {
+     char *cp;
+ 
+     ex = grabarg(ex, 0);
+     cp = swapname;
+     if (!*cp) {
+         note("SWAP function was used [202]");
+         cp = "SWAP";
+     }
+     return makeexpr_bicall_1(swapname, tp_int, ex);
+ }
+ 
+ 
+ 
+ Static Expr *func_tan(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("tan", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ Static Expr *func_tanh(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("tanh", tp_longreal, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_trunc(ex)
+ Expr *ex;
+ {
+     return makeexpr_actcast(grabarg(ex, 0), tp_integer);
+ }
+ 
+ 
+ 
+ Static Expr *func_utrunc(ex)
+ Expr *ex;
+ {
+     return makeexpr_actcast(grabarg(ex, 0), tp_unsigned);
+ }
+ 
+ 
+ 
+ Static Expr *func_uand()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_unsigned);
+     if (skipcomma()) {
+ 	ex = makeexpr_bin(EK_BAND, ex->val.type, ex, p_expr(tp_unsigned));
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_udec()
+ {
+     return handle_vax_hex(NULL, "u", 0);
+ }
+ 
+ 
+ 
+ Static Expr *func_unot()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_unsigned);
+     ex = makeexpr_un(EK_BNOT, ex->val.type, ex);
+     skipcloseparen();
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_uor()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_unsigned);
+     if (skipcomma()) {
+ 	ex = makeexpr_bin(EK_BOR, ex->val.type, ex, p_expr(tp_unsigned));
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_upcase(ex)
+ Expr *ex;
+ {
+     return makeexpr_bicall_1("toupper", tp_char, grabarg(ex, 0));
+ }
+ 
+ 
+ 
+ Static Expr *func_upper()
+ {
+     Expr *ex;
+     Value val;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	val = p_constant(tp_integer);
+ 	if (!val.type || val.i != 1)
+ 	    note("UPPER(v,n) not supported for n>1 [190]");
+     }
+     skipcloseparen();
+     return copyexpr(ex->val.type->indextype->smax);
+ }
+ 
+ 
+ 
+ Static Expr *func_uxor()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_unsigned);
+     if (skipcomma()) {
+ 	ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, p_expr(tp_unsigned));
+ 	skipcloseparen();
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Expr *func_val_modula()
+ {
+     Expr *ex;
+     Type *tp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     tp = p_type(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(tp);
+     skipcloseparen();
+     return pascaltypecast(tp, ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_val_turbo()
+ {
+     Expr *ex, *vex, *code, *fmt;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = gentle_cast(p_expr(tp_str255), tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (curtok == TOK_COMMA) {
+ 	gettok();
+ 	code = gentle_cast(p_expr(tp_integer), tp_integer);
+     } else
+ 	code = NULL;
+     skipcloseparen();
+     if (vex->val.type->kind == TK_REAL)
+         fmt = makeexpr_string("%lg");
+     else if (exprlongness(vex) > 0)
+         fmt = makeexpr_string("%ld");
+     else
+         fmt = makeexpr_string("%d");
+     ex = makeexpr_bicall_3("sscanf", tp_int,
+                            ex, fmt, makeexpr_addr(vex));
+     if (code) {
+ 	ex = makeexpr_rel(EK_EQ, ex, makeexpr_long(0));
+ 	return makestmt_assign(code, makeexpr_ord(ex));
+     } else
+ 	return makestmt_call(ex);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ Static Expr *writestrelement(ex, wid, vex, code, needboth)
+ Expr *ex, *wid, *vex;
+ int code, needboth;
+ {
+     if (formatstrings && needboth) {
+         return makeexpr_bicall_5("sprintf", tp_str255, vex,
+                                  makeexpr_string(format_d("%%*.*%c", code)),
+                                  copyexpr(wid),
+                                  wid,
+                                  ex);
+     } else {
+         return makeexpr_bicall_4("sprintf", tp_str255, vex,
+                                  makeexpr_string(format_d("%%*%c", code)),
+                                  wid,
+                                  ex);
+     }
+ }
+ 
+ 
+ 
+ Static char *makeenumnames(tp)
+ Type *tp;
+ {
+     Strlist *sp;
+     char *name;
+     Meaning *mp;
+     int saveindent;
+ 
+     for (sp = enumnames; sp && sp->value != (long)tp; sp = sp->next) ;
+     if (!sp) {
+         if (tp->meaning)
+             name = format_s(name_ENUM, tp->meaning->name);
+         else
+             name = format_s(name_ENUM, format_d("_%d", ++enumnamecount));
+         sp = strlist_insert(&enumnames, name);
+         sp->value = (long)tp;
+         outsection(2);
+         output(format_s("static %s *", charname));
+         output(sp->s);
+         output("[] = {\n");
+ 	saveindent = outindent;
+ 	moreindent(tabsize);
+ 	moreindent(structinitindent);
+         for (mp = tp->fbase; mp; mp = mp->xnext) {
+             output(makeCstring(mp->sym->name, strlen(mp->sym->name)));
+             if (mp->xnext)
+                 output(",\002 ");
+         }
+         outindent = saveindent;
+         output("\n} ;\n");
+         outsection(2);
+     }
+     return sp->s;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* This function must return a "tempsprintf" */
+ 
+ Expr *writeelement(ex, wid, prec, base)
+ Expr *ex, *wid, *prec;
+ int base;
+ {
+     Expr *vex, *ex1, *ex2;
+     Meaning *tvar;
+     char *fmtcode;
+     Type *type;
+ 
+     ex = makeexpr_charcast(ex);
+     if (ex->val.type->kind == TK_POINTER) {
+         ex = makeexpr_hat(ex, 0);   /* convert char *'s to strings */
+         intwarning("writeelement", "got a char * instead of a string [214]");
+     }
+     if ((ex->val.type->kind == TK_STRING && !wid) ||
+         (ord_type(ex->val.type)->kind == TK_CHAR && (!wid || checkconst(wid, 1)))) {
+         return makeexpr_sprintfify(ex);
+     }
+     tvar = makestmttempvar(tp_str255, name_STRING);
+     vex = makeexpr_var(tvar);
+     if (wid)
+         wid = makeexpr_longcast(wid, 0);
+     if (prec)
+         prec = makeexpr_longcast(prec, 0);
+ #if 0
+     if (wid && (wid->kind == EK_CONST && wid->val.i < 0 ||
+                 checkconst(wid, -1))) {
+         freeexpr(wid);     /* P-system uses write(x:-1) to mean write(x) */
+         wid = NULL;
+     }
+     if (prec && (prec->kind == EK_CONST && prec->val.i < 0 ||
+                  checkconst(prec, -1))) {
+         freeexpr(prec);
+         prec = NULL;
+     }
+ #endif
+     switch (ord_type(ex->val.type)->kind) {
+ 
+         case TK_INTEGER:
+             if (!wid) {
+ 		if (integerwidth < 0)
+ 		    integerwidth = (which_lang == LANG_TURBO) ? 1 : 12;
+ 		wid = makeexpr_long(integerwidth);
+ 	    }
+ 	    type = findbasetype(ex->val.type, ODECL_NOPRES);
+ 	    if (base == 16)
+ 		fmtcode = "x";
+ 	    else if (base == 8)
+ 		fmtcode = "o";
+ 	    else if ((possiblesigns(wid) & (1|4)) == 1) {
+ 		wid = makeexpr_neg(wid);
+ 		fmtcode = "x";
+ 	    } else if (type == tp_unsigned ||
+ 		       type == tp_uint ||
+ 		       (type == tp_ushort && sizeof_int < 32))
+ 		fmtcode = "u";
+ 	    else
+ 		fmtcode = "d";
+             ex = makeexpr_forcelongness(ex);
+             if (checkconst(wid, 0) || checkconst(wid, 1)) {
+                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+                                        makeexpr_string(format_ss("%%%s%s",
+ 								 (exprlongness(ex) > 0) ? "l" : "",
+ 								 fmtcode)),
+                                        ex);
+             } else {
+                 ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+                                        makeexpr_string(format_ss("%%*%s%s",
+ 								 (exprlongness(ex) > 0) ? "l" : "",
+ 								 fmtcode)),
+                                        wid,
+                                        ex);
+             }
+             break;
+ 
+         case TK_CHAR:
+             ex = writestrelement(ex, wid, vex, 'c',
+                                      (wid->kind != EK_CONST || wid->val.i < 1));
+             break;
+ 
+         case TK_BOOLEAN:
+             if (!wid) {
+                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+                                        makeexpr_string("%s"),
+                                        makeexpr_cond(ex,
+                                                      makeexpr_string(" TRUE"),
+                                                      makeexpr_string("FALSE")));
+             } else if (checkconst(wid, 1)) {
+                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+                                        makeexpr_string("%c"),
+                                        makeexpr_cond(ex,
+                                                      makeexpr_char('T'),
+                                                      makeexpr_char('F')));
+             } else {
+                 ex = writestrelement(makeexpr_cond(ex,
+                                                    makeexpr_string("TRUE"),
+                                                    makeexpr_string("FALSE")),
+                                      wid, vex, 's',
+                                      (wid->kind != EK_CONST || wid->val.i < 5));
+             }
+             break;
+ 
+         case TK_ENUM:
+             ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+                                    makeexpr_string("%s"),
+                                    makeexpr_index(makeexpr_name(makeenumnames(ex->val.type),
+                                                                 tp_strptr),
+                                                   ex, NULL));
+             break;
+ 
+         case TK_REAL:
+             if (!wid)
+                 wid = makeexpr_long(realwidth);
+             if (prec && (possiblesigns(prec) & (1|4)) != 1) {
+                 ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+                                        makeexpr_string("%*.*f"),
+                                        wid,
+                                        prec,
+                                        ex);
+             } else {
+ 		if (prec)
+ 		    prec = makeexpr_neg(prec);
+ 		else
+ 		    prec = makeexpr_minus(copyexpr(wid),
+ 					  makeexpr_long(7));
+ 		if (prec->kind == EK_CONST) {
+ 		    if (prec->val.i <= 0)
+ 			prec = makeexpr_long(1);
+ 		} else {
+ 		    prec = makeexpr_bicall_2("P_max", tp_integer, prec,
+ 					     makeexpr_long(1));
+ 		}
+                 if (wid->kind == EK_CONST && wid->val.i > 21) {
+                     ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+                                            makeexpr_string("%*.*E"),
+                                            wid,
+ 					   prec,
+                                            ex);
+ #if 0
+                 } else if (checkconst(wid, 7)) {
+                     ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+                                            makeexpr_string("%E"),
+                                            ex);
+ #endif
+                 } else {
+                     ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+                                            makeexpr_string("% .*E"),
+ 					   prec,
+                                            ex);
+                 }
+             }
+             break;
+ 
+         case TK_STRING:
+             ex = writestrelement(ex, wid, vex, 's', 1);
+             break;
+ 
+         case TK_ARRAY:     /* assume packed array of char */
+ 	    ord_range_expr(ex->val.type->indextype, &ex1, &ex2);
+ 	    ex1 = makeexpr_plus(makeexpr_minus(copyexpr(ex2),
+ 					       copyexpr(ex1)),
+ 				makeexpr_long(1));
+ 	    ex1 = makeexpr_longcast(ex1, 0);
+ 	    fmtcode = "%.*s";
+             if (!wid) {
+ 		wid = ex1;
+             } else {
+ 		if (isliteralconst(wid, NULL) == 2 &&
+ 		    isliteralconst(ex1, NULL) == 2) {
+ 		    if (wid->val.i > ex1->val.i) {
+ 			fmtcode = format_ds("%*s%%.*s",
+ 					    wid->val.i - ex1->val.i, "");
+ 			wid = ex1;
+ 		    }
+ 		} else
+ 		    note("Format for packed-array-of-char will work only if width < length [321]");
+ 	    }
+             ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+                                    makeexpr_string(fmtcode),
+                                    wid,
+                                    makeexpr_addr(ex));
+             break;
+ 
+         default:
+             note("Element has wrong type for WRITE statement [196]");
+             ex = makeexpr_bicall_2("sprintf", tp_str255, vex, makeexpr_string("<meef>"));
+             break;
+ 
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Static Stmt *handlewrite_text(fex, ex, iswriteln)
+ Expr *fex, *ex;
+ int iswriteln;
+ {
+     Expr *print, *wid, *prec;
+     unsigned char *ucp;
+     int i, done, base;
+ 
+     print = NULL;
+     for (;;) {
+         wid = NULL;
+         prec = NULL;
+ 	base = 10;
+ 	if (curtok == TOK_COLON && iswriteln >= 0) {
+ 	    gettok();
+ 	    wid = p_expr(tp_integer);
+ 	    if (curtok == TOK_COLON) {
+ 		gettok();
+ 		prec = p_expr(tp_integer);
+ 	    }
+ 	}
+ 	if (curtok == TOK_IDENT &&
+ 	    !strcicmp(curtokbuf, "OCT")) {
+ 	    base = 8;
+ 	    gettok();
+ 	} else if (curtok == TOK_IDENT &&
+ 		   !strcicmp(curtokbuf, "HEX")) {
+ 	    base = 16;
+ 	    gettok();
+ 	}
+         ex = writeelement(ex, wid, prec, base);
+         print = makeexpr_concat(print, cleansprintf(ex), 1);
+         if (curtok == TOK_COMMA && iswriteln >= 0) {
+             gettok();
+             ex = p_expr(NULL);
+         } else
+             break;
+     }
+     if (fex->val.type->kind != TK_STRING) {      /* not strwrite */
+         switch (iswriteln) {
+             case 1:
+             case -1:
+                 print = makeexpr_concat(print, makeexpr_string("\n"), 1);
+                 break;
+             case 2:
+             case -2:
+                 print = makeexpr_concat(print, makeexpr_string("\r"), 1);
+                 break;
+         }
+         if (isvar(fex, mp_output)) {
+             ucp = (unsigned char *)print->args[1]->val.s;
+             for (i = 0; i < print->args[1]->val.i; i++) {
+                 if (ucp[i] >= 128 && ucp[i] < 144) {
+                     note("WRITE statement contains color/attribute characters [203]");
+ 		    break;
+ 		}
+             }
+         }
+         if ((i = sprintflength(print, 0)) > 0 && print->nargs == 2 && printfonly != 1) {
+             print = makeexpr_unsprintfify(print);
+             done = 1;
+             if (isvar(fex, mp_output)) {
+                 if (i == 1) {
+                     print = makeexpr_bicall_1("putchar", tp_int,
+                                               makeexpr_charcast(print));
+                 } else {
+                     if (printfonly == 0) {
+                         if (print->val.s[print->val.i-1] == '\n') {
+ 			    print->val.s[--(print->val.i)] = 0;
+                             print = makeexpr_bicall_1("puts", tp_int, print);
+                         } else {
+                             print = makeexpr_bicall_2("fputs", tp_int,
+                                                       print,
+                                                       copyexpr(fex));
+                         }
+                     } else {
+                         print = makeexpr_sprintfify(print);
+                         done = 0;
+                     }
+                 }
+             } else {
+                 if (i == 1) {
+                     print = makeexpr_bicall_2("putc", tp_int,
+                                               makeexpr_charcast(print),
+                                               filebasename(copyexpr(fex)));
+                 } else if (printfonly == 0) {
+                     print = makeexpr_bicall_2("fputs", tp_int,
+                                               print,
+                                               filebasename(copyexpr(fex)));
+                 } else {
+                     print = makeexpr_sprintfify(print);
+                     done = 0;
+                 }
+             }
+         } else
+             done = 0;
+         if (!done) {
+             canceltempvar(istempvar(print->args[0]));
+             if (checkstring(print->args[1], "%s") && printfonly != 1) {
+                 print = makeexpr_bicall_2("fputs", tp_int,
+                                           grabarg(print, 2),
+                                           filebasename(copyexpr(fex)));
+             } else if (checkstring(print->args[1], "%c") && printfonly != 1 &&
+                        !nosideeffects(print->args[2], 0)) {
+                 print = makeexpr_bicall_2("fputc", tp_int,
+                                           grabarg(print, 2),
+                                           filebasename(copyexpr(fex)));
+             } else if (isvar(fex, mp_output)) {
+                 if (checkstring(print->args[1], "%s\n") && printfonly != 1) {
+                     print = makeexpr_bicall_1("puts", tp_int, grabarg(print, 2));
+                 } else if (checkstring(print->args[1], "%c") && printfonly != 1) {
+                     print = makeexpr_bicall_1("putchar", tp_int, grabarg(print, 2));
+                 } else {
+                     strchange(&print->val.s, "printf");
+                     delfreearg(&print, 0);
+                     print->val.type = tp_int;
+                 }
+             } else {
+                 if (checkstring(print->args[1], "%c") && printfonly != 1) {
+                     print = makeexpr_bicall_2("putc", tp_int,
+                                               grabarg(print, 2),
+                                               filebasename(copyexpr(fex)));
+                 } else {
+                     strchange(&print->val.s, "fprintf");
+                     freeexpr(print->args[0]);
+                     print->args[0] = filebasename(copyexpr(fex));
+                     print->val.type = tp_int;
+                 }
+             }
+         }
+         if (FCheck(checkfilewrite)) {
+             print = makeexpr_bicall_2("~SETIO", tp_void,
+                                       makeexpr_rel(EK_GE, print, makeexpr_long(0)),
+ 				      makeexpr_name(filewriteerrorname, tp_int));
+         }
+     }
+     return makestmt_call(print);
+ }
+ 
+ 
+ 
+ Static Stmt *handlewrite_bin(fex, ex)
+ Expr *fex, *ex;
+ {
+     Type *basetype;
+     Stmt *sp;
+     Expr *tvardef = NULL;
+     Meaning *tvar = NULL;
+ 
+     sp = NULL;
+     basetype = filebasetype(fex->val.type);
+     for (;;) {
+         if (!expr_has_address(ex) || ex->val.type != basetype) {
+             if (!tvar)
+                 tvar = makestmttempvar(basetype, name_TEMP);
+             if (!tvardef || !exprsame(tvardef, ex, 1)) {
+                 freeexpr(tvardef);
+                 tvardef = copyexpr(ex);
+                 sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(tvar),
+                                                       ex));
+             } else
+                 freeexpr(ex);
+             ex = makeexpr_var(tvar);
+         }
+         ex = makeexpr_bicall_4("fwrite", tp_integer, makeexpr_addr(ex),
+                                                      makeexpr_sizeof(makeexpr_type(basetype), 0),
+                                                      makeexpr_long(1),
+ 			                             filebasename(copyexpr(fex)));
+         if (FCheck(checkfilewrite)) {
+             ex = makeexpr_bicall_2("~SETIO", tp_void,
+                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ 				   makeexpr_name(filewriteerrorname, tp_int));
+         }
+         sp = makestmt_seq(sp, makestmt_call(ex));
+         if (curtok == TOK_COMMA) {
+             gettok();
+             ex = p_expr(NULL);
+         } else
+             break;
+     }
+     freeexpr(tvardef);
+     return sp;
+ }
+ 
+ 
+ 
+ Static Stmt *proc_write()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(NULL);
+     if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
+         fex = ex;
+         ex = p_expr(NULL);
+     } else {
+         fex = makeexpr_var(mp_output);
+     }
+     if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
+         sp = handlewrite_text(fex, ex, 0);
+     else
+         sp = handlewrite_bin(fex, ex);
+     skipcloseparen();
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *handle_modula_write(fmt)
+ char *fmt;
+ {
+     Expr *ex, *wid;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = makeexpr_forcelongness(p_expr(NULL));
+     if (skipcomma())
+ 	wid = p_expr(tp_integer);
+     else
+ 	wid = makeexpr_long(1);
+     if (checkconst(wid, 0) || checkconst(wid, 1))
+ 	ex = makeexpr_bicall_2("printf", tp_str255,
+ 			       makeexpr_string(format_ss("%%%s%s",
+ 							 (exprlongness(ex) > 0) ? "l" : "",
+ 							 fmt)),
+ 			       ex);
+     else
+ 	ex = makeexpr_bicall_3("printf", tp_str255,
+ 			       makeexpr_string(format_ss("%%*%s%s",
+ 							 (exprlongness(ex) > 0) ? "l" : "",
+ 							 fmt)),
+ 			       makeexpr_arglong(wid, 0),
+ 			       ex);
+     skipcloseparen();
+     return makestmt_call(ex);
+ }
+ 
+ 
+ Static Stmt *proc_writecard()
+ {
+     return handle_modula_write("u");
+ }
+ 
+ 
+ Static Stmt *proc_writeint()
+ {
+     return handle_modula_write("d");
+ }
+ 
+ 
+ Static Stmt *proc_writehex()
+ {
+     return handle_modula_write("x");
+ }
+ 
+ 
+ Static Stmt *proc_writeoct()
+ {
+     return handle_modula_write("o");
+ }
+ 
+ 
+ Static Stmt *proc_writereal()
+ {
+     return handle_modula_write("f");
+ }
+ 
+ 
+ 
+ Static Stmt *proc_writedir()
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     ex = p_expr(tp_integer);
+     sp = doseek(fex, ex);
+     if (!skipcomma())
+ 	return sp;
+     sp = makestmt_seq(sp, handlewrite_bin(fex, p_expr(NULL)));
+     skipcloseparen();
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *handlewriteln(iswriteln)
+ int iswriteln;
+ {
+     Expr *fex, *ex;
+     Stmt *sp;
+     Meaning *deffile = mp_output;
+ 
+     sp = NULL;
+     if (iswriteln == 3) {
+ 	iswriteln = 1;
+ 	if (messagestderr)
+ 	    deffile = mp_stderr;
+     }
+     if (curtok != TOK_LPAR) {
+         fex = makeexpr_var(deffile);
+         if (iswriteln)
+             sp = handlewrite_text(fex, makeexpr_string(""), -iswriteln);
+     } else {
+         gettok();
+         ex = p_expr(NULL);
+         if (isfiletype(ex->val.type, -1)) {
+             fex = ex;
+             if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
+                 if (iswriteln)
+                     ex = makeexpr_string("");
+                 else
+                     ex = NULL;
+             } else {
+                 ex = p_expr(NULL);
+             }
+         } else {
+             fex = makeexpr_var(deffile);
+         }
+         if (ex)
+             sp = handlewrite_text(fex, ex, iswriteln);
+         skipcloseparen();
+     }
+     if (iswriteln == 0) {
+         sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_1("fflush", tp_void,
+                                                               filebasename(copyexpr(fex)))));
+     }
+     return wrapopencheck(sp, fex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_overprint()
+ {
+     return handlewriteln(2);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_prompt()
+ {
+     return handlewriteln(0);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_writeln()
+ {
+     return handlewriteln(1);
+ }
+ 
+ 
+ Static Stmt *proc_message()
+ {
+     return handlewriteln(3);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_writev()
+ {
+     Expr *vex, *ex;
+     Stmt *sp;
+     Meaning *mp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(tp_str255);
+     if (curtok == TOK_RPAR) {
+ 	gettok();
+ 	return makestmt_assign(vex, makeexpr_string(""));
+     }
+     if (!skipcomma())
+ 	return NULL;
+     sp = handlewrite_text(vex, p_expr(NULL), 0);
+     skipcloseparen();
+     ex = sp->exp1;
+     if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+         (mp = istempvar(ex->args[0])) != NULL) {
+         canceltempvar(mp);
+         ex->args[0] = vex;
+     } else
+         sp->exp1 = makeexpr_assign(vex, ex);
+     return sp;
+ }
+ 
+ 
+ Static Stmt *proc_strwrite(mp_x, spbase)
+ Meaning *mp_x;
+ Stmt *spbase;
+ {
+     Expr *vex, *exi, *exj, *ex;
+     Stmt *sp;
+     Meaning *mp;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     vex = p_expr(tp_str255);
+     if (!skipcomma())
+ 	return NULL;
+     exi = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     exj = p_expr(tp_integer);
+     if (!skipcomma())
+ 	return NULL;
+     sp = handlewrite_text(vex, p_expr(NULL), 0);
+     skipcloseparen();
+     ex = sp->exp1;
+     FREE(sp);
+     if (checkconst(exi, 1)) {
+         sp = spbase;
+         while (sp && sp->next)
+             sp = sp->next;
+         if (sp && sp->kind == SK_ASSIGN && sp->exp1->kind == EK_ASSIGN &&
+              (sp->exp1->args[0]->kind == EK_HAT ||
+               sp->exp1->args[0]->kind == EK_INDEX) &&
+              exprsame(sp->exp1->args[0]->args[0], vex, 1) &&
+              checkconst(sp->exp1->args[1], 0)) {
+             nukestmt(sp);     /* remove preceding bogus setstrlen */
+         }
+     }
+     if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+         (mp = istempvar(ex->args[0])) != NULL) {
+         canceltempvar(mp);
+         ex->args[0] = bumpstring(copyexpr(vex), exi, 1);
+         sp = makestmt_call(ex);
+     } else
+         sp = makestmt_assign(bumpstring(copyexpr(vex), exi, 1), ex);
+     if (fullstrwrite != 0) {
+         sp = makestmt_seq(sp, makestmt_assign(exj,
+                                               makeexpr_plus(makeexpr_bicall_1("strlen", tp_int, vex),
+                                                             makeexpr_long(1))));
+         if (fullstrwrite == 1)
+             note("FullStrWrite=1 not yet supported [204]");
+         if (fullstrwrite == 2)
+             note("STRWRITE was used [205]");
+     } else {
+         freeexpr(vex);
+     }
+     return mixassignments(sp, NULL);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_str_turbo()
+ {
+     Expr *ex, *wid, *prec;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(NULL);
+     wid = NULL;
+     prec = NULL;
+     if (curtok == TOK_COLON) {
+         gettok();
+         wid = p_expr(tp_integer);
+         if (curtok == TOK_COLON) {
+             gettok();
+             prec = p_expr(tp_integer);
+         }
+     }
+     ex = writeelement(ex, wid, prec, 10);
+     if (!skipcomma())
+ 	return NULL;
+     wid = p_expr(tp_str255);
+     skipcloseparen();
+     return makestmt_assign(wid, ex);
+ }
+ 
+ 
+ 
+ Static Stmt *proc_time()
+ {
+     Expr *ex;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(tp_str255);
+     skipcloseparen();
+     return makestmt_call(makeexpr_bicall_1("VAXtime", tp_integer, ex));
+ }
+ 
+ 
+ Static Expr *func_xor()
+ {
+     Expr *ex, *ex2;
+     Type *type;
+     Meaning *tvar;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     ex = p_expr(NULL);
+     if (!skipcomma())
+ 	return ex;
+     ex2 = p_expr(ex->val.type);
+     skipcloseparen();
+     if (ex->val.type->kind != TK_SET &&
+ 	ex->val.type->kind != TK_SMALLSET) {
+ 	ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
+     } else {
+ 	type = mixsets(&ex, &ex2);
+ 	tvar = makestmttempvar(type, name_SET);
+ 	ex = makeexpr_bicall_3(setxorname, type,
+ 			       makeexpr_var(tvar),
+ 			       ex, ex2);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ void decl_builtins()
+ {
+     makespecialfunc( "ABS",           func_abs);
+     makespecialfunc( "ADDR",          func_addr);
+     if (!modula2)
+ 	makespecialfunc( "ADDRESS",   func_addr);
+     makespecialfunc( "ADDTOPOINTER",  func_addtopointer);
+     makespecialfunc( "ADR",           func_addr);
+     makespecialfunc( "ASL",	      func_lsl);
+     makespecialfunc( "ASR",	      func_asr);
+     makespecialfunc( "BADDRESS",      func_iaddress);
+     makespecialfunc( "BAND",	      func_uand);
+     makespecialfunc( "BIN",           func_bin);
+     makespecialfunc( "BITNEXT",	      func_bitnext);
+     makespecialfunc( "BITSIZE",	      func_bitsize);
+     makespecialfunc( "BITSIZEOF",     func_bitsize);
+ mp_blockread_ucsd =
+     makespecialfunc( "BLOCKREAD",     func_blockread);
+ mp_blockwrite_ucsd =
+     makespecialfunc( "BLOCKWRITE",    func_blockwrite);
+     makespecialfunc( "BNOT",	      func_unot);
+     makespecialfunc( "BOR",	      func_uor);
+     makespecialfunc( "BSL",	      func_bsl);
+     makespecialfunc( "BSR",	      func_bsr);
+     makespecialfunc( "BTST",	      func_btst);
+     makespecialfunc( "BXOR",	      func_uxor);
+     makespecialfunc( "BYTEREAD",      func_byteread);
+     makespecialfunc( "BYTEWRITE",     func_bytewrite);
+     makespecialfunc( "BYTE_OFFSET",   func_byte_offset);
+     makespecialfunc( "CHR",           func_chr);         
+     makespecialfunc( "CONCAT",        func_concat);
+     makespecialfunc( "DBLE",          func_float);
+ mp_dec_dec =
+     makespecialfunc( "DEC",           func_dec);
+     makespecialfunc( "EOF",           func_eof);
+     makespecialfunc( "EOLN",          func_eoln);
+     makespecialfunc( "FCALL",         func_fcall);
+     makespecialfunc( "FILEPOS",       func_filepos);
+     makespecialfunc( "FILESIZE",      func_filesize);
+     makespecialfunc( "FLOAT",	      func_float);
+     makespecialfunc( "HEX",           func_hex);         
+     makespecialfunc( "HI",            func_hi);
+     makespecialfunc( "HIWORD",        func_hiword);
+     makespecialfunc( "HIWRD",         func_hiword);
+     makespecialfunc( "HIGH",          func_high);
+     makespecialfunc( "IADDRESS",      func_iaddress);
+     makespecialfunc( "INT",           func_int);         
+     makespecialfunc( "LAND",	      func_uand);
+     makespecialfunc( "LNOT",	      func_unot);
+     makespecialfunc( "LO",            func_lo);
+     makespecialfunc( "LOOPHOLE",      func_loophole);
+     makespecialfunc( "LOR",	      func_uor);
+     makespecialfunc( "LOWER",	      func_lower);
+     makespecialfunc( "LOWORD",        func_loword);
+     makespecialfunc( "LOWRD",         func_loword);
+     makespecialfunc( "LSL",	      func_lsl);
+     makespecialfunc( "LSR",	      func_lsr);
+     makespecialfunc( "MAX",	      func_max);
+     makespecialfunc( "MAXPOS",        func_maxpos);
+     makespecialfunc( "MIN",	      func_min);
+     makespecialfunc( "NEXT",          func_sizeof);
+     makespecialfunc( "OCT",           func_oct);
+     makespecialfunc( "ORD",           func_ord);
+     makespecialfunc( "ORD4",          func_ord4);
+     makespecialfunc( "PI",	      func_pi);
+     makespecialfunc( "POSITION",      func_position);
+     makespecialfunc( "PRED",          func_pred);
+     makespecialfunc( "QUAD",          func_float);
+     makespecialfunc( "RANDOM",        func_random);
+     makespecialfunc( "REF",	      func_addr);
+     makespecialfunc( "SCAN",	      func_scan);
+     makespecialfunc( "SEEKEOF",       func_seekeof);
+     makespecialfunc( "SEEKEOLN",      func_seekeoln);
+     makespecialfunc( "SIZE",          func_sizeof);
+     makespecialfunc( "SIZEOF",        func_sizeof);
+     makespecialfunc( "SNGL",          func_sngl);
+     makespecialfunc( "SQR",           func_sqr);
+     makespecialfunc( "STATUSV",	      func_statusv);
+     makespecialfunc( "SUCC",          func_succ);
+     makespecialfunc( "TSIZE",         func_sizeof);
+     makespecialfunc( "UAND",	      func_uand);
+     makespecialfunc( "UDEC",          func_udec);
+     makespecialfunc( "UINT",          func_uint);         
+     makespecialfunc( "UNOT",	      func_unot);
+     makespecialfunc( "UOR",	      func_uor);
+     makespecialfunc( "UPPER",	      func_upper);
+     makespecialfunc( "UXOR",	      func_uxor);
+ mp_val_modula =
+     makespecialfunc( "VAL",	      func_val_modula);
+     makespecialfunc( "WADDRESS",      func_iaddress);
+     makespecialfunc( "XOR",	      func_xor);
+ 
+     makestandardfunc("ARCTAN",        func_arctan);
+     makestandardfunc("ARCTANH",       func_arctanh);
+     makestandardfunc("BINARY",        func_binary);      
+     makestandardfunc("CAP",           func_upcase);
+     makestandardfunc("COPY",          func_copy);        
+     makestandardfunc("COS",           func_cos);         
+     makestandardfunc("COSH",          func_cosh);         
+     makestandardfunc("EXP",           func_exp);         
+     makestandardfunc("EXP10",         func_pwroften);
+     makestandardfunc("EXPO",          func_expo);         
+     makestandardfunc("FRAC",          func_frac);        
+     makestandardfunc("INDEX",         func_strpos);      
+     makestandardfunc("LASTPOS",       NULL);             
+     makestandardfunc("LINEPOS",       NULL);             
+     makestandardfunc("LENGTH",        func_strlen);      
+     makestandardfunc("LN",            func_ln);          
+     makestandardfunc("LOG",           func_log);
+     makestandardfunc("LOG10",         func_log);
+     makestandardfunc("MAXAVAIL",      func_maxavail);
+     makestandardfunc("MEMAVAIL",      func_memavail);
+     makestandardfunc("OCTAL",         func_octal);       
+     makestandardfunc("ODD",           func_odd);         
+     makestandardfunc("PAD",           func_pad);
+     makestandardfunc("PARAMCOUNT",    func_paramcount);
+     makestandardfunc("PARAMSTR",      func_paramstr);    
+     makestandardfunc("POS",           func_pos);         
+     makestandardfunc("PTR",           func_ptr);
+     makestandardfunc("PWROFTEN",      func_pwroften);
+     makestandardfunc("ROUND",         func_round);       
+     makestandardfunc("SCANEQ",        func_scaneq);
+     makestandardfunc("SCANNE",        func_scanne);
+     makestandardfunc("SIN",           func_sin);         
+     makestandardfunc("SINH",          func_sinh);         
+     makestandardfunc("SQRT",          func_sqrt);        
+ mp_str_hp =
+     makestandardfunc("STR",           func_str_hp);
+     makestandardfunc("STRLEN",        func_strlen);      
+     makestandardfunc("STRLTRIM",      func_strltrim);    
+     makestandardfunc("STRMAX",        func_strmax);      
+     makestandardfunc("STRPOS",        func_strpos);      
+     makestandardfunc("STRRPT",        func_strrpt);      
+     makestandardfunc("STRRTRIM",      func_strrtrim);    
+     makestandardfunc("SUBSTR",        func_str_hp);
+     makestandardfunc("SWAP",          func_swap);        
+     makestandardfunc("TAN",           func_tan);       
+     makestandardfunc("TANH",          func_tanh);       
+     makestandardfunc("TRUNC",         func_trunc);       
+     makestandardfunc("UPCASE",        func_upcase);      
+     makestandardfunc("UROUND",        func_uround);
+     makestandardfunc("UTRUNC",        func_utrunc);
+ 
+     makespecialproc( "APPEND",        proc_append);
+     makespecialproc( "ARGV",	      proc_argv);
+     makespecialproc( "ASSERT",        proc_assert);
+     makespecialproc( "ASSIGN",        proc_assign);
+     makespecialproc( "BCLR",	      proc_bclr);
+ mp_blockread_turbo =
+     makespecialproc( "BLOCKREAD_TURBO", proc_blockread);
+ mp_blockwrite_turbo =
+     makespecialproc( "BLOCKWRITE_TURBO", proc_blockwrite);
+     makespecialproc( "BREAK",         proc_flush);
+     makespecialproc( "BSET",	      proc_bset);
+     makespecialproc( "CALL",          proc_call);
+     makespecialproc( "CLOSE",         proc_close);
+     makespecialproc( "CONNECT",       proc_assign);
+     makespecialproc( "CYCLE",	      proc_cycle);
+     makespecialproc( "DATE",	      proc_date);
+ mp_dec_turbo =
+     makespecialproc( "DEC_TURBO",     proc_dec);
+     makespecialproc( "DISPOSE",       proc_dispose);
+     makespecialproc( "ESCAPE",        proc_escape);
+     makespecialproc( "EXCL",          proc_excl);
+     makespecialproc( "EXIT",          proc_exit);
+     makespecialproc( "FILLCHAR",      proc_fillchar);
+     makespecialproc( "FLUSH",         proc_flush);
+     makespecialproc( "GET",           proc_get);
+     makespecialproc( "HALT",          proc_escape);
+     makespecialproc( "INC",           proc_inc);
+     makespecialproc( "INCL",          proc_incl);
+     makespecialproc( "LEAVE",	      proc_leave);
+     makespecialproc( "LOCATE",        proc_seek);
+     makespecialproc( "MESSAGE",       proc_message);
+     makespecialproc( "MOVE_FAST",     proc_move_fast);        
+     makespecialproc( "MOVE_L_TO_R",   proc_move_fast);        
+     makespecialproc( "MOVE_R_TO_L",   proc_move_fast);        
+     makespecialproc( "NEW",           proc_new);
+     if (which_lang != LANG_VAX)
+ 	makespecialproc( "OPEN",      proc_open);
+     makespecialproc( "OVERPRINT",     proc_overprint);
+     makespecialproc( "PACK",          proc_pack);
+     makespecialproc( "PAGE",          proc_page);
+     makespecialproc( "PUT",           proc_put);
+     makespecialproc( "PROMPT",        proc_prompt);
+     makespecialproc( "RANDOMIZE",     proc_randomize);
+     makespecialproc( "READ",          proc_read);
+     makespecialproc( "READDIR",       proc_readdir);
+     makespecialproc( "READLN",        proc_readln);
+     makespecialproc( "READV",         proc_readv);
+     makespecialproc( "RESET",         proc_reset);
+     makespecialproc( "REWRITE",       proc_rewrite);
+     makespecialproc( "SEEK",          proc_seek);
+     makespecialproc( "SETSTRLEN",     proc_setstrlen);
+     makespecialproc( "SETTEXTBUF",    proc_settextbuf);
+ mp_str_turbo =
+     makespecialproc( "STR_TURBO",     proc_str_turbo);
+     makespecialproc( "STRAPPEND",     proc_strappend);
+     makespecialproc( "STRDELETE",     proc_strdelete);
+     makespecialproc( "STRINSERT",     proc_strinsert);
+     makespecialproc( "STRMOVE",       proc_strmove);
+     makespecialproc( "STRREAD",       proc_strread);
+     makespecialproc( "STRWRITE",      proc_strwrite);
+     makespecialproc( "TIME",	      proc_time);
+     makespecialproc( "UNPACK",        proc_unpack);
+     makespecialproc( "WRITE",         proc_write);
+     makespecialproc( "WRITEDIR",      proc_writedir);
+     makespecialproc( "WRITELN",       proc_writeln);
+     makespecialproc( "WRITEV",        proc_writev);
+ mp_val_turbo =
+     makespecialproc( "VAL_TURBO",     proc_val_turbo);
+ 
+     makestandardproc("DELETE",        proc_delete);      
+     makestandardproc("FREEMEM",       proc_freemem);     
+     makestandardproc("GETMEM",        proc_getmem);
+     makestandardproc("GOTOXY",        proc_gotoxy);      
+     makestandardproc("INSERT",        proc_insert);      
+     makestandardproc("MARK",          NULL);             
+     makestandardproc("MOVE",          proc_move);        
+     makestandardproc("MOVELEFT",      proc_move);        
+     makestandardproc("MOVERIGHT",     proc_move);        
+     makestandardproc("RELEASE",       NULL);             
+ 
+     makespecialvar(  "MEM",           var_mem);
+     makespecialvar(  "MEMW",          var_memw);
+     makespecialvar(  "MEML",          var_meml);
+     makespecialvar(  "PORT",          var_port);
+     makespecialvar(  "PORTW",         var_portw);
+ 
+     /* Modula-2 standard I/O procedures (case-sensitive!) */
+     makespecialproc( "Read",          proc_read);
+     makespecialproc( "ReadCard",      proc_read);
+     makespecialproc( "ReadInt",       proc_read);
+     makespecialproc( "ReadReal",      proc_read);
+     makespecialproc( "ReadString",    proc_read);
+     makespecialproc( "Write",         proc_write);
+     makespecialproc( "WriteCard",     proc_writecard);
+     makespecialproc( "WriteHex",      proc_writehex);
+     makespecialproc( "WriteInt",      proc_writeint);
+     makespecialproc( "WriteOct",      proc_writeoct);
+     makespecialproc( "WriteLn",       proc_writeln);
+     makespecialproc( "WriteReal",     proc_writereal);
+     makespecialproc( "WriteString",   proc_write);
+ }
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c:1.1
*** /dev/null	Mon Feb 16 17:43:40 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,140 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_HPMODS_C
+ #include "trans.h"
+ 
+ 
+ 
+ 
+ 
+ /* FS functions */
+ 
+ 
+ Static Stmt *proc_freadbytes()
+ {
+     Expr *ex, *ex2, *vex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fread", tp_integer,
+                            makeexpr_addr(vex),
+                            convert_size(type, ex2, "FREADBYTES"),
+                            makeexpr_long(1),
+                            filebasename(copyexpr(fex)));
+     if (checkeof(fex)) {
+         ex = makeexpr_bicall_2(name_SETIO, tp_void,
+                                makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+                                makeexpr_long(30));
+     }
+     return wrapopencheck(makestmt_call(ex), fex);
+ }
+ 
+ 
+ 
+ 
+ Static Stmt *proc_fwritebytes()
+ {
+     Expr *ex, *ex2, *vex, *fex;
+     Type *type;
+ 
+     if (!skipopenparen())
+ 	return NULL;
+     fex = p_expr(tp_text);
+     if (!skipcomma())
+ 	return NULL;
+     vex = p_expr(NULL);
+     if (!skipcomma())
+ 	return NULL;
+     ex2 = p_expr(tp_integer);
+     skipcloseparen();
+     type = vex->val.type;
+     ex = makeexpr_bicall_4("fwrite", tp_integer,
+                            makeexpr_addr(vex),
+                            convert_size(type, ex2, "FWRITEBYTES"),
+                            makeexpr_long(1),
+                            filebasename(copyexpr(fex)));
+     if (checkfilewrite) {
+         ex = makeexpr_bicall_2(name_SETIO, tp_void,
+                                makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+                                makeexpr_long(3));
+     }
+     return wrapopencheck(makestmt_call(ex), fex);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* SYSGLOBALS */
+ 
+ 
+ Static void setup_sysglobals()
+ {
+     Symbol *sym;
+ 
+     sym = findsymbol("SYSESCAPECODE");
+     if (sym->mbase)
+         strchange(&sym->mbase->name, name_ESCAPECODE);
+     sym = findsymbol("SYSIORESULT");
+     if (sym->mbase)
+         strchange(&sym->mbase->name, name_IORESULT);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ void hpmods(name, defn)
+ char *name;
+ int defn;
+ {
+     if (!strcmp(name, "FS")) {
+         makespecialproc("freadbytes", proc_freadbytes);
+         makespecialproc("fwritebytes", proc_fwritebytes);
+     } else if (!strcmp(name, "SYSGLOBALS")) {
+         setup_sysglobals();
+     }
+ }
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c:1.1
*** /dev/null	Mon Feb 16 17:43:40 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,3421 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_LEX_C
+ #include "trans.h"
+ 
+ 
+ /* Define LEXDEBUG for a token trace */
+ #define LEXDEBUG
+ 
+ 
+ 
+ 
+ #define EOFMARK 1
+ 
+ 
+ Static char dollar_flag, lex_initialized;
+ Static int if_flag, if_skip;
+ Static int commenting_flag;
+ Static char *commenting_ptr;
+ Static int skipflag;
+ Static char modulenotation;
+ Static short inputkind;
+ Static Strlist *instrlist;
+ Static char inbuf[300];
+ Static char *oldinfname, *oldctxname;
+ Static Strlist *endnotelist;
+ 
+ 
+ 
+ #define INP_FILE     0
+ #define INP_INCFILE  1
+ #define INP_STRLIST  2
+ 
+ Static struct inprec {
+     struct inprec *next;
+     short kind;
+     char *fname, *inbufptr;
+     int lnum;
+     FILE *filep;
+     Strlist *strlistp, *tempopts;
+     Token curtok, saveblockkind;
+     Symbol *curtoksym;
+     Meaning *curtokmeaning;
+     char *curtokbuf, *curtokcase;
+ } *topinput;
+ 
+ 
+ 
+ 
+ 
+ 
+ char *fixpascalname(name)
+ char *name;
+ {
+     char *cp, *cp2;
+ 
+     if (pascalsignif > 0) {
+         name = format_ds("%.*s", pascalsignif, name);
+         if (!pascalcasesens)
+             upc(name);
+ 	else if (pascalcasesens == 3)
+ 	    lwc(name);
+     } else if (!pascalcasesens)
+         name = strupper(name);
+     else if (pascalcasesens == 3)
+ 	name = strlower(name);
+     if (ignorenonalpha) {
+ 	for (cp = cp2 = name; *cp; cp++)
+ 	    if (isalnum(*cp))
+ 		*cp2++ = *cp;
+     }
+     return name;
+ }
+ 
+ 
+ 
+ Static void makekeyword(name)
+ char *name;
+ {
+     Symbol *sym;
+ 
+     if (*name) {
+         sym = findsymbol(name);
+         sym->flags |= AVOIDNAME;
+     }
+ }
+ 
+ 
+ Static void makeglobword(name)
+ char *name;
+ {
+     Symbol *sym;
+ 
+     if (*name) {
+         sym = findsymbol(name);
+         sym->flags |= AVOIDGLOB;
+     }
+ }
+ 
+ 
+ 
+ Static void makekeywords()
+ {
+     makekeyword("auto");
+     makekeyword("break");
+     makekeyword("char");
+     makekeyword("continue");
+     makekeyword("default");
+     makekeyword("defined");   /* is this one really necessary? */
+     makekeyword("double");
+     makekeyword("enum");
+     makekeyword("extern");
+     makekeyword("float");
+     makekeyword("int");
+     makekeyword("long");
+     makekeyword("noalias");
+     makekeyword("register");
+     makekeyword("return");
+     makekeyword("short");
+     makekeyword("signed");
+     makekeyword("sizeof");
+     makekeyword("static");
+     makekeyword("struct");
+     makekeyword("switch");
+     makekeyword("typedef");
+     makekeyword("union");
+     makekeyword("unsigned");
+     makekeyword("void");
+     makekeyword("volatile");
+     makekeyword("asm");
+     makekeyword("fortran");
+     makekeyword("entry");
+     makekeyword("pascal");
+     if (cplus != 0) {
+         makekeyword("class");
+         makekeyword("delete");
+         makekeyword("friend");
+         makekeyword("inline");
+         makekeyword("new");
+         makekeyword("operator");
+         makekeyword("overload");
+         makekeyword("public");
+         makekeyword("this");
+         makekeyword("virtual");
+     }
+     makekeyword(name_UCHAR);
+     makekeyword(name_SCHAR);    /* any others? */
+     makekeyword(name_BOOLEAN);
+     makekeyword(name_PROCEDURE);
+     makekeyword(name_ESCAPE);
+     makekeyword(name_ESCIO);
+     makekeyword(name_CHKIO);
+     makekeyword(name_SETIO);
+     makeglobword("main");
+     makeglobword("vextern");     /* used in generated .h files */
+     makeglobword("argc");
+     makeglobword("argv");
+     makekeyword("TRY");
+     makekeyword("RECOVER");
+     makekeyword("RECOVER2");
+     makekeyword("ENDTRY");
+ }
+ 
+ 
+ 
+ Static Symbol *Pkeyword(name, tok)
+ char *name;
+ Token tok;
+ {
+     Symbol *sp = NULL;
+ 
+     if (pascalcasesens != 2) {
+ 	sp = findsymbol(strlower(name));
+ 	sp->kwtok = tok;
+     }
+     if (pascalcasesens != 3) {
+ 	sp = findsymbol(strupper(name));
+ 	sp->kwtok = tok;
+     }
+     return sp;
+ }
+ 
+ 
+ Static Symbol *Pkeywordposs(name, tok)
+ char *name;
+ Token tok;
+ {
+     Symbol *sp = NULL;
+ 
+     if (pascalcasesens != 2) {
+ 	sp = findsymbol(strlower(name));
+ 	sp->kwtok = tok;
+ 	sp->flags |= KWPOSS;
+     }
+     if (pascalcasesens != 3) {
+ 	sp = findsymbol(strupper(name));
+ 	sp->kwtok = tok;
+ 	sp->flags |= KWPOSS;
+     }
+     return sp;
+ }
+ 
+ 
+ Static void makePascalwords()
+ {
+     Pkeyword("AND", TOK_AND);
+     Pkeyword("ARRAY", TOK_ARRAY);
+     Pkeywordposs("ANYVAR", TOK_ANYVAR);
+     Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
+     Pkeyword("BEGIN", TOK_BEGIN);
+     Pkeywordposs("BY", TOK_BY);
+     Pkeyword("CASE", TOK_CASE);
+     Pkeyword("CONST", TOK_CONST);
+     Pkeyword("DIV", TOK_DIV);
+     Pkeywordposs("DEFINITION", TOK_DEFINITION);
+     Pkeyword("DO", TOK_DO);
+     Pkeyword("DOWNTO", TOK_DOWNTO);
+     Pkeyword("ELSE", TOK_ELSE);
+     Pkeywordposs("ELSIF", TOK_ELSIF);
+     Pkeyword("END", TOK_END);
+     Pkeywordposs("EXPORT", TOK_EXPORT);
+     Pkeyword("FILE", TOK_FILE);
+     Pkeyword("FOR", TOK_FOR);
+     Pkeywordposs("FROM", TOK_FROM);
+     Pkeyword("FUNCTION", TOK_FUNCTION);
+     Pkeyword("GOTO", TOK_GOTO);
+     Pkeyword("IF", TOK_IF);
+     Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
+     Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
+     Pkeywordposs("IMPORT", TOK_IMPORT);
+     Pkeyword("IN", TOK_IN);
+     Pkeywordposs("INLINE", TOK_INLINE);
+     Pkeywordposs("INTERFACE", TOK_EXPORT);
+     Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
+     Pkeyword("LABEL", TOK_LABEL);
+     Pkeywordposs("LOOP", TOK_LOOP);
+     Pkeyword("MOD", TOK_MOD);
+     Pkeywordposs("MODULE", TOK_MODULE);
+     Pkeyword("NIL", TOK_NIL);
+     Pkeyword("NOT", TOK_NOT);
+     Pkeyword("OF", TOK_OF);
+     Pkeyword("OR", TOK_OR);
+     Pkeywordposs("ORIGIN", TOK_ORIGIN);
+     Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
+     Pkeywordposs("OVERLAY", TOK_SEGMENT);
+     Pkeyword("PACKED", TOK_PACKED);
+     Pkeywordposs("POINTER", TOK_POINTER);
+     Pkeyword("PROCEDURE", TOK_PROCEDURE);
+     Pkeyword("PROGRAM", TOK_PROGRAM);
+     Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
+     Pkeyword("RECORD", TOK_RECORD);
+     Pkeywordposs("RECOVER", TOK_RECOVER);
+     Pkeywordposs("REM", TOK_REM);
+     Pkeyword("REPEAT", TOK_REPEAT);
+     Pkeywordposs("RETURN", TOK_RETURN);
+     if (which_lang == LANG_UCSD)
+ 	Pkeyword("SEGMENT", TOK_SEGMENT);
+     else
+ 	Pkeywordposs("SEGMENT", TOK_SEGMENT);
+     Pkeyword("SET", TOK_SET);
+     Pkeywordposs("SHL", TOK_SHL);
+     Pkeywordposs("SHR", TOK_SHR);
+     Pkeyword("THEN", TOK_THEN);
+     Pkeyword("TO", TOK_TO);
+     Pkeywordposs("TRY", TOK_TRY);
+     Pkeyword("TYPE", TOK_TYPE);
+     Pkeyword("UNTIL", TOK_UNTIL);
+     Pkeywordposs("USES", TOK_IMPORT);
+     Pkeywordposs("UNIT", TOK_MODULE);
+     if (which_lang == LANG_VAX)
+ 	Pkeyword("VALUE", TOK_VALUE);
+     else
+ 	Pkeywordposs("VALUE", TOK_VALUE);
+     Pkeyword("VAR", TOK_VAR);
+     Pkeywordposs("VARYING", TOK_VARYING);
+     Pkeyword("WHILE", TOK_WHILE);
+     Pkeyword("WITH", TOK_WITH);
+     Pkeywordposs("XOR", TOK_XOR);
+     Pkeyword("__MODULE", TOK_MODULE);
+     Pkeyword("__IMPORT", TOK_IMPORT);
+     Pkeyword("__EXPORT", TOK_EXPORT);
+     Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
+ }
+ 
+ 
+ 
+ Static void deterministic(name)
+ char *name;
+ {
+     Symbol *sym;
+ 
+     if (*name) {
+         sym = findsymbol(name);
+         sym->flags |= DETERMF;
+     }
+ }
+ 
+ 
+ Static void nosideeff(name)
+ char *name;
+ {
+     Symbol *sym;
+ 
+     if (*name) {
+         sym = findsymbol(name);
+         sym->flags |= NOSIDEEFF;
+     }
+ }
+ 
+ 
+ 
+ Static void recordsideeffects()
+ {
+     deterministic("abs");
+     deterministic("acos");
+     deterministic("asin");
+     deterministic("atan");
+     deterministic("atan2");
+     deterministic("atof");
+     deterministic("atoi");
+     deterministic("atol");
+     deterministic("ceil");
+     deterministic("cos");
+     deterministic("cosh");
+     deterministic("exp");
+     deterministic("fabs");
+     deterministic("feof");
+     deterministic("feoln");
+     deterministic("ferror");
+     deterministic("floor");
+     deterministic("fmod");
+     deterministic("ftell");
+     deterministic("isalnum");
+     deterministic("isalpha");
+     deterministic("isdigit");
+     deterministic("islower");
+     deterministic("isspace");
+     deterministic("isupper");
+     deterministic("labs");
+     deterministic("ldexp");
+     deterministic("log");
+     deterministic("log10");
+     deterministic("memcmp");
+     deterministic("memchr");
+     deterministic("pow");
+     deterministic("sin");
+     deterministic("sinh");
+     deterministic("sqrt");
+     deterministic("strchr");
+     deterministic("strcmp");
+     deterministic("strcspn");
+     deterministic("strlen");
+     deterministic("strncmp");
+     deterministic("strpbrk");
+     deterministic("strrchr");
+     deterministic("strspn");
+     deterministic("strstr");
+     deterministic("tan");
+     deterministic("tanh");
+     deterministic("tolower");
+     deterministic("toupper");
+     deterministic(setequalname);
+     deterministic(subsetname);
+     deterministic(signextname);
+ }
+ 
+ 
+ 
+ 
+ 
+ void init_lex()
+ {
+     int i;
+ 
+     inputkind = INP_FILE;
+     inf_lnum = 0;
+     inf_ltotal = 0;
+     *inbuf = 0;
+     inbufptr = inbuf;
+     keepingstrlist = NULL;
+     tempoptionlist = NULL;
+     switch_strpos = 0;
+     dollar_flag = 0;
+     if_flag = 0;
+     if_skip = 0;
+     commenting_flag = 0;
+     skipflag = 0;
+     inbufindent = 0;
+     modulenotation = 1;
+     notephase = 0;
+     endnotelist = NULL;
+     for (i = 0; i < SYMHASHSIZE; i++)
+         symtab[i] = 0;
+     C_lex = 0;
+     lex_initialized = 0;
+ }
+ 
+ 
+ void setup_lex()
+ {
+     lex_initialized = 1;
+     if (!strcmp(language, "MODCAL"))
+         sysprog_flag = 2;
+     else
+         sysprog_flag = 0;
+     if (shortcircuit < 0)
+         partial_eval_flag = (which_lang == LANG_TURBO ||
+ 			     which_lang == LANG_VAX ||
+ 			     which_lang == LANG_OREGON ||
+ 			     modula2 ||
+ 			     hpux_lang);
+     else
+         partial_eval_flag = shortcircuit;
+     iocheck_flag = 1;
+     range_flag = 1;
+     ovflcheck_flag = 1;
+     stackcheck_flag = 1;
+     fixedflag = 0;
+     withlevel = 0;
+     makekeywords();
+     makePascalwords();
+     recordsideeffects();
+     topinput = 0;
+     ignore_directives = 0;
+     skipping_module = 0;
+     blockkind = TOK_END;
+     gettok();
+ }
+ 
+ 
+ 
+ 
+ int checkeatnote(msg)
+ char *msg;
+ {
+     Strlist *lp;
+     char *cp;
+     int len;
+ 
+     for (lp = eatnotes; lp; lp = lp->next) {
+ 	if (!strcmp(lp->s, "1")) {
+ 	    echoword("[*]", 0);
+ 	    return 1;
+ 	}
+ 	if (!strcmp(lp->s, "0"))
+ 	    return 0;
+ 	len = strlen(lp->s);
+ 	cp = msg;
+ 	while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
+ 	    cp++;
+ 	if (*cp) {
+ 	    cp = lp->s;
+ 	    if (*cp != '[')
+ 		cp = format_s("[%s", cp);
+ 	    if (cp[strlen(cp)-1] != ']')
+ 		cp = format_s("%s]", cp);
+ 	    echoword(cp, 0);
+ 	    return 1;
+ 	}
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ void beginerror()
+ {
+     end_source();
+     if (showprogress) {
+         fprintf(stderr, "\r%60s\r", "");
+         clearprogress();
+     } else
+ 	echobreak();
+ }
+ 
+ 
+ void counterror()
+ {
+     if (maxerrors > 0) {
+ 	if (--maxerrors == 0) {
+ 	    fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
+ 	    fprintf(outf,   "-------------------------------------------\n");
+ 	    if (outf != stdout)
+ 		printf("Translation aborted: Too many errors.\n");
+ 	    if (verbose)
+ 		fprintf(logf, "Translation aborted: Too many errors.\n");
+ 	    closelogfile();
+ 	    exit(EXIT_FAILURE);
+ 	}
+     }
+ }
+ 
+ 
+ void error(msg)     /* does not return */
+ char *msg;
+ {
+     flushcomments(NULL, -1, -1);
+     beginerror();
+     fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
+     fprintf(outf, "/* Translation aborted. */\n");
+     fprintf(outf, "--------------------------\n");
+     if (outf != stdout) {
+         printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+         printf("Translation aborted.\n");
+     }
+     if (verbose) {
+ 	fprintf(logf, "%s, line %d/%d: %s\n",
+ 		infname, inf_lnum, outf_lnum, msg);
+ 	fprintf(logf, "Translation aborted.\n");
+     }
+     closelogfile();
+     exit(EXIT_FAILURE);
+ }
+ 
+ 
+ void interror(proc, msg)      /* does not return */
+ char *proc, *msg;
+ {
+     error(format_ss("Internal error in %s: %s", proc, msg));
+ }
+ 
+ 
+ void warning(msg)
+ char *msg;
+ {
+     if (checkeatnote(msg)) {
+ 	if (verbose)
+ 	    fprintf(logf, "%s, %d/%d: Omitted warning: %s\n",
+ 		    infname, inf_lnum, outf_lnum, msg);
+ 	return;
+     }
+     beginerror();
+     addnote(format_s("Warning: %s", msg), curserial);
+     counterror();
+ }
+ 
+ 
+ void intwarning(proc, msg)
+ char *proc, *msg;
+ {
+     if (checkeatnote(msg)) {
+ 	if (verbose)
+ 	    fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %s\n",
+ 		    infname, inf_lnum, outf_lnum, proc, msg);
+ 	return;
+     }
+     beginerror();
+     addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
+     if (error_crash)
+         exit(EXIT_FAILURE);
+     counterror();
+ }
+ 
+ 
+ 
+ 
+ void note(msg)
+ char *msg;
+ {
+     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
+ 	if (verbose)
+ 	    fprintf(logf, "%s, %d/%d: Omitted note: %s\n",
+ 		    infname, inf_lnum, outf_lnum, msg);
+ 	return;
+     }
+     beginerror();
+     addnote(format_s("Note: %s", msg), curserial);
+     counterror();
+ }
+ 
+ 
+ 
+ void endnote(msg)
+ char *msg;
+ {
+     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
+ 	if (verbose)
+ 	    fprintf(logf, "%s, %d/%d: Omitted end-note: %s\n",
+ 		    infname, inf_lnum, outf_lnum, msg);
+ 	return;
+     }
+     if (verbose)
+ 	fprintf(logf, "%s, %d/%d: Recorded end-note: %s\n",
+ 		infname, inf_lnum, outf_lnum, msg);
+     (void) strlist_add(&endnotelist, msg);
+ }
+ 
+ 
+ void showendnotes()
+ {
+     while (initialcalls) {
+ 	if (initialcalls->value)
+ 	    endnote(format_s("Remember to call %s in main program [215]",
+ 			     initialcalls->s));
+ 	strlist_eat(&initialcalls);
+     }
+     if (endnotelist) {
+ 	end_source();
+ 	while (endnotelist) {
+ 	    if (outf != stdout) {
+ 		beginerror();
+ 		printf("Note: %s\n", endnotelist->s);
+ 	    }
+ 	    fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
+ 	    outf_lnum++;
+ 	    strlist_eat(&endnotelist);
+ 	}
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ char *tok_name(tok)
+ Token tok;
+ {
+     if (tok == TOK_END && inputkind == INP_STRLIST)
+ 	return "end of macro";
+     if (tok == curtok && tok == TOK_IDENT)
+         return format_s("'%s'", curtokcase);
+     if (!modulenotation) {
+         switch (tok) {
+             case TOK_MODULE:    return "UNIT";
+             case TOK_IMPORT:    return "USES";
+             case TOK_EXPORT:    return "INTERFACE";
+             case TOK_IMPLEMENT: return "IMPLEMENTATION";
+ 	    default:		break;
+         }
+     }
+     return toknames[(int) tok];
+ }
+ 
+ 
+ 
+ void expected(msg)
+ char *msg;
+ {
+     error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
+ }
+ 
+ 
+ void expecttok(tok)
+ Token tok;
+ {
+     if (curtok != tok)
+         expected(tok_name(tok));
+ }
+ 
+ 
+ void needtok(tok)
+ Token tok;
+ {
+     if (curtok != tok)
+         expected(tok_name(tok));
+     gettok();
+ }
+ 
+ 
+ int wexpected(msg)
+ char *msg;
+ {
+     warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
+     return 0;
+ }
+ 
+ 
+ int wexpecttok(tok)
+ Token tok;
+ {
+     if (curtok != tok)
+         return wexpected(tok_name(tok));
+     else
+ 	return 1;
+ }
+ 
+ 
+ int wneedtok(tok)
+ Token tok;
+ {
+     if (wexpecttok(tok)) {
+ 	gettok();
+ 	return 1;
+     } else
+ 	return 0;
+ }
+ 
+ 
+ void alreadydef(sym)
+ Symbol *sym;
+ {
+     warning(format_s("Symbol '%s' was already defined [220]", sym->name));
+ }
+ 
+ 
+ void undefsym(sym)
+ Symbol *sym;
+ {
+     warning(format_s("Symbol '%s' is not defined [221]", sym->name));
+ }
+ 
+ 
+ void symclass(sym)
+ Symbol *sym;
+ {
+     warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
+ }
+ 
+ 
+ void badtypes()
+ {
+     warning("Type mismatch [223]");
+ }
+ 
+ 
+ void valrange()
+ {
+     warning("Value range error [224]");
+ }
+ 
+ 
+ 
+ void skipparens()
+ {
+     Token begintok;
+ 
+     if (curtok == TOK_LPAR) {
+         gettok();
+         while (curtok != TOK_RPAR)
+             skipparens();
+     } else if (curtok == TOK_LBR) {
+         gettok();
+         while (curtok != TOK_RBR)
+             skipparens();
+     } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
+ 	       curtok == TOK_CASE) {
+ 	begintok = curtok;
+         gettok();
+         while (curtok != TOK_END)
+ 	    if (curtok == TOK_CASE && begintok == TOK_RECORD)
+ 		gettok();
+ 	    else
+ 		skipparens();
+     }
+     gettok();
+ }
+ 
+ 
+ void skiptotoken2(tok1, tok2)
+ Token tok1, tok2;
+ {
+     while (curtok != tok1 && curtok != tok2 &&
+ 	   curtok != TOK_END && curtok != TOK_RPAR &&
+ 	   curtok != TOK_RBR && curtok != TOK_EOF)
+ 	skipparens();
+ }
+ 
+ 
+ void skippasttoken2(tok1, tok2)
+ Token tok1, tok2;
+ {
+     skiptotoken2(tok1, tok2);
+     if (curtok == tok1 || curtok == tok2)
+ 	gettok();
+ }
+ 
+ 
+ void skippasttotoken(tok1, tok2)
+ Token tok1, tok2;
+ {
+     skiptotoken2(tok1, tok2);
+     if (curtok == tok1)
+ 	gettok();
+ }
+ 
+ 
+ void skiptotoken(tok)
+ Token tok;
+ {
+     skiptotoken2(tok, tok);
+ }
+ 
+ 
+ void skippasttoken(tok)
+ Token tok;
+ {
+     skippasttoken2(tok, tok);
+ }
+ 
+ 
+ 
+ int skipopenparen()
+ {
+     if (wneedtok(TOK_LPAR))
+ 	return 1;
+     skiptotoken(TOK_SEMI);
+     return 0;
+ }
+ 
+ 
+ int skipcloseparen()
+ {
+     if (curtok == TOK_COMMA)
+ 	warning("Too many arguments for built-in routine [225]");
+     else
+ 	if (wneedtok(TOK_RPAR))
+ 	    return 1;
+     skippasttotoken(TOK_RPAR, TOK_SEMI);
+     return 0;
+ }
+ 
+ 
+ int skipcomma()
+ {
+     if (curtok == TOK_RPAR)
+ 	warning("Too few arguments for built-in routine [226]");
+     else
+ 	if (wneedtok(TOK_COMMA))
+ 	    return 1;
+     skippasttotoken(TOK_RPAR, TOK_SEMI);
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ char *findaltname(name, num)
+ char *name;
+ int num;
+ {
+     char *cp;
+ 
+     if (num <= 0)
+         return name;
+     if (num == 1 && *alternatename1)
+         return format_s(alternatename1, name);
+     if (num == 2 && *alternatename2)
+         return format_s(alternatename2, name);
+     if (*alternatename)
+         return format_sd(alternatename, name, num);
+     cp = name;
+     if (*alternatename1) {
+         while (--num >= 0)
+ 	    cp = format_s(alternatename1, cp);
+     } else {
+ 	while (--num >= 0)
+ 	    cp = format_s("%s_", cp);
+     }
+     return cp;
+ }
+ 
+ 
+ 
+ 
+ Symbol *findsymbol_opt(name)
+ char *name;
+ {
+     register int i;
+     register unsigned int hash;
+     register char *cp;
+     register Symbol *sp;
+ 
+     hash = 0;
+     for (cp = name; *cp; cp++)
+         hash = hash*3 + *cp;
+     sp = symtab[hash % SYMHASHSIZE];
+     while (sp && (i = strcmp(sp->name, name)) != 0) {
+         if (i < 0)
+             sp = sp->left;
+         else
+             sp = sp->right;
+     }
+     return sp;
+ }
+ 
+ 
+ 
+ Symbol *findsymbol(name)
+ char *name;
+ {
+     register int i;
+     register unsigned int hash;
+     register char *cp;
+     register Symbol **prev, *sp;
+ 
+     hash = 0;
+     for (cp = name; *cp; cp++)
+         hash = hash*3 + *cp;
+     prev = symtab + (hash % SYMHASHSIZE);
+     while ((sp = *prev) != 0 &&
+            (i = strcmp(sp->name, name)) != 0) {
+         if (i < 0)
+             prev = &(sp->left);
+         else
+             prev = &(sp->right);
+     }
+     if (!sp) {
+         sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
+         sp->mbase = sp->fbase = NULL;
+         sp->left = sp->right = NULL;
+         strcpy(sp->name, name);
+         sp->flags = 0;
+ 	sp->kwtok = TOK_NONE;
+         sp->symbolnames = NULL;
+         *prev = sp;
+     }
+     return sp;
+ }
+ 
+ 
+ 
+ 
+ void clearprogress()
+ {
+     oldinfname = NULL;
+ }
+ 
+ 
+ void progress()
+ {
+     char *ctxname;
+     int needrefr;
+     static int prevlen;
+ 
+     if (showprogress) {
+         if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
+             !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
+             ctxname = "";
+         else
+             ctxname = curctx->name;
+         needrefr = (inf_lnum & 15) == 0;
+         if (oldinfname != infname || oldctxname != ctxname) {
+ 	    if (oldinfname != infname)
+ 		prevlen = 60;
+             fprintf(stderr, "\r%*s", prevlen + 2, "");
+             oldinfname = infname;
+             oldctxname = ctxname;
+             needrefr = 1;
+         }
+         if (needrefr) {
+             fprintf(stderr, "\r%5d %s  %s", inf_lnum, infname, ctxname);
+ 	    prevlen = 8 + strlen(infname) + strlen(ctxname);
+         } else {
+             fprintf(stderr, "\r%5d", inf_lnum);
+ 	    prevlen = 5;
+ 	}
+     }
+ }
+ 
+ 
+ 
+ void p2c_getline()
+ {
+     char *cp, *cp2;
+ 
+     switch (inputkind) {
+ 
+         case INP_FILE:
+         case INP_INCFILE:
+             inf_lnum++;
+ 	    inf_ltotal++;
+             if (fgets(inbuf, 300, inf)) {
+                 cp = inbuf + strlen(inbuf);
+                 if (*inbuf && cp[-1] == '\n')
+                     cp[-1] = 0;
+ 		if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
+ 		    cp = inbuf + 2;    /* in case input text came */
+ 		    inf_lnum = 0;      /*  from the C preprocessor */
+ 		    while (isdigit(*cp))
+ 			inf_lnum = inf_lnum*10 + (*cp++) - '0';
+ 		    inf_lnum--;
+ 		    while (isspace(*cp)) cp++;
+ 		    if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
+ 			cp++;
+ 			infname = stralloc(cp);
+ 			infname[cp2 - cp] = 0;
+ 		    }
+ 		    p2c_getline();
+ 		    return;
+ 		}
+ 		if (copysource && *inbuf) {
+ 		    start_source();
+ 		    fprintf(outf, "%s\n", inbuf);
+ 		}
+                 if (keepingstrlist) {
+                     strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
+                 }
+                 if (showprogress && inf_lnum % showprogress == 0)
+                     progress();
+             } else {
+                 if (showprogress)
+                     fprintf(stderr, "\n");
+                 if (inputkind == INP_INCFILE) {
+                     pop_input();
+                     p2c_getline();
+                 } else
+                     strcpy(inbuf, "\001");
+             }
+             break;
+ 
+         case INP_STRLIST:
+             if (instrlist) {
+                 strcpy(inbuf, instrlist->s);
+                 if (instrlist->value)
+                     inf_lnum = instrlist->value;
+                 else
+                     inf_lnum++;
+                 instrlist = instrlist->next;
+             } else
+                 strcpy(inbuf, "\001");
+             break;
+     }
+     inbufptr = inbuf;
+     inbufindent = 0;
+ }
+ 
+ 
+ 
+ 
+ Static void push_input()
+ {
+     struct inprec *inp;
+ 
+     inp = ALLOC(1, struct inprec, inprecs);
+     inp->kind = inputkind;
+     inp->fname = infname;
+     inp->lnum = inf_lnum;
+     inp->filep = inf;
+     inp->strlistp = instrlist;
+     inp->inbufptr = stralloc(inbufptr);
+     inp->curtok = curtok;
+     inp->curtoksym = curtoksym;
+     inp->curtokmeaning = curtokmeaning;
+     inp->curtokbuf = stralloc(curtokbuf);
+     inp->curtokcase = stralloc(curtokcase);
+     inp->saveblockkind = TOK_NIL;
+     inp->next = topinput;
+     topinput = inp;
+     inbufptr = inbuf + strlen(inbuf);
+ }
+ 
+ 
+ 
+ void push_input_file(fp, fname, isinclude)
+ FILE *fp;
+ char *fname;
+ int isinclude;
+ {
+     push_input();
+     inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
+     inf = fp;
+     inf_lnum = 0;
+     infname = fname;
+     *inbuf = 0;
+     inbufptr = inbuf;
+     topinput->tempopts = tempoptionlist;
+     tempoptionlist = NULL;
+     if (isinclude != 2)
+         gettok();
+ }
+ 
+ 
+ void include_as_import()
+ {
+     if (inputkind == INP_INCFILE) {
+ 	if (topinput->saveblockkind == TOK_NIL)
+ 	    topinput->saveblockkind = blockkind;
+ 	blockkind = TOK_IMPORT;
+     } else
+ 	warning(format_s("%s ignored except in include files [228]",
+ 			 interfacecomment));
+ }
+ 
+ 
+ void push_input_strlist(sp, fname)
+ Strlist *sp;
+ char *fname;
+ {
+     push_input();
+     inputkind = INP_STRLIST;
+     instrlist = sp;
+     if (fname) {
+         infname = fname;
+         inf_lnum = 0;
+     } else
+         inf_lnum--;     /* adjust for extra p2c_getline() */
+     *inbuf = 0;
+     inbufptr = inbuf;
+     gettok();
+ }
+ 
+ 
+ 
+ void pop_input()
+ {
+     struct inprec *inp;
+ 
+     if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
+ 	while (tempoptionlist) {
+ 	    undooption(tempoptionlist->value, tempoptionlist->s);
+ 	    strlist_eat(&tempoptionlist);
+ 	}
+ 	tempoptionlist = topinput->tempopts;
+ 	if (inf)
+ 	    fclose(inf);
+     }
+     inp = topinput;
+     topinput = inp->next;
+     if (inp->saveblockkind != TOK_NIL)
+ 	blockkind = inp->saveblockkind;
+     inputkind = inp->kind;
+     infname = inp->fname;
+     inf_lnum = inp->lnum;
+     inf = inp->filep;
+     curtok = inp->curtok;
+     curtoksym = inp->curtoksym;
+     curtokmeaning = inp->curtokmeaning;
+     strcpy(curtokbuf, inp->curtokbuf);
+     FREE(inp->curtokbuf);
+     strcpy(curtokcase, inp->curtokcase);
+     FREE(inp->curtokcase);
+     strcpy(inbuf, inp->inbufptr);
+     FREE(inp->inbufptr);
+     inbufptr = inbuf;
+     instrlist = inp->strlistp;
+     FREE(inp);
+ }
+ 
+ 
+ 
+ 
+ int undooption(i, name)
+ int i;
+ char *name;
+ {
+     char kind = rctable[i].kind;
+ 
+     switch (kind) {
+ 
+         case 'S':
+ 	case 'B':
+ 	    if (rcprevvalues[i]) {
+                 *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
+                 strlist_eat(&rcprevvalues[i]);
+                 return 1;
+             }
+             break;
+ 
+         case 'I':
+         case 'D':
+             if (rcprevvalues[i]) {
+                 *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
+                 strlist_eat(&rcprevvalues[i]);
+                 return 1;
+             }
+             break;
+ 
+         case 'L':
+             if (rcprevvalues[i]) {
+                 *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
+                 strlist_eat(&rcprevvalues[i]);
+                 return 1;
+             }
+             break;
+ 
+ 	case 'R':
+ 	    if (rcprevvalues[i]) {
+ 		*((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
+ 		strlist_eat(&rcprevvalues[i]);
+ 		return 1;
+ 	    }
+ 	    break;
+ 
+         case 'C':
+         case 'U':
+             if (rcprevvalues[i]) {
+                 strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
+                 strlist_eat(&rcprevvalues[i]);
+                 return 1;
+             }
+             break;
+ 
+         case 'A':
+             strlist_remove((Strlist **)rctable[i].ptr, name);
+             return 1;
+ 
+         case 'X':
+             if (rctable[i].def == 1) {
+                 strlist_remove((Strlist **)rctable[i].ptr, name);
+                 return 1;
+             }
+             break;
+ 
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ void badinclude()
+ {
+     warning("Can't handle an \"include\" directive here [229]");
+     inputkind = INP_INCFILE;     /* expand it in-line */
+     gettok();
+ }
+ 
+ 
+ 
+ int handle_include(fn)
+ char *fn;
+ {
+     FILE *fp = NULL;
+     Strlist *sl;
+ 
+     for (sl = includedirs; sl; sl = sl->next) {
+ 	fp = fopen(format_s(sl->s, fn), "r");
+ 	if (fp) {
+ 	    fn = stralloc(format_s(sl->s, fn));
+ 	    break;
+ 	}
+     }
+     if (!fp) {
+         perror(fn);
+         warning(format_s("Could not open include file %s [230]", fn));
+         return 0;
+     } else {
+         if (!quietmode && !showprogress)
+ 	    if (outf == stdout)
+ 		fprintf(stderr, "Reading include file \"%s\"\n", fn);
+ 	    else
+ 		printf("Reading include file \"%s\"\n", fn);
+ 	if (verbose)
+ 	    fprintf(logf, "Reading include file \"%s\"\n", fn);
+         if (expandincludes == 0) {
+             push_input_file(fp, fn, 2);
+             curtok = TOK_INCLUDE;
+             strcpy(curtokbuf, fn);
+         } else {
+             push_input_file(fp, fn, 1);
+         }
+         return 1;
+     }
+ }
+ 
+ 
+ 
+ int turbo_directive(closing, after)
+ char *closing, *after;
+ {
+     char *cp, *cp2;
+     int i, result;
+ 
+     if (!strcincmp(inbufptr, "$double", 7)) {
+ 	cp = inbufptr + 7;
+ 	while (isspace(*cp)) cp++;
+ 	if (cp == closing) {
+ 	    inbufptr = after;
+ 	    doublereals = 1;
+ 	    return 1;
+ 	}
+     } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
+ 	cp = inbufptr + 9;
+ 	while (isspace(*cp)) cp++;
+ 	if (cp == closing) {
+ 	    inbufptr = after;
+ 	    doublereals = 0;
+ 	    return 1;
+ 	}
+     }
+     switch (inbufptr[2]) {
+ 
+         case '+':
+         case '-':
+             result = 1;
+             cp = inbufptr + 1;
+             for (;;) {
+                 if (!isalpha(*cp++))
+                     return 0;
+                 if (*cp != '+' && *cp != '-')
+                     return 0;
+                 if (++cp == closing)
+                     break;
+                 if (*cp++ != ',')
+                     return 0;
+             }
+             cp = inbufptr + 1;
+             do {
+                 switch (*cp++) {
+ 
+                     case 'b':
+                     case 'B':
+                         if (shortcircuit < 0 && which_lang != LANG_MPW)
+                             partial_eval_flag = (*cp == '-');
+                         break;
+ 
+                     case 'i':
+                     case 'I':
+                         iocheck_flag = (*cp == '+');
+                         break;
+ 
+                     case 'r':
+                     case 'R':
+                         if (*cp == '+') {
+                             if (!range_flag)
+                                 note("Range checking is ON [216]");
+                             range_flag = 1;
+                         } else {
+                             if (range_flag)
+                                 note("Range checking is OFF [216]");
+                             range_flag = 0;
+                         }
+                         break;
+ 
+                     case 's':
+                     case 'S':
+                         if (*cp == '+') {
+                             if (!stackcheck_flag)
+                                 note("Stack checking is ON [217]");
+                             stackcheck_flag = 1;
+                         } else {
+                             if (stackcheck_flag)
+                                 note("Stack checking is OFF [217]");
+                             stackcheck_flag = 0;
+                         }
+                         break;
+ 
+                     default:
+                         result = 0;
+                         break;
+                 }
+                 cp++;
+             } while (*cp++ == ',');
+             if (result)
+                 inbufptr = after;
+             return result;
+ 
+ 	case 'c':
+ 	case 'C':
+ 	    if (toupper(inbufptr[1]) == 'S' &&
+ 		(inbufptr[3] == '+' || inbufptr[3] == '-') &&
+ 		inbufptr + 4 == closing) {
+ 		if (shortcircuit < 0)
+ 		    partial_eval_flag = (inbufptr[3] == '+');
+ 		inbufptr = after;
+ 		return 1;
+ 	    }
+ 	    return 0;
+ 
+         case ' ':
+             switch (inbufptr[1]) {
+ 
+                 case 'i':
+                 case 'I':
+                     if (skipping_module)
+                         break;
+                     cp = inbufptr + 3;
+                     while (isspace(*cp)) cp++;
+                     cp2 = cp;
+                     i = 0;
+                     while (*cp2 && cp2 != closing)
+                         i++, cp2++;
+                     if (cp2 != closing)
+                         return 0;
+                     while (isspace(cp[i-1]))
+                         if (--i <= 0)
+                             return 0;
+                     inbufptr = after;
+                     cp2 = ALLOC(i + 1, char, strings);
+                     strncpy(cp2, cp, i);
+                     cp2[i] = 0;
+                     if (handle_include(cp2))
+ 			return 2;
+ 		    break;
+ 
+ 		case 's':
+ 		case 'S':
+ 		    cp = inbufptr + 3;
+ 		    outsection(minorspace);
+ 		    if (cp == closing) {
+ 			output("#undef __SEG__\n");
+ 		    } else {
+ 			output("#define __SEG__ ");
+ 			while (*cp && cp != closing)
+ 			    cp++;
+ 			if (*cp) {
+ 			    i = *cp;
+ 			    *cp = 0;
+ 			    output(inbufptr + 3);
+ 			    *cp = i;
+ 			}
+ 			output("\n");
+ 		    }
+ 		    outsection(minorspace);
+ 		    inbufptr = after;
+ 		    return 1;
+ 
+             }
+             return 0;
+ 
+ 	case '}':
+ 	case '*':
+ 	    if (inbufptr + 2 == closing) {
+ 		switch (inbufptr[1]) {
+ 		    
+ 		  case 's':
+ 		  case 'S':
+ 		    outsection(minorspace);
+ 		    output("#undef __SEG__\n");
+ 		    outsection(minorspace);
+ 		    inbufptr = after;
+ 		    return 1;
+ 
+ 		}
+ 	    }
+ 	    return 0;
+ 
+         case 'f':   /* $ifdef etc. */
+         case 'F':
+             if (toupper(inbufptr[1]) == 'I' &&
+                 ((toupper(inbufptr[3]) == 'O' &&
+                   toupper(inbufptr[4]) == 'P' &&
+                   toupper(inbufptr[5]) == 'T') ||
+                  (toupper(inbufptr[3]) == 'D' &&
+                   toupper(inbufptr[4]) == 'E' &&
+                   toupper(inbufptr[5]) == 'F') ||
+                  (toupper(inbufptr[3]) == 'N' &&
+                   toupper(inbufptr[4]) == 'D' &&
+                   toupper(inbufptr[5]) == 'E' &&
+                   toupper(inbufptr[6]) == 'F'))) {
+                 note("Turbo Pascal conditional compilation directive was ignored [218]");
+             }
+             return 0;
+ 
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ extern Strlist *addmacros;
+ 
+ void defmacro(name, kind, fname, lnum)
+ char *name, *fname;
+ long kind;
+ int lnum;
+ {
+     Strlist *defsl, *sl, *sl2;
+     Symbol *sym, *sym2;
+     Meaning *mp;
+     Expr *ex;
+ 
+     defsl = NULL;
+     sl = strlist_append(&defsl, name);
+     C_lex++;
+     if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
+         fname = curtoksym->name;
+     push_input_strlist(defsl, fname);
+     if (fname)
+         inf_lnum = lnum;
+     switch (kind) {
+ 
+         case MAC_VAR:
+             if (!wexpecttok(TOK_IDENT))
+ 		break;
+ 	    for (mp = curtoksym->mbase; mp; mp = mp->snext) {
+ 		if (mp->kind == MK_VAR)
+ 		    warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
+ 	    }
+             sl = strlist_append(&varmacros, curtoksym->name);
+             gettok();
+             if (!wneedtok(TOK_EQ))
+ 		break;
+             sl->value = (long)pc_expr();
+             break;
+ 
+         case MAC_CONST:
+             if (!wexpecttok(TOK_IDENT))
+ 		break;
+ 	    for (mp = curtoksym->mbase; mp; mp = mp->snext) {
+ 		if (mp->kind == MK_CONST)
+ 		    warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
+ 	    }
+             sl = strlist_append(&constmacros, curtoksym->name);
+             gettok();
+             if (!wneedtok(TOK_EQ))
+ 		break;
+             sl->value = (long)pc_expr();
+             break;
+ 
+         case MAC_FIELD:
+             if (!wexpecttok(TOK_IDENT))
+ 		break;
+             sym = curtoksym;
+             gettok();
+             if (!wneedtok(TOK_DOT))
+ 		break;
+             if (!wexpecttok(TOK_IDENT))
+ 		break;
+ 	    sym2 = curtoksym;
+             gettok();
+ 	    if (!wneedtok(TOK_EQ))
+ 		break;
+             funcmacroargs = NULL;
+             sym->flags |= FMACREC;
+             ex = pc_expr();
+             sym->flags &= ~FMACREC;
+ 	    for (mp = sym2->fbase; mp; mp = mp->snext) {
+ 		if (mp->rectype && mp->rectype->meaning &&
+ 		    mp->rectype->meaning->sym == sym)
+ 		    break;
+ 	    }
+ 	    if (mp) {
+ 		mp->constdefn = ex;
+ 	    } else {
+ 		sl = strlist_append(&fieldmacros, 
+ 				    format_ss("%s.%s", sym->name, sym2->name));
+ 		sl->value = (long)ex;
+ 	    }
+             break;
+ 
+         case MAC_FUNC:
+             if (!wexpecttok(TOK_IDENT))
+ 		break;
+             sym = curtoksym;
+             if (sym->mbase &&
+ 		(sym->mbase->kind == MK_FUNCTION ||
+ 		 sym->mbase->kind == MK_SPECIAL))
+                 sl = NULL;
+             else
+                 sl = strlist_append(&funcmacros, sym->name);
+             gettok();
+             funcmacroargs = NULL;
+             if (curtok == TOK_LPAR) {
+                 do {
+                     gettok();
+ 		    if (curtok == TOK_RPAR && !funcmacroargs)
+ 			break;
+                     if (!wexpecttok(TOK_IDENT)) {
+ 			skiptotoken2(TOK_COMMA, TOK_RPAR);
+ 			continue;
+ 		    }
+                     sl2 = strlist_append(&funcmacroargs, curtoksym->name);
+                     sl2->value = (long)curtoksym;
+                     curtoksym->flags |= FMACREC;
+                     gettok();
+                 } while (curtok == TOK_COMMA);
+                 if (!wneedtok(TOK_RPAR))
+ 		    skippasttotoken(TOK_RPAR, TOK_EQ);
+             }
+             if (!wneedtok(TOK_EQ))
+ 		break;
+             if (sl)
+                 sl->value = (long)pc_expr();
+             else
+                 sym->mbase->constdefn = pc_expr();
+             for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
+                 sym2 = (Symbol *)sl2->value;
+                 sym2->flags &= ~FMACREC;
+             }
+             strlist_empty(&funcmacroargs);
+             break;
+ 
+     }
+     if (curtok != TOK_EOF)
+         warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
+     pop_input();
+     C_lex--;
+     strlist_empty(&defsl);
+ }
+ 
+ 
+ 
+ void check_unused_macros()
+ {
+     Strlist *sl;
+ 
+     if (warnmacros) {
+         for (sl = varmacros; sl; sl = sl->next)
+             warning(format_s("VarMacro %s was never used [234]", sl->s));
+         for (sl = constmacros; sl; sl = sl->next)
+             warning(format_s("ConstMacro %s was never used [234]", sl->s));
+         for (sl = fieldmacros; sl; sl = sl->next)
+             warning(format_s("FieldMacro %s was never used [234]", sl->s));
+         for (sl = funcmacros; sl; sl = sl->next)
+             warning(format_s("FuncMacro %s was never used [234]", sl->s));
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ #define skipspc(cp)   while (isspace(*cp)) cp++
+ 
+ Static int parsecomment(p2c_only, starparen)
+ int p2c_only, starparen;
+ {
+     char namebuf[302];
+     char *cp, *cp2 = namebuf, *closing, *after;
+     char kind, chgmode, upcflag;
+     long val, oldval, sign;
+     double dval;
+     int i, tempopt, hassign;
+     Strlist *sp;
+     Symbol *sym;
+ 
+     if (if_flag)
+         return 0;
+     if (!p2c_only) {
+         if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
+ 	     *noskipcomment) {
+             inbufptr += strlen(noskipcomment);
+ 	    if (skipflag < 0) {
+ 		if (skipflag < -1) {
+ 		    skipflag++;
+ 		} else {
+ 		    curtok = TOK_ENDIF;
+ 		    skipflag = 1;
+ 		    return 2;
+ 		}
+ 	    } else {
+ 		skipflag = 1;
+ 		return 1;
+ 	    }
+         }
+     }
+     closing = inbufptr;
+     while (*closing && (starparen
+ 			? (closing[0] != '*' || closing[1] != ')')
+ 			: (closing[0] != '}')))
+ 	closing++;
+     if (!*closing)
+ 	return 0;
+     after = closing + (starparen ? 2 : 1);
+     cp = inbufptr;
+     while (cp < closing && (*cp != '#' || cp[1] != '#'))
+ 	cp++;    /* Ignore comments */
+     if (cp < closing) {
+ 	while (isspace(cp[-1]))
+ 	    cp--;
+ 	*cp = '#';   /* avoid skipping spaces past closing! */
+ 	closing = cp;
+     }
+     if (!p2c_only) {
+         if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
+ 	     closing == inbufptr + 12) {
+             wrapup();
+             inbufptr = after;
+             return 1;
+         }
+         if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
+ 	     *fixedcomment &&
+ 	     inbufptr + strlen(fixedcomment) == closing) {
+             fixedflag++;
+             inbufptr = after;
+             return 1;
+         }
+         if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
+ 	     *permanentcomment &&
+ 	     inbufptr + strlen(permanentcomment) == closing) {
+             permflag = 1;
+             inbufptr = after;
+             return 1;
+         }
+         if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
+ 	     *interfacecomment &&
+ 	     inbufptr + strlen(interfacecomment) == closing) {
+             inbufptr = after;
+ 	    curtok = TOK_INTFONLY;
+             return 2;
+         }
+         if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
+ 	     *skipcomment &&
+ 	     inbufptr + strlen(skipcomment) == closing) {
+             inbufptr = after;
+ 	    skipflag--;
+ 	    if (skipflag == -1) {
+ 		skipping_module++;    /* eat comments in skipped portion */
+ 		do {
+ 		    gettok();
+ 		} while (curtok != TOK_ENDIF);
+ 		skipping_module--;
+ 	    }
+             return 1;
+         }
+ 	if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
+ 	     *signedcomment && !p2c_only &&
+ 	     inbufptr + strlen(signedcomment) == closing) {
+ 	    inbufptr = after;
+ 	    gettok();
+ 	    if (curtok == TOK_IDENT && curtokmeaning &&
+ 		curtokmeaning->kind == MK_TYPE &&
+ 		curtokmeaning->type == tp_char) {
+ 		curtokmeaning = mp_schar;
+ 	    } else
+ 		warning("{SIGNED} applied to type other than CHAR [314]");
+ 	    return 2;
+ 	}
+ 	if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
+ 	     *unsignedcomment && !p2c_only &&
+ 	     inbufptr + strlen(unsignedcomment) == closing) {
+ 	    inbufptr = after;
+ 	    gettok();
+ 	    if (curtok == TOK_IDENT && curtokmeaning &&
+ 		curtokmeaning->kind == MK_TYPE &&
+ 		curtokmeaning->type == tp_char) {
+ 		curtokmeaning = mp_uchar;
+ 	    } else if (curtok == TOK_IDENT && curtokmeaning &&
+ 		       curtokmeaning->kind == MK_TYPE &&
+ 		       curtokmeaning->type == tp_integer) {
+ 		curtokmeaning = mp_unsigned;
+ 	    } else if (curtok == TOK_IDENT && curtokmeaning &&
+ 		       curtokmeaning->kind == MK_TYPE &&
+ 		       curtokmeaning->type == tp_int) {
+ 		curtokmeaning = mp_uint;
+ 	    } else
+ 		warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
+ 	    return 2;
+ 	}
+         if (*inbufptr == '$') {
+             i = turbo_directive(closing, after);
+             if (i)
+                 return i;
+         }
+     }
+     tempopt = 0;
+     cp = inbufptr;
+     if (*cp == '*') {
+         cp++;
+         tempopt = 1;
+     }
+     if (!isalpha(*cp))
+         return 0;
+     while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
+         *cp2++ = toupper(*cp++);
+     *cp2 = 0;
+     i = numparams;
+     while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
+     if (i < 0)
+         return 0;
+     kind = rctable[i].kind;
+     chgmode = rctable[i].chgmode;
+     if (chgmode == ' ')    /* allowed in p2crc only */
+         return 0;
+     if (chgmode == 'T' && lex_initialized) {
+         if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
+             warning(format_s("%s works only at top of program [235]",
+                              rctable[i].name));
+     }
+     if (cp == closing) {
+         if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
+ 	    kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
+             undooption(i, "");
+             inbufptr = after;
+             return 1;
+         }
+     }
+     switch (kind) {
+ 
+         case 'S':
+         case 'I':
+         case 'L':
+             val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
+                            (kind == 'S') ? *((short *)rctable[i].ptr) :
+                                            *((  int *)rctable[i].ptr);
+             switch (*cp) {
+ 
+                 case '=':
+                     skipspc(cp);
+ 		    hassign = (*++cp == '-' || *cp == '+');
+                     sign = (*cp == '-') ? -1 : 1;
+ 		    cp += hassign;
+                     if (isdigit(*cp)) {
+                         val = 0;
+                         while (isdigit(*cp))
+                             val = val * 10 + (*cp++) - '0';
+                         val *= sign;
+ 			if (kind == 'D' && !hassign)
+ 			    val += 10000;
+                     } else if (toupper(cp[0]) == 'D' &&
+                                toupper(cp[1]) == 'E' &&
+                                toupper(cp[2]) == 'F') {
+                         val = rctable[i].def;
+                         cp += 3;
+                     }
+                     break;
+ 
+                 case '+':
+                 case '-':
+                     if (chgmode != 'R')
+                         return 0;
+                     for (;;) {
+                         if (*cp == '+')
+                             val++;
+                         else if (*cp == '-')
+                             val--;
+                         else
+                             break;
+                         cp++;
+                     }
+                     break;
+ 
+             }
+             skipspc(cp);
+             if (cp != closing)
+                 return 0;
+             strlist_insert(&rcprevvalues[i], "")->value = oldval;
+             if (tempopt)
+                 strlist_insert(&tempoptionlist, "")->value = i;
+             if (kind == 'L')
+                 *((long *)rctable[i].ptr) = val;
+             else if (kind == 'S')
+                 *((short *)rctable[i].ptr) = val;
+             else
+                 *((int *)rctable[i].ptr) = val;
+             inbufptr = after;
+             return 1;
+ 
+ 	case 'D':
+             val = oldval = *((int *)rctable[i].ptr);
+ 	    if (*cp++ != '=')
+ 		return 0;
+ 	    skipspc(cp);
+ 	    if (toupper(cp[0]) == 'D' &&
+ 		toupper(cp[1]) == 'E' &&
+ 		toupper(cp[2]) == 'F') {
+ 		val = rctable[i].def;
+ 		cp += 3;
+ 	    } else {
+                 cp2 = namebuf;
+                 while (*cp && cp != closing && !isspace(*cp))
+                     *cp2++ = *cp++;
+ 		*cp2 = 0;
+ 		val = parsedelta(namebuf, -1);
+ 		if (!val)
+ 		    return 0;
+ 	    }
+ 	    skipspc(cp);
+             if (cp != closing)
+                 return 0;
+             strlist_insert(&rcprevvalues[i], "")->value = oldval;
+             if (tempopt)
+                 strlist_insert(&tempoptionlist, "")->value = i;
+             *((int *)rctable[i].ptr) = val;
+             inbufptr = after;
+             return 1;
+ 
+         case 'R':
+ 	    if (*cp++ != '=')
+ 		return 0;
+ 	    skipspc(cp);
+ 	    if (toupper(cp[0]) == 'D' &&
+ 		toupper(cp[1]) == 'E' &&
+ 		toupper(cp[2]) == 'F') {
+ 		dval = rctable[i].def / 100.0;
+ 		cp += 3;
+ 	    } else {
+ 		cp2 = cp;
+ 		while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
+ 		       *cp == '.' || toupper(*cp) == 'E')
+ 		    cp++;
+ 		if (cp == cp2)
+ 		    return 0;
+ 		dval = atof(cp2);
+ 	    }
+ 	    skipspc(cp);
+ 	    if (cp != closing)
+ 		return 0;
+ 	    sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
+             strlist_insert(&rcprevvalues[i], namebuf);
+             if (tempopt)
+                 strlist_insert(&tempoptionlist, namebuf)->value = i;
+ 	    *((double *)rctable[i].ptr) = dval;
+             inbufptr = after;
+             return 1;
+ 
+         case 'B':
+ 	    if (*cp++ != '=')
+ 		return 0;
+ 	    skipspc(cp);
+ 	    if (toupper(cp[0]) == 'D' &&
+ 		toupper(cp[1]) == 'E' &&
+ 		toupper(cp[2]) == 'F') {
+ 		val = rctable[i].def;
+ 		cp += 3;
+ 	    } else {
+ 		val = parse_breakstr(cp);
+ 		while (*cp && cp != closing && !isspace(*cp))
+ 		    cp++;
+ 	    }
+ 	    skipspc(cp);
+ 	    if (cp != closing || val == -1)
+ 		return 0;
+             strlist_insert(&rcprevvalues[i], "")->value =
+ 		*((short *)rctable[i].ptr);
+             if (tempopt)
+                 strlist_insert(&tempoptionlist, "")->value = i;
+ 	    *((short *)rctable[i].ptr) = val;
+             inbufptr = after;
+             return 1;
+ 
+         case 'C':
+         case 'U':
+             if (*cp == '=') {
+                 cp++;
+                 skipspc(cp);
+                 for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
+                     if (!*cp2 || cp2-cp >= rctable[i].def)
+                         return 0;
+                 cp2 = (char *)rctable[i].ptr;
+                 sp = strlist_insert(&rcprevvalues[i], cp2);
+                 if (tempopt)
+                     strlist_insert(&tempoptionlist, "")->value = i;
+                 while (cp != closing && !isspace(*cp2))
+                     *cp2++ = *cp++;
+                 *cp2 = 0;
+                 if (kind == 'U')
+                     upc((char *)rctable[i].ptr);
+                 skipspc(cp);
+                 if (cp != closing)
+                     return 0;
+                 inbufptr = after;
+                 if (!strcmp(rctable[i].name, "LANGUAGE") &&
+                     !strcmp((char *)rctable[i].ptr, "MODCAL"))
+                     sysprog_flag |= 2;
+                 return 1;
+             }
+             return 0;
+ 
+         case 'F':
+         case 'G':
+             if (*cp == '=' || *cp == '+' || *cp == '-') {
+                 upcflag = (kind == 'F' && !pascalcasesens);
+                 chgmode = *cp++;
+                 skipspc(cp);
+                 cp2 = namebuf;
+                 while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
+                     *cp2++ = *cp++;
+                 *cp2++ = 0;
+ 		if (!*namebuf)
+ 		    return 0;
+                 skipspc(cp);
+                 if (cp != closing)
+                     return 0;
+                 if (upcflag)
+                     upc(namebuf);
+                 sym = findsymbol(namebuf);
+ 		if (rctable[i].def & FUNCBREAK)
+ 		    sym->flags &= ~FUNCBREAK;
+                 if (chgmode == '-')
+                     sym->flags &= ~rctable[i].def;
+                 else
+                     sym->flags |= rctable[i].def;
+                 inbufptr = after;
+                 return 1;
+            }
+            return 0;
+ 
+         case 'A':
+             if (*cp == '=' || *cp == '+' || *cp == '-') {
+                 chgmode = *cp++;
+                 skipspc(cp);
+                 cp2 = namebuf;
+                 while (cp != closing && !isspace(*cp) && *cp)
+                     *cp2++ = *cp++;
+                 *cp2++ = 0;
+                 skipspc(cp);
+                 if (cp != closing)
+                     return 0;
+                 if (chgmode != '+')
+                     strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+                 if (chgmode != '-')
+                     sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
+                 if (tempopt)
+                     strlist_insert(&tempoptionlist, namebuf)->value = i;
+                 inbufptr = after;
+                 return 1;
+             }
+             return 0;
+ 
+         case 'M':
+             if (!isspace(*cp))
+                 return 0;
+             skipspc(cp);
+             if (!isalpha(*cp))
+                 return 0;
+             for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
+             if (cp2 > cp && cp2 == closing) {
+                 inbufptr = after;
+                 cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
+                 if (tp_integer != NULL) {
+                     defmacro(cp2, rctable[i].def, NULL, 0);
+                 } else {
+                     sp = strlist_append(&addmacros, cp2);
+                     sp->value = rctable[i].def;
+                 }
+                 return 1;
+             }
+             return 0;
+ 
+         case 'X':
+             switch (rctable[i].def) {
+ 
+                 case 1:     /* strlist with string values */
+                     if (!isspace(*cp) && *cp != '=' && 
+                         *cp != '+' && *cp != '-')
+                         return 0;
+                     chgmode = *cp++;
+                     skipspc(cp);
+                     cp2 = namebuf;
+                     while (isalnum(*cp) || *cp == '_' ||
+ 			   *cp == '$' || *cp == '%' ||
+ 			   *cp == '.' || *cp == '-' ||
+ 			   (*cp == '\'' && cp[1] && cp[2] == '\'' &&
+ 			    cp+1 != closing && cp[1] != '=')) {
+ 			if (*cp == '\'') {
+ 			    *cp2++ = *cp++;
+ 			    *cp2++ = *cp++;
+ 			}			    
+                         *cp2++ = *cp++;
+ 		    }
+                     *cp2++ = 0;
+                     if (chgmode == '-') {
+                         skipspc(cp);
+                         if (cp != closing)
+                             return 0;
+                         strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+                     } else {
+                         if (!isspace(*cp) && *cp != '=')
+                             return 0;
+                         skipspc(cp);
+                         if (*cp == '=') {
+                             cp++;
+                             skipspc(cp);
+                         }
+                         if (chgmode == '=' || isspace(chgmode))
+                             strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+                         sp = strlist_append((Strlist **)rctable[i].ptr, namebuf);
+                         if (tempopt)
+                             strlist_insert(&tempoptionlist, namebuf)->value = i;
+                         cp2 = namebuf;
+                         while (*cp && cp != closing && !isspace(*cp))
+                             *cp2++ = *cp++;
+                         *cp2++ = 0;
+                         skipspc(cp);
+                         if (cp != closing)
+                             return 0;
+                         sp->value = (long)stralloc(namebuf);
+                     }
+                     inbufptr = after;
+                     if (lex_initialized)
+                         handle_nameof();        /* as good a place to do this as any! */
+                     return 1;
+ 
+                 case 3:     /* Synonym parameter */
+ 		    if (isspace(*cp) || *cp == '=' ||
+ 			*cp == '+' || *cp == '-') {
+ 			chgmode = *cp++;
+ 			skipspc(cp);
+ 			cp2 = namebuf;
+ 			while (isalnum(*cp) || *cp == '_' ||
+ 			       *cp == '$' || *cp == '%')
+ 			    *cp2++ = *cp++;
+ 			*cp2++ = 0;
+ 			if (!*namebuf)
+ 			    return 0;
+ 			skipspc(cp);
+ 			if (!pascalcasesens)
+ 			    upc(namebuf);
+ 			sym = findsymbol(namebuf);
+ 			if (chgmode == '-') {
+ 			    if (cp != closing)
+ 				return 0;
+ 			    sym->flags &= ~SSYNONYM;
+ 			    inbufptr = after;
+ 			    return 1;
+ 			}
+ 			if (*cp == '=') {
+ 			    cp++;
+ 			    skipspc(cp);
+ 			}
+ 			cp2 = namebuf;
+ 			while (isalnum(*cp) || *cp == '_' ||
+ 			       *cp == '$' || *cp == '%')
+ 			    *cp2++ = *cp++;
+ 			*cp2++ = 0;
+ 			skipspc(cp);
+ 			if (cp != closing)
+ 			    return 0;
+ 			sym->flags |= SSYNONYM;
+ 			if (!pascalcasesens)
+ 			    upc(namebuf);
+ 			if (*namebuf)
+ 			    strlist_append(&sym->symbolnames, "===")->value =
+ 				(long)findsymbol(namebuf);
+ 			else
+ 			    strlist_append(&sym->symbolnames, "===")->value=0;
+ 			inbufptr = after;
+ 			return 1;
+ 		    }
+ 		    return 0;
+ 
+             }
+             return 0;
+ 
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ Static void comment(starparen)
+ int starparen;    /* 0={ }, 1=(* *), 2=C comments*/
+ {
+     register char ch;
+     int nestcount = 1, startlnum = inf_lnum, wasrel = 0, trailing;
+     int i, cmtindent, cmtindent2, saveeat = eatcomments;
+     char *cp;
+ 
+     if (!strncmp(inbufptr, embedcomment, strlen(embedcomment)) &&
+ 	*embedcomment)
+ 	eatcomments = 0;
+     cp = inbuf;
+     while (isspace(*cp))
+ 	cp++;
+     trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*'));
+     cmtindent = inbufindent;
+     cmtindent2 = cmtindent + 1 + (starparen != 0);
+     cp = inbufptr;
+     while (isspace(*cp))
+ 	cmtindent2++, cp++;
+     cp = curtokbuf;
+     for (;;) {
+         ch = *inbufptr++;
+         switch (ch) {
+ 
+             case '}':
+                 if ((!starparen || nestedcomments == 0) &&
+ 		    starparen != 2 &&
+                     --nestcount <= 0) {
+                     *cp = 0;
+ 		    if (wasrel && !strcmp(curtokbuf, "\003"))
+ 			*curtokbuf = '\002';
+ 		    if (!commenting_flag)
+ 			commentline(trailing ? CMT_TRAIL : CMT_POST);
+ 		    eatcomments = saveeat;
+                     return;
+                 }
+                 break;
+ 
+             case '{':
+                 if (nestedcomments == 1 && starparen != 2)
+                     nestcount++;
+                 break;
+ 
+             case '*':
+                 if ((*inbufptr == ((starparen == 2) ? '/' : ')') &&
+ 		     (starparen || nestedcomments == 0)) &&
+                     --nestcount <= 0) {
+                     inbufptr++;
+                     *cp = 0;
+ 		    if (wasrel && !strcmp(curtokbuf, "\003"))
+ 			*curtokbuf = '\002';
+ 		    if (!commenting_flag)
+ 			commentline(trailing ? CMT_TRAIL : CMT_POST);
+ 		    eatcomments = saveeat;
+                     return;
+                 }
+                 break;
+ 
+             case '(':
+                 if (*inbufptr == '*' && nestedcomments == 1 &&
+ 		    starparen != 2) {
+ 		    *cp++ = ch;
+ 		    ch = *inbufptr++;
+                     nestcount++;
+ 		}
+                 break;
+ 
+             case 0:
+                 *cp = 0;
+ 	        if (commenting_flag)
+ 		    saveinputcomment(inbufptr-1);
+ 		else
+ 		    commentline(CMT_POST);
+ 		trailing = 0;
+                 p2c_getline();
+ 		i = 0;
+ 		for (;;) {
+ 		    if (*inbufptr == ' ') {
+ 			inbufptr++;
+ 			i++;
+ 		    } else if (*inbufptr == '\t') {
+ 			inbufptr++;
+ 			i++;
+ 			if (intabsize)
+ 			    i = (i / intabsize + 1) * intabsize;
+ 		    } else
+ 			break;
+ 		}
+ 		cp = curtokbuf;
+ 		if (*inbufptr) {
+ 		    if (i == cmtindent2 && !starparen)
+ 			cmtindent--;
+ 		    cmtindent2 = -1;
+ 		    if (i >= cmtindent && i > 0) {
+ 			*cp++ = '\002';
+ 			i -= cmtindent;
+ 			wasrel = 1;
+ 		    } else {
+ 			*cp++ = '\003';
+ 		    }
+ 		    while (--i >= 0)
+ 			*cp++ = ' ';
+ 		} else
+ 		    *cp++ = '\003';
+                 continue;
+ 
+             case EOFMARK:
+                 error(format_d("Runaway comment from line %d", startlnum));
+ 		eatcomments = saveeat;
+                 return;     /* unnecessary */
+ 
+         }
+         *cp++ = ch;
+     }
+ }
+ 
+ 
+ 
+ char *getinlinepart()
+ {
+     char *cp, *buf;
+ 
+     for (;;) {
+         if (isspace(*inbufptr)) {
+             inbufptr++;
+         } else if (!*inbufptr) {
+             p2c_getline();
+         } else if (*inbufptr == '{') {
+             inbufptr++;
+             comment(0);
+         } else if (*inbufptr == '(' && inbufptr[1] == '*') {
+             inbufptr += 2;
+             comment(1);
+         } else
+             break;
+     }
+     cp = inbufptr;
+     while (isspace(*cp) || isalnum(*cp) ||
+            *cp == '_' || *cp == '$' || 
+            *cp == '+' || *cp == '-' ||
+            *cp == '<' || *cp == '>')
+         cp++;
+     if (cp == inbufptr)
+         return "";
+     while (isspace(cp[-1]))
+         cp--;
+     buf = format_s("%s", inbufptr);
+     buf[cp-inbufptr] = 0;     /* truncate the string */
+     inbufptr = cp;
+     return buf;
+ }
+ 
+ 
+ 
+ 
+ Static int getflag()
+ {
+     int res = 1;
+ 
+     gettok();
+     if (curtok == TOK_IDENT) {
+         res = (strcmp(curtokbuf, "OFF") != 0);
+         gettok();
+     }
+     return res;
+ }
+ 
+ 
+ 
+ 
+ char getchartok()
+ {
+     if (!*inbufptr) {
+         warning("Unexpected end of line [236]");
+         return ' ';
+     }
+     if (isspace(*inbufptr)) {
+         warning("Whitespace not allowed here [237]");
+         return ' ';
+     }
+     return *inbufptr++;
+ }
+ 
+ 
+ 
+ char *getparenstr(buf)
+ char *buf;
+ {
+     int count = 0;
+     char *cp;
+ 
+     if (inbufptr < buf)    /* this will get most bad cases */
+         error("Can't handle a line break here");
+     while (isspace(*buf))
+         buf++;
+     cp = buf;
+     for (;;) {
+         if (!*cp)
+             error("Can't handle a line break here");
+         if (*cp == '(')
+             count++;
+         if (*cp == ')')
+             if (--count < 0)
+                 break;
+         cp++;
+     }
+     inbufptr = cp + 1;
+     while (cp > buf && isspace(cp[-1]))
+         cp--;
+     return format_ds("%.*s", (int)(cp - buf), buf);
+ }
+ 
+ 
+ 
+ void leadingcomments()
+ {
+     for (;;) {
+         switch (*inbufptr++) {
+ 
+             case 0:
+                 p2c_getline();
+                 break;
+ 
+             case ' ':
+             case '\t':
+             case 26:
+                 /* ignore whitespace */
+                 break;
+ 
+             case '{':
+                 if (!parsecomment(1, 0)) {
+                     inbufptr--;
+                     return;
+                 }
+                 break;
+ 
+ 	    case '(':
+ 		if (*inbufptr == '*') {
+ 		    inbufptr++;
+ 		    if (!parsecomment(1, 1)) {
+ 			inbufptr -= 2;
+ 			return;
+ 		    }
+ 		    break;
+ 		}
+ 		/* fall through */
+ 
+             default:
+                 inbufptr--;
+                 return;
+ 
+         }
+     }
+ }
+ 
+ 
+ 
+ 
+ void get_C_string(term)
+ int term;
+ {
+     char *cp = curtokbuf;
+     char ch;
+     int i;
+ 
+     while ((ch = *inbufptr++)) {
+         if (ch == term) {
+             *cp = 0;
+             curtokint = cp - curtokbuf;
+             return;
+         } else if (ch == '\\') {
+             if (isdigit(*inbufptr)) {
+                 i = (*inbufptr++) - '0';
+                 if (isdigit(*inbufptr))
+                     i = i*8 + (*inbufptr++) - '0';
+                 if (isdigit(*inbufptr))
+                     i = i*8 + (*inbufptr++) - '0';
+                 *cp++ = i;
+             } else {
+                 ch = *inbufptr++;
+                 switch (tolower(ch)) {
+                     case 'n':
+                         *cp++ = '\n';
+                         break;
+                     case 't':
+                         *cp++ = '\t';
+                         break;
+                     case 'v':
+                         *cp++ = '\v';
+                         break;
+                     case 'b':
+                         *cp++ = '\b';
+                         break;
+                     case 'r':
+                         *cp++ = '\r';
+                         break;
+                     case 'f':
+                         *cp++ = '\f';
+                         break;
+                     case '\\':
+                         *cp++ = '\\';
+                         break;
+                     case '\'':
+                         *cp++ = '\'';
+                         break;
+                     case '"':
+                         *cp++ = '"';
+                         break;
+                     case 'x':
+                         if (isxdigit(*inbufptr)) {
+                             if (isdigit(*inbufptr))
+                                 i = (*inbufptr++) - '0';
+                             else
+                                 i = (toupper(*inbufptr++)) - 'A' + 10;
+                             if (isdigit(*inbufptr))
+                                 i = i*16 + (*inbufptr++) - '0';
+                             else if (isxdigit(*inbufptr))
+                                 i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
+                             *cp++ = i;
+                             break;
+                         }
+                         /* fall through */
+                     default:
+                         warning("Strange character in C string [238]");
+                 }
+             }
+         } else
+             *cp++ = ch;
+     }
+     *cp = 0;
+     curtokint = cp - curtokbuf;
+     warning("Unterminated C string [239]");
+ }
+ 
+ 
+ 
+ 
+ 
+ void begincommenting(cp)
+ char *cp;
+ {
+     if (!commenting_flag) {
+ 	commenting_ptr = cp;
+     }
+     commenting_flag++;
+ }
+ 
+ 
+ void saveinputcomment(cp)
+ char *cp;
+ {
+     if (commenting_ptr)
+ 	sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
+     else
+ 	sprintf(curtokbuf, "\003%.*s", (int)(cp - inbuf), inbuf);
+     commentline(CMT_POST);
+     commenting_ptr = NULL;
+ }
+ 
+ 
+ void endcommenting(cp)
+ char *cp;
+ {
+     commenting_flag--;
+     if (!commenting_flag) {
+ 	saveinputcomment(cp);
+     }
+ }
+ 
+ 
+ 
+ 
+ int peeknextchar()
+ {
+     char *cp;
+ 
+     cp = inbufptr;
+     while (isspace(*cp))
+ 	cp++;
+     return *cp;
+ }
+ 
+ 
+ 
+ 
+ #ifdef LEXDEBUG
+ Static void zgettok();
+ void gettok()
+ {
+     zgettok();
+     if (tokentrace) {
+         printf("gettok() found %s", tok_name(curtok));
+         switch (curtok) {
+             case TOK_HEXLIT:
+             case TOK_OCTLIT:
+             case TOK_INTLIT:
+             case TOK_MININT:
+                 printf(", curtokint = %d", curtokint);
+                 break;
+             case TOK_REALLIT:
+             case TOK_STRLIT:
+                 printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
+                 break;
+ 	    default:
+ 		break;
+         }
+         putchar('\n');
+     }
+ }
+ Static void zgettok()
+ #else
+ void gettok()
+ #endif
+ {
+     register char ch;
+     register char *cp;
+     char ch2;
+     char *startcp;
+     int i;
+ 
+     debughook();
+     for (;;) {
+         switch ((ch = *inbufptr++)) {
+ 
+             case 0:
+ 	        if (commenting_flag)
+ 		    saveinputcomment(inbufptr-1);
+                 p2c_getline();
+ 		cp = curtokbuf;
+ 		for (;;) {
+ 		    inbufindent = 0;
+ 		    for (;;) {
+ 			if (*inbufptr == '\t') {
+ 			    inbufindent++;
+ 			    if (intabsize)
+ 				inbufindent = (inbufindent / intabsize + 1) * intabsize;
+ 			} else if (*inbufptr == ' ')
+ 			    inbufindent++;
+ 			else if (*inbufptr != 26)
+ 			    break;
+ 			inbufptr++;
+ 		    }
+ 		    if (!*inbufptr && !commenting_flag) {   /* blank line */
+ 			*cp++ = '\001';
+ 			p2c_getline();
+ 		    } else
+ 			break;
+ 		}
+ 		if (cp > curtokbuf) {
+ 		    *cp = 0;
+ 		    commentline(CMT_POST);
+ 		}
+                 break;
+ 
+             case '\t':
+             case ' ':
+             case 26:    /* ignore ^Z's in Turbo files */
+                 while (*inbufptr++ == ch) ;
+                 inbufptr--;
+                 break;
+ 
+             case '$':
+ 		if (dollar_idents)
+ 		    goto ident;
+                 if (dollar_flag) {
+                     dollar_flag = 0;
+                     curtok = TOK_DOLLAR;
+                     return;
+ 		}
+ 		startcp = inbufptr-1;
+ 		while (isspace(*inbufptr))
+ 		    inbufptr++;
+ 		cp = inbufptr;
+ 		while (isxdigit(*cp))
+ 		    cp++;
+ 		if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
+ 		    while (isspace(*cp))
+ 			cp++;
+ 		    if (!isdigit(*cp) && *cp != '\'') {
+ 			cp = curtokbuf;    /* Turbo hex constant */
+ 			while (isxdigit(*inbufptr))
+ 			    *cp++ = *inbufptr++;
+ 			*cp = 0;
+ 			curtok = TOK_HEXLIT;
+ 			curtokint = my_strtol(curtokbuf, NULL, 16);
+ 			return;
+ 		    }
+                 }
+ 		dollar_flag++;     /* HP Pascal compiler directive */
+ 		do {
+ 		    gettok();
+ 		    if (curtok == TOK_IF) {             /* $IF expr$ */
+ 			Expr *ex;
+ 			Value val;
+ 			if (!skipping_module) {
+ 			    if (!setup_complete)
+ 				error("$IF$ not allowed at top of program");
+ 
+ 			    /* Even though HP Pascal doesn't let these nest,
+ 			       there's no harm in supporting it. */
+ 			    if (if_flag) {
+ 				skiptotoken(TOK_DOLLAR);
+ 				if_flag++;
+ 				break;
+ 			    }
+ 			    gettok();
+ 			    ex = p_expr(tp_boolean);
+ 			    val = eval_expr_consts(ex);
+ 			    freeexpr(ex);
+ 			    i = (val.type == tp_boolean && val.i);
+ 			    free_value(&val);
+ 			    if (!i) {
+ 				if (curtok != TOK_DOLLAR) {
+ 				    warning("Syntax error in $IF$ expression [240]");
+ 				    skiptotoken(TOK_DOLLAR);
+ 				}
+ 				begincommenting(startcp);
+ 				if_flag++;
+ 				while (if_flag > 0)
+ 				    gettok();
+ 				endcommenting(inbufptr);
+ 			    }
+ 			} else {
+ 			    skiptotoken(TOK_DOLLAR);
+ 			}
+ 		    } else if (curtok == TOK_END) {     /* $END$ */
+ 			if (if_flag) {
+ 			    gettok();
+ 			    if (!wexpecttok(TOK_DOLLAR))
+ 				skiptotoken(TOK_DOLLAR);
+ 			    curtok = TOK_ENDIF;
+ 			    if_flag--;
+ 			    return;
+ 			} else {
+ 			    gettok();
+ 			    if (!wexpecttok(TOK_DOLLAR))
+ 				skiptotoken(TOK_DOLLAR);
+ 			}
+ 		    } else if (curtok == TOK_IDENT) {
+ 			if (!strcmp(curtokbuf, "INCLUDE") &&
+ 			     !if_flag && !skipping_module) {
+ 			    char *fn;
+ 			    gettok();
+ 			    if (curtok == TOK_IDENT) {
+ 				fn = stralloc(curtokcase);
+ 				gettok();
+ 			    } else if (wexpecttok(TOK_STRLIT)) {
+ 				fn = stralloc(curtokbuf);
+ 				gettok();
+ 			    } else
+ 				fn = "";
+ 			    if (!wexpecttok(TOK_DOLLAR)) {
+ 				skiptotoken(TOK_DOLLAR);
+ 			    } else {
+ 				if (handle_include(fn))
+ 				    return;
+ 			    }
+ 			} else if (ignore_directives ||
+ 				   if_flag ||
+ 				   !strcmp(curtokbuf, "SEARCH") ||
+ 				   !strcmp(curtokbuf, "REF") ||
+ 				   !strcmp(curtokbuf, "DEF")) {
+ 			    skiptotoken(TOK_DOLLAR);
+ 			} else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
+ 			    switch_strpos = getflag();
+ 			} else if (!strcmp(curtokbuf, "SYSPROG")) {
+ 			    if (getflag())
+ 				sysprog_flag |= 1;
+ 			    else
+ 				sysprog_flag &= ~1;
+ 			} else if (!strcmp(curtokbuf, "MODCAL")) {
+ 			    if (getflag())
+ 				sysprog_flag |= 2;
+ 			    else
+ 				sysprog_flag &= ~2;
+ 			} else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
+ 			    if (shortcircuit < 0)
+ 				partial_eval_flag = getflag();
+ 			} else if (!strcmp(curtokbuf, "IOCHECK")) {
+ 			    iocheck_flag = getflag();
+ 			} else if (!strcmp(curtokbuf, "RANGE")) {
+ 			    if (getflag()) {
+ 				if (!range_flag)
+ 				    note("Range checking is ON [216]");
+ 				range_flag = 1;
+ 			    } else {
+ 				if (range_flag)
+ 				    note("Range checking is OFF [216]");
+ 				range_flag = 0;
+ 			    }
+ 			} else if (!strcmp(curtokbuf, "OVFLCHECK")) {
+ 			    if (getflag()) {
+ 				if (!ovflcheck_flag)
+ 				    note("Overflow checking is ON [219]");
+ 				ovflcheck_flag = 1;
+ 			    } else {
+ 				if (ovflcheck_flag)
+ 				    note("Overflow checking is OFF [219]");
+ 				ovflcheck_flag = 0;
+ 			    }
+ 			} else if (!strcmp(curtokbuf, "STACKCHECK")) {
+ 			    if (getflag()) {
+ 				if (!stackcheck_flag)
+ 				    note("Stack checking is ON [217]");
+ 				stackcheck_flag = 1;
+ 			    } else {
+ 				if (stackcheck_flag)
+ 				    note("Stack checking is OFF [217]");
+ 				stackcheck_flag = 0;
+ 			    }
+ 			}
+ 			skiptotoken2(TOK_DOLLAR, TOK_COMMA);
+ 		    } else {
+ 			warning("Mismatched '$' signs [241]");
+ 			dollar_flag = 0;    /* got out of sync */
+ 			return;
+ 		    }
+ 		} while (curtok == TOK_COMMA);
+                 break;
+ 
+             case '"':
+ 		if (C_lex) {
+ 		    get_C_string(ch);
+ 		    curtok = TOK_STRLIT;
+ 		    return;
+ 		}
+ 		goto stringLiteral;
+ 
+             case '#':
+ 		if (modula2) {
+ 		    curtok = TOK_NE;
+ 		    return;
+ 		}
+ 		cp = inbufptr;
+ 		while (isspace(*cp)) cp++;
+ 		if (!strcincmp(cp, "INCLUDE", 7)) {
+ 		    char *cp2, *cp3;
+ 		    cp += 7;
+ 		    while (isspace(*cp)) cp++;
+ 		    cp2 = cp + strlen(cp) - 1;
+ 		    while (isspace(*cp2)) cp2--;
+ 		    if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
+ 			(*cp == '<' && *cp2 == '>')) {
+ 			inbufptr = cp2 + 1;
+ 			cp3 = stralloc(cp + 1);
+ 			cp3[cp2 - cp - 1] = 0;
+ 			if (handle_include(cp3))
+ 			    return;
+ 			else
+ 			    break;
+ 		    }
+ 		}
+ 		/* fall through */
+ 
+             case '\'':
+                 if (C_lex && ch == '\'') {
+                     get_C_string(ch);
+                     if (curtokint != 1)
+                         warning("Character constant has length != 1 [242]");
+                     curtokint = *curtokbuf;
+                     curtok = TOK_CHARLIT;
+                     return;
+                 }
+ 	      stringLiteral:
+                 cp = curtokbuf;
+ 		ch2 = (ch == '"') ? '"' : '\'';
+                 do {
+                     if (ch == ch2) {
+                         while ((ch = *inbufptr++) != '\n' &&
+                                ch != EOF) {
+                             if (ch == ch2) {
+                                 if (*inbufptr != ch2 || modula2)
+                                     break;
+                                 else
+                                     inbufptr++;
+                             }
+                             *cp++ = ch;
+                         }
+                         if (ch != ch2)
+                             warning("Error in string literal [243]");
+                     } else {
+                         ch = *inbufptr++;
+                         if (isdigit(ch)) {
+                             i = 0;
+                             while (isdigit(ch)) {
+                                 i = i*10 + ch - '0';
+                                 ch = *inbufptr++;
+                             }
+                             inbufptr--;
+                             *cp++ = i;
+                         } else {
+                             *cp++ = ch & 0x1f;
+                         }
+                     }
+                     while (*inbufptr == ' ' || *inbufptr == '\t')
+                         inbufptr++;
+                 } while ((ch = *inbufptr++) == ch2 || ch == '#');
+                 inbufptr--;
+                 *cp = 0;
+                 curtokint = cp - curtokbuf;
+                 curtok = TOK_STRLIT;
+                 return;
+ 
+             case '(':
+                 if (*inbufptr == '*' && !C_lex) {
+                     inbufptr++;
+ 		    switch (commenting_flag ? 0 : parsecomment(0, 1)) {
+ 		        case 0:
+                             comment(1);
+ 			    break;
+ 		        case 2:
+ 			    return;
+ 		    }
+                     break;
+                 } else if (*inbufptr == '.') {
+                     curtok = TOK_LBR;
+                     inbufptr++;
+                 } else {
+                     curtok = TOK_LPAR;
+                 }
+                 return;
+ 
+             case '{':
+                 if (C_lex || modula2) {
+                     curtok = TOK_LBRACE;
+                     return;
+                 }
+                 switch (commenting_flag ? 0 : parsecomment(0, 0)) {
+                     case 0:
+                         comment(0);
+                         break;
+                     case 2:
+                         return;
+                 }
+                 break;
+ 
+             case '}':
+                 if (C_lex || modula2) {
+                     curtok = TOK_RBRACE;
+                     return;
+                 }
+ 		if (skipflag > 0) {
+ 		    skipflag = 0;
+ 		} else
+ 		    warning("Unmatched '}' in input file [244]");
+                 break;
+ 
+             case ')':
+                 curtok = TOK_RPAR;
+                 return;
+ 
+             case '*':
+ 		if (*inbufptr == (C_lex ? '/' : ')')) {
+ 		    inbufptr++;
+ 		    if (skipflag > 0) {
+ 			skipflag = 0;
+ 		    } else
+ 			warning("Unmatched '*)' in input file [245]");
+ 		    break;
+ 		} else if (*inbufptr == '*' && !C_lex) {
+ 		    curtok = TOK_STARSTAR;
+ 		    inbufptr++;
+ 		} else
+ 		    curtok = TOK_STAR;
+                 return;
+ 
+             case '+':
+                 if (C_lex && *inbufptr == '+') {
+                     curtok = TOK_PLPL;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_PLUS;
+                 return;
+ 
+             case ',':
+                 curtok = TOK_COMMA;
+                 return;
+ 
+             case '-':
+                 if (C_lex && *inbufptr == '-') {
+                     curtok = TOK_MIMI;
+                     inbufptr++;
+                 } else if (*inbufptr == '>') {
+                     curtok = TOK_ARROW;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_MINUS;
+                 return;
+ 
+             case '.':
+                 if (*inbufptr == '.') {
+                     curtok = TOK_DOTS;
+                     inbufptr++;
+                 } else if (*inbufptr == ')') {
+                     curtok = TOK_RBR;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_DOT;
+                 return;
+ 
+             case '/':
+ 		if (C_lex && *inbufptr == '*') {
+ 		    inbufptr++;
+ 		    comment(2);
+ 		    break;
+ 		}
+                 curtok = TOK_SLASH;
+                 return;
+ 
+             case ':':
+                 if (*inbufptr == '=') {
+                     curtok = TOK_ASSIGN;
+                     inbufptr++;
+ 		} else if (*inbufptr == ':') {
+                     curtok = TOK_COLONCOLON;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_COLON;
+                 return;
+ 
+             case ';':
+                 curtok = TOK_SEMI;
+                 return;
+ 
+             case '<':
+                 if (*inbufptr == '=') {
+                     curtok = TOK_LE;
+                     inbufptr++;
+                 } else if (*inbufptr == '>') {
+                     curtok = TOK_NE;
+                     inbufptr++;
+                 } else if (*inbufptr == '<') {
+                     curtok = TOK_LTLT;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_LT;
+                 return;
+ 
+             case '>':
+                 if (*inbufptr == '=') {
+                     curtok = TOK_GE;
+                     inbufptr++;
+                 } else if (*inbufptr == '>') {
+                     curtok = TOK_GTGT;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_GT;
+                 return;
+ 
+             case '=':
+ 		if (*inbufptr == '=') {
+ 		    curtok = TOK_EQEQ;
+ 		    inbufptr++;
+ 		} else
+ 		    curtok = TOK_EQ;
+                 return;
+ 
+             case '[':
+                 curtok = TOK_LBR;
+                 return;
+ 
+             case ']':
+                 curtok = TOK_RBR;
+                 return;
+ 
+             case '^':
+                 curtok = TOK_HAT;
+                 return;
+ 
+             case '&':
+                 if (*inbufptr == '&') {
+                     curtok = TOK_ANDAND;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_AMP;
+                 return;
+ 
+             case '|':
+                 if (*inbufptr == '|') {
+                     curtok = TOK_OROR;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_VBAR;
+                 return;
+ 
+             case '~':
+                 curtok = TOK_TWIDDLE;
+                 return;
+ 
+             case '!':
+                 if (*inbufptr == '=') {
+                     curtok = TOK_BANGEQ;
+                     inbufptr++;
+                 } else
+                     curtok = TOK_BANG;
+                 return;
+ 
+             case '%':
+ 		if (C_lex) {
+ 		    curtok = TOK_PERC;
+ 		    return;
+ 		}
+ 		goto ident;
+ 
+             case '?':
+                 curtok = TOK_QM;
+                 return;
+ 
+             case '@':
+ 		curtok = TOK_ADDR;
+                 return;
+ 
+             case EOFMARK:
+                 if (curtok == TOK_EOF) {
+                     if (inputkind == INP_STRLIST)
+                         error("Unexpected end of macro");
+                     else
+                         error("Unexpected end of file");
+                 }
+                 curtok = TOK_EOF;
+                 return;
+ 
+             default:
+                 if (isdigit(ch)) {
+ 		    cp = inbufptr;
+ 		    while (isxdigit(*cp))
+ 			cp++;
+ 		    if (*cp == '#' && isxdigit(cp[1])) {
+ 			i = atoi(inbufptr-1);
+ 			inbufptr = cp+1;
+ 		    } else if (toupper(cp[-1]) == 'B' ||
+ 			       toupper(cp[-1]) == 'C') {
+                         inbufptr--;
+ 			i = 8;
+ 		    } else if (toupper(*cp) == 'H') {
+                         inbufptr--;
+ 			i = 16;
+ 		    } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
+ 				isxdigit(inbufptr[1]))) {
+ 			inbufptr++;
+ 			i = 16;
+ 		    } else {
+ 			i = 10;
+ 		    }
+ 		    if (i != 10) {
+                         curtokint = 0;
+                         while (isdigit(*inbufptr) ||
+ 			       (i > 10 && isxdigit(*inbufptr))) {
+                             ch = toupper(*inbufptr++);
+                             curtokint *= i;
+                             if (ch <= '9')
+                                 curtokint += ch - '0';
+                             else
+                                 curtokint += ch - 'A' + 10;
+                         }
+                         sprintf(curtokbuf, "%ld", curtokint);
+ 			if ((toupper(*inbufptr) == 'B' && i == 8) ||
+ 			    (toupper(*inbufptr) == 'H' && i == 16))
+ 			    inbufptr++;
+ 			if (toupper(*inbufptr) == 'C' && i == 8) {
+ 			    inbufptr++;
+ 			    curtok = TOK_STRLIT;
+ 			    curtokbuf[0] = curtokint;
+ 			    curtokbuf[1] = 0;
+ 			    curtokint = 1;
+ 			    return;
+ 			}
+                         if (toupper(*inbufptr) == 'L') {
+                             strcat(curtokbuf, "L");
+                             inbufptr++;
+                         }
+                         curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
+                         return;
+                     }
+                     cp = curtokbuf;
+                     i = 0;
+                     while (ch == '0')
+                         ch = *inbufptr++;
+                     if (isdigit(ch)) {
+                         while (isdigit(ch)) {
+                             *cp++ = ch;
+                             ch = *inbufptr++;
+                         }
+                     } else
+                         *cp++ = '0';
+                     if (ch == '.') {
+                         if (isdigit(*inbufptr)) {
+                             *cp++ = ch;
+                             ch = *inbufptr++;
+                             i = 1;
+                             while (isdigit(ch)) {
+                                 *cp++ = ch;
+                                 ch = *inbufptr++;
+                             }
+                         }
+                     }
+                     if (ch == 'e' || ch == 'E' ||
+ 			ch == 'd' || ch == 'D' ||
+ 			ch == 'q' || ch == 'Q') {
+                         ch = *inbufptr;
+                         if (isdigit(ch) || ch == '+' || ch == '-') {
+                             *cp++ = 'e';
+                             inbufptr++;
+                             i = 1;
+                             do {
+                                 *cp++ = ch;
+                                 ch = *inbufptr++;
+                             } while (isdigit(ch));
+                         }
+                     }
+                     inbufptr--;
+                     *cp = 0;
+                     if (i) {
+                         curtok = TOK_REALLIT;
+                         curtokint = cp - curtokbuf;
+                     } else {
+                         if (cp >= curtokbuf+10) {
+                             i = strcmp(curtokbuf, "2147483648");
+                             if (cp > curtokbuf+10 || i > 0) {
+ 				curtok = TOK_REALLIT;
+ 				curtokint = cp - curtokbuf + 2;
+ 				strcat(curtokbuf, ".0");
+ 				return;
+ 			    }
+                             if (i == 0) {
+                                 curtok = TOK_MININT;
+                                 curtokint = -2147483648;
+                                 return;
+                             }
+                         }
+                         curtok = TOK_INTLIT;
+                         curtokint = atol(curtokbuf);
+                         if (toupper(*inbufptr) == 'L') {
+                             strcat(curtokbuf, "L");
+                             inbufptr++;
+                         }
+                     }
+                     return;
+                 } else if (isalpha(ch) || ch == '_') {
+ ident:
+                     {
+                         register char *cp2;
+                         curtoksym = NULL;
+                         cp = curtokbuf;
+                         cp2 = curtokcase;
+ 			*cp2++ = symcase ? ch : tolower(ch);
+ 			*cp++ = pascalcasesens ? ch : toupper(ch);
+ 			while (isalnum((ch = *inbufptr++)) ||
+ 			       ch == '_' ||
+ 			       (ch == '%' && !C_lex) ||
+ 			       (ch == '$' && dollar_idents)) {
+ 			    *cp2++ = symcase ? ch : tolower(ch);
+ 			    if (!ignorenonalpha || isalnum(ch))
+ 				*cp++ = pascalcasesens ? ch : toupper(ch);
+ 			}
+                         inbufptr--;
+                         *cp2 = 0;
+                         *cp = 0;
+ 			if (pascalsignif > 0)
+ 			    curtokbuf[pascalsignif] = 0;
+                     }
+ 		    if (*curtokbuf == '%') {
+ 			if (!strcicmp(curtokbuf, "%INCLUDE")) {
+ 			    char *cp2 = inbufptr;
+ 			    while (isspace(*cp2)) cp2++;
+ 			    if (*cp2 == '\'')
+ 				cp2++;
+ 			    cp = curtokbuf;
+ 			    while (*cp2 && *cp2 != '\'' &&
+ 				   *cp2 != ';' && !isspace(*cp2)) {
+ 				*cp++ = *cp2++;
+ 			    }
+ 			    *cp = 0;
+ 			    cp = my_strrchr(curtokbuf, '/');
+ 			    if (cp && (!strcicmp(cp, "/LIST") ||
+ 				       !strcicmp(cp, "/NOLIST")))
+ 				*cp = 0;
+ 			    if (*cp2 == '\'')
+ 				cp2++;
+ 			    while (isspace(*cp2)) cp2++;
+ 			    if (*cp2 == ';')
+ 				cp2++;
+ 			    while (isspace(*cp2)) cp2++;
+ 			    if (!*cp2) {
+ 				inbufptr = cp2;
+ 				(void) handle_include(stralloc(curtokbuf));
+ 				return;
+ 			    }
+ 			} else if (!strcicmp(curtokbuf, "%TITLE") ||
+ 				   !strcicmp(curtokbuf, "%SUBTITLE")) {
+ 			    gettok();   /* string literal */
+ 			    break;
+ 			} else if (!strcicmp(curtokbuf, "%PAGE")) {
+ 			    /* should store a special page-break comment? */
+ 			    break;   /* ignore token */
+ 			} else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
+ 				   (i = 8, !strcicmp(curtokbuf, "%O")) ||
+ 				   (i = 16, !strcicmp(curtokbuf, "%X"))) {
+ 			    while (isspace(*inbufptr)) inbufptr++;
+ 			    if (*inbufptr == '\'') {
+ 				inbufptr++;
+ 				curtokint = 0;
+ 				while (*inbufptr && *inbufptr != '\'') {
+ 				    ch = toupper(*inbufptr++);
+ 				    if (isxdigit(ch)) {
+ 					curtokint *= i;
+ 					if (ch <= '9')
+ 					    curtokint += ch - '0';
+ 					else
+ 					    curtokint += ch - 'A' + 10;
+ 				    } else if (!isspace(ch))
+ 					warning("Bad digit in literal [246]");
+ 				}
+ 				if (*inbufptr)
+ 				    inbufptr++;
+ 				sprintf(curtokbuf, "%ld", curtokint);
+ 				curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
+ 				return;
+ 			    }
+                         }
+ 		    }
+                     {
+                         register unsigned int hash;
+                         register Symbol *sp;
+ 
+                         hash = 0;
+                         for (cp = curtokbuf; *cp; cp++)
+                             hash = hash*3 + *cp;
+                         sp = symtab[hash % SYMHASHSIZE];
+                         while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
+                             if (i < 0)
+                                 sp = sp->left;
+                             else
+                                 sp = sp->right;
+                         }
+                         if (!sp)
+                             sp = findsymbol(curtokbuf);
+ 			if (sp->flags & SSYNONYM) {
+ 			    i = 100;
+ 			    while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
+ 				Strlist *sl;
+ 				sl = strlist_find(sp->symbolnames, "===");
+ 				if (sl)
+ 				    sp = (Symbol *)sl->value;
+ 				else
+ 				    sp = NULL;
+ 			    }
+ 			    if (!sp)
+ 				break;    /* ignore token */
+ 			}
+ 			if (sp->kwtok && !(sp->flags & KWPOSS) &&
+ 			    (pascalcasesens != 2 || !islower(*curtokbuf)) &&
+ 			    (pascalcasesens != 3 || !isupper(*curtokbuf))) {
+ 			    curtok = sp->kwtok;
+ 			    return;
+ 			}
+ 			curtok = TOK_IDENT;
+                         curtoksym = sp;
+                         if ((i = withlevel) != 0 && sp->fbase) {
+                             while (--i >= 0) {
+                                 curtokmeaning = sp->fbase;
+                                 while (curtokmeaning) {
+                                     if (curtokmeaning->rectype == withlist[i]) {
+                                         curtokint = i;
+                                         return;
+                                     }
+                                     curtokmeaning = curtokmeaning->snext;
+                                 }
+                             }
+                         }
+                         curtokmeaning = sp->mbase;
+                         while (curtokmeaning && !curtokmeaning->isactive)
+                             curtokmeaning = curtokmeaning->snext;
+ 			if (!curtokmeaning)
+ 			    return;
+ 			while (curtokmeaning->kind == MK_SYNONYM)
+ 			    curtokmeaning = curtokmeaning->xnext;
+ 			/* look for unit.ident notation */
+                         if (curtokmeaning->kind == MK_MODULE ||
+ 			    curtokmeaning->kind == MK_FUNCTION) {
+                             for (cp = inbufptr; isspace(*cp); cp++) ;
+                             if (*cp == '.') {
+                                 for (cp++; isspace(*cp); cp++) ;
+                                 if (isalpha(*cp)) {
+                                     Meaning *mp = curtokmeaning;
+                                     Symbol *sym = curtoksym;
+                                     char *saveinbufptr = inbufptr;
+                                     gettok();
+                                     if (curtok == TOK_DOT)
+ 					gettok();
+ 				    else
+ 					curtok = TOK_END;
+                                     if (curtok == TOK_IDENT) {
+ 					curtokmeaning = curtoksym->mbase;
+ 					while (curtokmeaning &&
+ 					       curtokmeaning->ctx != mp)
+ 					    curtokmeaning = curtokmeaning->snext;
+ 					if (!curtokmeaning &&
+ 					    !strcmp(sym->name, "SYSTEM")) {
+ 					    curtokmeaning = curtoksym->mbase;
+ 					    while (curtokmeaning &&
+ 						   curtokmeaning->ctx != nullctx)
+ 						curtokmeaning = curtokmeaning->snext;
+ 					}
+ 				    } else
+ 					curtokmeaning = NULL;
+                                     if (!curtokmeaning) {
+                                         /* oops, was probably funcname.field */
+                                         inbufptr = saveinbufptr;
+                                         curtokmeaning = mp;
+                                         curtoksym = sym;
+                                     }
+                                 }
+                             }
+                         }
+                         return;
+                     }
+                 } else {
+                     warning(format_d("Unrecognized character 0%o in file [247]",
+ 				     ch));
+                 }
+         }
+     }
+ }
+ 
+ 
+ 
+ void checkkeyword(tok)
+ Token tok;
+ {
+     if (curtok == TOK_IDENT &&
+ 	curtoksym->kwtok == tok) {
+ 	curtoksym->flags &= ~KWPOSS;
+ 	curtok = tok;
+     }
+ }
+ 
+ 
+ void checkmodulewords()
+ {
+     if (modula2) {
+ 	checkkeyword(TOK_FROM);
+ 	checkkeyword(TOK_DEFINITION);
+ 	checkkeyword(TOK_IMPLEMENT);
+ 	checkkeyword(TOK_MODULE);
+ 	checkkeyword(TOK_IMPORT);
+ 	checkkeyword(TOK_EXPORT);
+     } else if (curtok == TOK_IDENT &&
+ 	       (curtoksym->kwtok == TOK_MODULE ||
+ 		curtoksym->kwtok == TOK_IMPORT ||
+ 		curtoksym->kwtok == TOK_EXPORT ||
+ 		curtoksym->kwtok == TOK_IMPLEMENT)) {
+ 	if (!strcmp(curtokbuf, "UNIT") ||
+ 	    !strcmp(curtokbuf, "USES") ||
+ 	    !strcmp(curtokbuf, "INTERFACE") ||
+ 	    !strcmp(curtokbuf, "IMPLEMENTATION")) {
+ 	    modulenotation = 0;
+ 	    findsymbol("UNIT")->flags &= ~KWPOSS;
+ 	    findsymbol("USES")->flags &= ~KWPOSS;
+ 	    findsymbol("INTERFACE")->flags &= ~KWPOSS;
+ 	    findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
+ 	} else {
+ 	    modulenotation = 1;
+ 	    findsymbol("MODULE")->flags &= ~KWPOSS;
+ 	    findsymbol("EXPORT")->flags &= ~KWPOSS;
+ 	    findsymbol("IMPORT")->flags &= ~KWPOSS;
+ 	    findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
+ 	}
+ 	curtok = curtoksym->kwtok;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/libp2c.a


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c:1.1
*** /dev/null	Mon Feb 16 17:43:40 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,6 ----
+ 
+ /* Put p2c runtime features local to your system here.
+  * In particular, additional initialization may be provided by defining
+  * the symbol LOCAL_INIT when you compile p2clib.c.
+  */
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/makeproto


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,1580 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ 
+ /* This needs to go before trans.h (and thus p2c.proto) is read */
+ 
+ typedef struct S_paren {
+     struct S_paren *next;
+     int pos, indent, qmindent, flags;
+ } Paren;
+ 
+ 
+ 
+ #define PROTO_OUT_C
+ #include "trans.h"
+ 
+ 
+ #ifndef USETIME
+ # if defined(BSD) || defined(hpux)
+ #  define USETIME 1
+ # else
+ #  define USETIME 0
+ # endif
+ #endif
+ 
+ #if USETIME
+ # include <sys/time.h>
+ #else
+ # include <time.h>
+ #endif
+ 
+ 
+ 
+ 
+ /* Output control characters:
+ 
+    \001  \B  Possible break point
+    \002  \X  Break point in parentheses
+    \003  \(  Invisible open paren
+    \004  \)  Invisible close paren
+    \005  \T  Set left margin
+    \006  \F  Forced break point
+    \007  \A  Preceding paren requires all-or-none breaking
+    \010  \[  Invisible open paren, becomes visible if not all on one line
+    \011  \S  Break point after last "special argument" of a function
+    \012  \n  (newline)
+    \013  \E  Preceding break has extra penalty
+    \014  \f  (form-feed)
+    \015  \H  Hang-indent the preceding operator
+    \016  \.  (unused)
+    \017  \C  Break point for last : of a ?: construct
+ 
+ */
+ 
+ char spchars[] = ".BX()TFA[SnEfH.C................";
+ 
+ 
+ 
+ Static int testinglinebreaker = 0;
+ 
+ Static int deltaindent, thisindent, thisfutureindent;
+ Static int sectionsize, blanklines, codesectsize, hdrsectsize;
+ Static int codelnum, hdrlnum;
+ 
+ #define MAXBREAKS  200
+ Static int numbreaks, bestnumbreaks;
+ Static double bestbadness;
+ Static int breakpos[MAXBREAKS], breakindent[MAXBREAKS];
+ Static int breakcount[MAXBREAKS], breakparen[MAXBREAKS];
+ Static int bestbreakpos[MAXBREAKS], bestbreakindent[MAXBREAKS];
+ Static int breakerrorflag;
+ 
+ #define MAXEDITS  200
+ Static int numedits, bestnumedits;
+ Static int editpos[MAXEDITS], besteditpos[MAXEDITS];
+ Static char editold[MAXEDITS], editnew[MAXEDITS];
+ Static char besteditold[MAXEDITS], besteditnew[MAXEDITS];
+ 
+ Static Paren *parenlist;
+ 
+ Static long numalts, bestnumalts;
+ Static int randombreaks;
+ 
+ Static char *outbuf;
+ Static int outbufpos, outbufcount, outbufsize;
+ Static int suppressnewline, lastlinelength;
+ Static int eatblanks;
+ Static int embeddedcode;
+ Static int showingsourcecode = 0;
+ 
+ #define BIGBADNESS  (1e20)
+ 
+ 
+ 
+ void setup_out()
+ {
+     end_source();
+     if (!nobanner)
+ 	fprintf(outf, "/* From input file \"%s\" */\n", infname);
+     outf_lnum++;
+     hdrlnum = 1;
+     outindent = 0;
+     deltaindent = 0;
+     thisindent = 0;
+     thisfutureindent = -1;
+     sectionsize = 2;
+     blanklines = 0;
+     dontbreaklines = 0;
+     embeddedcode = 0;
+     outputmode = 0;
+     suppressnewline = 0;
+     eatblanks = 0;
+     outbufsize = 1000;
+     outbuf = ALLOC(outbufsize, char, misc);
+     outbufpos = 0;
+     outbufcount = 0;
+     srand(17);
+ }
+ 
+ 
+ 
+ void select_outfile(fp)
+ FILE *fp;
+ {
+     if (outf == codef) {
+         codesectsize = sectionsize;
+ 	codelnum = outf_lnum;
+     } else {
+         hdrsectsize = sectionsize;
+ 	hdrlnum = outf_lnum;
+     }
+     outf = fp;
+     if (outf == codef) {
+         sectionsize = codesectsize;
+ 	outf_lnum = codelnum;
+     } else {
+         sectionsize = hdrsectsize;
+ 	outf_lnum = hdrlnum;
+     }
+ }
+ 
+ 
+ 
+ void start_source()
+ {
+     if (!showingsourcecode) {
+ 	fprintf(outf, "\n#ifdef Pascal\n");
+ 	showingsourcecode = 1;
+     }
+ }
+ 
+ void end_source()
+ {
+     if (showingsourcecode) {
+ 	fprintf(outf, "#endif /*Pascal*/\n\n");
+ 	showingsourcecode = 0;
+     }
+ }
+ 
+ 
+ 
+ int line_start()
+ {
+     return (outbufcount == 0);
+ }
+ 
+ 
+ int cur_column()
+ {
+     if (outbufpos == 0)
+ 	return outindent;
+     else
+ 	return thisindent + outbufcount;
+ }
+ 
+ 
+ 
+ int lookback(n)
+ int n;
+ {
+     if (n <= 0 || n > outbufpos)
+ 	return 0;
+     else
+ 	return outbuf[outbufpos - n];
+ }
+ 
+ 
+ int lookback_prn(n)
+ int n;
+ {
+     for (;;) {
+ 	if (n <= 0 || n > outbufpos)
+ 	    return 0;
+ 	else if (outbuf[outbufpos - n] >= ' ')
+ 	    return outbuf[outbufpos - n];
+ 	else
+ 	    n++;
+     }
+ }
+ 
+ 
+ 
+ /* Combine two indentation adjustments */
+ int adddeltas(d1, d2)
+ int d1, d2;
+ {
+     if (d2 >= 1000)
+ 	return d2;
+     else
+ 	return d1 + d2;
+ }
+ 
+ 
+ /* Apply an indentation delta */
+ int applydelta(i, d)
+ int i, d;
+ {
+     if (d >= 1000)
+ 	return d - 1000;
+     else
+ 	return i + d;
+ }
+ 
+ 
+ /* Adjust the current indentation by delta */
+ void moreindent(delta)
+ int delta;
+ {
+     outindent = applydelta(outindent, delta);
+ }
+ 
+ 
+ /* Adjust indentation for just this line */
+ void singleindent(delta)
+ int delta;
+ {
+     deltaindent = adddeltas(deltaindent, delta);
+ }
+ 
+ 
+ /* Predict indentation for next line */
+ void futureindent(num)
+ int num;
+ {
+     thisfutureindent = applydelta(applydelta(outindent, deltaindent), num);
+ }
+ 
+ 
+ int parsedelta(cp, def)
+ char *cp;
+ int def;
+ {
+     if (!cp || !*cp)
+ 	return def;
+     if ((*cp == '+' || *cp == '-') && isdigit(cp[1]))
+ 	return atoi(cp);
+     if (*cp == '*' && isdigit(cp[1]))
+ 	return 2000 + atoi(cp+1);
+     else
+ 	return 1000 + atoi(cp);
+ }
+ 
+ 
+ 
+ 
+ Static void leading_tab(col)
+ int col;
+ {
+     if (col > maxlinewidth)
+ 	return;    /* something wrong happened! */
+     if (phystabsize > 0) {
+ 	while (col >= phystabsize) {
+ 	    putc('\t', outf);
+ 	    col -= phystabsize;
+ 	}
+     }
+     while (col > 0) {
+ 	putc(' ', outf);
+ 	col--;
+     }
+ }
+ 
+ 
+ 
+ void eatblanklines()
+ {
+     eatblanks = 1;
+ }
+ 
+ 
+ 
+ Static void flush_outbuf(numbreaks, breakpos, breakindent,
+ 			 numedits, editpos, editold, editnew)
+ int numbreaks, *breakpos, *breakindent, numedits, *editpos;
+ char *editold, *editnew;
+ {
+     unsigned char ch, ch2;
+     char *cp;
+     int i, j, linelen = 0, spaces, hashline;
+     int editsaves[MAXEDITS];
+ 
+     end_source();
+     if (outbufcount > 0) {
+ 	for (i = 0; i < numedits; i++) {
+ 	    editsaves[i] = outbuf[editpos[i]];
+ 	    outbuf[editpos[i]] = editnew[i];
+ 	}
+ 	leading_tab(thisindent);
+ 	cp = outbuf;
+ 	hashline = (*cp == '#');    /* a preprocessor directive */
+ 	spaces = 0;
+ 	j = 1;
+ 	for (i = 0; i < outbufpos; ) {
+ 	    if (j < numbreaks && i == breakpos[j]) {
+ 		if (hashline)
+ 		    fprintf(outf, " \\");   /* trailing backslash required */
+ 		putc('\n', outf);
+ 		outf_lnum++;
+ 		leading_tab(breakindent[j]);
+ 		linelen = breakindent[j];
+ 		j++;
+ 		while (i < outbufpos && *cp == ' ')
+ 		    i++, cp++;   /* eat leading spaces */
+ 		spaces = 0;      /* eat trailing spaces */
+ 	    } else {
+ 		ch = *cp++;
+ 		if (ch == ' ') {
+ 		    spaces++;
+ 		} else if (ch > ' ') {
+ 		    linelen += spaces;
+ 		    while (spaces > 0)
+ 			putc(' ', outf), spaces--;
+ 		    linelen++;
+ 		    if (ch == '\\' && embeddedcode) {
+ 			if (*cp == '[') {
+ 			    putc('{', outf);
+ 			    cp++, i++;
+ 			} else if (*cp == ']') {
+ 			    putc('}', outf);
+ 			    cp++, i++;
+ 			} else
+ 			    putc(ch, outf);
+ 		    } else
+ 			putc(ch, outf);
+ 		} else if (testinglinebreaker >= 3) {
+ 		    linelen += spaces;
+ 		    while (spaces > 0)
+ 			putc(' ', outf), spaces--;
+ 		    linelen++;
+ 		    putc('\\', outf);
+ 		    ch2 = spchars[ch];
+ 		    if (ch2 != '.')
+ 			putc(ch2, outf);
+ 		    else {
+ 			putc('0' + ((ch >> 6) & 7), outf);
+ 			putc('0' + ((ch >> 3) & 7), outf);
+ 			putc('0' + (ch & 7), outf);
+ 		    }
+ 		}
+ 		i++;
+ 	    }
+ 	}
+ 	for (i = 0; i < numedits; i++)
+ 	    outbuf[editpos[i]] = editsaves[i];
+ 	eatblanks = 0;
+     } else if (eatblanks) {
+ 	return;
+     }
+     if (suppressnewline) {
+ 	lastlinelength = linelen;
+     } else
+ 	putc('\n', outf);
+     outf_lnum++;
+ }
+ 
+ 
+ 
+ #define ISQUOTE(ch)  ((ch)=='"' || (ch)=='\'')
+ #define ISOPENP(ch)  ((ch)=='(' || (ch)=='[' || (ch)=='\003' || (ch)=='\010')
+ #define ISCLOSEP(ch) ((ch)==')' || (ch)==']' || (ch)=='\004')
+ #define ISBREAK(ch)  ((ch)=='\001' || (ch)=='\002' || (ch)=='\006' || (ch)=='\011' || (ch)=='\017')
+ 
+ Static int readquotes(posp, err)
+ int *posp, err;
+ {
+     int pos;
+     char quote;
+ 
+     pos = *posp;
+     quote = outbuf[pos++];
+     while (pos < outbufpos && outbuf[pos] != quote) {
+ 	if (outbuf[pos] == '\\')
+ 	    pos++;
+ 	pos++;
+     }
+     if (pos >= outbufpos) {
+ 	if (err && breakerrorflag) {
+ 	    intwarning("output", "Mismatched quotes [248]");
+ 	    breakerrorflag = 0;
+ 	}
+ 	return 0;
+     } else {
+ 	*posp = pos;
+ 	return 1;
+     }    
+ }
+ 
+ 
+ Static int maxdepth;
+ 
+ Static int readparens(posp, err)
+ int *posp, err;
+ {
+     char ch, closing;
+     int pos, level;
+ 
+     pos = *posp;
+     switch (outbuf[pos]) {
+       case '(':
+ 	closing = ')';
+ 	break;
+       case '[':
+ 	closing = ']';
+ 	break;
+       case '\003':
+       case '\010':
+ 	closing = '\004';
+ 	break;
+       default:
+ 	closing = 0;
+ 	break;
+     }
+     level = 0;
+     for (;;) {
+ 	pos++;
+ 	if (pos >= outbufpos)
+ 	    break;
+ 	ch = outbuf[pos];
+ 	if (ISOPENP(ch)) {
+ 	    level++;
+ 	    if (level > maxdepth)
+ 		maxdepth = level;
+ 	} else if (ISCLOSEP(ch)) {
+ 	    level--;
+ 	    if (level < 0) {
+ 		if (closing && outbuf[pos] != closing)
+ 		    break;
+ 		*posp = pos;
+ 		return 1;
+ 	    }
+ 	} else if (ISQUOTE(ch)) {
+ 	    if (!readquotes(&pos, err))
+ 		return 0;
+ 	}
+     }
+     if (err && breakerrorflag) {
+ 	switch (closing) {
+ 	  case ')':
+ 	    intwarning("output", "Mismatched parentheses [249]");
+ 	    break;
+ 	  case ']':
+ 	    intwarning("output", "Mismatched brackets [249]");
+ 	    break;
+ 	  default:
+ 	    intwarning("output", "Mismatched clauses [250]");
+ 	    break;
+ 	}
+ 	breakerrorflag = 0;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ Static int measurechars(first, last)
+ int first, last;
+ {
+     int count = 0;
+ 
+     while (first <= last) {
+ 	if (outbuf[first] >= ' ')
+ 	    count++;
+ 	first++;
+     }
+     return count;
+ }
+ 
+ 
+ 
+ Static void makeedit(pos, ch)
+ int pos, ch;
+ {
+     editpos[numedits] = pos;
+     editold[numedits] = outbuf[pos];
+     editnew[numedits] = ch;
+     outbuf[pos] = ch;
+     numedits++;
+ }
+ 
+ Static void unedit()
+ {
+     numedits--;
+     outbuf[editpos[numedits]] = editold[numedits];
+ }
+ 
+ 
+ Static int parencount(par)
+ Paren *par;
+ {
+     int count = 0;
+ 
+     while (par) {
+ 	count++;
+ 	par = par->next;
+     }
+     return count;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* The following routine explores the tree of all possible line breaks,
+    pruning according to the fact that "badness" and "extra" are
+    increasing functions.  The object is to find the set of breaks and
+    indentation with the least total badness.
+    (The basic idea was borrowed from Donald Knuth's "TeX".)
+ */
+ 
+ /* As an additional optimization, the concept of a "simple" line is used,
+    i.e., a line with a structure such that the best break is sure to be
+    the straightforward left-to-right fill used by a simple word processor.
+    (For example, a long line with nothing but comma-breakpoints is simple.)
+ 
+    Also, if the line is very long a few initial random passes are made just
+    to scope out an estimate of the eventual badness of the line.  This
+    combined with the badness cull helps keep the breaker from using up its
+    quota of tries before even considering a key break point!  Note that
+    when randombreaks==1, each call to trybreakline is fast since only one
+    branch is taken at each decision point.
+ */
+ 
+ 
+ #define randtest(lim)  (!randombreaks ? -1    \
+ 			: randombreaks > 0    \
+ 			    ? parencount(parens) < randombreaks-1   \
+ 			: randombreaks == -2  \
+ 			    ? 0 \
+ 			: (rand() & 0xfff) < (lim))
+ 
+ #define TB_BRKCOUNT   0x0ff
+ #define TB_FORCEBRK   0x100
+ #define TB_NOBREAK    0x200
+ #define TB_ALREADYBRK 0x400
+ #define TB_ALLORNONE  0x800
+ #define TB_EXTRAIND   0x1000
+ #define TB_EXTRAIND2  0x2000
+ 
+ #define TBR_ABORT     0x1
+ #define TBR_SIMPLE    0x2
+ #define TBR_REACHED   0x4
+ 
+ Static int trybreakline(pos, count, indent, badness, flags, parens)
+ int pos, count, indent, flags;
+ double badness;
+ Paren *parens;
+ {
+     int edited;
+     int i, j, jmask, f, pos2, r;
+     char ch, ch2, closing;
+     double extra, penalty;
+     Paren *pp;
+ 
+ #if 0
+     { static double save = -1;
+       if (showbadlimit != save) printf("Showbadlimit = %g\n", showbadlimit);
+       save = showbadlimit;
+     }
+ #endif
+ 
+     if (numalts >= maxalts)
+ 	return TBR_ABORT;
+     jmask = -1;
+     for (;;) {
+ 	if (numbreaks >= MAXBREAKS) {   /* must leave rest of line alone */
+ 	    count += measurechars(pos, outbufpos-1);
+ 	    pos = outbufpos;
+ 	}
+ 	i = count - breakcount[numbreaks-1] +
+ 	    breakindent[numbreaks-1] - linewidth;
+ 	if (i <= 0)
+ 	    extra = 0;
+ 	else {
+ 	    if (i + linewidth >= maxlinewidth || randombreaks == -2)
+ 		return 0;   /* absolutely too long! */
+ 	    extra = overwidepenalty + ((long)i*i)*overwideextrapenalty;
+ 	    jmask &= ~TBR_SIMPLE;
+ 	    if (extra < 0)
+ 		extra = 0;
+ 	}
+ 	if ((testinglinebreaker > 1 && showbadlimit > 0) ?
+ 	    (badness + extra >= showbadlimit) :
+ 	    (badness + extra >= bestbadness)) {
+ 	    numalts++;
+ 	    return 0;   /* no point in going on, badness will only increase */
+ 	}
+ 	if (pos >= outbufpos)
+ 	    break;
+ 	if (parens && pos >= parens->pos) {
+ 	    indent = parens->indent;
+ 	    flags = parens->flags;
+ 	    parens = parens->next;
+ 	}
+ 	ch = outbuf[pos++];
+ 	if (ch >= ' ')
+ 	    count++;
+ 	switch (ch) {
+ 
+ 	  case '(':
+ 	  case '[':
+ 	  case '\003':     /* "invisible open paren" */
+ 	  case '\010':     /* "semi-invisible open paren" */
+ 	    pos2 = pos - 1;
+ 	    if (!readparens(&pos2, 1))
+ 		break;
+ 	    i = measurechars(pos, pos2);
+ 	    if (count + i - breakcount[numbreaks-1] +
+ 		breakindent[numbreaks-1] <= linewidth) {
+ 		/* it fits, so leave it on one line */
+ #if 0  /* I don't think this is necessary */
+ 		while (pos <= pos2) {
+ 		    if (outbuf[pos] == '\002') {
+ 			jmask &= ~TBR_SIMPLE;
+ 			pos = pos2 + 1;
+ 			break;
+ 		    }
+ 		    pos++;
+ 		}
+ #else
+ 		pos = pos2 + 1;
+ #endif
+ 		count += i;
+ 		break;
+ 	    }
+ 	    pp = ALLOC(1, Paren, parens);   /* doesn't fit, try poss breaks */
+ 	    pp->next = parens;
+ 	    pp->pos = pos2;
+ 	    pp->indent = indent;
+ 	    pp->qmindent = indent;
+ 	    pp->flags = flags;
+ 	    parens = pp;
+ 	    flags = 0;
+ 	    if (ch == '\010' &&       /* change to real parens when broken */
+ 		numedits+1 < MAXEDITS) {    /* (assume it will be broken!) */
+ 		makeedit(pos-1, '(');
+ 		makeedit(pos2, ')');
+ 		count++;    /* count the new open paren */
+ 		edited = 1;
+ 	    } else
+ 		edited = 0;
+ 	    i = breakindent[numbreaks-1] + count - breakcount[numbreaks-1];
+ 	    if (i <= thisindent)
+ 		r = 0;  /* e.g., don't break top-level assignments */
+ 	    else if (i == indent + extraindent)
+ 		r = 1;  /* don't waste time on identical operations */
+ 	    else
+ 		r = randtest(0xc00);
+ 	    if (r != 0) {
+ 		j = trybreakline(pos, count, i,
+ 				 badness + MAX(- extraindentpenalty,0),
+ 				 flags, parens);
+ 	    } else
+ 		j = 0;
+ 	    if (r != 1) {
+ 		j &= trybreakline(pos, count, indent + extraindent,
+ 				  badness + MAX(extraindentpenalty,0),
+ 				  flags | TB_EXTRAIND, parens);
+ 	    }
+ 	    if (!randombreaks && bumpindent != 0) {
+ 		if (i == thisfutureindent) {
+ 		    j &= trybreakline(pos, count, i + bumpindent,
+ 				      badness + MAX(- extraindentpenalty,0)
+ 				              + bumpindentpenalty,
+ 				      flags, parens);
+ 		} else if (indent + extraindent == thisfutureindent) {
+ 		    j &= trybreakline(pos, count,
+ 				      indent + extraindent + bumpindent,
+ 				      badness + MAX(extraindentpenalty,0)
+ 				              + bumpindentpenalty,
+ 				      flags | TB_EXTRAIND, parens);
+ 		}
+ 	    }
+ 	    if (edited) {
+ 		unedit();
+ 		unedit();
+ 	    }
+ 	    FREE(pp);
+ 	    return j & jmask;
+ 
+ 	  case '\005':   /* "set left margin" */
+ 	    indent = breakindent[numbreaks-1] +
+ 		     count - breakcount[numbreaks-1];
+ 	    break;
+ 
+ 	  case '\007':   /* "all-or-none breaking" */
+ 	    flags |= TB_ALLORNONE;
+ 	    break;
+ 
+ 	  case '\001':   /* "possible break point" */
+ 	  case '\002':   /* "break point in parens" */
+ 	  case '\006':   /* "forced break point" */
+ 	  case '\011':   /* "break point after special args" */
+ 	  case '\017':   /* "break point for final : operator" */
+ 	    /* first try the non-breaking case */
+ 	    if (ch != '\001' && ch != '\006')
+ 		jmask &= ~TBR_SIMPLE;
+ 	    if ((flags & TB_BRKCOUNT) != TB_BRKCOUNT)
+ 		flags++;   /* increment TB_BRKCOUNT field */
+ 	    if (outbuf[pos] == '?' && parens)
+ 		parens->qmindent = breakindent[numbreaks-1] +
+ 		                   count - breakcount[numbreaks-1];
+ 	    j = TBR_REACHED;
+ 	    if (ch == '\006' || (flags & TB_FORCEBRK)) {
+ 		/* don't try the non-breaking case */
+ 	    } else {
+ 		if (ch == '\011') {
+ 		    i = breakindent[numbreaks-1] +
+ 			count - breakcount[numbreaks-1] + 2;
+ 		} else {
+ 		    i = indent;
+ 		}
+ 		f = flags;
+ 		if (f & TB_ALLORNONE)
+ 		    f |= TB_NOBREAK;
+ 		r = randtest(0x800);
+ 		if (r != 1 || (flags & TB_NOBREAK)) {
+ 		    j = trybreakline(pos, count, i, badness, f, parens) &
+ 			jmask;
+ 		    if (randombreaks == -2 && !(j & TBR_REACHED)) {
+ 			r = -1;
+ 			j |= TBR_REACHED;
+ 		    }
+ 		    if (r == 0 || (j & TBR_SIMPLE))
+ 			flags |= TB_NOBREAK;
+ 		}
+ 	    }
+ 	    if (flags & TB_NOBREAK)
+ 		return j;
+ 	    if (flags & TB_ALLORNONE)
+ 		flags |= TB_FORCEBRK;
+ 	    if (flags & TB_EXTRAIND) {
+ 		flags &= ~TB_EXTRAIND;
+ 		flags |= TB_EXTRAIND2;
+ 	    }
+ 	    /* now try breaking here */
+ 	    if (ch == '\017')
+ 		indent = parens->qmindent;
+ 	    if (indent < 0)
+ 		indent = 0;
+ 	    breakpos[numbreaks] = pos;
+ 	    breakcount[numbreaks] = count;
+ 	    breakindent[numbreaks] = indent;
+ 	    breakparen[numbreaks] = parens ? parens->pos : 0;
+ 	    numbreaks++;
+ 	    penalty = extra;
+ 	    if (indent == thisfutureindent) {
+ 		i = pos;
+ 		while (i < outbufpos-1 && outbuf[i] <= ' ')
+ 		    i++;
+ 		ch2 = outbuf[i];   /* first character on next line */
+ 		if (ch2 != '(' && ch2 != '!' && ch2 != '~' && ch2 != '-')
+ 		    penalty += nobumpindentpenalty;
+ 	    }
+ 	    switch (ch) {
+ 	      case '\001':
+ 		penalty += commabreakpenalty;
+ 		if (flags & TB_ALREADYBRK)
+ 		    penalty += morebreakpenalty;
+ 		break;
+ 	      case '\011':
+ 		i = parencount(parens);
+ 		penalty += specialargbreakpenalty + commabreakextrapenalty*i;
+ 		break;
+ 	      case '\002':
+ 	      case '\017':
+ 		i = parencount(parens);
+ 		if (outbuf[pos-2] == '(')
+ 		    penalty += parenbreakpenalty + parenbreakextrapenalty*i;
+ 		else if (outbuf[pos-2] == ',')
+ 		    penalty += commabreakpenalty + commabreakextrapenalty*i;
+ 		else if (((outbuf[pos] == '&' || outbuf[pos] == '|') &&
+ 			  outbuf[pos+1] == outbuf[pos]) ||
+ 			 ((outbuf[pos-3] == '&' || outbuf[pos-3] == '|') &&
+ 			  outbuf[pos-3] == outbuf[pos-2]))
+ 		    penalty += logbreakpenalty + logbreakextrapenalty*i;
+ 		else if (((outbuf[pos] == '<' || outbuf[pos] == '>') &&
+ 			  outbuf[pos+1] != outbuf[pos]) ||
+ 			 ((outbuf[pos] == '=' || outbuf[pos] == '!') &&
+ 			  outbuf[pos+1] == '=') ||
+ 			 ((outbuf[pos-2] == '<' || outbuf[pos-2] == '>') &&
+ 			  outbuf[pos-3] != outbuf[pos-2]) ||
+ 			 ((outbuf[pos-3] == '<' || outbuf[pos-3] == '>' ||
+ 			   outbuf[pos-3] == '=' || outbuf[pos-3] == '!') &&
+ 			  outbuf[pos-2] == '='))
+ 		    penalty += relbreakpenalty + relbreakextrapenalty*i;
+ 		else if (outbuf[pos-2] == '=')
+ 		    penalty += assignbreakpenalty + assignbreakextrapenalty*i;
+ 		else if (outbuf[pos] == '?') {
+ 		    penalty += qmarkbreakpenalty + qmarkbreakextrapenalty*i;
+ 		    if (parens)
+ 			parens->qmindent = breakindent[numbreaks-1] +
+ 			                   count - breakcount[numbreaks-1];
+ 		} else
+ 		    penalty += opbreakpenalty + opbreakextrapenalty*i;
+ 		if (outbuf[pos-2] == '-')
+ 		    penalty += exhyphenpenalty;
+ 		if (flags & TB_ALREADYBRK)
+ 		    penalty += morebreakpenalty + morebreakextrapenalty*i;
+ 		break;
+ 	      default:
+ 		break;
+ 	    }
+ 	    while (pos < outbufpos && outbuf[pos] == '\013') {
+ 		penalty += wrongsidepenalty;
+ 		pos++;
+ 	    }
+ 	    penalty -= earlybreakpenalty*(flags & TB_BRKCOUNT);
+ 	    /* the following test is not quite right, but it's not too bad. */
+ 	    if (breakindent[numbreaks-2] == breakindent[numbreaks-1] &&
+ 		breakparen[numbreaks-2] != breakparen[numbreaks-1])
+ 		penalty += sameindentpenalty;
+ #if 0
+ 	    else if (ch == '\002' && parens &&  /*don't think this is needed*/
+ 		     parens->indent == breakindent[numbreaks-1] &&
+ 		     parens->pos != breakparen[numbreaks-1])
+ 		penalty += sameindentpenalty + 0.001;   /***/
+ #endif
+ 	    penalty += (breakindent[numbreaks-1] - thisindent) *
+ 		       indentamountpenalty;
+ 	    if (penalty < 1) penalty = 1;
+ 	    pos2 = pos;
+ 	    while (pos2 < outbufpos && outbuf[pos2] == ' ')
+ 		pos2++;
+ 	    flags |= TB_ALREADYBRK;
+ 	    j = trybreakline(pos2, count, indent, badness + penalty,
+ 			     flags, parens) & jmask;
+ 	    numbreaks--;
+ 	    return j;
+ 	    
+ 	  case '\015':    /* "hang-indent operator" */
+ 	    if (count <= breakcount[numbreaks-1] + 2 &&
+ 		!(flags & TB_EXTRAIND2)) {
+ 		breakindent[numbreaks-1] -= count - breakcount[numbreaks-1];
+ 		pos2 = pos;
+ 		while (pos2 < outbufpos && outbuf[pos2] <= ' ') {
+ 		    if (outbuf[pos2] == ' ')
+ 			breakindent[numbreaks-1]--;
+ 		    pos2++;
+ 		}
+ 	    }
+ 	    break;
+ 
+ 	  case '"':
+ 	  case '\'':
+ 	    closing = ch;
+ 	    while (pos < outbufpos && outbuf[pos] != closing) {
+ 		if (outbuf[pos] == '\\')
+ 		    pos++, count++;
+ 		pos++;
+ 		count++;
+ 	    }
+ 	    if (pos >= outbufpos) {
+ 		intwarning("output", "Mismatched quotes [248]");
+ 		continue;
+ 	    }
+ 	    pos++;
+ 	    count++;
+ 	    break;
+ 
+ 	  case '/':
+ 	    if (pos < outbufpos && (outbuf[pos] == '*' ||
+ 				    (outbuf[pos] == '/' && cplus > 0))) {
+ 		count += measurechars(pos, outbufpos-1);
+ 		pos = outbufpos;   /* assume comment is at end of line */
+ 	    }
+ 	    break;
+ 
+ 	}
+     }
+     numalts++;
+     badness += extra;
+     if (testinglinebreaker > 1) {
+ 	if (badness >= bestbadness &&
+ 	    (badness < showbadlimit || showbadlimit == 0)) {
+ 	    fprintf(outf, "\n#if 0   /* rejected #%ld, badness = %g >= %g */\n", numalts, badness, bestbadness);
+ 	    flush_outbuf(numbreaks, breakpos, breakindent,
+ 			 numedits, editpos, editold, editnew);
+ 	    fprintf(outf, "#endif\n");
+ 	    return TBR_SIMPLE & jmask;
+ 	} else if ((bestbadness < showbadlimit || showbadlimit == 0) &&
+ 		   bestnumalts > 0) {
+ 	    fprintf(outf, "\n#if 0   /* rejected #%ld, badness = %g > %g */\n", bestnumalts, bestbadness, badness);
+ 	    flush_outbuf(bestnumbreaks, bestbreakpos, bestbreakindent,
+ 			 bestnumedits, besteditpos,
+ 			 besteditold, besteditnew);
+ 	    fprintf(outf, "#endif\n");
+ 	}
+     }
+     bestbadness = badness;
+     bestnumbreaks = numbreaks;
+     bestnumalts = numalts;
+     for (i = 0; i < numbreaks; i++) {
+ 	bestbreakpos[i] = breakpos[i];
+ 	bestbreakindent[i] = breakindent[i];
+     }
+     bestnumedits = numedits;
+     for (i = 0; i < numedits; i++) {
+ 	besteditpos[i] = editpos[i];
+ 	besteditold[i] = editold[i];
+ 	besteditnew[i] = editnew[i];
+     }
+     return TBR_SIMPLE & jmask;
+ }
+ 
+ 
+ 
+ 
+ int parse_breakstr(cp)
+ char *cp;
+ {
+     short val = 0;
+ 
+     if (isdigit(*cp))
+ 	return atoi(cp);
+     while (*cp && !isspace(*cp) && *cp != '}') {
+ 	switch (toupper(*cp++)) {
+ 
+ 	  case 'N':
+ 	  case '=':
+ 	    break;
+ 
+ 	  case 'L':
+ 	    val |= BRK_LEFT;
+ 	    break;
+ 
+ 	  case 'R':
+ 	    val |= BRK_RIGHT;
+ 	    break;
+ 
+ 	  case 'H':
+ 	    val |= BRK_HANG | BRK_LEFT;
+ 	    break;
+ 
+ 	  case '>':
+ 	    if (val & BRK_LEFT)
+ 		val |= BRK_LPREF;
+ 	    else if (val & BRK_RIGHT)
+ 		val |= BRK_RPREF;
+ 	    else
+ 		return -1;
+ 	    break;
+ 
+ 	  case '<':
+ 	    if (val & BRK_LEFT)
+ 		val |= BRK_RPREF;
+ 	    else if (val & BRK_RIGHT)
+ 		val |= BRK_LPREF;
+ 	    else
+ 		return -1;
+ 	    break;
+ 
+ 	  case 'A':
+ 	    val |= BRK_ALLNONE;
+ 	    break;
+ 
+ 	  default:
+ 	    return -1;
+ 
+ 	}
+     }
+     return val;
+ }
+ 
+ 
+ 
+ 
+ long getcurtime()
+ {
+ #if USETIME
+     static unsigned long starttime = 0;
+     struct timeval t;
+     struct timezone tz;
+ 
+     gettimeofday(&t, &tz);
+     if (starttime == 0)
+ 	starttime = t.tv_sec;
+     t.tv_sec -= starttime;
+     return (t.tv_sec*1000 + t.tv_usec/1000);
+ #else
+     static unsigned long starttime = 0;
+     if (!starttime) starttime = time(NULL);
+     return (time(NULL) - starttime) * 1000;
+ #endif
+ }
+ 
+ 
+ 
+ void output(msg)
+ register char *msg;
+ {
+     unsigned char ch;
+     double savelimit;
+     int i, savemaxlw, maxdp;
+     long alts;
+     long time0, time0a, time1;
+ 
+     debughook();
+     if (outputmode) {
+ 	end_source();
+ 	while ((ch = *msg++) != 0) {
+ 	    if (ch >= ' ') {
+ 		putc(ch, outf);
+ 	    } else if (ch == '\n') {
+ 		putc('\n', outf);
+ 		outf_lnum++;
+ 	    }
+ 	}
+ 	return;
+     }
+     while ((ch = *msg++) != 0) {
+ 	if (ch == '\n') {
+ 	    if (outbufpos == 0) {      /* blank line */
+ 		thisfutureindent = -1;
+ 		blanklines++;
+ 		continue;
+ 	    }
+ 	    if (sectionsize > blanklines)
+ 		blanklines = sectionsize;
+ 	    sectionsize = 0;
+ 	    if (eatblanks)
+ 		blanklines = 0;
+             while (blanklines > 0) {
+                 blanklines--;
+ 		end_source();
+                 putc('\n', outf);
+ 		outf_lnum++;
+             }
+ 	    if (thisindent + outbufcount >= linewidth && !dontbreaklines) {
+ 		numbreaks = 1;
+ 		bestnumbreaks = 0;
+ 		bestbadness = BIGBADNESS;
+ 		breakpos[0] = 0;
+ 		breakindent[0] = thisindent;
+ 		breakcount[0] = 0;
+ 		breakerrorflag = 1;
+ 		numedits = 0;
+ 		bestnumedits = 0;
+ 		savelimit = showbadlimit;
+ 		numalts = 0;
+ 		bestnumalts = 0;
+ 		savemaxlw = maxlinewidth;
+ 		time0 = time0a = getcurtime();
+ 		if (regression)
+ 		    srand(17);
+ 		if (thisindent + outbufcount > linewidth*3/2) {
+ 		    i = 0;
+ 		    maxdepth = 0;
+ 		    readparens(&i, 0);
+ 		    maxdp = maxdepth;
+ 		    for (;;) {    /* try some simple fixed methods first... */
+ 			for (i = 1; i <= 20; i++) {
+ 			    randombreaks = -1;
+ 			    trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 			}
+ 			randombreaks = -2;
+ 			trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 			for (i = 0; i <= maxdp+1; i++) {
+ 			    randombreaks = i+1;
+ 			    trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 			}
+ 			if (bestbadness == BIGBADNESS && maxlinewidth < 9999) {
+ 			    maxlinewidth = 9999;   /* no choice but to relax */
+ 			    numalts = 0;
+ 			} else
+ 			    break;
+ 		    }
+ 		    time0a = getcurtime();
+ 		}
+ 		randombreaks = 0;
+ 		trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 		if (bestbadness == BIGBADNESS && maxlinewidth < 9999) {
+ 		    numalts = 0;
+ 		    maxlinewidth = 9999;   /* no choice but to relax this */
+ 		    trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 		}
+ 		time1 = getcurtime() - time0;
+ 		alts = numalts;
+ 		if (testinglinebreaker) {
+ 		    if (savelimit < 0 && testinglinebreaker > 1) {
+ 			showbadlimit = bestbadness * (-savelimit);
+ 			numalts = 0;
+ 			bestnumalts = 0;
+ 			trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ 		    }
+ 		    fprintf(outf, "\n#if 1   /* accepted #%ld, badness = %g, tried %ld in %.3f sec */\n", bestnumalts, bestbadness, alts, time1/1000.0);
+ 		}
+ 		showbadlimit = savelimit;
+ 		maxlinewidth = savemaxlw;
+ 		flush_outbuf(bestnumbreaks, bestbreakpos, bestbreakindent,
+ 			     bestnumedits, besteditpos,
+ 			     besteditold, besteditnew);
+ 		if (((USETIME && time1 > 1000) || alts >= maxalts) &&
+ 		    !regression) {
+ 		    sprintf(outbuf, "Line breaker spent %.1f",
+ 			    (time1 + time0 - time0a) / 1000.0);
+ 		    if (time0 != time0a)
+ 			sprintf(outbuf + strlen(outbuf),
+ 				"+%.2f", (time0a - time0) / 1000.0);
+ 		    sprintf(outbuf + strlen(outbuf),
+ 			    " seconds, %ld tries on line %d [251]", alts, outf_lnum);
+ 		    note(outbuf);
+ 		} else if (verbose) {
+ 		    fprintf(logf, "%s, %d/%d: Line breaker spent %ld tries\n",
+ 			    infname, inf_lnum, outf_lnum, alts);
+ 		}
+ 		if (testinglinebreaker)
+ 		    fprintf(outf, "#endif\n\n");
+ 	    } else {
+ 		if (testinglinebreaker < 2)
+ 		    flush_outbuf(0, NULL, NULL, 0, NULL, NULL, NULL);
+ 	    }
+ 	    thisfutureindent = -1;
+ 	    outbufpos = 0;
+ 	    outbufcount = 0;
+ 	} else {
+ 	    if (outbufpos == 0) {
+ 		if (ch == ' ' && !dontbreaklines)    /* eat leading spaces */
+ 		    continue;
+ 		thisindent = applydelta(outindent, deltaindent);
+ 		deltaindent = 0;
+ 	    }
+ 	    if (outbufpos == outbufsize) {
+ 		outbufsize *= 2;
+ 		outbuf = REALLOC(outbuf, outbufsize, char);
+ 	    }
+ 	    outbuf[outbufpos++] = ch;
+ 	    if (ch >= ' ')
+ 		outbufcount++;
+ 	}
+     }
+ }
+ 
+ 
+ 
+ void out_n_spaces(n)
+ int n;
+ {
+     while (--n >= 0)
+ 	output(" ");
+ }
+ 
+ 
+ 
+ void out_spaces(spc, over, len, delta)
+ int spc, over, len, delta;
+ {
+     int n;
+ 
+     if (spc == -999)
+ 	spc = commentindent;
+     if (spc < 0) {               /* right-justify */
+ 	n = (-spc) - cur_column() - len;
+ 	if (n < minspcthresh)
+ 	    n = minspacing;
+ 	else
+ 	    over = 1000;
+     } else if (spc >= 2000) {    /* tab to multiple */
+ 	spc -= 2000;
+ 	n = (spc-1) - ((cur_column()+spc-1) % spc);
+ 	if (n < minspcthresh)
+ 	    n += spc;
+     } else if (spc >= 1000) {    /* absolute column */
+ 	spc -= 1000;
+ 	n = spc - cur_column();
+ 	if (n < minspcthresh)
+ 	    n = minspacing;
+     } else                       /* relative spacing */
+ 	n = spc;
+     if (line_start()) {
+ 	singleindent(n);
+     } else if (len > 0 && over != 1000 && cur_column() + n + len > linewidth) {
+ 	output("\n");
+ 	out_spaces(over, 1000, len, 0);
+ 	singleindent(delta);
+     } else {
+ 	out_n_spaces(n);
+     }
+ }
+ 
+ 
+ 
+ 
+ void testlinebreaker(lev, fn)
+ int lev;
+ char *fn;
+ {
+     char buf[256], *bp, *cp;
+     int first, indent;
+ 
+     testinglinebreaker = lev;
+     if (!fn)
+ 	return;
+     inf = fopen(fn, "r");
+     if (!inf) {
+ 	perror(fn);
+ 	exit(1);
+     }
+     sprintf(buf, "%s.br", fn);
+     outf = fopen(buf, "w");
+     if (!outf) {
+ 	perror(buf);
+ 	exit(1);
+     }
+     setup_out();
+     outindent = 4;
+     first = 1;
+     while (fgets(buf, 256, inf)) {
+ 	cp = buf + strlen(buf) - 2;
+ 	if (cp >= buf) {
+ 	    bp = buf;
+ 	    indent = 0;
+ 	    while (isspace(*bp))
+ 		if (*bp++ == '\t')
+ 		    indent += 8;
+ 		else
+ 		    indent++;
+ 	    if (first) {
+ 		first = 0;
+ 		outindent = indent;
+ 	    }
+ 	    if (!(*cp == '{' ||
+ 		  *cp == ')' ||
+ 		  *cp == ';') ||
+ 		  (*cp == '/' && cp[-1] == '*')) {
+ 		cp[1] = '\001';   /* eat the \n */
+ 	    } else {
+ 		first = 1;
+ 	    }
+ 	    output(bp);
+ 	}
+     }
+     fclose(outf);
+     fclose(inf);
+ }
+ 
+ 
+ 
+ 
+ 
+ void outsection(size)
+ int size;
+ {
+     if (size > sectionsize)
+         sectionsize = size;
+ }
+ 
+ 
+ 
+ int isembedcomment(cmt)
+ Strlist *cmt;
+ {
+     int len = strlen(embedcomment);
+     return (cmt && len > 0 && !strncmp(cmt->s, embedcomment, len) &&
+ 	    (isspace(cmt->s[len]) ||
+ 	     (!cmt->s[len] && cmt->next &&
+ 	      (*cmt->next->s == '\002' || *cmt->next->s == '\003'))));
+ }
+ 
+ 
+ Strlist *outcomments(cmt)
+ Strlist *cmt;
+ {
+     char *cp;
+     int saveindent = outindent, savesingle = deltaindent, theindent;
+     int saveeat = eatcomments;
+     int i = 0;
+ 
+     if (!cmt)
+ 	return NULL;
+     if (!commentvisible(cmt)) {
+ 	setcommentkind(cmt, CMT_DONE);
+ 	return cmt->next;
+     }
+     if (*cmt->s == '\001') {
+ 	if (cmtdebug)
+ 	    output(format_sd("[]  [%s:%d]",
+ 			     CMT_NAMES[getcommentkind(cmt)],
+ 			     cmt->value & CMT_MASK));
+ 	for (cp = cmt->s; *cp; cp++) {
+ 	    output("\n");
+ 	    if (cmtdebug && cp[1])
+ 		output("[]");
+ 	}
+ 	setcommentkind(cmt, CMT_DONE);
+ 	return cmt->next;
+     }
+     dontbreaklines++;
+     if (isembedcomment(cmt)) {
+ 	embeddedcode = 1;
+ 	eatcomments = 0;
+ 	if (!strcmp(cmt->s, embedcomment)) {
+ 	    cmt = cmt->next;
+ 	    theindent = 0;
+ 	    cp = cmt/*->next*/->s + 1;
+ 	    while (*cp++ == ' ')
+ 		theindent++;
+ 	} else {
+ 	    strcpy(cmt->s, cmt->s + strlen(embedcomment) + 1);
+ 	    moreindent(deltaindent);
+ 	    theindent = outindent;
+ 	    deltaindent = 0;
+ 	}
+     } else {
+ 	moreindent(deltaindent);
+ 	if (cmt->s[0] == '\004')
+ 	    outindent = 0;
+ 	theindent = outindent;
+ 	deltaindent = 0;
+ 	output("/*");
+     }
+     cp = cmt->s;
+     for (;;) {
+ 	if (*cp == '\002')
+ 	    cp++;
+ 	else if (*cp == '\003' || *cp == '\004') {
+ 	    outindent = 0;
+ 	    cp++;
+ 	}
+ 	if (embeddedcode) {
+ 	    for (i = 0; *cp == ' ' && i < theindent; i++)
+ 		cp++;
+ 	    i = *cp;
+ 	    if (*cp == '#')
+ 		outindent = 0;
+ 	}
+ 	output(cp);
+ 	if (cmtdebug)
+ 	    output(format_sd(" [%s:%d] ",
+ 			     CMT_NAMES[getcommentkind(cmt)],
+ 			     cmt->value & CMT_MASK));
+ 	setcommentkind(cmt, CMT_DONE);
+ 	cmt = cmt->next;
+ 	if (!cmt || !commentvisible(cmt))
+ 	    break;
+ 	cp = cmt->s;
+ 	if (*cp != '\002' && *cp != '\003')
+ 	    break;
+ 	output("\n");
+ 	if (!embeddedcode) {
+ 	    outindent = (*cp == '\002') ? theindent : 0;
+ 	    deltaindent = 0;
+ 	}
+     }
+     if (embeddedcode) {
+ 	embeddedcode = 0;
+ 	if (i) {   /* eat final blank line */
+ 	    output("\n");
+ 	}
+     } else {
+ 	output("*/\n");
+     }
+     outindent = saveindent;
+     deltaindent = savesingle;
+     dontbreaklines--;
+     eatcomments = saveeat;
+     return cmt;
+ }
+ 
+ 
+ 
+ void outcomment(cmt)
+ Strlist *cmt;
+ {
+     Strlist *savenext;
+     
+     if (cmt) {
+ 	savenext = cmt->next;
+ 	cmt->next = NULL;
+ 	outcomments(cmt);
+ 	cmt->next = savenext;
+     }
+ }
+ 
+ 
+ 
+ void outtrailcomment(cmt, serial, indent)
+ Strlist *cmt;
+ int serial, indent;
+ {
+     int savedelta = deltaindent;
+ 
+ #if 0
+     suppressnewline = 1;
+     output("\n");
+     suppressnewline = 0;
+ #endif
+     cmt = findcomment(cmt, CMT_TRAIL, serial);
+     if (commentvisible(cmt)) {
+ 	out_spaces(indent, commentoverindent, commentlen(cmt), 0);
+ 	outcomment(cmt);
+ 	deltaindent = savedelta;
+     } else
+ 	output("\n");
+ }
+ 
+ 
+ 
+ void flushcomments(cmt, kind, serial)
+ Strlist **cmt;
+ int kind, serial;
+ {
+     Strlist *cmt2, *cmt3;
+     int saveindent, savesingle, saveeat;
+ 
+     if (!cmt)
+ 	cmt = &curcomments;
+     cmt2 = extractcomment(cmt, kind, serial);
+     saveindent = outindent;
+     savesingle = deltaindent;
+     moreindent(deltaindent);
+     deltaindent = 0;
+     saveeat = eatcomments;
+     if (eatcomments == 2)
+ 	eatcomments = 0;
+     cmt3 = cmt2;
+     while (cmt3)
+ 	cmt3 = outcomments(cmt3);
+     eatcomments = saveeat;
+     outindent = saveindent;
+     deltaindent = savesingle;
+     strlist_empty(&cmt2);
+ }
+ 
+ 
+ 
+ 
+ 
+ char *rawCstring(fmt, s, len, special)
+ char *fmt;
+ register char *s;
+ int len, special;
+ {
+     char buf[500];
+     register char *cp;
+     register unsigned char ch;
+ 
+     cp = buf;
+     while (--len >= 0) {
+         ch = *((unsigned char *) s);
+         s++;
+         if (ch == 0 && (len == 0 || !isdigit(*s))) {
+             *cp++ = '\\';
+             *cp++ = '0';
+         } else if (ch == '\n') {
+             *cp++ = '\\';
+             *cp++ = 'n';
+         } else if (ch == '\b') {
+             *cp++ = '\\';
+             *cp++ = 'b';
+         } else if (ch == '\t') {
+             *cp++ = '\\';
+             *cp++ = 't';
+         } else if (ch == '\f') {
+             *cp++ = '\\';
+             *cp++ = 'f';
+ #if 0
+         } else if (ch == '\r') {
+             *cp++ = '\\';
+             *cp++ = 'r';
+ #endif
+         } else if (ch < ' ' || ch >= 127) {
+             *cp++ = '\\';
+             *cp++ = '0' + (ch>>6);
+             *cp++ = '0' + ((ch>>3) & 7);
+             *cp++ = '0' + (ch & 7);
+         } else if (ch == special) {
+             switch (ch) {
+                 case '%':
+                     *cp++ = ch;
+                     *cp++ = ch;
+                     break;
+             }
+         } else {
+             if (ch == '"' || ch == '\\')
+                 *cp++ = '\\';
+             *cp++ = ch;
+         }
+     }
+     *cp = 0;
+     return format_s(fmt, buf);
+ }
+ 
+ 
+ char *makeCstring(s, len)
+ register char *s;
+ int len;
+ {
+     return rawCstring("\"%s\"", s, len, 0);
+ }
+ 
+ 
+ 
+ char *makeCchar(ich)
+ int ich;
+ {
+     char buf[500];
+     register char *cp;
+     register unsigned char ch = (ich & 0xff);
+ 
+     if (ich < 0 || ich > 255 || (ich == 0 && !nullcharconst))
+         return format_d("%d", ich);
+     cp = buf;
+     if (ch == 0) {
+         *cp++ = '\\';
+         *cp++ = '0';
+     } else if (ch == '\n') {
+         *cp++ = '\\';
+         *cp++ = 'n';
+     } else if (ch == '\b') {
+         *cp++ = '\\';
+         *cp++ = 'b';
+     } else if (ch == '\t') {
+         *cp++ = '\\';
+         *cp++ = 't';
+     } else if (ch == '\f') {
+         *cp++ = '\\';
+         *cp++ = 'f';
+ #if 0
+     } else if (ch == '\r') {
+         *cp++ = '\\';
+         *cp++ = 'r';
+ #endif
+     } else if (ch < ' ' || ch >= 127) {
+         *cp++ = '\\';
+         *cp++ = '0' + (ch>>6);
+         *cp++ = '0' + ((ch>>3) & 7);
+         *cp++ = '0' + (ch & 7);
+     } else {
+         if (ch == '\'' || ch == '\\')
+             *cp++ = '\\';
+         *cp++ = ch;
+     }
+     *cp = 0;
+     return format_s("'%s'", buf);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,511 ----
+ #ifndef P2C_H
+ #define P2C_H
+ 
+ 
+ /* Header file for code generated by "p2c", the Pascal-to-C translator */
+ 
+ /* "p2c"  Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+  * By Dave Gillespie, daveg at csvax.cs.caltech.edu.  Version 1.20.
+  * This file may be copied, modified, etc. in any way.  It is not restricted
+  * by the licence agreement accompanying p2c itself.
+  */
+ 
+ 
+ #include <stdio.h>
+ 
+ 
+ 
+ /* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
+    or -DBSD=1 for BSD systems. */
+ 
+ #ifdef M_XENIX
+ # define BSD 0
+ #endif
+ 
+ #ifdef vms
+ # define BSD 0
+ # ifndef __STDC__
+ #  define __STDC__ 1
+ # endif
+ #endif
+ 
+ #ifdef __TURBOC__
+ # define MSDOS 1
+ #endif
+ 
+ #ifdef MSDOS
+ # define BSD 0
+ #endif
+ 
+ #ifdef FILE       /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
+ # ifndef BSD	  /*  (a convenient, but horrible kludge!) */
+ #  define BSD 1
+ # endif
+ #endif
+ 
+ #ifdef BSD
+ # if !BSD
+ #  undef BSD
+ # endif
+ #endif
+ 
+ 
+ #if (defined(__STDC__) && !defined(M_XENIX)) || defined(__TURBOC__)
+ /*# include <stddef.h>*/
+ # include <stdlib.h>
+ # define HAS_STDLIB
+ # if defined(vms) || defined(__TURBOC__)
+ #  define __ID__(a)a
+ # endif
+ #else
+ # ifndef BSD
+ #  ifndef __TURBOC__
+ #   include <memory.h>
+ #  endif
+ # endif
+ # ifdef hpux
+ #  ifdef _INCLUDE__STDC__
+ #   include <stddef.h>
+ #   include <stdlib.h>
+ #  endif
+ # endif
+ # include <sys/types.h>
+ # if !defined(MSDOS) || defined(__TURBOC__)
+ #  define __ID__(a)a
+ # endif
+ #endif
+ 
+ #ifdef __ID__
+ # define __CAT__(a,b)__ID__(a)b
+ #else
+ # define __CAT__(a,b)a##b
+ #endif
+ 
+ 
+ #ifdef BSD
+ # include <strings.h>
+ # define memcpy(a,b,n) (bcopy(b,a,n),a)
+ # define memcmp(a,b,n) bcmp(a,b,n)
+ # define strchr(s,c) index(s,c)
+ # define strrchr(s,c) rindex(s,c)
+ #else
+ # include <string.h>
+ #endif
+ 
+ #include <ctype.h>
+ #include <math.h>
+ #include <setjmp.h>
+ #include <assert.h>
+ 
+ 
+ #ifndef NO_LACK
+ #ifdef vms
+ 
+ #define LACK_LABS
+ #define LACK_MEMMOVE
+ #define LACK_MEMCPY
+ 
+ #else
+ 
+ #define LACK_LABS       /* Undefine these if your library has these */
+ #define LACK_MEMMOVE
+ 
+ #endif
+ #endif
+ 
+ 
+ typedef struct __p2c_jmp_buf {
+     struct __p2c_jmp_buf *next;
+     jmp_buf jbuf;
+ } __p2c_jmp_buf;
+ 
+ 
+ /* Warning: The following will not work if setjmp is used simultaneously.
+    This also violates the ANSI restriction about using vars after longjmp,
+    but a typical implementation of longjmp will get it right anyway. */
+ 
+ #ifndef FAKE_TRY
+ # define TRY(x)         do { __p2c_jmp_buf __try_jb;  \
+ 			     __try_jb.next = __top_jb;  \
+ 			     if (!setjmp((__top_jb = &__try_jb)->jbuf)) {
+ # define RECOVER(x)	__top_jb = __try_jb.next; } else {
+ # define RECOVER2(x,L)  __top_jb = __try_jb.next; } else {  \
+ 			     if (0) { L: __top_jb = __try_jb.next; }
+ # define ENDTRY(x)      } } while (0) 
+ #else
+ # define TRY(x)         if (1) {
+ # define RECOVER(x)     } else do {
+ # define RECOVER2(x,L)  } else do { L: ;
+ # define ENDTRY(x)      } while (0)
+ #endif
+ 
+ 
+ 
+ #ifdef M_XENIX  /* avoid compiler bug */
+ # define SHORT_MAX  (32767)
+ # define SHORT_MIN  (-32768)
+ #endif
+ 
+ 
+ /* The following definitions work only on twos-complement machines */
+ #ifndef SHORT_MAX
+ # define SHORT_MAX  ((short)(((unsigned short) -1) >> 1))
+ # define SHORT_MIN  (~SHORT_MAX)
+ #endif
+ 
+ #ifndef INT_MAX
+ # define INT_MAX    ((int)(((unsigned int) -1) >> 1))
+ # define INT_MIN    (~INT_MAX)
+ #endif
+ 
+ #ifndef LONG_MAX
+ # define LONG_MAX   ((long)(((unsigned long) -1) >> 1))
+ # define LONG_MIN   (~LONG_MAX)
+ #endif
+ 
+ #ifndef SEEK_SET
+ # define SEEK_SET   0
+ # define SEEK_CUR   1
+ # define SEEK_END   2
+ #endif
+ 
+ #ifndef EXIT_SUCCESS
+ # ifdef vms
+ #  define EXIT_SUCCESS  1
+ #  define EXIT_FAILURE  (02000000000L)
+ # else
+ #  define EXIT_SUCCESS  0
+ #  define EXIT_FAILURE  1
+ # endif
+ #endif
+ 
+ 
+ #define SETBITS  32
+ 
+ 
+ #if defined(__STDC__) || defined(__TURBOC__)
+ # if !defined(vms) && !defined(M_LINT)
+ #  define Signed    signed
+ # else
+ #  define Signed
+ # endif
+ # define Void       void      /* Void f() = procedure */
+ # ifndef Const
+ #  define Const     const
+ # endif
+ # ifndef Volatile
+ # define Volatile   volatile
+ # endif
+ # ifdef M_LINT
+ #  define PP(x)     ()
+ #  define PV()	    ()
+ typedef char *Anyptr;
+ # else
+ #  define PP(x)     x         /* function prototype */
+ #  define PV()      (void)    /* null function prototype */
+ typedef void *Anyptr;
+ # endif
+ #else
+ # define Signed
+ # define Void       void
+ # ifndef Const
+ #  define Const
+ # endif
+ # ifndef Volatile
+ #  define Volatile
+ # endif
+ # define PP(x)      ()
+ # define PV()       ()
+ typedef char *Anyptr;
+ #endif
+ 
+ #ifdef __GNUC__
+ # define Inline     inline
+ #else
+ # define Inline
+ #endif
+ 
+ #define Register    register  /* Register variables */
+ #define Char        char      /* Characters (not bytes) */
+ 
+ #ifndef Static
+ # define Static     static    /* Private global funcs and vars */
+ #endif
+ 
+ #ifndef Local
+ # define Local      static    /* Nested functions */
+ #endif
+ 
+ typedef Signed   char schar;
+ typedef unsigned char uchar;
+ typedef unsigned char boolean;
+ 
+ #ifndef true
+ # define true    1
+ # define false   0
+ #endif
+ 
+ #ifndef TRUE
+ # define TRUE    1
+ # define FALSE   0
+ #endif
+ 
+ 
+ typedef struct {
+     Anyptr proc, link;
+ } _PROCEDURE;
+ 
+ #ifndef _FNSIZE
+ # define _FNSIZE  120
+ #endif
+ 
+ 
+ extern Void    PASCAL_MAIN  PP( (int, Char **) );
+ extern Char    **P_argv;
+ extern int     P_argc;
+ extern short   P_escapecode;
+ extern int     P_ioresult;
+ extern __p2c_jmp_buf *__top_jb;
+ 
+ 
+ #ifdef P2C_H_PROTO   /* if you have Ansi C but non-prototyped header files */
+ extern Char    *strcat      PP( (Char *, Const Char *) );
+ extern Char    *strchr      PP( (Const Char *, int) );
+ extern int      strcmp      PP( (Const Char *, Const Char *) );
+ extern Char    *strcpy      PP( (Char *, Const Char *) );
+ extern size_t   strlen      PP( (Const Char *) );
+ extern Char    *strncat     PP( (Char *, Const Char *, size_t) );
+ extern int      strncmp     PP( (Const Char *, Const Char *, size_t) );
+ extern Char    *strncpy     PP( (Char *, Const Char *, size_t) );
+ extern Char    *strrchr     PP( (Const Char *, int) );
+ 
+ extern Anyptr   memchr      PP( (Const Anyptr, int, size_t) );
+ extern Anyptr   memmove     PP( (Anyptr, Const Anyptr, size_t) );
+ extern Anyptr   memset      PP( (Anyptr, int, size_t) );
+ #ifndef memcpy
+ extern Anyptr   memcpy      PP( (Anyptr, Const Anyptr, size_t) );
+ extern int      memcmp      PP( (Const Anyptr, Const Anyptr, size_t) );
+ #endif
+ 
+ extern int      atoi        PP( (Const Char *) );
+ extern double   atof        PP( (Const Char *) );
+ extern long     atol        PP( (Const Char *) );
+ extern double   strtod      PP( (Const Char *, Char **) );
+ extern long     strtol      PP( (Const Char *, Char **, int) );
+ #endif /*P2C_H_PROTO*/
+ 
+ #ifndef HAS_STDLIB
+ extern Anyptr   malloc      PP( (size_t) );
+ extern Void     free        PP( (Anyptr) );
+ #endif
+ 
+ extern int      _OutMem     PV();
+ extern int      _CaseCheck  PV();
+ extern int      _NilCheck   PV();
+ extern int	_Escape     PP( (int) );
+ extern int	_EscIO      PP( (int) );
+ 
+ extern long     ipow        PP( (long, long) );
+ extern Char    *strsub      PP( (Char *, Char *, int, int) );
+ extern Char    *strltrim    PP( (Char *) );
+ extern Char    *strrtrim    PP( (Char *) );
+ extern Char    *strrpt      PP( (Char *, Char *, int) );
+ extern Char    *strpad      PP( (Char *, Char *, int, int) );
+ extern int      strpos2     PP( (Char *, Char *, int) );
+ extern long     memavail    PV();
+ extern int      P_peek      PP( (FILE *) );
+ extern int      P_eof       PP( (FILE *) );
+ extern int      P_eoln      PP( (FILE *) );
+ extern Void     P_readpaoc  PP( (FILE *, Char *, int) );
+ extern Void     P_readlnpaoc PP( (FILE *, Char *, int) );
+ extern long     P_maxpos    PP( (FILE *) );
+ extern Char    *P_trimname  PP( (Char *, int) );
+ extern long    *P_setunion  PP( (long *, long *, long *) );
+ extern long    *P_setint    PP( (long *, long *, long *) );
+ extern long    *P_setdiff   PP( (long *, long *, long *) );
+ extern long    *P_setxor    PP( (long *, long *, long *) );
+ extern int      P_inset     PP( (unsigned, long *) );
+ extern int      P_setequal  PP( (long *, long *) );
+ extern int      P_subset    PP( (long *, long *) );
+ extern long    *P_addset    PP( (long *, unsigned) );
+ extern long    *P_addsetr   PP( (long *, unsigned, unsigned) );
+ extern long    *P_remset    PP( (long *, unsigned) );
+ extern long    *P_setcpy    PP( (long *, long *) );
+ extern long    *P_expset    PP( (long *, long) );
+ extern long     P_packset   PP( (long *) );
+ extern int      P_getcmdline PP( (int, int, Char *) );
+ extern Void     TimeStamp   PP( (int *, int *, int *,
+ 				 int *, int *, int *) );
+ extern Void	P_sun_argv  PP( (char *, int, int) );
+ 
+ 
+ /* I/O error handling */
+ #define _CHKIO(cond,ior,val,def)  ((cond) ? P_ioresult=0,(val)  \
+ 					  : P_ioresult=(ior),(def))
+ #define _SETIO(cond,ior)          (P_ioresult = (cond) ? 0 : (ior))
+ 
+ /* Following defines are suitable for the HP Pascal operating system */
+ #define FileNotFound     10
+ #define FileNotOpen      13
+ #define FileWriteError   38
+ #define BadInputFormat   14
+ #define EndOfFile        30
+ 
+ #define FILENOTFOUND     10
+ #define FILENOTOPEN      13
+ #define FILEWRITEERROR   38
+ #define BADINPUTFORMAT   14
+ #define ENDOFFILE        30
+ 
+ /* Creating temporary files */
+ #if (defined(BSD) || defined(NO_TMPFILE)) && !defined(HAVE_TMPFILE)
+ # define tmpfile()  (fopen(tmpnam(NULL), "w+"))
+ #endif
+ 
+ /* File buffers */
+ #define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS);   \
+ 			   sc type __CAT__(f,_BUFFER)
+ #define FILEBUFNC(f,type)  int __CAT__(f,_BFLAGS);   \
+ 			   type __CAT__(f,_BUFFER)
+ 
+ #define RESETBUF(f,type)   (__CAT__(f,_BFLAGS) = 1)
+ #define SETUPBUF(f,type)   (__CAT__(f,_BFLAGS) = 0)
+ 
+ #define GETFBUF(f,type)    (*((__CAT__(f,_BFLAGS) == 1 &&   \
+ 			       ((__CAT__(f,_BFLAGS) = 2),   \
+ 				fread(&__CAT__(f,_BUFFER),  \
+ 				      sizeof(type),1,(f)))),\
+ 			      &__CAT__(f,_BUFFER)))
+ #define AGETFBUF(f,type)   ((__CAT__(f,_BFLAGS) == 1 &&   \
+ 			     ((__CAT__(f,_BFLAGS) = 2),   \
+ 			      fread(__CAT__(f,_BUFFER),  \
+ 				    sizeof(type),1,(f)))),\
+ 			    __CAT__(f,_BUFFER))
+ 
+ #define PUTFBUF(f,type,v)  (GETFBUF(f,type) = (v))
+ #define CPUTFBUF(f,v)      (PUTFBUF(f,char,v))
+ #define APUTFBUF(f,type,v) (memcpy(AGETFBUF(f,type), (v),  \
+ 				   sizeof(__CAT__(f,_BUFFER))))
+ 
+ #define GET(f,type)        (__CAT__(f,_BFLAGS) == 1 ?   \
+ 			    fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) :  \
+ 			    (__CAT__(f,_BFLAGS) = 1))
+ 
+ #define PUT(f,type)        (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)),  \
+ 			    (__CAT__(f,_BFLAGS) = 0))
+ #define CPUT(f)            (PUT(f,char))
+ 
+ #define BUFEOF(f)	   (__CAT__(f,_BFLAGS) != 2 && P_eof(f))
+ #define BUFFPOS(f)	   (ftell(f) - (__CAT__(f,_BFLAGS) == 2))
+ 
+ typedef struct {
+     FILE *f;
+     FILEBUFNC(f,Char);
+     Char name[_FNSIZE];
+ } _TEXT;
+ 
+ /* Memory allocation */
+ #ifdef __GCC__
+ # define Malloc(n)  (malloc(n) ?: (Anyptr)_OutMem())
+ #else
+ extern Anyptr __MallocTemp__;
+ # define Malloc(n)  ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem())
+ #endif
+ #define FreeR(p)    (free((Anyptr)(p)))    /* used if arg is an rvalue */
+ #define Free(p)     (free((Anyptr)(p)), (p)=NULL)
+ 
+ /* sign extension */
+ #define SEXT(x,n)   ((x) | -(((x) & (1L<<((n)-1))) << 1))
+ 
+ /* packed arrays */   /* BEWARE: these are untested! */
+ #define P_getbits_UB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] >>   \
+ 				       (((~(i))&((1<<(L)-(n))-1)) << (n)) &  \
+ 				       (1<<(1<<(n)))-1))
+ 
+ #define P_getbits_SB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] <<   \
+ 				       (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\
+ 					      (n)) >> (16-(1<<(n))))))
+ 
+ #define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
+ 				 (x) << (((~(i))&((1<<(L)-(n))-1)) << (n)))
+ 
+ #define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
+ 				 ((x) & (1<<(1<<(n)))-1) <<   \
+ 				 (((~(i))&((1<<(L)-(n))-1)) << (n)))
+ 
+ #define P_clrbits_B(a,i,n,L)    ((a)[(i)>>(L)-(n)] &=   \
+ 				 ~( ((1<<(1<<(n)))-1) <<   \
+ 				   (((~(i))&((1<<(L)-(n))-1)) << (n))) )
+ 
+ /* small packed arrays */
+ #define P_getbits_US(v,i,n)     ((int)((v) >> ((i)<<(n)) & (1<<(1<<(n)))-1))
+ #define P_getbits_SS(v,i,n)     ((int)((long)(v) << (SETBITS - (((i)+1) << (n))) >> (SETBITS-(1<<(n)))))
+ #define P_putbits_US(v,i,x,n)   ((v) |= (x) << ((i) << (n)))
+ #define P_putbits_SS(v,i,x,n)   ((v) |= ((x) & (1<<(1<<(n)))-1) << ((i)<<(n)))
+ #define P_clrbits_S(v,i,n)      ((v) &= ~( ((1<<(1<<(n)))-1) << ((i)<<(n)) ))
+ 
+ #define P_max(a,b)   ((a) > (b) ? (a) : (b))
+ #define P_min(a,b)   ((a) < (b) ? (a) : (b))
+ 
+ 
+ /* Fix ANSI-isms */
+ 
+ #ifdef LACK_LABS
+ # ifndef labs
+ #  define labs  my_labs
+    extern long my_labs PP( (long) );
+ # endif
+ #endif
+ 
+ #ifdef LACK_MEMMOVE
+ # ifndef memmove
+ #  define memmove  my_memmove
+    extern Anyptr my_memmove PP( (Anyptr, Const Anyptr, size_t) );
+ # endif
+ #endif
+ 
+ #ifdef LACK_MEMCPY
+ # ifndef memcpy
+ #  define memcpy  my_memcpy
+    extern Anyptr my_memcpy PP( (Anyptr, Const Anyptr, size_t) );
+ # endif
+ # ifndef memcmp
+ #  define memcmp  my_memcmp
+    extern int my_memcmp PP( (Const Anyptr, Const Anyptr, size_t) );
+ # endif
+ # ifndef memset
+ #  define memset  my_memset
+    extern Anyptr my_memset PP( (Anyptr, int, size_t) );
+ # endif
+ #endif
+ 
+ /* Fix toupper/tolower on Suns and other stupid BSD systems */
+ #ifdef toupper
+ # undef toupper
+ # undef tolower
+ # define toupper(c)   my_toupper(c)
+ # define tolower(c)   my_tolower(c)
+ #endif
+ 
+ #ifndef _toupper
+ # if 'A' == 65 && 'a' == 97
+ #  define _toupper(c)  ((c)-'a'+'A')
+ #  define _tolower(c)  ((c)-'A'+'a')
+ # else
+ #  ifdef toupper
+ #   undef toupper   /* hope these are shadowing real functions, */
+ #   undef tolower   /* because my_toupper calls _toupper! */
+ #  endif
+ #  define _toupper(c)  toupper(c)
+ #  define _tolower(c)  tolower(c)
+ # endif
+ #endif
+ 
+ 
+ #endif    /* P2C_H */
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,4380 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_PARSE_C
+ #include "trans.h"
+ 
+ 
+ 
+ Static short candeclare;
+ Static int trycount;
+ Static Strlist *includedfiles;
+ Static char echo_first;
+ Static int echo_pos;
+ 
+ 
+ 
+ void setup_parse()
+ {
+     candeclare = 0;
+     trycount = 0;
+     includedfiles = NULL;
+     echo_first = 1;
+     echo_pos = 0;
+     fixexpr_tryblock = 0;
+ }
+ 
+ 
+ 
+ void echobreak()
+ {
+     if (echo_pos > 0) {
+ 	printf("\n");
+ 	echo_pos = 0;
+ 	echo_first = 0;
+     }
+ }
+ 
+ 
+ void echoword(name, comma)
+ char *name;
+ int comma;
+ {
+     FILE *f = (outf == stdout) ? stderr : stdout;
+ 
+     if (quietmode || showprogress)
+         return;
+     if (!echo_first) {
+ 	if (comma) {
+ 	    fprintf(f, ",");
+ 	    echo_pos++;
+ 	}
+         if (echo_pos + strlen(name) > 77) {
+             fprintf(f, "\n");
+             echo_pos = 0;
+         } else {
+             fprintf(f, " ");
+             echo_pos++;
+         }
+     }
+     echo_first = 0;
+     fprintf(f, "%s", name);
+     echo_pos += strlen(name);
+     fflush(f);
+ }
+ 
+ 
+ 
+ void echoprocname(mp)
+ Meaning *mp;
+ {
+     echoword(mp->name, 1);
+ }
+ 
+ 
+ 
+ 
+ 
+ Static void forward_decl(func, isextern)
+ Meaning *func;
+ int isextern;
+ {
+     if (func->wasdeclared)
+         return;
+     if (isextern && func->constdefn && !checkvarmac(func))
+ 	return;
+     if (isextern) {
+         output("extern ");
+     } else if (func->ctx->kind == MK_FUNCTION) {
+ 	if (useAnyptrMacros)
+ 	    output("Local ");
+ 	else
+ 	    output("static ");
+     } else if ((use_static != 0 && !useAnyptrMacros) ||
+ 	       (findsymbol(func->name)->flags & NEEDSTATIC)) {
+ 	output("static ");
+     } else if (useAnyptrMacros) {
+ 	output("Static ");
+     }
+     if (func->type->basetype != tp_void || ansiC != 0) {
+         outbasetype(func->type, ODECL_FORWARD);
+         output(" ");
+     }
+     outdeclarator(func->type, func->name, ODECL_FORWARD);
+     output(";\n");
+     func->wasdeclared = 1;
+ }
+ 
+ 
+ 
+ 
+ /* Check if calling a parent procedure, whose body must */
+ /*   be declared forward */
+ 
+ void need_forward_decl(func)
+ Meaning *func;
+ {
+     Meaning *mp;
+ 
+     if (func->wasdeclared)
+         return;
+     for (mp = curctx->ctx; mp; mp = mp->ctx) {
+         if (mp == func) {
+ 	    if (func->ctx->kind == MK_FUNCTION)
+ 		func->isforward = 1;
+ 	    else
+ 		forward_decl(func, 0);
+             return;
+         }
+     }
+ }
+ 
+ 
+ 
+ 
+ void free_stmt(sp)
+ register Stmt *sp;
+ {
+     if (sp) {
+         free_stmt(sp->stm1);
+         free_stmt(sp->stm2);
+         free_stmt(sp->next);
+         freeexpr(sp->exp1);
+         freeexpr(sp->exp2);
+         freeexpr(sp->exp3);
+         FREE(sp);
+     }
+ }
+ 
+ 
+ 
+ 
+ Stmt *makestmt(kind)
+ enum stmtkind kind;
+ {
+     Stmt *sp;
+ 
+     sp = ALLOC(1, Stmt, stmts);
+     sp->kind = kind;
+     sp->next = NULL;
+     sp->stm1 = NULL;
+     sp->stm2 = NULL;
+     sp->exp1 = NULL;
+     sp->exp2 = NULL;
+     sp->exp3 = NULL;
+     sp->serial = curserial = ++serialcount;
+     return sp;
+ }
+ 
+ 
+ 
+ Stmt *makestmt_call(call)
+ Expr *call;
+ {
+     Stmt *sp = makestmt(SK_ASSIGN);
+     sp->exp1 = call;
+     return sp;
+ }
+ 
+ 
+ 
+ Stmt *makestmt_assign(lhs, rhs)
+ Expr *lhs, *rhs;
+ {
+     Stmt *sp = makestmt(SK_ASSIGN);
+     sp->exp1 = makeexpr_assign(lhs, rhs);
+     return sp;
+ }
+ 
+ 
+ 
+ Stmt *makestmt_if(cond, thn, els)
+ Expr *cond;
+ Stmt *thn, *els;
+ {
+     Stmt *sp = makestmt(SK_IF);
+     sp->exp1 = cond;
+     sp->stm1 = thn;
+     sp->stm2 = els;
+     return sp;
+ }
+ 
+ 
+ 
+ Stmt *makestmt_seq(s1, s2)
+ Stmt *s1, *s2;
+ {
+     Stmt *s1a;
+ 
+     if (!s1)
+         return s2;
+     if (!s2)
+         return s1;
+     for (s1a = s1; s1a->next; s1a = s1a->next) ;
+     s1a->next = s2;
+     return s1;
+ }
+ 
+ 
+ 
+ Stmt *copystmt(sp)
+ Stmt *sp;
+ {
+     Stmt *sp2;
+ 
+     if (sp) {
+         sp2 = makestmt(sp->kind);
+         sp2->stm1 = copystmt(sp->stm1);
+         sp2->stm2 = copystmt(sp->stm2);
+         sp2->exp1 = copyexpr(sp->exp1);
+         sp2->exp2 = copyexpr(sp->exp2);
+         sp2->exp3 = copyexpr(sp->exp3);
+         return sp2;
+     } else
+         return NULL;
+ }
+ 
+ 
+ 
+ void nukestmt(sp)
+ Stmt *sp;
+ {
+     if (sp) {
+         sp->kind = SK_ASSIGN;
+         sp->exp1 = makeexpr_long(0);
+     }
+ }
+ 
+ 
+ 
+ void splicestmt(sp, spnew)
+ Stmt *sp, *spnew;
+ {
+     Stmt *snext;
+ 
+     if (spnew) {
+ 	snext = sp->next;
+ 	*sp = *spnew;
+ 	while (sp->next)
+ 	    sp = sp->next;
+ 	sp->next = snext;
+     } else
+ 	nukestmt(sp);
+ }
+ 
+ 
+ 
+ int stmtcount(sp)
+ Stmt *sp;
+ {
+     int i = 0;
+ 
+     while (sp) {
+         i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
+         sp = sp->next;
+     }
+     return i;
+ }
+ 
+ 
+ 
+ 
+ 
+ Stmt *close_files_to_ctx(ctx)
+ Meaning *ctx;
+ {
+     Meaning *ctx2, *mp;
+     Stmt *splist = NULL, *sp;
+ 
+     ctx2 = curctx;
+     while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
+ 	for (mp = ctx2->cbase; mp; mp = mp->cnext) {
+ 	    if (mp->kind == MK_VAR &&
+ 		isfiletype(mp->type, -1) && !mp->istemporary) {
+ 		var_reference(mp);
+ 		sp = makestmt_if(makeexpr_rel(EK_NE,
+ 					      filebasename(makeexpr_var(mp)),
+ 					      makeexpr_nil()),
+ 				 makestmt_call(
+ 				     makeexpr_bicall_1("fclose", tp_void,
+ 						       filebasename(makeexpr_var(mp)))),
+ 				 NULL);
+ 		splist = makestmt_seq(splist, sp);
+ 	    }
+ 	}
+ 	ctx2 = ctx2->ctx;
+     }
+     return splist;
+ }
+ 
+ 
+ 
+ 
+ int simplewith(ex)
+ Expr *ex;
+ {
+     switch (ex->kind) {
+         case EK_VAR:
+         case EK_CONST:
+             return 1;
+         case EK_DOT:
+             return simplewith(ex->args[0]);
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ int simplefor(sp, ex)
+ Stmt *sp;
+ Expr *ex;
+ {
+     return (exprspeed(sp->exp2) <= 3 &&
+             !checkexprchanged(sp->stm1, sp->exp2) &&
+ 	    !exproccurs(sp->exp2, ex));
+ }
+ 
+ 
+ 
+ int tryfuncmacro(exp, mp)
+ Expr **exp;
+ Meaning *mp;
+ {
+     char *name;
+     Strlist *lp;
+     Expr *ex = *exp, *ex2;
+ 
+     ex2 = (mp) ? mp->constdefn : NULL;
+     if (!ex2) {
+ 	if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
+ 	    name = ex->val.s;
+ 	else if (ex->kind == EK_FUNCTION)
+ 	    name = ((Meaning *)ex->val.i)->name;
+ 	else
+ 	    return 0;
+ 	lp = strlist_cifind(funcmacros, name);
+ 	ex2 = (lp) ? (Expr *)lp->value : NULL;
+     }
+     if (ex2) {
+         *exp = replacemacargs(copyexpr(ex2), ex);
+ 	freeexpr(ex);
+         return 1;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ #define addstmt(kind)   \
+     *spp = sp = makestmt(kind),   \
+     spp = &(sp->next)
+ 
+ #define newstmt(kind)   \
+     addstmt(kind),   \
+     steal_comments(firstserial, sp->serial, sflags & SF_FIRST),   \
+     sflags &= ~SF_FIRST
+ 
+ 
+ 
+ #define SF_FUNC    0x1
+ #define SF_SAVESER 0x2
+ #define SF_FIRST   0x4
+ #define SF_IF	   0x8
+ 
+ Static Stmt *p_stmt(slist, sflags)
+ Stmt *slist;
+ int sflags;
+ {
+     Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
+     Stmt *defsp, **defsphook;
+     register Stmt *sp;
+     Stmt *sp2;
+     long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
+     int i, forfixed, offset, line1, line2, toobig, isunsafe;
+     Token savetok;
+     char *name;
+     Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
+     Type *tp;
+     Meaning *mp, *tvar, *tempmark;
+     Symbol *sym;
+     enum exprkind ekind;
+     Stmt *(*prochandler)();
+     Strlist *cmt;
+ 
+     tempmark = markstmttemps();
+ again:
+     while (findlabelsym()) {
+         newstmt(SK_LABEL);
+         sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
+         gettok();
+         wneedtok(TOK_COLON);
+     }
+     firstserial = curserial;
+     checkkeyword(TOK_TRY);
+     checkkeyword(TOK_INLINE);
+     checkkeyword(TOK_LOOP);
+     checkkeyword(TOK_RETURN);
+     if (modula2) {
+ 	if (sflags & SF_SAVESER)
+ 	    goto stmtSeq;
+     }
+     switch (curtok) {
+ 
+         case TOK_BEGIN:
+         stmtSeq:
+ 	    if (sflags & (SF_FUNC|SF_SAVESER)) {
+ 		saveserial = curserial;
+ 		cmt = grabcomment(CMT_ONBEGIN);
+ 		if (sflags & SF_FUNC)
+ 		    cmt = fixbeginendcomment(cmt);
+ 		strlist_mix(&curcomments, cmt);
+ 	    }
+ 	    i = sflags & SF_FIRST;
+             do {
+ 		if (modula2) {
+ 		    if (curtok == TOK_BEGIN || curtok == TOK_SEMI)
+ 			gettok();
+ 		    checkkeyword(TOK_ELSIF);
+ 		    if (curtok == TOK_ELSE || curtok == TOK_ELSIF)
+ 			break;
+ 		} else
+ 		    gettok();
+                 *spp = p_stmt(sbase, i);
+ 		i = 0;
+                 while (*spp)
+                     spp = &((*spp)->next);
+             } while (curtok == TOK_SEMI);
+ 	    if (sflags & (SF_FUNC|SF_SAVESER)) {
+ 		cmt = grabcomment(CMT_ONEND);
+ 		changecomments(cmt, -1, -1, -1, saveserial);
+ 		if (sflags & SF_FUNC)
+ 		    cmt = fixbeginendcomment(cmt);
+ 		strlist_mix(&curcomments, cmt);
+ 		if (sflags & SF_FUNC)
+ 		    changecomments(curcomments, -1, saveserial, -1, 10000);
+ 		curserial = saveserial;
+ 	    }
+ 	    checkkeyword(TOK_ELSIF);
+ 	    if (modula2 && (sflags & SF_IF)) {
+ 		break;
+ 	    }
+ 	    if (curtok == TOK_VBAR)
+ 		break;
+             if (!wneedtok(TOK_END))
+ 		skippasttoken(TOK_END);
+             break;
+ 
+         case TOK_CASE:
+             gettok();
+             swexpr = trueswexpr = p_ord_expr();
+             if (nosideeffects(swexpr, 1)) {
+                 tvar = NULL;
+             } else {
+                 tvar = makestmttempvar(swexpr->val.type, name_TEMP);
+                 swexpr = makeexpr_var(tvar);
+             }
+             savespp = spp;
+             newstmt(SK_CASE);
+ 	    saveserial2 = curserial;
+             sp->exp1 = trueswexpr;
+             spp2 = &sp->stm1;
+             tp = swexpr->val.type;
+             defsp = NULL;
+             defsphook = &defsp;
+             if (!wneedtok(TOK_OF)) {
+ 		skippasttoken(TOK_END);
+ 		break;
+ 	    }
+ 	    i = 1;
+ 	    while (curtok == TOK_VBAR)
+ 		gettok();
+ 	    checkkeyword(TOK_OTHERWISE);
+             while (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
+                 spp3 = spp2;
+ 		saveserial = curserial;
+                 *spp2 = sp = makestmt(SK_CASELABEL);
+ 		steal_comments(saveserial, sp->serial, i);
+                 spp2 = &sp->next;
+                 range = NULL;
+                 toobig = 0;
+                 for (;;) {
+                     ep = gentle_cast(p_expr(tp), tp);
+                     if (curtok == TOK_DOTS) {
+                         li1 = ord_value(eval_expr(ep));
+                         gettok();
+                         ep2 = gentle_cast(p_expr(tp), tp);
+                         li2 = ord_value(eval_expr(ep2));
+                         range = makeexpr_or(range,
+                                             makeexpr_range(copyexpr(swexpr),
+                                                            ep, ep2, 1));
+                         if (li2 - li1 >= caselimit)
+                             toobig = 1;
+                         if (!toobig) {
+                             for (;;) {
+                                 sp->exp1 = makeexpr_val(make_ord(tp, li1));
+                                 if (li1 >= li2) break;
+                                 li1++;
+ 				serialcount--;   /* make it reuse the count */
+                                 sp->stm1 = makestmt(SK_CASELABEL);
+                                 sp = sp->stm1;
+                             }
+                         }
+                     } else {
+                         sp->exp1 = copyexpr(ep);
+                         range = makeexpr_or(range,
+                                             makeexpr_rel(EK_EQ, 
+                                                          copyexpr(swexpr),
+                                                          ep));
+                     }
+                     if (curtok == TOK_COMMA) {
+                         gettok();
+ 			serialcount--;   /* make it reuse the count */
+                         sp->stm1 = makestmt(SK_CASELABEL);
+                         sp = sp->stm1;
+                     } else
+                         break;
+                 }
+                 wneedtok(TOK_COLON);
+                 if (toobig) {
+                     free_stmt(*spp3);
+                     spp2 = spp3;
+                     *defsphook = makestmt_if(range, p_stmt(NULL, SF_SAVESER),
+ 					     NULL);
+                     if (defsphook != &defsp && elseif != 0)
+                         (*defsphook)->exp2 = makeexpr_long(1);
+                     defsphook = &((*defsphook)->stm2);
+                 } else {
+                     freeexpr(range);
+                     sp->stm1 = p_stmt(NULL, SF_SAVESER);
+                 }
+ 		i = 0;
+ 		checkkeyword(TOK_OTHERWISE);
+                 if (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
+ 		    if (curtok == TOK_VBAR) {
+ 			while (curtok == TOK_VBAR)
+ 			    gettok();
+ 		    } else
+ 			wneedtok(TOK_SEMI);
+ 		    checkkeyword(TOK_OTHERWISE);
+ 		}
+             }
+             if (defsp) {
+                 *spp2 = defsp;
+                 spp2 = defsphook;
+                 if (tvar) {
+                     sp = makestmt_assign(makeexpr_var(tvar), trueswexpr);
+                     sp->next = *savespp;
+                     *savespp = sp;
+                     sp->next->exp1 = swexpr;
+                 }
+             } else {
+                 if (tvar) {
+                     canceltempvar(tvar);
+                     freeexpr(swexpr);
+                 }
+             }
+             if (curtok == TOK_OTHERWISE || curtok == TOK_ELSE) {
+                 gettok();
+                 while (curtok == TOK_SEMI)
+                     gettok();
+ /*		changecomments(curcomments, CMT_TRAIL, curserial,
+ 			                    CMT_POST, -1);   */
+ 		i = SF_FIRST;
+ 		while (curtok != TOK_END) {
+                     *spp2 = p_stmt(NULL, i);
+                     while (*spp2)
+                         spp2 = &((*spp2)->next);
+ 		    i = 0;
+                     if (curtok != TOK_SEMI)
+                         break;
+                     gettok();
+                 }
+                 if (!wexpecttok(TOK_END))
+ 		    skiptotoken(TOK_END);
+             } else if (casecheck == 1 || (casecheck == 2 && range_flag)) {
+                 *spp2 = makestmt(SK_CASECHECK);
+             }
+ 	    curserial = saveserial2;
+ 	    strlist_mix(&curcomments, grabcomment(CMT_ONEND));
+             gettok();
+             break;
+ 
+         case TOK_FOR:
+             forfixed = fixedflag;
+             gettok();
+             newstmt(SK_FOR);
+             ep = p_expr(tp_integer);
+             if (!wneedtok(TOK_ASSIGN)) {
+ 		skippasttoken(TOK_DO);
+ 		break;
+ 	    }
+             ep2 = makeexpr_charcast(p_expr(ep->val.type));
+             if (curtok != TOK_DOWNTO) {
+ 		if (!wexpecttok(TOK_TO)) {
+ 		    skippasttoken(TOK_DO);
+ 		    break;
+ 		}
+ 	    }
+             savetok = curtok;
+             gettok();
+             sp->exp2 = makeexpr_charcast(p_expr(ep->val.type));
+ 	    checkkeyword(TOK_BY);
+ 	    if (curtok == TOK_BY) {
+ 		gettok();
+ 		forstep = p_expr(tp_integer);
+ 		i = possiblesigns(forstep);
+ 		if ((i & 5) == 5) {
+ 		    if (expr_is_neg(forstep)) {
+ 			ekind = EK_GE;
+ 			note("Assuming FOR loop step is negative [252]");
+ 		    } else {
+ 			ekind = EK_LE;
+ 			note("Assuming FOR loop step is positive [252]");
+ 		    }
+ 		} else {
+ 		    if (!(i & 1))
+ 			ekind = EK_LE;
+ 		    else
+ 			ekind = EK_GE;
+ 		}
+ 	    } else {
+ 		if (savetok == TOK_DOWNTO) {
+ 		    ekind = EK_GE;
+ 		    forstep = makeexpr_long(-1);
+ 		} else {
+ 		    ekind = EK_LE;
+ 		    forstep = makeexpr_long(1);
+ 		}
+ 	    }
+             tvar = NULL;
+ 	    swexpr = NULL;
+             if (ep->kind == EK_VAR) {
+                 tp = findbasetype(ep->val.type, ODECL_NOPRES);
+                 if ((tp == tp_char || tp == tp_schar || tp == tp_uchar ||
+                      tp == tp_abyte || tp == tp_sbyte || tp == tp_ubyte ||
+ 		     tp == tp_boolean) &&
+                     ((checkconst(sp->exp2, 0) &&
+ 		      tp != tp_sbyte && tp != tp_schar) ||
+                      checkconst(sp->exp2, -128) ||
+                      (checkconst(sp->exp2, 127) &&
+ 		      tp != tp_ubyte && tp != tp_uchar) ||
+                      checkconst(sp->exp2, 255) ||
+                      (tp == tp_char &&
+                       (useAnyptrMacros == 1 || unsignedchar != 1) &&
+                       isliteralconst(sp->exp2, NULL) == 2 &&
+                       sp->exp2->val.i >= 128))) {
+                     swexpr = ep;
+                     tvar = makestmttempvar(tp_sshort, name_TEMP);
+                     ep = makeexpr_var(tvar);
+                 } else if (((tp == tp_sshort &&
+                              (checkconst(sp->exp2, -32768) ||
+                               checkconst(sp->exp2, 32767))) ||
+                             (tp == tp_ushort &&
+                              (checkconst(sp->exp2, 0) ||
+                               checkconst(sp->exp2, 65535))))) {
+                     swexpr = ep;
+                     tvar = makestmttempvar(tp_integer, name_TEMP);
+                     ep = makeexpr_var(tvar);
+                 } else if (tp == tp_integer &&
+ 			   (checkconst(sp->exp2, LONG_MAX) ||
+ 			    (sp->exp2->kind == EK_VAR &&
+ 			     sp->exp2->val.i == (long)mp_maxint))) {
+                     swexpr = ep;
+                     tvar = makestmttempvar(tp_unsigned, name_TEMP);
+                     ep = makeexpr_var(tvar);
+                 }
+             }
+ 	    sp->exp3 = makeexpr_assign(copyexpr(ep),
+ 				       makeexpr_inc(copyexpr(ep),
+ 						    copyexpr(forstep)));
+             wneedtok(TOK_DO);
+             forfixed = (fixedflag != forfixed);
+             mp = makestmttempvar(ep->val.type, name_FOR);
+             sp->stm1 = p_stmt(NULL, SF_SAVESER);
+             if (tvar) {
+                 if (checkexprchanged(sp->stm1, swexpr))
+                     note(format_s("Rewritten FOR loop won't work if it meddles with %s [253]",
+                                   ((Meaning *)swexpr->val.i)->name));
+                 sp->stm1 = makestmt_seq(makestmt_assign(swexpr, makeexpr_var(tvar)),
+                                         sp->stm1);
+             } else if (offsetforloops && ep->kind == EK_VAR) {
+ 		offset = checkvaroffset(sp->stm1, (Meaning *)ep->val.i);
+ 		if (offset != 0) {
+ 		    ep3 = makeexpr_inc(copyexpr(ep), makeexpr_long(-offset));
+ 		    replaceexpr(sp->stm1, ep, ep3);
+ 		    freeexpr(ep3);
+ 		    ep2 = makeexpr_plus(ep2, makeexpr_long(offset));
+ 		    sp->exp2 = makeexpr_inc(sp->exp2, makeexpr_long(offset));
+ 		}
+ 	    }
+             if (!exprsame(ep, ep2, 1))
+                 sp->exp1 = makeexpr_assign(copyexpr(ep), copyexpr(ep2));
+ 	    isunsafe = ((!nodependencies(ep2, 2) &&
+ 			 !nosideeffects(sp->exp2, 1)) ||
+ 			(!nodependencies(sp->exp2, 2) &&
+ 			 !nosideeffects(ep2, 1)));
+             if (forfixed || (simplefor(sp, ep) && !isunsafe)) {
+                 canceltempvar(mp);
+                 sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
+             } else {
+ 		ep3 = makeexpr_neg(copyexpr(forstep));
+ 		if ((checkconst(forstep, 1) || checkconst(forstep, -1)) &&
+ 		    sp->exp2->kind == EK_PLUS &&
+ 		    exprsame(sp->exp2->args[sp->exp2->nargs-1], ep3, 2)) {
+ 		    sp->exp2 = makeexpr_inc(sp->exp2, forstep);
+ 		} else {
+ 		    freeexpr(forstep);
+ 		    freeexpr(ep3);
+ 		    ep3 = makeexpr_long(0);
+ 		}
+ 		if (forevalorder && isunsafe) {
+ 		    if (exprdepends(sp->exp2, ep)) {
+ 			tvar = makestmttempvar(mp->type, name_TEMP);
+ 			sp->exp1 = makeexpr_comma(
+ 				     makeexpr_comma(
+ 				       makeexpr_assign(makeexpr_var(tvar),
+ 						       copyexpr(ep2)),
+ 				       makeexpr_assign(makeexpr_var(mp),
+ 						       sp->exp2)),
+ 				     makeexpr_assign(copyexpr(ep),
+ 						     makeexpr_var(tvar)));
+ 		    } else
+ 			sp->exp1 = makeexpr_comma(
+ 				     sp->exp1,
+ 				     makeexpr_assign(makeexpr_var(mp),
+ 						     sp->exp2));
+ 		} else {
+ 		    if (isunsafe)
+ 			note("Evaluating FOR loop limit before initial value [315]");
+ 		    sp->exp1 = makeexpr_comma(
+ 			         makeexpr_assign(makeexpr_var(mp),
+ 						 sp->exp2),
+ 			         sp->exp1);
+ 		}
+ 		sp->exp2 = makeexpr_inc(makeexpr_var(mp), ep3);
+                 sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
+             }
+ 	    freeexpr(ep2);
+             break;
+ 
+         case TOK_GOTO:
+             gettok();
+             if (findlabelsym()) {
+                 if (curtokmeaning->ctx != curctx) {
+ 		    curtokmeaning->val.i = 1;
+ 		    *spp = close_files_to_ctx(curtokmeaning->ctx);
+ 		    while (*spp)
+ 			spp = &((*spp)->next);
+ 		    newstmt(SK_ASSIGN);
+ 		    var_reference(curtokmeaning->xnext);
+ 		    if (curtokmeaning->ctx->kind == MK_MODULE &&
+ 			!curtokmeaning->xnext->wasdeclared) {
+ 			outsection(minorspace);
+ 			declarevar(curtokmeaning->xnext, 0x7);
+ 			curtokmeaning->xnext->wasdeclared = 1;
+ 			outsection(minorspace);
+ 		    }
+ 		    sp->exp1 = makeexpr_bicall_2("longjmp", tp_void,
+ 						 makeexpr_var(curtokmeaning->xnext),
+ 						 makeexpr_long(1));
+ 		} else {
+ 		    newstmt(SK_GOTO);
+ 		    sp->exp1 = makeexpr_name(format_s(name_LABEL,
+ 						      curtokmeaning->name),
+ 					     tp_integer);
+ 		}
+             } else {
+                 warning("Expected a label [263]");
+ 	    }
+ 	    gettok();
+             break;
+ 
+         case TOK_IF:
+             gettok();
+             newstmt(SK_IF);
+ 	    saveserial = curserial;
+ 	    curserial = ++serialcount;
+             sp->exp1 = p_expr(tp_boolean);
+             wneedtok(TOK_THEN);
+             sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ 	    changecomments(curcomments, -1, saveserial+1, -1, saveserial);
+ 	    checkkeyword(TOK_ELSIF);
+ 	    while (curtok == TOK_ELSIF) {
+ 		gettok();
+ 		sp->stm2 = makestmt(SK_IF);
+ 		sp = sp->stm2;
+ 		sp->exp1 = p_expr(tp_boolean);
+ 		wneedtok(TOK_THEN);
+ 		sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ 		sp->exp2 = makeexpr_long(1);
+ 	    }
+ 	    if (curtok == TOK_ELSE) {
+                 line1 = inf_lnum;
+ 		strlist_mix(&curcomments, grabcomment(CMT_ONELSE));
+                 gettok();
+                 line2 = (curtok == TOK_IF) ? inf_lnum : -1;
+ 		saveserial2 = curserial;
+                 sp->stm2 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ 		changecomments(curcomments, -1, saveserial2, -1, saveserial+1);
+                 if (sp->stm2 && sp->stm2->kind == SK_IF &&
+ 		    !sp->stm2->next && !modula2) {
+                     sp->stm2->exp2 = makeexpr_long(elseif > 0 ||
+                                                    (elseif < 0 && line1 == line2));
+                 }
+             }
+ 	    if (modula2)
+ 		wneedtok(TOK_END);
+ 	    curserial = saveserial;
+             break;
+ 
+         case TOK_INLINE:
+             gettok();
+             note("Inline assembly language encountered [254]");
+             if (curtok != TOK_LPAR) {   /* Macintosh style */
+ 		newstmt(SK_ASSIGN);
+ 		sp->exp1 = makeexpr_bicall_1("inline", tp_void,
+ 					     p_expr(tp_integer));
+ 		break;
+ 	    }
+             do {
+                 name = getinlinepart();
+                 if (!*name)
+                     break;
+                 newstmt(SK_ASSIGN);
+                 sp->exp1 = makeexpr_bicall_1("asm", tp_void,
+                             makeexpr_string(format_s(" inline %s", name)));
+                 gettok();
+             } while (curtok == TOK_SLASH);
+             skipcloseparen();
+             break;
+ 
+ 	case TOK_LOOP:
+ 	    gettok();
+ 	    newstmt(SK_WHILE);
+ 	    sp->exp1 = makeexpr_long(1);
+             sp->stm1 = p_stmt(NULL, SF_SAVESER);
+ 	    break;
+ 
+         case TOK_REPEAT:
+             newstmt(SK_REPEAT);
+ 	    saveserial = curserial;
+             spp2 = &(sp->stm1);
+ 	    i = SF_FIRST;
+             do {
+                 gettok();
+                 *spp2 = p_stmt(sp->stm1, i);
+ 		i = 0;
+                 while (*spp2)
+                     spp2 = &((*spp2)->next);
+             } while (curtok == TOK_SEMI);
+             if (!wneedtok(TOK_UNTIL))
+ 		skippasttoken(TOK_UNTIL);
+             sp->exp1 = makeexpr_not(p_expr(tp_boolean));
+ 	    curserial = saveserial;
+ 	    strlist_mix(&curcomments, grabcomment(CMT_ONEND));
+             break;
+ 
+ 	case TOK_RETURN:
+ 	    gettok();
+ 	    newstmt(SK_RETURN);
+ 	    if (curctx->isfunction) {
+ 		sp->exp1 = gentle_cast(p_expr(curctx->cbase->type),
+ 				       curctx->cbase->type);
+ 	    }
+ 	    break;
+ 
+         case TOK_TRY:
+ 	    findsymbol("RECOVER")->flags &= ~KWPOSS;
+             newstmt(SK_TRY);
+             sp->exp1 = makeexpr_long(++trycount);
+             spp2 = &(sp->stm1);
+ 	    i = SF_FIRST;
+             do {
+                 gettok();
+                 *spp2 = p_stmt(sp->stm1, i);
+ 		i = 0;
+                 while (*spp2)
+                     spp2 = &((*spp2)->next);
+             } while (curtok == TOK_SEMI);
+             if (!wneedtok(TOK_RECOVER))
+ 		skippasttoken(TOK_RECOVER);
+             sp->stm2 = p_stmt(NULL, SF_SAVESER);
+             break;
+ 
+         case TOK_WHILE:
+             gettok();
+             newstmt(SK_WHILE);
+             sp->exp1 = p_expr(tp_boolean);
+             wneedtok(TOK_DO);
+             sp->stm1 = p_stmt(NULL, SF_SAVESER);
+             break;
+ 
+         case TOK_WITH:
+             gettok();
+             if (withlevel >= MAXWITHS-1)
+                 error("Too many nested WITHs");
+             ep = p_expr(NULL);
+             if (ep->val.type->kind != TK_RECORD)
+                 warning("Argument of WITH is not a RECORD [264]");
+             withlist[withlevel] = ep->val.type;
+             if (simplewith(ep)) {
+                 withexprs[withlevel] = ep;
+                 mp = NULL;
+             } else {           /* need to save a temporary pointer */
+                 tp = makepointertype(ep->val.type);
+                 mp = makestmttempvar(tp, name_WITH);
+                 withexprs[withlevel] = makeexpr_hat(makeexpr_var(mp), 0);
+             }
+             withlevel++;
+             if (curtok == TOK_COMMA) {
+                 curtok = TOK_WITH;
+                 sp2 = p_stmt(NULL, sflags & SF_FIRST);
+             } else {
+                 wneedtok(TOK_DO);
+                 sp2 = p_stmt(NULL, sflags & SF_FIRST);
+             }
+             withlevel--;
+             if (mp) {    /* if "with p^" for constant p, don't need temp ptr */
+                 if (ep->kind == EK_HAT && ep->args[0]->kind == EK_VAR &&
+                     !checkvarchanged(sp2, (Meaning *)ep->args[0]->val.i)) {
+                     replaceexpr(sp2, withexprs[withlevel]->args[0],
+                                      ep->args[0]);
+                     freeexpr(ep);
+                     canceltempvar(mp);
+                 } else {
+                     newstmt(SK_ASSIGN);
+                     sp->exp1 = makeexpr_assign(makeexpr_var(mp),
+                                                makeexpr_addr(ep));
+                 }
+             }
+             freeexpr(withexprs[withlevel]);
+             *spp = sp2;
+             while (*spp)
+                 spp = &((*spp)->next);
+             break;
+ 
+         case TOK_INCLUDE:
+             badinclude();
+             goto again;
+ 
+ 	case TOK_ADDR:   /* flakey Turbo "@procptr := anyptr" assignment */
+ 	    newstmt(SK_ASSIGN);
+ 	    ep = p_expr(tp_void);
+ 	    if (wneedtok(TOK_ASSIGN))
+ 		sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
+ 	    else
+ 		sp->exp1 = ep;
+ 	    break;
+ 
+         case TOK_IDENT:
+             mp = curtokmeaning;
+ 	    if (mp == mp_str_hp)
+ 		mp = curtokmeaning = mp_str_turbo;
+ 	    if (mp == mp_val_modula)
+ 		mp = curtokmeaning = mp_val_turbo;
+ 	    if (mp == mp_blockread_ucsd)
+ 		mp = curtokmeaning = mp_blockread_turbo;
+ 	    if (mp == mp_blockwrite_ucsd)
+ 		mp = curtokmeaning = mp_blockwrite_turbo;
+ 	    if (mp == mp_dec_dec)
+ 		mp = curtokmeaning = mp_dec_turbo;
+             if (!mp) {
+                 sym = curtoksym;     /* make a guess at what the undefined name is... */
+                 name = stralloc(curtokcase);
+                 gettok();
+                 newstmt(SK_ASSIGN);
+                 if (curtok == TOK_ASSIGN) {
+                     gettok();
+                     ep = p_expr(NULL);
+                     mp = addmeaning(sym, MK_VAR);
+                     mp->name = name;
+                     mp->type = ep->val.type;
+                     sp->exp1 = makeexpr_assign(makeexpr_var(mp), ep);
+                 } else if (curtok == TOK_HAT || curtok == TOK_ADDR ||
+                            curtok == TOK_LBR || curtok == TOK_DOT) {
+                     ep = makeexpr_name(name, tp_integer);
+                     ep = fake_dots_n_hats(ep);
+                     if (wneedtok(TOK_ASSIGN))
+ 			sp->exp1 = makeexpr_assign(ep, p_expr(NULL));
+ 		    else
+ 			sp->exp1 = ep;
+                 } else if (curtok == TOK_LPAR) {
+                     ep = makeexpr_bicall_0(name, tp_void);
+                     do {
+                         gettok();
+                         insertarg(&ep, ep->nargs, p_expr(NULL));
+                     } while (curtok == TOK_COMMA);
+                     skipcloseparen();
+                     sp->exp1 = ep;
+                 } else {
+                     sp->exp1 = makeexpr_bicall_0(name, tp_void);
+                 }
+ 		if (!tryfuncmacro(&sp->exp1, NULL))
+ 		    undefsym(sym);
+             } else if (mp->kind == MK_FUNCTION && !mp->isfunction) {
+                 mp->refcount++;
+                 gettok();
+                 ep = p_funccall(mp);
+                 if (!mp->constdefn)
+                     need_forward_decl(mp);
+                 if (mp->handler && !(mp->sym->flags & LEAVEALONE) &&
+                                    !mp->constdefn) {
+                     prochandler = (Stmt *(*)())mp->handler;
+                     *spp = (*prochandler)(ep, slist);
+                     while (*spp)
+                         spp = &((*spp)->next);
+                 } else {
+                     newstmt(SK_ASSIGN);
+                     sp->exp1 = ep;
+                 }
+             } else if (mp->kind == MK_SPECIAL) {
+                 gettok();
+                 if (mp->handler && !mp->isfunction) {
+                     if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
+                         ep = makeexpr_bicall_0(mp->name, tp_void);
+                         if (curtok == TOK_LPAR) {
+                             do {
+                                 gettok();
+                                 insertarg(&ep, ep->nargs, p_expr(NULL));
+                             } while (curtok == TOK_COMMA);
+                             skipcloseparen();
+                         }
+                         newstmt(SK_ASSIGN);
+ 			tryfuncmacro(&ep, mp);
+ 			sp->exp1 = ep;
+                     } else {
+                         prochandler = (Stmt *(*)())mp->handler;
+                         *spp = (*prochandler)(mp, slist);
+                         while (*spp)
+                             spp = &((*spp)->next);
+                     }
+                 } else
+                     symclass(curtoksym);
+             } else {
+                 newstmt(SK_ASSIGN);
+                 if (curtokmeaning->kind == MK_FUNCTION &&
+ 		    peeknextchar() != '(') {
+                     mp = curctx;
+                     while (mp && mp != curtokmeaning)
+                         mp = mp->ctx;
+                     if (mp)
+                         curtokmeaning = curtokmeaning->cbase;
+                 }
+                 ep = p_expr(tp_void);
+ #if 0
+ 		if (!(ep->kind == EK_SPCALL ||
+ 		      (ep->kind == EK_COND &&
+ 		       ep->args[1]->kind == EK_SPCALL)))
+ 		    wexpecttok(TOK_ASSIGN);
+ #endif
+ 		if (curtok == TOK_ASSIGN) {
+ 		    gettok();
+ 		    if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
+ 			!curtokmeaning) {   /* VAX Pascal foolishness */
+ 			gettok();
+ 			ep2 = makeexpr_sizeof(copyexpr(ep), 0);
+ 			sp->exp1 = makeexpr_bicall_3("memset", tp_void,
+ 						     makeexpr_addr(ep),
+ 						     makeexpr_long(0), ep2);
+ 		    } else
+ 			sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
+ 		} else
+ 		    sp->exp1 = ep;
+             }
+             break;
+ 
+ 	default:
+ 	    break;    /* null statement */
+     }
+     freestmttemps(tempmark);
+     if (sflags & SF_SAVESER)
+ 	curserial = firstserial;
+     return sbase;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ #define BR_NEVER        0x1     /* never use braces */
+ #define BR_FUNCTION     0x2     /* function body */
+ #define BR_THENPART     0x4     /* before an "else" */
+ #define BR_ALWAYS       0x8     /* always use braces */
+ #define BR_REPEAT       0x10    /* "do-while" loop */
+ #define BR_TRY          0x20    /* in a recover block */
+ #define BR_ELSEPART     0x40    /* after an "else" */
+ #define BR_CASE         0x80    /* case of a switch stmt */
+ 
+ Static int usebraces(sp, opts)
+ Stmt *sp;
+ int opts;
+ {
+     if (opts & (BR_FUNCTION|BR_ALWAYS))
+         return 1;
+     if (opts & BR_NEVER)
+         return 0;
+     switch (bracesalways) {
+         case 0:
+             if (sp) {
+                 if (sp->next ||
+                     sp->kind == SK_TRY ||
+                     (sp->kind == SK_IF && !sp->stm2) ||
+                     (opts & BR_REPEAT))
+                     return 1;
+             }
+             break;
+ 
+         case 1:
+             return 1;
+ 
+         default:
+             if (sp) {
+                 if (sp->next ||
+                     sp->kind == SK_IF ||
+                     sp->kind == SK_WHILE ||
+                     sp->kind == SK_REPEAT ||
+                     sp->kind == SK_TRY ||
+ 		    sp->kind == SK_CASE ||
+                     sp->kind == SK_FOR)
+                     return 1;
+             }
+             break;
+     }
+     if (sp != NULL &&
+ 	findcomment(curcomments, CMT_NOT | CMT_TRAIL, sp->serial) != NULL)
+ 	return 1;
+     return 0;
+ }
+ 
+ 
+ 
+ #define outspnl(spflag) output((spflag) ? " " : "\n")
+ 
+ #define openbrace()                 \
+     wbraces = (!candeclare);        \
+     if (wbraces) {                  \
+         output("{");                \
+         outspnl(braceline <= 0);    \
+         candeclare = 1;             \
+     }
+ 
+ #define closebrace()                \
+     if (wbraces) {                  \
+         if (sp->next || braces)     \
+             output("}\n");          \
+         else                        \
+             braces = 1;             \
+     }
+ 
+ 
+ 
+ Meaning *outcontext;
+ 
+ Static void outnl(serial)
+ int serial;
+ {
+     outtrailcomment(curcomments, serial, commentindent);
+ }
+ 
+ 
+ Static void out_block(spbase, opts, serial)
+ Stmt *spbase;
+ int opts, serial;
+ {
+     int i, j, braces, always, trynum, istrail, hascmt;
+     int gotcomments = 0;
+     int saveindent, saveindent2, delta;
+     Stmt *sp = spbase;
+     Stmt *sp2, *sp3;
+     Meaning *ctx, *mp;
+     Strlist *curcmt, *cmt, *savecurcmt = curcomments;
+     Strlist *trailcmt, *begincmt, *endcmt;
+ 
+     if (debug>1) { fprintf(outf, "out_block of:\n"); dumpstmt(spbase,5); }
+     if (opts & BR_FUNCTION) {
+ 	if (outcontext && outcontext->comments) {
+ 	    gotcomments = 1;
+ 	    curcomments = outcontext->comments;
+ 	}
+ 	attach_comments(spbase);
+     }
+     braces = usebraces(sp, opts);
+     trailcmt = findcomment(curcomments, CMT_TRAIL, serial);
+     begincmt = findcomment(curcomments, CMT_ONBEGIN, serial);
+     istrail = 1;
+     if (!trailcmt) {
+ 	trailcmt = begincmt;
+ 	begincmt = NULL;
+ 	istrail = 0;
+     }
+     endcmt = findcomment(curcomments, CMT_ONEND, serial);
+     if ((begincmt || endcmt) && !(opts & BR_NEVER))
+ 	braces = 1;
+     if (opts & BR_ELSEPART) {
+ 	cmt = findcomment(curcomments, CMT_ONELSE, serial);
+ 	if (cmt) {
+ 	    if (trailcmt) {
+ 		out_spaces(bracecommentindent, commentoverindent,
+ 			   commentlen(cmt), 0);
+ 		output("\001");
+ 		outcomment(cmt);
+ 	    } else
+ 		trailcmt = cmt;
+ 	}
+     }
+     if (braces) {
+ 	j = (opts & BR_FUNCTION) ? funcopenindent : openbraceindent;
+         if (!line_start()) {
+ 	    if (trailcmt &&
+ 		cur_column() + commentlen(trailcmt) + 2 > linewidth &&
+ 		outindent + commentlen(trailcmt) + 2 < linewidth)  /*close enough*/
+ 		i = 0;
+ 	    else if (opts & BR_ELSEPART)
+ 		i = ((braceelseline & 2) == 0);
+ 	    else if (braceline >= 0)
+ 		i = (braceline == 0);
+ 	    else
+                 i = ((opts & BR_FUNCTION) == 0);
+ 	    if (trailcmt && begincmt) {
+ 		out_spaces(commentindent, commentoverindent,
+ 			   commentlen(trailcmt), j);
+ 		outcomment(trailcmt);
+ 		trailcmt = begincmt;
+ 		begincmt = NULL;
+ 		istrail = 0;
+ 	    } else
+ 		outspnl(i);
+         }
+ 	if (line_start())
+ 	    singleindent(j);
+         output("{");
+         candeclare = 1;
+     } else if (!sp) {
+         if (!line_start())
+             outspnl(!nullstmtline && !(opts & BR_TRY));
+ 	if (line_start())
+ 	    singleindent(tabsize);
+         output(";");
+     }
+     if (opts & BR_CASE)
+ 	delta = 0;
+     else {
+ 	delta = tabsize;
+ 	if (opts & BR_FUNCTION)
+ 	    delta = adddeltas(delta, bodyindent);
+ 	else if (braces)
+ 	    delta = adddeltas(delta, blockindent);
+     }
+     futureindent(delta);
+     if (bracecombine && braces)
+ 	i = applydelta(outindent, delta) - cur_column();
+     else
+ 	i = -1;
+     if (commentvisible(trailcmt)) {
+ 	if (line_start()) {
+ 	    singleindent(delta);
+ 	    out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
+ 	    outcomment(trailcmt);
+ 	} else /*if (commentlen(trailcmt) + cur_column() + 1 <= linewidth)*/ {
+ 	    out_spaces(istrail ? commentindent : bracecommentindent,
+ 		       commentoverindent, commentlen(trailcmt), delta);
+ 	    outcomment(trailcmt);
+ 	} /*else {
+ 	    output("\n");
+ 	    singleindent(delta);
+ 	    out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
+ 	    outcomment(trailcmt);
+ 	}*/
+ 	i = -9999;
+     }
+     if (i > 0)
+ 	out_spaces(i, 0, 0, 0);
+     else if (i != -9999)
+ 	output("\n");
+     saveindent = outindent;
+     moreindent(delta);
+     outcomment(begincmt);
+     while (sp) {
+ 	flushcomments(NULL, CMT_PRE, sp->serial);
+ 	if (cmtdebug)
+ 	    output(format_d("[%d] ", sp->serial));
+         switch (sp->kind) {
+ 
+             case SK_HEADER:
+                 ctx = (Meaning *)sp->exp1->val.i;
+ 		eatblanklines();
+                 if (declarevars(ctx, 0))
+                     outsection(minorspace);
+ 		flushcomments(NULL, CMT_NOT | CMT_ONEND, serial);
+                 if (ctx->kind == MK_MODULE) {
+                     if (ctx->anyvarflag) {
+                         output(format_s(name_MAIN, ""));
+ 			if (spacefuncs)
+ 			    output(" ");
+                         output("(argc,");
+ 			if (spacecommas)
+ 			    output(" ");
+ 			output("argv);\n");
+                     } else {
+                         output("static int _was_initialized = 0;\n");
+                         output("if (_was_initialized++)\n");
+ 			singleindent(tabsize);
+                         output("return;\n");
+                     }
+ 		    while (initialcalls) {
+ 			output(initialcalls->s);
+ 			output(";\n");
+ 			strlist_remove(&initialcalls, initialcalls->s);
+ 		    }
+                 } else {
+                     if (ctx->varstructflag && ctx->ctx->kind == MK_FUNCTION &&
+                                               ctx->ctx->varstructflag) {
+                         output(format_s(name_VARS, ctx->name));
+                         output(".");
+                         output(format_s(name_LINK, ctx->ctx->name));
+                         output(" = ");
+                         output(format_s(name_LINK, ctx->ctx->name));
+                         output(";\n");
+                     }
+ 		    for (mp = ctx->cbase; mp; mp = mp->cnext) {
+ 			if ((mp->kind == MK_VAR ||    /* these are variables with */
+ 			     mp->kind == MK_VARREF) &&
+ 			    ((mp->varstructflag &&      /* initializers which were moved */
+ 			      mp->cnext &&              /* into a varstruct, so they */
+ 			      mp->cnext->snext == mp && /* must be initialized now */
+ 			      mp->cnext->constdefn &&
+ 			      ctx->kind == MK_FUNCTION) ||
+ 			     (mp->constdefn &&
+ 			      mp->type->kind == TK_ARRAY &&
+ 			      mp->constdefn->val.type->kind == TK_STRING &&
+ 			      !initpacstrings))) {
+ 			    if (mp->type->kind == TK_ARRAY) {
+ 				output("memcpy(");
+ 				out_var(mp, 2);
+ 				output(",\002");
+ 				if (spacecommas)
+ 				    output(" ");
+ 				if (mp->constdefn) {
+ 				    output(makeCstring(mp->constdefn->val.s,
+ 						       mp->constdefn->val.i));
+ 				    mp->constdefn = NULL;
+ 				} else
+ 				    out_var(mp->cnext, 2);
+ 				output(",\002");
+ 				if (spacecommas)
+ 				    output(" ");
+ 				output("sizeof(");
+ 				out_type(mp->type, 1);
+ 				output("))");
+ 			    } else {
+ 				out_var(mp, 2);
+ 				output(" = ");
+ 				out_var(mp->cnext, 2);
+ 			    }
+ 			    output(";\n");
+ 			}
+ 		    }
+                 }
+                 break;
+ 
+             case SK_RETURN:
+                 output("return");
+ 		if (sp->exp1) {
+ 		    switch (returnparens) {
+ 			
+ 		      case 0:
+ 			output(" ");
+ 			out_expr(sp->exp1);
+ 			break;
+ 			
+ 		      case 1:
+ 			if (spaceexprs != 0)
+ 			    output(" ");
+ 			out_expr_parens(sp->exp1);
+ 			break;
+ 			
+ 		      default:
+ 			if (sp->exp1->kind == EK_VAR ||
+ 			    sp->exp1->kind == EK_CONST ||
+ 			    sp->exp1->kind == EK_LONGCONST ||
+ 			    sp->exp1->kind == EK_BICALL) {
+ 			    output(" ");
+ 			    out_expr(sp->exp1);
+ 			} else {
+ 			    if (spaceexprs != 0)
+ 				output(" ");
+ 			    out_expr_parens(sp->exp1);
+ 			}
+ 			break;
+ 		    }
+ 		}
+ 		output(";");
+ 		outnl(sp->serial);
+                 break;
+ 
+             case SK_ASSIGN:
+                 out_expr_stmt(sp->exp1);
+                 output(";");
+ 		outnl(sp->serial);
+                 break;
+ 
+             case SK_CASE:
+                 output("switch (");
+                 out_expr(sp->exp1);
+                 output(")");
+                 outspnl(braceline <= 0);
+                 output("{");
+ 		outnl(sp->serial);
+ 		saveindent2 = outindent;
+ 		moreindent(tabsize);
+ 		moreindent(switchindent);
+                 sp2 = sp->stm1;
+                 while (sp2 && sp2->kind == SK_CASELABEL) {
+                     outsection(casespacing);
+                     sp3 = sp2;
+ 		    i = 0;
+ 		    hascmt = (findcomment(curcomments, -1, sp2->serial) != NULL);
+ 		    singleindent(caseindent);
+ 		    flushcomments(NULL, CMT_PRE, sp2->serial);
+                     for (;;) {
+ 			if (i)
+ 			    singleindent(caseindent);
+ 			i = 0;
+                         output("case ");
+                         out_expr(sp3->exp1);
+                         output(":\001");
+                         sp3 = sp3->stm1;
+                         if (!sp3 || sp3->kind != SK_CASELABEL)
+                             break;
+                         if (casetabs != 1000)
+                             out_spaces(casetabs, 0, 0, 0);
+                         else {
+                             output("\n");
+ 			    i = 1;
+ 			}
+                     }
+                     if (sp3)
+                         out_block(sp3, BR_NEVER|BR_CASE, sp2->serial);
+                     else {
+ 			outnl(sp2->serial);
+ 			if (!hascmt)
+ 			    output("/* blank case */\n");
+ 		    }
+                     output("break;\n");
+ 		    flushcomments(NULL, -1, sp2->serial);
+                     sp2 = sp2->next;
+                 }
+                 if (sp2) {
+                     outsection(casespacing);
+ 		    singleindent(caseindent);
+ 		    flushcomments(NULL, CMT_PRE, sp2->serial);
+                     output("default:");
+                     out_block(sp2, BR_NEVER|BR_CASE, sp2->serial);
+                     output("break;\n");
+ 		    flushcomments(NULL, -1, sp2->serial);
+                 }
+                 outindent = saveindent2;
+                 output("}");
+ 		curcmt = findcomment(curcomments, CMT_ONEND, sp->serial);
+ 		if (curcmt)
+ 		    outcomment(curcmt);
+ 		else
+ 		    output("\n");
+                 break;
+ 
+             case SK_CASECHECK:
+ 		output(name_CASECHECK);
+                 output("();   /* CASE value range error */\n");
+                 break;
+ 
+             case SK_FOR:
+                 output("for (");
+ 		if (for_allornone)
+ 		    output("\007");
+                 if (sp->exp1 || sp->exp2 || sp->exp3 || spaceexprs > 0) {
+                     if (sp->exp1)
+                         out_expr_top(sp->exp1);
+                     else if (spaceexprs > 0)
+                         output(" ");
+                     output(";\002 ");
+                     if (sp->exp2)
+                         out_expr(sp->exp2);
+                     output(";\002 ");
+                     if (sp->exp3)
+                         out_expr_top(sp->exp3);
+                 } else {
+                     output(";;");
+                 }
+                 output(")");
+                 out_block(sp->stm1, 0, sp->serial);
+                 break;
+ 
+             case SK_LABEL:
+                 if (!line_start())
+                     output("\n");
+ 		singleindent(labelindent);
+                 out_expr(sp->exp1);
+                 output(":");
+                 if (!sp->next)
+                     output(" ;");
+                 outnl(sp->serial);
+                 break;
+ 
+             case SK_GOTO:
+                 /* what about non-local goto's? */
+                 output("goto ");
+                 out_expr(sp->exp1);
+                 output(";");
+ 		outnl(sp->serial);
+                 break;
+ 
+             case SK_IF:
+                 sp2 = sp;
+                 for (;;) {
+                     output("if (");
+                     out_expr_bool(sp2->exp1);
+                     output(")");
+                     if (sp2->stm2) {
+ 			cmt = findcomment(curcomments, CMT_ONELSE, sp->serial+1);
+                         i = (!cmt && sp2->stm2->kind == SK_IF &&
+ 			     !sp2->stm2->next &&
+ 			     ((sp2->stm2->exp2)
+ 			      ? checkconst(sp2->stm2->exp2, 1)
+ 			      : (elseif > 0)));
+ 			if (braceelse &&
+                             (usebraces(sp2->stm1, 0) ||
+                              usebraces(sp2->stm2, 0) || i))
+                             always = BR_ALWAYS;
+                         else
+                             always = 0;
+                         out_block(sp2->stm1, BR_THENPART|always, sp->serial);
+                         output("else");
+                         sp2 = sp2->stm2;
+                         if (i) {
+                             output(" ");
+                         } else {
+                             out_block(sp2, BR_ELSEPART|always, sp->serial+1);
+                             break;
+                         }
+                     } else {
+                         out_block(sp2->stm1, 0, sp->serial);
+                         break;
+                     }
+                 }
+                 break;
+ 
+             case SK_REPEAT:
+                 output("do");
+                 out_block(sp->stm1, BR_ALWAYS|BR_REPEAT, sp->serial);
+                 output("while (");
+                 out_expr_bool(sp->exp1);
+                 output(");");
+ 		cmt = findcomment(curcomments, CMT_ONEND, sp->serial);
+ 		if (commentvisible(cmt)) {
+ 		    out_spaces(commentindent, commentoverindent,
+ 			       commentlen(cmt), 0);
+ 		    output("\001");
+ 		    outcomment(cmt);
+ 		} else
+ 		    output("\n");
+                 break;
+ 
+             case SK_TRY:
+                 trynum = sp->exp1->val.i;
+                 output(format_d("TRY(try%d);", trynum));
+                 out_block(sp->stm1, BR_NEVER|BR_TRY, sp->serial);
+                 if (sp->exp2)
+                     output(format_ds("RECOVER2(try%d,%s);", trynum,
+                                      format_s(name_LABEL, format_d("try%d", trynum))));
+                 else
+                     output(format_d("RECOVER(try%d);", trynum));
+                 out_block(sp->stm2, BR_NEVER|BR_TRY, sp->serial);
+                 output(format_d("ENDTRY(try%d);\n", trynum));
+                 break;
+ 
+             case SK_WHILE:
+                 output("while (");
+                 out_expr_bool(sp->exp1);
+                 output(")");
+                 out_block(sp->stm1, 0, sp->serial);
+                 break;
+ 
+             case SK_BREAK:
+                 output("break;");
+ 		outnl(sp->serial);
+                 break;
+ 
+             case SK_CONTINUE:
+                 output("continue;");
+ 		outnl(sp->serial);
+                 break;
+ 
+ 	    default:
+ 	        intwarning("out_block",
+ 			   format_s("Misplaced statement kind %s [265]",
+ 				    stmtkindname(sp->kind)));
+ 		break;
+         }
+ 	flushcomments(NULL, -1, sp->serial);
+         candeclare = 0;
+         if (debug>1) { fprintf(outf, "in out_block:\n"); dumpstmt(spbase,5); }
+         sp = sp->next;
+     }
+     if (opts & BR_FUNCTION) {
+ 	cmt = extractcomment(&curcomments, CMT_ONEND, serial);
+ 	if (findcomment(curcomments, -1, -1) != NULL)  /* check for non-DONE */
+ 	    output("\n");
+ 	flushcomments(NULL, -1, -1);
+ 	curcomments = cmt;
+     }
+     outindent = saveindent;
+     if (braces) {
+ 	if (line_start()) {
+ 	    if (opts & BR_FUNCTION)
+ 		singleindent(funccloseindent);
+ 	    else
+ 		singleindent(closebraceindent);
+ 	}
+         output("}");
+ 	i = 1;
+ 	cmt = findcomment(curcomments, CMT_ONEND, serial);
+ 	if (!(opts & BR_REPEAT) && commentvisible(cmt)) {
+ 	    out_spaces(bracecommentindent, commentoverindent,
+ 		       commentlen(cmt), 0);
+ 	    output("\001");
+ 	    outcomment(cmt);
+ 	    i = 0;
+ 	}
+ 	if (i) {
+ 	    outspnl((opts & BR_REPEAT) ||
+ 		    ((opts & BR_THENPART) && (braceelseline & 1) == 0));
+ 	}
+         candeclare = 0;
+     }
+     if (gotcomments) {
+ 	outcontext->comments = curcomments;
+ 	curcomments = savecurcmt;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ /* Should have a way to convert GOTO's to the end of the function to RETURN's */
+ 
+ 
+ /* Convert "_RETV = foo;" at end of function to "return foo" */
+ 
+ Static int checkreturns(spp, nearret)
+ Stmt **spp;
+ int nearret;
+ {
+     Stmt *sp;
+     Expr *rvar, *ex;
+     Meaning *mp;
+     int spnearret, spnextreturn;
+     int result = 0;
+ 
+     if (debug>2) { fprintf(outf, "checkreturns on:\n"); dumpstmt(*spp, 5); }
+     while ((sp = *spp)) {
+         spnextreturn = (sp->next &&
+                         sp->next->kind == SK_RETURN && sp->next->exp1 &&
+                         isretvar(sp->next->exp1) == curctx->cbase);
+         spnearret = (nearret && !sp->next) || spnextreturn;
+         result = 0;
+         switch (sp->kind) {
+ 
+             case SK_ASSIGN:
+                 ex = sp->exp1;
+                 if (ex->kind == EK_ASSIGN || structuredfunc(ex)) {
+                     rvar = ex->args[0];
+                     mp = isretvar(rvar);
+                     if (mp == curctx->cbase && spnearret) {
+                         if (ex->kind == EK_ASSIGN) {
+                             if (mp->kind == MK_VARPARAM) {
+                                 ex = makeexpr_comma(ex, makeexpr_var(mp));
+                             } else {
+                                 ex = grabarg(ex, 1);
+                                 mp->refcount--;
+                             }
+                         }
+                         sp->exp1 = ex;
+                         sp->kind = SK_RETURN;
+                         if (spnextreturn) {
+                             mp->refcount--;
+                             sp->next = sp->next->next;
+                         }
+                         result = 1;
+                     }
+                 }
+                 break;
+ 
+             case SK_RETURN:
+             case SK_GOTO:
+                 result = 1;
+                 break;
+ 
+             case SK_IF:
+                 result = checkreturns(&sp->stm1, spnearret) &    /* NOT && */
+                          checkreturns(&sp->stm2, spnearret);
+                 break;
+ 
+             case SK_TRY:
+                 (void) checkreturns(&sp->stm1, 0);
+                 (void) checkreturns(&sp->stm2, spnearret);
+                 break;
+ 
+             /* should handle CASE statements as well */
+ 
+             default:
+                 (void) checkreturns(&sp->stm1, 0);
+                 (void) checkreturns(&sp->stm2, 0);
+                 break;
+         }
+         spp = &sp->next;
+     }
+     return result;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Replace all occurrences of one expression with another expression */
+ 
+ Expr *replaceexprexpr(ex, oldex, newex, keeptype)
+ Expr *ex, *oldex, *newex;
+ int keeptype;
+ {
+     int i;
+     Type *type;
+ 
+     for (i = 0; i < ex->nargs; i++)
+         ex->args[i] = replaceexprexpr(ex->args[i], oldex, newex, keeptype);
+     if (exprsame(ex, oldex, 2)) {
+         if (ex->val.type->kind == TK_POINTER &&
+             ex->val.type->basetype == oldex->val.type) {
+             freeexpr(ex);
+             return makeexpr_addr(copyexpr(newex));
+         } else if (oldex->val.type->kind == TK_POINTER &&
+                    oldex->val.type->basetype == ex->val.type) {
+             freeexpr(ex);
+             return makeexpr_hat(copyexpr(newex), 0);
+         } else {
+ 	    type = ex->val.type;
+             freeexpr(ex);
+             ex = copyexpr(newex);
+ 	    if (keeptype)
+ 		ex->val.type = type;
+ 	    return ex;
+         }
+     }
+     return resimplify(ex);
+ }
+ 
+ 
+ void replaceexpr(sp, oldex, newex)
+ Stmt *sp;
+ Expr *oldex, *newex;
+ {
+     while (sp) {
+         replaceexpr(sp->stm1, oldex, newex);
+         replaceexpr(sp->stm2, oldex, newex);
+         if (sp->exp1)
+             sp->exp1 = replaceexprexpr(sp->exp1, oldex, newex, 1);
+         if (sp->exp2)
+             sp->exp2 = replaceexprexpr(sp->exp2, oldex, newex, 1);
+         if (sp->exp3)
+             sp->exp3 = replaceexprexpr(sp->exp3, oldex, newex, 1);
+         sp = sp->next;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ Stmt *mixassignments(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+     if (!sp)
+         return NULL;
+     sp->next = mixassignments(sp->next, mp);
+     if (sp->next &&
+ 	 sp->kind == SK_ASSIGN &&
+          sp->exp1->kind == EK_ASSIGN &&
+          sp->exp1->args[0]->kind == EK_VAR &&
+          (!mp || mp == (Meaning *)sp->exp1->args[0]->val.i) &&
+          ord_type(sp->exp1->args[0]->val.type)->kind == TK_INTEGER &&
+          nodependencies(sp->exp1->args[1], 0) &&
+          sp->next->kind == SK_ASSIGN &&
+          sp->next->exp1->kind == EK_ASSIGN &&
+          (exprsame(sp->exp1->args[0], sp->next->exp1->args[0], 1) ||
+           (mp && mp->istemporary)) &&
+          exproccurs(sp->next->exp1->args[1], sp->exp1->args[0]) == 1) {
+         sp->next->exp1->args[1] = replaceexprexpr(sp->next->exp1->args[1],
+                                                   sp->exp1->args[0],
+                                                   sp->exp1->args[1], 1);
+         if (mp && mp->istemporary)
+             canceltempvar(mp);
+         return sp->next;
+     }
+     return sp;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Do various simple (sometimes necessary) massages on the statements */
+ 
+ 
+ Static Stmt bogusreturn = { SK_RETURN, NULL, NULL, NULL, NULL, NULL, NULL };
+ 
+ 
+ 
+ Static int isescape(ex)
+ Expr *ex;
+ {
+     if (ex->kind == EK_BICALL && (!strcmp(ex->val.s, name_ESCAPE) ||
+                                   !strcmp(ex->val.s, name_ESCIO) ||
+ 				  !strcmp(ex->val.s, name_OUTMEM) ||
+ 				  !strcmp(ex->val.s, name_CASECHECK) ||
+ 				  !strcmp(ex->val.s, name_NILCHECK) ||
+                                   !strcmp(ex->val.s, "_exit") ||
+                                   !strcmp(ex->val.s, "exit")))
+         return 1;
+     if (ex->kind == EK_CAST)
+         return isescape(ex->args[0]);
+     return 0;
+ }
+ 
+ 
+ /* check if a block can never exit by falling off the end */
+ Static int deadendblock(sp)
+ Stmt *sp;
+ {
+     if (!sp)
+         return 0;
+     while (sp->next)
+         sp = sp->next;
+     return (sp->kind == SK_GOTO ||
+             sp->kind == SK_BREAK ||
+             sp->kind == SK_CONTINUE ||
+             sp->kind == SK_RETURN ||
+             sp->kind == SK_CASECHECK ||
+             (sp->kind == SK_IF && deadendblock(sp->stm1) &&
+                                   deadendblock(sp->stm2)) ||
+             (sp->kind == SK_ASSIGN && isescape(sp->exp1)));
+ }
+ 
+ 
+ 
+ 
+ int expr_is_bool(ex, want)
+ Expr *ex;
+ int want;
+ {
+     long val;
+ 
+     if (ex->val.type == tp_boolean && isconstexpr(ex, &val))
+         return (val == want);
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ /* Returns 1 if c1 implies c2, 0 otherwise */
+ /* If not1 is true, then checks if (!c1) implies c2; similarly for not2 */
+ 
+ /* Identities used:
+         c1 -> (c2a && c2b)      <=>     (c1 -> c2a) && (c1 -> c2b)
+         c1 -> (c2a || c2b)      <=>     (c1 -> c2a) || (c1 -> c2b)
+         (c1a && c1b) -> c2      <=>     (c1a -> c2) || (c1b -> c2)
+         (c1a || c1b) -> c2      <=>     (c1a -> c2) && (c1b -> c2)
+         (!c1) -> (!c2)          <=>     c2 -> c1
+         (a == b) -> c2(b)       <=>     c2(a)
+         !(c1 && c2)             <=>     (!c1) || (!c2)
+         !(c1 || c2)             <=>     (!c1) && (!c2)
+ */
+ /* This could be smarter about, e.g., (a>5) -> (a>0) */
+ 
+ int implies(c1, c2, not1, not2)
+ Expr *c1, *c2;
+ int not1, not2;
+ {
+     Expr *ex;
+     int i;
+ 
+     if (c1->kind == EK_EQ && c1->args[0]->val.type == tp_boolean) {
+         if (checkconst(c1->args[0], 1)) {     /* things like "flag = true" */
+             return implies(c1->args[1], c2, not1, not2);
+         } else if (checkconst(c1->args[1], 1)) {
+             return implies(c1->args[0], c2, not1, not2);
+         } else if (checkconst(c1->args[0], 0)) {
+             return implies(c1->args[1], c2, !not1, not2);
+         } else if (checkconst(c1->args[1], 0)) {
+             return implies(c1->args[0], c2, !not1, not2);
+         }
+     }
+     if (c2->kind == EK_EQ && c2->args[0]->val.type == tp_boolean) {
+         if (checkconst(c2->args[0], 1)) {
+             return implies(c1, c2->args[1], not1, not2);
+         } else if (checkconst(c2->args[1], 1)) {
+             return implies(c1, c2->args[0], not1, not2);
+         } else if (checkconst(c2->args[0], 0)) {
+             return implies(c1, c2->args[1], not1, !not2);
+         } else if (checkconst(c2->args[1], 0)) {
+             return implies(c1, c2->args[0], not1, !not2);
+         }
+     }
+     switch (c2->kind) {
+ 
+         case EK_AND:
+             if (not2)               /* c1 -> (!c2a || !c2b) */
+                 return (implies(c1, c2->args[0], not1, 1) ||
+                         implies(c1, c2->args[1], not1, 1));
+             else                    /* c1 -> (c2a && c2b) */
+                 return (implies(c1, c2->args[0], not1, 0) &&
+                         implies(c1, c2->args[1], not1, 0));
+ 
+         case EK_OR:
+             if (not2)               /* c1 -> (!c2a && !c2b) */
+                 return (implies(c1, c2->args[0], not1, 1) &&
+                         implies(c1, c2->args[1], not1, 1));
+             else                    /* c1 -> (c2a || c2b) */
+                 return (implies(c1, c2->args[0], not1, 0) ||
+                         implies(c1, c2->args[1], not1, 0));
+ 
+         case EK_NOT:                /* c1 -> (!c2) */
+             return (implies(c1, c2->args[0], not1, !not2));
+ 
+         case EK_CONST:
+             if ((c2->val.i != 0) != not2)  /* c1 -> true */
+                 return 1;
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     switch (c1->kind) {
+ 
+         case EK_AND:
+             if (not1)               /* (!c1a || !c1b) -> c2 */
+                 return (implies(c1->args[0], c2, 1, not2) &&
+                         implies(c1->args[1], c2, 1, not2));
+             else                    /* (c1a && c1b) -> c2 */
+                 return (implies(c1->args[0], c2, 0, not2) ||
+                         implies(c1->args[1], c2, 0, not2));
+ 
+         case EK_OR:
+             if (not1)               /* (!c1a && !c1b) -> c2 */
+                 return (implies(c1->args[0], c2, 1, not2) ||
+                         implies(c1->args[1], c2, 1, not2));
+             else                    /* (c1a || c1b) -> c2 */
+                 return (implies(c1->args[0], c2, 0, not2) &&
+                         implies(c1->args[1], c2, 0, not2));
+ 
+         case EK_NOT:                /* (!c1) -> c2 */
+             return (implies(c1->args[0], c2, !not1, not2));
+ 
+         case EK_CONST:
+             if ((c1->val.i != 0) == not1)  /*  false -> c2 */
+                 return 1;
+             break;
+ 
+         case EK_EQ:                 /* (a=b) -> c2 */
+         case EK_ASSIGN:             /* (a:=b) -> c2 */
+         case EK_NE:                 /* (a<>b) -> c2 */
+             if ((c1->kind == EK_NE) == not1) {
+                 if (c1->args[0]->kind == EK_VAR) {
+                     ex = replaceexprexpr(copyexpr(c2), c1->args[0], c1->args[1], 1);
+                     i = expr_is_bool(ex, !not2);
+                     freeexpr(ex);
+                     if (i)
+                         return 1;
+                 }
+                 if (c1->args[1]->kind == EK_VAR) {
+                     ex = replaceexprexpr(copyexpr(c2), c1->args[1], c1->args[0], 1);
+                     i = expr_is_bool(ex, !not2);
+                     freeexpr(ex);
+                     if (i)
+                         return 1;
+                 }
+             }
+             break;
+ 
+ 	default:
+ 	    break;
+     }
+     if (not1 == not2 && exprequiv(c1, c2)) {    /* c1 -> c1 */
+         return 1;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ void infiniteloop(sp)
+ Stmt *sp;
+ {
+     switch (infloopstyle) {
+ 
+         case 1:      /* write "for (;;) ..." */
+             sp->kind = SK_FOR;
+             freeexpr(sp->exp1);
+             sp->exp1 = NULL;
+             break;
+ 
+         case 2:      /* write "while (1) ..." */
+             sp->kind = SK_WHILE;
+             freeexpr(sp->exp1);
+             sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
+             break;
+ 
+         case 3:      /* write "do ... while (1)" */
+             sp->kind = SK_REPEAT;
+             freeexpr(sp->exp1);
+             sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
+             break;
+ 
+         default:     /* leave it alone */
+             break;
+ 
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ Expr *print_func(ex)
+ Expr *ex;
+ {
+     if (!ex || ex->kind != EK_BICALL)
+ 	return NULL;
+     if ((!strcmp(ex->val.s, "printf") &&
+ 	 ex->args[0]->kind == EK_CONST) ||
+ 	!strcmp(ex->val.s, "putchar") ||
+ 	!strcmp(ex->val.s, "puts"))
+ 	return ex_output;
+     if ((!strcmp(ex->val.s, "fprintf") ||
+ 	 !strcmp(ex->val.s, "sprintf")) &&
+ 	ex->args[1]->kind == EK_CONST)
+ 	return ex->args[0];
+     if (!strcmp(ex->val.s, "putc") ||
+ 	!strcmp(ex->val.s, "fputc") ||
+ 	!strcmp(ex->val.s, "fputs"))
+ 	return ex->args[1];
+     return NULL;
+ }
+ 
+ 
+ 
+ int printnl_func(ex)
+ Expr *ex;
+ {
+     char *cp, ch;
+     int i, len;
+ 
+     if (debug>2) { fprintf(outf,"printnl_func("); dumpexpr(ex); fprintf(outf, ")\n"); }
+     if (!strcmp(ex->val.s, "printf") ||
+ 	!strcmp(ex->val.s, "puts") ||
+ 	!strcmp(ex->val.s, "fputs")) {
+ 	if (ex->args[0]->kind != EK_CONST)
+ 	    return 0;
+ 	cp = ex->args[0]->val.s;
+ 	len = ex->args[0]->val.i;
+     } else if (!strcmp(ex->val.s, "fprintf")) {
+ 	if (ex->args[1]->kind != EK_CONST)
+ 	    return 0;
+ 	cp = ex->args[1]->val.s;
+ 	len = ex->args[1]->val.i;
+     } else if (!strcmp(ex->val.s, "putchar") ||
+ 	       !strcmp(ex->val.s, "putc") ||
+ 	       !strcmp(ex->val.s, "fputc")) {
+ 	if (ex->args[0]->kind != EK_CONST)
+ 	    return 0;
+ 	ch = ex->args[0]->val.i;
+ 	cp = &ch;
+ 	len = 1;
+     } else
+ 	return 0;
+     for (i = 1; i <= len; i++)
+ 	if (*cp++ != '\n')
+ 	    return 0;
+     return len + (!strcmp(ex->val.s, "puts"));
+ }
+ 
+ 
+ 
+ Expr *chg_printf(ex)
+ Expr *ex;
+ {
+     Expr *fex;
+ 
+     if (debug>2) { fprintf(outf,"chg_printf("); dumpexpr(ex); fprintf(outf, ")\n"); }
+     if (!strcmp(ex->val.s, "putchar")) {
+ 	ex = makeexpr_sprintfify(grabarg(ex, 0));
+ 	canceltempvar(istempvar(ex->args[0]));
+ 	strchange(&ex->val.s, "printf");
+ 	delfreearg(&ex, 0);
+ 	ex->val.type = tp_void;
+     } else if (!strcmp(ex->val.s, "putc") ||
+ 	       !strcmp(ex->val.s, "fputc") ||
+ 	       !strcmp(ex->val.s, "fputs")) {
+ 	fex = copyexpr(ex->args[1]);
+ 	ex = makeexpr_sprintfify(grabarg(ex, 0));
+ 	canceltempvar(istempvar(ex->args[0]));
+ 	strchange(&ex->val.s, "fprintf");
+ 	ex->args[0] = fex;
+ 	ex->val.type = tp_void;
+     } else if (!strcmp(ex->val.s, "puts")) {
+ 	ex = makeexpr_concat(makeexpr_sprintfify(grabarg(ex, 0)),
+ 			     makeexpr_string("\n"), 1);
+ 	strchange(&ex->val.s, "printf");
+ 	delfreearg(&ex, 0);
+ 	ex->val.type = tp_void;
+     }
+     if (!strcmp(ex->val.s, "fprintf") && exprsame(ex->args[0], ex_output, 1)) {
+ 	delfreearg(&ex, 0);
+ 	strchange(&ex->val.s, "printf");
+     }
+     return ex;
+ }
+ 
+ 
+ Expr *mix_printf(ex, ex2)
+ Expr *ex, *ex2;
+ {
+     int i;
+ 
+     ex = chg_printf(ex);
+     if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex); fprintf(outf, "\n"); }
+     ex2 = chg_printf(copyexpr(ex2));
+     if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex2);fprintf(outf, "\n"); }
+     i = (!strcmp(ex->val.s, "printf")) ? 0 : 1;
+     ex->args[i] = makeexpr_concat(ex->args[i], ex2->args[i], 0);
+     for (i++; i < ex2->nargs; i++) {
+ 	insertarg(&ex, ex->nargs, ex2->args[i]);
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ void eatstmt(spp)
+ Stmt **spp;
+ {
+     Stmt *sp = *spp;
+ 
+     if (debug>2) { fprintf(outf, "eatstmt on:\n"); dumpstmt(sp, 5); }
+     *spp = sp->next;
+     sp->next = NULL;
+     free_stmt(sp);
+ }
+ 
+ 
+ 
+ int haslabels(sp)
+ Stmt *sp;
+ {
+     if (!sp)
+         return 0;
+     if (haslabels(sp->stm1) || haslabels(sp->stm2))
+         return 1;
+     return (sp->kind == SK_LABEL);
+ }
+ 
+ 
+ 
+ void fixblock(spp, thereturn)
+ Stmt **spp, *thereturn;
+ {
+     Stmt *sp, *sp1, *sp2, *sp3, **spp2, *thisreturn;
+     Expr *ex;
+     Meaning *tvar;
+     int save_tryblock;
+     short save_tryflag;
+     int i, j, de1, de2;
+     long saveserial = curserial;
+ 
+     while ((sp = *spp)) {
+         sp2 = sp->next;
+         sp->next = NULL;
+         sp = fix_statement(*spp);
+         if (!sp) {
+             *spp = sp2;
+             continue;
+         }
+         *spp = sp;
+         for (sp3 = sp; sp3->next; sp3 = sp3->next) ;
+         sp3->next = sp2;
+         if (!sp->next)
+             thisreturn = thereturn;
+         else if (sp->next->kind == SK_RETURN ||
+                  (sp->next->kind == SK_ASSIGN &&
+                   isescape(sp->next->exp1)))
+             thisreturn = sp->next;
+         else
+             thisreturn = NULL;
+ 	if (sp->serial >= 0)
+ 	    curserial = sp->serial;
+         switch (sp->kind) {
+ 
+             case SK_ASSIGN:
+ 	        if (sp->exp1)
+ 		    sp->exp1 = fixexpr(sp->exp1, ENV_STMT);
+ 		if (!sp->exp1)
+ 		    intwarning("fixblock", "sp->exp1 == NULL in SK_ASSIGN");
+                 if (!sp->exp1 || nosideeffects(sp->exp1, 1)) {
+ 		    eatstmt(spp);
+ 		    continue;
+                 } else {
+                     switch (sp->exp1->kind) {
+ 
+                         case EK_COND:
+                             *spp = makestmt_if(sp->exp1->args[0],
+                                                makestmt_call(sp->exp1->args[1]),
+                                                makestmt_call(sp->exp1->args[2]));
+                             (*spp)->next = sp->next;
+                             continue;    /* ... to fix this new if statement */
+ 
+                         case EK_ASSIGN:
+                             if (sp->exp1->args[1]->kind == EK_COND && usecommas != 1) {
+                                 *spp = makestmt_if(sp->exp1->args[1]->args[0],
+                                                    makestmt_assign(copyexpr(sp->exp1->args[0]),
+                                                                    sp->exp1->args[1]->args[1]),
+                                                    makestmt_assign(sp->exp1->args[0],
+                                                                    sp->exp1->args[1]->args[2]));
+                                 (*spp)->next = sp->next;
+                                 continue;
+                             }
+ 			    if (isescape(sp->exp1->args[1])) {
+                                 sp->exp1 = grabarg(sp->exp1, 1);
+ 				continue;
+                             }
+ 			    if (exprsame(sp->exp1->args[0], sp->exp1->args[1], 1)) {
+                               /*  *spp = sp->next;  */
+                                 sp->exp1 = grabarg(sp->exp1, 0);
+                                 continue;
+                             }
+ 			    if (sp->exp1->args[1]->kind == EK_BICALL) {
+ 				if (!strcmp(sp->exp1->args[1]->val.s,
+ 					    getfbufname) &&
+ 				    buildreads == 1 &&
+ 				    sp->next &&
+ 				    sp->next->kind == SK_ASSIGN &&
+ 				    sp->next->exp1->kind == EK_BICALL &&
+ 				    !strcmp(sp->next->exp1->val.s,
+ 					    getname) &&
+ 				    expr_has_address(sp->exp1->args[0]) &&
+ 				    similartypes(sp->exp1->args[0]->val.type,
+ 						 filebasetype(sp->exp1->args[1]->args[0]->val.type)) &&
+ 				    exprsame(sp->exp1->args[1]->args[0],
+ 					     sp->next->exp1->args[0], 1)) {
+ 				    eatstmt(&sp->next);
+ 				    ex = makeexpr_bicall_4("fread", tp_integer,
+ 							   makeexpr_addr(sp->exp1->args[0]),
+ 							   makeexpr_sizeof(sp->exp1->args[1]->args[1], 0),
+ 							   makeexpr_long(1),
+ 							   sp->exp1->args[1]->args[0]);
+ 				    FREE(sp->exp1);
+ 				    sp->exp1 = ex;
+ 				    continue;
+ 				}
+ 				if (!strcmp(sp->exp1->args[1]->val.s,
+ 					    chargetfbufname) &&
+ 				    buildreads != 0 &&
+ 				    sp->next &&
+ 				    sp->next->kind == SK_ASSIGN &&
+ 				    sp->next->exp1->kind == EK_BICALL &&
+ 				    !strcmp(sp->next->exp1->val.s,
+ 					    chargetname) &&
+ 				    expr_has_address(sp->exp1->args[0]) &&
+ 				    exprsame(sp->exp1->args[1]->args[0],
+ 					     sp->next->exp1->args[0], 1)) {
+ 				    eatstmt(&sp->next);
+ 				    strchange(&sp->exp1->args[1]->val.s,
+ 					      "getc");
+ 				    continue;
+ 				}
+ 			    }
+                             break;
+ 
+                         case EK_BICALL:
+                             if (!strcmp(sp->exp1->val.s, name_ESCAPE)) {
+                                 if (fixexpr_tryblock) {
+                                     *spp = makestmt_assign(makeexpr_var(mp_escapecode),
+                                                            grabarg(sp->exp1, 0));
+                                     (*spp)->next = makestmt(SK_GOTO);
+                                     (*spp)->next->exp1 = makeexpr_name(format_s(name_LABEL,
+                                                                                 format_d("try%d",
+                                                                                          fixexpr_tryblock)),
+                                                                        tp_integer);
+                                     (*spp)->next->next = sp->next;
+                                     fixexpr_tryflag = 1;
+                                     continue;
+                                 }
+                             } else if (!strcmp(sp->exp1->val.s, name_ESCIO)) {
+                                 if (fixexpr_tryblock) {
+                                     *spp = makestmt_assign(makeexpr_var(mp_escapecode),
+                                                            makeexpr_long(-10));
+                                     (*spp)->next = makestmt_assign(makeexpr_var(mp_ioresult),
+                                                                    grabarg(sp->exp1, 0));
+                                     (*spp)->next->next = makestmt(SK_GOTO);
+                                     (*spp)->next->next->exp1 = makeexpr_name(format_s(name_LABEL,
+                                                                                       format_d("try%d",
+                                                                                                fixexpr_tryblock)),
+                                                                              tp_integer);
+                                     (*spp)->next->next->next = sp->next;
+                                     fixexpr_tryflag = 1;
+                                     continue;
+                                 }
+                             }
+ 			    if (!strcmp(sp->exp1->val.s, putfbufname) &&
+ 				buildwrites == 1 &&
+ 				sp->next &&
+ 				sp->next->kind == SK_ASSIGN &&
+ 				sp->next->exp1->kind == EK_BICALL &&
+ 				!strcmp(sp->next->exp1->val.s,
+ 					putname) &&
+ 				exprsame(sp->exp1->args[0],
+ 					 sp->next->exp1->args[0], 1)) {
+ 				eatstmt(&sp->next);
+ 				if (!expr_has_address(sp->exp1->args[2]) ||
+ 				    sp->exp1->args[2]->val.type !=
+ 				        sp->exp1->args[1]->val.type) {
+ 				    tvar = maketempvar(sp->exp1->args[1]->val.type,
+ 							   name_TEMP);
+ 				    sp2 = makestmt_assign(makeexpr_var(tvar),
+ 							  sp->exp1->args[2]);
+ 				    sp2->next = sp;
+ 				    *spp = sp2;
+ 				    sp->exp1->args[2] = makeexpr_var(tvar);
+ 				    freetempvar(tvar);
+ 				}
+ 				ex = makeexpr_bicall_4("fwrite", tp_integer,
+ 						       makeexpr_addr(sp->exp1->args[2]),
+ 						       makeexpr_sizeof(sp->exp1->args[1], 0),
+ 						       makeexpr_long(1),
+ 						       sp->exp1->args[0]);
+ 				FREE(sp->exp1);
+ 				sp->exp1 = ex;
+ 				continue;
+ 			    }
+ 			    if (!strcmp(sp->exp1->val.s, charputfbufname) &&
+ 				buildwrites != 0 &&
+ 				sp->next &&
+ 				sp->next->kind == SK_ASSIGN &&
+ 				sp->next->exp1->kind == EK_BICALL &&
+ 				!strcmp(sp->next->exp1->val.s,
+ 					charputname) &&
+ 				exprsame(sp->exp1->args[0],
+ 					 sp->next->exp1->args[0], 1)) {
+ 				eatstmt(&sp->next);
+ 				swapexprs(sp->exp1->args[0],
+ 					  sp->exp1->args[1]);
+ 				strchange(&sp->exp1->val.s, "putc");
+ 				continue;
+ 			    }
+ 			    if ((!strcmp(sp->exp1->val.s, resetbufname) ||
+ 				 !strcmp(sp->exp1->val.s, setupbufname)) &&
+ 				!fileisbuffered(sp->exp1->args[0], 0)) {
+ 				eatstmt(spp);
+ 				continue;
+ 			    }
+ 			    ex = print_func(sp->exp1);
+ 			    if (ex && sp->next && mixwritelns &&
+ 				sp->next->kind == SK_ASSIGN &&
+ 				exprsame(ex, print_func(sp->next->exp1), 1) &&
+ 				(printnl_func(sp->exp1) ||
+ 				 printnl_func(sp->next->exp1))) {
+ 				sp->exp1 = mix_printf(sp->exp1,
+ 						      sp->next->exp1);
+ 				eatstmt(&sp->next);
+ 				continue;
+ 			    }
+                             break;
+ 
+                         case EK_FUNCTION:
+                         case EK_SPCALL:
+                         case EK_POSTINC:
+                         case EK_POSTDEC:
+                         case EK_AND:
+                         case EK_OR:
+                             break;
+ 
+                         default:
+                             spp2 = spp;
+                             for (i = 0; i < sp->exp1->nargs; i++) {
+                                 *spp2 = makestmt_call(sp->exp1->args[i]);
+                                 spp2 = &(*spp2)->next;
+                             }
+                             *spp2 = sp->next;
+                             continue;    /* ... to fix these new statements */
+ 
+                     }
+                 }
+                 break;
+ 
+             case SK_IF:
+                 fixblock(&sp->stm1, thisreturn);
+                 fixblock(&sp->stm2, thisreturn);
+                 if (!sp->stm1) {
+                     if (!sp->stm2) {
+                         sp->kind = SK_ASSIGN;
+                         continue;
+                     } else {
+ 			if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
+ 			    freeexpr(sp->stm2->exp2);
+ 			    sp->stm2->exp2 = NULL;
+ 			}
+                         sp->exp1 = makeexpr_not(sp->exp1);   /* if (x) else foo  =>  if (!x) foo */
+                         swapstmts(sp->stm1, sp->stm2);
+ 			/* Ought to exchange comments for then/else parts */
+                     }
+                 }
+ 		/* At this point we know sp1 != NULL */
+                 if (thisreturn) {
+                     if (thisreturn->kind == SK_WHILE) {
+                         if (usebreaks) {
+                             sp1 = sp->stm1;
+                             while (sp1->next)
+                                 sp1 = sp1->next;
+                             if (sp->stm2) {
+ 				sp2 = sp->stm2;
+ 				while (sp2->next)
+ 				    sp2 = sp2->next;
+                                 i = stmtcount(sp->stm1);
+                                 j = stmtcount(sp->stm2);
+                                 if (j >= breaklimit && i <= 2 && j > i*2 &&
+                                     ((implies(sp->exp1, thisreturn->exp1, 0, 1) &&
+ 				      !checkexprchanged(sp->stm1, sp->exp1)) ||
+ 				     (sp1->kind == SK_ASSIGN &&
+ 				      implies(sp1->exp1, thisreturn->exp1, 0, 1)))) {
+                                     sp1->next = makestmt(SK_BREAK);
+                                 } else if (i >= breaklimit && j <= 2 && i > j*2 &&
+                                            ((implies(sp->exp1, thisreturn->exp1, 1, 1) &&
+ 					     !checkexprchanged(sp->stm2, sp->exp1)) ||
+ 					    (sp2->kind == SK_ASSIGN &&
+ 					     implies(sp2->exp1, thisreturn->exp1, 0, 1)))) {
+                                     sp2->next = makestmt(SK_BREAK);
+ 				} else if (!checkconst(sp->exp2, 1)) {
+ 				    /* not part of an else-if */
+ 				    if (j >= continuelimit) {
+ 					sp1->next = makestmt(SK_CONTINUE);
+ 				    } else if (i >= continuelimit) {
+ 					sp2->next = makestmt(SK_CONTINUE);
+ 				    }
+ 				}
+ 			    } else {
+                                 i = stmtcount(sp->stm1);
+                                 if (i >= breaklimit &&
+                                     implies(sp->exp1, thisreturn->exp1, 1, 1)) {
+                                     sp->exp1 = makeexpr_not(sp->exp1);
+                                     sp1->next = sp->next;
+                                     sp->next = sp->stm1;
+                                     sp->stm1 = makestmt(SK_BREAK);
+                                 } else if (i >= continuelimit) {
+                                     sp->exp1 = makeexpr_not(sp->exp1);
+                                     sp1->next = sp->next;
+                                     sp->next = sp->stm1;
+                                     sp->stm1 = makestmt(SK_CONTINUE);
+                                 }
+                             }
+                         }
+                     } else {
+                         if (usereturns) {
+                             sp2 = sp->stm1;
+                             while (sp2->next)
+                                 sp2 = sp2->next;
+                             if (sp->stm2) {
+                                 /* if (x) foo; else bar; (return;)  =>  if (x) {foo; return;} bar; */
+                                 if (stmtcount(sp->stm2) >= returnlimit) {
+ 				    if (!deadendblock(sp->stm1))
+ 					sp2->next = copystmt(thisreturn);
+                                 } else if (stmtcount(sp->stm1) >= returnlimit) {
+                                     sp2 = sp->stm2;
+                                     while (sp2->next)
+                                         sp2 = sp2->next;
+ 				    if (!deadendblock(sp->stm2))
+ 					sp2->next = copystmt(thisreturn);
+                                 }
+                             } else {      /* if (x) foo; (return;)  =>  if (!x) return; foo; */
+                                 if (stmtcount(sp->stm1) >= returnlimit) {
+                                     sp->exp1 = makeexpr_not(sp->exp1);
+                                     sp2->next = sp->next;
+                                     sp->next = sp->stm1;
+                                     sp->stm1 = copystmt(thisreturn);
+                                 }
+                             }
+                         }
+                     }
+                 }
+                 if (!checkconst(sp->exp2, 1)) {    /* not part of an else-if */
+                     de1 = deadendblock(sp->stm1);
+                     de2 = deadendblock(sp->stm2);
+                     if (de2 && !de1) {
+                         sp->exp1 = makeexpr_not(sp->exp1);
+                         swapstmts(sp->stm1, sp->stm2);
+                         de1 = 1, de2 = 0;
+                     }
+                     if (de1 && !de2 && sp->stm2) {
+ 			if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
+ 			    freeexpr(sp->stm2->exp2);
+ 			    sp->stm2->exp2 = NULL;
+ 			}
+                         for (sp2 = sp->stm2; sp2->next; sp2 = sp2->next) ;
+                         sp2->next = sp->next;
+                         sp->next = sp->stm2;      /* if (x) ESCAPE else foo  =>  if (x) ESCAPE; foo */
+                         sp->stm2 = NULL;
+                     }
+                 }
+                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+ 		if (elimdeadcode > 1 && checkconst(sp->exp1, 0)) {
+ 		    note("Eliminated \"if false\" statement [326]");
+ 		    splicestmt(sp, sp->stm2);
+ 		    continue;
+ 		} else if (elimdeadcode > 1 && checkconst(sp->exp1, 1)) {
+ 		    note("Eliminated \"if true\" statement [327]");
+ 		    splicestmt(sp, sp->stm1);
+ 		    continue;
+ 		}
+                 break;
+ 
+             case SK_WHILE:
+                 if (whilefgets &&    /* handle "while eof(f) do readln(f,...)" */
+ 		    sp->stm1 &&
+ 		    sp->stm1->kind == SK_ASSIGN &&
+ 		    sp->stm1->exp1->kind == EK_BICALL &&
+ 		    !strcmp(sp->stm1->exp1->val.s, "fgets") &&
+ 		    nosideeffects(sp->stm1->exp1->args[0], 1) &&
+ 		    nosideeffects(sp->stm1->exp1->args[1], 1) &&
+ 		    nosideeffects(sp->stm1->exp1->args[2], 1)) {
+ 		    if ((sp->exp1->kind == EK_NOT &&
+ 			 sp->exp1->args[0]->kind == EK_BICALL && *eofname &&
+ 			 !strcmp(sp->exp1->args[0]->val.s, eofname) &&
+ 			 exprsame(sp->exp1->args[0]->args[0],
+ 				  sp->stm1->exp1->args[2], 1)) ||
+ 			(sp->exp1->kind == EK_EQ &&
+ 			 sp->exp1->args[0]->kind == EK_BICALL &&
+ 			 !strcmp(sp->exp1->args[0]->val.s, "feof") &&
+ 			 checkconst(sp->exp1->args[1], 0) &&
+ 			 exprsame(sp->exp1->args[0]->args[0],
+ 				  sp->stm1->exp1->args[2], 1))) {
+ 			sp->stm1->exp1->val.type = tp_strptr;
+ 			sp->exp1 = makeexpr_rel(EK_NE,
+ 						sp->stm1->exp1,
+ 						makeexpr_nil());
+ 			sp->stm1 = sp->stm1->next;
+ 		    }
+                 }
+                 fixblock(&sp->stm1, sp);
+                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+                 if (checkconst(sp->exp1, 1))
+                     infiniteloop(sp);
+                 break;
+ 
+             case SK_REPEAT:
+                 fixblock(&sp->stm1, NULL);
+                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+                 if (checkconst(sp->exp1, 1))
+                     infiniteloop(sp);
+                 break;
+ 
+             case SK_TRY:
+                 save_tryblock = fixexpr_tryblock;
+                 save_tryflag = fixexpr_tryflag;
+                 fixexpr_tryblock = sp->exp1->val.i;
+                 fixexpr_tryflag = 0;
+                 fixblock(&sp->stm1, NULL);
+                 if (fixexpr_tryflag)
+                     sp->exp2 = makeexpr_long(1);
+                 fixexpr_tryblock = save_tryblock;
+                 fixexpr_tryflag = save_tryflag;
+                 fixblock(&sp->stm2, NULL);
+                 break;
+ 
+             case SK_BODY:
+                 fixblock(&sp->stm1, thisreturn);
+                 break;
+ 
+             case SK_CASE:
+                 fixblock(&sp->stm1, NULL);
+                 sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
+                 if (!sp->stm1) {    /* empty case */
+                     sp->kind = SK_ASSIGN;
+                     continue;
+                 } else if (sp->stm1->kind != SK_CASELABEL) {   /* default only */
+                     for (sp2 = sp->stm1; sp2->next; sp2 = sp2->next) ;
+                     sp2->next = sp->next;
+                     sp->next = sp->stm1;
+                     sp->kind = SK_ASSIGN;
+                     sp->stm1 = NULL;
+                     continue;
+                 }
+                 break;
+ 
+             default:
+                 fixblock(&sp->stm1, NULL);
+                 fixblock(&sp->stm2, NULL);
+                 sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
+                 sp->exp2 = fixexpr(sp->exp2, ENV_EXPR);
+                 sp->exp3 = fixexpr(sp->exp3, ENV_EXPR);
+                 if (sp->next &&
+                     (sp->kind == SK_GOTO ||
+                      sp->kind == SK_BREAK ||
+                      sp->kind == SK_CONTINUE ||
+                      sp->kind == SK_RETURN) &&
+                     !haslabels(sp->next)) {
+                     if (elimdeadcode) {
+                         note("Deleting unreachable code [255]");
+                         while (sp->next && !haslabels(sp->next))
+                             eatstmt(&sp->next);
+                     } else {
+                         note("Code is unreachable [256]");
+                     }
+                 } else if (sp->kind == SK_RETURN &&
+                            thisreturn &&
+                            thisreturn->kind == SK_RETURN &&
+                            exprsame(sp->exp1, thisreturn->exp1, 1)) {
+                     eatstmt(spp);
+ 		    continue;
+                 }
+                 break;
+         }
+         spp = &sp->next;
+     }
+     saveserial = curserial;
+ }
+ 
+ 
+ 
+ 
+ /* Convert comma expressions into multiple statements */
+ 
+ Static int checkcomma_expr(spp, exp)
+ Stmt **spp;
+ Expr **exp;
+ {
+     Stmt *sp;
+     Expr *ex = *exp;
+     int i, res;
+ 
+     switch (ex->kind) {
+ 
+         case EK_COMMA:
+             if (spp) {
+                 res = checkcomma_expr(spp, &ex->args[ex->nargs-1]);
+                 for (i = ex->nargs-1; --i >= 0; ) {
+                     sp = makestmt(SK_ASSIGN);
+                     sp->exp1 = ex->args[i];
+                     sp->next = *spp;
+                     *spp = sp;
+                     res = checkcomma_expr(spp, &ex->args[i]);
+                 }
+                 *exp = ex->args[ex->nargs-1];
+             }
+             return 1;
+ 
+         case EK_COND:
+             if (isescape(ex->args[1]) && spp &&
+                 !isescape(ex->args[2])) {
+                 swapexprs(ex->args[1], ex->args[2]);
+                 ex->args[0] = makeexpr_not(ex->args[0]);
+             }
+             if (isescape(ex->args[2])) {
+                 if (spp) {
+                     res = checkcomma_expr(spp, &ex->args[1]);
+                     if (ex->args[0]->kind == EK_ASSIGN) {
+                         sp = makestmt(SK_ASSIGN);
+                         sp->exp1 = copyexpr(ex->args[0]);
+                         sp->next = makestmt(SK_IF);
+                         sp->next->next = *spp;
+                         *spp = sp;
+                         res = checkcomma_expr(spp, &sp->exp1);
+                         ex->args[0] = grabarg(ex->args[0], 0);
+                         sp = sp->next;
+                     } else {
+                         sp = makestmt(SK_IF);
+                         sp->next = *spp;
+                         *spp = sp;
+                     }
+                     sp->exp1 = makeexpr_not(ex->args[0]);
+                     sp->stm1 = makestmt(SK_ASSIGN);
+                     sp->stm1->exp1 = eatcasts(ex->args[2]);
+                     res = checkcomma_expr(&sp->stm1, &ex->args[2]);
+                     res = checkcomma_expr(spp, &sp->exp1);
+                     *exp = ex->args[1];
+                 }
+                 return 1;
+             }
+             return checkcomma_expr(spp, &ex->args[0]);
+ 
+         case EK_AND:
+         case EK_OR:
+             return checkcomma_expr(spp, &ex->args[0]);
+ 
+ 	default:
+ 	    res = 0;
+ 	    for (i = ex->nargs; --i >= 0; ) {
+ 		res += checkcomma_expr(spp, &ex->args[i]);
+ 	    }
+ 	    return res;
+ 
+     }
+ }
+ 
+ 
+ 
+ Static void checkcommas(spp)
+ Stmt **spp;
+ {
+     Stmt *sp;
+     int res;
+ 
+     while ((sp = *spp)) {
+         checkcommas(&sp->stm1);
+         checkcommas(&sp->stm2);
+         switch (sp->kind) {
+ 
+             case SK_ASSIGN:
+             case SK_IF:
+             case SK_CASE:
+             case SK_RETURN:
+                 if (sp->exp1)
+                     res = checkcomma_expr(spp, &sp->exp1);
+                 break;
+ 
+             case SK_WHILE:
+                 /* handle the argument */
+                 break;
+ 
+             case SK_REPEAT:
+                 /* handle the argument */
+                 break;
+ 
+             case SK_FOR:
+ 		if (sp->exp1)
+ 		    res = checkcomma_expr(spp, &sp->exp1);
+                 /* handle the other arguments */
+                 break;
+ 
+ 	    default:
+ 		break;
+         }
+         spp = &sp->next;
+     }
+ }
+ 
+ 
+ 
+ 
+ Static int checkvarchangeable(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             return (mp == (Meaning *)ex->val.i);
+ 
+         case EK_DOT:
+         case EK_INDEX:
+             return checkvarchangeable(ex->args[0], mp);
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ 
+ int checkvarchangedexpr(ex, mp, addrokay)
+ Expr *ex;
+ Meaning *mp;
+ int addrokay;
+ {
+     int i;
+     Meaning *mp3;
+     unsigned int safemask = 0;
+ 
+     switch (ex->kind) {
+ 
+         case EK_FUNCTION:
+         case EK_SPCALL:
+             if (ex->kind == EK_FUNCTION) {
+                 i = 0;
+                 mp3 = ((Meaning *)ex->val.i)->type->fbase;
+             } else {
+                 i = 1;
+                 if (ex->args[0]->val.type->kind != TK_PROCPTR)
+                     return 1;
+                 mp3 = ex->args[0]->val.type->basetype->fbase;
+             }
+             for ( ; i < ex->nargs && i < 16; i++) {
+                 if (!mp3) {
+                     intwarning("checkvarchangedexpr", "Too many arguments for EK_FUNCTION [266]");
+                     break;
+                 }
+                 if (mp3->kind == MK_PARAM &&
+                     (mp3->type->kind == TK_ARRAY ||
+                      mp3->type->kind == TK_STRING ||
+                      mp3->type->kind == TK_SET))
+                     safemask |= 1<<i;
+                 if (mp3->kind == MK_VARPARAM &&
+                     mp3->type == tp_strptr && mp3->anyvarflag)
+                     i++;
+                 mp3 = mp3->xnext;
+             }
+             if (mp3)
+                 intwarning("checkvarchangedexpr", "Too few arguments for EK_FUNCTION [267]");
+             break;
+ 
+         case EK_VAR:
+             if (mp == (Meaning *)ex->val.i) {
+                 if ((mp->type->kind == TK_ARRAY ||
+                      mp->type->kind == TK_STRING ||
+                      mp->type->kind == TK_SET) &&
+                     ex->val.type->kind == TK_POINTER && !addrokay)
+                     return 1;   /* must be an implicit & */
+             }
+             break;
+ 
+         case EK_ADDR:
+         case EK_ASSIGN:
+         case EK_POSTINC:
+         case EK_POSTDEC:
+             if (checkvarchangeable(ex->args[0], mp))
+                 return 1;
+             break;
+ 
+         case EK_BICALL:
+             if (structuredfunc(ex) && checkvarchangeable(ex->args[0], mp))
+                 return 1;
+             safemask = safemask_bicall(ex->val.s);
+             break;
+             /* In case calls to these functions were lazy and passed
+                the array rather than its (implicit) address.  Other
+                BICALLs had better be careful about their arguments. */
+ 
+         case EK_PLUS:
+             if (addrokay)         /* to keep from being scared by pointer */
+                 safemask = ~0;    /*  arithmetic on string being passed */
+             break;                /*  to functions. */
+ 
+ 	default:
+ 	    break;
+     }
+     for (i = 0; i < ex->nargs; i++) {
+         if (checkvarchangedexpr(ex->args[i], mp, safemask&1))
+             return 1;
+         safemask >>= 1;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ int checkvarchanged(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+     if (mp->constqual)
+ 	return 0;
+     if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION ||
+         mp->volatilequal || alwayscopyvalues)
+         return 1;
+     while (sp) {
+         if (/* sp->kind == SK_GOTO || */
+ 	    sp->kind == SK_LABEL ||
+             checkvarchanged(sp->stm1, mp) ||
+             checkvarchanged(sp->stm2, mp) ||
+             (sp->exp1 && checkvarchangedexpr(sp->exp1, mp, 1)) ||
+             (sp->exp2 && checkvarchangedexpr(sp->exp2, mp, 1)) ||
+             (sp->exp3 && checkvarchangedexpr(sp->exp3, mp, 1)))
+             return 1;
+         sp = sp->next;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ int checkexprchanged(sp, ex)
+ Stmt *sp;
+ Expr *ex;
+ {
+     Meaning *mp;
+     int i;
+ 
+     for (i = 0; i < ex->nargs; i++) {
+         if (checkexprchanged(sp, ex->args[i]))
+             return 1;
+     }
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+             if (mp->kind == MK_CONST)
+                 return 0;
+             else
+                 return checkvarchanged(sp, mp);
+ 
+         case EK_HAT:
+         case EK_INDEX:
+         case EK_SPCALL:
+             return 1;
+ 
+         case EK_FUNCTION:
+         case EK_BICALL:
+             return !nosideeffects_func(ex);
+ 
+ 	default:
+ 	    return 0;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ /* Check if a variable always occurs with a certain offset added, e.g. "i+1" */
+ 
+ Static int theoffset, numoffsets, numzerooffsets;
+ #define BadOffset  (-999)
+ 
+ void checkvaroffsetexpr(ex, mp, myoffset)
+ Expr *ex;
+ Meaning *mp;
+ int myoffset;
+ {
+     int i, nextoffset = 0;
+     Expr *ex2;
+ 
+     if (!ex)
+ 	return;
+     switch (ex->kind) {
+ 
+       case EK_VAR:
+ 	if (ex->val.i == (long)mp) {
+ 	    if (myoffset == 0)
+ 		numzerooffsets++;
+ 	    else if (numoffsets == 0 || myoffset == theoffset) {
+ 		theoffset = myoffset;
+ 		numoffsets++;
+ 	    } else
+ 		theoffset = BadOffset;
+ 	}
+ 	break;
+ 
+       case EK_PLUS:
+ 	ex2 = ex->args[ex->nargs-1];
+ 	if (ex2->kind == EK_CONST &&
+ 	    ex2->val.type->kind == TK_INTEGER) {
+ 	    nextoffset = ex2->val.i;
+ 	}
+ 	break;
+ 
+       case EK_HAT:
+       case EK_POSTINC:
+       case EK_POSTDEC:
+ 	nextoffset = BadOffset;
+ 	break;
+ 
+       case EK_ASSIGN:
+ 	checkvaroffsetexpr(ex->args[0], mp, BadOffset);
+ 	checkvaroffsetexpr(ex->args[1], mp, 0);
+ 	return;
+ 
+       default:
+ 	break;
+     }
+     i = ex->nargs;
+     while (--i >= 0)
+ 	checkvaroffsetexpr(ex->args[i], mp, nextoffset);
+ }
+ 
+ 
+ void checkvaroffsetstmt(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+     while (sp) {
+ 	checkvaroffsetstmt(sp->stm1, mp);
+ 	checkvaroffsetstmt(sp->stm1, mp);
+ 	checkvaroffsetexpr(sp->exp1, mp, 0);
+ 	checkvaroffsetexpr(sp->exp2, mp, 0);
+ 	checkvaroffsetexpr(sp->exp3, mp, 0);
+ 	sp = sp->next;
+     }
+ }
+ 
+ 
+ int checkvaroffset(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+     if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION)
+ 	return 0;
+     numoffsets = 0;
+     numzerooffsets = 0;
+     checkvaroffsetstmt(sp, mp);
+     if (numoffsets == 0 || theoffset == BadOffset ||
+ 	numoffsets <= numzerooffsets * 3)
+ 	return 0;
+     else
+ 	return theoffset;
+ }
+ 
+ 
+ 
+ 
+ Expr *initfilevar(ex)
+ Expr *ex;
+ {
+     Expr *ex2;
+     Meaning *mp;
+     char *name;
+ 
+     if (ex->val.type->kind == TK_BIGFILE) {
+ 	ex2 = copyexpr(ex);
+ 	if (ex->kind == EK_VAR &&
+ 	    (mp = (Meaning *)ex->val.i)->kind == MK_VAR &&
+ 	    mp->ctx->kind != MK_FUNCTION &&
+ 	    !is_std_file(ex) &&
+ 	    literalfilesflag > 0 &&
+ 	    (literalfilesflag == 1 ||
+ 	     strlist_cifind(literalfiles, mp->name)))
+ 	    name = mp->name;
+ 	else
+ 	    name = "";
+ 	return makeexpr_comma(makeexpr_assign(filebasename(ex),
+ 					      makeexpr_nil()),
+ 			      makeexpr_assign(makeexpr_dotq(ex2, "name",
+ 							    tp_str255),
+ 					      makeexpr_string(name)));
+     } else {
+ 	return makeexpr_assign(ex, makeexpr_nil());
+     }
+ }
+ 
+ 
+ void initfilevars(mp, sppp, exbase)
+ Meaning *mp;
+ Stmt ***sppp;
+ Expr *exbase;
+ {
+     Stmt *sp;
+     Type *tp;
+     Expr *ex;
+ 
+     while (mp) {
+ 	if ((mp->kind == MK_VAR && mp->refcount > 0 && !mp->istemporary) ||
+ 	    mp->kind == MK_FIELD) {
+ 	    tp = mp->type;
+ 	    if (isfiletype(tp, -1)) {
+ 		mp->refcount++;
+ 		sp = makestmt(SK_ASSIGN);
+ 		sp->next = **sppp;
+ 		**sppp = sp;
+ 		if (exbase)
+ 		    ex = makeexpr_dot(copyexpr(exbase), mp);
+ 		else
+ 		    ex = makeexpr_var(mp);
+ 		sp->exp1 = initfilevar(copyexpr(ex));
+ 	    } else if (tp->kind == TK_RECORD) {
+ 		if (exbase)
+ 		    ex = makeexpr_dot(copyexpr(exbase), mp);
+ 		else
+ 		    ex = makeexpr_var(mp);
+ 		initfilevars(tp->fbase, sppp, ex);
+ 		freeexpr(ex);
+ 	    } else if (tp->kind == TK_ARRAY) {
+ 		while (tp->kind == TK_ARRAY)
+ 		    tp = tp->basetype;
+ 		if (isfiletype(tp, -1))
+ 		    note(format_s("Array of files %s should be initialized [257]",
+ 				  mp->name));
+ 	    }
+ 	}
+ 	mp = mp->cnext;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ Static Stmt *p_body()
+ {
+     Stmt *sp, **spp, *spbody, **sppbody, *spbase, *thereturn;
+     Meaning *mp;
+     Expr *ex;
+     int haspostamble;
+     long saveserial;
+ 
+     if (verbose)
+ 	fprintf(logf, "%s, %d/%d: Translating %s (in %s)\n",
+ 		infname, inf_lnum, outf_lnum,
+ 		curctx->name, curctx->ctx->name);
+     notephase = 1;
+     spp = &spbase;
+     addstmt(SK_HEADER);
+     sp->exp1 = makeexpr_var(curctx);
+     checkkeyword(TOK_INLINE);
+     if (curtok != TOK_END && curtok != TOK_BEGIN && curtok != TOK_INLINE) {
+ 	if (curctx->kind == MK_FUNCTION || curctx->anyvarflag)
+ 	    wexpecttok(TOK_BEGIN);
+ 	else
+ 	    wexpecttok(TOK_END);
+ 	skiptotoken2(TOK_BEGIN, TOK_END);
+     }
+     if (curtok == TOK_END) {
+ 	gettok();
+ 	spbody = NULL;
+     } else {
+ 	spbody = p_stmt(NULL, SF_FUNC);  /* parse the procedure/program body */
+     }
+     if (curtok == TOK_IDENT && curtokmeaning == curctx) {
+ 	gettok();    /* Modula-2 */
+     }
+     notephase = 2;
+     saveserial = curserial;
+     curserial = 10000;
+     if (curctx->kind == MK_FUNCTION) {     /* handle copy parameters */
+         for (mp = curctx->type->fbase; mp; mp = mp->xnext) {
+             if (!mp->othername && mp->varstructflag) {
+                 mp->othername = stralloc(format_s(name_COPYPAR, mp->name));
+                 mp->rectype = mp->type;
+                 addstmt(SK_ASSIGN);
+                 sp->exp1 = makeexpr_assign(makeexpr_var(mp), 
+                                            makeexpr_name(mp->othername, mp->rectype));
+                 mp->refcount++;
+             } else if (mp->othername) {
+                 if (checkvarchanged(spbody, mp)) {
+                     addstmt(SK_ASSIGN);
+                     sp->exp1 = makeexpr_assign(makeexpr_var(mp),
+                                                makeexpr_hat(makeexpr_name(mp->othername,
+                                                                           mp->rectype), 0));
+                     mp->refcount++;
+                 } else {           /* don't need to copy it after all */
+                     strchange(&mp->othername, mp->name);
+                     ex = makeexpr_var(mp);
+                     ex->val.type = mp->rectype;
+                     replaceexpr(spbody, makeexpr_var(mp), makeexpr_hat(ex, 0));
+                 }
+             }
+         }
+     }
+     for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ 	if (mp->kind == MK_LABEL && mp->val.i) {
+ 	    addstmt(SK_IF);
+ 	    sp->exp1 = makeexpr_bicall_1("setjmp", tp_int,
+ 					 makeexpr_var(mp->xnext));
+ 	    sp->stm1 = makestmt(SK_GOTO);
+ 	    sp->stm1->exp1 = makeexpr_name(format_s(name_LABEL, mp->name),
+ 					   tp_integer);
+ 	}
+     }
+     *spp = spbody;
+     sppbody = spp;
+     while (*spp)
+         spp = &((*spp)->next);
+     haspostamble = 0;
+     initfilevars(curctx->cbase, &sppbody, NULL);
+     for (mp = curctx->cbase; mp; mp = mp->cnext) {
+         if (mp->kind == MK_VAR && mp->refcount > 0 &&
+ 	    isfiletype(mp->type, -1) &&
+ 	    !mp->istemporary) {
+             if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
+                 addstmt(SK_IF);                    /* close file variables */
+                 sp->exp1 = makeexpr_rel(EK_NE, filebasename(makeexpr_var(mp)),
+ 					makeexpr_nil());
+                 sp->stm1 = makestmt(SK_ASSIGN);
+                 sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void,
+ 						   filebasename(makeexpr_var(mp)));
+             }
+             haspostamble = 1;
+         }
+     }
+     thereturn = &bogusreturn;
+     if (curctx->kind == MK_FUNCTION && curctx->type->basetype != tp_void) {
+         if ((haspostamble || !checkreturns(&spbase, 1)) &&
+             curctx->cbase->refcount > 0) {      /* add function return code */
+             addstmt(SK_RETURN);
+             sp->exp1 = makeexpr_var(curctx->cbase);
+         }
+         thereturn = NULL;
+     } else if (curctx->kind == MK_MODULE && curctx->anyvarflag) {
+         addstmt(SK_ASSIGN);
+         sp->exp1 = makeexpr_bicall_1("exit", tp_void,
+ 				     makeexpr_name("EXIT_SUCCESS",
+ 						   tp_integer));
+         thereturn = NULL;
+     }
+     if (debug>2) { fprintf(outf, "calling fixblock/usecommas on:\n"); dumpstmt(spbase, 5); }
+     curserial = saveserial;
+     sp = makestmt(SK_BODY);
+     sp->stm1 = spbase;
+     fixblock(&sp, thereturn);           /* finishing touches to statements and expressions */
+     spbase = sp->stm1;
+     FREE(sp);
+     if (usecommas != 1)
+         checkcommas(&spbase);    /* unroll ugly EK_COMMA and EK_COND expressions */
+     if (debug>1) { fprintf(outf, "p_body returns:\n"); dumpstmt(spbase, 5); }
+     notephase = 0;
+     return spbase;
+ }
+ 
+ 
+ 
+ 
+ #define checkWord()  if (anywords) output(" "); anywords = 1
+ 
+ Static void out_function(func)
+ Meaning *func;
+ {
+     Meaning *mp;
+     Symbol *sym;
+     int opts, anywords, spacing, saveindent;
+ 
+     if (func->varstructflag) {
+         makevarstruct(func);
+     }
+     if (collectnest) {
+ 	for (mp = func->cbase; mp; mp = mp->cnext) {
+ 	    if (mp->kind == MK_FUNCTION && mp->isforward) {
+ 		forward_decl(mp, 0);
+ 	    }
+ 	}
+ 	for (mp = func->cbase; mp; mp = mp->cnext) {
+ 	    if (mp->kind == MK_FUNCTION && mp->type && !mp->exported) {
+ 		pushctx(mp);
+ 		out_function(mp);    /* generate the sub-procedures first */
+ 		popctx();
+ 	    }
+ 	}
+     }
+     spacing = functionspace;
+     for (mp = func; mp->ctx->kind == MK_FUNCTION; mp = mp->ctx) {
+         if (spacing > minfuncspace)
+             spacing--;
+     }
+     outsection(spacing);
+     flushcomments(&func->comments, -1, 0);
+     if (usePPMacros == 1) {
+         forward_decl(func, 0);
+         outsection(minorspace);
+     }
+     opts = ODECL_HEADER;
+     anywords = 0;
+     if (func->namedfile) {
+ 	checkWord();
+ 	if (useAnyptrMacros || ansiC < 2)
+ 	    output("Inline");
+ 	else
+ 	    output("inline");
+     }
+     if (!func->exported) {
+ 	if (func->ctx->kind == MK_FUNCTION) {
+ 	    if (useAnyptrMacros) {
+ 		checkWord();
+ 		output("Local");
+ 	    } else if (use_static) {
+ 		checkWord();
+ 		output("static");
+ 	    }
+ 	} else if ((findsymbol(func->name)->flags & NEEDSTATIC) ||
+ 		   (use_static != 0 && !useAnyptrMacros)) {
+ 	    checkWord();
+ 	    output("static");
+ 	} else if (useAnyptrMacros) {
+ 	    checkWord();
+ 	    output("Static");
+ 	}
+     }
+     if (func->type->basetype != tp_void || ansiC != 0) {
+ 	checkWord();
+         outbasetype(func->type, 0);
+     }
+     if (anywords) {
+         if (newlinefunctions)
+             opts |= ODECL_FUNCTION;
+         else
+             output(" ");
+     }
+     outdeclarator(func->type, func->name, opts);
+     if (fullprototyping == 0) {
+ 	saveindent = outindent;
+ 	moreindent(argindent);
+         out_argdecls(func->type);
+ 	outindent = saveindent;
+     }
+     for (mp = func->type->fbase; mp; mp = mp->xnext) {
+         if (mp->othername && strcmp(mp->name, mp->othername))
+             mp->wasdeclared = 0;    /* make sure we also declare the copy */
+     }
+     func->wasdeclared = 1;
+     outcontext = func;
+     out_block((Stmt *)func->val.i, BR_FUNCTION, 10000);
+     if (useundef) {
+ 	anywords = 0;
+ 	for (mp = func->cbase; mp; mp = mp->cnext) {
+ 	    if (mp->kind == MK_CONST &&
+ 		mp->isreturn) {    /* the was-#defined flag */
+ 		if (!anywords)
+ 		    outsection(minorspace);
+ 		anywords++;
+ 		output(format_s("#undef %s\n", mp->name));
+ 		sym = findsymbol(mp->name);
+ 		sym->flags &= ~AVOIDNAME;
+ 	    }
+ 	}
+     }
+     if (conserve_mem) {
+ 	free_stmt((Stmt *)func->val.i);   /* is this safe? */
+ 	func->val.i = 0;
+ 	forget_ctx(func, 0);
+     }
+     outsection(spacing);
+ }
+ 
+ 
+ 
+ 
+ void movetoend(mp)
+ Meaning *mp;
+ {
+     Meaning **mpp;
+ 
+     if (mp->ctx != curctx) {
+         intwarning("movetoend", "curctx is wrong [268]");
+     } else {
+         mpp = &mp->ctx->cbase;     /* move a meaning to end of its parent context */
+         while (*mpp != mp) {
+ 	    if (!*mpp) {
+ 		intwarning("movetoend", "meaning not on its context list [269]");
+ 		return;
+ 	    }
+             mpp = &(*mpp)->cnext;
+ 	}
+         *mpp = mp->cnext;    /* Remove from present position in list */
+         while (*mpp)
+             mpp = &(*mpp)->cnext;
+         *mpp = mp;           /* Insert at end of list */
+         mp->cnext = NULL;
+         curctxlast = mp;
+     }
+ }
+ 
+ 
+ 
+ Static void scanfwdparams(mp)
+ Meaning *mp;
+ {
+     Symbol *sym;
+ 
+     mp = mp->type->fbase;
+     while (mp) {
+ 	sym = findsymbol(mp->name);
+ 	sym->flags |= FWDPARAM;
+ 	mp = mp->xnext;
+     }
+ }
+ 
+ 
+ 
+ Static void p_function(isfunc)
+ int isfunc;
+ {
+     Meaning *func;
+     Type *type;
+     Stmt *sp;
+     Strlist *sl, *comments, *savecmt;
+     int initializeattr = 0, isinline = 0;
+ 
+     if ((sl = strlist_find(attrlist, "INITIALIZE")) != NULL) {
+ 	initializeattr = 1;
+ 	strlist_delete(&attrlist, sl);
+     }
+     if ((sl = strlist_find(attrlist, "OPTIMIZE")) != NULL &&
+ 	sl->value != -1 &&
+ 	!strcmp((char *)(sl->value), "INLINE")) {
+ 	isinline = 1;
+ 	strlist_delete(&attrlist, sl);
+     }
+     ignore_attributes();
+     comments = extractcomment(&curcomments, -1, curserial);
+     changecomments(comments, -1, -1, -1, 0);
+     if (curctx->kind == MK_FUNCTION) {    /* sub-procedure */
+ 	savecmt = curcomments;
+     } else {
+ 	savecmt = NULL;
+ 	flushcomments(&curcomments, -1, -1);
+     }
+     curcomments = comments;
+     curserial = serialcount = 1;
+     gettok();
+     if (!wexpecttok(TOK_IDENT))
+ 	skiptotoken(TOK_IDENT);
+     if (curtokmeaning && curtokmeaning->ctx == curctx &&
+         curtokmeaning->kind == MK_FUNCTION) {
+         func = curtokmeaning;
+         if (!func->isforward || func->val.i)
+             warning(format_s("Redeclaration of function %s [270]", func->name));
+ 	skiptotoken(TOK_SEMI);
+         movetoend(func);
+         pushctx(func);
+         type = func->type;
+     } else {
+         func = addmeaning(curtoksym, MK_FUNCTION);
+         gettok();
+         func->val.i = 0;
+         pushctx(func);
+         func->type = type = p_funcdecl(&isfunc, 0);
+         func->isfunction = isfunc;
+ 	func->namedfile = isinline;
+         type->meaning = func;
+     }
+     if (blockkind == TOK_EXPORT)
+ 	flushcomments(NULL, -1, -1);
+     wneedtok(TOK_SEMI);
+     if (initializeattr) {
+ 	sl = strlist_append(&initialcalls, format_s("%s()", func->name));
+ 	sl->value = 1;
+     }
+     if (curtok == TOK_IDENT && !strcmp(curtokbuf, "C")) {
+ 	gettok();
+ 	wneedtok(TOK_SEMI);
+     }
+     if (blockkind == TOK_IMPORT) {
+ 	strlist_empty(&curcomments);
+ 	if (curtok == TOK_IDENT &&
+ 	    (!strcicmp(curtokbuf, "FORWARD") ||
+ 	     strlist_cifind(externwords, curtokbuf) ||
+ 	     strlist_cifind(cexternwords, curtokbuf))) {
+ 	    gettok();
+ 	    while (curtok == TOK_IDENT)
+ 		gettok();
+ 	    wneedtok(TOK_SEMI);
+ 	}
+         /* do nothing more */
+     } else if (blockkind == TOK_EXPORT) {
+         func->isforward = 1;
+ 	scanfwdparams(func);
+         forward_decl(func, 1);
+     } else {
+ 	checkkeyword(TOK_INTERRUPT);
+ 	checkkeyword(TOK_INLINE);
+         if (curtok == TOK_INTERRUPT) {
+             note("Ignoring INTERRUPT keyword [258]");
+             gettok();
+             wneedtok(TOK_SEMI);
+         }
+         if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "FORWARD")) {
+             func->isforward = 1;
+ 	    scanfwdparams(func);
+             gettok();
+             if (func->ctx->kind != MK_FUNCTION) {
+                 outsection(minorspace);
+ 		flushcomments(NULL, -1, -1);
+                 forward_decl(func, 0);
+                 outsection(minorspace);
+             }
+         } else if (curtok == TOK_IDENT &&
+ 		   (strlist_cifind(externwords, curtokbuf) ||
+ 		    strlist_cifind(cexternwords, curtokbuf))) {
+             if (*externalias && my_strchr(externalias, '%')) {
+                 strchange(&func->name, format_s(externalias, func->name));
+             } else if (strlist_cifind(cexternwords, curtokbuf)) {
+ 		if (func->name[0] == '_')
+ 		    strchange(&func->name, func->name + 1);
+ 		if (func->name[strlen(func->name)-1] == '_')
+ 		    func->name[strlen(func->name)-1] = 0;
+ 	    }
+ 	    func->isforward = 1;    /* for Oregon Software Pascal-2 */
+ 	    func->exported = 1;
+             gettok();
+ 	    while (curtok == TOK_IDENT)
+ 		gettok();
+             outsection(minorspace);
+ 	    flushcomments(NULL, -1, -1);
+ 	    scanfwdparams(func);
+             forward_decl(func, 1);
+             outsection(minorspace);
+ 	} else if (curtok == TOK_IDENT) {
+ 	    wexpecttok(TOK_BEGIN);   /* print warning */
+ 	    gettok();
+             outsection(minorspace);
+ 	    flushcomments(NULL, -1, -1);
+ 	    scanfwdparams(func);
+             forward_decl(func, 1);
+             outsection(minorspace);
+         } else {
+             if (func->ctx->kind == MK_FUNCTION)
+                 func->ctx->needvarstruct = 1;
+ 	    func->comments = curcomments;
+ 	    curcomments = NULL;
+             p_block(TOK_FUNCTION);
+             echoprocname(func);
+ 	    changecomments(curcomments, -1, curserial, -1, 10000);
+             sp = p_body();
+             func->ctx->needvarstruct = 0;
+             func->val.i = (long)sp;
+ 	    strlist_mix(&func->comments, curcomments);
+ 	    curcomments = NULL;
+             if (func->ctx->kind != MK_FUNCTION || !collectnest) {
+                 out_function(func);    /* output top-level procedures immediately */
+             }                          /*  (sub-procedures are output later) */
+         }
+         if (!wneedtok(TOK_SEMI))
+ 	    skippasttoken(TOK_SEMI);
+     }
+     strlist_mix(&curcomments, savecmt);
+     popctx();
+ }
+ 
+ 
+ 
+ Static void out_include(name, quoted)
+ char *name;
+ int quoted;
+ {
+     if (*name == '"' || *name == '<')
+ 	output(format_s("#include %s\n", name));
+     else if (quoted)
+         output(format_s("#include \"%s\"\n", name));
+     else
+         output(format_s("#include <%s>\n", name));
+ }
+ 
+ 
+ Static void cleanheadername(dest, name)
+ char *dest, *name;
+ {
+     char *cp;
+     int len;
+ 
+     if (*name == '<' || *name == '"')
+ 	name++;
+     cp = my_strrchr(name, '/');
+     if (cp)
+ 	cp++;
+     else
+ 	cp = name;
+     strcpy(dest, cp);
+     len = strlen(dest);
+     if (dest[len-1] == '>' || dest[len-1] == '"')
+ 	dest[len-1] = 0;
+ }
+ 
+ 
+ 
+ 
+ Static int tryimport(sym, fname, ext, need)
+ Symbol *sym;
+ char *fname, *ext;
+ int need;
+ {
+     int found = 0;
+     Meaning *savectx, *savectxlast;
+ 
+     savectx = curctx;
+     savectxlast = curctxlast;
+     curctx = nullctx;
+     curctxlast = curctx->cbase;
+     while (curctxlast && curctxlast->cnext)
+         curctxlast = curctxlast->cnext;
+     if (p_search(fname, ext, need)) {
+         curtokmeaning = sym->mbase;
+         while (curtokmeaning && !curtokmeaning->isactive)
+             curtokmeaning = curtokmeaning->snext;
+         if (curtokmeaning)
+             found = 1;
+     }
+     curctx = savectx;
+     curctxlast = savectxlast;
+     return found;
+ }
+ 
+ 
+ 
+ Static void p_import(inheader)
+ int inheader;
+ {
+     Strlist *sl;
+     Symbol *sym;
+     char *name;
+     int found, isfrom = (curtok == TOK_FROM);
+ 
+     outsection(minorspace);
+     do {
+         gettok();
+         if (!wexpecttok(TOK_IDENT)) {
+ 	    skiptotoken(TOK_SEMI);
+ 	    break;
+ 	}
+         sym = curtoksym;
+         if (curtokmeaning && curtokmeaning->kind == MK_MODULE) {
+             found = 1;
+ 	} else if (strlist_cifind(permimports, sym->name)) {
+             found = 2;   /* built-in module, there already! */
+         } else {
+             found = 0;
+             sl = strlist_cifind(importfrom, sym->name);
+             name = (sl) ? format_none((char *)sl->value) : NULL;
+             if (name) {
+                 if (tryimport(sym, name, "pas", 1))
+                     found = 1;
+             } else {
+                 for (sl = importdirs; sl && !found; sl = sl->next) {
+                     if (tryimport(sym, format_s(sl->s, curtokcase), NULL, 0))
+                         found = 1;
+                 }
+             }
+         }
+         if (found == 1) {
+             if (!inheader) {
+                 sl = strlist_cifind(includefrom, curtokmeaning->name);
+                 name = (sl) ? (char *)sl->value :
+ 		    format_ss(*headerfnfmt2 ? headerfnfmt2 : headerfnfmt,
+ 			      infname, curtokmeaning->name);
+                 if (name && !strlist_find(includedfiles, name)) {
+                     strlist_insert(&includedfiles, name);
+                     if (*name_HSYMBOL)
+                         output(format_s("#ifndef %s\n", format_s(name_HSYMBOL, sym->name)));
+ 		    out_include(name, quoteincludes);
+                     if (*name_HSYMBOL)
+                         output("#endif\n");
+                     outsection(minorspace);
+                 }
+             }
+             import_ctx(curtokmeaning);
+ 	} else if (curtokmeaning) {
+ 	    /* Modula-2, importing a single ident */
+ 	    /* Ignored for now, since we always import whole modules */
+         } else if (found == 0) {
+             warning(format_s("Could not find module %s [271]", sym->name));
+             if (!inheader) {
+                 out_include(format_ss(*headerfnfmt2?headerfnfmt2:headerfnfmt,
+ 				      sym->name, sym->name),
+ 			    quoteincludes);
+             }
+         }
+         gettok();
+     } while (curtok == TOK_COMMA);
+     if (isfrom) {
+ 	checkkeyword(TOK_IMPORT);
+ 	if (wneedtok(TOK_IMPORT)) {
+ 	    do {
+ 		gettok();
+ 		if (curtok == TOK_IDENT)
+ 		    gettok();
+ 	    } while (curtok == TOK_COMMA);
+ 	}
+     }
+     if (!wneedtok(TOK_SEMI))
+ 	skippasttoken(TOK_SEMI);
+     outsection(minorspace);
+ }
+ 
+ 
+ 
+ 
+ void do_include(blkind)
+ Token blkind;
+ {
+     FILE *oldfile = outf;
+     int savelnum = outf_lnum;
+     char fname[256];
+ 
+     outsection(majorspace);
+     strcpy(fname, curtokbuf);
+     removesuffix(fname);
+     strcat(fname, ".c");
+     if (!strcmp(fname, codefname)) {
+         warning("Include file name conflict! [272]");
+         badinclude();
+         return;
+     }
+     saveoldfile(fname);
+     outf = fopen(fname, "w");
+     if (!outf) {
+         outf = oldfile;
+         perror(fname);
+         badinclude();
+         return;
+     }
+     outf_lnum = 1;
+     if (nobanner)
+ 	output("\n");
+     else
+ 	output(format_ss("\n/* Include file %s from %s */\n\n",
+ 			 fname, codefname));
+     if (blkind == TOK_END)
+         gettok();
+     else
+         curtok = blkind;
+     p_block(blockkind);
+     if (nobanner)
+ 	output("\n");
+     else
+ 	output("\n\n/* End. */\n\n");
+     fclose(outf);
+     outf = oldfile;
+     outf_lnum = savelnum;
+     if (curtok != TOK_EOF) {
+         warning("Junk at end of include file ignored [273]");
+     }
+     outsection(majorspace);
+     if (*includefnfmt)
+ 	out_include(format_s(includefnfmt, fname), 1);
+     else
+ 	out_include(fname, 1);
+     outsection(majorspace);
+     pop_input();
+     p2c_getline();
+     gettok();
+ }
+ 
+ 
+ 
+ 
+ /* blockkind is one of:
+        TOK_PROGRAM:     Global declarations of a program
+        TOK_FUNCTION:    Declarations local to a procedure or function
+        TOK_IMPORT:      Import text read from a module
+        TOK_EXPORT:      Export section of a module
+        TOK_IMPLEMENT:   Implementation section of a module
+        TOK_END:         None of the above
+ */
+ 
+ void p_block(blkind)
+ Token blkind;
+ {
+     Token saveblockkind = blockkind;
+     Token lastblockkind = TOK_END;
+ 
+     blockkind = blkind;
+     for (;;) {
+ 	while (curtok == TOK_INTFONLY) {
+ 	    include_as_import();
+ 	    gettok();
+ 	}
+         if (curtok == TOK_CONST || curtok == TOK_TYPE ||
+ 	    curtok == TOK_VAR || curtok == TOK_VALUE) {
+             while (curtok == TOK_CONST || curtok == TOK_TYPE ||
+ 		   curtok == TOK_VAR || curtok == TOK_VALUE) {
+                 lastblockkind = curtok;
+                 switch (curtok) {
+ 
+                     case TOK_CONST:
+                         p_constdecl();
+                         break;
+ 
+                     case TOK_TYPE:
+                         p_typedecl();
+                         break;
+ 
+                     case TOK_VAR:
+                         p_vardecl();
+                         break;
+ 
+ 		    case TOK_VALUE:
+ 			p_valuedecl();
+ 			break;
+ 
+ 		    default:
+ 			break;
+                 }
+             }
+             if ((blkind == TOK_PROGRAM ||
+                  blkind == TOK_EXPORT ||
+                  blkind == TOK_IMPLEMENT) &&
+                 (curtok != TOK_BEGIN || !mainlocals)) {
+                 outsection(majorspace);
+                 if (declarevars(curctx, 0))
+                     outsection(majorspace);
+             }
+         } else {
+ 	    checkmodulewords();
+ 	    checkkeyword(TOK_SEGMENT);
+ 	    if (curtok == TOK_SEGMENT) {
+ 		note("SEGMENT or OVERLAY keyword ignored [259]");
+ 		gettok();
+ 	    }
+ 	    p_attributes();
+             switch (curtok) {
+ 
+                 case TOK_LABEL:
+                     p_labeldecl();
+                     break;
+ 
+                 case TOK_IMPORT:
+                 case TOK_FROM:
+                     p_import(0);
+                     break;
+ 
+ 		case TOK_EXPORT:
+ 		    do {
+ 			gettok();
+ 			checkkeyword(TOK_QUALIFIED);
+ 			if (curtok == TOK_QUALIFIED)
+ 			    gettok();
+ 			wneedtok(TOK_IDENT);
+ 		    } while (curtok == TOK_COMMA);
+ 		    if (!wneedtok(TOK_SEMI))
+ 			skippasttoken(TOK_SEMI);
+ 		    break;
+ 
+                 case TOK_MODULE:
+ 		    p_nested_module();
+                     break;
+ 
+                 case TOK_PROCEDURE:
+                     p_function(0);
+                     break;
+ 
+                 case TOK_FUNCTION:
+                     p_function(1);
+                     break;
+ 
+                 case TOK_INCLUDE:
+                     if (blockkind == TOK_PROGRAM ||
+                         blockkind == TOK_IMPLEMENT ||
+ 			(blockkind == TOK_FUNCTION && !collectnest)) {
+                         do_include(lastblockkind);
+                     } else {
+                         badinclude();
+                     }
+                     break;
+ 
+                 default:
+ 		    if (curtok == TOK_BEGIN && blockkind == TOK_IMPORT) {
+ 			warning("BEGIN encountered in interface text [274]");
+ 			skipparens();
+ 			if (curtok == TOK_SEMI)
+ 			    gettok();
+ 			break;
+ 		    }
+                     blockkind = saveblockkind;
+                     return;
+             }
+             lastblockkind = TOK_END;
+         }
+     }
+ }
+ 
+ 
+ 
+ 
+ Static void skipunitheader()
+ {
+     if (curtok == TOK_LPAR || curtok == TOK_LBR) {
+ 	skipparens();
+     }
+ }
+ 
+ 
+ Static void skiptomodule()
+ {
+     skipping_module++;
+     while (curtok != TOK_MODULE) {
+         if (curtok == TOK_END) {
+             gettok();
+             if (curtok == TOK_DOT)
+                 break;
+         } else
+             gettok();
+     }
+     skipping_module--;
+ }
+ 
+ 
+ 
+ Static void p_moduleinit(mod)
+ Meaning *mod;
+ {
+     Stmt *sp;
+     Strlist *sl;
+ 
+     if (curtok != TOK_BEGIN && curtok != TOK_END) {
+ 	wexpecttok(TOK_END);
+ 	skiptotoken2(TOK_BEGIN, TOK_END);
+     }
+     if (curtok == TOK_BEGIN || initialcalls) {
+ 	echoprocname(mod);
+ 	sp = p_body();
+ 	strlist_mix(&mod->comments, curcomments);
+ 	curcomments = NULL;
+ 	if (ansiC != 0)
+ 	    output("void ");
+ 	output(format_s(name_UNITINIT, mod->name));
+ 	if (void_args)
+ 	    output("(void)\n");
+ 	else
+ 	    output("()\n");
+ 	outcontext = mod;
+ 	out_block(sp, BR_FUNCTION, 10000);
+ 	free_stmt(sp);
+ 	/* The following must come after out_block! */
+ 	sl = strlist_append(&initialcalls,
+ 			    format_s("%s()",
+ 				     format_s(name_UNITINIT, mod->name)));
+ 	sl->value = 1;
+     } else
+ 	wneedtok(TOK_END);
+ }
+ 
+ 
+ 
+ Static void p_nested_module()
+ {
+     Meaning *mp;
+ 
+     if (!modula2) {
+ 	note("Ignoring nested module [260]");
+ 	p_module(1, 0);
+ 	return;
+     }
+     note("Nested modules not fully supported [261]");
+     checkmodulewords();
+     wneedtok(TOK_MODULE);
+     wexpecttok(TOK_IDENT);
+     mp = addmeaning(curtoksym, MK_MODULE);
+     mp->anyvarflag = 0;
+     gettok();
+     skipunitheader();
+     wneedtok(TOK_SEMI);
+     p_block(TOK_IMPLEMENT);
+     p_moduleinit(mp);
+     if (curtok == TOK_IDENT)
+ 	gettok();
+     wneedtok(TOK_SEMI);
+ }
+ 
+ 
+ 
+ Static int p_module(ignoreit, isdefn)
+ int ignoreit;
+ int isdefn;    /* Modula-2: 0=local module, 1=DEFINITION, 2=IMPLEMENTATION */
+ {
+     Meaning *mod, *mp;
+     Strlist *sl;
+     int kind;
+     char *cp;
+ 
+     checkmodulewords();
+     wneedtok(TOK_MODULE);
+     wexpecttok(TOK_IDENT);
+     if (curtokmeaning && curtokmeaning->kind == MK_MODULE && isdefn == 2) {
+ 	mod = curtokmeaning;
+ 	import_ctx(mod);
+ 	for (mp = mod->cbase; mp; mp = mp->cnext)
+ 	    if (mp->kind == MK_FUNCTION)
+ 		mp->isforward = 1;
+     } else {
+ 	mod = addmeaning(curtoksym, MK_MODULE);
+     }
+     mod->anyvarflag = 0;
+     pushctx(mod);
+     gettok();
+     skipunitheader();
+     wneedtok(TOK_SEMI);
+     if (ignoreit || 
+         (requested_module && strcicmp(requested_module, mod->name))) {
+         if (!quietmode)
+ 	    if (outf == stdout)
+ 		fprintf(stderr, "Skipping over module \"%s\"\n", mod->name);
+ 	    else
+ 		printf("Skipping over module \"%s\"\n", mod->name);
+ 	checkmodulewords();
+         while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+             p_import(1);
+ 	checkmodulewords();
+ 	if (curtok == TOK_EXPORT)
+ 	    gettok();
+         strlist_empty(&curcomments);
+         p_block(TOK_IMPORT);
+         setup_module(mod->sym->name, 0);
+ 	checkmodulewords();
+         if (curtok == TOK_IMPLEMENT) {
+             skiptomodule();
+         } else {
+             if (!wneedtok(TOK_END))
+ 		skippasttoken(TOK_END);
+             if (curtok == TOK_SEMI)
+                 gettok();
+         }
+         popctx();
+         strlist_empty(&curcomments);
+         return 0;
+     }
+     found_module = 1;
+     if (isdefn != 2) {
+ 	if (!*hdrfname) {
+ 	    sl = strlist_cifind(includefrom, mod->name);
+ 	    if (sl)
+ 		cleanheadername(hdrfname, (char *)sl->value);
+ 	    else
+ 		strcpy(hdrfname, format_ss(headerfnfmt, infname, mod->name));
+ 	}
+ 	saveoldfile(hdrfname);
+ 	hdrf = fopen(hdrfname, "w");
+ 	if (!hdrf) {
+ 	    perror(hdrfname);
+ 	    error("Could not open output file for header");
+ 	}
+ 	outsection(majorspace);
+ 	if (usevextern && my_strchr(name_GSYMBOL, '%'))
+ 	    output(format_s("#define %s\n", format_s(name_GSYMBOL, mod->sym->name)));
+ 	if (*selfincludefmt)
+ 	    cp = format_s(selfincludefmt, hdrfname);
+ 	else
+ 	    cp = hdrfname;
+ 	out_include(cp, quoteincludes);
+ 	outsection(majorspace);
+ 	select_outfile(hdrf);
+ 	if (nobanner)
+ 	    output("\n");
+ 	else
+ 	    output(format_s("/* Header for module %s, generated by p2c */\n",
+ 			    mod->name));
+ 	if (*name_HSYMBOL) {
+ 	    cp = format_s(name_HSYMBOL, mod->sym->name);
+ 	    output(format_ss("#ifndef %s\n#define %s\n", cp, cp));
+ 	}
+ 	outsection(majorspace);
+ 	checkmodulewords();
+ 	while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ 	    p_import(0);
+ 	checkmodulewords();
+ 	if (curtok == TOK_EXPORT)
+ 	    gettok();
+ 	checkmodulewords();
+ 	while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ 	    p_import(0);
+ 	outsection(majorspace);
+ 	if (usevextern) {
+ 	    output(format_s("#ifdef %s\n# define vextern\n#else\n",
+ 			    format_s(name_GSYMBOL, mod->sym->name)));
+ 	    output("# define vextern extern\n#endif\n");
+ 	}
+ 	checkmodulewords();
+ 	p_block(TOK_EXPORT);
+ 	flushcomments(NULL, -1, -1);
+ 	setup_module(mod->sym->name, 1);
+ 	outsection(majorspace);
+ 	if (usevextern)
+ 	    output("#undef vextern\n");
+ 	outsection(minorspace);
+ 	if (*name_HSYMBOL)
+ 	    output(format_s("#endif /*%s*/\n", format_s(name_HSYMBOL, mod->sym->name)));
+ 	if (nobanner)
+ 	    output("\n");
+ 	else
+ 	    output("\n/* End. */\n\n");
+ 	select_outfile(codef);
+ 	fclose(hdrf);
+ 	*hdrfname = 0;
+ 	redeclarevars(mod);
+ 	declarevars(mod, 0);
+     }
+     checkmodulewords();
+     if (curtok != TOK_END) {
+ 	if (!modula2 && !implementationmodules)
+ 	    wneedtok(TOK_IMPLEMENT);
+ 	import_ctx(mod);
+         p_block(TOK_IMPLEMENT);
+ 	flushcomments(NULL, -1, -1);
+ 	p_moduleinit(mod);
+         kind = 1;
+     } else {
+         kind = 0;
+         if (!wneedtok(TOK_END))
+ 	    skippasttoken(TOK_END);
+     }
+     if (curtok == TOK_IDENT)
+ 	gettok();
+     if (curtok == TOK_SEMI)
+         gettok();
+     popctx();
+     return kind;
+ }
+ 
+ 
+ 
+ 
+ int p_search(fname, ext, need)
+ char *fname, *ext;
+ int need;
+ {
+     char infnbuf[300];
+     FILE *fp;
+     Meaning *mod;
+     int savesysprog, savecopysource;
+     int outerimportmark, importmark, mypermflag;
+ 
+     strcpy(infnbuf, fname);
+     fixfname(infnbuf, ext);
+     fp = fopen(infnbuf, "r");
+     if (!fp) {
+         if (need)
+             perror(infnbuf);
+ 	if (logf)
+ 	    fprintf(logf, "(Unable to open search file \"%s\")\n", infnbuf);
+         return 0;
+     }
+     flushcomments(NULL, -1, -1);
+     ignore_directives++;
+     savesysprog = sysprog_flag;
+     sysprog_flag |= 3;
+     savecopysource = copysource;
+     copysource = 0;
+     outerimportmark = numimports;   /*obsolete*/
+     importmark = push_imports();
+     clearprogress();
+     push_input_file(fp, infnbuf, 0);
+     do {
+ 	strlist_empty(&curcomments);
+ 	checkmodulewords();
+ 	permflag = 0;
+ 	if (curtok == TOK_DEFINITION) {
+ 	    gettok();
+ 	    checkmodulewords();
+ 	} else if (curtok == TOK_IMPLEMENT && modula2) {
+ 	    gettok();
+ 	    checkmodulewords();
+ 	    warning("IMPLEMENTATION module in search text! [275]");
+ 	}
+         if (!wneedtok(TOK_MODULE))
+ 	    break;
+         if (!wexpecttok(TOK_IDENT))
+ 	    break;
+         mod = addmeaning(curtoksym, MK_MODULE);
+         mod->anyvarflag = 0;
+         if (!quietmode && !showprogress)
+ 	    if (outf == stdout)
+ 		fprintf(stderr, "Reading import text for \"%s\"\n", mod->name);
+ 	    else
+ 		printf("Reading import text for \"%s\"\n", mod->name);
+ 	if (verbose)
+ 	    fprintf(logf, "%s, %d/%d: Reading import text for \"%s\"\n",
+ 		    infname, inf_lnum, outf_lnum, mod->name);
+         pushctx(mod);
+         gettok();
+         skipunitheader();
+         wneedtok(TOK_SEMI);
+ 	mypermflag = permflag;
+         if (debug>0) printf("Found module %s\n", mod->name);
+ 	checkmodulewords();
+         while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+             p_import(1);
+ 	checkmodulewords();
+ 	if (curtok == TOK_EXPORT)
+ 	    gettok();
+         strlist_empty(&curcomments);
+         p_block(TOK_IMPORT);
+         setup_module(mod->sym->name, 0);
+ 	if (mypermflag) {
+ 	    strlist_add(&permimports, mod->sym->name)->value = (long)mod;
+ 	    perm_import(mod);
+ 	}
+ 	checkmodulewords();
+ 	if (curtok == TOK_END) {
+ 	    gettok();
+ 	    if (curtok == TOK_SEMI)
+ 		gettok();
+ 	} else {
+ 	    wexpecttok(TOK_IMPLEMENT);
+ 	    if (importall) {
+ 		skiptomodule();
+             }
+         }
+         popctx();
+     } while (curtok == TOK_MODULE);
+     pop_imports(importmark);
+     unimport(outerimportmark);
+     sysprog_flag = savesysprog;
+     copysource = savecopysource;
+     ignore_directives--;
+     pop_input();
+     strlist_empty(&curcomments);
+     clearprogress();
+     return 1;
+ }
+ 
+ 
+ 
+ 
+ void p_program()
+ {
+     Meaning *prog;
+     Stmt *sp;
+     int nummods, isdefn = 0;
+ 
+     flushcomments(NULL, -1, -1);
+     output(format_s("\n#include %s\n", p2c_h_name));
+     outsection(majorspace);
+     p_attributes();
+     ignore_attributes();
+     checkmodulewords();
+     if (modula2) {
+ 	if (curtok == TOK_MODULE) {
+ 	    curtok = TOK_PROGRAM;
+ 	} else {
+ 	    if (curtok == TOK_DEFINITION) {
+ 		isdefn = 1;
+ 		gettok();
+ 		checkmodulewords();
+ 	    } else if (curtok == TOK_IMPLEMENT) {
+ 		isdefn = 2;
+ 		gettok();
+ 		checkmodulewords();
+ 	    }
+ 	}
+     }
+     switch (curtok) {
+ 
+         case TOK_MODULE:
+ 	    if (implementationmodules)
+ 		isdefn = 2;
+             nummods = 0;
+             while (curtok == TOK_MODULE) {
+                 if (p_module(0, isdefn)) {
+                     nummods++;
+                     if (nummods == 2 && !requested_module)
+                         warning("Multiple modules in one source file may not work correctly [276]");
+                 }
+             }
+ 	    wneedtok(TOK_DOT);
+             break;
+ 
+         default:
+             if (curtok == TOK_PROGRAM) {
+                 gettok();
+                 if (!wexpecttok(TOK_IDENT))
+ 		    skiptotoken(TOK_IDENT);
+                 prog = addmeaning(curtoksym, MK_MODULE);
+                 gettok();
+                 if (curtok == TOK_LPAR) {
+                     while (curtok != TOK_RPAR) {
+                         if (curtok == TOK_IDENT &&
+                             strcicmp(curtokbuf, "INPUT") &&
+                             strcicmp(curtokbuf, "OUTPUT") &&
+ 			    strcicmp(curtokbuf, "KEYBOARD") &&
+ 			    strcicmp(curtokbuf, "LISTING")) {
+ 			    if (literalfilesflag == 2) {
+ 				strlist_add(&literalfiles, curtokbuf);
+ 			    } else
+ 				note(format_s("Unexpected name \"%s\" in program header [262]",
+ 					      curtokcase));
+                         }
+                         gettok();
+                     }
+                     gettok();
+                 }
+ 		if (curtok == TOK_LBR)
+ 		    skipparens();
+                 wneedtok(TOK_SEMI);
+             } else {
+                 prog = addmeaning(findsymbol("program"), MK_MODULE);
+             }
+             prog->anyvarflag = 1;
+             if (requested_module && strcicmp(requested_module, prog->name) &&
+                                     strcicmp(requested_module, "program")) {
+                 for (;;) {
+                     skiptomodule();
+                     if (curtok == TOK_DOT)
+                         break;
+                      (void)p_module(0, 2);
+                 }
+ 		gettok();
+                 break;
+             }
+             pushctx(prog);
+             p_block(TOK_PROGRAM);
+             echoprocname(prog);
+ 	    flushcomments(NULL, -1, -1);
+ 	    if (curtok != TOK_EOF) {
+ 		sp = p_body();
+ 		strlist_mix(&prog->comments, curcomments);
+ 		curcomments = NULL;
+ 		if (fullprototyping > 0) {
+ 		    output(format_sss("main%s(int argc,%s%s *argv[])",
+ 				      spacefuncs ? " " : "",
+ 				      spacecommas ? " " : "",
+ 				      charname));
+ 		} else {
+ 		    output("main");
+ 		    if (spacefuncs)
+ 			output(" ");
+ 		    output("(argc,");
+ 		    if (spacecommas)
+ 			output(" ");
+ 		    output("argv)\n");
+ 		    singleindent(argindent);
+ 		    output("int argc;\n");
+ 		    singleindent(argindent);
+ 		    output(format_s("%s *argv[];\n", charname));
+ 		}
+ 		outcontext = prog;
+ 		out_block(sp, BR_FUNCTION, 10000);
+ 		free_stmt(sp);
+ 		popctx();
+ 		if (curtok == TOK_SEMI)
+ 		    gettok();
+ 		else 
+ 		    wneedtok(TOK_DOT);
+ 	    }
+             break;
+ 
+     }
+     if (curtok != TOK_EOF) {
+         warning("Junk at end of input file ignored [277]");
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,3626 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_PEXPR_C
+ #include "trans.h"
+ 
+ 
+ 
+ 
+ Expr *dots_n_hats(ex, target)
+ Expr *ex;
+ Type *target;
+ {
+     Expr *ex2, *ex3;
+     Type *tp, *tp2;
+     Meaning *mp, *tvar;
+     int hassl;
+ 
+     for (;;) {
+ 	if ((ex->val.type->kind == TK_PROCPTR ||
+ 	     ex->val.type->kind == TK_CPROCPTR) &&
+ 	    curtok != TOK_ASSIGN &&
+ 	    ((mp = (tp2 = ex->val.type)->basetype->fbase) == NULL ||
+ 	     (mp->isreturn && mp->xnext == NULL) ||
+ 	     curtok == TOK_LPAR) &&
+ 	    (tp2->basetype->basetype != tp_void || target == tp_void) &&
+ 	    (!target || (target->kind != TK_PROCPTR &&
+ 			 target->kind != TK_CPROCPTR))) {
+ 	    hassl = tp2->escale;
+ 	    ex2 = ex;
+ 	    ex3 = copyexpr(ex2);
+ 	    if (hassl != 0)
+ 		ex3 = makeexpr_cast(makeexpr_dotq(ex3, "proc", tp_anyptr),
+ 				    makepointertype(tp2->basetype));
+ 	    ex = makeexpr_un(EK_SPCALL, tp2->basetype->basetype, ex3);
+ 	    if (mp && mp->isreturn) {  /* pointer to buffer for return value */
+ 		tvar = makestmttempvar(ex->val.type->basetype,
+ 				       (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+ 		insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
+ 		mp = mp->xnext;
+ 	    }
+ 	    if (mp) {
+ 		if (wneedtok(TOK_LPAR)) {
+ 		    ex = p_funcarglist(ex, mp, 0, 0);
+ 		    skipcloseparen();
+ 		}
+ 	    } else if (curtok == TOK_LPAR) {
+ 		gettok();
+ 		if (!wneedtok(TOK_RPAR))
+ 		    skippasttoken(TOK_RPAR);
+ 	    }
+ 	    if (hassl != 1 || hasstaticlinks == 2) {
+ 		freeexpr(ex2);
+ 	    } else {
+ 		ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+ 		ex3 = copyexpr(ex);
+ 		insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+ 		tp = maketype(TK_FUNCTION);
+ 		tp->basetype = tp2->basetype->basetype;
+ 		tp->fbase = tp2->basetype->fbase;
+ 		tp->issigned = 1;
+ 		ex3->args[0]->val.type = makepointertype(tp);
+ 		ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ 				   ex3, ex);
+ 	    }
+ 	    if (tp2->basetype->fbase &&
+ 		tp2->basetype->fbase->isreturn &&
+ 		tp2->basetype->fbase->kind == MK_VARPARAM)
+ 		ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
+ 	    continue;
+ 	}
+         switch (curtok) {
+ 
+             case TOK_HAT:
+ 	    case TOK_ADDR:
+                 gettok();
+                 ex = makeexpr_hat(ex, 1);
+                 break;
+ 
+             case TOK_LBR:
+                 do {
+                     gettok();
+ 		    ex2 = p_ord_expr();
+ 		    ex = p_index(ex, ex2);
+                 } while (curtok == TOK_COMMA);
+                 if (!wneedtok(TOK_RBR))
+ 		    skippasttotoken(TOK_RBR, TOK_SEMI);
+                 break;
+ 
+             case TOK_DOT:
+                 gettok();
+                 if (!wexpecttok(TOK_IDENT))
+ 		    break;
+ 		if (ex->val.type->kind == TK_STRING) {
+ 		    if (!strcicmp(curtokbuf, "LENGTH")) {
+ 			ex = makeexpr_bicall_1("strlen", tp_int, ex);
+ 		    } else if (!strcicmp(curtokbuf, "BODY")) {
+ 			/* nothing to do */
+ 		    }
+ 		    gettok();
+ 		    break;
+ 		}
+                 mp = curtoksym->fbase;
+                 while (mp && mp->rectype != ex->val.type)
+                     mp = mp->snext;
+                 if (mp)
+                     ex = makeexpr_dot(ex, mp);
+                 else {
+                     warning(format_s("No field called %s in that record [288]", curtokbuf));
+ 		    ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+ 		}
+                 gettok();
+                 break;
+ 
+ 	    case TOK_COLONCOLON:
+ 		gettok();
+ 		if (wexpecttok(TOK_IDENT)) {
+ 		    ex = pascaltypecast(curtokmeaning->type, ex);
+ 		    gettok();
+ 		}
+ 		break;
+ 
+             default:
+                 return ex;
+         }
+     }
+ }
+ 
+ 
+ Expr *p_index(ex, ex2)
+ Expr *ex, *ex2;
+ {
+     Expr *ex3;
+     Type *tp, *ot;
+     Meaning *mp;
+     int bits;
+ 
+     tp = ex->val.type;
+     if (tp->kind == TK_STRING) {
+ 	if (checkconst(ex2, 0))   /* is it "s[0]"? */
+ 	    return makeexpr_bicall_1("strlen", tp_char, ex);
+ 	else
+ 	    return makeexpr_index(ex, ex2, makeexpr_long(1));
+     } else if (tp->kind == TK_ARRAY ||
+ 	       tp->kind == TK_SMALLARRAY) {
+ 	if (tp->smax) {
+ 	    ord_range_expr(tp->indextype, &ex3, NULL);
+ 	    ex2 = makeexpr_minus(ex2, copyexpr(ex3));
+ 	    if (!nodependencies(ex2, 0) &&
+ 		*getbitsname == '*') {
+ 		mp = makestmttempvar(tp_integer, name_TEMP);
+ 		ex3 = makeexpr_assign(makeexpr_var(mp), ex2);
+ 		ex2 = makeexpr_var(mp);
+ 	    } else
+ 		ex3 = NULL;
+ 	    ex = makeexpr_bicall_3(getbitsname, tp_int,
+ 				   ex, ex2,
+ 				   makeexpr_long(tp->escale));
+ 	    if (tp->kind == TK_ARRAY) {
+ 		if (tp->basetype == tp_sshort)
+ 		    bits = 4;
+ 		else
+ 		    bits = 3;
+ 		insertarg(&ex, 3, makeexpr_long(bits));
+ 	    }
+ 	    ex = makeexpr_comma(ex3, ex);
+ 	    ot = ord_type(tp->smax->val.type);
+ 	    if (ot->kind == TK_ENUM && ot->meaning && useenum)
+ 		ex = makeexpr_cast(ex, tp->smax->val.type);
+ 	    ex->val.type = tp->smax->val.type;
+ 	    return ex;
+ 	} else {
+ 	    ord_range_expr(ex->val.type->indextype, &ex3, NULL);
+ 	    if (debug>2) { fprintf(outf, "ord_range_expr returns "); dumpexpr(ex3); fprintf(outf, "\n"); }
+ 	    return makeexpr_index(ex, ex2, copyexpr(ex3));
+ 	}
+     } else {
+ 	warning("Index on a non-array variable [287]");
+ 	return makeexpr_bin(EK_INDEX, tp_integer, ex, ex2);
+     }
+ }
+ 
+ 
+ Expr *fake_dots_n_hats(ex)
+ Expr *ex;
+ {
+     for (;;) {
+         switch (curtok) {
+ 
+             case TOK_HAT:
+ 	    case TOK_ADDR:
+ 	        if (ex->val.type->kind == TK_POINTER)
+ 		    ex = makeexpr_hat(ex, 0);
+ 		else {
+ 		    ex->val.type = makepointertype(ex->val.type);
+ 		    ex = makeexpr_un(EK_HAT, ex->val.type->basetype, ex);
+ 		}
+                 gettok();
+                 break;
+ 
+             case TOK_LBR:
+                 do {
+                     gettok();
+                     ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
+                 } while (curtok == TOK_COMMA);
+                 if (!wneedtok(TOK_RBR))
+ 		    skippasttotoken(TOK_RBR, TOK_SEMI);
+                 break;
+ 
+             case TOK_DOT:
+                 gettok();
+                 if (!wexpecttok(TOK_IDENT))
+ 		    break;
+                 ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+                 gettok();
+                 break;
+ 
+ 	    case TOK_COLONCOLON:
+ 		gettok();
+ 		if (wexpecttok(TOK_IDENT)) {
+ 		    ex = pascaltypecast(curtokmeaning->type, ex);
+ 		    gettok();
+ 		}
+ 		break;
+ 
+             default:
+                 return ex;
+         }
+     }
+ }
+ 
+ 
+ 
+ Static void bindnames(ex)
+ Expr *ex;
+ {
+     int i;
+     Symbol *sp;
+     Meaning *mp;
+ 
+     if (ex->kind == EK_NAME) {
+ 	sp = findsymbol_opt(fixpascalname(ex->val.s));
+ 	if (sp) {
+ 	    mp = sp->mbase;
+ 	    while (mp && !mp->isactive)
+ 		mp = mp->snext;
+ 	    if (mp && !strcmp(mp->name, ex->val.s)) {
+ 		ex->kind = EK_VAR;
+ 		ex->val.i = (long)mp;
+ 		ex->val.type = mp->type;
+ 	    }
+ 	}
+     }
+     i = ex->nargs;
+     while (--i >= 0)
+ 	bindnames(ex->args[i]);
+ }
+ 
+ 
+ 
+ void var_reference(mp)
+ Meaning *mp;
+ {
+     Meaning *mp2;
+ 
+     mp->refcount++;
+     if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
+ 	mp->ctx->needvarstruct &&
+ 	(mp->kind == MK_VAR ||
+ 	 mp->kind == MK_VARREF ||
+ 	 mp->kind == MK_VARMAC ||
+ 	 mp->kind == MK_PARAM ||
+ 	 mp->kind == MK_VARPARAM ||
+ 	 (mp->kind == MK_CONST &&
+ 	  (mp->type->kind == TK_ARRAY ||
+ 	   mp->type->kind == TK_RECORD)))) {
+         if (debug>1) { fprintf(outf, "varstruct'ing %s\n", mp->name); }
+         if (!mp->varstructflag) {
+             mp->varstructflag = 1;
+             if (mp->constdefn &&      /* move init code into function body */
+ 		mp->kind != MK_VARMAC) {
+                 mp2 = addmeaningafter(mp, curtoksym, MK_VAR);
+                 curtoksym->mbase = mp2->snext;  /* hide this fake variable */
+                 mp2->snext = mp;      /* remember true variable */
+                 mp2->type = mp->type;
+                 mp2->constdefn = mp->constdefn;
+                 mp2->isforward = 1;   /* declare it "static" */
+                 mp2->refcount++;      /* so it won't be purged! */
+                 mp->constdefn = NULL;
+                 mp->isforward = 0;
+             }
+         }
+         for (mp2 = curctx->ctx; mp2 != mp->ctx; mp2 = mp2->ctx)
+             mp2->varstructflag = 1;
+         mp2->varstructflag = 1;
+     }
+ }
+ 
+ 
+ 
+ Static Expr *p_variable(target)
+ Type *target;
+ {
+     Expr *ex, *ex2;
+     Meaning *mp;
+     Symbol *sym;
+ 
+     if (curtok != TOK_IDENT) {
+         warning("Expected a variable [289]");
+ 	return makeexpr_long(0);
+     }
+     if (!curtokmeaning) {
+ 	sym = curtoksym;
+         ex = makeexpr_name(curtokcase, tp_integer);
+         gettok();
+         if (curtok == TOK_LPAR) {
+             ex = makeexpr_bicall_0(ex->val.s, tp_integer);
+             do {
+                 gettok();
+                 insertarg(&ex, ex->nargs, p_expr(NULL));
+             } while (curtok == TOK_COMMA || curtok == TOK_ASSIGN);
+             if (!wneedtok(TOK_RPAR))
+ 		skippasttotoken(TOK_RPAR, TOK_SEMI);
+         }
+ 	if (!tryfuncmacro(&ex, NULL))
+ 	    undefsym(sym);
+         return fake_dots_n_hats(ex);
+     }
+     var_reference(curtokmeaning);
+     mp = curtokmeaning;
+     if (mp->kind == MK_FIELD) {
+         ex = makeexpr_dot(copyexpr(withexprs[curtokint]), mp);
+     } else if (mp->kind == MK_CONST &&
+ 	       mp->type->kind == TK_SET &&
+ 	       mp->constdefn) {
+ 	ex = copyexpr(mp->constdefn);
+ 	mp = makestmttempvar(ex->val.type, name_SET);
+         ex2 = makeexpr(EK_MACARG, 0);
+         ex2->val.type = ex->val.type;
+ 	ex = replaceexprexpr(ex, ex2, makeexpr_var(mp), 0);
+         freeexpr(ex2);
+     } else if (mp->kind == MK_CONST &&
+                (mp == mp_false ||
+                 mp == mp_true ||
+                 mp->anyvarflag ||
+                 (foldconsts > 0 &&
+                  (mp->type->kind == TK_INTEGER ||
+                   mp->type->kind == TK_BOOLEAN ||
+                   mp->type->kind == TK_CHAR ||
+                   mp->type->kind == TK_ENUM ||
+                   mp->type->kind == TK_SUBR ||
+                   mp->type->kind == TK_REAL)) ||
+                 (foldstrconsts > 0 &&
+                  (mp->type->kind == TK_STRING)))) {
+         if (mp->constdefn) {
+             ex = copyexpr(mp->constdefn);
+             if (ex->val.type == tp_int)   /* kludge! */
+                 ex->val.type = tp_integer;
+         } else
+             ex = makeexpr_val(copyvalue(mp->val));
+     } else if (mp->kind == MK_VARPARAM ||
+                mp->kind == MK_VARREF) {
+         ex = makeexpr_hat(makeexpr_var(mp), 0);
+     } else if (mp->kind == MK_VARMAC) {
+         ex = copyexpr(mp->constdefn);
+ 	bindnames(ex);
+         ex = gentle_cast(ex, mp->type);
+         ex->val.type = mp->type;
+     } else if (mp->kind == MK_SPVAR && mp->handler) {
+         gettok();
+         ex = (*mp->handler)(mp);
+         return dots_n_hats(ex, target);
+     } else if (mp->kind == MK_VAR ||
+                mp->kind == MK_CONST ||
+                mp->kind == MK_PARAM) {
+         ex = makeexpr_var(mp);
+     } else {
+         symclass(mp->sym);
+         ex = makeexpr_name(mp->name, tp_integer);
+     }
+     gettok();
+     return dots_n_hats(ex, target);
+ }
+ 
+ 
+ 
+ 
+ Expr *p_ord_expr()
+ {
+     return makeexpr_charcast(p_expr(tp_integer));
+ }
+ 
+ 
+ 
+ Static Expr *makesmallsetconst(bits, type)
+ long bits;
+ Type *type;
+ {
+     Expr *ex;
+ 
+     ex = makeexpr_long(bits);
+     ex->val.type = type;
+     if (smallsetconst != 2)
+         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *packset(ex, type)
+ Expr *ex;
+ Type *type;
+ {
+     Meaning *mp;
+     Expr *ex2;
+     long max2;
+ 
+     if (ex->kind == EK_BICALL) {
+         if (!strcmp(ex->val.s, setexpandname) &&
+             (mp = istempvar(ex->args[0])) != NULL) {
+             canceltempvar(mp);
+             return grabarg(ex, 1);
+         }
+         if (!strcmp(ex->val.s, setunionname) &&
+             (mp = istempvar(ex->args[0])) != NULL &&
+             !exproccurs(ex->args[1], ex->args[0]) &&
+             !exproccurs(ex->args[2], ex->args[0])) {
+             canceltempvar(mp);
+             return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
+                                               packset(ex->args[2], type));
+         }
+         if (!strcmp(ex->val.s, setaddname)) {
+             ex2 = makeexpr_bin(EK_LSH, type,
+                                makeexpr_longcast(makeexpr_long(1), 1),
+                                ex->args[1]);
+             ex = packset(ex->args[0], type);
+             if (checkconst(ex, 0))
+                 return ex2;
+             else
+                 return makeexpr_bin(EK_BOR, type, ex, ex2);
+         }
+         if (!strcmp(ex->val.s, setaddrangename)) {
+             if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
+                 note("Range construction was implemented by a subtraction which may overflow [278]");
+             ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
+                                               makeexpr_longcast(makeexpr_long(1), 1),
+                                               makeexpr_plus(ex->args[2],
+                                                             makeexpr_long(1))),
+                                  makeexpr_bin(EK_LSH, type,
+                                               makeexpr_longcast(makeexpr_long(1), 1),
+                                               ex->args[1]));
+             ex = packset(ex->args[0], type);
+             if (checkconst(ex, 0))
+                 return ex2;
+             else
+                 return makeexpr_bin(EK_BOR, type, ex, ex2);
+         }
+     }
+     return makeexpr_bicall_1(setpackname, type, ex);
+ }
+ 
+ 
+ 
+ #define MAXSETLIT 400
+ 
+ Expr *p_setfactor(target, sure)
+ Type *target;
+ int sure;
+ {
+     Expr *ex, *exmax = NULL, *ex2;
+     Expr *first[MAXSETLIT], *last[MAXSETLIT];
+     char doneflag[MAXSETLIT];
+     int i, j, num, donecount;
+     int isconst, guesstype;
+     long maxv, max2;
+     Value val;
+     Type *tp, *type;
+     Meaning *tvar;
+ 
+     if (curtok == TOK_LBRACE)
+ 	gettok();
+     else if (!wneedtok(TOK_LBR))
+ 	return makeexpr_long(0);
+     if (curtok == TOK_RBR || curtok == TOK_RBRACE) {        /* empty set */
+         gettok();
+         val.type = tp_smallset;
+         val.i = 0;
+         val.s = NULL;
+         return makeexpr_val(val);
+     }
+     type = target;
+     guesstype = !sure;
+     maxv = -1;
+     isconst = 1;
+     num = 0;
+     for (;;) {
+         if (num >= MAXSETLIT) {
+             warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
+             ex = p_expr(type);
+             while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
+                 gettok();
+                 ex = p_expr(type);
+             }
+             break;
+         }
+         if (guesstype && num == 0) {
+             ex = p_ord_expr();
+ 	    type = ex->val.type;
+         } else {
+             ex = p_expr(type);
+         }
+         first[num] = ex = gentle_cast(ex, type);
+         doneflag[num] = 0;
+         if (curtok == TOK_DOTS || curtok == TOK_COLON) {   /* UCSD? */
+             val = eval_expr(ex);
+             if (val.type) {
+ 		if (val.i > maxv) {     /* In case of [127..0] */
+ 		    maxv = val.i;
+ 		    exmax = ex;
+ 		}
+ 	    } else
+                 isconst = 0;
+             gettok();
+             last[num] = ex = gentle_cast(p_expr(type), type);
+         } else {
+             last[num] = NULL;
+         }
+         val = eval_expr(ex);
+         if (val.type) {
+             if (val.i > maxv) {
+                 maxv = val.i;
+                 exmax = ex;
+             }
+         } else {
+             isconst = 0;
+             maxv = LONG_MAX;
+         }
+         num++;
+         if (curtok == TOK_COMMA)
+             gettok();
+         else
+             break;
+     }
+     if (curtok == TOK_RBRACE)
+ 	gettok();
+     else if (!wneedtok(TOK_RBR))
+ 	skippasttotoken(TOK_RBR, TOK_SEMI);
+     tp = first[0]->val.type;
+     if (guesstype) {      /* must determine type */
+         if (maxv == LONG_MAX) {
+ 	    if (target && ord_range(target, NULL, &max2))
+ 		maxv = max2;
+             else if (ord_range(tp, NULL, &max2) && max2 < 1000000 &&
+ 		     (max2 >= defaultsetsize || num == 1))
+                 maxv = max2;
+ 	    else
+ 		maxv = defaultsetsize-1;
+             exmax = makeexpr_long(maxv);
+         } else
+             exmax = copyexpr(exmax);
+         if (!ord_range(tp, NULL, &max2) || maxv != max2)
+             tp = makesubrangetype(tp, makeexpr_long(0), exmax);
+         type = makesettype(tp);
+     } else
+ 	type = makesettype(type);
+     donecount = 0;
+     if (smallsetconst > 0) {
+         val.i = 0;
+         for (i = 0; i < num; i++) {
+             if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
+                 (!last[i] || (last[i]->kind == EK_CONST &&
+                               last[i]->val.i >= 0 &&
+                               last[i]->val.i < setbits))) {
+                 if (last[i]) {
+                     for (j = first[i]->val.i; j <= last[i]->val.i; j++)
+                         val.i |= 1<<j;
+                 } else
+ 		    val.i |= 1 << first[i]->val.i;
+                 doneflag[i] = 1;
+                 donecount++;
+             }
+         }
+     }
+     if (donecount) {
+         ex = makesmallsetconst(val.i, tp_smallset);
+     } else
+         ex = NULL;
+     if (type->kind == TK_SMALLSET) {
+         for (i = 0; i < num; i++) {
+             if (!doneflag[i]) {
+                 ex2 = makeexpr_bin(EK_LSH, type,
+ 				   makeexpr_longcast(makeexpr_long(1), 1),
+ 				   enum_to_int(first[i]));
+                 if (last[i]) {
+                     if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
+                         note("Range construction was implemented by a subtraction which may overflow [278]");
+                     ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
+                                                       makeexpr_longcast(makeexpr_long(1), 1),
+                                                       makeexpr_plus(enum_to_int(last[i]),
+                                                                     makeexpr_long(1))),
+                                          ex2);
+                 }
+                 if (ex)
+                     ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
+                 else
+                     ex = ex2;
+             }
+         }
+     } else {
+         tvar = makestmttempvar(type, name_SET);
+         if (!ex) {
+             val.type = tp_smallset;
+ 	    val.i = 0;
+ 	    val.s = NULL;
+ 	    ex = makeexpr_val(val);
+ 	}
+         ex = makeexpr_bicall_2(setexpandname, type,
+                                makeexpr_var(tvar), makeexpr_arglong(ex, 1));
+         for (i = 0; i < num; i++) {
+             if (!doneflag[i]) {
+                 if (last[i])
+                     ex = makeexpr_bicall_3(setaddrangename, type,
+                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0),
+                                                makeexpr_arglong(enum_to_int(last[i]), 0));
+                 else
+                     ex = makeexpr_bicall_2(setaddname, type,
+                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0));
+             }
+         }
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Expr *p_funcarglist(ex, args, firstarg, ismacro)
+ Expr *ex;
+ Meaning *args;
+ int firstarg, ismacro;
+ {
+     Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
+     Expr *ex2;
+     int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
+     Type *tp, *tp2;
+     char *name;
+ 
+     castit = castargs;
+     if (castit < 0)
+ 	castit = (prototypes == 0);
+     while (args) {
+ 	if (isnonpos) {
+ 	    while (curtok == TOK_COMMA)
+ 		gettok();
+ 	    if (curtok == TOK_RPAR) {
+ 		args = arglist;
+ 		i = firstarg;
+ 		while (args) {
+ 		    if (ex->nargs <= i)
+ 			insertarg(&ex, ex->nargs, NULL);
+ 		    if (!ex->args[i]) {
+ 			if (args->constdefn)
+ 			    ex->args[i] = copyexpr(args->constdefn);
+ 			else {
+ 			    warning(format_s("Missing value for parameter %s [291]",
+ 					     args->name));
+ 			    ex->args[i] = makeexpr_long(0);
+ 			}
+ 		    }
+ 		    args = args->xnext;
+ 		    i++;
+ 		}
+ 		break;
+ 	    }
+ 	}
+ 	if (args->isreturn || args->fakeparam) {
+ 	    if (args->fakeparam) {
+ 		if (fakenum < 0)
+ 		    fakenum = ex->nargs;
+ 		if (args->constdefn)
+ 		    insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ 		else
+ 		    insertarg(&ex, ex->nargs, makeexpr_long(0));
+ 	    }
+ 	    args = args->xnext;     /* return value parameter */
+ 	    continue;
+ 	}
+ 	if (curtok == TOK_RPAR) {
+ 	    if (args->constdefn) {
+ 		insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ 		args = args->xnext;
+ 		continue;
+ 	    } else {
+ 		if (ex->kind == EK_FUNCTION) {
+ 		    name = ((Meaning *)ex->val.i)->name;
+ 		    ex->kind = EK_BICALL;
+ 		    ex->val.s = stralloc(name);
+ 		} else
+ 		    name = "function";
+ 		warning(format_s("Too few arguments for %s [292]", name));
+ 		return ex;
+ 	    }
+ 	}
+ 	if (curtok == TOK_COMMA) {
+ 	    if (args->constdefn)
+ 		insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ 	    else {
+ 		warning(format_s("Missing parameter %s [293]", args->name));
+ 		insertarg(&ex, ex->nargs, makeexpr_long(0));
+ 	    }
+ 	    gettok();
+ 	    args = args->xnext;
+ 	    continue;
+ 	}
+ 	p_mech_spec(0);
+ 	if (curtok == TOK_IDENT) {
+ 	    mp = arglist;
+ 	    mp2 = NULL;
+ 	    i = firstarg;
+ 	    fi = -1;
+ 	    while (mp && strcmp(curtokbuf, mp->sym->name)) {
+ 		if (mp->fakeparam) {
+ 		    if (fi < 0)
+ 			fi = i;
+ 		} else
+ 		    fi = -1;
+ 		i++;
+ 		mp2 = mp;
+ 		mp = mp->xnext;
+ 	    }
+ 	    if (mp &&
+ 		(peeknextchar() == ':' || !curtokmeaning || isnonpos)) {
+ 		gettok();
+ 		wneedtok(TOK_ASSIGN);
+ 		prevarg = mp2;
+ 		args = mp;
+ 		fakenum = fi;
+ 		isnonpos = 1;
+ 	    } else
+ 		i = ex->nargs;
+ 	} else
+ 	    i = ex->nargs;
+ 	while (ex->nargs <= i)
+ 	    insertarg(&ex, ex->nargs, NULL);
+ 	if (ex->args[i])
+ 	    warning(format_s("Multiple values for parameter %s [294]",
+ 			     args->name));
+ 	tp = args->type;
+ 	ex2 = p_expr(tp);
+ 	if (args->kind == MK_VARPARAM)
+ 	    tp = tp->basetype;
+ 	if (isfiletype(tp, 1) && is_std_file(ex2)) {
+ 	    mp2 = makestmttempvar(tp_bigtext, name_TEMP);
+ 	    ex2 = makeexpr_comma(
+ 		   makeexpr_comma(makeexpr_assign(filebasename(makeexpr_var(mp2)),
+ 						  ex2),
+ 				  makeexpr_assign(filenamepart(makeexpr_var(mp2)),
+ 						  makeexpr_string(""))),
+ 				 makeexpr_var(mp2));
+ 	}
+ 	tp2 = ex2->val.type;
+ 	isconf = ((tp->kind == TK_ARRAY ||
+ 		   tp->kind == TK_STRING) && tp->structdefd);
+         switch (args->kind) {
+ 
+             case MK_PARAM:
+ 	        if (castit && tp->kind == TK_REAL &&
+ 		    ex2->val.type->kind != TK_REAL)
+                     ex2 = makeexpr_cast(ex2, tp);
+                 else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
+                     ex2 = makeexpr_arglong(ex2, long_type(tp));
+                 else if (args->othername && args->rectype != tp &&
+                          tp->kind != TK_STRING && args->type == tp2)
+                     ex2 = makeexpr_addr(ex2);
+                 else
+                     ex2 = gentle_cast(ex2, tp);
+ 		ex->args[i] = ex2;
+                 break;
+ 
+             case MK_VARPARAM:
+                 if (args->type == tp_strptr && args->anyvarflag) {
+ 		    ex->args[i] = strmax_func(ex2);
+                     insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
+ 		    if (isnonpos)
+ 			note("Non-positional conformant parameters may not work [279]");
+                 } else {                        /* regular VAR parameter */
+ 		    if (!expr_is_lvalue(ex2) ||
+ 			(tp->kind == TK_REAL &&
+ 			 ord_type(tp2)->kind == TK_INTEGER)) {
+ 			mp2 = makestmttempvar(tp, name_TEMP);
+ 			ex2 = makeexpr_comma(makeexpr_assign(makeexpr_var(mp2),
+ 							     ex2),
+ 					     makeexpr_addrf(makeexpr_var(mp2)));
+ 		    } else
+ 			ex2 = makeexpr_addrf(ex2);
+                     if (args->anyvarflag ||
+                         (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
+                          (tp == tp_anyptr || tp2 == tp_anyptr))) {
+ 			if (!ismacro)
+ 			    ex2 = makeexpr_cast(ex2, args->type);
+                     } else {
+                         if (tp2 != tp && !isconf &&
+ 			    (tp2->kind != TK_STRING ||
+ 			     tp->kind != TK_STRING))
+                             warning(format_s("Type mismatch in VAR parameter %s [295]",
+                                              args->name));
+                     }
+ 		    ex->args[i] = ex2;
+                 }
+                 break;
+ 
+ 	    default:
+ 		intwarning("p_funcarglist",
+ 			   format_s("Parameter type is %s [296]",
+ 				    meaningkindname(args->kind)));
+ 		break;
+         }
+ 	if (isconf &&   /* conformant array or string */
+ 	    (!prevarg || prevarg->type != args->type)) {
+ 	    while (tp->kind == TK_ARRAY && tp->structdefd) {
+ 		if (tp2->kind == TK_SMALLARRAY) {
+ 		    warning("Trying to pass a small-array for a conformant array [297]");
+ 		    /* this has a chance of working... */
+ 		    ex->args[ex->nargs-1] =
+ 			makeexpr_addr(ex->args[ex->nargs-1]);
+ 		} else if (tp2->kind == TK_STRING) {
+ 		    ex->args[fakenum++] =
+ 			makeexpr_arglong(makeexpr_long(1), integer16 == 0);
+ 		    ex->args[fakenum++] =
+ 			makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
+ 					 integer16 == 0);
+ 		    break;
+ 	        } else if (tp2->kind != TK_ARRAY) {
+ 		    warning("Type mismatch for conformant array [298]");
+ 		    break;
+ 		}
+ 		ex->args[fakenum++] =
+ 		    makeexpr_arglong(copyexpr(tp2->indextype->smin),
+ 				     integer16 == 0);
+ 		ex->args[fakenum++] =
+ 		    makeexpr_arglong(copyexpr(tp2->indextype->smax),
+ 				     integer16 == 0);
+ 		tp = tp->basetype;
+ 		tp2 = tp2->basetype;
+ 	    }
+ 	    if (tp->kind == TK_STRING && tp->structdefd) {
+ 		ex->args[fakenum] =
+ 		    makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
+ 				     integer16 == 0);
+ 	    }
+ 	}
+ 	fakenum = -1;
+ 	if (!isnonpos) {
+ 	    prevarg = args;
+ 	    args = args->xnext;
+ 	    if (args) {
+ 		if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
+ 		    skiptotoken2(TOK_RPAR, TOK_SEMI);
+ 	    }
+ 	}
+     }
+     if (curtok == TOK_COMMA) {
+ 	if (ex->kind == EK_FUNCTION) {
+ 	    name = ((Meaning *)ex->val.i)->name;
+ 	    ex->kind = EK_BICALL;
+ 	    ex->val.s = stralloc(name);
+ 	} else
+ 	    name = "function";
+ 	warning(format_s("Too many arguments for %s [299]", name));
+ 	while (curtok == TOK_COMMA) {
+ 	    gettok();
+ 	    insertarg(&ex, ex->nargs, p_expr(tp_integer));
+ 	}
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ Expr *replacemacargs(ex, fex)
+ Expr *ex, *fex;
+ {
+     int i;
+     Expr *ex2;
+ 
+     for (i = 0; i < ex->nargs; i++)
+         ex->args[i] = replacemacargs(ex->args[i], fex);
+     if (ex->kind == EK_MACARG) {
+ 	if (ex->val.i <= fex->nargs) {
+ 	    ex2 = copyexpr(fex->args[ex->val.i - 1]);
+ 	} else {
+ 	    ex2 = makeexpr_name("<meef>", tp_integer);
+ 	    note("FuncMacro specified more arguments than call [280]");
+ 	}
+ 	freeexpr(ex);
+ 	return ex2;
+     }
+     return resimplify(ex);
+ }
+ 
+ 
+ Expr *p_noarglist(ex, mp, args)
+ Expr *ex;
+ Meaning *mp, *args;
+ {
+     while (args && args->constdefn) {
+ 	insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ 	args = args->xnext;
+     }
+     if (args) {
+ 	warning(format_s("Expected an argument list for %s [300]", mp->name));
+ 	ex->kind = EK_BICALL;
+ 	ex->val.s = stralloc(mp->name);
+     }
+     return ex;
+ }
+ 
+ 
+ void func_reference(func)
+ Meaning *func;
+ {
+     Meaning *mp;
+ 
+     if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
+ 	func->ctx->varstructflag && !curctx->ctx->varstructflag) {
+ 	for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
+ 	    mp->varstructflag = 1;
+     }
+ }
+ 
+ 
+ Expr *p_funccall(mp)
+ Meaning *mp;
+ {
+     Meaning *mp2, *tvar;
+     Expr *ex, *ex2;
+     int firstarg = 0;
+ 
+     func_reference(mp);
+     ex = makeexpr(EK_FUNCTION, 0);
+     ex->val.i = (long)mp;
+     ex->val.type = mp->type->basetype;
+     mp2 = mp->type->fbase;
+     if (mp2 && mp2->isreturn) {    /* pointer to buffer for return value */
+         tvar = makestmttempvar(ex->val.type->basetype,
+             (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+         insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
+         mp2 = mp2->xnext;
+ 	firstarg++;
+     }
+     if (mp2 && curtok != TOK_LPAR) {
+ 	ex = p_noarglist(ex, mp, mp2);
+     } else if (curtok == TOK_LPAR) {
+ 	gettok();
+         ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
+         skipcloseparen();
+     }
+     if (mp->constdefn) {
+         ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
+ 	ex2 = gentle_cast(ex2, ex->val.type);
+ 	ex2->val.type = ex->val.type;
+         freeexpr(ex);
+         return ex2;
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ Expr *accumulate_strlit()
+ {
+     char buf[256], ch, *cp, *cp2;
+     int len, i, danger = 0;
+ 
+     len = 0;
+     cp = buf;
+     for (;;) {
+         if (curtok == TOK_STRLIT) {
+             cp2 = curtokbuf;
+             i = curtokint;
+             while (--i >= 0) {
+                 if (++len <= 255) {
+                     ch = *cp++ = *cp2++;
+                     if (ch & 128)
+                         danger++;
+                 }
+             }
+         } else if (curtok == TOK_HAT) {    /* Turbo */
+             i = getchartok() & 0x1f;
+             if (++len <= 255)
+                 *cp++ = i;
+ 	} else if (curtok == TOK_LPAR) {   /* VAX */
+ 	    Value val;
+ 	    do {
+ 		gettok();
+ 		val = p_constant(tp_integer);
+ 		if (++len <= 255)
+ 		    *cp++ = val.i;
+ 	    } while (curtok == TOK_COMMA);
+ 	    skipcloseparen();
+ 	    continue;
+         } else
+             break;
+         gettok();
+     }
+     if (len > 255) {
+         warning("String literal too long [301]");
+         len = 255;
+     }
+     if (danger &&
+         !(unsignedchar == 1 ||
+           (unsignedchar != 0 && signedchars == 0)))
+         note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
+     return makeexpr_lstring(buf, len);
+ }
+ 
+ 
+ 
+ Expr *pascaltypecast(type, ex2)
+ Type *type;
+ Expr *ex2;
+ {
+     if (type->kind == TK_POINTER || type->kind == TK_STRING ||
+ 	type->kind == TK_ARRAY)
+ 	ex2 = makeexpr_stringcast(ex2);
+     else
+ 	ex2 = makeexpr_charcast(ex2);
+     if ((ex2->val.type->kind == TK_INTEGER ||
+ 	 ex2->val.type->kind == TK_CHAR ||
+ 	 ex2->val.type->kind == TK_BOOLEAN ||
+ 	 ex2->val.type->kind == TK_ENUM ||
+ 	 ex2->val.type->kind == TK_SUBR ||
+ 	 ex2->val.type->kind == TK_REAL ||
+ 	 ex2->val.type->kind == TK_POINTER ||
+ 	 ex2->val.type->kind == TK_STRING) &&
+ 	(type->kind == TK_INTEGER ||
+ 	 type->kind == TK_CHAR ||
+ 	 type->kind == TK_BOOLEAN ||
+ 	 type->kind == TK_ENUM ||
+ 	 type->kind == TK_SUBR ||
+ 	 type->kind == TK_REAL ||
+ 	 type->kind == TK_POINTER)) {
+ 	if (type->kind == TK_POINTER || ex2->val.type->kind == TK_POINTER)
+ 	    return makeexpr_un(EK_CAST, type, ex2);
+ 	else
+ 	    return makeexpr_un(EK_ACTCAST, type, ex2);
+     } else {
+ 	return makeexpr_hat(makeexpr_cast(makeexpr_addr(ex2),
+ 					  makepointertype(type)), 0);
+     }
+ }
+ 
+ 
+ 
+ 
+ Static Expr *p_factor(target)
+ Type *target;
+ {
+     Expr *ex, *ex2;
+     Type *type;
+     Meaning *mp, *mp2;
+ 
+     switch (curtok) {
+ 
+         case TOK_INTLIT:
+             ex = makeexpr_long(curtokint);
+             gettok();
+             return ex;
+ 
+         case TOK_HEXLIT:
+             ex = makeexpr_long(curtokint);
+             insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+             gettok();
+             return ex;
+ 
+         case TOK_OCTLIT:
+             ex = makeexpr_long(curtokint);
+             insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
+             gettok();
+             return ex;
+ 
+         case TOK_MININT:
+ 	    strcat(curtokbuf, ".0");
+ 
+ 	/* fall through */
+         case TOK_REALLIT:
+             ex = makeexpr_real(curtokbuf);
+             gettok();
+             return ex;
+ 
+         case TOK_HAT:
+         case TOK_STRLIT:
+             ex = accumulate_strlit();
+             return ex;
+ 
+         case TOK_LPAR:
+             gettok();
+             ex = p_expr(target);
+             skipcloseparen();
+             return dots_n_hats(ex, target);
+ 
+         case TOK_NOT:
+ 	case TOK_TWIDDLE:
+             gettok();
+             ex = p_factor(tp_integer);
+             if (ord_type(ex->val.type)->kind == TK_INTEGER)
+                 return makeexpr_un(EK_BNOT, tp_integer, ex);
+             else
+                 return makeexpr_not(ex);
+ 
+ 	case TOK_MINUS:
+ 	    gettok();
+             if (curtok == TOK_MININT) {
+                 gettok();
+                 return makeexpr_long(MININT);
+             } else
+ 		return makeexpr_neg(p_factor(target));
+ 	    
+         case TOK_PLUS:
+ 	    gettok();
+ 	    return p_factor(target);
+ 
+         case TOK_ADDR:
+             gettok();
+ 	    if (curtok == TOK_ADDR) {
+ 		gettok();
+ 		ex = p_factor(tp_proc);
+ 		if (ex->val.type->kind == TK_PROCPTR && ex->kind == EK_COMMA)
+ 		    return grabarg(grabarg(grabarg(ex, 0), 1), 0);
+ 		if (ex->val.type->kind != TK_CPROCPTR)
+ 		    warning("@@ allowed only for procedure pointers [302]");
+ 		return makeexpr_addrf(ex);
+ 	    }
+             if (curtok == TOK_IDENT && 0 &&  /***/
+                 curtokmeaning && (curtokmeaning->kind == MK_FUNCTION ||
+                                   curtokmeaning->kind == MK_SPECIAL)) {
+                 if (curtokmeaning->ctx == nullctx)
+                     warning(format_s("Can't take address of predefined object %s [303]",
+                                      curtokmeaning->name));
+                 ex = makeexpr_name(curtokmeaning->name, tp_anyptr);
+                 gettok();
+             } else {
+ 		ex = p_factor(tp_proc);
+ 		if (ex->val.type->kind == TK_PROCPTR) {
+ 		  /*  ex = makeexpr_dotq(ex, "proc", tp_anyptr);  */
+ 		} else if (ex->val.type->kind == TK_CPROCPTR) {
+ 		    ex = makeexpr_cast(ex, tp_anyptr);
+ 		} else
+ 		    ex = makeexpr_addrf(ex);
+             }
+             return ex;
+ 
+         case TOK_LBR:
+ 	case TOK_LBRACE:
+             return p_setfactor(target && target->kind == TK_SET
+ 			       ? target->indextype : NULL, 0);
+ 
+         case TOK_NIL:
+             gettok();
+             return makeexpr_nil();
+ 
+ 	case TOK_IF:    /* nifty Pascal extension */
+ 	    gettok();
+ 	    ex = p_expr(tp_boolean);
+ 	    wneedtok(TOK_THEN);
+ 	    ex2 = p_expr(tp_integer);
+ 	    if (wneedtok(TOK_ELSE))
+ 		return makeexpr_cond(ex, ex2, p_factor(ex2->val.type));
+ 	    else
+ 		return makeexpr_cond(ex, ex2, makeexpr_long(0));
+ 
+         case TOK_IDENT:
+             mp = curtokmeaning;
+             switch ((mp) ? mp->kind : MK_VAR) {
+ 
+                 case MK_TYPE:
+                     gettok();
+                     type = mp->type;
+                     switch (curtok) {
+ 
+                         case TOK_LPAR:    /* Turbo type cast */
+                             gettok();
+                             ex2 = p_expr(type);
+ 			    ex = pascaltypecast(type, ex2);
+                             skipcloseparen();
+                             return dots_n_hats(ex, target);
+ 
+                         case TOK_LBR:
+ 			case TOK_LBRACE:
+                             switch (type->kind) {
+ 
+                                 case TK_SET:
+                                 case TK_SMALLSET:
+                                     return p_setfactor(type->indextype, 1);
+ 
+                                 case TK_RECORD:
+                                     return p_constrecord(type, 0);
+ 
+                                 case TK_ARRAY:
+                                 case TK_SMALLARRAY:
+                                     return p_constarray(type, 0);
+ 
+                                 case TK_STRING:
+                                     return p_conststring(type, 0);
+ 
+                                 default:
+                                     warning("Bad type for constructor [304]");
+ 				    skipparens();
+ 				    return makeexpr_name(mp->name, mp->type);
+                             }
+ 
+ 			default:
+ 			    wexpected("an expression");
+ 			    return makeexpr_name(mp->name, mp->type);
+                     }
+ 
+                 case MK_SPECIAL:
+                     if (mp->handler && mp->isfunction &&
+ 			(curtok == TOK_LPAR || !target ||
+ 			 (target->kind != TK_PROCPTR &&
+ 			  target->kind != TK_CPROCPTR))) {
+                         gettok();
+                         if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
+                             ex = makeexpr_bicall_0(mp->name, tp_integer);
+                             if (curtok == TOK_LPAR) {
+                                 do {
+                                     gettok();
+                                     insertarg(&ex, ex->nargs, p_expr(NULL));
+                                 } while (curtok == TOK_COMMA);
+                                 skipcloseparen();
+                             }
+                             tryfuncmacro(&ex, mp);
+ 			    return ex;
+                         }
+                         ex = (*mp->handler)(mp);
+ 			if (!ex)
+ 			    ex = makeexpr_long(0);
+ 			return ex;
+                     } else {
+ 			if (target &&
+ 			    (target->kind == TK_PROCPTR ||
+ 			     target->kind == TK_CPROCPTR))
+ 			    note("Using a built-in procedure as a procedure pointer [316]");
+                         else
+ 			    symclass(curtoksym);
+                         gettok();
+                         return makeexpr_name(mp->name, tp_integer);
+                     }
+ 
+                 case MK_FUNCTION:
+                     mp->refcount++;
+                     need_forward_decl(mp);
+ 		    gettok();
+                     if (mp->isfunction &&
+ 			(curtok == TOK_LPAR || !target ||
+ 			 (target->kind != TK_PROCPTR &&
+ 			  target->kind != TK_CPROCPTR))) {
+                         ex = p_funccall(mp);
+                         if (!mp->constdefn) {
+                             if (mp->handler && !(mp->sym->flags & LEAVEALONE))
+                                 ex = (*mp->handler)(ex);
+ 			}
+ 			if (mp->cbase->kind == MK_VARPARAM) {
+ 			    ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
+                         }
+                         return dots_n_hats(ex, target);
+                     } else {
+ 			if (mp->handler && !(mp->sym->flags & LEAVEALONE))
+ 			    note("Using a built-in procedure as a procedure pointer [316]");
+ 			if (target && target->kind == TK_CPROCPTR) {
+ 			    type = maketype(TK_CPROCPTR);
+ 			    type->basetype = mp->type;
+ 			    type->escale = 0;
+ 			    mp2 = makestmttempvar(type, name_TEMP);
+ 			    ex = makeexpr_comma(
+                                     makeexpr_assign(
+                                        makeexpr_var(mp2),
+ 				       makeexpr_name(mp->name, tp_text)),
+ 				    makeexpr_var(mp2));
+ 			    if (mp->ctx->kind == MK_FUNCTION)
+ 				warning("Procedure pointer to nested procedure [305]");
+ 			} else {
+ 			    type = maketype(TK_PROCPTR);
+ 			    type->basetype = mp->type;
+ 			    type->escale = 1;
+ 			    mp2 = makestmttempvar(type, name_TEMP);
+ 			    ex = makeexpr_comma(
+                                     makeexpr_comma(
+                                        makeexpr_assign(
+                                           makeexpr_dotq(makeexpr_var(mp2),
+ 							"proc",
+ 							tp_anyptr),
+ 					  makeexpr_name(mp->name, tp_text)),
+                                           /* handy pointer type */
+ 				       makeexpr_assign(
+                                           makeexpr_dotq(makeexpr_var(mp2),
+ 							"link",
+ 							tp_anyptr),
+ 				          makeexpr_ctx(mp->ctx))),
+ 				    makeexpr_var(mp2));
+ 			}
+                         return ex;
+                     }
+ 
+                 default:
+                     return p_variable(target);
+             }
+ 
+ 	default:
+ 	    wexpected("an expression");
+ 	    return makeexpr_long(0);
+ 	    
+     }
+ }
+ 
+ 
+ 
+ 
+ Static Expr *p_powterm(target)
+ Type *target;
+ {
+     Expr *ex = p_factor(target);
+     Expr *ex2;
+     int i, castit;
+     long v;
+ 
+     if (curtok == TOK_STARSTAR) {
+ 	gettok();
+ 	ex2 = p_powterm(target);
+ 	if (ex->val.type->kind == TK_REAL ||
+ 	    ex2->val.type->kind == TK_REAL) {
+ 	    if (checkconst(ex2, 2)) {
+ 		ex = makeexpr_sqr(ex, 0);
+ 	    } else if (checkconst(ex2, 3)) {
+ 		ex = makeexpr_sqr(ex, 1);
+ 	    } else {
+ 		castit = castargs >= 0 ? castargs : (prototypes == 0);
+ 		if (ex->val.type->kind != TK_REAL && castit)
+ 		    ex = makeexpr_cast(ex, tp_longreal);
+ 		if (ex2->val.type->kind != TK_REAL && castit)
+ 		    ex2 = makeexpr_cast(ex2, tp_longreal);
+ 		ex = makeexpr_bicall_2("pow", tp_longreal, ex, ex2);
+ 	    }
+ 	} else if (checkconst(ex, 2)) {
+ 	    freeexpr(ex);
+ 	    ex = makeexpr_bin(EK_LSH, tp_integer,
+ 			      makeexpr_longcast(makeexpr_long(1), 1), ex2);
+ 	} else if (checkconst(ex, 0) ||
+ 		   checkconst(ex, 1) ||
+ 		   checkconst(ex2, 1)) {
+ 	    freeexpr(ex2);
+ 	} else if (checkconst(ex2, 0)) {
+ 	    freeexpr(ex);
+ 	    freeexpr(ex2);
+ 	    ex = makeexpr_long(1);
+ 	} else if (isliteralconst(ex, NULL) == 2 &&
+ 		   isliteralconst(ex2, NULL) == 2 &&
+ 		   ex2->val.i > 0) {
+ 	    v = ex->val.i;
+ 	    i = ex2->val.i;
+ 	    while (--i > 0)
+ 		v *= ex->val.i;
+ 	    freeexpr(ex);
+ 	    freeexpr(ex2);
+ 	    ex = makeexpr_long(v);
+ 	} else if (checkconst(ex2, 2)) {
+ 	    ex = makeexpr_sqr(ex, 0);
+ 	} else if (checkconst(ex2, 3)) {
+ 	    ex = makeexpr_sqr(ex, 1);
+ 	} else {
+ 	    ex = makeexpr_bicall_2("ipow", tp_integer,
+ 				   makeexpr_arglong(ex, 1),
+ 				   makeexpr_arglong(ex2, 1));
+ 	}
+     }
+     return ex;
+ }
+ 
+ 
+ Static Expr *p_term(target)
+ Type *target;
+ {
+     Expr *ex = p_powterm(target);
+     Expr *ex2;
+     Type *type;
+     Meaning *tvar;
+     int useshort;
+ 
+     for (;;) {
+ 	checkkeyword(TOK_SHL);
+ 	checkkeyword(TOK_SHR);
+ 	checkkeyword(TOK_REM);
+         switch (curtok) {
+ 
+             case TOK_STAR:
+                 gettok();
+                 if (ex->val.type->kind == TK_SET ||
+                     ex->val.type->kind == TK_SMALLSET) {
+                     ex2 = p_powterm(ex->val.type);
+                     type = mixsets(&ex, &ex2);
+                     if (type->kind == TK_SMALLSET) {
+                         ex = makeexpr_bin(EK_BAND, type, ex, ex2);
+                     } else {
+                         tvar = makestmttempvar(type, name_SET);
+                         ex = makeexpr_bicall_3(setintname, type,
+                                                makeexpr_var(tvar),
+                                                ex, ex2);
+                     }
+                 } else
+                     ex = makeexpr_times(ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_SLASH:
+                 gettok();
+                 if (ex->val.type->kind == TK_SET ||
+                     ex->val.type->kind == TK_SMALLSET) {
+                     ex2 = p_powterm(ex->val.type);
+                     type = mixsets(&ex, &ex2);
+                     if (type->kind == TK_SMALLSET) {
+                         ex = makeexpr_bin(EK_BXOR, type, ex, ex2);
+                     } else {
+                         tvar = makestmttempvar(type, name_SET);
+                         ex = makeexpr_bicall_3(setxorname, type,
+                                                makeexpr_var(tvar),
+                                                ex, ex2);
+                     }
+ 		} else
+ 		    ex = makeexpr_divide(ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_DIV:
+                 gettok();
+                 ex = makeexpr_div(ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_REM:
+                 gettok();
+                 ex = makeexpr_rem(ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_MOD:
+                 gettok();
+                 ex = makeexpr_mod(ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_AND:
+ 	    case TOK_AMP:
+ 		useshort = (curtok == TOK_AMP);
+                 gettok();
+                 ex2 = p_powterm(tp_integer);
+                 if (ord_type(ex->val.type)->kind == TK_INTEGER)
+                     ex = makeexpr_bin(EK_BAND, ex->val.type, ex, ex2);
+                 else if (partial_eval_flag || useshort ||
+                          (shortopt && nosideeffects(ex2, 1)))
+                     ex = makeexpr_and(ex, ex2);
+                 else
+                     ex = makeexpr_bin(EK_BAND, tp_boolean, ex, ex2);
+                 break;
+ 
+             case TOK_SHL:
+                 gettok();
+                 ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_powterm(tp_integer));
+                 break;
+ 
+             case TOK_SHR:
+                 gettok();
+                 ex = force_unsigned(ex);
+                 ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_powterm(tp_integer));
+                 break;
+ 
+             default:
+                 return ex;
+         }
+     }
+ }
+ 
+ 
+ 
+ Static Expr *p_sexpr(target)
+ Type *target;
+ {
+     Expr *ex, *ex2;
+     Type *type;
+     Meaning *tvar;
+     int useshort;
+ 
+     switch (curtok) {
+         case TOK_MINUS:
+             gettok();
+             if (curtok == TOK_MININT) {
+                 gettok();
+                 ex = makeexpr_long(MININT);
+ 		break;
+             }
+             ex = makeexpr_neg(p_term(target));
+             break;
+         case TOK_PLUS:
+             gettok();
+         /* fall through */
+         default:
+             ex = p_term(target);
+             break;
+     }
+     if (curtok == TOK_PLUS &&
+         (ex->val.type->kind == TK_STRING ||
+          ord_type(ex->val.type)->kind == TK_CHAR ||
+          ex->val.type->kind == TK_ARRAY)) {
+         while (curtok == TOK_PLUS) {
+             gettok();
+             ex = makeexpr_concat(ex, p_term(NULL), 0);
+         }
+         return ex;
+     } else {
+         for (;;) {
+ 	    checkkeyword(TOK_XOR);
+             switch (curtok) {
+ 
+                 case TOK_PLUS:
+                     gettok();
+                     if (ex->val.type->kind == TK_SET ||
+                         ex->val.type->kind == TK_SMALLSET) {
+                         ex2 = p_term(ex->val.type);
+                         type = mixsets(&ex, &ex2);
+                         if (type->kind == TK_SMALLSET) {
+                             ex = makeexpr_bin(EK_BOR, type, ex, ex2);
+                         } else {
+                             tvar = makestmttempvar(type, name_SET);
+                             ex = makeexpr_bicall_3(setunionname, type,
+                                                    makeexpr_var(tvar),
+                                                    ex, ex2);
+                         }
+                     } else
+                         ex = makeexpr_plus(ex, p_term(tp_integer));
+                     break;
+ 
+                 case TOK_MINUS:
+                     gettok();
+                     if (ex->val.type->kind == TK_SET ||
+                         ex->val.type->kind == TK_SMALLSET) {
+                         ex2 = p_term(tp_integer);
+                         type = mixsets(&ex, &ex2);
+                         if (type->kind == TK_SMALLSET) {
+                             ex = makeexpr_bin(EK_BAND, type, ex,
+                                               makeexpr_un(EK_BNOT, type, ex2));
+                         } else {
+                             tvar = makestmttempvar(type, name_SET);
+                             ex = makeexpr_bicall_3(setdiffname, type,
+                                                    makeexpr_var(tvar), ex, ex2);
+                         }
+                     } else
+                         ex = makeexpr_minus(ex, p_term(tp_integer));
+                     break;
+ 
+ 		case TOK_VBAR:
+ 		    if (modula2)
+ 			return ex;
+ 		    /* fall through */
+ 
+                 case TOK_OR:
+ 		    useshort = (curtok == TOK_VBAR);
+                     gettok();
+                     ex2 = p_term(tp_integer);
+                     if (ord_type(ex->val.type)->kind == TK_INTEGER)
+                         ex = makeexpr_bin(EK_BOR, ex->val.type, ex, ex2);
+                     else if (partial_eval_flag || useshort ||
+                              (shortopt && nosideeffects(ex2, 1)))
+                         ex = makeexpr_or(ex, ex2);
+                     else
+                         ex = makeexpr_bin(EK_BOR, tp_boolean, ex, ex2);
+                     break;
+ 
+                 case TOK_XOR:
+                     gettok();
+                     ex2 = p_term(tp_integer);
+                     ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
+                     break;
+ 
+                 default:
+                     return ex;
+             }
+         }
+     }
+ }
+ 
+ 
+ 
+ Expr *p_expr(target)
+ Type *target;
+ {
+     Expr *ex = p_sexpr(target);
+     Expr *ex2, *ex3, *ex4;
+     Type *type;
+     Meaning *tvar;
+     long mask, smin, smax;
+     int i, j;
+ 
+     switch (curtok) {
+ 
+         case TOK_EQ:
+             gettok();
+             return makeexpr_rel(EK_EQ, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_NE:
+             gettok();
+             return makeexpr_rel(EK_NE, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_LT:
+             gettok();
+             return makeexpr_rel(EK_LT, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_GT:
+             gettok();
+             return makeexpr_rel(EK_GT, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_LE:
+             gettok();
+             return makeexpr_rel(EK_LE, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_GE:
+             gettok();
+             return makeexpr_rel(EK_GE, ex, p_sexpr(ex->val.type));
+ 
+         case TOK_IN:
+             gettok();
+             ex2 = p_sexpr(tp_smallset);
+             ex = gentle_cast(ex, ex2->val.type->indextype);
+             if (ex2->val.type->kind == TK_SMALLSET) {
+                 if (!ord_range(ex->val.type, &smin, &smax)) {
+                     smin = -1;
+                     smax = setbits;
+                 }
+                 if (!nosideeffects(ex, 0)) {
+                     tvar = makestmttempvar(ex->val.type, name_TEMP);
+                     ex3 = makeexpr_assign(makeexpr_var(tvar), ex);
+                     ex = makeexpr_var(tvar);
+                 } else
+                     ex3 = NULL;
+                 ex4 = copyexpr(ex);
+                 if (ex->kind == EK_CONST && smallsetconst)
+                     ex = makesmallsetconst(1<<ex->val.i, ex2->val.type);
+                 else
+                     ex = makeexpr_bin(EK_LSH, ex2->val.type,
+                                       makeexpr_longcast(makeexpr_long(1), 1),
+                                       enum_to_int(ex));
+                 ex = makeexpr_rel(EK_NE, makeexpr_bin(EK_BAND, tp_integer, ex, ex2),
+                                          makeexpr_long(0));
+                 if (*name_SETBITS ||
+                     ((ex4->kind == EK_CONST) ? ((unsigned long)ex4->val.i >= setbits)
+                                              : !(0 <= smin && smax < setbits))) {
+                     ex = makeexpr_and(makeexpr_range(enum_to_int(ex4),
+                                                      makeexpr_long(0),
+                                                      makeexpr_setbits(), 0),
+                                       ex);
+                 } else
+                     freeexpr(ex4);
+                 ex = makeexpr_comma(ex3, ex);
+                 return ex;
+             } else {
+                 ex3 = ex2;
+                 while (ex3->kind == EK_BICALL &&
+                        (!strcmp(ex3->val.s, setaddname) ||
+                         !strcmp(ex3->val.s, setaddrangename)))
+                     ex3 = ex3->args[0];
+                 if (ex3->kind == EK_BICALL && !strcmp(ex3->val.s, setexpandname) &&
+                     (tvar = istempvar(ex3->args[0])) != NULL && 
+                     isconstexpr(ex3->args[1], &mask)) {
+                     canceltempvar(tvar);
+                     if (!nosideeffects(ex, 0)) {
+                         tvar = makestmttempvar(ex->val.type, name_TEMP);
+                         ex3 = makeexpr_assign(makeexpr_var(tvar), ex);
+                         ex = makeexpr_var(tvar);
+                     } else
+                         ex3 = NULL;
+                     type = ord_type(ex2->val.type->indextype);
+                     ex4 = NULL;
+                     i = 0;
+                     while (i < setbits) {
+                         if (mask & (1<<i++)) {
+                             if (i+1 < setbits && (mask & (2<<i))) {
+                                 for (j = i; j < setbits && (mask & (1<<j)); j++) ;
+                                 ex4 = makeexpr_or(ex4,
+                                         makeexpr_range(copyexpr(ex),
+                                                        makeexpr_val(make_ord(type, i-1)),
+                                                        makeexpr_val(make_ord(type, j-1)), 1));
+                                 i = j;
+                             } else {
+                                 ex4 = makeexpr_or(ex4,
+                                         makeexpr_rel(EK_EQ, copyexpr(ex),
+                                                             makeexpr_val(make_ord(type, i-1))));
+                             }
+                         }
+                     }
+                     mask = 0;
+                     for (;;) {
+                         if (!strcmp(ex2->val.s, setaddrangename)) {
+                             if (checkconst(ex2->args[1], 'a') &&
+                                 checkconst(ex2->args[2], 'z')) {
+                                 mask |= 0x1;
+                             } else if (checkconst(ex2->args[1], 'A') &&
+                                        checkconst(ex2->args[2], 'Z')) {
+                                 mask |= 0x2;
+                             } else if (checkconst(ex2->args[1], '0') &&
+                                        checkconst(ex2->args[2], '9')) {
+                                 mask |= 0x4;
+                             } else {
+                                 ex4 = makeexpr_or(ex4,
+                                         makeexpr_range(copyexpr(ex), ex2->args[1], ex2->args[2], 1));
+                             }
+                         } else if (!strcmp(ex2->val.s, setaddname)) {
+                             ex4 = makeexpr_or(ex4,
+                                     makeexpr_rel(EK_EQ, copyexpr(ex), ex2->args[1]));
+                         } else
+                             break;
+                         ex2 = ex2->args[0];
+                     }
+                     /* do these now so that EK_OR optimizations will work: */
+                     if (mask & 0x1)
+                         ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+                                                               makeexpr_char('a'),
+                                                               makeexpr_char('z'), 1));
+                     if (mask & 0x2)
+                         ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+                                                               makeexpr_char('A'),
+                                                               makeexpr_char('Z'), 1));
+                     if (mask & 0x4)
+                         ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+                                                               makeexpr_char('0'),
+                                                               makeexpr_char('9'), 1));
+                     freeexpr(ex);
+                     return makeexpr_comma(ex3, ex4);
+                 }
+                 return makeexpr_bicall_2(setinname, tp_boolean,
+                                          makeexpr_arglong(ex, 0), ex2);
+             }
+ 
+ 	default:
+ 	    return ex;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Parse a C expression; used by VarMacro, etc. */
+ 
+ Type *nametotype(name)
+ char *name;
+ {
+     if (!strcicmp(name, "malloc") ||
+ 	!strcicmp(name, mallocname)) {
+ 	return tp_anyptr;
+     }
+     return tp_integer;
+ }
+ 
+ 
+ int istypespec()
+ {
+     switch (curtok) {
+ 
+         case TOK_CONST:
+             return 1;
+ 
+         case TOK_IDENT:
+             return !strcmp(curtokcase, "volatile") ||
+                    !strcmp(curtokcase, "void") ||
+                    !strcmp(curtokcase, "char") ||
+                    !strcmp(curtokcase, "short") ||
+                    !strcmp(curtokcase, "int") ||
+                    !strcmp(curtokcase, "long") ||
+                    !strcmp(curtokcase, "float") ||
+                    !strcmp(curtokcase, "double") ||
+                    !strcmp(curtokcase, "signed") ||
+                    !strcmp(curtokcase, "unsigned") ||
+                    !strcmp(curtokcase, "struct") ||
+                    !strcmp(curtokcase, "union") ||
+                    !strcmp(curtokcase, "class") ||
+                    !strcmp(curtokcase, "enum") ||
+                    !strcmp(curtokcase, "typedef") ||
+                    (curtokmeaning &&
+                     curtokmeaning->kind == MK_TYPE);
+ 
+         default:
+             return 0;
+     }
+ }
+ 
+ 
+ 
+ Expr *pc_parentype(cp)
+ char *cp;
+ {
+     Expr *ex;
+ 
+     if (curtok == TOK_IDENT &&
+          curtokmeaning &&
+          curtokmeaning->kind == MK_TYPE) {
+         ex = makeexpr_type(curtokmeaning->type);
+         gettok();
+         skipcloseparen();
+     } else if (curtok == TOK_IDENT && !strcmp(curtokcase, "typedef")) {
+         ex = makeexpr_name(getparenstr(inbufptr), tp_integer);
+         gettok();
+     } else {
+         ex = makeexpr_name(getparenstr(cp), tp_integer);
+         gettok();
+     }
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ Expr *pc_expr2();
+ 
+ Expr *pc_factor()
+ {
+     Expr *ex;
+     char *cp;
+     Strlist *sl;
+     int i;
+ 
+     switch (curtok) {
+ 
+         case TOK_BANG:
+             gettok();
+             return makeexpr_not(pc_expr2(14));
+ 
+         case TOK_TWIDDLE:
+             gettok();
+             return makeexpr_un(EK_BNOT, tp_integer, pc_expr2(14));
+ 
+         case TOK_PLPL:
+             gettok();
+             ex = pc_expr2(14);
+             return makeexpr_assign(ex, makeexpr_plus(copyexpr(ex), makeexpr_long(1)));
+ 
+         case TOK_MIMI:
+             gettok();
+             ex = pc_expr2(14);
+             return makeexpr_assign(ex, makeexpr_minus(copyexpr(ex), makeexpr_long(1)));
+ 
+         case TOK_STAR:
+             gettok();
+             ex = pc_expr2(14);
+             if (ex->val.type->kind != TK_POINTER)
+                 ex->val.type = makepointertype(ex->val.type);
+             return makeexpr_hat(ex, 0);
+ 
+         case TOK_AMP:
+             gettok();
+             return makeexpr_addr(pc_expr2(14));
+ 
+         case TOK_PLUS:
+             gettok();
+             return pc_expr2(14);
+ 
+         case TOK_MINUS:
+             gettok();
+             return makeexpr_neg(pc_expr2(14));
+ 
+         case TOK_LPAR:
+             cp = inbufptr;
+             gettok();
+             if (istypespec()) {
+                 ex = pc_parentype(cp);
+                 return makeexpr_bin(EK_LITCAST, tp_integer, ex, pc_expr2(14));
+             }
+             ex = pc_expr();
+             skipcloseparen();
+             return ex;
+ 
+         case TOK_IDENT:
+             if (!strcmp(curtokcase, "sizeof")) {
+                 gettok();
+                 if (curtok != TOK_LPAR)
+                     return makeexpr_sizeof(pc_expr2(14), 1);
+                 cp = inbufptr;
+                 gettok();
+                 if (istypespec()) {
+                     ex = makeexpr_sizeof(pc_parentype(cp), 1);
+                 } else {
+                     ex = makeexpr_sizeof(pc_expr(), 1);
+                     skipcloseparen();
+                 }
+                 return ex;
+             }
+             if (curtoksym->flags & FMACREC) {
+                 ex = makeexpr(EK_MACARG, 0);
+                 ex->val.type = tp_integer;
+                 ex->val.i = 0;
+                 for (sl = funcmacroargs, i = 1; sl; sl = sl->next, i++) {
+                     if (sl->value == (long)curtoksym) {
+                         ex->val.i = i;
+                         break;
+                     }
+                 }
+             } else
+                 ex = makeexpr_name(curtokcase, nametotype(curtokcase));
+             gettok();
+             return ex;
+ 
+         case TOK_INTLIT:
+             ex = makeexpr_long(curtokint);
+             if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+                 ex = makeexpr_longcast(ex, 1);
+             gettok();
+             return ex;
+ 
+         case TOK_HEXLIT:
+             ex = makeexpr_long(curtokint);
+             insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+             if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+                 ex = makeexpr_longcast(ex, 1);
+             gettok();
+             return ex;
+ 
+         case TOK_OCTLIT:
+             ex = makeexpr_long(curtokint);
+             insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
+             if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+                 ex = makeexpr_longcast(ex, 1);
+             gettok();
+             return ex;
+ 
+         case TOK_REALLIT:
+             ex = makeexpr_real(curtokbuf);
+             gettok();
+             return ex;
+ 
+         case TOK_STRLIT:
+             ex = makeexpr_lstring(curtokbuf, curtokint);
+             gettok();
+             return ex;
+ 
+         case TOK_CHARLIT:
+             ex = makeexpr_char(curtokint);
+             gettok();
+             return ex;
+ 
+         default:
+ 	    wexpected("a C expression");
+ 	    return makeexpr_long(0);
+     }
+ }
+ 
+ 
+ 
+ 
+ #define pc_prec(pr)  if (prec > (pr)) return ex; gettok();
+ 
+ Expr *pc_expr2(prec)
+ int prec;
+ {
+     Expr *ex, *ex2;
+     int i;
+ 
+     ex = pc_factor();
+     for (;;) {
+         switch (curtok) {
+ 
+             case TOK_COMMA:
+                 pc_prec(1);
+                 ex = makeexpr_comma(ex, pc_expr2(2));
+                 break;
+ 
+             case TOK_EQ:
+                 pc_prec(2);
+                 ex = makeexpr_assign(ex, pc_expr2(2));
+                 break;
+ 
+             case TOK_QM:
+                 pc_prec(3);
+                 ex2 = pc_expr();
+                 if (wneedtok(TOK_COLON))
+ 		    ex = makeexpr_cond(ex, ex2, pc_expr2(3));
+ 		else
+ 		    ex = makeexpr_cond(ex, ex2, makeexpr_long(0));
+                 break;
+ 
+             case TOK_OROR:
+                 pc_prec(4);
+                 ex = makeexpr_or(ex, pc_expr2(5));
+                 break;
+ 
+             case TOK_ANDAND:
+                 pc_prec(5);
+                 ex = makeexpr_and(ex, pc_expr2(6));
+                 break;
+ 
+             case TOK_VBAR:
+                 pc_prec(6);
+                 ex = makeexpr_bin(EK_BOR, tp_integer, ex, pc_expr2(7));
+                 break;
+ 
+             case TOK_HAT:
+                 pc_prec(7);
+                 ex = makeexpr_bin(EK_BXOR, tp_integer, ex, pc_expr2(8));
+                 break;
+ 
+             case TOK_AMP:
+                 pc_prec(8);
+                 ex = makeexpr_bin(EK_BAND, tp_integer, ex, pc_expr2(9));
+                 break;
+ 
+             case TOK_EQEQ:
+                 pc_prec(9);
+                 ex = makeexpr_rel(EK_EQ, ex, pc_expr2(10));
+                 break;
+ 
+             case TOK_BANGEQ:
+                 pc_prec(9);
+                 ex = makeexpr_rel(EK_NE, ex, pc_expr2(10));
+                 break;
+ 
+             case TOK_LT:
+                 pc_prec(10);
+                 ex = makeexpr_rel(EK_LT, ex, pc_expr2(11));
+                 break;
+ 
+             case TOK_LE:
+                 pc_prec(10);
+                 ex = makeexpr_rel(EK_LE, ex, pc_expr2(11));
+                 break;
+ 
+             case TOK_GT:
+                 pc_prec(10);
+                 ex = makeexpr_rel(EK_GT, ex, pc_expr2(11));
+                 break;
+ 
+             case TOK_GE:
+                 pc_prec(10);
+                 ex = makeexpr_rel(EK_GE, ex, pc_expr2(11));
+                 break;
+ 
+             case TOK_LTLT:
+                 pc_prec(11);
+                 ex = makeexpr_bin(EK_LSH, tp_integer, ex, pc_expr2(12));
+                 break;
+ 
+             case TOK_GTGT:
+                 pc_prec(11);
+                 ex = makeexpr_bin(EK_RSH, tp_integer, ex, pc_expr2(12));
+                 break;
+ 
+             case TOK_PLUS:
+                 pc_prec(12);
+                 ex = makeexpr_plus(ex, pc_expr2(13));
+                 break;
+ 
+             case TOK_MINUS:
+                 pc_prec(12);
+                 ex = makeexpr_minus(ex, pc_expr2(13));
+                 break;
+ 
+             case TOK_STAR:
+                 pc_prec(13);
+                 ex = makeexpr_times(ex, pc_expr2(14));
+                 break;
+ 
+             case TOK_SLASH:
+                 pc_prec(13);
+                 ex = makeexpr_div(ex, pc_expr2(14));
+                 break;
+ 
+             case TOK_PERC:
+                 pc_prec(13);
+                 ex = makeexpr_mod(ex, pc_expr2(14));
+                 break;
+ 
+             case TOK_PLPL:
+                 pc_prec(15);
+                 ex = makeexpr_un(EK_POSTINC, tp_integer, ex);
+                 break;
+ 
+             case TOK_MIMI:
+                 pc_prec(15);
+                 ex = makeexpr_un(EK_POSTDEC, tp_integer, ex);
+                 break;
+ 
+             case TOK_LPAR:
+                 pc_prec(16);
+                 if (ex->kind == EK_NAME) {
+                     ex->kind = EK_BICALL;
+                 } else {
+                     ex = makeexpr_un(EK_SPCALL, tp_integer, ex);
+                 }
+                 while (curtok != TOK_RPAR) {
+                     insertarg(&ex, ex->nargs, pc_expr2(2));
+                     if (curtok != TOK_RPAR)
+                         if (!wneedtok(TOK_COMMA))
+ 			    skiptotoken2(TOK_RPAR, TOK_SEMI);
+                 }
+                 gettok();
+                 break;
+ 
+             case TOK_LBR:
+                 pc_prec(16);
+                 ex = makeexpr_index(ex, pc_expr(), NULL);
+                 if (!wneedtok(TOK_RBR))
+ 		    skippasttoken(TOK_RBR);
+                 break;
+ 
+             case TOK_ARROW:
+                 pc_prec(16);
+                 if (!wexpecttok(TOK_IDENT))
+ 		    break;
+                 if (ex->val.type->kind != TK_POINTER)
+                     ex->val.type = makepointertype(ex->val.type);
+                 ex = makeexpr_dotq(makeexpr_hat(ex, 0),
+                                    curtokcase, tp_integer);
+                 gettok();
+                 break;
+ 
+             case TOK_DOT:
+                 pc_prec(16);
+                 if (!wexpecttok(TOK_IDENT))
+ 		    break;
+                 ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+                 gettok();
+                 break;
+ 
+ 	    case TOK_COLONCOLON:
+ 		if (prec > 16)
+ 		    return ex;
+ 		i = C_lex;
+ 		C_lex = 0;
+ 		gettok();
+ 		if (curtok == TOK_IDENT &&
+ 		    curtokmeaning && curtokmeaning->kind == MK_TYPE) {
+ 		    ex->val.type = curtokmeaning->type;
+ 		} else if (curtok == TOK_LPAR) {
+ 		    gettok();
+ 		    ex->val.type = p_type(NULL);
+ 		    if (!wexpecttok(TOK_RPAR))
+ 			skiptotoken(TOK_RPAR);
+ 		} else
+ 		    wexpected("a type name");
+ 		C_lex = i;
+ 		gettok();
+ 		break;
+ 
+             default:
+                 return ex;
+         }
+     }
+ }
+ 
+ 
+ 
+ 
+ Expr *pc_expr()
+ {
+     return pc_expr2(0);
+ }
+ 
+ 
+ 
+ Expr *pc_expr_str(buf)
+ char *buf;
+ {
+     Strlist *defsl, *sl;
+     Expr *ex;
+ 
+     defsl = NULL;
+     sl = strlist_append(&defsl, buf);
+     C_lex++;
+     push_input_strlist(defsl, buf);
+     ex = pc_expr();
+     if (curtok != TOK_EOF)
+         warning(format_s("Junk (%s) at end of C expression [306]",
+ 			 tok_name(curtok)));
+     pop_input();
+     C_lex--;
+     strlist_empty(&defsl);
+     return ex;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Simplify an expression */
+ 
+ Expr *fixexpr(ex, env)
+ Expr *ex;
+ int env;
+ {
+     Expr *ex2, *ex3;
+     Type *type, *type2;
+     char *cp;
+     char sbuf[5];
+     int i, j;
+     Value val;
+ 
+     if (!ex)
+         return NULL;
+     if (debug>4) {fprintf(outf, "fixexpr("); dumpexpr(ex); fprintf(outf, ")\n");}
+     switch (ex->kind) {
+ 
+         case EK_BICALL:
+             ex2 = fix_bicall(ex, env);
+             if (ex2) {
+                 ex = ex2;
+                 break;
+             }
+             cp = ex->val.s;
+             if (!strcmp(cp, "strlen")) {
+                 if (ex->args[0]->kind == EK_BICALL &&
+                     !strcmp(ex->args[0]->val.s, "sprintf") &&
+                     sprintf_value == 0) {     /* does sprintf return char count? */
+                     ex = grabarg(ex, 0);
+                     strchange(&ex->val.s, "*sprintf");
+                     ex = fixexpr(ex, env);
+                 } else {
+                     ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+                 }
+             } else if (!strcmp(cp, name_SETIO)) {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+             } else if (!strcmp(cp, "~~SETIO")) {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+                 ex = makeexpr_cond(ex->args[0],
+                                    makeexpr_long(0),
+                                    makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]));
+             } else if (!strcmp(cp, name_CHKIO)) {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+                 ex->args[2] = fixexpr(ex->args[2], env);
+                 ex->args[3] = fixexpr(ex->args[3], env);
+             } else if (!strcmp(cp, "~~CHKIO")) {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+                 ex->args[2] = fixexpr(ex->args[2], env);
+                 ex->args[3] = fixexpr(ex->args[3], env);
+                 ex2 = makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]);
+                 if (ord_type(ex->args[3]->val.type)->kind != TK_INTEGER)
+                     ex2 = makeexpr_cast(ex2, ex->args[3]->val.type);
+                 ex = makeexpr_cond(ex->args[0], ex->args[2], ex2);
+             } else if (!strcmp(cp, "assert")) {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ 	    } else if ((!strcmp(cp, setaddname) ||
+ 			!strcmp(cp, setaddrangename)) &&
+ 		       (ex2 = ex->args[0])->kind == EK_BICALL &&
+ 		       (!strcmp(ex2->val.s, setaddname) ||
+ 			!strcmp(ex2->val.s, setaddrangename))) {
+ 		while (ex2->kind == EK_BICALL &&
+ 		       (!strcmp(ex2->val.s, setaddname) ||
+ 			!strcmp(ex2->val.s, setaddrangename) ||
+ 			!strcmp(ex2->val.s, setexpandname)))
+ 		    ex2 = ex2->args[0];
+ 		if (nosideeffects(ex2, 1)) {
+ 		    ex = makeexpr_comma(ex->args[0], ex);
+ 		    ex->args[1]->args[0] = ex2;
+ 		    ex = fixexpr(ex, env);
+ 		} else
+ 		    for (i = 0; i < ex->nargs; i++)
+ 			ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+ 	    } else if (!strcmp(cp, setunionname) &&
+ 		       (ex3 = singlevar(ex->args[0])) != NULL &&
+ 		       ((i=1, exprsame(ex->args[0], ex->args[i], 0)) ||
+ 			(i=2, exprsame(ex->args[0], ex->args[i], 0))) &&
+ 		       !exproccurs(ex3, ex->args[3-i]) &&
+ 		       ex->args[3-i]->kind == EK_BICALL &&
+ 		       (!strcmp(ex->args[3-i]->val.s, setaddname) ||
+ 			!strcmp(ex->args[3-i]->val.s, setaddrangename) ||
+ 			(!strcmp(ex->args[3-i]->val.s, setexpandname) &&
+ 			 checkconst(ex->args[3-i]->args[1], 0))) &&
+ 		       totempvar(ex->args[3-i])) {
+ 		if (!strcmp(ex->args[3-i]->val.s, setexpandname)) {
+ 		    ex = grabarg(ex, 0);
+ 		} else {
+ 		    ex = makeexpr_comma(ex, ex->args[3-i]);
+ 		    ex->args[0]->args[3-i] = ex->args[1]->args[0];
+ 		    ex->args[1]->args[0] = copyexpr(ex->args[0]->args[0]);
+ 		}
+ 		ex = fixexpr(ex, env);
+ 	    } else if (!strcmp(cp, setdiffname) && *setremname &&
+ 		       (ex3 = singlevar(ex->args[0])) != NULL &&
+ 		       exprsame(ex->args[0], ex->args[1], 0) &&
+ 		       !exproccurs(ex3, ex->args[2]) &&
+ 		       ex->args[2]->kind == EK_BICALL &&
+ 		       (!strcmp(ex->args[2]->val.s, setaddname) ||
+ 			(!strcmp(ex->args[2]->val.s, setexpandname) &&
+ 			 checkconst(ex->args[2]->args[1], 0))) &&
+ 		       totempvar(ex->args[2])) {
+ 		if (!strcmp(ex->args[2]->val.s, setexpandname)) {
+ 		    ex = grabarg(ex, 0);
+ 		} else {
+ 		    ex = makeexpr_comma(ex, ex->args[2]);
+ 		    ex->args[0]->args[2] = ex->args[1]->args[0];
+ 		    ex->args[1]->args[0] = copyexpr(ex->args[0]->args[0]);
+ 		    strchange(&ex->args[1]->val.s, setremname);
+ 		}
+ 		ex = fixexpr(ex, env);
+             } else {
+                 for (i = 0; i < ex->nargs; i++)
+                     ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+ 		ex = cleansprintf(ex);
+                 if (!strcmp(cp, "sprintf")) {
+                     if (checkstring(ex->args[1], "%s")) {
+                         delfreearg(&ex, 1);
+                         strchange(&ex->val.s, "strcpy");
+                         ex = fixexpr(ex, env);
+                     } else if (sprintf_value != 1 && env != ENV_STMT) {
+                         if (*sprintfname) {
+                             strchange(&ex->val.s, format_s("*%s", sprintfname));
+                         } else {
+                             strchange(&ex->val.s, "*sprintf");
+                             ex = makeexpr_comma(ex, copyexpr(ex->args[0]));
+                         }
+                     }
+                 } else if (!strcmp(cp, "strcpy")) {
+                     if (env == ENV_STMT &&
+                          ex->args[1]->kind == EK_BICALL &&
+                          !strcmp(ex->args[1]->val.s, "strcpy") &&
+                          nosideeffects(ex->args[1]->args[0], 1)) {
+                         ex2 = ex->args[1];
+                         ex->args[1] = copyexpr(ex2->args[0]);
+                         ex = makeexpr_comma(ex2, ex);
+                     }
+                 } else if (!strcmp(cp, "memcpy")) {
+                     strchange(&ex->val.s, format_s("*%s", memcpyname));
+                     if (!strcmp(memcpyname, "*bcopy")) {
+                         swapexprs(ex->args[0], ex->args[1]);
+                         if (env != ENV_STMT)
+                             ex = makeexpr_comma(ex, copyexpr(ex->args[1]));
+                     }
+ #if 0
+ 		} else if (!strcmp(cp, setunionname) &&
+ 			   (ex3 = singlevar(ex->args[0])) != NULL &&
+ 			   ((i=1, exprsame(ex->args[0], ex->args[i], 0)) ||
+ 			    (i=2, exprsame(ex->args[0], ex->args[i], 0))) &&
+ 			   !exproccurs(ex3, ex->args[3-i])) {
+ 		    ep = &ex->args[3-i];
+ 		    while ((ex2 = *ep)->kind == EK_BICALL &&
+ 			   (!strcmp(ex2->val.s, setaddname) ||
+ 			    !strcmp(ex2->val.s, setaddrangename)))
+ 			ep = &ex2->args[0];
+ 		    if (ex2->kind == EK_BICALL &&
+ 			!strcmp(ex2->val.s, setexpandname) &&
+ 			checkconst(ex2->args[1], 0) &&
+ 			(mp = istempvar(ex2->args[0])) != NULL) {
+ 			if (ex2 == ex->args[3-i]) {
+ 			    ex = grabarg(ex, i);
+ 			} else {
+ 			    freeexpr(ex2);
+ 			    *ep = ex->args[i];
+ 			    ex = ex->args[3-i];
+ 			}
+ 		    }
+ 		} else if (!strcmp(cp, setdiffname) && *setremname &&
+ 			   (ex3 = singlevar(ex->args[0])) != NULL &&
+ 			   exprsame(ex->args[0], ex->args[1], 0) &&
+ 			   !exproccurs(ex3, ex->args[2])) {
+ 		    ep = &ex->args[2];
+ 		    while ((ex2 = *ep)->kind == EK_BICALL &&
+ 			   !strcmp(ex2->val.s, setaddname))
+ 			ep = &ex2->args[0];
+ 		    if (ex2->kind == EK_BICALL &&
+ 			!strcmp(ex2->val.s, setexpandname) &&
+ 			checkconst(ex2->args[1], 0) &&
+ 			(mp = istempvar(ex2->args[0])) != NULL) {
+ 			if (ex2 == ex->args[2]) {
+ 			    ex = grabarg(ex, 1);
+ 			} else {
+ 			    ex2 = ex->args[2];
+ 			    while (ex2->kind == EK_BICALL &&
+ 				   !strcmp(ex2->val.s, setaddname)) {
+ 				strchange(&ex2->val.s, setremname);
+ 				ex2 = ex2->args[0];
+ 			    }
+ 			    freeexpr(ex2);
+ 			    *ep = ex->args[1];
+ 			    ex = ex->args[2];
+ 			}
+ 		    }
+ #endif
+                 } else if (!strcmp(cp, setexpandname) && env == ENV_STMT &&
+                            checkconst(ex->args[1], 0)) {
+                     ex = makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+                                          ex->args[1]);
+                 } else if (!strcmp(cp, getbitsname)) {
+ 		    type = ex->args[0]->val.type;
+ 		    if (type->kind == TK_POINTER)
+ 			type = type->basetype;
+                     sbuf[0] = (type->issigned) ? 'S' : 'U';
+                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+                     sbuf[2] = 0;
+                     if (sbuf[1] == 'S' &&
+                         type->smax->val.type == tp_boolean) {
+                         ex = makeexpr_rel(EK_NE,
+                                           makeexpr_bin(EK_BAND, tp_integer,
+                                                        ex->args[0],
+                                                        makeexpr_bin(EK_LSH, tp_integer,
+                                                                     makeexpr_longcast(makeexpr_long(1),
+                                                                                       type->basetype
+                                                                                             == tp_unsigned),
+                                                                     ex->args[1])),
+                                           makeexpr_long(0));
+                         ex = fixexpr(ex, env);
+                     } else
+                         strchange(&ex->val.s, format_s(cp, sbuf));
+                 } else if (!strcmp(cp, putbitsname)) {
+ 		    type = ex->args[0]->val.type;
+ 		    if (type->kind == TK_POINTER)
+ 			type = type->basetype;
+                     sbuf[0] = (type->issigned) ? 'S' : 'U';
+                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+                     sbuf[2] = 0;
+                     if (sbuf[1] == 'S' &&
+                         type->smax->val.type == tp_boolean) {
+                         ex = makeexpr_assign(ex->args[0],
+                                              makeexpr_bin(EK_BOR, tp_integer,
+                                                           copyexpr(ex->args[0]),
+                                                           makeexpr_bin(EK_LSH, tp_integer,
+                                                                        makeexpr_longcast(ex->args[2],
+                                                                                          type->basetype
+                                                                                                == tp_unsigned),
+                                                                        ex->args[1])));
+                     } else
+                         strchange(&ex->val.s, format_s(cp, sbuf));
+                 } else if (!strcmp(cp, storebitsname)) {
+ 		    type = ex->args[0]->val.type;
+ 		    if (type->kind == TK_POINTER)
+ 			type = type->basetype;
+                     sbuf[0] = (type->issigned) ? 'S' : 'U';
+                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+                     sbuf[2] = 0;
+                     strchange(&ex->val.s, format_s(cp, sbuf));
+                 } else if (!strcmp(cp, clrbitsname)) {
+ 		    type = ex->args[0]->val.type;
+ 		    if (type->kind == TK_POINTER)
+ 			type = type->basetype;
+                     sbuf[0] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+                     sbuf[1] = 0;
+                     if (sbuf[0] == 'S' &&
+                         type->smax->val.type == tp_boolean) {
+                         ex = makeexpr_assign(ex->args[0],
+                                              makeexpr_bin(EK_BAND, tp_integer,
+                                                    copyexpr(ex->args[0]),
+                                                    makeexpr_un(EK_BNOT, tp_integer,
+                                                           makeexpr_bin(EK_LSH, tp_integer,
+                                                                        makeexpr_longcast(makeexpr_long(1),
+                                                                                          type->basetype
+                                                                                                == tp_unsigned),
+                                                                        ex->args[1]))));
+                     } else
+                         strchange(&ex->val.s, format_s(cp, sbuf));
+                 } else if (!strcmp(cp, "fopen")) {
+ 		    if (which_lang == LANG_HP &&
+ 			ex->args[0]->kind == EK_CONST &&
+ 			ex->args[0]->val.type->kind == TK_STRING &&
+ 			ex->args[0]->val.i >= 1 &&
+ 			ex->args[0]->val.i <= 2 &&
+ 			isdigit(ex->args[0]->val.s[0]) &&
+ 			(ex->args[0]->val.i == 1 ||
+ 			 isdigit(ex->args[0]->val.s[1]))) {
+ 			strchange(&ex->val.s, "fdopen");
+ 			ex->args[0] = makeexpr_long(atoi(ex->args[0]->val.s));
+ 		    }
+ 		}
+             }
+             break;
+ 
+         case EK_NOT:
+             ex = makeexpr_not(fixexpr(grabarg(ex, 0), ENV_BOOL));
+             break;
+ 
+         case EK_AND:
+         case EK_OR:
+             for (i = 0; i < ex->nargs; ) {
+                 ex->args[i] = fixexpr(ex->args[i], ENV_BOOL);
+ 		if (checkconst(ex->args[i], (ex->kind == EK_OR) ? 0 : 1) &&
+ 		    ex->nargs > 1)
+ 		    delfreearg(&ex, i);
+ 		else if (checkconst(ex->args[i], (ex->kind == EK_OR) ? 1 : 0))
+ 		    return grabarg(ex, i);
+ 		else
+ 		    i++;
+ 	    }
+ 	    if (ex->nargs == 1)
+ 		ex = grabarg(ex, 0);
+             break;
+ 
+         case EK_EQ:
+         case EK_NE:
+             ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+             ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
+             if (checkconst(ex->args[1], 0) && env == ENV_BOOL &&
+                 ord_type(ex->args[1]->val.type)->kind != TK_ENUM &&
+                 (implicitzero > 0 ||
+                  (implicitzero < 0 && ex->args[0]->kind == EK_BICALL &&
+                                       boolean_bicall(ex->args[0]->val.s)))) {
+                 if (ex->kind == EK_EQ)
+                     ex = makeexpr_not(grabarg(ex, 0));
+                 else {
+                     ex = grabarg(ex, 0);
+                     ex->val.type = tp_boolean;
+                 }
+             }
+             break;
+ 
+         case EK_COND:
+             ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ #if 0
+             val = eval_expr(ex->args[0]);
+ #else
+ 	    val = ex->args[0]->val;
+ 	    if (ex->args[0]->kind != EK_CONST)
+ 		val.type = NULL;
+ #endif
+             if (val.type == tp_boolean) {
+                 ex = grabarg(ex, (val.i) ? 1 : 2);
+                 ex = fixexpr(ex, env);
+             } else {
+                 ex->args[1] = fixexpr(ex->args[1], env);
+                 ex->args[2] = fixexpr(ex->args[2], env);
+             }
+             break;
+ 
+         case EK_COMMA:
+             for (i = 0; i < ex->nargs; ) {
+ 		j = (i < ex->nargs-1);
+                 ex->args[i] = fixexpr(ex->args[i], j ? ENV_STMT : env);
+                 if (nosideeffects(ex->args[i], 1) && j) {
+                     delfreearg(&ex, i);
+                 } else if (ex->args[i]->kind == EK_COMMA) {
+ 		    ex2 = ex->args[i];
+ 		    ex->args[i++] = ex2->args[0];
+ 		    for (j = 1; j < ex2->nargs; j++)
+ 			insertarg(&ex, i++, ex2->args[j]);
+ 		    FREE(ex2);
+ 		} else
+                     i++;
+             }
+             if (ex->nargs == 1)
+                 ex = grabarg(ex, 0);
+             break;
+ 
+         case EK_CHECKNIL:
+             ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+             if (ex->nargs == 2) {
+                 ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
+                 ex2 = makeexpr_assign(copyexpr(ex->args[1]), ex->args[0]);
+                 ex3 = ex->args[1];
+             } else {
+                 ex2 = copyexpr(ex->args[0]);
+                 ex3 = ex->args[0];
+             }
+             type = ex->args[0]->val.type;
+             type2 = ex->val.type;
+             ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+                                ex3,
+                                makeexpr_cast(makeexpr_bicall_0(name_NILCHECK,
+                                                                tp_int),
+                                              type));
+             ex->val.type = type2;
+             ex = fixexpr(ex, env);
+             break;
+ 
+         case EK_CAST:
+         case EK_ACTCAST:
+             if (env == ENV_STMT) {
+                 ex = fixexpr(grabarg(ex, 0), ENV_STMT);
+             } else {
+                 ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+             }
+             break;
+ 
+         default:
+             for (i = 0; i < ex->nargs; i++)
+                 ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+             break;
+     }
+     if (debug>4) {fprintf(outf, "fixexpr returns "); dumpexpr(ex); fprintf(outf, "\n");}
+     return fix_expression(ex, env);
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Output an expression */
+ 
+ 
+ #define bitOp(k)  ((k)==EK_BAND || (k)==EK_BOR || (k)==EK_BXOR)
+ 
+ #define shfOp(k)  ((k)==EK_LSH || (k)==EK_RSH)
+ 
+ #define logOp(k)  ((k)==EK_AND || (k)==EK_OR)
+ 
+ #define relOp(k)  ((k)==EK_EQ || (k)==EK_LT || (k)==EK_GT ||    \
+ 		   (k)==EK_NE || (k)==EK_GE || (k)==EK_LE)
+ 
+ #define mathOp(k) ((k)==EK_PLUS || (k)==EK_TIMES || (k)==EK_NEG ||   \
+ 		   (k)==EK_DIV || (k)==EK_DIVIDE || (k)==EK_MOD)
+ 
+ #define divOp(k)  ((k)==EK_DIV || (k)==EK_DIVIDE)
+ 
+ 
+ Static int incompat(ex, num, prec)
+ Expr *ex;
+ int num, prec;
+ {
+     Expr *subex = ex->args[num];
+ 
+     if (extraparens == 0)
+ 	return prec;
+     if (ex->kind == subex->kind) {
+ 	if (logOp(ex->kind) || bitOp(ex->kind) ||
+ 	    (divOp(ex->kind) && num == 0))
+ 	    return -99;   /* not even invisible parens */
+ 	else if (extraparens != 2)
+ 	    return prec;
+     }
+     if (extraparens == 2)
+ 	return 15;
+     if (divOp(ex->kind) && num == 0 &&
+ 	(subex->kind == EK_TIMES || divOp(subex->kind)))
+ 	return -99;
+     if (bitOp(ex->kind) || shfOp(ex->kind))
+ 	return 15;
+     if (relOp(ex->kind) && relOp(subex->kind))
+ 	return 15;
+     if ((relOp(ex->kind) || logOp(ex->kind)) && bitOp(subex->kind))
+ 	return 15;
+     if (ex->kind == EK_COMMA)
+ 	return 15;
+     if (ex->kind == EK_ASSIGN && relOp(subex->kind))
+ 	return 15;
+     if (extraparens != 1)
+ 	return prec;
+     if (ex->kind == EK_ASSIGN)
+ 	return prec;
+     if (relOp(ex->kind) && mathOp(subex->kind))
+ 	return prec;
+     return 15;
+ }
+ 
+ 
+ 
+ 
+ #define EXTRASPACE() if (spaceexprs == 1) output(" ")
+ #define NICESPACE()  if (spaceexprs != 0) output(" ")
+ 
+ #define setprec(p) \
+     if ((subprec=(p)) <= prec) { \
+         parens = 1; output("("); \
+     }
+ 
+ #define setprec2(p) \
+     if ((subprec=(p)) <= prec) { \
+         parens = 1; output("("); \
+     } else if (prec != -99) { \
+         parens = 2; output((breakparens == 1) ? "\010" : "\003"); \
+     }
+ 
+ #define setprec3(p) \
+     if ((subprec=(p)) <= prec) { \
+          parens = 1; output("("); \
+     } else if (prec != -99) { \
+          parens = 2; output((prec > 2 && breakparens != 0) ? "\010" \
+ 			                                   : "\003"); \
+     }
+ 
+ 
+ Static void outop3(breakbefore, name)
+ int breakbefore;
+ char *name;
+ {
+     if (breakbefore & BRK_LEFT) {
+ 	output("\002");
+ 	if (breakbefore & BRK_RPREF)
+ 	    output("\013");
+     }
+     output(name);
+     if (breakbefore & BRK_HANG)
+ 	output("\015");
+     if (breakbefore & BRK_RIGHT) {
+ 	output("\002");
+ 	if (breakbefore & BRK_LPREF)
+ 	    output("\013");
+     }
+ }
+ 
+ #define outop(name) do { \
+     NICESPACE(); outop3(breakflag, name); NICESPACE(); \
+ } while (0)
+ 
+ #define outop2(name) do { \
+     EXTRASPACE(); outop3(breakflag, name); EXTRASPACE(); \
+ } while (0)
+ 
+ #define checkbreak(code) do { \
+     breakflag=(code); \
+     if ((prec != -99) && (breakflag & BRK_ALLNONE)) output("\007"); \
+ } while (0)
+ 
+ 
+ Static void out_ctx(ctx, address)
+ Meaning *ctx;
+ int address;
+ {
+     Meaning *ctx2;
+     int breakflag = breakbeforedot;
+ 
+     if (ctx->kind == MK_FUNCTION && ctx->varstructflag) {
+         if (curctx != ctx) {
+ 	    if (address && curctx->ctx && curctx->ctx != ctx) {
+ 		output("\003");
+ 		if (breakflag & BRK_ALLNONE)
+ 		    output("\007");
+ 	    }
+             output(format_s(name_LINK, curctx->ctx->name));
+             ctx2 = curctx->ctx;
+             while (ctx2 && ctx2 != ctx) {
+                 outop2("->");
+                 output(format_s(name_LINK, ctx2->ctx->name));
+                 ctx2 = ctx2->ctx;
+             }
+             if (ctx2 != ctx)
+                 intwarning("out_ctx",
+                            format_s("variable from %s not present in context path [307]",
+                                      ctx->name));
+ 	    if (address && curctx->ctx && curctx->ctx != ctx)
+ 		output("\004");
+             if (!address)
+                 outop2("->");
+         } else {
+             if (address) {
+                 output("&");
+ 		EXTRASPACE();
+ 	    }
+             output(format_s(name_VARS, curctx->name));
+             if (!address) {
+                 outop2(".");
+ 	    }
+         }
+     } else {
+         if (address)
+             output("NULL");
+     }
+ }
+ 
+ 
+ 
+ void out_var(mp, prec)
+ Meaning *mp;
+ int prec;
+ {
+     switch (mp->kind) {
+ 
+         case MK_CONST:
+             output(mp->name);
+             return;
+ 
+         case MK_VAR:
+         case MK_VARREF:
+         case MK_VARMAC:
+         case MK_PARAM:
+         case MK_VARPARAM:
+             if (mp->varstructflag) {
+ 		output("\003");
+                 out_ctx(mp->ctx, 0);
+ 		output(mp->name);
+ 		output("\004");
+ 	    } else
+ 		output(mp->name);
+             return;
+ 
+ 	default:
+ 	    if (mp->name)
+ 		output(mp->name);
+ 	    else
+ 		intwarning("out_var", "mp->sym == NULL [308]");
+ 	    return;
+     }
+ }
+ 
+ 
+ 
+ Static int scanfield(variants, unions, lev, mp, field)
+ Meaning **variants, *mp, *field;
+ short *unions;
+ int lev;
+ {
+     int i, num, breakflag;
+     Value v;
+ 
+     unions[lev] = (mp && mp->kind == MK_VARIANT);
+     while (mp && mp->kind == MK_FIELD) {
+         if (mp == field) {
+             for (i = 0; i < lev; i++) {
+ 		v = variants[i]->val;    /* sidestep a Sun 386i compiler bug */
+                 num = ord_value(v);
+ 		breakflag = breakbeforedot;
+                 if (!unions[i]) {
+                     output(format_s(name_UNION, ""));
+ 		    outop2(".");
+                 }
+                 if (variants[i]->ctx->cnext ||
+                     variants[i]->ctx->kind != MK_FIELD) {
+                     output(format_s(name_VARIANT, variantfieldname(num)));
+ 		    outop2(".");
+                 }
+             }
+             output(mp->name);
+             return 1;
+         }
+         mp = mp->cnext;
+     }
+     while (mp && mp->kind == MK_VARIANT) {
+         variants[lev] = mp;
+         if (scanfield(variants, unions, lev+1, mp->ctx, field))
+             return 1;
+         mp = mp->cnext;
+     }
+     return 0;
+ }
+ 
+ 
+ void out_field(mp)
+ Meaning *mp;
+ {
+     Meaning *variants[50];
+     short unions[51];
+ 
+     if (!scanfield(variants, unions, 0, mp->rectype->fbase, mp))
+         intwarning("out_field", "field name not in tree [309]");
+     else if (mp->warnifused) {
+         if (mp->rectype->meaning)
+             note(format_ss("Reference to field %s of record %s [282]", 
+                            mp->name, mp->rectype->meaning->name));
+         else
+             note(format_s("Reference to field %s [282]", mp->name));
+     }
+ }
+ 
+ 
+ 
+ 
+ Static void wrexpr(ex, prec)
+ Expr *ex;
+ int prec;
+ {
+     short parens = 0;
+     int subprec, i, j, minusflag, breakflag = 0;
+     int saveindent;
+     Expr *ex2, *ex3;
+     char *cp;
+     Meaning *mp;
+     Symbol *sp;
+ 
+     if (debug>2) { fprintf(outf,"wrexpr{"); dumpexpr(ex); fprintf(outf,", %d}\n", prec); }
+     switch (ex->kind) {
+ 
+         case EK_VAR:
+             mp = (Meaning *)ex->val.i;
+             if (mp->warnifused)
+                 note(format_s("Reference to %s [283]", mp->name));
+             out_var(mp, prec);
+             break;
+ 
+         case EK_NAME:
+             output(ex->val.s);
+             break;
+ 
+         case EK_MACARG:
+             output("<meef>");
+             intwarning("wrexpr", "Stray EK_MACARG encountered [310]");
+             break;
+ 
+         case EK_CTX:
+             out_ctx((Meaning *)ex->val.i, 1);
+             break;
+ 
+         case EK_CONST:
+             if (ex->nargs > 0)
+                 cp = value_name(ex->val, ex->args[0]->val.s, 0);
+             else
+                 cp = value_name(ex->val, NULL, 0);
+             if (*cp == '-')
+                 setprec(14);
+             output(cp);
+             break;
+ 
+         case EK_LONGCONST:
+             if (ex->nargs > 0)
+                 cp = value_name(ex->val, ex->args[0]->val.s, 1);
+             else
+                 cp = value_name(ex->val, NULL, 1);
+             if (*cp == '-')
+                 setprec(14);
+             output(cp);
+             break;
+ 
+         case EK_STRUCTCONST:
+             ex3 = NULL;
+             for (i = 0; i < ex->nargs; i++) {
+                 ex2 = ex->args[i];
+                 if (ex2->kind == EK_STRUCTOF) {
+                     j = ex2->val.i;
+                     ex2 = ex2->args[0];
+                 } else
+                     j = 1;
+                 if (ex2->kind == EK_VAR) {
+                     mp = (Meaning *)ex2->val.i;
+                     if (mp->kind == MK_CONST &&
+ 			mp->val.type &&
+                         (mp->val.type->kind == TK_RECORD ||
+                          mp->val.type->kind == TK_ARRAY)) {
+                         if (foldconsts != 1)
+                             note(format_s("Expanding constant %s into another constant [284]",
+                                           mp->name));
+                         ex2 = (Expr *)mp->val.i;
+                     }
+                 }
+                 while (--j >= 0) {
+                     if (ex3) {
+                         if (ex3->kind == EK_STRUCTCONST ||
+                             ex2->kind == EK_STRUCTCONST)
+                             output(",\n");
+                         else if (spacecommas)
+                             output(",\001 ");
+ 			else
+ 			    output(",\001");
+                     }
+                     if (ex2->kind == EK_STRUCTCONST) {
+                         output("{ \005");
+ 			saveindent = outindent;
+ 			moreindent(extrainitindent);
+                         out_expr(ex2);
+                         outindent = saveindent;
+                         output(" }");
+                     } else
+                         out_expr(ex2);
+                     ex3 = ex2;
+                 }
+             }
+             break;
+ 
+         case EK_FUNCTION:
+             mp = (Meaning *)ex->val.i;
+ 	    sp = findsymbol_opt(mp->name);
+ 	    if ((sp && (sp->flags & WARNLIBR)) || mp->warnifused)
+                 note(format_s("Called procedure %s [285]", mp->name));
+             output(mp->name);
+ 	    if (spacefuncs)
+ 		output(" ");
+             output("(\002");
+ 	    j = sp ? (sp->flags & FUNCBREAK) : 0;
+ 	    if (j == FALLBREAK)
+ 		output("\007");
+             for (i = 0; i < ex->nargs; i++) {
+ 		if ((j == FSPCARG1 && i == 1) ||
+ 		    (j == FSPCARG2 && i == 2) ||
+ 		    (j == FSPCARG3 && i == 3))
+ 		    if (spacecommas)
+ 			output(",\011 ");
+ 		    else
+ 			output(",\011");
+                 else if (i > 0)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 out_expr(ex->args[i]);
+             }
+             if (mp->ctx->kind == MK_FUNCTION && mp->ctx->varstructflag) {
+                 if (i > 0)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 out_ctx(mp->ctx, 1);
+             }
+             output(")");
+             break;
+ 
+         case EK_BICALL:
+             cp = ex->val.s;
+             while (*cp == '*')
+                 cp++;
+ 	    sp = findsymbol_opt(cp);
+ 	    if (sp && (sp->flags & WARNLIBR))
+                 note(format_s("Called library procedure %s [286]", cp));
+             output(cp);
+ 	    if (spacefuncs)
+ 		output(" ");
+             output("(\002");
+ 	    j = sp ? (sp->flags & FUNCBREAK) : 0;
+ 	    if (j == FALLBREAK)
+ 		output("\007");
+             for (i = 0; i < ex->nargs; i++) {
+ 		if ((j == FSPCARG1 && i == 1) ||
+ 		    (j == FSPCARG2 && i == 2) ||
+ 		    (j == FSPCARG3 && i == 3))
+ 		    if (spacecommas)
+ 			output(",\011 ");
+ 		    else
+ 			output(",\011");
+                 else if (i > 0)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 out_expr(ex->args[i]);
+             }
+             output(")");
+             break;
+ 
+         case EK_SPCALL:
+             setprec(16);
+             if (starfunctions) {
+                 output("(\002*");
+                 wrexpr(ex->args[0], 13);
+                 output(")");
+             } else
+                 wrexpr(ex->args[0], subprec-1);
+ 	    if (spacefuncs)
+ 		output(" ");
+             output("(\002");
+             for (i = 1; i < ex->nargs; i++) {
+                 if (i > 1)
+ 		    if (spacecommas)
+ 			output(",\002 ");
+ 		    else
+ 			output(",\002");
+                 out_expr(ex->args[i]);
+             }
+             output(")");
+             break;
+ 
+         case EK_INDEX:
+             setprec(16);
+             wrexpr(ex->args[0], subprec-1);
+ 	    if (lookback(1) == ']')
+ 		output("\001");
+             output("[");
+             out_expr(ex->args[1]);
+             output("]");
+             break;
+ 
+         case EK_DOT:
+             setprec2(16);
+ 	    checkbreak(breakbeforedot);
+             if (ex->args[0]->kind == EK_HAT) {
+                 wrexpr(ex->args[0]->args[0], subprec-1);
+                 outop2("->");
+             } else if (ex->args[0]->kind == EK_CTX) {
+                 out_ctx((Meaning *)ex->args[0]->val.i, 0);
+             } else {
+                 wrexpr(ex->args[0], subprec-1);
+                 outop2(".");
+             }
+             if (ex->val.i)
+                 out_field((Meaning *)ex->val.i);
+             else
+                 output(ex->val.s);
+             break;
+ 
+         case EK_POSTINC:
+ 	    if (prec == 0 && !postincrement) {
+ 		setprec(14);
+ 		output("++");
+ 		EXTRASPACE();
+ 		wrexpr(ex->args[0], subprec);
+ 	    } else {
+ 		setprec(15);
+ 		wrexpr(ex->args[0], subprec);
+ 		EXTRASPACE();
+ 		output("++");
+ 	    }
+             break;
+ 
+         case EK_POSTDEC:
+ 	    if (prec == 0 && !postincrement) {
+ 		setprec(14);
+ 		output("--");
+ 		EXTRASPACE();
+ 		wrexpr(ex->args[0], subprec);
+ 	    } else {
+ 		setprec(15);
+ 		wrexpr(ex->args[0], subprec);
+ 		EXTRASPACE();
+ 		output("--");
+ 	    }
+             break;
+ 
+         case EK_HAT:
+             setprec(14);
+ 	    if (lookback_prn(1) == '/')
+ 		output(" ");
+             output("*");
+             EXTRASPACE();
+             wrexpr(ex->args[0], subprec-1);
+             break;
+ 
+         case EK_ADDR:
+             setprec(14);
+ 	    if (lookback_prn(1) == '&')
+ 		output(" ");
+             output("&");
+             EXTRASPACE();
+             wrexpr(ex->args[0], subprec-1);
+             break;
+ 
+         case EK_NEG:
+             setprec(14);
+             output("-");
+             EXTRASPACE();
+             if (ex->args[0]->kind == EK_TIMES)
+                 wrexpr(ex->args[0], 12);
+             else
+                 wrexpr(ex->args[0], subprec-1);
+             break;
+ 
+         case EK_NOT:
+             setprec(14);
+             output("!");
+             EXTRASPACE();
+             wrexpr(ex->args[0], subprec-1);
+             break;
+ 
+         case EK_BNOT:
+             setprec(14);
+             output("~");
+             EXTRASPACE();
+             wrexpr(ex->args[0], subprec-1);
+             break;
+ 
+         case EK_CAST:
+         case EK_ACTCAST:
+             if (similartypes(ex->val.type, ex->args[0]->val.type)) {
+                 wrexpr(ex->args[0], prec);
+             } else if (ord_type(ex->args[0]->val.type)->kind == TK_ENUM &&
+                        ex->val.type == tp_int && !useenum) {
+                 wrexpr(ex->args[0], prec);
+             } else {
+                 setprec2(14);
+                 output("(");
+                 out_type(ex->val.type, 0);
+                 output(")\002");
+                 EXTRASPACE();
+                 if (extraparens != 0)
+                     wrexpr(ex->args[0], 15);
+                 else
+                     wrexpr(ex->args[0], subprec-1);
+             }
+             break;
+ 
+         case EK_LITCAST:
+             setprec2(14);
+             output("(");
+             out_expr(ex->args[0]);
+             output(")\002");
+             EXTRASPACE();
+             if (extraparens != 0)
+                 wrexpr(ex->args[1], 15);
+             else
+                 wrexpr(ex->args[1], subprec-1);
+             break;
+ 
+         case EK_SIZEOF:
+             setprec(14);
+             output("sizeof");
+ 	    if (spacefuncs)
+ 		output(" ");
+ 	    output("(");
+ 	    out_expr(ex->args[0]);
+             output(")");
+             break;
+ 
+ 	case EK_TYPENAME:
+ 	    out_type(ex->val.type, 1);
+ 	    break;
+ 
+         case EK_TIMES:
+ 	    setprec2(13);
+ 	    checkbreak(breakbeforearith);
+             ex2 = copyexpr(ex);
+             if (expr_looks_neg(ex2->args[ex2->nargs-1])) {
+                 ex2->args[0] = makeexpr_neg(ex2->args[0]);
+                 ex2->args[ex2->nargs-1] = makeexpr_neg(ex2->args[ex2->nargs-1]);
+             }
+             wrexpr(ex2->args[0], incompat(ex2, 0, subprec-1));
+             for (i = 1; i < ex2->nargs; i++) {
+                 outop("*");
+                 wrexpr(ex2->args[i], incompat(ex2, i, subprec));
+             }
+             freeexpr(ex2);
+             break;
+ 
+         case EK_DIV:
+         case EK_DIVIDE:
+             setprec2(13);
+ 	    checkbreak(breakbeforearith);
+ 	    wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+             outop("/");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec));
+             break;
+ 
+         case EK_MOD:
+             setprec2(13);
+ 	    checkbreak(breakbeforearith);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+             outop("%");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec));
+             break;
+ 
+         case EK_PLUS:
+             setprec2(12);
+ 	    checkbreak(breakbeforearith);
+             ex2 = copyexpr(ex);
+             minusflag = 0;
+             if (expr_looks_neg(ex2->args[0])) {
+                 j = 1;
+                 while (j < ex2->nargs && expr_looks_neg(ex2->args[j])) j++;
+                 if (j < ex2->nargs)
+                     swapexprs(ex2->args[0], ex2->args[j]);
+             } else if (ex2->val.i && ex2->nargs == 2) {   /* this was originally "a-b" */
+                 if (isliteralconst(ex2->args[1], NULL) != 2) {
+                     if (expr_neg_cost(ex2->args[1]) <= 0) {
+                         minusflag = 1;
+                     } else if (expr_neg_cost(ex2->args[0]) <= 0) {
+                         swapexprs(ex2->args[0], ex2->args[1]);
+                         if (isliteralconst(ex2->args[0], NULL) != 2)
+                             minusflag = 1;
+                     }
+                 }
+             }
+             wrexpr(ex2->args[0], incompat(ex, 0, subprec));
+             for (i = 1; i < ex2->nargs; i++) {
+                 if (expr_looks_neg(ex2->args[i]) || minusflag) {
+                     outop("-");
+                     ex2->args[i] = makeexpr_neg(ex2->args[i]);
+                 } else
+                     outop("+");
+                 wrexpr(ex2->args[i], incompat(ex, i, subprec));
+             }
+             freeexpr(ex2);
+             break;
+ 
+         case EK_LSH:
+             setprec3(11);
+ 	    checkbreak(breakbeforearith);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop("<<");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec));
+             break;
+ 
+         case EK_RSH:
+             setprec3(11);
+ 	    checkbreak(breakbeforearith);
+ 	    wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop(">>");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec));
+             break;
+ 
+         case EK_LT:
+             setprec2(10);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop("<");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_GT:
+             setprec2(10);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop(">");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_LE:
+             setprec2(10);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop("<=");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_GE:
+             setprec2(10);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop(">=");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_EQ:
+             setprec2(9);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop("==");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_NE:
+             setprec2(9);
+ 	    checkbreak(breakbeforerel);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec));
+             outop("!=");
+             wrexpr(ex->args[1], incompat(ex, 0, subprec));
+             break;
+ 
+         case EK_BAND:
+             setprec3(8);
+ 	    if (ex->val.type == tp_boolean)
+ 		checkbreak(breakbeforelog);
+ 	    else
+ 		checkbreak(breakbeforearith);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ 	    outop("&");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+             break;
+ 
+         case EK_BXOR:
+             setprec3(7);
+ 	    checkbreak(breakbeforearith);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+             outop("^");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+             break;
+ 
+         case EK_BOR:
+             setprec3(6);
+ 	    if (ex->val.type == tp_boolean)
+ 		checkbreak(breakbeforelog);
+ 	    else
+ 		checkbreak(breakbeforearith);
+             wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ 	    outop("|");
+             wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+             break;
+ 
+         case EK_AND:
+             setprec3(5);
+ 	    checkbreak(breakbeforelog);
+ 	    wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+             outop("&&");
+ 	    wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+             break;
+ 
+         case EK_OR:
+             setprec3(4);
+ 	    checkbreak(breakbeforelog);
+ 	    wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+             outop("||");
+ 	    wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+             break;
+ 
+         case EK_COND:
+             setprec3(3);
+ 	    i = 0;
+ 	    for (;;) {
+ 		i++;
+ 		if (extraparens != 0)
+ 		    wrexpr(ex->args[0], 15);
+ 		else
+ 		    wrexpr(ex->args[0], subprec);
+ 		NICESPACE();
+ 		output("\002?");
+ 		NICESPACE();
+ 		out_expr(ex->args[1]);
+ 		if (ex->args[2]->kind == EK_COND) {
+ 		    NICESPACE();
+ 		    output("\002:");
+ 		    NICESPACE();
+ 		    ex = ex->args[2];
+ 		} else {
+ 		    NICESPACE();
+ 		    output((i == 1) ? "\017:" : "\002:");
+ 		    NICESPACE();
+ 		    wrexpr(ex->args[2], subprec-1);
+ 		    break;
+ 		}
+ 	    }
+             break;
+ 
+         case EK_ASSIGN:
+             if (ex->args[1]->kind == EK_PLUS &&
+                 exprsame(ex->args[1]->args[0], ex->args[0], 2) &&
+                 ex->args[1]->args[1]->kind == EK_CONST &&
+                 ex->args[1]->args[1]->val.type->kind == TK_INTEGER &&
+                 abs(ex->args[1]->args[1]->val.i) == 1) {
+ 		if (prec == 0 && postincrement) {
+ 		    setprec(15);
+ 		    wrexpr(ex->args[0], subprec);
+ 		    EXTRASPACE();
+ 		    if (ex->args[1]->args[1]->val.i == 1)
+ 			output("++");
+ 		    else
+ 			output("--");
+ 		} else {
+ 		    setprec(14);
+ 		    if (ex->args[1]->args[1]->val.i == 1)
+ 			output("++");
+ 		    else
+ 			output("--");
+ 		    EXTRASPACE();
+ 		    wrexpr(ex->args[0], subprec-1);
+ 		}
+             } else {
+                 setprec2(2);
+ 		checkbreak(breakbeforeassign);
+                 wrexpr(ex->args[0], subprec);
+                 ex2 = copyexpr(ex->args[1]);
+                 j = -1;
+                 switch (ex2->kind) {
+ 
+                     case EK_PLUS:
+                     case EK_TIMES:
+                     case EK_BAND:
+                     case EK_BOR:
+                     case EK_BXOR:
+                         for (i = 0; i < ex2->nargs; i++) {
+                             if (exprsame(ex->args[0], ex2->args[i], 2)) {
+                                 j = i;
+                                 break;
+                             }
+                             if (ex2->val.type->kind == TK_REAL)
+                                 break;   /* non-commutative */
+                         }
+                         break;
+ 
+                     case EK_DIVIDE:
+                     case EK_DIV:
+                     case EK_MOD:
+                     case EK_LSH:
+                     case EK_RSH:
+                         if (exprsame(ex->args[0], ex2->args[0], 2))
+                             j = 0;
+                         break;
+ 
+ 		    default:
+ 			break;
+                 }
+                 if (j >= 0) {
+                     if (ex2->nargs == 2)
+                         ex2 = grabarg(ex2, 1-j);
+                     else
+                         delfreearg(&ex2, j);
+                     switch (ex->args[1]->kind) {
+ 
+                         case EK_PLUS:
+                             if (expr_looks_neg(ex2)) {
+                                 outop("-=");
+                                 ex2 = makeexpr_neg(ex2);
+                             } else
+                                 outop("+=");
+                             break;
+ 
+                         case EK_TIMES:
+                             outop("*=");
+                             break;
+ 
+                         case EK_DIVIDE:
+                         case EK_DIV:
+                             outop("/=");
+                             break;
+ 
+                         case EK_MOD:
+                             outop("%=");
+                             break;
+ 
+                         case EK_LSH:
+                             outop("<<=");
+                             break;
+ 
+                         case EK_RSH:
+                             outop(">>=");
+                             break;
+ 
+                         case EK_BAND:
+                             outop("&=");
+                             break;
+ 
+                         case EK_BOR:
+                             outop("|=");
+                             break;
+ 
+                         case EK_BXOR:
+                             outop("^=");
+                             break;
+ 
+ 			default:
+ 			    break;
+                     }
+                 } else {
+ 		    output(" ");
+ 		    outop3(breakbeforeassign, "=");
+ 		    output(" ");
+                 }
+                 if (extraparens != 0 &&
+                     (ex2->kind == EK_EQ || ex2->kind == EK_NE ||
+                      ex2->kind == EK_GT || ex2->kind == EK_LT ||
+                      ex2->kind == EK_GE || ex2->kind == EK_LE ||
+                      ex2->kind == EK_AND || ex2->kind == EK_OR))
+                     wrexpr(ex2, 16);
+                 else
+                     wrexpr(ex2, subprec-1);
+                 freeexpr(ex2);
+             }
+             break;
+ 
+         case EK_COMMA:
+             setprec3(1);
+             for (i = 0; i < ex->nargs-1; i++) {
+                 wrexpr(ex->args[i], subprec);
+                 output(",\002");
+ 		if (spacecommas)
+ 		    NICESPACE();
+             }
+             wrexpr(ex->args[ex->nargs-1], subprec);
+             break;
+ 
+         default:
+             intwarning("wrexpr", "bad ex->kind [311]");
+     }
+     switch (parens) {
+       case 1:
+         output(")");
+ 	break;
+       case 2:
+ 	output("\004");
+ 	break;
+     }
+ }
+ 
+ 
+ 
+ /* will parenthesize assignments and "," operators */
+ 
+ void out_expr(ex)
+ Expr *ex;
+ {
+     wrexpr(ex, 2);
+ }
+ 
+ 
+ 
+ /* will not parenthesize anything at top level */
+ 
+ void out_expr_top(ex)
+ Expr *ex;
+ {
+     wrexpr(ex, 0);
+ }
+ 
+ 
+ 
+ /* will parenthesize unless only writing a factor */
+ 
+ void out_expr_factor(ex)
+ Expr *ex;
+ {
+     wrexpr(ex, 15);
+ }
+ 
+ 
+ 
+ /* will parenthesize always */
+ 
+ void out_expr_parens(ex)
+ Expr *ex;
+ {
+     output("(");
+     wrexpr(ex, 1);
+     output(")");
+ }
+ 
+ 
+ 
+ /* evaluate expression for side effects only */
+ /* no top-level parentheses */
+ 
+ void out_expr_stmt(ex)
+ Expr *ex;
+ {
+     wrexpr(ex, 0);
+ }
+ 
+ 
+ 
+ /* evaluate expression for boolean (zero/non-zero) result only */
+ /* parenthesizes like out_expr() */
+ 
+ void out_expr_bool(ex)
+ Expr *ex;
+ {
+     wrexpr(ex, 2);
+ }
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,839 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ #define PROTO_STUFF_C
+ #include "trans.h"
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Called regularly, for debugging purposes */
+ 
+ void debughook()
+ {
+ #if 0
+     Symbol *sp;
+     Meaning *mp;
+     static int flag = 0;
+ 
+     sp = findsymbol_opt("DEFSTIPPLES");
+     if (sp) {
+ 	mp = sp->mbase;
+ 	if (mp) {
+ 	    flag = 1;
+ 	    if (mp->sym != sp || mp->snext)
+ 		intwarning("debughook", "Inconsistent!");
+ 	} else
+ 	    if (flag)
+ 		intwarning("debughook", "Missing!");
+     }
+ #endif
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* The "Strlist" data type, like in NEWASM */
+ 
+ 
+ /* Add a string to end of strlist */
+ 
+ Strlist *strlist_append(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+     register Strlist *p;
+ 
+     while (*base)
+         base = &(*base)->next;
+     *base = p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+     p->next = NULL;
+     p->value = 0;
+     strcpy(p->s, s);
+     return p;
+ }
+ 
+ 
+ 
+ /* Insert a string at front of strlist */
+ 
+ Strlist *strlist_insert(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+     register Strlist *p;
+ 
+     p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+     p->next = *base;
+     *base = p;
+     p->value = 0;
+     strcpy(p->s, s);
+     return p;
+ }
+ 
+ 
+ 
+ /* Add a string to a sorted strlist */
+ 
+ Strlist *strlist_add(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+     register Strlist *p;
+ 
+     while ((p = *base) && strcmp(p->s, s) < 0)
+         base = &p->next;
+     if (!p || strcmp(p->s, s)) {
+         p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+         p->next = *base;
+         *base = p;
+         strcpy(p->s, s);
+     }
+     p->value = 0;
+     return p;
+ }
+ 
+ 
+ 
+ /* Append two strlists together */
+ 
+ void strlist_mix(base, sl)
+ register Strlist **base;
+ Strlist *sl;
+ {
+     if (sl) {
+ 	while (*base)
+ 	    base = &(*base)->next;
+ 	*base = sl;
+     }
+ }
+ 
+ 
+ 
+ /* Remove the first element of a strlist */
+ 
+ void strlist_eat(base)
+ register Strlist **base;
+ {
+     register Strlist *p;
+ 
+     if ((p = *base) != NULL) {
+         *base = p->next;
+         FREE(p);
+     }
+ }
+ 
+ 
+ 
+ /* Remove all elements of a strlist */
+ 
+ void strlist_empty(base)
+ register Strlist **base;
+ {
+     register Strlist *p;
+ 
+     if (!base) {
+ 	intwarning("strlist_empty", "NULL base pointer [312]");
+ 	return;
+     }
+     while ((p = *base) != NULL) {
+         *base = p->next;
+         FREE(p);
+     }
+ }
+ 
+ 
+ 
+ /* Remove first occurrence of a given string */
+ 
+ void strlist_remove(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+     register Strlist *p;
+ 
+     while ((p = *base) != NULL) {
+ 	if (!strcmp(p->s, s)) {
+ 	    *base = p->next;
+ 	    FREE(p);
+ 	} else
+ 	    base = &p->next;
+     }
+ }
+ 
+ 
+ 
+ /* Remove a given entry from a strlist */
+ 
+ void strlist_delete(base, sl)
+ register Strlist **base, *sl;
+ {
+     register Strlist *p;
+ 
+     while ((p = *base) && p != sl)
+         base = &p->next;
+     if (p) {
+         *base = p->next;
+         FREE(p);
+     }
+ }
+ 
+ 
+ 
+ /* Find the first occurrence of a string */
+ 
+ Strlist *strlist_find(base, s)
+ register Strlist *base;
+ register char *s;
+ {
+     if (!s)
+ 	return NULL;
+     while (base && strcmp(base->s, s))
+         base = base->next;
+     return base;
+ }
+ 
+ 
+ 
+ /* Case-insensitive version of strlist_find */
+ 
+ Strlist *strlist_cifind(base, s)
+ register Strlist *base;
+ register char *s;
+ {
+     if (!s)
+ 	return NULL;
+     while (base && strcicmp(base->s, s))
+         base = base->next;
+     return base;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* String comparisons */
+ 
+ 
+ int strcincmp(s1, s2, n)
+ register char *s1, *s2;
+ register int n;
+ {
+     register unsigned char ch1, ch2;
+ 
+     while (--n >= 0) {
+         if (!(ch1 = *s1++))
+             return (*s2) ? -1 : 0;
+         if (!(ch2 = *s2++))
+             return 1;
+         if (islower(ch1))
+             ch1 = _toupper(ch1);
+         if (islower(ch2))
+             ch2 = _toupper(ch2);
+         if (ch1 != ch2)
+             return ch1 - ch2;
+     }
+     return 0;
+ }
+ 
+ 
+ 
+ int strcicmp(s1, s2)
+ register char *s1, *s2;
+ {
+     register unsigned char ch1, ch2;
+ 
+     for (;;) {
+         if (!(ch1 = *s1++))
+             return (*s2) ? -1 : 0;
+         if (!(ch2 = *s2++))
+             return 1;
+         if (islower(ch1))
+             ch1 = _toupper(ch1);
+         if (islower(ch2))
+             ch2 = _toupper(ch2);
+         if (ch1 != ch2)
+             return ch1 - ch2;
+     }
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* File name munching */
+ 
+ 
+ void fixfname(fn, ext)
+ char *fn, *ext;
+ {
+     char *cp, *cp2;
+ 
+     if (!ext)
+         return;
+     cp = my_strrchr(fn, '.');
+     cp2 = my_strrchr(fn, '/');
+     if (cp && (!cp2 || cp > cp2)) {
+         if (!cp[1])     /* remove trailing '.' */
+             *cp = 0;
+     } else {
+         strcat(fn, ".");
+         strcat(fn, ext);
+     }
+ }
+ 
+ 
+ 
+ void removesuffix(fn)
+ char *fn;
+ {
+     char *cp, *cp2;
+ 
+     cp = my_strrchr(fn, '.');
+     if (!cp)
+         return;
+ #if defined(unix) || defined(__unix)
+     cp2 = my_strrchr(fn, '/');
+     if (cp2 && cp < cp2)
+         return;
+ #endif
+     *cp = 0;
+ }
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Dynamically-allocated strings */
+ 
+ 
+ char *stralloc(s)
+ char *s;
+ {
+     register char *buf = ALLOC(strlen(s) + 1, char, strings);
+     strcpy(buf, s);
+     return buf;
+ }
+ 
+ 
+ 
+ void strchange(v, s)
+ char **v, *s;
+ {
+     s = stralloc(s);   /* do this first in case **v and *s overlap */
+     FREE(*v);
+     *v = s;
+ }
+ 
+ 
+ 
+ 
+ 
+ /* Handy string formatting */
+ 
+ #define NUMBUF 8
+ static char *(formatbuf[NUMBUF]);
+ static int nextformat = -1;
+ 
+ #define getformat()  ((nextformat=(nextformat+1)%NUMBUF), formatbuf[nextformat])
+ 
+ 
+ #define FF_UCASE   0x1
+ #define FF_LCASE   0x2
+ #define FF_REMSUFF 0x4
+ #define FF_UNDER   0x8     /* Thanks to William Bader for suggesting these */
+ #define FF_PRESERVE 0x10
+ #define FF_REMSLASH 0x20
+ #define FF_REMUNDER 0x40
+ 
+ Static void cvcase(buf, flags)
+ char *buf;
+ int flags;
+ {
+     char *cp, *cp2;
+     int ulflag, i;
+ 
+     if (flags & FF_PRESERVE) {
+         ulflag = 0;
+ 	for (cp = buf; *cp; cp++) {
+ 	    if (isupper(*cp))
+ 		ulflag |= 1;
+ 	    else if (islower(*cp))
+ 		ulflag |= 2;
+ 	}
+ 	if (ulflag == 3)
+ 	    flags &= ~(FF_UCASE | FF_LCASE);
+     }
+     if ((flags & FF_UNDER) && *buf) {
+         for (cp = buf + 1; *cp; cp++) {
+             if (isupper(*cp) && islower(cp[-1])) {
+ 		for (i = strlen(cp); i >= 0; i--)
+ 		    cp[i+1] = cp[i];
+ 		*cp++ = '_';
+ 	    }
+ 	}
+     }
+     if (flags & FF_UCASE) {
+ 	if (flags & FF_LCASE) {
+ 	    for (cp = buf; *cp; cp++) {
+ 		if (cp == buf || !isalpha(cp[-1]))
+ 		    *cp = toupper(*cp);
+ 		else
+ 		    *cp = tolower(*cp);
+ 	    }
+ 	} else
+ 	    upc(buf);
+     } else if (flags & FF_LCASE)
+ 	lwc(buf);
+     if (flags & FF_REMUNDER) {
+ 	for (cp = cp2 = buf; *cp; cp++) {
+ 	    if (isalnum(*cp))
+ 		*cp2++ = *cp;
+ 	}
+ 	if (cp2 > buf)
+ 	    *cp2 = 0;
+     }
+ }
+ 
+ 
+ char *format_gen(fmt, i1, i2, dbl, s1, s2, s3)
+ char *fmt;
+ long i1, i2;
+ double dbl;
+ char *s1, *s2, *s3;
+ {
+     char *buf = getformat();
+     char *dst = buf, *src = fmt, *cp, *cp2, *saves2 = s2;
+     int wid, prec;
+     int flags;
+     char fmtbuf[50], *fp;
+ 
+     debughook();
+     while (*src) {
+ 	if (*src != '%') {
+ 	    *dst++ = *src++;
+ 	    continue;
+ 	}
+ 	src++;
+ 	wid = -1;
+ 	prec = -1;
+ 	flags = 0;
+ 	fp = fmtbuf;
+ 	*fp++ = '%';
+ 	for (;;) {
+ 	    if (*src == '-' || *src == '+' || *src == ' ' || *src == '#') {
+ 		*fp++ = *src;
+ 	    } else if (*src == '^') {
+ 		flags |= FF_UCASE;
+ 	    } else if (*src == '_') {
+ 		flags |= FF_LCASE;
+ 	    } else if (*src == 'R') {
+ 		flags |= FF_REMSUFF;
+ 	    } else if (*src == '~') {
+ 		flags |= FF_UNDER;
+ 	    } else if (*src == '!') {
+ 		flags |= FF_REMUNDER;
+ 	    } else if (*src == '?') {
+ 		flags |= FF_PRESERVE;
+ 	    } else if (*src == '/') {
+ 		flags |= FF_REMSLASH;
+ 	    } else
+ 		break;
+ 	    src++;
+ 	}
+ 	if (isdigit(*src)) {
+ 	    wid = 0;
+ 	    while (isdigit(*src))
+ 		wid = wid*10 + (*fp++ = *src++) - '0';
+ 	} else if (*src == '*') {
+ 	    src++;
+ 	    wid = i1;
+ 	    sprintf(fp, "%d", wid);
+ 	    fp = fp + strlen(fp);
+ 	    if (wid < 0)
+ 		wid = -wid;
+ 	    i1 = i2;
+ 	}
+ 	if (*src == '.') {
+ 	    if (*++src == '*') {
+ 		prec = i1;
+ 		i1 = i2;
+ 		src++;
+ 	    } else {
+ 		prec = 0;
+ 		while (isdigit(*src))
+ 		    prec = prec*10 + (*src++) - '0';
+ 	    }
+ 	    sprintf(fp, ".%d", prec);
+ 	    fp = fp + strlen(fp);
+ 	}
+ 	if (*src == 'l' || *src == 'h')
+ 	    src++;
+ 	switch (*src) {
+ 
+ 	  case '%':
+ 	    *dst++ = '%';
+ 	    break;
+ 
+ 	  case 'H':
+ 	    strcpy(dst, p2c_home);
+ 	    dst = dst + strlen(dst);
+ 	    break;
+ 
+ 	  case 'd':
+ 	  case 'i':
+ 	  case 'o':
+ 	  case 'u':
+ 	  case 'x':
+ 	  case 'X':
+ 	    *fp++ = 'l';
+ 	    *fp++ = *src;
+ 	    *fp = 0;
+ 	    sprintf(dst, fmtbuf, i1);
+ 	    i1 = i2;
+ 	    cvcase(dst, flags);
+ 	    dst = dst + strlen(dst);
+ 	    break;
+ 
+ 	  case 'c':
+ 	    *fp++ = *src;
+ 	    *fp = 0;
+ 	    sprintf(dst, fmtbuf, (int)i1);
+ 	    i1 = i2;
+ 	    cvcase(dst, flags);
+ 	    dst = dst + strlen(dst);
+ 	    break;
+ 
+ 	  case 'e':
+ 	  case 'E':
+ 	  case 'f':
+ 	  case 'g':
+ 	  case 'G':
+ 	    *fp++ = *src;
+ 	    *fp++ = 0;
+ 	    sprintf(dst, fmtbuf, dbl);
+ 	    cvcase(dst, flags);
+ 	    dst = dst + strlen(dst);
+ 	    break;
+ 
+ 	  case 's':
+ 	  case 'S':
+ 	    *fp++ = 's';
+ 	    *fp = 0;
+ 	    if (*src == 'S' && saves2) {
+ 		cp = saves2;
+ 	    } else {
+ 		cp = s1;
+ 		s1 = s2;
+ 		s2 = s3;
+ 	    }
+ 	    if (flags & FF_REMSUFF) {
+ 		cp = format_s("%s", cp);
+ 		removesuffix(cp);
+ 	    }
+ 	    if (flags & FF_REMSLASH) {
+ 		cp2 = cp + strlen(cp);
+ 		while (cp2 >= cp &&
+ 		       *cp2 != '/' && *cp2 != '\\' &&
+ 		       *cp2 != ']' && *cp2 != ':')
+ 		    cp2--;
+ 		if (cp2[1])
+ 		    cp = cp2 + 1;
+ 	    }
+ 	    sprintf(dst, fmtbuf, cp);
+ 	    cvcase(dst, flags);
+ 	    dst = dst + strlen(dst);
+ 	    break;
+ 
+ 	}
+ 	src++;
+     }
+     *dst = 0;
+     return buf;
+ }
+ 
+ 
+ 
+ 
+ char *format_none(fmt)
+ char *fmt;
+ {
+     return format_gen(fmt, 0L, 0L, 0.0, NULL, NULL, NULL);
+ }
+ 
+ 
+ char *format_d(fmt, a1)
+ char *fmt;
+ int a1;
+ {
+     return format_gen(fmt, a1, 0L, (double)a1, NULL, NULL, NULL);
+ }
+ 
+ 
+ char *format_g(fmt, a1)
+ char *fmt;
+ double a1;
+ {
+     return format_gen(fmt, (long)a1, 0L, a1, NULL, NULL, NULL);
+ }
+ 
+ 
+ char *format_s(fmt, a1)
+ char *fmt, *a1;
+ {
+     return format_gen(fmt, 0L, 0L, 0.0, a1, NULL, NULL);
+ }
+ 
+ 
+ char *format_ss(fmt, a1, a2)
+ char *fmt, *a1, *a2;
+ {
+     return format_gen(fmt, 0L, 0L, 0.0, a1, a2, NULL);
+ }
+ 
+ 
+ char *format_sd(fmt, a1, a2)
+ char *fmt, *a1;
+ int a2;
+ {
+     return format_gen(fmt, a2, 0L, (double)a2, a1, NULL, NULL);
+ }
+ 
+ 
+ char *format_ds(fmt, a1, a2)
+ char *fmt, *a2;
+ long a1;
+ {
+     return format_gen(fmt, a1, 0L, (double)a1, a2, NULL, NULL);
+ }
+ 
+ 
+ char *format_dd(fmt, a1, a2)
+ char *fmt;
+ long a1, a2;
+ {
+     return format_gen(fmt, a1, a2, (double)a1, NULL, NULL, NULL);
+ }
+ 
+ 
+ char *format_sss(fmt, a1, a2, a3)
+ char *fmt, *a1, *a2, *a3;
+ {
+     return format_gen(fmt, 0L, 0L, 0.0, a1, a2, a3);
+ }
+ 
+ 
+ char *format_ssd(fmt, a1, a2, a3)
+ char *fmt, *a1, *a2;
+ long a3;
+ {
+     return format_gen(fmt, a3, 0L, (double)a3, a1, a2, NULL);
+ }
+ 
+ 
+ char *format_sds(fmt, a1, a2, a3)
+ char *fmt, *a1, *a3;
+ long a2;
+ {
+     return format_gen(fmt, a2, 0L, (double)a2, a1, a3, NULL);
+ }
+ 
+ 
+ 
+ 
+ /* String conversions */
+ 
+ int my_toupper(c)
+ int c;
+ {
+     if (islower(c))
+ 	return _toupper(c);
+     else
+ 	return c;
+ }
+ 
+ 
+ int my_tolower(c)
+ int c;
+ {
+     if (isupper(c))
+ 	return _tolower(c);
+     else
+ 	return c;
+ }
+ 
+ 
+ void upc(s)
+ register char *s;
+ {
+     for (; *s; s++)
+         *s = toupper(*s);
+ }
+ 
+ 
+ void lwc(s)
+ register char *s;
+ {
+     for (; *s; s++)
+         *s = tolower(*s);
+ }
+ 
+ 
+ char *strupper(s)
+ register char *s;
+ {
+     char *dest = getformat();
+     register char *s2 = dest;
+     while (*s)
+         *s2++ = toupper(*s++);
+     *s2 = 0;
+     return dest;
+ }
+ 
+ 
+ char *strlower(s)
+ register char *s;
+ {
+     char *dest = getformat();
+     register char *s2 = dest;
+     while (*s)
+         *s2++ = tolower(*s++);
+     *s2 = 0;
+     return dest;
+ }
+ 
+ 
+ 
+ char *my_strchr(cp, c)
+ register char *cp;
+ int c;
+ {
+     while (*cp && *cp != c)
+ 	cp++;
+     if (*cp)
+ 	return cp;
+     else
+ 	return NULL;
+ }
+ 
+ 
+ char *my_strrchr(cp, c)
+ register char *cp;
+ int c;
+ {
+     register char *cp2 = NULL;
+     while (*cp) {
+ 	if (*cp == c)
+ 	    cp2 = cp;
+ 	cp++;
+     }
+     return cp2;
+ }
+ 
+ 
+ char *my_strtok(cp, delim)
+ char *cp, *delim;
+ {
+     static char *ptr;
+ 
+     if (cp)
+ 	ptr = cp;
+     while (*ptr && my_strchr(delim, *ptr))
+ 	ptr++;
+     if (!*ptr)
+ 	return NULL;
+     cp = ptr;
+     while (*ptr && !my_strchr(delim, *ptr))
+ 	ptr++;
+     *ptr++ = 0;
+     return cp;
+ }
+ 
+ 
+ 
+ long my_strtol(buf, ret, base)
+ char *buf, **ret;
+ int base;
+ {
+     unsigned long val = 0;
+     int dig, sign = 1;
+ 
+     while (isspace(*buf))
+ 	buf++;
+     if (*buf == '+')
+ 	buf++;
+     else if (*buf == '-') {
+ 	sign = -1;
+ 	buf++;
+     }
+     if (*buf == '0') {
+ 	if ((buf[1] == 'x' || buf[1] == 'X') &&
+ 	    (base == 0 || base == 16)) {
+ 	    buf++;
+ 	    base = 16;
+ 	} else if (base == 0)
+ 	    base = 8;
+ 	buf++;
+     }
+     for (;;) {
+ 	if (isdigit(*buf))
+ 	    dig = *buf - '0';
+ 	else if (*buf >= 'a')
+ 	    dig = *buf - 'a' + 10;
+ 	else if (*buf >= 'A')
+ 	    dig = *buf - 'A' + 10;
+ 	else
+ 	    break;
+ 	if (dig >= base)
+ 	    break;
+ 	val = val * base + dig;
+ 	buf++;
+     }
+     if (ret)
+ 	*ret = buf;
+     if (sign > 0)
+ 	return val;
+     else
+ 	return -val;
+ }
+ 
+ 
+ 
+ 
+ void init_stuff()
+ {
+     int i;
+ 
+     for (i = 0; i < NUMBUF; i++)
+         formatbuf[i] = ALLOC(1000, char, misc);
+ }
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,1512 ----
+ /* "p2c", a Pascal to C translator.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ 
+ #define define_globals
+ #define PROTO_TRANS_C
+ #include "trans.h"
+ 
+ #include <time.h>
+ 
+ 
+ 
+ 
+ 
+ 
+ /* Roadmap:
+ 
+     trans.h         Declarations for all public global variables, types,
+                     and macros.  Functions are declared in separate
+                     files p2c.{proto,hdrs} which are created
+                     mechanically by the makeproto program.
+ 
+     trans.c         Main program.  Parses the p2crc file.  Also reserves
+                     storage for public globals in trans.h.
+ 
+     stuff.c         Miscellaneous support routines.
+ 
+     out.c           Routines to handle the writing of C code to the output
+                     file.  This includes line breaking and indentation
+ 		    support.
+ 
+     comment.c       Routines for managing comments and comment lists.
+ 
+     lex.c           Lexical analyzer.  Manages input files and streams,
+                     splits input stream into Pascal tokens.  Parses
+ 		    compiler directives and special comments.  Also keeps
+ 		    the symbol table.
+ 
+     parse.c         Parsing and writing statements and blocks.
+ 
+     decl.c          Parsing and writing declarations.
+ 
+     expr.c          Manipulating expressions.
+ 
+     pexpr.c         Parsing and writing expressions.
+ 
+     funcs.c         Built-in special functions and procedures.
+ 
+     dir.c           Interface file to "external" functions and procedures
+ 		    such as hpmods and citmods.
+ 
+     hpmods.c        Definitions for HP-supplied Pascal modules.
+ 
+     citmods.c       Definitions for some Caltech-local Pascal modules.
+                     (Outside of Caltech this file is mostly useful
+                     as a large body of examples of how to write your
+                     own translator extensions.)
+ 
+ 
+     p2crc           Control file (read when p2c starts up).
+ 
+     p2c.h           Header file used by translated programs.
+ 
+     p2clib.c        Run-time library used by translated programs.
+ 
+ */
+ 
+ 
+ 
+ 
+ Static Strlist *tweaksymbols, *synonyms;
+ Strlist *addmacros;
+ 
+ 
+ 
+ Static void initrc()
+ {
+     int i;
+ 
+     for (i = 0; i < numparams; i++) {
+         switch (rctable[i].kind) {
+             case 'S':
+ 	    case 'B':
+                 *((short *)rctable[i].ptr) = rctable[i].def;
+                 break;
+             case 'I':
+ 	    case 'D':
+                 *((int *)rctable[i].ptr) = rctable[i].def;
+                 break;
+             case 'L':
+                 *((long *)rctable[i].ptr) = rctable[i].def;
+                 break;
+             case 'R':
+                 *((double *)rctable[i].ptr) = rctable[i].def/100.0;
+                 break;
+             case 'U':
+             case 'C':
+                 *((char *)rctable[i].ptr) = 0;
+                 break;
+             case 'A':
+                 *((Strlist **)rctable[i].ptr) = NULL;
+ 		break;
+ 	    case 'X':
+ 		if (rctable[i].def == 1)
+ 		    *((Strlist **)rctable[i].ptr) = NULL;
+ 		break;
+         }
+         rcprevvalues[i] = NULL;
+     }
+     tweaksymbols = NULL;
+     synonyms = NULL;
+     addmacros = NULL;
+     varmacros = NULL;
+     constmacros = NULL;
+     fieldmacros = NULL;
+     funcmacros = NULL;
+ }
+ 
+ 
+ 
+ Static int readrc(rcname, need)
+ char *rcname;
+ int need;
+ {
+     FILE *rc;
+     char buf[500], *cp, *cp2;
+     long val = 0;
+     int i;
+     Strlist *sl;
+ 
+     rc = fopen(rcname, "r");
+     if (!rc) {
+         if (need)
+             perror(rcname);
+         return 0;
+     }
+     while (fgets(buf, 500, rc)) {
+         cp = my_strtok(buf, " =\t\n");
+         if (cp && *cp != '#') {
+             upc(cp);
+             i = numparams;
+             while (--i >= 0 && strcmp(rctable[i].name, cp)) ;
+             if (i >= 0) {
+                 if (rctable[i].kind != 'M') {
+                     cp = my_strtok(NULL, " =\t\n");
+                     if (cp && *cp == '#')
+                         cp = NULL;
+                     if (cp && (isdigit(*cp) || *cp == '-' || *cp == '+'))
+                         val = atol(cp);
+                     else
+                         val = rctable[i].def;
+                 }
+                 switch (rctable[i].kind) {
+ 
+                     case 'S':
+                         *((short *)rctable[i].ptr) = val;
+                         break;
+ 
+                     case 'I':
+                         *((int *)rctable[i].ptr) = val;
+                         break;
+ 
+                     case 'D':
+                         *((int *)rctable[i].ptr) =
+ 			    parsedelta(cp, rctable[i].def);
+                         break;
+ 
+                     case 'L':
+                         *((long *)rctable[i].ptr) = val;
+                         break;
+ 
+ 		    case 'R':
+ 			if (cp && (isdigit(*cp) || *cp == '-' || *cp == '.'))
+ 			    *((double *)rctable[i].ptr) = atof(cp);
+ 			else
+ 			    *((double *)rctable[i].ptr) = rctable[i].def/100.0;
+ 			break;
+ 
+                     case 'U':
+                         if (cp)
+                             upc(cp);
+ 
+                     /* fall through */
+                     case 'C':
+                         val = rctable[i].def;
+                         strncpy((char *)rctable[i].ptr, cp ? cp : "", val-1);
+                         ((char *)rctable[i].ptr)[val-1] = 0;
+                         break;
+ 
+                     case 'F':
+                         while (cp && *cp != '#') {
+                             sl = strlist_append(&tweaksymbols,
+ 						format_s("*%s", cp));
+                             sl->value = rctable[i].def;
+                             cp = my_strtok(NULL, " \t\n");
+                         }
+                         break;
+ 
+                     case 'G':
+                         while (cp && *cp != '#') {
+                             sl = strlist_append(&tweaksymbols, cp);
+                             sl->value = rctable[i].def;
+                             cp = my_strtok(NULL, " \t\n");
+                         }
+                         break;
+ 
+                     case 'A':
+                         while (cp && *cp != '#') {
+                             strlist_insert((Strlist **)rctable[i].ptr, cp);
+                             cp = my_strtok(NULL, " \t\n");
+                         }
+                         break;
+ 
+                     case 'M':
+                         cp = my_strtok(NULL, "\n");
+                         if (cp) {
+                             while (isspace(*cp)) cp++;
+                             for (cp2 = cp; *cp2 && *cp2 != '#'; cp2++) ;
+                             *cp2 = 0;
+                             if (*cp) {
+                                 sl = strlist_append(&addmacros, cp);
+                                 sl->value = rctable[i].def;
+                             }
+                         }
+                         break;
+ 
+ 		    case 'B':
+ 			if (cp)
+ 			    val = parse_breakstr(cp);
+ 			if (val != -1)
+ 			    *((short *)rctable[i].ptr) = val;
+ 			break;
+ 
+                     case 'X':
+                         switch (rctable[i].def) {
+ 
+                             case 1:     /* strlist with string values */
+                                 if (cp) {
+                                     sl = strlist_append((Strlist **)rctable[i].ptr, cp);
+                                     cp = my_strtok(NULL, " =\t\n");
+                                     if (cp && *cp != '#')
+                                         sl->value = (long)stralloc(cp);
+                                 }
+                                 break;
+ 
+                             case 2:     /* Include */
+                                 if (cp)
+                                     readrc(format_s(cp, infname), 1);
+                                 break;
+ 
+ 			    case 3:     /* Synonym */
+ 				if (cp) {
+ 				    sl = strlist_append(&synonyms, cp);
+ 				    cp = my_strtok(NULL, " =\t\n");
+ 				    if (cp && *cp != '#')
+ 					sl->value = (long)stralloc(cp);
+ 				}
+ 				break;
+ 
+                         }
+                 }
+             } else
+                 fprintf(stderr, "warning: can't understand %s in %s\n", cp, rcname);
+         }
+     }
+     fclose(rc);
+     return 1;
+ }
+ 
+ 
+ Static void postrc()
+ {
+     int longbits;
+     unsigned long val;
+ 
+     which_unix = UNIX_ANY;
+     if (!strcmp(target, "CHIPMUNK") ||
+         !strcmp(target, "HPUX-300") ||
+         !strcmp(target, "SUN-68K") ||
+         !strcmp(target, "BSD-VAX")) {
+         signedchars = 1;
+         sizeof_char = 8;
+         sizeof_short = 16;
+         sizeof_int = sizeof_long = sizeof_pointer = 32;
+         sizeof_enum = 32;
+ 	sizeof_float = 32;
+         sizeof_double = 64;
+         if (!strcmp(target, "CHIPMUNK") ||
+             !strcmp(target, "HPUX-300"))
+             which_unix = UNIX_SYSV;
+         else
+             which_unix = UNIX_BSD;
+     } else if (!strcmp(target, "LSC-MAC")) {
+         signedchars = 1;
+         if (prototypes < 0)
+             prototypes = 1;
+         if (fullprototyping < 0)
+             fullprototyping = 0;
+         if (voidstar < 0)
+             voidstar = 1;
+         sizeof_char = 8;
+         sizeof_short = sizeof_int = 16;
+         sizeof_long = sizeof_pointer = 32;
+     } else if (!strcmp(target, "BSD")) {
+         which_unix = UNIX_BSD;
+     } else if (!strcmp(target, "SYSV")) {
+         which_unix = UNIX_SYSV;
+     } else if (*target) {
+         fprintf(stderr, "p2c: warning: don't understand target name %s\n", target);
+     }
+     if (ansiC > 0) {
+         if (sprintf_value < 0)
+             sprintf_value = 0;
+         if (castnull < 0)
+             castnull = 0;
+     }
+     if (useenum < 0)
+         useenum = (ansiC != 0) ? 1 : 0;
+     if (void_args < 0)
+         void_args = (ansiC > 0 && prototypes != 0) ? 1 : 0;
+     if (prototypes < 0)
+         prototypes = (cplus > 0) ? 2 : (ansiC > 0) ? 1 : 0;
+     if (prototypes == 0)
+         fullprototyping = 0;
+     else if (fullprototyping < 0)
+         fullprototyping = 1;
+     if (useAnyptrMacros < 0)
+ 	useAnyptrMacros = (ansiC > 0 || cplus > 0) ? 2 : 1;
+     if (usePPMacros < 0)
+ 	usePPMacros = (ansiC > 0 || cplus > 0) ? 0 : 2;
+     if (voidstar < 0)
+         voidstar = (ansiC > 0 || cplus > 0) ? 1 : 0;
+     if (hassignedchar < 0)
+         hassignedchar = (ansiC > 0) ? 1 : 0;
+     if (useconsts < 0)
+         useconsts = (ansiC > 0 || cplus > 0) ? 1 : 0;
+     if (copystructs < 0)
+         copystructs = (ansiC != 0 || cplus > 0) ? 3 : 0;
+     if (copystructfuncs < 0)
+         copystructfuncs = (ansiC > 0 || cplus > 0) ? 0 : 1;
+     if (starfunctions < 0)
+         starfunctions = (ansiC > 0) ? 0 : 1;
+     if (variablearrays < 0)
+ 	variablearrays = (ansiC > 1) ? 1 : 0;
+     if (initpacstrings < 0)
+ 	initpacstrings = (ansiC > 0) ? 1 : 0;
+     if (*memcpyname) {
+         if (ansiC > 0 || which_unix == UNIX_SYSV)
+             strcpy(memcpyname, "memcpy");
+         else if (which_unix == UNIX_BSD)
+             strcpy(memcpyname, "bcopy");
+     }
+     sizeof_integer = (sizeof_int >= 32) ? sizeof_int : sizeof_long;
+     integername = (sizeof_int >= 32) ? "int" : "long";
+     if (sizeof_integer && sizeof_integer < 32)
+         fprintf(stderr, "Warning: long integers have less than 32 bits\n");
+     if (sizeof_int >= 32 && sizeof_long > sizeof_int && prototypes == 0)
+         fprintf(stderr, "Warning: translated code assumes int and long are the same");
+     if (setbits < 0)
+         setbits = (sizeof_integer > 0) ? sizeof_integer : 32;
+     ucharname = (*name_UCHAR) ? name_UCHAR :
+                 (signedchars == 0) ? "char" : "unsigned char";
+     scharname = (*name_SCHAR) ? name_SCHAR :
+                 (signedchars == 1) ? "char" : 
+                 (useAnyptrMacros == 1) ? "Signed char" : "signed char";
+     for (longbits = 1, val = LONG_MAX; val >>= 1; longbits++) ;
+     if (sizeof_char) {
+         if (sizeof_char < 8 && ansiC > 0)
+             fprintf(stderr, "Warning: chars have less than 8 bits\n");
+         if (sizeof_char > longbits) {
+             min_schar = LONG_MIN;
+             max_schar = LONG_MAX;
+         } else {
+             min_schar = - (1<<(sizeof_char-1));
+             max_schar = (1<<(sizeof_char-1)) - 1;
+         }
+         if (sizeof_char >= longbits)
+             max_uchar = LONG_MAX;
+         else
+             max_uchar = (1<<sizeof_char) - 1;
+     } else {
+         min_schar = -128;      /* Ansi-required minimum maxima */
+         max_schar = 127;
+         max_uchar = 255;
+     }
+     if (sizeof_short) {
+         if (sizeof_short < 16 && ansiC > 0)
+             fprintf(stderr, "Warning: shorts have less than 16 bits\n");
+         if (sizeof_short > longbits) {
+             min_sshort = LONG_MIN;
+             max_sshort = LONG_MAX;
+         } else {
+             min_sshort = - (1<<(sizeof_short-1));
+             max_sshort = (1<<(sizeof_short-1)) - 1;
+         }
+         if (sizeof_short >= longbits)
+             max_ushort = LONG_MAX;
+         else
+             max_ushort = (1<<sizeof_short) - 1;
+     } else {
+         min_sshort = -32768;   /* Ansi-required minimum maxima */
+         max_sshort = 32767;
+         max_ushort = 65535;
+     }
+     if (symcase < 0)
+         symcase = 1;
+     if (smallsetconst == -2)
+         smallsetconst = (*name_SETBITS) ? -1 : 1;
+     hpux_lang = 0;
+     if (!strcmp(language, "TURBO")) {
+         which_lang = LANG_TURBO;
+     } else if (!strcmp(language, "UCSD")) {
+         which_lang = LANG_UCSD;
+     } else if (!strcmp(language, "MPW")) {
+         which_lang = LANG_MPW;
+     } else if (!strcmp(language, "HPUX") || !strcmp(language, "HP-UX")) {
+ 	which_lang = LANG_HP;
+ 	hpux_lang = 1;
+     } else if (!strcmp(language, "OREGON")) {
+ 	which_lang = LANG_OREGON;
+     } else if (!strcmp(language, "VAX") || !strcmp(language, "VMS")) {
+ 	which_lang = LANG_VAX;
+     } else if (!strncmp(language, "MODULA", 6)) {
+ 	which_lang = LANG_MODULA;
+     } else if (!strncmp(language, "BERK", 4) ||
+ 	       !strcmp(language, "SUN")) {
+ 	which_lang = LANG_BERK;
+     } else {
+         if (*language && strcmp(language, "HP") && strcmp(language, "MODCAL"))
+             fprintf(stderr, "Warning: Language %s not recognized, using HP\n", language);
+         which_lang = LANG_HP;
+     }
+     if (modula2 < 0)
+ 	modula2 = (which_lang == LANG_MODULA) ? 1 : 0;
+     if (pascalcasesens < 0)
+ 	pascalcasesens = (which_lang == LANG_MODULA) ? 2 :
+ 	                 (which_lang == LANG_BERK) ? 3 : 0;
+     if (implementationmodules < 0)
+ 	implementationmodules = (which_lang == LANG_VAX) ? 1 : 0;
+     if (integer16 < 0)
+         integer16 = (which_lang == LANG_TURBO ||
+ 		     which_lang == LANG_MPW) ? 1 : 0;
+     if (doublereals < 0)
+ 	doublereals = (hpux_lang ||
+ 		       which_lang == LANG_OREGON ||
+ 		       which_lang == LANG_VAX) ? 0 : 1;
+     if (pascalenumsize < 0)
+ 	pascalenumsize = (which_lang == LANG_HP) ? 16 : 8;
+     if (storefilenames < 0)
+         storefilenames = (which_lang == LANG_TURBO) ? 1 : 0;
+     if (charfiletext < 0)
+         charfiletext = (which_lang == LANG_BERK) ? 1 : 0;
+     if (readwriteopen < 0)
+ 	readwriteopen = (which_lang == LANG_TURBO) ? 1 : 0;
+     if (literalfilesflag < 0)
+ 	literalfilesflag = (which_lang == LANG_BERK) ? 2 : 0;
+     if (newlinespace < 0)
+         newlinespace = (which_lang == LANG_TURBO) ? 0 : 1;
+     if (nestedcomments < 0)
+         nestedcomments = (which_lang == LANG_TURBO ||
+ 			  which_lang == LANG_MPW ||
+ 			  which_lang == LANG_UCSD ||
+ 			  which_lang == LANG_BERK) ? 2 : 0;
+     if (importall < 0)
+         importall = (which_lang == LANG_HP) ? 1 : 0;
+     if (seek_base < 0)
+         seek_base = (which_lang == LANG_TURBO ||
+ 			  which_lang == LANG_MPW ||
+ 		     which_lang == LANG_UCSD) ? 0 : 1;
+     if (unsignedchar < 0 && signedchars == 0)
+         unsignedchar = 2;
+     if (hasstaticlinks < 0)
+ 	hasstaticlinks = (which_lang == LANG_HP) ? 1 : 0;
+     if (dollar_idents < 0)
+ 	dollar_idents = (which_lang == LANG_OREGON ||
+ 			 which_lang == LANG_VAX) ? 1 : 0;
+     if (ignorenonalpha < 0)
+ 	ignorenonalpha = (which_lang == LANG_UCSD) ? 1 : 0;
+     if (stringtrunclimit < 0)
+ 	stringtrunclimit = (which_lang == LANG_TURBO) ? 80 : 0;
+     if (defaultsetsize < 0)
+ 	defaultsetsize = (which_lang == LANG_VAX) ? 256 :
+ 			 (which_lang == LANG_BERK) ? 128 :
+ 	                 (which_lang == LANG_MPW) ? 2040 : 8192;
+     if (enumbyte < 0)
+ 	enumbyte = (which_lang == LANG_HP) ? 0 : 1;
+     if (!*filenamefilter && (which_lang == LANG_OREGON ||
+ 			     which_lang == LANG_BERK))
+ 	strcpy(filenamefilter, "P_trimname");
+     charname = (useAnyptrMacros) ? "Char" :
+                (unsignedchar == 1) ? ucharname :
+                (unsignedchar == 0) ? scharname : "char";
+     if (!*memcpyname)
+         strcpy(memcpyname, "memcpy");
+     if (!*mallocname)
+         strcpy(mallocname, "malloc");
+     if (!*freename)
+         strcpy(freename, "free");
+     fix_parameters();
+ }
+ 
+ 
+ 
+ 
+ void saveoldfile(fname)
+ char *fname;
+ {
+ #if defined(unix) || defined(__unix) || defined(CAN_LINK)
+     (void) unlink(format_s("%s~", fname));
+     if (link(fname, format_s("%s~", fname)) == 0)
+         (void) unlink(fname);
+ #endif
+ }
+ 
+ 
+ 
+ #ifndef __STDC__
+ # ifdef NO_GETENV
+ #  define getenv(x) NULL
+ # else
+ extern char *getenv PP((char *));
+ # endif
+ #endif
+ 
+ Static long starting_time;
+ 
+ Static void openlogfile()
+ {
+     char *name, *uname;
+ 
+     if (*codefname == '<')
+ 	name = format_ss(logfnfmt, infname, infname);
+     else
+ 	name = format_ss(logfnfmt, infname, codefname);
+     if (!name)
+ 	name = format_s("%s.log", codefname);
+     saveoldfile(name);
+     logf = fopen(name, "w");
+     if (logf) {
+ 	fprintf(logf, "\nTranslation of %s to %s by p2c %s\n",
+ 		infname, codefname, P2C_VERSION);
+ 	fprintf(logf, "Translated");
+ 	uname = getenv("USER");
+ 	if (uname)
+ 	    fprintf(logf, " by %s", uname);
+ 	time(&starting_time);
+ 	fprintf(logf, " on %s", ctime(&starting_time));
+ 	fprintf(logf, "\n\n");
+     } else {
+ 	perror(name);
+ 	verbose = 0;
+     }
+ }
+ 
+ 
+ void closelogfile()
+ {
+     long ending_time;
+ 
+     if (logf) {
+ 	fprintf(logf, "\n\n");
+ #if defined(unix) || defined(__unix)
+ 	fprintf(logf, "Total memory used: %ld bytes.\n", (long)sbrk(0));
+ #endif
+ 	time(&ending_time);
+ 	fprintf(logf, "Processed %d source lines in %ld:%ld seconds.\n",
+ 		inf_ltotal,
+ 		(ending_time - starting_time) / 60,
+ 		(ending_time - starting_time) % 60);
+ 	fprintf(logf, "\n\nTranslation completed on %s", ctime(&ending_time));
+ 	fclose(logf);
+     }
+ }
+ 
+ 
+ 
+ 
+ void showinitfile()
+ {
+     FILE *f;
+     int ch;
+     char *name;
+ 
+     name = format_s("%H/%s", "p2crc");
+     printf("# Copy of file %%H/p2crc => %s:\n\n", name);
+     f = fopen(name, "r");
+     if (!f) {
+ 	perror(name);
+ 	exit(1);
+     }
+     while ((ch = getc(f)) != EOF)
+ 	putchar(ch);
+     fclose(f);
+     exit(0);
+ }
+ 
+ 
+ 
+ 
+ void usage()
+ {
+     fprintf(stderr, "usage: p2c [options] file [modulename] [-h file.h] [-o file.c]\n");
+     exit(EXIT_FAILURE);
+ }
+ 
+ 
+ 
+ int main(argc, argv)
+ int argc;
+ char **argv;
+ {
+     int numsearch;
+     char *searchlist[50];
+     char infnbuf[200], codefnbuf[200], hdrfnbuf[200], *cp;
+     Symbol *sp;
+     Strlist *sl;
+     int i, nobuffer = 0, savequiet;
+     
+     i = 0;
+     while (i < argc && strcmp(argv[i], "-H")) i++;
+     if (i < argc-1)
+ 	p2c_home = argv[i+1];
+     else {
+ 	cp = getenv("P2C_HOME");
+ 	if (cp)
+ 	    p2c_home = cp;
+     }
+     init_stuff();
+     i = 0;
+     while (i < argc && strcmp(argv[i], "-i")) i++;
+     if (i < argc)
+ 	showinitfile();
+     initrc();
+     setup_dir();
+     infname = infnbuf;
+     *infname = 0;
+     i = 0;
+     while (i < argc && argv[i][0] == '-') i++;
+     if (i >= argc)
+ 	strcpy(infname, argv[i]);
+     i = 0;
+     while (i < argc && strcmp(argv[i], "-v")) i++;
+     if (i >= argc) {
+ 	cp = getenv("P2CRC");
+ 	if (cp)
+ 	    readrc(cp, 1);
+ 	else
+ 	    readrc(format_s("%H/%s", "p2crc"), 1);
+     }
+     i = 0;
+     while (i < argc && strcmp(argv[i], "-c")) i++;
+     if (i < argc-1) {
+         if (strcmp(argv[i+1], "-"))
+             readrc(argv[i+1], 1);
+     } else
+         if (!readrc("p2crc", 0))
+             readrc(".p2crc", 0);
+     codefname = codefnbuf;
+     *codefname = 0;
+     hdrfname = hdrfnbuf;
+     *hdrfname = 0;
+     requested_module = NULL;
+     found_module = 0;
+     error_crash = 0;
+ #ifdef CONSERVE_MEMORY
+     conserve_mem = CONSERVE_MEMORY;
+ #else
+     conserve_mem = 1;
+ #endif
+     regression = 0;
+     verbose = 0;
+     partialdump = 1;
+     numsearch = 0;
+     argc--, argv++;
+     while (argc > 0) {
+         if (**argv == '-' && (*argv)[1]) {
+             if (!strcmp(*argv, "-a")) {
+                 ansiC = 1;
+ 	    } else if (argv[0][1] == 'L') {
+ 		if (strlen(*argv) == 2 && argc > 1) {
+ 		    strcpy(language, ++*argv);
+ 		    --argc;
+ 		} else
+ 		    strcpy(language, *argv + 2);
+ 		upc(language);
+             } else if (!strcmp(*argv, "-q")) {
+                 quietmode = 1;
+             } else if (!strcmp(*argv, "-o")) {
+                 if (*codefname || --argc <= 0)
+                     usage();
+                 strcpy(codefname, *++argv);
+             } else if (!strcmp(*argv, "-h")) {
+                 if (*hdrfname || --argc <= 0)
+                     usage();
+                 strcpy(hdrfname, *++argv);
+             } else if (!strcmp(*argv, "-s")) {
+                 if (--argc <= 0)
+                     usage();
+                 cp = *++argv;
+                 if (!strcmp(cp, "-"))
+                     librfiles = NULL;
+                 else
+                     searchlist[numsearch++] = cp;
+             } else if (!strcmp(*argv, "-c")) {
+                 if (--argc <= 0)
+                     usage();
+                 argv++;
+                 /* already done above */
+             } else if (!strcmp(*argv, "-v")) {
+                 /* already done above */
+             } else if (!strcmp(*argv, "-H")) {
+                 /* already done above */
+ 	    } else if (argv[0][1] == 'I') {
+ 		if (strlen(*argv) == 2 && argc > 1) {
+ 		    strlist_append(&importdirs, ++*argv);
+ 		    --argc;
+ 		} else
+ 		    strlist_append(&importdirs, *argv + 2);
+             } else if (argv[0][1] == 'p') {
+                 if (strlen(*argv) == 2)
+                     showprogress = 25;
+                 else
+                     showprogress = atoi(*argv + 2);
+ 		nobuffer = 1;
+             } else if (!strcmp(*argv, "-e")) {
+                 copysource++;
+             } else if (!strcmp(*argv, "-t")) {
+                 tokentrace++;
+             } else if (!strcmp(*argv, "-x")) {
+                 error_crash++;
+ 	    } else if (argv[0][1] == 'E') {
+ 		if (strlen(*argv) == 2)
+ 		    maxerrors = 0;
+ 		else
+ 		    maxerrors = atoi(*argv + 2);
+             } else if (!strcmp(*argv, "-F")) {
+                 partialdump = 0;
+             } else if (argv[0][1] == 'd') {
+ 		nobuffer = 1;
+                 if (strlen(*argv) == 2)
+                     debug = 1;
+                 else
+                     debug = atoi(*argv + 2);
+ 	    } else if (argv[0][1] == 'B') {
+ 		if (strlen(*argv) == 2)
+ 		    i = 1;
+ 		else
+ 		    i = atoi(*argv + 2);
+ 		if (argc == 2 &&
+ 		    strlen(argv[1]) > 2 &&
+ 		    !strcmp(argv[1] + strlen(argv[1]) - 2, ".c")) {
+ 		    testlinebreaker(i, argv[1]);
+ 		    exit(EXIT_SUCCESS);
+ 		} else
+ 		    testlinebreaker(i, NULL);
+ 	    } else if (argv[0][1] == 'C') {
+ 		if (strlen(*argv) == 2)
+ 		    cmtdebug = 1;
+ 		else
+ 		    cmtdebug = atoi(*argv + 2);
+             } else if (!strcmp(*argv, "-R")) {
+ 		regression = 1;
+             } else if (argv[0][1] == 'V') {
+ 		if (strlen(*argv) == 2)
+ 		    verbose = 1;
+ 		else
+ 		    verbose = atoi(*argv + 2);
+             } else if (argv[0][1] == 'M') {
+ 		if (strlen(*argv) == 2)
+ 		    conserve_mem = 1;
+ 		else
+ 		    conserve_mem = atoi(*argv + 2);
+ 	    } else
+                 usage();
+         } else if (!*infname) {
+             strcpy(infname, *argv);
+         } else if (!requested_module) {
+             requested_module = stralloc(*argv);
+         } else
+             usage();
+         argc--, argv++;
+     }
+     if (requested_module && !*codefname)
+ 	strcpy(codefname, format_ss(modulefnfmt, infname, requested_module));
+     if (*infname && strcmp(infname, "-")) {
+ 	if (strlen(infname) > 2 &&
+ 	    !strcmp(infname + strlen(infname) - 2, ".c")) {
+ 	    fprintf(stderr, "What is wrong with this picture?\n");
+ 	    exit(EXIT_FAILURE);
+ 	}
+         inf = fopen(infname, "r");
+         if (!inf) {
+             perror(infname);
+             exit(EXIT_FAILURE);
+         }
+         if (!*codefname)
+             strcpy(codefname, format_s(codefnfmt, infname));
+     } else {
+         strcpy(infname, "<stdin>");
+         inf = stdin;
+         if (!*codefname)
+             strcpy(codefname, "-");
+     }
+     if (strcmp(codefname, "-")) {
+         saveoldfile(codefname);
+         codef = fopen(codefname, "w");
+         if (!codef) {
+             perror(codefname);
+             exit(EXIT_FAILURE);
+         }
+         fprintf(codef, "/* Output from p2c, the Pascal-to-C translator */\n");
+     } else {
+         strcpy(codefname, "<stdout>");
+         codef = stdout;
+     }
+     if (nobuffer)
+         setbuf(codef, NULL);      /* for debugging */
+     outf = codef;
+     outf_lnum = 1;
+     logf = NULL;
+     if (verbose)
+ 	openlogfile();
+     setup_complete = 0;
+     init_lex();
+     leadingcomments();
+     postrc();
+     setup_comment();  /* must call this first */
+     setup_lex();      /* must call this second */
+     setup_out();
+     setup_decl();     /* must call *after* setup_lex() */
+     setup_parse();
+     setup_funcs();
+     for (sl = tweaksymbols; sl; sl = sl->next) {
+ 	cp = sl->s;
+ 	if (*cp == '*') {
+ 	    cp++;
+ 	    if (!pascalcasesens)
+ 		upc(cp);
+ 	}
+         sp = findsymbol(cp);
+ 	if (sl->value & FUNCBREAK)
+ 	    sp->flags &= ~FUNCBREAK;
+         sp->flags |= sl->value;
+     }
+     strlist_empty(&tweaksymbols);
+     for (sl = synonyms; sl; sl = sl->next) {
+ 	if (!pascalcasesens)
+ 	    upc(sl->s);
+ 	sp = findsymbol(sl->s);
+ 	sp->flags |= SSYNONYM;
+ 	if (sl->value) {
+ 	    if (!pascalcasesens)
+ 		upc((char *)sl->value);
+ 	    strlist_append(&sp->symbolnames, "===")->value =
+ 		(long)findsymbol((char *)sl->value);
+ 	} else
+ 	    strlist_append(&sp->symbolnames, "===")->value = 0;
+     }
+     strlist_empty(&synonyms);
+     for (sl = addmacros; sl; sl = sl->next) {
+         defmacro(sl->s, sl->value, "<macro>", 0);
+     }
+     strlist_empty(&addmacros);
+     handle_nameof();
+     setup_complete = 1;
+     savequiet = quietmode;
+     quietmode = 1;
+     for (sl = librfiles; sl; sl = sl->next)
+         (void)p_search(format_none(sl->s), "pas", 0);
+     for (i = 0; i < numsearch; i++)
+         (void)p_search(format_none(searchlist[i]), "pas", 1);
+     quietmode = savequiet;
+     p_program();
+     end_source();
+     flushcomments(NULL, -1, -1);
+     showendnotes();
+     check_unused_macros();
+     printf("\n");
+     if (!showprogress)
+ 	fprintf(stderr, "\n");
+     output("\n");
+     if (requested_module && !found_module)
+         error(format_s("Module \"%s\" not found in file", requested_module));
+     if (codef != stdout)
+         output("\n\n/* End. */\n");
+     if (inf != stdin)
+         fclose(inf);
+     if (codef != stdout)
+         fclose(codef);
+     closelogfile();
+     mem_summary();
+     if (!quietmode)
+         fprintf(stderr, "Translation completed.\n");
+     exit(EXIT_SUCCESS);
+ }
+ 
+ 
+ 
+ 
+ int outmem()
+ {
+     fprintf(stderr, "p2c: Out of memory!\n");
+     exit(EXIT_FAILURE);
+ }
+ 
+ 
+ 
+ #if !defined(NO_ISBOGUS) && (defined(mc68000) || defined(m68k) || defined(vax))
+ int ISBOGUS(p)
+ char *p;
+ {
+     unsigned long ip = (unsigned long)p;
+ 
+     if (ip < 0) {
+ 	if (ip < (unsigned long)&ip)
+ 	    return 1;    /* below the start of the stack */
+     } else if (ip >= 512) {
+ 	if (ip > (unsigned long)sbrk(0))
+ 	    return 1;    /* past the end of memory */
+     } else
+ 	return 1;
+     return 0;
+ }
+ #else
+ #define ISBOGUS(p) 0
+ #endif
+ 
+ 
+ 
+ 
+ 
+ 
+ char *meaningkindname(kind)
+ enum meaningkind kind;
+ {
+ #ifdef HASDUMPS
+     if ((unsigned int)kind < (unsigned int)MK_LAST)
+         return meaningkindnames[(int) kind];
+     else
+ #endif /*HASDUMPS*/
+         return format_d("<meaning %d>", (int) kind);
+ }
+ 
+ char *typekindname(kind)
+ enum typekind kind;
+ {
+ #ifdef HASDUMPS
+     if ((unsigned int)kind < (unsigned int)TK_LAST)
+         return typekindnames[(int) kind];
+     else
+ #endif /*HASDUMPS*/
+         return format_d("<type %d>", (int) kind);
+ }
+ 
+ char *exprkindname(kind)
+ enum exprkind kind;
+ {
+ #ifdef HASDUMPS
+     if ((unsigned int)kind < (unsigned int)EK_LAST)
+         return exprkindnames[(int) kind];
+     else
+ #endif /*HASDUMPS*/
+         return format_d("<expr %d>", (int) kind);
+ }
+ 
+ char *stmtkindname(kind)
+ enum stmtkind kind;
+ {
+ #ifdef HASDUMPS
+     if ((unsigned int)kind < (unsigned int)SK_LAST)
+         return stmtkindnames[(int) kind];
+     else
+ #endif /*HASDUMPS*/
+         return format_d("<stmt %d>", (int) kind);
+ }
+ 
+ 
+ 
+ void dumptype(tp)
+ Type *tp;
+ {
+     if (!tp) {
+         fprintf(outf, "<NULL>\n");
+         return;
+     }
+     if (ISBOGUS(tp)) {
+ 	fprintf(outf, "0x%lX\n", tp);
+ 	return;
+     }
+     fprintf(outf, "      Type %lx, kind=%s", tp, typekindname(tp->kind));
+ #ifdef HASDUMPS
+     fprintf(outf, ", meaning=%lx, basetype=%lx, indextype=%lx\n",
+             tp->meaning, tp->basetype, tp->indextype);
+     tp->dumped = 1;
+     if (tp->basetype)
+ 	dumptype(tp->basetype);
+     if (tp->indextype)
+ 	dumptype(tp->indextype);
+ #else
+     fprintf(outf, "\n");
+ #endif /*HASDUMPS*/
+ }
+ 
+ 
+ void dumpmeaning(mp)
+ Meaning *mp;
+ {
+     if (!mp) {
+         fprintf(outf, "<NULL>\n");
+         return;
+     }
+     if (ISBOGUS(mp)) {
+ 	fprintf(outf, "0x%lX\n", mp);
+ 	return;
+     }
+     fprintf(outf, "   Meaning %lx, name=%s, kind=%s", mp, ((mp->name) ? mp->name : "<null>"),
+                                                      meaningkindname(mp->kind));
+ #ifdef HASDUMPS
+     fprintf(outf, ", ctx=%lx, cbase=%lx, cnext=%lx, type=%lx\n",
+             mp->ctx, mp->cbase, mp->cnext, mp->type);
+     if (mp->type && !mp->type->dumped)
+ 	dumptype(mp->type);
+     mp->dumped = 1;
+ #else
+     fprintf(outf, "\n");
+ #endif /*HASDUMPS*/
+ }
+ 
+ 
+ void dumpsymtable(sym)
+ Symbol *sym;
+ {
+     Meaning *mp;
+ 
+     if (sym) {
+ 	dumpsymtable(sym->left);
+ #ifdef HASDUMPS
+ 	if ((sym->mbase && !sym->mbase->dumped) ||
+ 	    (sym->fbase && !sym->fbase->dumped))
+ #endif
+ 	    {
+ 		fprintf(outf, "Symbol %s:\n", sym->name);
+ 		for (mp = sym->mbase; mp; mp = mp->snext)
+ 		    dumpmeaning(mp);
+ 		for (mp = sym->fbase; mp; mp = mp->snext)
+ 		    dumpmeaning(mp);
+ 		fprintf(outf, "\n");
+ 	    }
+ 	dumpsymtable(sym->right);
+     }
+ }
+ 
+ 
+ void dumptypename(tp, waddr)
+ Type *tp;
+ int waddr;
+ {
+ #ifdef HASDUMPS
+     if (!tp) {
+ 	fprintf(outf, "<NULL>");
+ 	return;
+     }
+     if (ISBOGUS(tp)) {
+ 	fprintf(outf, "0x%lX", tp);
+ 	return;
+     }
+     if (tp == tp_int)             fprintf(outf, "I");
+     else if (tp == tp_sint)       fprintf(outf, "SI");
+     else if (tp == tp_uint)       fprintf(outf, "UI");
+     else if (tp == tp_integer)    fprintf(outf, "L");
+     else if (tp == tp_unsigned)   fprintf(outf, "UL");
+     else if (tp == tp_char)       fprintf(outf, "C");
+     else if (tp == tp_schar)      fprintf(outf, "UC");
+     else if (tp == tp_uchar)      fprintf(outf, "SC");
+     else if (tp == tp_boolean)    fprintf(outf, "B");
+     else if (tp == tp_longreal)   fprintf(outf, "R");
+     else if (tp == tp_real)       fprintf(outf, "F");
+     else if (tp == tp_anyptr)     fprintf(outf, "A");
+     else if (tp == tp_void)       fprintf(outf, "V");
+     else if (tp == tp_text)       fprintf(outf, "T");
+     else if (tp == tp_bigtext)    fprintf(outf, "BT");
+     else if (tp == tp_sshort)     fprintf(outf, "SS");
+     else if (tp == tp_ushort)     fprintf(outf, "US");
+     else if (tp == tp_abyte)      fprintf(outf, "AB");
+     else if (tp == tp_sbyte)      fprintf(outf, "SB");
+     else if (tp == tp_ubyte)      fprintf(outf, "UB");
+     else if (tp == tp_str255)     fprintf(outf, "S");
+     else if (tp == tp_strptr)     fprintf(outf, "SP");
+     else if (tp == tp_charptr)    fprintf(outf, "CP");
+     else if (tp == tp_smallset)   fprintf(outf, "SMS");
+     else if (tp == tp_proc)       fprintf(outf, "PR");
+     else if (tp == tp_jmp_buf)    fprintf(outf, "JB");
+     else {
+ 	if (tp->meaning && !ISBOGUS(tp->meaning) &&
+ 	    tp->meaning->name && !ISBOGUS(tp->meaning->name) &&
+ 	    tp->meaning->name[0]) {
+ 	    fprintf(outf, "%s", tp->meaning->name);
+ 	    if (tp->dumped)
+ 		return;
+ 	    fprintf(outf, "=");
+ 	    waddr = 1;
+ 	}
+ 	if (waddr) {
+ 	    fprintf(outf, "%lX", tp);
+ 	    if (tp->dumped)
+ 		return;
+ 	    fprintf(outf, ":");
+ 	    tp->dumped = 1;
+ 	}
+ 	switch (tp->kind) {
+ 	    
+ 	  case TK_STRING:
+ 	    fprintf(outf, "Str");
+ 	    if (tp->structdefd)
+ 		fprintf(outf, "Conf");
+ 	    break;
+ 
+ 	  case TK_SUBR:
+ 	    dumptypename(tp->basetype, 0);
+ 	    break;
+ 
+ 	  case TK_POINTER:
+ 	    fprintf(outf, "^");
+ 	    dumptypename(tp->basetype, 0);
+ 	    break;
+ 
+ 	  case TK_SMALLARRAY:
+ 	    fprintf(outf, "Sm");
+ 	    /* fall through */
+ 
+ 	  case TK_ARRAY:
+ 	    fprintf(outf, "Ar");
+ 	    if (tp->structdefd)
+ 		fprintf(outf, "Conf");
+ 	    fprintf(outf, "{");
+ 	    dumptypename(tp->indextype, 0);
+ 	    fprintf(outf, "}");
+ 	    if (tp->smin) {
+ 		fprintf(outf, "Skip(");
+ 		dumpexpr(tp->smin);
+ 		fprintf(outf, ")");
+ 	    }
+ 	    if (tp->smax) {
+ 		fprintf(outf, "/");
+ 		if (!ISBOGUS(tp->smax))
+ 		    dumptypename(tp->smax->val.type, 0);
+ 		fprintf(outf, "{%d%s}", tp->escale,
+ 			tp->issigned ? "S" : "U");
+ 	    }
+ 	    fprintf(outf, ":");
+ 	    dumptypename(tp->basetype, 0);
+ 	    break;
+ 		    
+ 	  case TK_SMALLSET:
+ 	    fprintf(outf, "Sm");
+ 	    /* fall through */
+ 
+ 	  case TK_SET:
+ 	    fprintf(outf, "Set{");
+ 	    dumptypename(tp->indextype, 0);
+ 	    fprintf(outf, "}");
+ 	    break;
+ 
+ 	  case TK_FILE:
+ 	    fprintf(outf, "File{");
+ 	    dumptypename(tp->basetype, 0);
+ 	    fprintf(outf, "}");
+ 	    break;
+ 
+ 	  case TK_BIGFILE:
+ 	    fprintf(outf, "BigFile{");
+ 	    dumptypename(tp->basetype, 0);
+ 	    fprintf(outf, "}");
+ 	    break;
+ 
+ 	  case TK_FUNCTION:
+ 	    fprintf(outf, "Func");
+ 	    if (tp->issigned)
+ 		fprintf(outf, "Link");
+ 	    fprintf(outf, "{");
+ 	    dumptypename(tp->basetype, 0);
+ 	    fprintf(outf, "}");
+ 	    break;
+ 
+ 	  case TK_CPROCPTR:
+ 	    fprintf(outf, "C");
+ 	    /* fall through */
+ 
+ 	  case TK_PROCPTR:
+ 	    fprintf(outf, "Proc%d{", tp->escale);
+ 	    dumptypename(tp->basetype, 0);
+ 	    fprintf(outf, "}");
+ 	    break;
+ 
+ 	  default:
+ 	    fprintf(outf, "%s", typekindname(tp->kind));
+ 	    break;
+ 		    
+ 	}
+ 	if (tp->kind != TK_ARRAY && tp->kind != TK_SMALLARRAY &&
+ 	    (tp->smin || tp->smax)) {
+ 	    fprintf(outf, "{");
+ 	    dumpexpr(tp->smin);
+ 	    fprintf(outf, "..");
+ 	    dumpexpr(tp->smax);
+ 	    fprintf(outf, "}");
+ 	}
+     }
+ #else
+     fprintf(outf, "%lX", tp);
+ #endif
+ }
+ 
+ 
+ void dumptypename_file(f, tp)
+ FILE *f;
+ Type *tp;
+ {
+     FILE *save = outf;
+     outf = f;
+     dumptypename(tp, 1);
+     outf = save;
+ }
+ 
+ 
+ void dumpexpr(ex)
+ Expr *ex;
+ {
+     int i;
+     Type *type;
+     char *name;
+ 
+     if (!ex) {
+         fprintf(outf, "<NULL>");
+         return;
+     }
+     if (ISBOGUS(ex)) {
+ 	fprintf(outf, "0x%lX", ex);
+ 	return;
+     }
+     if (ex->kind == EK_CONST && ex->val.type == tp_integer &&
+ 	ex->nargs == 0 && !ex->val.s) {
+ 	fprintf(outf, "%ld", ex->val.i);
+ 	return;
+     }
+     if (ex->kind == EK_LONGCONST && ex->val.type == tp_integer &&
+ 	ex->nargs == 0 && !ex->val.s) {
+ 	fprintf(outf, "%ldL", ex->val.i);
+ 	return;
+     }
+     name = exprkindname(ex->kind);
+     if (!strncmp(name, "EK_", 3))
+ 	name += 3;
+     fprintf(outf, "%s", name);
+ #ifdef HASDUMPS
+ 
+     type = ex->val.type;
+     fprintf(outf, "/");
+     dumptypename(type, 1);
+     if (ex->val.i) {
+         switch (ex->kind) {
+ 
+             case EK_VAR:
+             case EK_FUNCTION:
+             case EK_CTX:
+ 	        if (ISBOGUS(ex->val.i))
+ 		    fprintf(outf, "[0x%lX]", ex->val.i);
+ 		else
+ 		    fprintf(outf, "[\"%s\"]", ((Meaning *)ex->val.i)->name);
+                 break;
+ 
+             default:
+                 fprintf(outf, "[i=%ld]", ex->val.i);
+                 break;
+         }
+     }
+     if (ISBOGUS(ex->val.s))
+ 	fprintf(outf, "[0x%lX]", ex->val.s);
+     else if (ex->val.s) {
+         switch (ex->kind) {
+ 
+             case EK_BICALL:
+             case EK_NAME:
+             case EK_DOT:
+ 	        fprintf(outf, "[s=\"%s\"]", ex->val.s);
+                 break;
+ 
+             default:
+                 switch (ex->val.type ? ex->val.type->kind : TK_VOID) {
+                     case TK_STRING:
+                         fprintf(outf, "[s=%s]", makeCstring(ex->val.s, ex->val.i));
+                         break;
+                     case TK_REAL:
+                         fprintf(outf, "[s=%s]", ex->val.s);
+                         break;
+                     default:
+                         fprintf(outf, "[s=%lx]", ex->val.s);
+                 }
+                 break;
+         }
+     }
+     if (ex->nargs > 0) {
+         fprintf(outf, "(");
+         if (ex->nargs < 10) {
+             for (i = 0; i < ex->nargs; i++) {
+                 if (i)
+                     fprintf(outf, ", ");
+                 dumpexpr(ex->args[i]);
+             }
+         } else
+             fprintf(outf, "...");
+         fprintf(outf, ")");
+     }
+ #endif
+ }
+ 
+ 
+ void dumpexpr_file(f, ex)
+ FILE *f;
+ Expr *ex;
+ {
+     FILE *save = outf;
+     outf = f;
+     dumpexpr(ex);
+     outf = save;
+ }
+ 
+ 
+ void innerdumpstmt(sp, indent)
+ Stmt *sp;
+ int indent;
+ {
+ #ifdef HASDUMPS
+     if (!sp) {
+         fprintf(outf, "<NULL>\n");
+         return;
+     }
+     while (sp) {
+ 	if (ISBOGUS(sp)) {
+ 	    fprintf(outf, "0x%lX\n", sp);
+ 	    return;
+ 	}
+         fprintf(outf, "%s", stmtkindname(sp->kind));
+         if (sp->exp1) {
+             fprintf(outf, ", exp1=");
+             dumpexpr(sp->exp1);
+         }
+         if (sp->exp2) {
+             fprintf(outf, ", exp2=");
+             dumpexpr(sp->exp2);
+         }
+         if (sp->exp3) {
+             fprintf(outf, ", exp3=");
+             dumpexpr(sp->exp3);
+         }
+         fprintf(outf, "\n");
+         if (sp->stm1) {
+             fprintf(outf, "%*sstm1=", indent, "");
+             innerdumpstmt(sp->stm1, indent+5);
+         }
+         if (sp->stm2) {
+             fprintf(outf, "%*sstm2=", indent, "");
+             innerdumpstmt(sp->stm2, indent+5);
+         }
+         sp = sp->next;
+         if (sp) {
+             if (indent > 5)
+                 fprintf(outf, "%*s", indent-5, "");
+             fprintf(outf, "next=");
+         }
+     }
+ #endif
+ }
+ 
+ 
+ void dumpstmt(sp, indent)
+ Stmt *sp;
+ int indent;
+ {
+     fprintf(outf, "%*s", indent, "");
+     innerdumpstmt(sp, indent);
+ }
+ 
+ 
+ void dumpstmt_file(f, sp)
+ FILE *f;
+ Stmt *sp;
+ {
+     FILE *save = outf;
+     Stmt *savenext = NULL;
+     outf = f;
+     if (sp) {
+ 	savenext = sp->next;
+ 	sp->next = NULL;
+     }
+     dumpstmt(sp, 5);
+     if (sp)
+ 	sp->next = savenext;
+     outf = save;
+ }
+ 
+ 
+ 
+ void wrapup()
+ {
+     int i;
+ 
+     for (i = 0; i < SYMHASHSIZE; i++)
+         dumpsymtable(symtab[i]);
+ }
+ 
+ 
+ 
+ 
+ void mem_summary()
+ {
+ #ifdef TEST_MALLOC
+     printf("Summary of memory allocated but not freed:\n");
+     printf("Total bytes = %d of %d\n", final_bytes, total_bytes);
+     printf("Expressions = %d of %d\n", final_exprs, total_exprs);
+     printf("Meanings =    %d of %d (%d of %d)\n",
+ 	   final_meanings, total_meanings,
+ 	   final_meanings / sizeof(Meaning),
+ 	   total_meanings / sizeof(Meaning));
+     printf("Strings =     %d of %d\n", final_strings, total_strings);
+     printf("Symbols =     %d of %d\n", final_symbols, total_symbols);
+     printf("Types =       %d of %d (%d of %d)\n", final_types, total_types,
+ 	   final_types / sizeof(Type), total_types / sizeof(Type));
+     printf("Statements =  %d of %d (%d of %d)\n", final_stmts, total_stmts,
+ 	   final_stmts / sizeof(Stmt), total_stmts / sizeof(Stmt));
+     printf("Strlists =    %d of %d\n", final_strlists, total_strlists);
+     printf("Literals =    %d of %d\n", final_literals, total_literals);
+     printf("Ctxstacks =   %d of %d\n", final_ctxstacks, total_ctxstacks);
+     printf("Temp vars =   %d of %d\n", final_tempvars, total_tempvars);
+     printf("Input recs =  %d of %d\n", final_inprecs, total_inprecs);
+     printf("Parens =      %d of %d\n", final_parens, total_parens);
+     printf("Ptr Descs =   %d of %d\n", final_ptrdescs, total_ptrdescs);
+     printf("Other =       %d of %d\n", final_misc, total_misc);
+     printf("\n");
+ #endif
+ }
+ 
+ 
+ #ifdef TEST_MALLOC
+ 
+ anyptr memlist;
+ 
+ anyptr test_malloc(size, total, final)
+ int size, *total, *final;
+ {
+     anyptr p;
+ 
+     p = malloc(size + 3*sizeof(long));
+ #if 1
+     ((anyptr *)p)[0] = memlist;
+     memlist = p;
+     ((long *)p)[1] = size;
+     ((int **)p)[2] = final;
+     total_bytes += size;
+     final_bytes += size;
+     *total += size;
+     *final += size;
+ #endif
+     return (anyptr)((long *)p + 3);
+ }
+ 
+ void test_free(p)
+ anyptr p;
+ {
+ #if 1
+     final_bytes -= ((long *)p)[1-3];
+     *((int **)p)[2-3] -= ((long *)p)[1-3];
+     ((long *)p)[1-3] *= -1;
+ #endif
+ }
+ 
+ anyptr test_realloc(p, size)
+ anyptr p;
+ int size;
+ {
+     anyptr p2;
+ 
+     p2 = test_malloc(size, &total_misc, &final_misc);
+     memcpy(p2, p, size);
+     test_free(p);
+     return p2;
+ }
+ 
+ #endif  /* TEST_MALLOC */
+ 
+ 
+ 
+ 
+ /* End. */
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h:1.1
*** /dev/null	Mon Feb 16 17:43:41 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h	Mon Feb 16 17:43:28 2004
***************
*** 0 ****
--- 1,1867 ----
+ /* "p2c", a Pascal to C translator, version 1.20.
+    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+    Author: Dave Gillespie.
+    Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING.  If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ 
+ 
+ 
+ 
+ #ifdef __STDC__
+ # define PP(x)  x             /* use true prototypes */
+ # define PV()   (void)
+ # define Anyptr void
+ # define __CAT__(a,b)a##b
+ #else
+ # define PP(x)  ()            /* use old-style declarations */
+ # define PV()   ()
+ # define Anyptr char
+ # define __ID__(a)a
+ # define __CAT__(a,b)__ID__(a)b
+ #endif
+ 
+ #define Static                /* For debugging purposes */
+ 
+ 
+ 
+ #include <stdio.h>
+ 
+ 
+ /* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
+    or -DBSD=1 for BSD systems. */
+ 
+ #ifdef M_XENIX
+ # define BSD 0
+ #endif
+ 
+ #ifdef FILE       /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
+ # ifndef BSD
+ #  define BSD 1
+ # endif
+ #endif
+ 
+ #ifdef BSD
+ # if !BSD
+ #  undef BSD
+ # endif
+ #endif
+ 
+ 
+ #ifdef __STDC__
+ /* # include <stddef.h> */
+ # include <stdlib.h>
+ # include <limits.h>
+ #else
+ # ifndef BSD
+ #  include <malloc.h>
+ #  include <memory.h>
+ #  include <values.h>
+ # endif
+ # define EXIT_SUCCESS 0
+ # define EXIT_FAILURE 1
+ # define CHAR_BIT 8
+ # define LONG_MAX (((unsigned long)~0L) >> 1)
+ # define LONG_MIN (- LONG_MAX - 1)
+ #endif
+ 
+ 
+ 
+ #if defined(BSD) && !defined(__STDC__)
+ # include <strings.h>
+ # define memcpy(a,b,n) bcopy(b,a,n)
+ # define memcmp(a,b,n) bcmp(a,b,n)
+ char *malloc(), *realloc();
+ #else
+ # include <string.h>
+ #endif
+ 
+ #include <ctype.h>
+ 
+ 
+ #ifdef __GNUC__      /* Fast, in-line version of strcmp */
+ # define strcmp(a,b) ({ char *_aa = (a), *_bb = (b); int _diff;  \
+ 			for (;;) {    \
+ 			    if (!*_aa && !*_bb) { _diff = 0; break; }   \
+                             if (*_aa++ != *_bb++)    \
+ 				{ _diff = _aa[-1] - _bb[-1]; break; }   \
+ 			} _diff; })
+ #endif
+ 
+ 
+ #if defined(HASDUMPS) && defined(define_globals)
+ # define DEFDUMPS
+ #endif
+ 
+ 
+ 
+ /* Constants */
+ 
+ #undef MININT      /* we want the Pascal definitions, not the local C definitions */
+ #undef MAXINT
+ 
+ #define MININT     0x80000000
+ #define MAXINT     0x7fffffff
+ 
+ 
+ #ifndef EXIT_SUCCESS
+ # define EXIT_SUCCESS  0
+ # define EXIT_FAILURE  1
+ #endif
+ 
+ 
+ #ifndef P2C_HOME
+ # ifdef citPWS
+ #  define    P2C_HOME        "/lib/p2c"
+ # else
+ #  define    P2C_HOME        "/usr/local/p2c"     /* sounds reasonable... */
+ # endif
+ #endif
+ 
+ #ifdef define_globals
+ char *p2c_home = P2C_HOME;
+ #else
+ extern char *p2c_home;
+ #endif
+ 
+ #define P2C_VERSION  "1.20"
+ 
+ 
+ 
+ 
+ /* Types */
+ 
+ #ifdef __STDC__
+ typedef void *anyptr;
+ #else
+ typedef char *anyptr;
+ #endif
+ 
+ typedef unsigned char uchar;
+ 
+ 
+ 
+ /* Ought to rearrange token assignments at the next full re-compile */
+ 
+ typedef enum E_token {
+     TOK_NONE,
+ 
+     /* reserved words */
+     TOK_AND, TOK_ARRAY, TOK_BEGIN, TOK_CASE, TOK_CONST,
+     TOK_DIV, TOK_DO, TOK_DOWNTO, TOK_ELSE, TOK_END,
+     TOK_FILE, TOK_FOR, TOK_FUNCTION, TOK_GOTO, TOK_IF,
+     TOK_IN, TOK_LABEL, TOK_MOD, TOK_NIL, TOK_NOT,
+     TOK_OF, TOK_OR, TOK_PACKED, TOK_PROCEDURE, TOK_PROGRAM,
+     TOK_RECORD, TOK_REPEAT, TOK_SET, TOK_THEN, TOK_TO,
+     TOK_TYPE, TOK_UNTIL, TOK_VAR, TOK_WHILE, TOK_WITH,
+ 
+     /* symbols */
+     TOK_DOLLAR, TOK_STRLIT, TOK_LPAR, TOK_RPAR, TOK_STAR,
+     TOK_PLUS, TOK_COMMA, TOK_MINUS, TOK_DOT, TOK_DOTS,
+     TOK_SLASH, TOK_INTLIT, TOK_REALLIT, TOK_COLON, TOK_ASSIGN,
+     TOK_SEMI, TOK_NE, TOK_LT, TOK_GT, TOK_LE, TOK_GE,
+     TOK_EQ, TOK_LBR, TOK_RBR, TOK_HAT,
+     TOK_INCLUDE, TOK_ENDIF,
+     TOK_IDENT, TOK_MININT, TOK_EOF,
+ 
+     /* C symbols */
+     TOK_ARROW, TOK_AMP, TOK_VBAR, TOK_BANG,
+     TOK_TWIDDLE, TOK_PERC, TOK_QM,
+     TOK_LTLT, TOK_GTGT, TOK_EQEQ, TOK_BANGEQ,
+     TOK_PLPL, TOK_MIMI, TOK_ANDAND, TOK_OROR,
+     TOK_LBRACE, TOK_RBRACE, TOK_CHARLIT,
+ 
+     /* HP Pascal tokens */
+     TOK_ANYVAR, TOK_EXPORT, TOK_IMPLEMENT, TOK_IMPORT, TOK_MODULE,
+     TOK_OTHERWISE, TOK_RECOVER, TOK_TRY,
+ 
+     /* Turbo Pascal tokens */
+     TOK_SHL, TOK_SHR, TOK_XOR, TOK_INLINE, TOK_ABSOLUTE,
+     TOK_INTERRUPT, TOK_ADDR, TOK_HEXLIT,
+ 
+     /* Oregon Software Pascal tokens */
+     TOK_ORIGIN, TOK_INTFONLY,
+ 
+     /* VAX Pascal tokens */
+     TOK_REM, TOK_VALUE, TOK_VARYING, TOK_OCTLIT, TOK_COLONCOLON,
+     TOK_STARSTAR,
+ 
+     /* Modula-2 tokens */
+     TOK_BY, TOK_DEFINITION, TOK_ELSIF, TOK_FROM, TOK_LOOP,
+     TOK_POINTER, TOK_QUALIFIED, TOK_RETURN,
+ 
+     /* UCSD Pascal tokens */
+     TOK_SEGMENT,
+ 
+     TOK_LAST
+ } Token;
+ 
+ #ifdef define_globals
+ char *toknames[(int)TOK_LAST] = { "",
+     "AND", "ARRAY", "BEGIN", "CASE", "CONST",
+     "DIV", "DO", "DOWNTO", "ELSE", "END",
+     "FILE", "FOR", "FUNCTION", "GOTO", "IF",
+     "IN", "LABEL", "MOD", "NIL", "NOT",
+     "OF", "OR", "PACKED", "PROCEDURE", "PROGRAM",
+     "RECORD", "REPEAT", "SET", "THEN", "TO",
+     "TYPE", "UNTIL", "VAR", "WHILE", "WITH",
+ 
+     "a '$'", "a string literal", "a '('", "a ')'", "a '*'",
+     "a '+'", "a comma", "a '-'", "a '.'", "'..'",
+     "a '/'", "an integer", "a real number", "a colon", "a ':='",
+     "a semicolon", "a '<>'", "a '<'", "a '>'", "a '<='", "a '>='",
+     "an '='", "a '['", "a ']'", "a '^'",
+     "an \"include\" file", "$end$",
+     "an identifier", "an integer", "end of file",
+ 
+     "an '->'", "an '&'", "a '|'", "a '!'", 
+     "a '~'", "a '%'", "a '?'",
+     "a '<<'", "a '>>'", "a '=='", "a '!='",
+     "a '++'", "a '--'", "a '&&'", "a '||'",
+     "a '{'", "a '}'", "a character literal",
+ 
+     "ANYVAR", "EXPORT", "IMPLEMENT", "IMPORT", "MODULE",
+     "OTHERWISE", "RECOVER", "TRY",
+ 
+     "SHL", "SHR", "XOR", "INLINE", "ABSOLUTE",
+     "INTERRUPT", "an '@'", "a hex integer",
+ 
+     "ORIGIN", "INTF-ONLY",
+ 
+     "REM", "VALUE", "VARYING", "an octal integer", "a '::'",
+     "a '**'",
+ 
+     "BY", "DEFINITION", "ELSIF", "FROM", "LOOP",
+     "POINTER", "QUALIFIED", "RETURN",
+ 
+     "SEGMENT"
+ } ;
+ #else
+ extern char *toknames[];
+ #endif /*define_globals*/
+ 
+ typedef struct S_strlist {
+     struct S_strlist *next;
+     long value;
+     char s[1];
+ } Strlist;
+ 
+ 
+ 
+ typedef struct S_value {
+     struct S_type *type;
+     long i;
+     char *s;
+ } Value;
+ 
+ 
+ 
+ /* "Symbol" notes:
+  *
+  * The symbol table is used for several things.  Mainly it records all
+  * identifiers in the Pascal program (normally converted to upper case).
+  * Also used for recording certain properties about C and Pascal names.
+  *
+  * The symbol table is a hash table of binary trees.
+  */
+ 
+ #define AVOIDNAME  0x1         /* Avoid this name in C code */
+ #define WARNNAME   0x2	       /* Warn if using this name in C code */
+ #define AVOIDGLOB  0x4	       /* Avoid C name except private to module */
+ #define NOSIDEEFF  0x8	       /* Function by this name has no side effects */
+ #define STRUCTF    0x10	       /* Function by this name is a StructFunction */
+ #define STRLAPF    0x20	       /* Function by this name is a StrlapFunction */
+ #define LEAVEALONE 0x40	       /* Do not use custom handler for function */
+ #define DETERMF    0x80	       /* Function by this name is Deterministic */
+ #define FMACREC    0x100       /* Used by FieldMacro stuff */
+ #define AVOIDFIELD 0x200       /* Avoid this name as a struct field name */
+ #define NEEDSTATIC 0x400       /* This name must be declared static */
+ #define KWPOSS     0x800       /* This word may be a keyword */
+ #define FUNCBREAK  0x7000      /* Line breaking flags (see sys.p2crc) */
+ # define FALLBREAK  0x1000     /*  Break at all commas if at any */
+ # define FSPCARG1   0x2000     /*  First argument is special */
+ # define FSPCARG2   0x3000     /*  First two arguments are special */
+ # define FSPCARG3   0x4000     /*  First three arguments are special */
+ #define WARNLIBR   0x8000      /* Warn for all uses of this library function */
+ #define FWDPARAM   0x10000     /* Was a param name for forward-declared func */
+ #define SSYNONYM   0x20000     /* Symbol is a synonym for another */
+ 
+ typedef struct S_symbol {
+     struct S_symbol *left;     /* Left pointer in binary tree */
+     struct S_symbol *right;    /* Right pointer in binary tree */
+     struct S_meaning *mbase;   /* First normal meaning for this symbol */
+     struct S_meaning *fbase;   /* First record-field meaning for this symbol */
+     Strlist *symbolnames;      /* List of NameOf's for this name */
+     long flags;		       /* (above) */
+     Token kwtok;	       /* Token, if symbol is a keyword */
+     char name[1];              /* Pascal name (actually variable-sized) */
+ } Symbol;
+ 
+ 
+ 
+ /* "Meaning" notes:
+  *
+  * This represents one meaning of a symbol (see below).  Meanings are
+  * organized in a tree of contexts (i.e., scopes), and also in linked
+  * lists of meanings per symbol.  Fields described in the following are
+  * undefined for kinds where they are not listed.  Other fields are
+  * defined in all kinds of meanings.
+  *
+  * MK_MODULE:  Program, module, or unit.
+  *    mp->anyvarflag = 1 if main program, 0 if module.
+  *    mp->cbase => First meaning in module's context.
+  *
+  * MK_CONST:  Pascal CONST.
+  *    mp->type => Type of constant, same as mp->constdefn->type & mp->val.type.
+  *    mp->anyvarflag = 1 if FoldConstants was true when defined.
+  *    mp->constdefn => Expression for the value of the constant.
+  *    mp->val = Value of the const, if can be evaluated, else val.type is NULL.
+  *    mp->xnext => Next constant in enumeration, else NULL.
+  *    mp->isreturn = 1 if constant was declared as a macro (with #define).
+  *
+  * MK_TYPE:  Pascal type name.
+  *    mp->type => Type which name represents.
+  *
+  * MK_VAR:  Normal variable.
+  *    mp->type => Type of variable.
+  *    mp->constdefn => Initializer for variable, else NULL.
+  *    mp->varstructflag = 1 if variable is in parent function's varstruct.
+  *    mp->isforward = 1 if should be declared static.
+  *    mp->isfunction = 1 if should be declared extern.
+  *    mp->namedfile = 1 if this file variable has a shadow file-name variable.
+  *    mp->bufferedfile = 1 if this file variable has a shadow buffer variable.
+  *    mp->val.s => name format string if temporary var, else NULL.
+  *
+  * MK_VARREF:  Variable always referenced through a pointer.
+  *    mp->type => Type "pointer to T" where T is type of variable.
+  *    mp->constdefn => Initializer for the pointer, else NULL.
+  *    (Others same as for MK_VAR.)
+  *
+  * MK_VARMAC:  Variable which has a VarMacro.
+  *    mp->type => Type of variable.
+  *    mp->constdefn => Expression for VarMacro definition.
+  *    (Others same as for MK_VAR.)
+  *
+  * MK_SPVAR:  Special variable.
+  *    mp->handler => C function to parse and translate the special variable.
+  *
+  * MK_FIELD:  Record/struct field name.
+  *    mp->ctx, cbase = unused (unlike other meanings).
+  *    mp->cnext => Next field in record or variant.
+  *    mp->type => Type of field (base type if a bit-field).
+  *    mp->rectype => Type of containing record.
+  *    mp->constdefn => Expression for definition if FieldMacro, else NULL.
+  *    mp->val.i = Number of bits if bit-field, or 0 if normal field.
+  *    mp->val.type => True type of bit-field, else same as mp->type.
+  *    mp->isforward = 1 if tag field for following variant, else 0.
+  *    mp->namedfile = 1 if this file field has a shadow file-name field.
+  *    mp->bufferedfile = 1 if this file field has a shadow buffer field.
+  *
+  * MK_VARIANT:  Header for variant record case.
+  *    mp->ctx => First field in variant (unlike other meanings).
+  *    mp->cbase = unused (unlike other meanings).
+  *    mp->cnext => Next variant in record (or next sub-variant in variant).
+  *    mp->rectype => Type of containing record.
+  *    mp->val = Tag value of variant.
+  *
+  * MK_LABEL:  Statement label.
+  *    mp->val.i => Case number if used by non-local gotos, else -1.
+  *    mp->xnext => MK_VAR representing associated jmp_buf variable.
+  *    (All optional fields are unused.)
+  *
+  * MK_FUNCTION:  Procedure or function.
+  *    mp->type => TK_FUNCTION type.
+  *    mp->cbase => First meaning in procedure's context (when isfunction is 1,
+  *		   this will always be the return-value meaning.)
+  *    mp->val.i => Body of the function (cast to Stmt *).
+  *    mp->constdefn => Expression for definition if FuncMacro, else NULL.
+  *    mp->handler => C function to adjust parse tree if predefined, else NULL.
+  *    mp->isfunction = 1 if function, 0 if procedure.
+  *    mp->isforward = 1 if function has been declared forward.
+  *    mp->varstructflag = 1 if function has a varstruct.
+  *    mp->needvarstruct = 1 if no varstruct yet but may need one.
+  *    mp->namedfile = 1 if function should be declared "inline".
+  *
+  * MK_SPECIAL:  Special, irregular built-in function.
+  *    mp->handler => C function to parse and translate the special function.
+  *    mp->constdefn => Expression for definition if FuncMacro, else NULL.
+  *    mp->isfunction = 1 if function, 0 if procedure.
+  *
+  * MK_PARAM:  Procedure or function parameter, or function return value.
+  *    mp->type => Type of parameter.
+  *    mp->isreturn = 1 if a function return value (not on parameter list).
+  *    mp->xnext => Next parameter of function.
+  *    mp->fakeparam = 1 if a fake parameter (e.g., conformant array size).
+  *    mp->othername => Name of true param if this one is a local copy.
+  *    mp->rectype => Type of true param if this one is a local copy.
+  *		     If a normal copy param, will be "pointer to" mp->type.
+  *		     If copied for varstruct reasons, will be same as mp->type.
+  *    mp->varstructflag = 1 if variable is in parent function's varstruct.
+  *
+  * MK_VARPARAM:  VAR parameter, or StructFunction return value.
+  *    mp->type => Type "pointer to T" where T is type of parameter.
+  *    mp->anyvarflag = 1 if no type checking is to be applied to parameter.
+  *    mp->isreturn = 1 if a StructFunction return value (will be first param).
+  *    (Others same as for MK_PARAM.)
+  *
+  * MK_VARPARAM with mp->type == tp_anyptr:  Turbo "typeless var" parameter.
+  *    mp->type = tp_anyptr.
+  *    mp->anyvarflag = 1.
+  *    (Others same as for MK_PARAM.)
+  *
+  * MK_VARPARAM with mp->type == tp_strptr:  HP Pascal "var s:string" parameter.
+  *    mp->type = tp_strptr.
+  *    mp->anyvarflag = 1 if a separate "strmax" parameter is passed.
+  *    (Others same as for MK_PARAM.)
+  *
+  * MK_SYNONYM:  Meaning which should be treated as identical to another.
+  *    mp->xnext => Actual meaning to be used.
+  *
+  */
+ 
+ enum meaningkind {
+     MK_NONE, MK_SPECIAL,
+     MK_MODULE, MK_FUNCTION, MK_CONST, MK_VAR, MK_TYPE,
+     MK_FIELD, MK_LABEL, MK_VARIANT,
+     MK_PARAM, MK_VARPARAM, MK_VARREF, MK_VARMAC,
+     MK_SPVAR, MK_SYNONYM,
+     MK_LAST
+ } ;
+ 
+ #ifdef DEFDUMPS
+ char *meaningkindnames[(int)MK_LAST] = {
+     "MK_NONE", "MK_SPECIAL",
+     "MK_MODULE", "MK_FUNCTION", "MK_CONST", "MK_VAR", "MK_TYPE",
+     "MK_FIELD", "MK_LABEL", "MK_VARIANT",
+     "MK_PARAM", "MK_VARPARAM", "MK_VARREF", "MK_VARMAC",
+     "MK_SPVAR", "MK_SYNONYM"
+ } ;
+ #endif /*DEFDUMPS*/
+ 
+ typedef struct S_meaning {
+     struct S_meaning *snext;   /* Next meaning for this symbol */
+     struct S_meaning *cnext;   /* Next meaning in this meaning's context */
+     struct S_meaning *cbase;   /* First meaning in this context */
+     struct S_meaning *ctx;     /* Context of this meaning */
+     struct S_meaning *xnext;   /* (above) */
+     struct S_meaning *dtype;   /* Declared type name, if any */
+     struct S_symbol *sym;      /* Symbol of which this is a meaning */
+     struct S_type *type;       /* (above) */
+     struct S_type *rectype;    /* (above) */
+     struct S_expr *constdefn;  /* (above) */
+     enum meaningkind kind;     /* Kind of meaning */
+     unsigned needvarstruct:1,  /* (above) */
+              varstructflag:1,  /* (above) */
+              wasdeclared:1,    /* Declaration has been written for meaning */
+              istemporary:1,    /* Is a temporary variable */
+              isforward:1,      /* (above) */
+              isfunction:1,     /* (above) */
+              anyvarflag:1,     /* (above) */
+              isactive:1,       /* Meaning is currently in scope */
+              exported:1,       /* Meaning is visible outside this module */
+              warnifused:1,     /* WarnNames was 1 when meaning was declared */
+              dumped:1,	       /* Has been dumped (for debugging) */
+              isreturn:1,       /* (above) */
+              fakeparam:1,      /* (above) */
+              namedfile:1,      /* (above) */
+              bufferedfile:1,   /* (above) */
+              volatilequal:1,   /* Object has C "volatile" qualifier */
+              constqual:1,      /* Object has C "const" qualifier */
+              dummy17:1, dummy18:1, dummy19:1, 
+ 	     dummy20:1, dummy21:1, dummy22:1, dummy23:1, dummy24:1, dummy25:1, 
+ 	     dummy26:1, dummy27:1, dummy28:1, dummy29:1, dummy30:1, dummy31:1;
+     Value val;		       /* (above) */
+     int refcount;	       /* Number of references to meaning in program */
+     char *name;		       /* Print name (i.e., C name) of the meaning */
+     char *othername;	       /* (above) */
+     struct S_expr *(*handler)();   /* Custom translator for procedure */
+     Strlist *comments;	       /* Comments associated with meaning */
+ } Meaning;
+ 
+ 
+ 
+ /* "Type" notes:
+  *
+  * This struct represents a data type.  Types are stored in a strange
+  * cross between Pascal and C semantics.  (This usually works out okay.)
+  *
+  * TK_INTEGER:  Base integer type.
+  *    The following types are TK_INTEGER:
+  *        tp_integer, tp_unsigned, tp_int, tp_uint, tp_sint.
+  *    All other integer types are represented by subranges.
+  *    tp->smin => Minimum value for integer.
+  *    tp->smax => Maximum value for integer.
+  *
+  * TK_CHAR:  Base character type.
+  *    The following types are TK_CHAR:  tp_char, tp_schar, tp_uchar.
+  *    All other character types are represented by subranges.
+  *    tp->smin => Minimum value for character.
+  *    tp->smax => Maximum value for character.
+  *
+  * TK_BOOLEAN:  Boolean type.
+  *    The only TK_BOOLEAN type is tp_boolean.
+  *    tp->smin => "False" expression.
+  *    tp->smax => "True" expression.
+  *
+  * TK_REAL:  Real types.
+  *    The only TK_REAL types are tp_real, tp_longreal, and/or the SINGLE type.
+  *
+  * TK_VOID:  C "void" type.
+  *    The only TK_VOID type is tp_void.
+  *
+  * TK_SUBR:  Subrange of ordinal type.
+  *    tp->basetype => a TK_INTEGER, TK_CHAR, TK_BOOLEAN, or TK_ENUM type.
+  *    tp->smin => Minimum ordinal value for subrange.
+  *    tp->smax => Maximum ordinal value for subrange.
+  *
+  * TK_ENUM:  Enumerated type.
+  *    tp->fbase => First enumeration constant.
+  *    tp->smin => Minimum value (zero).
+  *    tp->smax => Maximum value (number of choices minus 1).
+  *
+  * TK_POINTER:  Pointer type.
+  *    tp->basetype => Base type of pointer.
+  *    tp->smin => EK_NAME for type if not-yet-resolved forward; else NULL.
+  *    tp->fbase => Actual type name for tp->basetype, or NULL.
+  *    Only one pointer type is ever generated for a given other type;
+  *    each tp->pointertype points back to that type if it has been generated.
+  *
+  * TK_STRING:  Pascal string or VARYING OF CHAR type.
+  *    tp->basetype => tp_char.
+  *    tp->indextype => TK_SUBR from 0 to maximum string length.
+  *    tp->structdefd = 1 if type is for a conformant VARYING OF CHAR parameter.
+  *
+  * TK_RECORD:  Pascal record/C struct type.
+  *    tp->fbase => First field in record.
+  *    tp->structdefd = 1 if struct type has been declared in output.
+  *
+  * TK_ARRAY with smax == NULL:  Normal array type.
+  *    tp->basetype => Element type of array.
+  *    tp->indextype => Index type (usually a TK_SUBR).
+  *    tp->smin => Integer constant if SkipIndices was used, else NULL.
+  *    tp->smax = NULL.
+  *    tp->structdefd = 1 if type is for a conformant array parameter.
+  *    tp->fbase => Actual type name for tp->basetype, or NULL.
+  *
+  * TK_ARRAY with smax != NULL:  Large packed array type.
+  *    tp->basetype => Element type of C array (tp_ubyte/tp_sbyte/tp_sshort).
+  *    tp->indextype => Index type (usually a TK_SUBR).
+  *    tp->smin => Integer constant if SkipIndices was used, else NULL.
+  *    tp->smax => EK_TYPENAME for element type of Pascal array.
+  *    tp->escale = log-base-two of number of bits per packed element, else 0.
+  *    tp->issigned = 1 if packed array elements are signed, 0 if unsigned.
+  *    tp->structdefd = 1 if type is for a conformant array parameter.
+  *    tp->fbase => Actual type name for tp->basetype, or NULL.
+  *
+  * TK_SMALLARRAY:  Packed array fitting within a single integer.
+  *    (Same as for packed TK_ARRAY.)
+  *
+  * TK_SET:  Normal set type.
+  *    tp->basetype => tp_integer.
+  *    tp->indextype => Element type of the set.
+  *
+  * TK_SMALLSET:  Set fitting within a single integer.
+  *    (Same as for TK_SET.)
+  *
+  * TK_FILE:  File type (corresponds to C "FILE" type).
+  *    tp->basetype => Type of file elements, or tp_abyte if UCSD untyped file.
+  *    A Pascal "file" variable is represented as a TK_POINTER to a TK_FILE.
+  *
+  * TK_BIGFILE:  File type with attached buffers and name.
+  *    tp->basetype => Type of file elements, or tp_abyte if UCSD untyped file.
+  *    A Pascal "file" variable is represented directly as a TK_BIGFILE.
+  *
+  * TK_FUNCTION:  Procedure or procedure-pointer type.
+  *    tp->basetype => Return type of function, or tp_void if procedure.
+  *    tp->issigned = 1 if type has a generic static link.
+  *    tp->fbase => First argument (or StructFunction return buffer pointer).
+  *
+  * TK_PROCPTR:  Procedure pointer with static link.
+  *    tp->basetype => TK_FUNCTION type.
+  *    tp->fbase => Internal Meaning struct associated with basetype.
+  *    tp->escale = Value of StaticLinks when type was declared.
+  *
+  * TK_CPROCPTR:  Procedure pointer without static link.
+  *    tp->basetype => TK_FUNCTION type.
+  *    tp->fbase => Internal Meaning struct associated with basetype.
+  *    tp->escale = Value of StaticLinks = 0.
+  *
+  * TK_SPECIAL:  Special strange data type.
+  *    Only TK_SPECIAL type at present is tp_jmp_buf.
+  *
+  */
+ 
+ enum typekind {
+     TK_NONE,
+     TK_INTEGER, TK_CHAR, TK_BOOLEAN, TK_REAL, TK_VOID,
+     TK_SUBR, TK_ENUM, TK_POINTER, TK_STRING,
+     TK_RECORD, TK_ARRAY, TK_SET, TK_FILE, TK_FUNCTION,
+     TK_PROCPTR, TK_SMALLSET, TK_SMALLARRAY, TK_CPROCPTR,
+     TK_SPECIAL, TK_BIGFILE,
+     TK_LAST
+ } ;
+ 
+ #ifdef DEFDUMPS
+ char *typekindnames[(int)TK_LAST] = {
+     "TK_NONE",
+     "TK_INTEGER", "TK_CHAR", "TK_BOOLEAN", "TK_REAL", "TK_VOID",
+     "TK_SUBR", "TK_ENUM", "TK_POINTER", "TK_STRING",
+     "TK_RECORD", "TK_ARRAY", "TK_SET", "TK_FILE", "TK_FUNCTION",
+     "TK_PROCPTR", "TK_SMALLSET", "TK_SMALLARRAY", "TK_CPROCPTR",
+     "TK_SPECIAL", "TK_BIGFILE"
+ } ;
+ #endif /*DEFDUMPS*/
+ 
+ typedef struct S_type {
+     enum typekind kind;        /* Kind of type */
+     struct S_type *basetype;   /* (above) */
+     struct S_type *indextype;  /* (above) */
+     struct S_type *pointertype; /* Pointer to this type */
+     struct S_meaning *meaning; /* Name of this type, if any */
+     struct S_meaning *fbase;   /* (above) */
+     struct S_expr *smin;       /* (above) */
+     struct S_expr *smax;       /* (above) */
+     unsigned issigned:1,       /* (above) */
+              dumped:1,         /* Has been dumped (for debugging) */
+              structdefd:1,     /* (above) */
+              preserved:1;      /* Declared with preservetypes = 1 */
+     short escale;              /* (above) */
+ } Type;
+ 
+ 
+ /* "Expr" notes:
+  *
+  * Expression trees generally reflect C notation and semantics.  For example,
+  * EK_ASSIGN is not generated for string arguments; these would get an
+  * EK_BICALL to strcpy instead.
+  *
+  * The data type of each expression node is stored in its "val.type" field.
+  * The rest of the "val" field is used only when shown below.
+  * The "nargs" field always contains the number of arguments; the "args"
+  * array is allocated to that size and will contain non-NULL Expr pointers.
+  *
+  * EK_EQ, EK_NE, EK_LT, EK_GT, EK_LE, EK_GE:  Relational operators.
+  *    ep->nargs = 2.
+  *
+  * EK_PLUS:  Addition.
+  *    ep->nargs >= 2.
+  *
+  * EK_NEG:  Negation.
+  *    ep->nargs = 1.
+  *
+  * EK_TIMES:  Multiplication.
+  *    ep->nargs >= 2.
+  *
+  * EK_DIVIDE:  Real division.
+  *    ep->nargs = 2.
+  *
+  * EK_DIV:  Integer division.
+  *    ep->nargs = 2.
+  *
+  * EK_MOD:  Integer modulo (C "%" operator).
+  *    ep->nargs = 2.
+  *
+  * EK_OR, EK_AND:  Logical operators (C "&&" and "||").
+  *    ep->nargs = 2.
+  *
+  * EK_NOT:  Logical NOT (C "!" operator).
+  *    ep->nargs = 1.
+  *
+  * EK_BAND, EK_BOR, EK_BXOR:  Bitwise operators (C "&", "|", "^").
+  *    ep->nargs = 2.
+  *
+  * EK_BNOT:  Bitwise NOT (C "~" operator).
+  *    ep->nargs = 1.
+  *
+  * EK_LSH, EK_RSH:  Shift operators.
+  *    ep->nargs = 2.
+  *
+  * EK_HAT:  Pointer dereference.
+  *    ep->nargs = 1.
+  *
+  * EK_INDEX:  Array indexing.
+  *    ep->nargs = 2.
+  *
+  * EK_CAST:  "Soft" type cast, change data type retaining value.
+  *    ep->type => New data type.
+  *    ep->nargs = 1.
+  *
+  * EK_ACTCAST:  "Active" type cast, performs a computation as result of cast.
+  *    ep->type => New data type.
+  *    ep->nargs = 1.
+  *
+  * EK_LITCAST:  Literal type cast.
+  *    ep->nargs = 2.
+  *    ep->args[0] => EK_TYPENAME expression for name of new data type.
+  *    ep->args[1] => Argument of cast.
+  *
+  * EK_DOT:  Struct field extraction.
+  *    ep->nargs = 1.  (Only one of the following will be nonzero:)
+  *    ep->val.i => MK_FIELD being extracted (cast to Meaning *), else 0.
+  *    ep->val.s => Literal name of field being extracted, else NULL.
+  *
+  * EK_COND:  C conditional expression.
+  *    ep->nargs = 3.
+  *    ep->args[0] => Condition expression.
+  *    ep->args[1] => "Then" expression.
+  *    ep->args[2] => "Else" expression.
+  *
+  * EK_ADDR:  Address-of operator.
+  *    ep->nargs = 1.
+  *
+  * EK_SIZEOF:  Size-of operator.
+  *    ep->nargs = 1.
+  *    ep->args[0] => Argument expression, may be EK_TYPENAME.
+  *
+  * EK_CONST:  Literal constant.
+  *    ep->nargs = 0 or 1.
+  *    ep->val = Value of constant.
+  *    ep->args[0] => EK_NAME of printf format string for constant, if any.
+  *
+  * EK_LONGCONST:  Literal constant, type "long int".
+  *    (Same as for EK_CONST.)
+  *
+  * EK_VAR:  Variable name.
+  *    ep->nargs = 0.
+  *    ep->val.i => Variable being referenced (cast to Meaning *).
+  *
+  * EK_ASSIGN:  Assignment operator.
+  *    ep->nargs = 2.
+  *    ep->args[0] => Destination l-value expression.
+  *    ep->args[1] => Source expression.
+  *
+  * EK_POSTINC, EK_POSTDEC:  Post-increment/post-decrement operators.
+  *    ep->nargs = 1.
+  *
+  * EK_MACARG:  Placeholder for argument in expression for FuncMacro, etc.
+  *    ep->nargs = 0.
+  *    ep->val.i = Code selecting which argument.
+  *
+  * EK_CHECKNIL:  Null-pointer check.
+  *    ep->nargs = 1.
+  *
+  * EK_BICALL:  Call to literal function name.
+  *    ep->val.s => Name of function.
+  *
+  * EK_STRUCTCONST:  Structured constant.
+  *    ep->nargs = Number of elements in constant.
+  *    (Note:  constdefn points to an EK_CONST whose val.i points to this.)
+  *
+  * EK_STRUCTOF:  Repeated element in structured constant.
+  *    ep->nargs = 1.
+  *    ep->val.i = Number of repetitions.
+  *
+  * EK_COMMA:  C comma operator.
+  *    ep->nargs >= 2.
+  *
+  * EK_NAME:  Literal variable name.
+  *    ep->nargs = 0.
+  *    ep->val.s => Name of variable.
+  *
+  * EK_CTX:  Name of a context, with static links.
+  *    ep->nargs = 0.
+  *    ep->val.i => MK_FUNCTION or MK_MODULE to name (cast to Meaning *).
+  *
+  * EK_SPCALL:  Special function call.
+  *    ep->nargs = 1 + number of arguments to function.
+  *    ep->args[0] => Expression which is the function to call.
+  *
+  * EK_TYPENAME:  Type name.
+  *    ep->nargs = 0.
+  *    ep->val.type => Type whose name should be printed.
+  *
+  * EK_FUNCTION:  Normal function call.
+  *    ep->val.i => MK_FUNCTION being called (cast to Meaning *).
+  *
+  */
+ 
+ enum exprkind {
+     EK_EQ, EK_NE, EK_LT, EK_GT, EK_LE, EK_GE,
+     EK_PLUS, EK_NEG, EK_TIMES, EK_DIVIDE,
+     EK_DIV, EK_MOD,
+     EK_OR, EK_AND, EK_NOT,
+     EK_BAND, EK_BOR, EK_BXOR, EK_BNOT, EK_LSH, EK_RSH,
+     EK_HAT, EK_INDEX, EK_CAST, EK_DOT, EK_COND,
+     EK_ADDR, EK_SIZEOF, EK_ACTCAST,
+     EK_CONST, EK_VAR, EK_FUNCTION,
+     EK_ASSIGN, EK_POSTINC, EK_POSTDEC, EK_CHECKNIL,
+     EK_MACARG, EK_BICALL, EK_STRUCTCONST, EK_STRUCTOF,
+     EK_COMMA, EK_LONGCONST, EK_NAME, EK_CTX, EK_SPCALL,
+     EK_LITCAST, EK_TYPENAME,
+     EK_LAST
+ } ;
+ 
+ #ifdef DEFDUMPS
+ char *exprkindnames[(int)EK_LAST] = {
+     "EK_EQ", "EK_NE", "EK_LT", "EK_GT", "EK_LE", "EK_GE",
+     "EK_PLUS", "EK_NEG", "EK_TIMES", "EK_DIVIDE",
+     "EK_DIV", "EK_MOD",
+     "EK_OR", "EK_AND", "EK_NOT",
+     "EK_BAND", "EK_BOR", "EK_BXOR", "EK_BNOT", "EK_LSH", "EK_RSH",
+     "EK_HAT", "EK_INDEX", "EK_CAST", "EK_DOT", "EK_COND",
+     "EK_ADDR", "EK_SIZEOF", "EK_ACTCAST",
+     "EK_CONST", "EK_VAR", "EK_FUNCTION",
+     "EK_ASSIGN", "EK_POSTINC", "EK_POSTDEC", "EK_CHECKNIL",
+     "EK_MACARG", "EK_BICALL", "EK_STRUCTCONST", "EK_STRUCTOF",
+     "EK_COMMA", "EK_LONGCONST", "EK_NAME", "EK_CTX", "EK_SPCALL",
+     "EK_LITCAST", "EK_TYPENAME"
+ } ;
+ #endif /*DEFDUMPS*/
+ 
+ typedef struct S_expr {
+     enum exprkind kind;
+     short nargs;
+     Value val;
+     struct S_expr *args[1];    /* (Actually, variable-sized) */
+ } Expr;
+ 
+ 
+ 
+ /* "Stmt" notes.
+  *
+  * Statements form linked lists along the "next" pointers.
+  * All other pointers are NULL and unused unless shown below.
+  *
+  * SK_ASSIGN:  Assignment or function call (C expression statement).
+  *    sp->exp1 => Expression to be evaluated.
+  *
+  * SK_RETURN:  C "return" statement.
+  *    sp->exp1 => Value to return, else NULL.
+  *
+  * SK_CASE:  C "switch" statement.
+  *    sp->exp1 => Switch selector expression.
+  *    sp->stm1 => List of SK_CASELABEL statements, followed by list of
+  *		  statements that make up the "default:" clause.
+  *
+  * SK_CASELABEL:  C "case" label.
+  *    sp->exp1 => Case value.
+  *    sp->stm1 => List of SK_CASELABELs labelling the same clause, followed
+  *                by list of statements in that clause.
+  *
+  * SK_CASECHECK:  Case-value-range-error, occurs in "default:" clause.
+  *
+  * SK_IF:  C "if" statement.
+  *    sp->exp1 => Conditional expression.
+  *    sp->exp2 => Constant expression, "1" if this "if" should be else-if'd
+  *		  on to parent "if".  NULL => follow ElseIf parameter.
+  *    sp->stm1 => "Then" clause.
+  *    sp->stm2 => "Else" clause.
+  *
+  * SK_FOR:  C "for" statement.
+  *    sp->exp1 => Initialization expression (may be NULL).
+  *    sp->exp2 => Conditional expression (may be NULL).
+  *    sp->exp3 => Iteration expression (may be NULL).
+  *    sp->stm1 => Loop body.
+  *
+  * SK_REPEAT:  C "do-while" statement.
+  *    sp->exp1 => Conditional expression (True = continue loop).
+  *    sp->stm1 => Loop body.
+  *
+  * SK_WHILE:  C "while" statement.
+  *    sp->exp1 => Conditional expression.
+  *    sp->stm1 => Loop body.
+  *
+  * SK_BREAK:  C "break" statement.
+  *
+  * SK_CONTINUE:  C "continue" statement.
+  *
+  * SK_TRY:  HP Pascal TRY-RECOVER statement.
+  *    sp->exp1->val.i = Global serial number of the TRY statement.
+  *    sp->exp2 = Non-NULL if must generate a label for RECOVER block.
+  *    sp->stm1 => TRY block.
+  *    sp->stm2 => RECOVER block.
+  *
+  * SK_GOTO:  C "goto" statement.
+  *    sp->exp1 => EK_NAME for the label number or name.
+  *
+  * SK_LABEL:  C statement label.
+  *    sp->exp1 => EK_NAME for the label number of name.
+  *
+  * SK_HEADER:  Function/module header.
+  *    sp->exp1 => EK_VAR pointing to MK_FUNCTION or MK_MODULE.
+  *    (This always comes first in a context's statement list.)
+  *
+  * SK_BODY:  Body of function/module.
+  *    sp->stm1 => SK_HEADER that begins the body.
+  *    (This exists only during fixblock.)
+  *
+  */
+ 
+ enum stmtkind {
+     SK_ASSIGN, SK_RETURN,
+     SK_CASE, SK_CASELABEL, SK_IF,
+     SK_FOR, SK_REPEAT, SK_WHILE, SK_BREAK, SK_CONTINUE,
+     SK_TRY, SK_GOTO, SK_LABEL,
+     SK_HEADER, SK_CASECHECK, SK_BODY,
+     SK_LAST
+ } ;
+ 
+ #ifdef DEFDUMPS
+ char *stmtkindnames[(int)SK_LAST] = {
+     "SK_ASSIGN", "SK_RETURN",
+     "SK_CASE", "SK_CASELABEL", "SK_IF",
+     "SK_FOR", "SK_REPEAT", "SK_WHILE", "SK_BREAK", "SK_CONTINUE",
+     "SK_TRY", "SK_GOTO", "SK_LABEL",
+     "SK_HEADER", "SK_CASECHECK", "SK_BODY"
+ } ;
+ #endif /*DEFDUMPS*/
+ 
+ typedef struct S_stmt {
+     enum stmtkind kind;
+     struct S_stmt *next, *stm1, *stm2;
+     struct S_expr *exp1, *exp2, *exp3;
+     long serial;
+ } Stmt;
+ 
+ 
+ 
+ /* Flags for out_declarator(): */
+ 
+ #define ODECL_CHARSTAR      0x1
+ #define ODECL_FREEARRAY     0x2
+ #define ODECL_FUNCTION      0x4
+ #define ODECL_HEADER        0x8
+ #define ODECL_FORWARD       0x10
+ #define ODECL_DECL	    0x20
+ #define ODECL_NOPRES	    0x40
+ 
+ 
+ /* Flags for fixexpr(): */
+ 
+ #define ENV_EXPR    0       /* return value needed */
+ #define ENV_STMT    1       /* return value ignored */
+ #define ENV_BOOL    2       /* boolean return value needed */
+ 
+ 
+ /* Flags for defmacro(): */
+ #define MAC_VAR     0       /* VarMacro */
+ #define MAC_CONST   1       /* ConstMacro */
+ #define MAC_FIELD   2       /* FieldMacro */
+ #define MAC_FUNC    3       /* FuncMacro */
+ 
+ #define FMACRECname  "<rec>"
+ 
+ 
+ /* Kinds of comment lines: */
+ #define CMT_SHIFT   24
+ #define CMT_MASK    ((1L<<CMT_SHIFT)-1)
+ #define CMT_KMASK   ((1<<(32-CMT_SHIFT))-1)
+ #define CMT_DONE    0       /* comment that has already been printed */
+ #define CMT_PRE     1       /* comment line preceding subject */
+ #define CMT_POST    2       /* comment line following subject */
+ #define CMT_TRAIL   4       /* comment at end of line of code */
+ #define CMT_ONBEGIN 6       /* comment on "begin" of procedure */
+ #define CMT_ONEND   7       /* comment on "end" of procedure */
+ #define CMT_ONELSE  8       /* comment on "else" keyword */
+ #define CMT_NOT     256     /* negation of above, for searches */
+ 
+ #ifdef define_globals
+ char *CMT_NAMES[] = { "DONE", "PRE", "POST", "3", "TRAIL", "5",
+                       "BEGIN", "END", "ELSE" };
+ #else
+ extern char *CMT_NAMES[];
+ #endif
+ 
+ #define getcommentkind(cmt)  (((cmt)->value >> CMT_SHIFT) & CMT_KMASK)
+ 
+ 
+ /* Kinds of operator line-breaking: */
+ #define BRK_LEFT     0x1
+ #define BRK_RIGHT    0x2
+ #define BRK_LPREF    0x4
+ #define BRK_RPREF    0x8
+ #define BRK_ALLNONE  0x10
+ #define BRK_HANG     0x20
+ 
+ 
+ 
+ 
+ /* Translation parameters: */
+ 
+ #ifdef define_parameters
+ # define extern
+ #endif /* define_parameters */
+ 
+ extern enum {
+     UNIX_ANY, UNIX_BSD, UNIX_SYSV
+ } which_unix;
+ 
+ extern enum {
+     LANG_HP, LANG_UCSD, LANG_TURBO, LANG_OREGON, LANG_VAX,
+     LANG_MODULA, LANG_MPW, LANG_BERK
+ } which_lang;
+ 
+ extern short debug, tokentrace, quietmode, cmtdebug, copysource;
+ extern int nobanner, showprogress, maxerrors;
+ extern short hpux_lang, integer16, doublereals, pascalenumsize;
+ extern short needsignedbyte, unsignedchar, importall;
+ extern short nestedcomments, pascalsignif, pascalcasesens;
+ extern short dollar_idents, ignorenonalpha, modula2;
+ extern short ansiC, cplus, signedchars, signedfield, signedshift;
+ extern short hassignedchar, voidstar, symcase, ucconsts, csignif;
+ extern short copystructs, usevextern, implementationmodules;
+ extern short useAnyptrMacros, usePPMacros;
+ extern short sprintf_value;
+ extern char codefnfmt[40], modulefnfmt[40], logfnfmt[40];
+ extern char headerfnfmt[40], headerfnfmt2[40], includefnfmt[40];
+ extern char selfincludefmt[40];
+ extern char constformat[40], moduleformat[40], functionformat[40];
+ extern char varformat[40], fieldformat[40], typeformat[40];
+ extern char enumformat[40], symbolformat[40];
+ extern char p2c_h_name[40], exportsymbol[40], export_symbol[40];
+ extern char externalias[40];
+ extern char memcpyname[40], sprintfname[40];
+ extern char roundname[40], divname[40], modname[40], remname[40];
+ extern char strposname[40], strcicmpname[40];
+ extern char strsubname[40], strdeletename[40], strinsertname[40];
+ extern char strmovename[40], strpadname[40];
+ extern char strltrimname[40], strrtrimname[40], strrptname[40];
+ extern char absname[40], oddname[40], evenname[40], swapname[40];
+ extern char mallocname[40], freename[40], freervaluename[40];
+ extern char randrealname[40], randintname[40], randomizename[40];
+ extern char skipspacename[40], readlnname[40], freopenname[40];
+ extern char eofname[40], eolnname[40], fileposname[40], maxposname[40];
+ extern char setunionname[40], setintname[40], setdiffname[40];
+ extern char setinname[40], setaddname[40], setaddrangename[40];
+ extern char setremname[40];
+ extern char setequalname[40], subsetname[40], setxorname[40];
+ extern char setcopyname[40], setexpandname[40], setpackname[40];
+ extern char getbitsname[40], clrbitsname[40], putbitsname[40];
+ extern char declbufname[40], declbufncname[40];
+ extern char resetbufname[40], setupbufname[40];
+ extern char getfbufname[40], chargetfbufname[40], arraygetfbufname[40];
+ extern char putfbufname[40], charputfbufname[40], arrayputfbufname[40];
+ extern char getname[40], chargetname[40], arraygetname[40];
+ extern char putname[40], charputname[40], arrayputname[40];
+ extern char eofbufname[40], fileposbufname[40];
+ extern char storebitsname[40], signextname[40];
+ extern char filenotfoundname[40], filenotopenname[40];
+ extern char filewriteerrorname[40], badinputformatname[40], endoffilename[40];
+ extern short strcpyleft;
+ extern char language[40], target[40];
+ extern int sizeof_char, sizeof_short, sizeof_integer, sizeof_pointer, 
+            sizeof_double, sizeof_float, sizeof_enum, sizeof_int, sizeof_long;
+ extern short size_t_long;
+ extern int setbits, defaultsetsize, seek_base, integerwidth, realwidth;
+ extern short quoteincludes, expandincludes, collectnest;
+ extern int phystabsize, intabsize, linewidth, maxlinewidth;
+ extern int majorspace, minorspace, functionspace, minfuncspace;
+ extern int casespacing, caselimit;
+ extern int returnlimit, breaklimit, continuelimit;
+ extern short nullstmtline, shortcircuit, shortopt, usecommas, elseif;
+ extern short usereturns, usebreaks, infloopstyle, reusefieldnames;
+ extern short bracesalways, braceline, bracecombine, braceelse, braceelseline;
+ extern short newlinefunctions;
+ extern short eatcomments, spitcomments, spitorphancomments;
+ extern short commentafter, blankafter;
+ extern int tabsize, blockindent, bodyindent, argindent;
+ extern int switchindent, caseindent, labelindent;
+ extern int openbraceindent, closebraceindent;
+ extern int funcopenindent, funccloseindent;
+ extern int structindent, structinitindent, extrainitindent;
+ extern int constindent, commentindent, bracecommentindent, commentoverindent;
+ extern int declcommentindent;
+ extern int minspacing, minspacingthresh;
+ extern int extraindent, bumpindent;
+ extern double overwidepenalty, overwideextrapenalty;
+ extern double commabreakpenalty, commabreakextrapenalty;
+ extern double assignbreakpenalty, assignbreakextrapenalty;
+ extern double specialargbreakpenalty;
+ extern double opbreakpenalty, opbreakextrapenalty, exhyphenpenalty;
+ extern double logbreakpenalty, logbreakextrapenalty;
+ extern double relbreakpenalty, relbreakextrapenalty;
+ extern double morebreakpenalty, morebreakextrapenalty;
+ extern double parenbreakpenalty, parenbreakextrapenalty;
+ extern double qmarkbreakpenalty, qmarkbreakextrapenalty;
+ extern double wrongsidepenalty, earlybreakpenalty, extraindentpenalty;
+ extern double bumpindentpenalty, nobumpindentpenalty;
+ extern double indentamountpenalty, sameindentpenalty;
+ extern double showbadlimit;
+ extern long maxalts;
+ extern short breakbeforearith, breakbeforerel, breakbeforelog;
+ extern short breakbeforedot, breakbeforeassign;
+ extern short for_allornone;
+ extern short extraparens, breakparens, returnparens;
+ extern short variablearrays, initpacstrings, stararrays;
+ extern short spaceexprs, spacefuncs, spacecommas, implicitzero, starindex;
+ extern int casetabs;
+ extern short starfunctions, mixfields, alloczeronil, postincrement;
+ extern short mixvars, mixtypes, mixinits, nullcharconst, castnull, addindex;
+ extern short highcharints, highcharbits, hasstaticlinks;
+ extern short mainlocals, storefilenames, addrstdfiles, readwriteopen;
+ extern short charfiletext, messagestderr, literalfilesflag, structfilesflag;
+ extern short printfonly, mixwritelns, usegets, newlinespace, binarymode;
+ extern char openmode[40], filenamefilter[40];
+ extern short atan2flag, div_po2, mod_po2, assumebits, assumesigns;
+ extern short fullstrwrite, fullstrread, whilefgets, buildreads, buildwrites;
+ extern short foldconsts, foldstrconsts, charconsts, useconsts, useundef;
+ extern short elimdeadcode, offsetforloops, forevalorder;
+ extern short smallsetconst, bigsetconst, lelerange, unsignedtrick;
+ extern short useisalpha, useisspace, usestrncmp;
+ extern short casecheck, arraycheck, rangecheck, nilcheck, malloccheck;
+ extern short checkfileopen, checkfileisopen, checkfilewrite;
+ extern short checkreadformat, checkfileeof, checkstdineof, checkfileseek;
+ extern short squeezesubr, useenum, enumbyte, packing, packsigned, keepnulls;
+ extern short compenums, formatstrings, alwayscopyvalues;
+ extern short use_static, var_static, void_args, prototypes, fullprototyping;
+ extern short procptrprototypes, promote_enums;
+ extern short preservetypes, preservepointers, preservestrings;
+ extern short castargs, castlongargs, promoteargs, fixpromotedargs;
+ extern short varstrings, varfiles, copystructfuncs;
+ extern long skipindices;
+ extern short stringleaders;
+ extern int stringceiling, stringdefault, stringtrunclimit, longstringsize;
+ extern short warnnames, warnmacros;
+ extern Strlist *importfrom, *importdirs, *includedirs, *includefrom;
+ extern Strlist *librfiles, *bufferedfiles, *unbufferedfiles;
+ extern Strlist *externwords, *cexternwords;
+ extern Strlist *varmacros, *constmacros, *fieldmacros;
+ extern Strlist *funcmacros, *funcmacroargs, *nameoflist;
+ extern Strlist *specialmallocs, *specialfrees, *specialsizeofs;
+ extern Strlist *initialcalls, *eatnotes, *literalfiles, *structfiles;
+ 
+ extern char fixedcomment[40], permanentcomment[40], interfacecomment[40];
+ extern char embedcomment[40],  skipcomment[40], noskipcomment[40];
+ extern char signedcomment[40], unsignedcomment[40];
+ 
+ extern char name_RETV[40], name_STRMAX[40], name_LINK[40];
+ extern char name_COPYPAR[40], name_TEMP[40], name_DUMMY[40];
+ extern char name_LOC[40], name_VARS[40], name_STRUCT[40];
+ extern char name_FAKESTRUCT[40], name_AHIGH[40], name_ALOW[40];
+ extern char name_UNION[40], name_VARIANT[40], name_LABEL[40], name_LABVAR[40];
+ extern char name_WITH[40], name_FOR[40], name_ENUM[40];
+ extern char name_PTR[40], name_STRING[40], name_SET[40];
+ extern char name_PROCEDURE[40], name_MAIN[40], name_UNITINIT[40];
+ extern char name_HSYMBOL[40], name_GSYMBOL[40];
+ extern char name_SETBITS[40], name_UCHAR[40], name_SCHAR[40];
+ extern char name_BOOLEAN[40], name_TRUE[40], name_FALSE[40], name_NULL[40];
+ extern char name_ESCAPECODE[40], name_IORESULT[40];
+ extern char name_ARGC[40], name_ARGV[40];
+ extern char name_ESCAPE[40], name_ESCIO[40], name_CHKIO[40], name_SETIO[40];
+ extern char name_OUTMEM[40], name_CASECHECK[40], name_NILCHECK[40];
+ extern char name_FNSIZE[40], name_FNVAR[40];
+ extern char alternatename1[40], alternatename2[40], alternatename[40];
+ 
+ 
+ #ifndef define_parameters
+ extern
+ #endif
+ struct rcstruct {
+     char kind;
+     char chgmode;
+     char *name;
+     anyptr ptr;
+     long def;
+ } rctable[]
+ #ifdef define_parameters
+    = {
+     'S', 'R', "DEBUG",           (anyptr) &debug,             0,
+     'I', 'R', "SHOWPROGRESS",    (anyptr) &showprogress,      0,
+     'S', 'V', "TOKENTRACE",      (anyptr) &tokentrace,        0,
+     'S', 'V', "QUIET",           (anyptr) &quietmode,         0,
+     'S', 'V', "COPYSOURCE",      (anyptr) &copysource,        0,
+     'I', 'R', "MAXERRORS",	 (anyptr) &maxerrors,	      0,
+     'X', ' ', "INCLUDE",         (anyptr) NULL,               2,
+ 
+ /* INPUT LANGUAGE */
+     'U', 'T', "LANGUAGE",        (anyptr)  language,         40,
+     'S', 'V', "MODULA2",         (anyptr) &modula2,          -1,
+     'S', 'T', "INTEGER16",       (anyptr) &integer16,        -1,
+     'S', 'T', "DOUBLEREALS",     (anyptr) &doublereals,      -1,
+     'S', 'V', "UNSIGNEDCHAR",    (anyptr) &unsignedchar,     -1,
+     'S', 'V', "NEEDSIGNEDBYTE",  (anyptr) &needsignedbyte,    0,
+     'S', 'V', "PASCALENUMSIZE",  (anyptr) &pascalenumsize,   -1,
+     'S', 'V', "NESTEDCOMMENTS",  (anyptr) &nestedcomments,   -1,
+     'S', 'V', "IMPORTALL",       (anyptr) &importall,        -1,
+     'S', 'V', "IMPLMODULES",     (anyptr) &implementationmodules, -1,
+     'A', 'V', "EXTERNWORDS",	 (anyptr) &externwords,	      0,
+     'A', 'V', "CEXTERNWORDS",	 (anyptr) &cexternwords,      0,
+     'S', 'V', "PASCALSIGNIF",    (anyptr) &pascalsignif,     -1,
+     'S', 'V', "PASCALCASESENS",  (anyptr) &pascalcasesens,   -1,
+     'S', 'V', "DOLLARIDENTS",    (anyptr) &dollar_idents,    -1,
+     'S', 'V', "IGNORENONALPHA",  (anyptr) &ignorenonalpha,   -1,
+     'I', 'V', "SEEKBASE",        (anyptr) &seek_base,        -1,
+     'I', 'R', "INPUTTABSIZE",    (anyptr) &intabsize,         8,
+ 
+ /* TARGET LANGUAGE */
+     'S', 'T', "ANSIC",           (anyptr) &ansiC,            -1,
+     'S', 'T', "C++",             (anyptr) &cplus,            -1,
+     'S', 'T', "VOID*",           (anyptr) &voidstar,         -1,
+     'S', 'T', "HASSIGNEDCHAR",   (anyptr) &hassignedchar,    -1,
+     'S', 'V', "CASTNULL",        (anyptr) &castnull,         -1,
+     'S', 'V', "COPYSTRUCTS",     (anyptr) &copystructs,      -1,
+     'S', 'V', "VARIABLEARRAYS",  (anyptr) &variablearrays,   -1,
+     'S', 'V', "INITPACSTRINGS",  (anyptr) &initpacstrings,   -1,
+     'S', 'V', "REUSEFIELDNAMES", (anyptr) &reusefieldnames,   1,
+     'S', 'V', "USEVEXTERN",      (anyptr) &usevextern,        1,
+     'S', 'V', "CSIGNIF",         (anyptr) &csignif,          -1,
+     'S', 'V', "USEANYPTRMACROS", (anyptr) &useAnyptrMacros,  -1,
+     'S', 'V', "USEPPMACROS",     (anyptr) &usePPMacros,      -1,
+ 
+ /* TARGET MACHINE */
+     'U', 'T', "TARGET",          (anyptr)  target,           40,
+     'S', 'T', "SIGNEDCHAR",      (anyptr) &signedchars,      -1,
+     'S', 'T', "SIGNEDFIELD",     (anyptr) &signedfield,      -1,
+     'S', 'T', "SIGNEDSHIFT",     (anyptr) &signedshift,      -1,
+     'I', 'T', "CHARSIZE",        (anyptr) &sizeof_char,       0,
+     'I', 'T', "SHORTSIZE",       (anyptr) &sizeof_short,      0,
+     'I', 'T', "INTSIZE",         (anyptr) &sizeof_int,        0,
+     'I', 'T', "LONGSIZE",        (anyptr) &sizeof_long,       0,
+     'I', 'T', "PTRSIZE",         (anyptr) &sizeof_pointer,    0,
+     'I', 'T', "DOUBLESIZE",      (anyptr) &sizeof_double,     0,
+     'I', 'T', "FLOATSIZE",       (anyptr) &sizeof_float,      0,
+     'I', 'T', "ENUMSIZE",        (anyptr) &sizeof_enum,       0,
+     'S', 'T', "SIZE_T_LONG",     (anyptr) &size_t_long,      -1,
+ 
+ /* BRACES */
+     'S', 'V', "NULLSTMTLINE",    (anyptr) &nullstmtline,      0,
+     'S', 'V', "BRACESALWAYS",    (anyptr) &bracesalways,     -1,
+     'S', 'V', "BRACELINE",       (anyptr) &braceline,        -1,
+     'S', 'V', "BRACECOMBINE",    (anyptr) &bracecombine,      0,
+     'S', 'V', "BRACEELSE",       (anyptr) &braceelse,         0,
+     'S', 'V', "BRACEELSELINE",   (anyptr) &braceelseline,     0,
+     'S', 'V', "ELSEIF",          (anyptr) &elseif,           -1,
+     'S', 'V', "NEWLINEFUNCS",    (anyptr) &newlinefunctions,  0,
+ 
+ /* INDENTATION */
+     'I', 'R', "PHYSTABSIZE",     (anyptr) &phystabsize,       8,
+     'D', 'R', "INDENT",          (anyptr) &tabsize,           2,
+     'D', 'R', "BLOCKINDENT",     (anyptr) &blockindent,       0,
+     'D', 'R', "BODYINDENT",      (anyptr) &bodyindent,        0,
+     'D', 'R', "FUNCARGINDENT",   (anyptr) &argindent,      1000,
+     'D', 'R', "OPENBRACEINDENT", (anyptr) &openbraceindent,   0,
+     'D', 'R', "CLOSEBRACEINDENT",(anyptr) &closebraceindent,  0,
+     'D', 'R', "FUNCOPENINDENT",  (anyptr) &funcopenindent,    0,
+     'D', 'R', "FUNCCLOSEINDENT", (anyptr) &funccloseindent,   0,
+     'D', 'R', "SWITCHINDENT",    (anyptr) &switchindent,      0,
+     'D', 'R', "CASEINDENT",      (anyptr) &caseindent,       -2,
+     'D', 'R', "LABELINDENT",     (anyptr) &labelindent,    1000,
+     'D', 'R', "STRUCTINDENT",    (anyptr) &structindent,      0,
+     'D', 'R', "STRUCTINITINDENT",(anyptr) &structinitindent,  0,
+     'D', 'R', "EXTRAINITINDENT", (anyptr) &extrainitindent,   2,
+     'I', 'R', "EXTRAINDENT",     (anyptr) &extraindent,       2,
+     'I', 'R', "BUMPINDENT",      (anyptr) &bumpindent,        1,
+     'D', 'R', "CONSTINDENT",     (anyptr) &constindent,    1024,
+     'D', 'R', "COMMENTINDENT",   (anyptr) &commentindent,     3,
+     'D', 'R', "BRACECOMMENTINDENT",(anyptr)&bracecommentindent, 2,
+     'D', 'R', "DECLCOMMENTINDENT",(anyptr)&declcommentindent, -999,
+     'D', 'R', "COMMENTOVERINDENT",(anyptr)&commentoverindent, 4,  /*1000*/
+     'I', 'R', "MINSPACING",      (anyptr) &minspacing,        2,
+     'I', 'R', "MINSPACINGTHRESH",(anyptr) &minspacingthresh, -1,
+ 
+ /* LINE BREAKING */
+     'I', 'R', "LINEWIDTH",       (anyptr) &linewidth,        78,
+     'I', 'R', "MAXLINEWIDTH",    (anyptr) &maxlinewidth,     90,
+     'R', 'V', "OVERWIDEPENALTY",       (anyptr) &overwidepenalty,         2500,
+     'R', 'V', "OVERWIDEEXTRAPENALTY",  (anyptr) &overwideextrapenalty,     100,
+     'R', 'V', "COMMABREAKPENALTY",     (anyptr) &commabreakpenalty,       1000,
+     'R', 'V', "COMMABREAKEXTRAPENALTY",(anyptr) &commabreakextrapenalty,   500,
+     'R', 'V', "ASSIGNBREAKPENALTY",    (anyptr) &assignbreakpenalty,      5000,
+     'R', 'V', "ASSIGNBREAKEXTRAPENALTY",(anyptr)&assignbreakextrapenalty, 3000,
+     'R', 'V', "SPECIALARGBREAKPENALTY",(anyptr) &specialargbreakpenalty,   500,
+     'R', 'V', "OPBREAKPENALTY",        (anyptr) &opbreakpenalty,          2500,
+     'R', 'V', "OPBREAKEXTRAPENALTY",   (anyptr) &opbreakextrapenalty,     2000,
+     'R', 'V', "LOGBREAKPENALTY",       (anyptr) &logbreakpenalty,          500,
+     'R', 'V', "LOGBREAKEXTRAPENALTY",  (anyptr) &logbreakextrapenalty,     100,
+     'R', 'V', "RELBREAKPENALTY",       (anyptr) &relbreakpenalty,         2000,
+     'R', 'V', "RELBREAKEXTRAPENALTY",  (anyptr) &relbreakextrapenalty,    1000,
+     'R', 'V', "EXHYPHENPENALTY",       (anyptr) &exhyphenpenalty,         1000,
+     'R', 'V', "MOREBREAKPENALTY",      (anyptr) &morebreakpenalty,        -500,
+     'R', 'V', "MOREBREAKEXTRAPENALTY", (anyptr) &morebreakextrapenalty,   -300,
+     'R', 'V', "QMARKBREAKPENALTY",     (anyptr) &qmarkbreakpenalty,       5000,
+     'R', 'V', "QMARKBREAKEXTRAPENALTY",(anyptr) &qmarkbreakextrapenalty,  3000,
+     'R', 'V', "PARENBREAKPENALTY",     (anyptr) &parenbreakpenalty,       2500,
+     'R', 'V', "PARENBREAKEXTRAPENALTY",(anyptr) &parenbreakextrapenalty,  1000,
+     'R', 'V', "WRONGSIDEPENALTY",      (anyptr) &wrongsidepenalty,        1000,
+     'R', 'V', "EARLYBREAKPENALTY",     (anyptr) &earlybreakpenalty,        100,
+     'R', 'V', "EXTRAINDENTPENALTY",    (anyptr) &extraindentpenalty,      3000,
+     'R', 'V', "BUMPINDENTPENALTY",     (anyptr) &bumpindentpenalty,       1000,
+     'R', 'V', "NOBUMPINDENTPENALTY",   (anyptr) &nobumpindentpenalty,     2500,
+     'R', 'V', "INDENTAMOUNTPENALTY",   (anyptr) &indentamountpenalty,       50,
+     'R', 'V', "SAMEINDENTPENALTY",     (anyptr) &sameindentpenalty,        500,
+     'R', 'V', "SHOWBADLIMIT",          (anyptr) &showbadlimit,            -120,
+     'L', 'R', "MAXLINEBREAKTRIES", (anyptr) &maxalts,      5000,
+     'G', 'V', "ALLORNONEBREAK",  (anyptr)  NULL,             FALLBREAK,
+     'G', 'V', "ONESPECIALARG",   (anyptr)  NULL,             FSPCARG1,
+     'G', 'V', "TWOSPECIALARGS",  (anyptr)  NULL,             FSPCARG2,
+     'G', 'V', "THREESPECIALARGS",(anyptr)  NULL,             FSPCARG3,
+     'B', 'V', "BREAKARITH",      (anyptr) &breakbeforearith,  BRK_RIGHT,
+     'B', 'V', "BREAKREL",        (anyptr) &breakbeforerel,    BRK_RIGHT,
+     'B', 'V', "BREAKLOG",        (anyptr) &breakbeforelog,    BRK_RIGHT,
+     'B', 'V', "BREAKDOT",        (anyptr) &breakbeforedot,    BRK_RIGHT,
+     'B', 'V', "BREAKASSIGN",     (anyptr) &breakbeforeassign, BRK_RIGHT,
+     'S', 'V', "FOR_ALLORNONE",   (anyptr) &for_allornone,     1,
+ 
+ /* COMMENTS AND BLANK LINES */
+     'S', 'V', "NOBANNER",        (anyptr) &nobanner,	      0,
+     'S', 'V', "EATCOMMENTS",     (anyptr) &eatcomments,       0,
+     'S', 'V', "SPITCOMMENTS",    (anyptr) &spitcomments,      0,
+     'S', 'V', "SPITORPHANCOMMENTS",(anyptr)&spitorphancomments, 0,
+     'S', 'V', "COMMENTAFTER",    (anyptr) &commentafter,     -1,
+     'S', 'V', "BLANKAFTER",      (anyptr) &blankafter,        1,
+     'A', 'V', "EATNOTES",        (anyptr) &eatnotes,          0,
+ 
+ /* SPECIAL COMMENTS */
+     'C', 'V', "FIXEDCOMMENT",    (anyptr)  fixedcomment,     40,
+     'C', 'V', "PERMANENTCOMMENT",(anyptr)  permanentcomment, 40,
+     'C', 'V', "INTERFACECOMMENT",(anyptr)  interfacecomment, 40,
+     'C', 'V', "EMBEDCOMMENT",    (anyptr)  embedcomment,     40,
+     'C', 'V', "SKIPCOMMENT",     (anyptr)  skipcomment,      40,
+     'C', 'V', "NOSKIPCOMMENT",   (anyptr)  noskipcomment,    40,
+     'C', 'V', "SIGNEDCOMMENT",   (anyptr)  signedcomment,    40,
+     'C', 'V', "UNSIGNEDCOMMENT", (anyptr)  unsignedcomment,  40,
+ 
+ /* STYLISTIC OPTIONS */
+     'I', 'V', "MAJORSPACING",    (anyptr) &majorspace,        2,
+     'I', 'V', "MINORSPACING",    (anyptr) &minorspace,        1,
+     'I', 'V', "FUNCSPACING",     (anyptr) &functionspace,     2,
+     'I', 'V', "MINFUNCSPACING",  (anyptr) &minfuncspace,      1,
+     'S', 'V', "EXTRAPARENS",     (anyptr) &extraparens,      -1,
+     'S', 'V', "BREAKADDPARENS",  (anyptr) &breakparens,      -1,
+     'S', 'V', "RETURNPARENS",    (anyptr) &returnparens,     -1,
+     'S', 'V', "SPACEEXPRS",      (anyptr) &spaceexprs,       -1,
+     'S', 'V', "SPACEFUNCS",	 (anyptr) &spacefuncs,	      0,
+     'S', 'V', "SPACECOMMAS",	 (anyptr) &spacecommas,	      1,
+     'S', 'V', "IMPLICITZERO",    (anyptr) &implicitzero,     -1,
+     'S', 'V', "STARINDEX",       (anyptr) &starindex,        -1,
+     'S', 'V', "ADDINDEX",        (anyptr) &addindex,         -1,
+     'S', 'V', "STARARRAYS",      (anyptr) &stararrays,        1,
+     'S', 'V', "STARFUNCTIONS",   (anyptr) &starfunctions,    -1,
+     'S', 'V', "POSTINCREMENT",   (anyptr) &postincrement,     1,
+     'S', 'V', "MIXVARS",         (anyptr) &mixvars,          -1,
+     'S', 'V', "MIXTYPES",        (anyptr) &mixtypes,         -1,
+     'S', 'V', "MIXFIELDS",       (anyptr) &mixfields,        -1,
+     'S', 'V', "MIXINITS",        (anyptr) &mixinits,         -1,
+     'S', 'V', "MAINLOCALS",      (anyptr) &mainlocals,        1,
+     'S', 'V', "NULLCHAR",        (anyptr) &nullcharconst,     1,
+     'S', 'V', "HIGHCHARINT",     (anyptr) &highcharints,      1,
+     'I', 'V', "CASESPACING",     (anyptr) &casespacing,       1,
+     'D', 'V', "CASETABS",        (anyptr) &casetabs,       1000,
+     'I', 'V', "CASELIMIT",       (anyptr) &caselimit,         9,
+     'S', 'V', "USECOMMAS",       (anyptr) &usecommas,        -1,
+     'S', 'V', "USERETURNS",      (anyptr) &usereturns,        1,
+     'I', 'V', "RETURNLIMIT",     (anyptr) &returnlimit,       3,
+     'S', 'V', "USEBREAKS",       (anyptr) &usebreaks,         1,
+     'I', 'V', "BREAKLIMIT",      (anyptr) &breaklimit,        2,
+     'I', 'V', "CONTINUELIMIT",   (anyptr) &continuelimit,     5,
+     'S', 'V', "INFLOOPSTYLE",    (anyptr) &infloopstyle,      0,
+ 
+ /* NAMING CONVENTIONS */
+     'C', 'V', "CODEFILENAME",    (anyptr)  codefnfmt,        40,
+     'C', 'V', "MODULEFILENAME",  (anyptr)  modulefnfmt,      40,
+     'C', 'V', "HEADERFILENAME",  (anyptr)  headerfnfmt,      40,
+     'C', 'V', "HEADERFILENAME2", (anyptr)  headerfnfmt2,     40,
+     'C', 'V', "SELFINCLUDENAME", (anyptr)  selfincludefmt,   40,
+     'C', 'V', "LOGFILENAME",     (anyptr)  logfnfmt,         40,
+     'C', 'V', "INCLUDEFILENAME", (anyptr)  includefnfmt,     40,
+     'S', 'V', "SYMCASE",         (anyptr) &symcase,          -1,
+     'C', 'V', "SYMBOLFORMAT",    (anyptr)  symbolformat,     40,
+     'C', 'V', "CONSTFORMAT",     (anyptr)  constformat,      40,
+     'C', 'V', "MODULEFORMAT",    (anyptr)  moduleformat,     40,
+     'C', 'V', "FUNCTIONFORMAT",  (anyptr)  functionformat,   40,
+     'C', 'V', "VARFORMAT",       (anyptr)  varformat,        40,
+     'C', 'V', "FIELDFORMAT",     (anyptr)  fieldformat,      40,
+     'C', 'V', "TYPEFORMAT",      (anyptr)  typeformat,       40,
+     'C', 'V', "ENUMFORMAT",      (anyptr)  enumformat,       40,
+     'C', 'V', "RETURNVALUENAME", (anyptr)  name_RETV,        40,
+     'C', 'V', "UNITINITNAME",    (anyptr)  name_UNITINIT,    40,
+     'C', 'V', "HSYMBOLNAME",     (anyptr)  name_HSYMBOL,     40,
+     'C', 'V', "GSYMBOLNAME",     (anyptr)  name_GSYMBOL,     40,
+     'C', 'V', "STRINGMAXNAME",   (anyptr)  name_STRMAX,      40,
+     'C', 'V', "ARRAYMINNAME",    (anyptr)  name_ALOW,        40,
+     'C', 'V', "ARRAYMAXNAME",    (anyptr)  name_AHIGH,       40,
+     'C', 'V', "COPYPARNAME",     (anyptr)  name_COPYPAR,     40,
+     'C', 'V', "STATICLINKNAME",  (anyptr)  name_LINK,        40,
+     'C', 'V', "LOCALVARSSTRUCT", (anyptr)  name_LOC,         40,
+     'C', 'V', "LOCALVARSNAME",   (anyptr)  name_VARS,        40,
+     'C', 'V', "FWDSTRUCTNAME",   (anyptr)  name_STRUCT,      40,
+     'C', 'V', "ENUMLISTNAME",    (anyptr)  name_ENUM,        40,
+     'C', 'V', "UNIONNAME",       (anyptr)  name_UNION,       40,
+     'C', 'V', "UNIONPARTNAME",   (anyptr)  name_VARIANT,     40,
+     'C', 'V', "FAKESTRUCTNAME",  (anyptr)  name_FAKESTRUCT,  40,
+     'C', 'V', "LABELNAME",       (anyptr)  name_LABEL,       40,
+     'C', 'V', "LABELVARNAME",    (anyptr)  name_LABVAR,      40,
+     'C', 'V', "TEMPNAME",        (anyptr)  name_TEMP,        40,
+     'C', 'V', "DUMMYNAME",       (anyptr)  name_DUMMY,       40,
+     'C', 'V', "FORNAME",         (anyptr)  name_FOR,         40,
+     'C', 'V', "WITHNAME",        (anyptr)  name_WITH,        40,
+     'C', 'V', "PTRNAME",         (anyptr)  name_PTR,         40,
+     'C', 'V', "STRINGNAME",      (anyptr)  name_STRING,      40,
+     'C', 'V', "SETNAME",         (anyptr)  name_SET,         40,
+     'C', 'V', "FNVARNAME",       (anyptr)  name_FNVAR,       40,
+     'C', 'V', "FNSIZENAME",      (anyptr)  name_FNSIZE,      40,
+     'C', 'V', "ALTERNATENAME1",  (anyptr)  alternatename1,   40,
+     'C', 'V', "ALTERNATENAME2",  (anyptr)  alternatename2,   40,
+     'C', 'V', "ALTERNATENAME",   (anyptr)  alternatename,    40,
+     'C', 'V', "EXPORTSYMBOL",    (anyptr)  exportsymbol,     40,
+     'C', 'V', "EXPORT_SYMBOL",   (anyptr)  export_symbol,    40,
+     'C', 'V', "ALIAS",           (anyptr)  externalias,      40,
+     'X', 'V', "SYNONYM",         (anyptr)  NULL,              3,
+     'X', 'V', "NAMEOF",          (anyptr) &nameoflist,        1,
+     'G', 'V', "AVOIDNAME",       (anyptr)  NULL,             AVOIDNAME,
+     'G', 'V', "AVOIDGLOBALNAME", (anyptr)  NULL,             AVOIDGLOB,
+     'G', 'V', "WARNNAME",        (anyptr)  NULL,             WARNNAME,
+     'G', 'V', "NOSIDEEFFECTS",   (anyptr)  NULL,             NOSIDEEFF,
+     'G', 'V', "STRUCTFUNCTION",  (anyptr)  NULL,             STRUCTF,
+     'G', 'V', "STRLAPFUNCTION",  (anyptr)  NULL,             STRLAPF,
+     'F', 'V', "LEAVEALONE",      (anyptr)  NULL,             LEAVEALONE,
+     'G', 'V', "DETERMINISTIC",   (anyptr)  NULL,             DETERMF,
+     'G', 'V', "NEEDSTATIC",      (anyptr)  NULL,             NEEDSTATIC,
+     'S', 'V', "WARNNAMES",       (anyptr) &warnnames,         0,
+     'M', 'V', "VARMACRO",        (anyptr)  NULL,             MAC_VAR,
+     'M', 'V', "CONSTMACRO",      (anyptr)  NULL,             MAC_CONST,
+     'M', 'V', "FIELDMACRO",      (anyptr)  NULL,             MAC_FIELD,
+     'M', 'V', "FUNCMACRO",       (anyptr)  NULL,             MAC_FUNC,
+     'S', 'V', "WARNMACROS",      (anyptr) &warnmacros,        0,
+ 
+ /* CODING OPTIONS */
+     'A', 'V', "INITIALCALLS",    (anyptr) &initialcalls,      0,
+     'S', 'V', "EXPANDINCLUDES",  (anyptr) &expandincludes,   -1,
+     'S', 'V', "COLLECTNEST",     (anyptr) &collectnest,       1,
+     'S', 'V', "SHORTCIRCUIT",    (anyptr) &shortcircuit,     -1,
+     'S', 'V', "SHORTOPT",        (anyptr) &shortopt,          1,
+     'S', 'V', "ELIMDEADCODE",    (anyptr) &elimdeadcode,      1,
+     'S', 'V', "FOLDCONSTANTS",   (anyptr) &foldconsts,       -1,
+     'S', 'V', "FOLDSTRCONSTANTS",(anyptr) &foldstrconsts,    -1,
+     'S', 'V', "CHARCONSTS",	 (anyptr) &charconsts,        1,
+     'S', 'V', "USECONSTS",       (anyptr) &useconsts,        -1,
+     'S', 'V', "USEUNDEF",        (anyptr) &useundef,          1,
+     'L', 'V', "SKIPINDICES",     (anyptr) &skipindices,       0,
+     'S', 'V', "OFFSETFORLOOPS",  (anyptr) &offsetforloops,    1,
+     'S', 'V', "FOREVALORDER",    (anyptr) &forevalorder,      0,
+     'S', 'V', "STRINGLEADERS",   (anyptr) &stringleaders,     2,
+     'S', 'V', "STOREFILENAMES",  (anyptr) &storefilenames,   -1,
+     'S', 'V', "CHARFILETEXT",    (anyptr) &charfiletext,     -1,
+     'S', 'V', "SQUEEZESUBR",     (anyptr) &squeezesubr,       1,
+     'S', 'T', "USEENUM",         (anyptr) &useenum,          -1,
+     'S', 'V', "SQUEEZEENUM",     (anyptr) &enumbyte,         -1,
+     'S', 'V', "COMPENUMS",       (anyptr) &compenums,        -1,
+     'S', 'V', "PRESERVETYPES",   (anyptr) &preservetypes,     1,
+     'S', 'V', "PRESERVEPOINTERS",(anyptr) &preservepointers,  0,
+     'S', 'V', "PRESERVESTRINGS", (anyptr) &preservestrings,  -1,
+     'S', 'V', "PACKING",         (anyptr) &packing,           1,
+     'S', 'V', "PACKSIGNED",      (anyptr) &packsigned,        1,
+     'I', 'V', "STRINGCEILING",   (anyptr) &stringceiling,   255,
+     'I', 'V', "STRINGDEFAULT",   (anyptr) &stringdefault,   255,
+     'I', 'V', "STRINGTRUNCLIMIT",(anyptr) &stringtrunclimit, -1,
+     'I', 'V', "LONGSTRINGSIZE",  (anyptr) &longstringsize,   -1,
+     'S', 'V', "KEEPNULLS",       (anyptr) &keepnulls,         0,
+     'S', 'V', "HIGHCHARBITS",    (anyptr) &highcharbits,     -1,
+     'S', 'V', "ALWAYSCOPYVALUES",(anyptr) &alwayscopyvalues,  0,
+     'S', 'V', "STATICFUNCTIONS", (anyptr) &use_static,        1,
+     'S', 'V', "STATICVARIABLES", (anyptr) &var_static,        1,
+     'S', 'V', "VOIDARGS",        (anyptr) &void_args,        -1,
+     'S', 'V', "PROTOTYPES",      (anyptr) &prototypes,       -1,
+     'S', 'V', "FULLPROTOTYPING", (anyptr) &fullprototyping,  -1,
+     'S', 'V', "PROCPTRPROTOTYPES",(anyptr)&procptrprototypes, 1,
+     'S', 'V', "CASTARGS",        (anyptr) &castargs,         -1,
+     'S', 'V', "CASTLONGARGS",    (anyptr) &castlongargs,     -1,
+     'S', 'V', "PROMOTEARGS",     (anyptr) &promoteargs,      -1,
+     'S', 'V', "FIXPROMOTEDARGS", (anyptr) &fixpromotedargs,   1,
+     'S', 'V', "PROMOTEENUMS",    (anyptr) &promote_enums,    -1,
+     'S', 'V', "STATICLINKS",     (anyptr) &hasstaticlinks,   -1,
+     'S', 'V', "VARSTRINGS",      (anyptr) &varstrings,        0,
+     'S', 'V', "VARFILES",        (anyptr) &varfiles,          1,
+     'S', 'V', "ADDRSTDFILES",    (anyptr) &addrstdfiles,      0,
+     'S', 'V', "COPYSTRUCTFUNCS", (anyptr) &copystructfuncs,  -1,
+     'S', 'V', "ATAN2",           (anyptr) &atan2flag,         0,
+     'S', 'V', "BITWISEMOD",      (anyptr) &mod_po2,          -1,
+     'S', 'V', "BITWISEDIV",      (anyptr) &div_po2,          -1,
+     'S', 'V', "ASSUMEBITS",      (anyptr) &assumebits,        0,
+     'S', 'V', "ASSUMESIGNS",     (anyptr) &assumesigns,       1,
+     'S', 'V', "ALLOCZERONIL",    (anyptr) &alloczeronil,      0,
+     'S', 'V', "PRINTFONLY",      (anyptr) &printfonly,       -1,
+     'S', 'V', "MIXWRITELNS",     (anyptr) &mixwritelns,       1,
+     'S', 'V', "MESSAGESTDERR",   (anyptr) &messagestderr,     1,
+     'I', 'V', "INTEGERWIDTH",    (anyptr) &integerwidth,     -1,
+     'I', 'V', "REALWIDTH",       (anyptr) &realwidth,        12,
+     'S', 'V', "FORMATSTRINGS",   (anyptr) &formatstrings,     0,
+     'S', 'V', "WHILEFGETS",      (anyptr) &whilefgets,        1,
+     'S', 'V', "USEGETS",         (anyptr) &usegets,           1,
+     'S', 'V', "NEWLINESPACE",    (anyptr) &newlinespace,     -1,
+     'S', 'V', "BUILDREADS",      (anyptr) &buildreads,        1,
+     'S', 'V', "BUILDWRITES",     (anyptr) &buildwrites,       1,
+     'S', 'V', "BINARYMODE",      (anyptr) &binarymode,        1,
+     'S', 'V', "READWRITEOPEN",   (anyptr) &readwriteopen,    -1,
+     'C', 'V', "OPENMODE",        (anyptr)  openmode,         40,
+     'S', 'V', "LITERALFILES",    (anyptr) &literalfilesflag, -1,
+     'A', 'V', "LITERALFILE",     (anyptr) &literalfiles,      0,
+     'S', 'V', "STRUCTFILES",     (anyptr) &structfilesflag,   0,
+     'A', 'V', "STRUCTFILE",      (anyptr) &structfiles,       0,
+     'C', 'V', "FILENAMEFILTER",  (anyptr)  filenamefilter,   40,
+     'S', 'V', "FULLSTRWRITE",    (anyptr) &fullstrwrite,     -1,
+     'S', 'V', "FULLSTRREAD",     (anyptr) &fullstrread,       1,
+     'I', 'R', "SETBITS",         (anyptr) &setbits,          -1,
+     'I', 'V', "DEFAULTSETSIZE",  (anyptr) &defaultsetsize,   -1,
+     'S', 'V', "SMALLSETCONST",   (anyptr) &smallsetconst,    -2,
+     'S', 'V', "BIGSETCONST",     (anyptr) &bigsetconst,       1,
+     'S', 'V', "LELERANGE",       (anyptr) &lelerange,         0,
+     'S', 'V', "UNSIGNEDTRICK",   (anyptr) &unsignedtrick,     1,
+     'S', 'V', "USEISALPHA",      (anyptr) &useisalpha,        1,
+     'S', 'V', "USEISSPACE",      (anyptr) &useisspace,        0,
+     'S', 'V', "USESTRNCMP",	 (anyptr) &usestrncmp,	      1,
+ 
+ /* TARGET LIBRARY */
+     'G', 'V', "WARNLIBRARY",     (anyptr)  NULL,             WARNLIBR,
+     'S', 'V', "QUOTEINCLUDES",   (anyptr) &quoteincludes,     1,
+     'X', 'V', "IMPORTFROM",      (anyptr) &importfrom,        1,
+     'A', 'V', "IMPORTDIR",       (anyptr) &importdirs,        0,
+     'A', 'V', "INCLUDEDIR",      (anyptr) &includedirs,       0,
+     'X', 'V', "INCLUDEFROM",     (anyptr) &includefrom,       1,
+     'A', 'V', "LIBRARYFILE",     (anyptr) &librfiles,         0,
+     'C', 'V', "HEADERNAME",      (anyptr)  p2c_h_name,       40,
+     'C', 'V', "PROCTYPENAME",    (anyptr)  name_PROCEDURE,   40,
+     'C', 'V', "UCHARNAME",       (anyptr)  name_UCHAR,       40,
+     'C', 'V', "SCHARNAME",       (anyptr)  name_SCHAR,       40,
+     'C', 'V', "BOOLEANNAME",     (anyptr)  name_BOOLEAN,     40,
+     'C', 'V', "TRUENAME",        (anyptr)  name_TRUE,        40,
+     'C', 'V', "FALSENAME",       (anyptr)  name_FALSE,       40,
+     'C', 'V', "NULLNAME",        (anyptr)  name_NULL,        40,
+     'C', 'V', "ESCAPECODENAME",  (anyptr)  name_ESCAPECODE,  40,
+     'C', 'V', "IORESULTNAME",    (anyptr)  name_IORESULT,    40,
+     'C', 'V', "ARGCNAME",        (anyptr)  name_ARGC,        40,
+     'C', 'V', "ARGVNAME",        (anyptr)  name_ARGV,        40,
+     'C', 'V', "MAINNAME",        (anyptr)  name_MAIN,        40,
+     'C', 'V', "ESCAPENAME",      (anyptr)  name_ESCAPE,      40,
+     'C', 'V', "ESCIONAME",       (anyptr)  name_ESCIO,       40,
+     'C', 'V', "CHECKIONAME",     (anyptr)  name_CHKIO,       40,
+     'C', 'V', "SETIONAME",       (anyptr)  name_SETIO,       40,
+     'C', 'V', "FILENOTFOUNDNAME",(anyptr)  filenotfoundname, 40,
+     'C', 'V', "FILENOTOPENNAME", (anyptr)  filenotopenname,  40,
+     'C', 'V', "FILEWRITEERRORNAME",(anyptr)filewriteerrorname,40,
+     'C', 'V', "BADINPUTFORMATNAME",(anyptr)badinputformatname,40,
+     'C', 'V', "ENDOFFILENAME",   (anyptr)  endoffilename,    40,
+     'C', 'V', "OUTMEMNAME",      (anyptr)  name_OUTMEM,      40,
+     'C', 'V', "CASECHECKNAME",   (anyptr)  name_CASECHECK,   40,
+     'C', 'V', "NILCHECKNAME",    (anyptr)  name_NILCHECK,    40,
+     'C', 'V', "SETBITSNAME",     (anyptr)  name_SETBITS,     40,
+     'S', 'V', "SPRINTFVALUE",    (anyptr) &sprintf_value,    -1,
+     'C', 'V', "SPRINTFNAME",     (anyptr)  sprintfname,      40,
+     'C', 'V', "MEMCPYNAME",      (anyptr)  memcpyname,       40,
+     'C', 'V', "ROUNDNAME",       (anyptr)  roundname,        40,
+     'C', 'V', "DIVNAME",	 (anyptr)  divname,	     40,
+     'C', 'V', "MODNAME",	 (anyptr)  modname,	     40,
+     'C', 'V', "REMNAME",	 (anyptr)  remname,	     40,
+     'C', 'V', "STRCICMPNAME",    (anyptr)  strcicmpname,     40,
+     'C', 'V', "STRSUBNAME",      (anyptr)  strsubname,       40,
+     'C', 'V', "STRPOSNAME",      (anyptr)  strposname,       40,
+     'S', 'V', "STRCPYLEFT",      (anyptr) &strcpyleft,        1,
+     'C', 'V', "STRDELETENAME",   (anyptr)  strdeletename,    40,
+     'C', 'V', "STRINSERTNAME",   (anyptr)  strinsertname,    40,
+     'C', 'V', "STRMOVENAME",     (anyptr)  strmovename,	     40,
+     'C', 'V', "STRLTRIMNAME",    (anyptr)  strltrimname,     40,
+     'C', 'V', "STRRTRIMNAME",    (anyptr)  strrtrimname,     40,
+     'C', 'V', "STRRPTNAME",      (anyptr)  strrptname,       40,
+     'C', 'V', "STRPADNAME",      (anyptr)  strpadname,       40,
+     'C', 'V', "ABSNAME",         (anyptr)  absname,          40,
+     'C', 'V', "ODDNAME",         (anyptr)  oddname,          40,
+     'C', 'V', "EVENNAME",        (anyptr)  evenname,         40,
+     'C', 'V', "SWAPNAME",        (anyptr)  swapname,         40,
+     'C', 'V', "MALLOCNAME",      (anyptr)  mallocname,       40,
+     'C', 'V', "FREENAME",        (anyptr)  freename,         40,
+     'C', 'V', "FREERVALUENAME",  (anyptr)  freervaluename,   40,
+     'X', 'V', "SPECIALMALLOC",   (anyptr) &specialmallocs,    1,
+     'X', 'V', "SPECIALFREE",     (anyptr) &specialfrees,      1,
+     'X', 'V', "SPECIALSIZEOF",   (anyptr) &specialsizeofs,    1,
+     'C', 'V', "RANDREALNAME",    (anyptr)  randrealname,     40,
+     'C', 'V', "RANDINTNAME",     (anyptr)  randintname,      40,
+     'C', 'V', "RANDOMIZENAME",   (anyptr)  randomizename,    40,
+     'C', 'V', "SKIPSPACENAME",   (anyptr)  skipspacename,    40,
+     'C', 'V', "READLNNAME",      (anyptr)  readlnname,       40,
+     'C', 'V', "FREOPENNAME",     (anyptr)  freopenname,      40,
+     'C', 'V', "EOFNAME",         (anyptr)  eofname,          40,
+     'C', 'V', "EOLNNAME",        (anyptr)  eolnname,         40,
+     'C', 'V', "FILEPOSNAME",     (anyptr)  fileposname,      40,
+     'C', 'V', "MAXPOSNAME",      (anyptr)  maxposname,       40,
+     'C', 'V', "SETUNIONNAME",    (anyptr)  setunionname,     40,
+     'C', 'V', "SETINTNAME",      (anyptr)  setintname,       40,
+     'C', 'V', "SETDIFFNAME",     (anyptr)  setdiffname,      40,
+     'C', 'V', "SETXORNAME",      (anyptr)  setxorname,       40,
+     'C', 'V', "SETINNAME",       (anyptr)  setinname,        40,
+     'C', 'V', "SETADDNAME",      (anyptr)  setaddname,       40,
+     'C', 'V', "SETADDRANGENAME", (anyptr)  setaddrangename,  40,
+     'C', 'V', "SETREMNAME",      (anyptr)  setremname,       40,
+     'C', 'V', "SETEQUALNAME",    (anyptr)  setequalname,     40,
+     'C', 'V', "SUBSETNAME",      (anyptr)  subsetname,       40,
+     'C', 'V', "SETCOPYNAME",     (anyptr)  setcopyname,      40,
+     'C', 'V', "SETEXPANDNAME",   (anyptr)  setexpandname,    40,
+     'C', 'V', "SETPACKNAME",     (anyptr)  setpackname,      40,
+     'C', 'V', "SIGNEXTENDNAME",  (anyptr)  signextname,      40,
+     'C', 'V', "GETBITSNAME",     (anyptr)  getbitsname,      40,
+     'C', 'V', "CLRBITSNAME",     (anyptr)  clrbitsname,      40,
+     'C', 'V', "PUTBITSNAME",     (anyptr)  putbitsname,      40,
+     'C', 'V', "STOREBITSNAME",   (anyptr)  storebitsname,    40,
+     'C', 'V', "DECLBUFNAME",	 (anyptr)  declbufname,	     40,
+     'C', 'V', "DECLBUFNCNAME",	 (anyptr)  declbufncname,    40,
+     'A', 'V', "BUFFEREDFILE",    (anyptr) &bufferedfiles,     0,
+     'A', 'V', "UNBUFFEREDFILE",  (anyptr) &unbufferedfiles,   0,
+     'C', 'V', "RESETBUFNAME",	 (anyptr)  resetbufname,     40,
+     'C', 'V', "SETUPBUFNAME",	 (anyptr)  setupbufname,     40,
+     'C', 'V', "GETFBUFNAME",     (anyptr)  getfbufname,      40,
+     'C', 'V', "CHARGETFBUFNAME", (anyptr)  chargetfbufname,  40,
+     'C', 'V', "ARRAYGETFBUFNAME",(anyptr)  arraygetfbufname, 40,
+     'C', 'V', "PUTFBUFNAME",     (anyptr)  putfbufname,      40,
+     'C', 'V', "CHARPUTFBUFNAME", (anyptr)  charputfbufname,  40,
+     'C', 'V', "ARRAYPUTFBUFNAME",(anyptr)  arrayputfbufname, 40,
+     'C', 'V', "GETNAME",         (anyptr)  getname,          40,
+     'C', 'V', "CHARGETNAME",     (anyptr)  chargetname,      40,
+     'C', 'V', "ARRAYGETNAME",    (anyptr)  arraygetname,     40,
+     'C', 'V', "PUTNAME",         (anyptr)  putname,          40,
+     'C', 'V', "CHARPUTNAME",     (anyptr)  charputname,      40,
+     'C', 'V', "ARRAYPUTNAME",    (anyptr)  arrayputname,     40,
+     'C', 'V', "EOFBUFNAME",      (anyptr)  eofbufname,       40,
+     'C', 'V', "FILEPOSBUFNAME",  (anyptr)  fileposbufname,   40,
+ 
+ /* RANGE CHECKING */
+     'S', 'V', "CASECHECK",       (anyptr) &casecheck,         0,
+     'S', 'V', "ARRAYCHECK",      (anyptr) &arraycheck,        0,
+     'S', 'V', "RANGECHECK",      (anyptr) &rangecheck,        0,
+     'S', 'V', "NILCHECK",        (anyptr) &nilcheck,          0,
+     'S', 'V', "MALLOCCHECK",     (anyptr) &malloccheck,       0,
+     'S', 'V', "CHECKFILEOPEN",   (anyptr) &checkfileopen,     1,
+     'S', 'V', "CHECKFILEISOPEN", (anyptr) &checkfileisopen,   0,
+     'S', 'V', "CHECKFILEWRITE",  (anyptr) &checkfilewrite,    2,
+     'S', 'V', "CHECKREADFORMAT", (anyptr) &checkreadformat,   2,
+     'S', 'V', "CHECKFILEEOF",    (anyptr) &checkfileeof,      2,
+     'S', 'V', "CHECKSTDINEOF",   (anyptr) &checkstdineof,     2,
+     'S', 'V', "CHECKFILESEEK",   (anyptr) &checkfileseek,     2,
+ }
+ #endif /* define_parameters */
+     ;
+ 
+ 
+ #undef extern
+ 
+ 
+ #ifdef define_parameters
+   int numparams = sizeof(rctable) / sizeof(struct rcstruct);
+   Strlist *rcprevvalues[sizeof(rctable) / sizeof(struct rcstruct)];
+ #else
+   extern int numparams;
+   extern Strlist *rcprevvalues[];
+ #endif /* define_parameters */
+ 
+ 
+ 
+ /* Global variables: */
+ 
+ #ifdef define_globals
+ # define extern
+ #endif /* define_globals */
+ 
+ 
+ extern char *charname, *ucharname, *scharname, *integername;
+ extern long min_schar, max_schar, max_uchar;
+ extern long min_sshort, max_sshort, max_ushort;
+ 
+ extern char *alloctemp;
+ extern short error_crash;
+ extern int total_bytes, total_exprs, total_meanings, total_strings;
+ extern int total_symbols, total_types, total_stmts, total_strlists;
+ extern int total_literals, total_ctxstacks, total_tempvars, total_inprecs;
+ extern int total_parens, total_ptrdescs, total_misc;
+ extern int final_bytes, final_exprs, final_meanings, final_strings;
+ extern int final_symbols, final_types, final_stmts, final_strlists;
+ extern int final_literals, final_ctxstacks, final_tempvars, final_inprecs;
+ extern int final_parens, final_ptrdescs, final_misc;
+ 
+ extern char *infname, *outfname, *codefname, *hdrfname;
+ extern char *requested_module;
+ extern FILE *inf, *outf, *codef, *hdrf, *logf;
+ extern short setup_complete, found_module;
+ extern short regression, verbose, conserve_mem;
+ extern int inf_lnum, inf_ltotal;
+ 
+ extern int outindent, outputmode;
+ extern int outf_lnum;
+ extern short dontbreaklines;
+ 
+ extern Token curtok;
+ extern char curtokbuf[256], curtokcase[256];
+ extern char *inbufptr;
+ extern int inbufindent;
+ extern long curtokint;
+ extern Symbol *curtoksym;
+ extern Meaning *curtokmeaning;
+ extern Strlist *curcomments;
+ extern Strlist **keepingstrlist;
+ extern short ignore_directives, skipping_module;
+ extern short C_lex;
+ extern char sysprog_flag, partial_eval_flag, iocheck_flag;
+ extern char range_flag, ovflcheck_flag, stackcheck_flag;
+ extern short switch_strpos;
+ extern int fixedflag;
+ extern int numimports;
+ extern Strlist *tempoptionlist;
+ extern long curserial, serialcount;
+ extern int notephase;
+ extern Strlist *permimports;
+ extern int permflag;
+ 
+ #define SYMHASHSIZE 293
+ extern Symbol *(symtab[SYMHASHSIZE]);
+ extern short partialdump;
+ 
+ #define MAXWITHS 100
+ extern int withlevel;
+ extern Type *withlist[MAXWITHS];
+ extern Expr *withexprs[MAXWITHS];
+ 
+ extern Token blockkind;
+ extern Meaning *curctx, *curctxlast, *nullctx;
+ 
+ extern int fixexpr_tryblock;
+ extern short fixexpr_tryflag;
+ 
+ extern Type *tp_integer, *tp_char, *tp_boolean, *tp_real, *tp_longreal;
+ extern Type *tp_anyptr, *tp_jmp_buf, *tp_schar, *tp_uchar, *tp_charptr;
+ extern Type *tp_int, *tp_sshort, *tp_ushort, *tp_abyte, *tp_sbyte, *tp_ubyte;
+ extern Type *tp_void, *tp_str255, *tp_strptr, *tp_text, *tp_bigtext;
+ extern Type *tp_unsigned, *tp_uint, *tp_sint, *tp_smallset, *tp_proc;
+ extern Meaning *mp_string, *mp_true, *mp_false;
+ extern Meaning *mp_input, *mp_output, *mp_stderr;
+ extern Meaning *mp_maxint, *mp_minint, *mp_escapecode, *mp_ioresult;
+ extern Meaning *mp_uchar, *mp_schar, *mp_unsigned, *mp_uint;
+ extern Meaning *mp_str_hp, *mp_str_turbo;
+ extern Meaning *mp_val_modula, *mp_val_turbo;
+ extern Meaning *mp_blockread_ucsd, *mp_blockread_turbo;
+ extern Meaning *mp_blockwrite_ucsd, *mp_blockwrite_turbo;
+ extern Meaning *mp_dec_dec, *mp_dec_turbo;
+ extern Expr *ex_input, *ex_output;
+ extern Strlist *attrlist;
+ 
+ 
+ #ifndef define_globals
+ # undef extern
+ #endif
+ 
+ 
+ 
+ 
+ /* Function declarations are created automatically by "makeproto" */
+ 
+ #include "p2c.hdrs"
+ 
+ #include "p2c.proto"
+ 
+ 
+ 
+ /* Our library omits declarations for these functions! */
+ 
+ int link           PP( (char *, char *) );
+ int unlink         PP( (char *) );
+ 
+ 
+ 
+ #define minspcthresh ((minspacingthresh >= 0) ? minspacingthresh : minspacing)
+ 
+ #define delfreearg(ex, n) freeexpr((*(ex))->args[n]), deletearg(ex, n)
+ #define delsimpfreearg(ex, n) freeexpr((*(ex))->args[n]), delsimparg(ex, n)
+ 
+ #define swapexprs(a,b) do {register Expr *t=(a);(a)=(b);(b)=(t);} while (0)
+ #define swapstmts(a,b) do {register Stmt *t=(a);(a)=(b);(b)=(t);} while (0)
+ 
+ #define CHECKORDEXPR(ex,v) ((ex)->kind==EK_CONST ? (ex)->val.i - (v) : -2)
+ 
+ #define FCheck(flag)  ((flag) == 1 || (!iocheck_flag && (flag)))
+ #define checkeof(fex)  (isvar(fex, mp_input) ? FCheck(checkstdineof)  \
+ 					     : FCheck(checkfileeof))
+ 
+ 
+ #ifdef TEST_MALLOC   /* Memory testing */
+ 
+ #define ALLOC(N,TYPE,NAME) \
+     (TYPE *) test_malloc((unsigned)((N)*sizeof(TYPE)),  \
+ 			 &__CAT__(total_,NAME), &__CAT__(final_,NAME))
+ 
+ #define ALLOCV(N,TYPE,NAME) \
+     (TYPE *) test_malloc((unsigned)(N),  \
+ 			 &__CAT__(total_,NAME), &__CAT__(final_,NAME))
+ 
+ #define REALLOC(P,N,TYPE) \
+     (TYPE *) test_realloc((char *)(P), (unsigned)((N)*sizeof(TYPE)))
+ 
+ #define FREE(P) test_free((char*)(P))
+ 
+ #else  /* not TEST_MALLOC */
+ 
+ /* If p2c always halts immediately with an out-of-memory error, try
+    recompiling all modules with BROKEN_OR defined. */
+ #ifdef BROKEN_OR
+ 
+ #define ALLOC(N,TYPE,NAME) \
+     ((alloctemp = malloc((unsigned)((N)*sizeof(TYPE)))), \
+      (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+ 
+ #define ALLOCV(N,TYPE,NAME) \
+     ((alloctemp = malloc((unsigned)(N))), \
+      (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+ 
+ #define REALLOC(P,N,TYPE) \
+     ((alloctemp = realloc((char*)(P), (unsigned)((N)*sizeof(TYPE)))), \
+      (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+ 
+ #define FREE(P) free((char*)(P))
+ 
+ #else  /* not BROKEN_OR */
+ 
+ #define ALLOC(N,TYPE,NAME) \
+     ((alloctemp = malloc((unsigned)((N)*sizeof(TYPE)))) || outmem(), \
+      (TYPE *) alloctemp)
+ 
+ #define ALLOCV(N,TYPE,NAME) \
+     ((alloctemp = malloc((unsigned)(N))) || outmem(), \
+      (TYPE *) alloctemp)
+ 
+ #define REALLOC(P,N,TYPE) \
+     ((alloctemp = realloc((char*)(P), (unsigned)((N)*sizeof(TYPE)))) || outmem(), \
+      (TYPE *) alloctemp)
+ 
+ #define FREE(P) free((char*)(P))
+ 
+ #endif  /* BROKEN_OR */
+ #endif  /* TEST_MALLOC */
+ 
+ 
+ #define MIN(a,b) ((a) < (b) ? (a) : (b))
+ #define MAX(a,b) ((a) > (b) ? (a) : (b))
+ 
+ 
+ 
+ #ifdef toupper
+ # undef toupper
+ # undef tolower
+ # define toupper(c)   my_toupper(c)
+ # define tolower(c)   my_tolower(c)
+ #endif
+ 
+ #ifndef _toupper
+ # if 'A' == 65 && 'a' == 97
+ #  define _toupper(c)  ((c)-'a'+'A')
+ #  define _tolower(c)  ((c)-'A'+'a')
+ # else
+ #  ifdef toupper
+ #   undef toupper   /* hope these are shadowing real functions, */
+ #   undef tolower   /* because my_toupper calls _toupper! */
+ #  endif
+ #  define _toupper(c)  toupper(c)
+ #  define _tolower(c)  tolower(c)
+ # endif
+ #endif
+ 
+ 
+ 
+ 
+ /* End. */
+ 




From criswell at cs.uiuc.edu  Mon Feb 16 17:48:05 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Mon Feb 16 17:48:05 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile
Message-ID: <200402162344.RAA31012@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench:

Makefile added (r1.1)

---
Log message:

Initial commit of Malloc Benchmark



---
Diffs of the changes:  (+3 -0)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile:1.1
*** /dev/null	Mon Feb 16 17:44:13 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile	Mon Feb 16 17:44:03 2004
***************
*** 0 ****
--- 1,3 ----
+ LEVEL = ../../../../..
+ PARALLEL_DIRS  := p2c
+ include $(LEVEL)/test/Programs/Makefile.programs




From alkis at niobe.cs.uiuc.edu  Mon Feb 16 17:49:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 17:49:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86InstrInfo.td
Message-ID: <200402162348.i1GNmqK20087@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86InstrInfo.td updated: 1.24 -> 1.25

---
Log message:

Add two more variants of add. Update comments.


---
Diffs of the changes:  (+11 -6)

Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.24 llvm/lib/Target/X86/X86InstrInfo.td:1.25
--- llvm/lib/Target/X86/X86InstrInfo.td:1.24	Mon Feb 16 12:19:31 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Mon Feb 16 17:48:42 2004
@@ -272,12 +272,17 @@
 def ADDri16b : I2A8 <"add", 0x83, MRMS0r    >, OpSize;   // ADDri with sign extended 8 bit imm
 def ADDri32b : I2A8 <"add", 0x83, MRMS0r    >;
 
-def ADDmr8   : I2A8 <"add", 0x00, MRMDestMem>;         // [mem] += R8
-def ADDmr16  : I2A16<"add", 0x01, MRMDestMem>, OpSize; // [mem] += R16
-def ADDmr32  : I2A32<"add", 0x01, MRMDestMem>;         // [mem] += R32
-def ADDrm8   : I2A8 <"add", 0x02, MRMSrcMem >;         // R8  += [mem]
-def ADDrm16  : I2A16<"add", 0x03, MRMSrcMem >, OpSize; // R16 += [mem]
-def ADDrm32  : I2A32<"add", 0x03, MRMSrcMem >;         // R32 += [mem]
+def ADDmr8   : I2A8 <"add", 0x00, MRMDestMem>;         // [mem8]  += R8
+def ADDmr16  : I2A16<"add", 0x01, MRMDestMem>, OpSize; // [mem16] += R16
+def ADDmr32  : I2A32<"add", 0x01, MRMDestMem>;         // [mem32] += R32
+def ADDrm8   : I2A8 <"add", 0x02, MRMSrcMem >;         // R8  += [mem8]
+def ADDrm16  : I2A16<"add", 0x03, MRMSrcMem >, OpSize; // R16 += [mem16]
+def ADDrm32  : I2A32<"add", 0x03, MRMSrcMem >;         // R32 += [mem32]
+def ADDmi8   : I2A8 <"add", 0x80, MRMSrcMem >;         // [mem8] += I8
+def ADDmi16  : I2A16<"add", 0x81, MRMSrcMem >, OpSize; // [mem16] += I16
+def ADDmi32  : I2A32<"add", 0x81, MRMSrcMem >;         // [mem32] += I8
+def ADDmi16b : I2A8 <"add", 0x83, MRMSrcMem >, OpSize; // [mem16] += I8
+def ADDmi32b : I2A8 <"add", 0x83, MRMSrcMem >;         // [mem32] += I32
 
 def ADCrr32  : I2A32<"adc", 0x11, MRMDestReg>;                // R32 += imm32+Carry
 




From alkis at niobe.cs.uiuc.edu  Mon Feb 16 17:51:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 17:51:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp
Message-ID: <200402162350.i1GNoSG20105@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.15 -> 1.16

---
Log message:

Add peephole optimizations for ADD [MEM], IMM8 instructions.


---
Diffs of the changes:  (+3 -0)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.15 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.16
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.15	Sun Feb 15 15:37:17 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Mon Feb 16 17:50:18 2004
@@ -94,6 +94,7 @@
     return false;
 
   case X86::ADDri16:  case X86::ADDri32:
+  case X86::ADDmi16:  case X86::ADDmi32:
   case X86::SUBri16:  case X86::SUBri32:
   case X86::ANDri16:  case X86::ANDri32:
   case X86::ORri16:   case X86::ORri32:
@@ -108,6 +109,8 @@
         default: assert(0 && "Unknown opcode value!");
         case X86::ADDri16:  Opcode = X86::ADDri16b; break;
         case X86::ADDri32:  Opcode = X86::ADDri32b; break;
+        case X86::ADDmi16:  Opcode = X86::ADDmi16b; break;
+        case X86::ADDmi32:  Opcode = X86::ADDmi32b; break;
         case X86::SUBri16:  Opcode = X86::SUBri16b; break;
         case X86::SUBri32:  Opcode = X86::SUBri32b; break;
         case X86::ANDri16:  Opcode = X86::ANDri16b; break;




From lattner at cs.uiuc.edu  Mon Feb 16 20:59:14 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 20:59:14 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/Type.h DerivedTypes.h
Message-ID: <200402170258.UAA13063@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm:

Type.h updated: 1.39 -> 1.40
DerivedTypes.h updated: 1.54 -> 1.55

---
Log message:

Rearrange code to eliminate warnings


---
Diffs of the changes:  (+96 -70)

Index: llvm/include/llvm/Type.h
diff -u llvm/include/llvm/Type.h:1.39 llvm/include/llvm/Type.h:1.40
--- llvm/include/llvm/Type.h:1.39	Tue Feb 10 15:48:12 2004
+++ llvm/include/llvm/Type.h	Mon Feb 16 20:58:36 2004
@@ -83,10 +83,17 @@
   unsigned    UID;       // The unique ID number for this class
   bool        Abstract;  // True if type contains an OpaqueType
 
+  /// RefCount - This counts the number of PATypeHolders that are pointing to
+  /// this type.  When this number falls to zero, if the type is abstract and
+  /// has no AbstractTypeUsers, the type is deleted.  This is only sensical for
+  /// derived types.
+  ///
+  mutable unsigned RefCount;
+
   const Type *getForwardedTypeInternal() const;
 protected:
   /// ctor is protected, so only subclasses can create Type objects...
-  Type(const std::string &Name, PrimitiveID id);
+  Type(PrimitiveID id);
   virtual ~Type() {}
 
   /// setName - Associate the name with this type in the symbol table, but don't
@@ -259,8 +266,89 @@
   }
 
 #include "llvm/Type.def"
+
+  // Virtual methods used by callbacks below.  These should only be implemented
+  // in the DerivedType class.
+  virtual void addAbstractTypeUser(AbstractTypeUser *U) const {
+    abort(); // Only on derived types!
+  }
+  virtual void removeAbstractTypeUser(AbstractTypeUser *U) const {
+    abort(); // Only on derived types!
+  }
+
+  void addRef() const {
+    assert(isAbstract() && "Cannot add a reference to a non-abstract type!");
+    ++RefCount;
+  }
+  
+  void dropRef() const {
+    assert(isAbstract() && "Cannot drop a refernce to a non-abstract type!");
+    assert(RefCount && "No objects are currently referencing this object!");
+
+    // If this is the last PATypeHolder using this object, and there are no
+    // PATypeHandles using it, the type is dead, delete it now.
+    if (--RefCount == 0)
+      RefCountIsZero();
+  }
+private:
+  virtual void RefCountIsZero() const {
+    abort(); // only on derived types!
+  }
+
 };
 
+//===----------------------------------------------------------------------===//
+// Define some inline methods for the AbstractTypeUser.h:PATypeHandle class.
+// These are defined here because they MUST be inlined, yet are dependent on 
+// the definition of the Type class.  Of course Type derives from Value, which
+// contains an AbstractTypeUser instance, so there is no good way to factor out
+// the code.  Hence this bit of uglyness.
+//
+// In the long term, Type should not derive from Value, allowing
+// AbstractTypeUser.h to #include Type.h, allowing us to eliminate this
+// nastyness entirely.
+//
+inline void PATypeHandle::addUser() {
+  assert(Ty && "Type Handle has a null type!");
+  if (Ty->isAbstract())
+    Ty->addAbstractTypeUser(User);
+}
+inline void PATypeHandle::removeUser() {
+  if (Ty->isAbstract())
+    Ty->removeAbstractTypeUser(User);
+}
+
+inline void PATypeHandle::removeUserFromConcrete() {
+  if (!Ty->isAbstract())
+    Ty->removeAbstractTypeUser(User);
+}
+
+// Define inline methods for PATypeHolder...
+
+inline void PATypeHolder::addRef() {
+  if (Ty->isAbstract())
+    Ty->addRef();
+}
+
+inline void PATypeHolder::dropRef() {
+  if (Ty->isAbstract())
+    Ty->dropRef();
+}
+
+/// get - This implements the forwarding part of the union-find algorithm for
+/// abstract types.  Before every access to the Type*, we check to see if the
+/// type we are pointing to is forwarding to a new type.  If so, we drop our
+/// reference to the type.
+///
+inline const Type* PATypeHolder::get() const {
+  const Type *NewTy = Ty->getForwardedType();
+  if (!NewTy) return Ty;
+  return *const_cast<PATypeHolder*>(this) = NewTy;
+}
+
+
+
+//===----------------------------------------------------------------------===//
 // Provide specializations of GraphTraits to be able to treat a type as a 
 // graph of sub types...
 


Index: llvm/include/llvm/DerivedTypes.h
diff -u llvm/include/llvm/DerivedTypes.h:1.54 llvm/include/llvm/DerivedTypes.h:1.55
--- llvm/include/llvm/DerivedTypes.h:1.54	Tue Feb 10 15:49:59 2004
+++ llvm/include/llvm/DerivedTypes.h	Mon Feb 16 20:58:36 2004
@@ -29,20 +29,13 @@
 class PointerValType;
 
 class DerivedType : public Type, public AbstractTypeUser {
-  /// RefCount - This counts the number of PATypeHolders that are pointing to
-  /// this type.  When this number falls to zero, if the type is abstract and
-  /// has no AbstractTypeUsers, the type is deleted.
-  ///
-  mutable unsigned RefCount;
-  
   // AbstractTypeUsers - Implement a list of the users that need to be notified
   // if I am a type, and I get resolved into a more concrete type.
   //
-  ///// FIXME: kill mutable nonsense when Types are not const
   mutable std::vector<AbstractTypeUser *> AbstractTypeUsers;
 
 protected:
-  DerivedType(PrimitiveID id) : Type("", id), RefCount(0) {}
+  DerivedType(PrimitiveID id) : Type("", id) {}
   ~DerivedType() {
     assert(AbstractTypeUsers.empty());
   }
@@ -58,6 +51,12 @@
   /// types, to avoid some circular reference problems.
   ///
   void dropAllTypeUses();
+
+  void RefCountIsZero() const {
+    if (AbstractTypeUsers.empty())
+      delete this;
+  }
+
   
 public:
 
@@ -89,22 +88,6 @@
   ///
   void refineAbstractTypeTo(const Type *NewType);
 
-  void addRef() const {
-    assert(isAbstract() && "Cannot add a reference to a non-abstract type!");
-    ++RefCount;
-  }
-
-  void dropRef() const {
-    assert(isAbstract() && "Cannot drop a refernce to a non-abstract type!");
-    assert(RefCount && "No objects are currently referencing this object!");
-
-    // If this is the last PATypeHolder using this object, and there are no
-    // PATypeHandles using it, the type is dead, delete it now.
-    if (--RefCount == 0 && AbstractTypeUsers.empty())
-      delete this;
-  }
-
-
   void dump() const { Value::dump(); }
 
   // Methods for support type inquiry through isa, cast, and dyn_cast:
@@ -405,51 +388,6 @@
     return isa<Type>(V) && classof(cast<Type>(V));
   }
 };
-
-
-// Define some inline methods for the AbstractTypeUser.h:PATypeHandle class.
-// These are defined here because they MUST be inlined, yet are dependent on 
-// the definition of the Type class.  Of course Type derives from Value, which
-// contains an AbstractTypeUser instance, so there is no good way to factor out
-// the code.  Hence this bit of uglyness.
-//
-inline void PATypeHandle::addUser() {
-  assert(Ty && "Type Handle has a null type!");
-  if (Ty->isAbstract())
-    cast<DerivedType>(Ty)->addAbstractTypeUser(User);
-}
-inline void PATypeHandle::removeUser() {
-  if (Ty->isAbstract())
-    cast<DerivedType>(Ty)->removeAbstractTypeUser(User);
-}
-
-inline void PATypeHandle::removeUserFromConcrete() {
-  if (!Ty->isAbstract())
-    cast<DerivedType>(Ty)->removeAbstractTypeUser(User);
-}
-
-// Define inline methods for PATypeHolder...
-
-inline void PATypeHolder::addRef() {
-  if (Ty->isAbstract())
-    cast<DerivedType>(Ty)->addRef();
-}
-
-inline void PATypeHolder::dropRef() {
-  if (Ty->isAbstract())
-    cast<DerivedType>(Ty)->dropRef();
-}
-
-/// get - This implements the forwarding part of the union-find algorithm for
-/// abstract types.  Before every access to the Type*, we check to see if the
-/// type we are pointing to is forwarding to a new type.  If so, we drop our
-/// reference to the type.
-///
-inline const Type* PATypeHolder::get() const {
-  const Type *NewTy = Ty->getForwardedType();
-  if (!NewTy) return Ty;
-  return *const_cast<PATypeHolder*>(this) = NewTy;
-}
 
 } // End llvm namespace
 




From lattner at cs.uiuc.edu  Mon Feb 16 21:04:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 21:04:01 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/Type.h
Message-ID: <200402170303.VAA20020@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm:

Type.h updated: 1.40 -> 1.41

---
Log message:

Add two missing pieces from last checkin


---
Diffs of the changes:  (+3 -1)

Index: llvm/include/llvm/Type.h
diff -u llvm/include/llvm/Type.h:1.40 llvm/include/llvm/Type.h:1.41
--- llvm/include/llvm/Type.h:1.40	Mon Feb 16 20:58:36 2004
+++ llvm/include/llvm/Type.h	Mon Feb 16 21:03:36 2004
@@ -93,7 +93,7 @@
   const Type *getForwardedTypeInternal() const;
 protected:
   /// ctor is protected, so only subclasses can create Type objects...
-  Type(PrimitiveID id);
+  Type(const std::string &Name, PrimitiveID id);
   virtual ~Type() {}
 
   /// setName - Associate the name with this type in the symbol table, but don't
@@ -108,6 +108,8 @@
   /// isTypeAbstract - This method is used to calculate the Abstract bit.
   ///
   bool isTypeAbstract();
+
+  unsigned getRefCount() const { return RefCount; }
 
   /// ForwardType - This field is used to implement the union find scheme for
   /// abstract types.  When types are refined to other types, this field is set




From lattner at cs.uiuc.edu  Mon Feb 16 21:04:21 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 21:04:21 2004
Subject: [llvm-commits] CVS: llvm/lib/VMCore/Type.cpp
Message-ID: <200402170303.VAA20032@zion.cs.uiuc.edu>


Changes in directory llvm/lib/VMCore:

Type.cpp updated: 1.94 -> 1.95

---
Log message:

Adjust to recent changes


---
Diffs of the changes:  (+2 -2)

Index: llvm/lib/VMCore/Type.cpp
diff -u llvm/lib/VMCore/Type.cpp:1.94 llvm/lib/VMCore/Type.cpp:1.95
--- llvm/lib/VMCore/Type.cpp:1.94	Mon Feb  9 15:01:23 2004
+++ llvm/lib/VMCore/Type.cpp	Mon Feb 16 21:03:47 2004
@@ -42,7 +42,7 @@
 static std::map<const Type*, std::string> AbstractTypeDescriptions;
 
 Type::Type(const std::string &name, PrimitiveID id)
-  : Value(Type::TypeTy, Value::TypeVal), ForwardType(0) {
+  : Value(Type::TypeTy, Value::TypeVal), RefCount(0), ForwardType(0) {
   if (!name.empty())
     ConcreteTypeDescriptions[this] = name;
   ID = id;
@@ -976,7 +976,7 @@
             << *this << "][" << i << "] User = " << U << "\n";
 #endif
     
-  if (AbstractTypeUsers.empty() && RefCount == 0 && isAbstract()) {
+  if (AbstractTypeUsers.empty() && getRefCount() == 0 && isAbstract()) {
 #ifdef DEBUG_MERGE_TYPES
     std::cerr << "DELETEing unused abstract type: <" << *this
               << ">[" << (void*)this << "]" << "\n";




From lattner at cs.uiuc.edu  Mon Feb 16 21:58:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 21:58:01 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/RegAllocLocal.cpp
Message-ID: <200402170357.VAA16899@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

RegAllocLocal.cpp updated: 1.46 -> 1.47

---
Log message:

Refactor code a bit.  No functionality changes, though the comment hints at things to come.


---
Diffs of the changes:  (+46 -30)

Index: llvm/lib/CodeGen/RegAllocLocal.cpp
diff -u llvm/lib/CodeGen/RegAllocLocal.cpp:1.46 llvm/lib/CodeGen/RegAllocLocal.cpp:1.47
--- llvm/lib/CodeGen/RegAllocLocal.cpp:1.46	Sun Feb 15 15:37:17 2004
+++ llvm/lib/CodeGen/RegAllocLocal.cpp	Mon Feb 16 21:57:19 2004
@@ -162,7 +162,7 @@
     /// the virtual register slot specified by VirtReg.  It then updates the RA
     /// data structures to indicate the fact that PhysReg is now available.
     ///
-    void spillVirtReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+    void spillVirtReg(MachineBasicBlock &MBB, MachineInstr *MI,
                       unsigned VirtReg, unsigned PhysReg);
 
     /// spillPhysReg - This method spills the specified physical register into
@@ -170,7 +170,7 @@
     /// true, then the request is ignored if the physical register does not
     /// contain a virtual register.
     ///
-    void spillPhysReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+    void spillPhysReg(MachineBasicBlock &MBB, MachineInstr *I,
                       unsigned PhysReg, bool OnlyVirtRegs = false);
 
     /// assignVirtToPhysReg - This method updates local state so that we know
@@ -202,16 +202,23 @@
     /// spills the last used virtual register to the stack, and uses that
     /// register.
     ///
-    unsigned getReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+    unsigned getReg(MachineBasicBlock &MBB, MachineInstr *MI,
                     unsigned VirtReg);
 
-    /// reloadVirtReg - This method loads the specified virtual register into a
-    /// physical register, returning the physical register chosen.  This updates
-    /// the regalloc data structures to reflect the fact that the virtual reg is
-    /// now alive in a physical register, and the previous one isn't.
+    /// reloadVirtReg - This method transforms the specified specified virtual
+    /// register use to refer to a physical register.  This method may do this
+    /// in one of several ways: if the register is available in a physical
+    /// register already, it uses that physical register.  If the value is not
+    /// in a physical register, and if there are physical registers available,
+    /// it loads it into a register.  If register pressure is high, and it is
+    /// possible, it tries to fold the load of the virtual register into the
+    /// instruction itself.  It avoids doing this if register pressure is low to
+    /// improve the chance that subsequent instructions can use the reloaded
+    /// value.  This method returns the modified instruction.
     ///
-    unsigned reloadVirtReg(MachineBasicBlock &MBB,
-                           MachineBasicBlock::iterator &I, unsigned VirtReg);
+    MachineInstr *reloadVirtReg(MachineBasicBlock &MBB, MachineInstr *MI,
+                                unsigned OpNum);
+ 
 
     void reloadPhysReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
                        unsigned PhysReg);
@@ -253,7 +260,7 @@
 /// virtual register slot specified by VirtReg.  It then updates the RA data
 /// structures to indicate the fact that PhysReg is now available.
 ///
-void RA::spillVirtReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+void RA::spillVirtReg(MachineBasicBlock &MBB, MachineInstr *I,
                       unsigned VirtReg, unsigned PhysReg) {
   if (!VirtReg && DisableKill) return;
   assert(VirtReg && "Spilling a physical register is illegal!"
@@ -287,7 +294,7 @@
 /// then the request is ignored if the physical register does not contain a
 /// virtual register.
 ///
-void RA::spillPhysReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+void RA::spillPhysReg(MachineBasicBlock &MBB, MachineInstr *I,
                       unsigned PhysReg, bool OnlyVirtRegs) {
   if (PhysRegsUsed[PhysReg] != -1) {            // Only spill it if it's used!
     if (PhysRegsUsed[PhysReg] || !OnlyVirtRegs)
@@ -400,7 +407,7 @@
 /// register.  If all compatible physical registers are used, this method spills
 /// the last used virtual register to the stack, and uses that register.
 ///
-unsigned RA::getReg(MachineBasicBlock &MBB, MachineBasicBlock::iterator &I,
+unsigned RA::getReg(MachineBasicBlock &MBB, MachineInstr *I,
                     unsigned VirtReg) {
   const TargetRegisterClass *RC = MF->getSSARegMap()->getRegClass(VirtReg);
 
@@ -457,20 +464,30 @@
 }
 
 
-/// reloadVirtReg - This method loads the specified virtual register into a
-/// physical register, returning the physical register chosen.  This updates the
-/// regalloc data structures to reflect the fact that the virtual reg is now
-/// alive in a physical register, and the previous one isn't.
+/// reloadVirtReg - This method transforms the specified specified virtual
+/// register use to refer to a physical register.  This method may do this in
+/// one of several ways: if the register is available in a physical register
+/// already, it uses that physical register.  If the value is not in a physical
+/// register, and if there are physical registers available, it loads it into a
+/// register.  If register pressure is high, and it is possible, it tries to
+/// fold the load of the virtual register into the instruction itself.  It
+/// avoids doing this if register pressure is low to improve the chance that
+/// subsequent instructions can use the reloaded value.  This method returns the
+/// modified instruction.
 ///
-unsigned RA::reloadVirtReg(MachineBasicBlock &MBB,
-                           MachineBasicBlock::iterator &I,
-                           unsigned VirtReg) {
+MachineInstr *RA::reloadVirtReg(MachineBasicBlock &MBB, MachineInstr *MI,
+                                unsigned OpNum) {
+  unsigned VirtReg = MI->getOperand(OpNum).getReg();
+
+  // If the virtual register is already available, just update the instruction
+  // and return.
   if (unsigned PR = getVirt2PhysRegMapSlot(VirtReg)) {
-    MarkPhysRegRecentlyUsed(PR);
-    return PR;               // Already have this value available!
+    MarkPhysRegRecentlyUsed(PR);          // Already have this value available!
+    MI->SetMachineOperandReg(OpNum, PR);  // Assign the input register
+    return MI;
   }
 
-  unsigned PhysReg = getReg(MBB, I, VirtReg);
+  unsigned PhysReg = getReg(MBB, MI, VirtReg);
 
   const TargetRegisterClass *RC = MF->getSSARegMap()->getRegClass(VirtReg);
   int FrameIndex = getStackSpaceFor(VirtReg, RC);
@@ -481,9 +498,11 @@
                   << RegInfo->getName(PhysReg) << "\n");
 
   // Add move instruction(s)
-  RegInfo->loadRegFromStackSlot(MBB, I, PhysReg, FrameIndex, RC);
+  RegInfo->loadRegFromStackSlot(MBB, MI, PhysReg, FrameIndex, RC);
   ++NumReloaded;    // Update statistics
-  return PhysReg;
+
+  MI->SetMachineOperandReg(OpNum, PhysReg);  // Assign the input register
+  return MI;
 }
 
 
@@ -513,14 +532,11 @@
     // physical register is referenced by the instruction, that it is guaranteed
     // to be live-in, or the input is badly hosed.
     //
-    for (unsigned i = 0, e = MI->getNumOperands(); i != e; ++i)
+    for (unsigned i = 0; i != MI->getNumOperands(); ++i)
       if (MI->getOperand(i).isUse() &&
           !MI->getOperand(i).isDef() && MI->getOperand(i).isRegister() &&
-          MRegisterInfo::isVirtualRegister(MI->getOperand(i).getReg())) {
-        unsigned VirtSrcReg = MI->getOperand(i).getReg();
-        unsigned PhysSrcReg = reloadVirtReg(MBB, MI, VirtSrcReg);
-        MI->SetMachineOperandReg(i, PhysSrcReg);  // Assign the input register
-      }
+          MRegisterInfo::isVirtualRegister(MI->getOperand(i).getReg()))
+        MI = reloadVirtReg(MBB, MI, i);
 
     if (!DisableKill) {
       // If this instruction is the last user of anything in registers, kill the




From alkis at cs.uiuc.edu  Mon Feb 16 22:05:01 2004
From: alkis at cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 22:05:01 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/LiveIntervals.cpp
Message-ID: <200402170404.WAA17106@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

LiveIntervals.cpp updated: 1.51 -> 1.52

---
Log message:

Fix spilled interval update. It was too conservative.


---
Diffs of the changes:  (+4 -1)

Index: llvm/lib/CodeGen/LiveIntervals.cpp
diff -u llvm/lib/CodeGen/LiveIntervals.cpp:1.51 llvm/lib/CodeGen/LiveIntervals.cpp:1.52
--- llvm/lib/CodeGen/LiveIntervals.cpp:1.51	Sun Feb 15 04:24:21 2004
+++ llvm/lib/CodeGen/LiveIntervals.cpp	Mon Feb 16 22:04:20 2004
@@ -191,7 +191,10 @@
                 if (mop.isRegister()) {
                     unsigned reg = mop.getReg();
                     if (rep(reg) == li.reg) {
-                        li.addRange(index, index + 2);
+                        if (mop.isUse())
+                            li.addRange(index, index+2);
+                        else
+                            li.addRange(index+1, index+2);
                     }
                 }
             }




From lattner at cs.uiuc.edu  Mon Feb 16 22:09:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 22:09:02 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/RegAllocLocal.cpp
Message-ID: <200402170408.WAA30570@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

RegAllocLocal.cpp updated: 1.47 -> 1.48

---
Log message:

Once we have a way to fold spill code reloads into instructions, we have a way to use it.  :)


---
Diffs of the changes:  (+17 -2)

Index: llvm/lib/CodeGen/RegAllocLocal.cpp
diff -u llvm/lib/CodeGen/RegAllocLocal.cpp:1.47 llvm/lib/CodeGen/RegAllocLocal.cpp:1.48
--- llvm/lib/CodeGen/RegAllocLocal.cpp:1.47	Mon Feb 16 21:57:19 2004
+++ llvm/lib/CodeGen/RegAllocLocal.cpp	Mon Feb 16 22:08:37 2004
@@ -487,9 +487,24 @@
     return MI;
   }
 
-  unsigned PhysReg = getReg(MBB, MI, VirtReg);
-
+  // Otherwise, we need to fold it into the current instruction, or reload it.
+  // If we have registers available to hold the value, use them.
   const TargetRegisterClass *RC = MF->getSSARegMap()->getRegClass(VirtReg);
+  unsigned PhysReg = getFreeReg(RC);
+
+  if (PhysReg == 0) {  // No registers available...
+    /// If we can fold this spill into this instruction, do so now.
+    if (0) {
+      // TODO
+      return MI;
+    }
+
+    // It looks like we can't fold this virtual register load into this
+    // instruction.  Force some poor hapless value out of the register file to
+    // make room for the new register, and reload it.
+    PhysReg = getReg(MBB, MI, VirtReg);
+  }
+
   int FrameIndex = getStackSpaceFor(VirtReg, RC);
 
   markVirtRegModified(VirtReg, false);   // Note that this reg was just reloaded




From lattner at cs.uiuc.edu  Mon Feb 16 22:27:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 22:27:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/InstSelectSimple.cpp PeepholeOptimizer.cpp Printer.cpp X86InstrInfo.td
Message-ID: <200402170426.WAA01371@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

InstSelectSimple.cpp updated: 1.160 -> 1.161
PeepholeOptimizer.cpp updated: 1.16 -> 1.17
Printer.cpp updated: 1.82 -> 1.83
X86InstrInfo.td updated: 1.25 -> 1.26

---
Log message:

Rename the IMULri* instructions to IMULrri, as they are actually three address
instructions.  Add forms of these instructions that read from memory


---
Diffs of the changes:  (+44 -11)

Index: llvm/lib/Target/X86/InstSelectSimple.cpp
diff -u llvm/lib/Target/X86/InstSelectSimple.cpp:1.160 llvm/lib/Target/X86/InstSelectSimple.cpp:1.161
--- llvm/lib/Target/X86/InstSelectSimple.cpp:1.160	Sat Feb 14 19:04:03 2004
+++ llvm/lib/Target/X86/InstSelectSimple.cpp	Mon Feb 16 22:26:43 2004
@@ -1524,10 +1524,10 @@
   }
   
   if (Class == cShort) {
-    BMI(MBB, IP, X86::IMULri16, 2, DestReg).addReg(op0Reg).addZImm(ConstRHS);
+    BMI(MBB, IP, X86::IMULrri16, 2, DestReg).addReg(op0Reg).addZImm(ConstRHS);
     return;
   } else if (Class == cInt) {
-    BMI(MBB, IP, X86::IMULri32, 2, DestReg).addReg(op0Reg).addZImm(ConstRHS);
+    BMI(MBB, IP, X86::IMULrri32, 2, DestReg).addReg(op0Reg).addZImm(ConstRHS);
     return;
   }
 


Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.16 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.17
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.16	Mon Feb 16 17:50:18 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Mon Feb 16 22:26:43 2004
@@ -72,7 +72,7 @@
     // immediate despite the fact that the operands are 16 or 32 bits.  Because
     // this can save three bytes of code size (and icache space), we want to
     // shrink them if possible.
-  case X86::IMULri16: case X86::IMULri32:
+  case X86::IMULrri16: case X86::IMULrri32:
     assert(MI->getNumOperands() == 3 && "These should all have 3 operands!");
     if (MI->getOperand(2).isImmediate()) {
       int Val = MI->getOperand(2).getImmedValue();
@@ -81,13 +81,38 @@
         unsigned Opcode;
         switch (MI->getOpcode()) {
         default: assert(0 && "Unknown opcode value!");
-        case X86::IMULri16: Opcode = X86::IMULri16b; break;
-        case X86::IMULri32: Opcode = X86::IMULri32b; break;
+        case X86::IMULrri16: Opcode = X86::IMULrri16b; break;
+        case X86::IMULrri32: Opcode = X86::IMULrri32b; break;
         }
         unsigned R0 = MI->getOperand(0).getReg();
         unsigned R1 = MI->getOperand(1).getReg();
         I = MBB.insert(MBB.erase(I),
                        BuildMI(Opcode, 2, R0).addReg(R1).addZImm((char)Val));
+        return true;
+      }
+    }
+    return false;
+
+  case X86::IMULrmi16: case X86::IMULrmi32:
+    assert(MI->getNumOperands() == 6 && "These should all have 6 operands!");
+    if (MI->getOperand(5).isImmediate()) {
+      int Val = MI->getOperand(5).getImmedValue();
+      // If the value is the same when signed extended from 8 bits...
+      if (Val == (signed int)(signed char)Val) {
+        unsigned Opcode;
+        switch (MI->getOpcode()) {
+        default: assert(0 && "Unknown opcode value!");
+        case X86::IMULrmi16: Opcode = X86::IMULrmi16b; break;
+        case X86::IMULrmi32: Opcode = X86::IMULrmi32b; break;
+        }
+        unsigned R0 = MI->getOperand(0).getReg();
+        unsigned R1 = MI->getOperand(1).getReg();
+        unsigned Scale = MI->getOperand(2).getImmedValue();
+        unsigned R2 = MI->getOperand(3).getReg();
+        unsigned Offset = MI->getOperand(3).getImmedValue();
+        I = MBB.insert(MBB.erase(I),
+                       BuildMI(Opcode, 2, R0).addReg(R1).addZImm(Scale).
+                             addReg(R2).addSImm(Offset).addZImm((char)Val));
         return true;
       }
     }


Index: llvm/lib/Target/X86/Printer.cpp
diff -u llvm/lib/Target/X86/Printer.cpp:1.82 llvm/lib/Target/X86/Printer.cpp:1.83
--- llvm/lib/Target/X86/Printer.cpp:1.82	Sun Feb 15 15:37:17 2004
+++ llvm/lib/Target/X86/Printer.cpp	Mon Feb 16 22:26:43 2004
@@ -665,7 +665,7 @@
     // like: add r32, r/m32
     //
     // 3 Operands: in this form, we can have 'INST R1, R2, imm', which is used
-    // for instructions like the IMULri instructions.
+    // for instructions like the IMULrri instructions.
     //
     //
     assert(MI->getOperand(0).isRegister() &&


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.25 llvm/lib/Target/X86/X86InstrInfo.td:1.26
--- llvm/lib/Target/X86/X86InstrInfo.td:1.25	Mon Feb 16 17:48:42 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Mon Feb 16 22:26:43 2004
@@ -299,12 +299,20 @@
 
 def IMULrr16 : I2A16<"imul", 0xAF, MRMSrcReg>, TB, OpSize, Pattern<(set R16, (times R16, R16))>;
 def IMULrr32 : I2A32<"imul", 0xAF, MRMSrcReg>, TB        , Pattern<(set R32, (times R32, R32))>;
+def IMULrm16 : I2A16<"imul", 0xAF, MRMSrcMem>, TB, OpSize;
+def IMULrm32 : I2A32<"imul", 0xAF, MRMSrcMem>, TB        ;
+
+
+// These are suprisingly enough not two address instructions!
+def IMULrri16  : X86Inst<"imul", 0x69, MRMSrcReg, Arg16>,     OpSize;  // R16 = R16*I16
+def IMULrri32  : X86Inst<"imul", 0x69, MRMSrcReg, Arg32>;              // R32 = R32*I32
+def IMULrri16b : X86Inst<"imul", 0x6B, MRMSrcReg, Arg8 >,     OpSize;  // R16 = R16*I8
+def IMULrri32b : X86Inst<"imul", 0x6B, MRMSrcReg, Arg8 >;              // R32 = R32*I8
+def IMULrmi16  : X86Inst<"imul", 0x69, MRMSrcMem, Arg16>,     OpSize;  // R16 = [mem16]*I16
+def IMULrmi32  : X86Inst<"imul", 0x69, MRMSrcMem, Arg32>;              // R32 = [mem32]*I32
+def IMULrmi16b : X86Inst<"imul", 0x6B, MRMSrcMem, Arg8 >,     OpSize;  // R16 = [mem16]*I8
+def IMULrmi32b : X86Inst<"imul", 0x6B, MRMSrcMem, Arg8 >;              // R32 = [mem32]*I8
 
-// These are suprisingly enough not two addres instructions!
-def IMULri16 : X86Inst<"imul", 0x69, MRMSrcReg, Arg16>,     OpSize;
-def IMULri32 : X86Inst<"imul", 0x69, MRMSrcReg, Arg32>;
-def IMULri16b : X86Inst<"imul", 0x6B, MRMSrcReg, Arg8>,     OpSize;
-def IMULri32b : X86Inst<"imul", 0x6B, MRMSrcReg, Arg8>;
 
 
 // Logical operators...




From alkis at niobe.cs.uiuc.edu  Mon Feb 16 22:34:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 22:34:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.h X86RegisterInfo.cpp
Message-ID: <200402170433.i1H4XSq12570@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.h updated: 1.21 -> 1.22
X86RegisterInfo.cpp updated: 1.48 -> 1.49

---
Log message:

Add API to check and fold memory operands into instructions.


---
Diffs of the changes:  (+86 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.h
diff -u llvm/lib/Target/X86/X86RegisterInfo.h:1.21 llvm/lib/Target/X86/X86RegisterInfo.h:1.22
--- llvm/lib/Target/X86/X86RegisterInfo.h:1.21	Sat Feb 14 13:49:54 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.h	Mon Feb 16 22:33:17 2004
@@ -42,6 +42,11 @@
 		   unsigned DestReg, unsigned SrcReg,
 		   const TargetRegisterClass *RC) const;
 
+  virtual bool canFoldMemoryOperand(MachineInstr* MI, unsigned i) const;
+
+  virtual int foldMemoryOperand(MachineInstr* MI, unsigned i,
+                                int FrameIndex) const;
+
   void eliminateCallFramePseudoInstr(MachineFunction &MF,
                                      MachineBasicBlock &MBB,
                                      MachineBasicBlock::iterator MI) const;


Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.48 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.49
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.48	Sat Feb 14 18:15:37 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Mon Feb 16 22:33:17 2004
@@ -79,6 +79,87 @@
   return 1;
 }
 
+bool X86RegisterInfo::canFoldMemoryOperand(MachineInstr* MI,
+                                           unsigned i) const
+{
+  switch(MI->getOpcode()) {
+  case X86::ADDrr8:  case X86::ADDrr16: case X86::ADDrr32:
+  case X86::ADDri8:  case X86::ADDri16: case X86::ADDri32:
+  case X86::MOVrr8:  case X86::MOVrr16: case X86::MOVrr32:
+    return true;
+  default:
+    return false;
+  }
+}
+
+int X86RegisterInfo::foldMemoryOperand(MachineInstr* MI,
+                                       unsigned i,
+                                       int FrameIndex) const
+{
+  MachineBasicBlock& MBB = *MI->getParent();
+  MachineInstr* NI = 0;
+  if (i == 0)
+      switch(MI->getOpcode()) {
+      case X86::MOVrr8:
+    NI = addFrameReference(BuildMI(X86::MOVmr8, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+      case X86::MOVrr16:
+    NI = addFrameReference(BuildMI(X86::MOVmr16, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+      case X86::MOVrr32:
+    NI = addFrameReference(BuildMI(X86::MOVmr32, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+  case X86::ADDrr8:
+    NI = addFrameReference(BuildMI(X86::ADDmr8, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+  case X86::ADDrr16:
+    NI = addFrameReference(BuildMI(X86::ADDmr16, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+  case X86::ADDrr32:
+    NI = addFrameReference(BuildMI(X86::ADDmr32, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
+    break;
+  case X86::ADDri8:
+    NI = addFrameReference(BuildMI(X86::ADDmi8, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
+    break;
+  case X86::ADDri16:
+    NI = addFrameReference(BuildMI(X86::ADDmi16, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
+    break;
+  case X86::ADDri32:
+    NI = addFrameReference(BuildMI(X86::ADDmi32, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
+    break;
+  default:
+    assert(0 && "Operand cannot be folded");
+  }
+  else if (i == 1)
+      switch(MI->getOpcode()) {
+  case X86::MOVrr8:
+    NI = addFrameReference(BuildMI(X86::MOVrm8, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  case X86::MOVrr16:
+    NI = addFrameReference(BuildMI(X86::MOVrm16, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  case X86::MOVrr32:
+    NI = addFrameReference(BuildMI(X86::MOVrm32, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  case X86::ADDrr8:
+    NI = addFrameReference(BuildMI(X86::ADDrm8, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  case X86::ADDrr16:
+    NI = addFrameReference(BuildMI(X86::ADDrm16, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  case X86::ADDrr32:
+    NI = addFrameReference(BuildMI(X86::ADDrm32, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
+    break;
+  default:
+    assert(0 && "Operand cannot be folded");
+  }
+  else
+    assert(0 && "Operand cannot be folded");
+
+  MBB.insert(MBB.erase(MI), NI);
+  return 0;
+}
+
 //===----------------------------------------------------------------------===//
 // Stack Frame Processing methods
 //===----------------------------------------------------------------------===//




From alkis at niobe.cs.uiuc.edu  Mon Feb 16 22:34:20 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 22:34:20 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/Target/MRegisterInfo.h
Message-ID: <200402170433.i1H4XSq12574@niobe.cs.uiuc.edu>


Changes in directory llvm/include/llvm/Target:

MRegisterInfo.h updated: 1.31 -> 1.32

---
Log message:

Add API to check and fold memory operands into instructions.


---
Diffs of the changes:  (+10 -0)

Index: llvm/include/llvm/Target/MRegisterInfo.h
diff -u llvm/include/llvm/Target/MRegisterInfo.h:1.31 llvm/include/llvm/Target/MRegisterInfo.h:1.32
--- llvm/include/llvm/Target/MRegisterInfo.h:1.31	Sat Feb 14 13:49:05 2004
+++ llvm/include/llvm/Target/MRegisterInfo.h	Mon Feb 16 22:33:18 2004
@@ -242,6 +242,16 @@
                            const TargetRegisterClass *RC) const = 0;
 
 
+  virtual bool canFoldMemoryOperand(MachineInstr* MI, unsigned i) const {
+    return false;
+  }
+
+  virtual int foldMemoryOperand(MachineInstr* MI,
+                                unsigned i,
+                                int FrameIndex) const {
+    return 0;
+  }
+
   /// getCallFrameSetup/DestroyOpcode - These methods return the opcode of the
   /// frame setup/destroy instructions if they exist (-1 otherwise).  Some
   /// targets use pseudo instructions in order to abstract away the difference




From alkis at cs.uiuc.edu  Mon Feb 16 23:15:01 2004
From: alkis at cs.uiuc.edu (Alkis Evlogimenos)
Date: Mon Feb 16 23:15:01 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/CodeGen/LiveIntervals.h
Message-ID: <200402170514.XAA03018@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm/CodeGen:

LiveIntervals.h updated: 1.17 -> 1.18

---
Log message:

Add LiveIntervals::Interval::empty() member function.


---
Diffs of the changes:  (+4 -2)

Index: llvm/include/llvm/CodeGen/LiveIntervals.h
diff -u llvm/include/llvm/CodeGen/LiveIntervals.h:1.17 llvm/include/llvm/CodeGen/LiveIntervals.h:1.18
--- llvm/include/llvm/CodeGen/LiveIntervals.h:1.17	Sun Feb 15 04:24:12 2004
+++ llvm/include/llvm/CodeGen/LiveIntervals.h	Mon Feb 16 23:14:37 2004
@@ -42,13 +42,15 @@
 
             Interval(unsigned r);
 
+            bool empty() const { return ranges.empty(); }
+
             unsigned start() const {
-                assert(!ranges.empty() && "empty interval for register");
+                assert(!empty() && "empty interval for register");
                 return ranges.front().first;
             }
 
             unsigned end() const {
-                assert(!ranges.empty() && "empty interval for register");
+                assert(!empty() && "empty interval for register");
                 return ranges.back().second;
             }
 




From lattner at cs.uiuc.edu  Mon Feb 16 23:26:04 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 23:26:04 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp X86InstrInfo.td
Message-ID: <200402170526.XAA04853@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.17 -> 1.18
X86InstrInfo.td updated: 1.26 -> 1.27

---
Log message:

Add mem forms of AND instructions


---
Diffs of the changes:  (+44 -4)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.17 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.18
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.17	Mon Feb 16 22:26:43 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Mon Feb 16 23:25:50 2004
@@ -109,9 +109,9 @@
         unsigned R1 = MI->getOperand(1).getReg();
         unsigned Scale = MI->getOperand(2).getImmedValue();
         unsigned R2 = MI->getOperand(3).getReg();
-        unsigned Offset = MI->getOperand(3).getImmedValue();
+        unsigned Offset = MI->getOperand(4).getImmedValue();
         I = MBB.insert(MBB.erase(I),
-                       BuildMI(Opcode, 2, R0).addReg(R1).addZImm(Scale).
+                       BuildMI(Opcode, 5, R0).addReg(R1).addZImm(Scale).
                              addReg(R2).addSImm(Offset).addZImm((char)Val));
         return true;
       }
@@ -144,6 +144,31 @@
         case X86::ORri32:   Opcode = X86::ORri32b; break;
         case X86::XORri16:  Opcode = X86::XORri16b; break;
         case X86::XORri32:  Opcode = X86::XORri32b; break;
+        }
+        unsigned R0 = MI->getOperand(0).getReg();
+        unsigned Scale = MI->getOperand(1).getImmedValue();
+        unsigned R1 = MI->getOperand(2).getReg();
+        unsigned Offset = MI->getOperand(3).getImmedValue();
+        I = MBB.insert(MBB.erase(I),
+                       BuildMI(Opcode, 5).addReg(R0).addZImm(Scale).
+                             addReg(R1).addSImm(Offset).addZImm((char)Val));
+        return true;
+      }
+    }
+    return false;
+
+
+  case X86::ANDmi16:  case X86::ANDmi32:
+    assert(MI->getNumOperands() == 5 && "These should all have 5 operands!");
+    if (MI->getOperand(4).isImmediate()) {
+      int Val = MI->getOperand(4).getImmedValue();
+      // If the value is the same when signed extended from 8 bits...
+      if (Val == (signed int)(signed char)Val) {
+        unsigned Opcode;
+        switch (MI->getOpcode()) {
+        default: assert(0 && "Unknown opcode value!");
+        case X86::ANDmi16:  Opcode = X86::ANDmi16b; break;
+        case X86::ANDmi32:  Opcode = X86::ANDmi32b; break;
         }
         unsigned R0 = MI->getOperand(0).getReg();
         I = MBB.insert(MBB.erase(I),


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.26 llvm/lib/Target/X86/X86InstrInfo.td:1.27
--- llvm/lib/Target/X86/X86InstrInfo.td:1.26	Mon Feb 16 22:26:43 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Mon Feb 16 23:25:50 2004
@@ -319,11 +319,26 @@
 def ANDrr8   : I2A8 <"and", 0x20, MRMDestReg>,         Pattern<(set R8 , (and R8 , R8 ))>;
 def ANDrr16  : I2A16<"and", 0x21, MRMDestReg>, OpSize, Pattern<(set R16, (and R16, R16))>;
 def ANDrr32  : I2A32<"and", 0x21, MRMDestReg>,         Pattern<(set R32, (and R32, R32))>;
+def ANDmr8   : I2A8 <"and", 0x20, MRMDestMem>;            // [mem8]  &= R8
+def ANDmr16  : I2A16<"and", 0x21, MRMDestMem>, OpSize;    // [mem16] &= R16
+def ANDmr32  : I2A32<"and", 0x21, MRMDestMem>;            // [mem32] &= R32
+def ANDrm8   : I2A8 <"and", 0x22, MRMSrcMem >;            // R8  &= [mem8]
+def ANDrm16  : I2A16<"and", 0x23, MRMSrcMem >, OpSize;    // R16 &= [mem16]
+def ANDrm32  : I2A32<"and", 0x23, MRMSrcMem >;            // R32 &= [mem32]
+
 def ANDri8   : I2A8 <"and", 0x80, MRMS4r    >,         Pattern<(set R8 , (and R8 , imm))>;
 def ANDri16  : I2A16<"and", 0x81, MRMS4r    >, OpSize, Pattern<(set R16, (and R16, imm))>;
 def ANDri32  : I2A32<"and", 0x81, MRMS4r    >,         Pattern<(set R32, (and R32, imm))>;
-def ANDri16b : I2A8 <"and", 0x83, MRMS4r    >, OpSize;
-def ANDri32b : I2A8 <"and", 0x83, MRMS4r    >;
+def ANDmi8   : I2A8 <"and", 0x80, MRMS4m    >;            // [mem8]  &= imm8
+def ANDmi16  : I2A16<"and", 0x81, MRMS4m    >, OpSize;    // [mem16] &= imm16
+def ANDmi32  : I2A32<"and", 0x81, MRMS4m    >;            // [mem32] &= imm32
+
+def ANDri16b : I2A8 <"and", 0x83, MRMS4r    >, OpSize;    // R16 &= imm8
+def ANDri32b : I2A8 <"and", 0x83, MRMS4r    >;            // R32 &= imm8
+def ANDmi16b : I2A8 <"and", 0x83, MRMS4m    >, OpSize;    // [mem16] &= imm8
+def ANDmi32b : I2A8 <"and", 0x83, MRMS4m    >;            // [mem32] &= imm8
+
+
 
 def ORrr8    : I2A8 <"or" , 0x08, MRMDestReg>,         Pattern<(set R8 , (or  R8 , R8 ))>;
 def ORrr16   : I2A16<"or" , 0x09, MRMDestReg>, OpSize, Pattern<(set R16, (or  R16, R16))>;




From lattner at cs.uiuc.edu  Mon Feb 16 23:36:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 23:36:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170535.XAA04942@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.49 -> 1.50

---
Log message:

Scrunchify code, by adding helpers.  No functionality changes.


---
Diffs of the changes:  (+45 -56)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.49 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.50
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.49	Mon Feb 16 22:33:17 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Mon Feb 16 23:35:13 2004
@@ -92,70 +92,59 @@
   }
 }
 
+static MachineInstr *MakeMRInst(unsigned Opcode, unsigned FrameIndex,
+                                MachineInstr *MI) {
+  return addFrameReference(BuildMI(Opcode, 5), FrameIndex)
+                 .addReg(MI->getOperand(1).getReg());
+}
+
+static MachineInstr *MakeMIInst(unsigned Opcode, unsigned FrameIndex,
+                                MachineInstr *MI) {
+  return addFrameReference(BuildMI(Opcode, 5), FrameIndex)
+                 .addZImm(MI->getOperand(1).getImmedValue());
+}
+
+static MachineInstr *MakeRMInst(unsigned Opcode, unsigned FrameIndex,
+                                MachineInstr *MI) {
+  return addFrameReference(BuildMI(Opcode, 5)
+          .addReg(MI->getOperand(0).getReg()), FrameIndex);
+}
+
 int X86RegisterInfo::foldMemoryOperand(MachineInstr* MI,
                                        unsigned i,
                                        int FrameIndex) const
 {
+  /// FIXME: This should obviously be autogenerated by tablegen when patterns
+  /// are available!
   MachineBasicBlock& MBB = *MI->getParent();
   MachineInstr* NI = 0;
-  if (i == 0)
-      switch(MI->getOpcode()) {
-      case X86::MOVrr8:
-    NI = addFrameReference(BuildMI(X86::MOVmr8, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-      case X86::MOVrr16:
-    NI = addFrameReference(BuildMI(X86::MOVmr16, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-      case X86::MOVrr32:
-    NI = addFrameReference(BuildMI(X86::MOVmr32, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-  case X86::ADDrr8:
-    NI = addFrameReference(BuildMI(X86::ADDmr8, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-  case X86::ADDrr16:
-    NI = addFrameReference(BuildMI(X86::ADDmr16, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-  case X86::ADDrr32:
-    NI = addFrameReference(BuildMI(X86::ADDmr32, 5), FrameIndex).addReg(MI->getOperand(1).getReg());
-    break;
-  case X86::ADDri8:
-    NI = addFrameReference(BuildMI(X86::ADDmi8, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
-    break;
-  case X86::ADDri16:
-    NI = addFrameReference(BuildMI(X86::ADDmi16, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
-    break;
-  case X86::ADDri32:
-    NI = addFrameReference(BuildMI(X86::ADDmi32, 5), FrameIndex).addZImm(MI->getOperand(1).getImmedValue());
-    break;
-  default:
+  if (i == 0) {
+    switch(MI->getOpcode()) {
+    case X86::MOVrr8:  NI = MakeMRInst(X86::MOVmr8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeMRInst(X86::MOVmr16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeMRInst(X86::MOVmr32, FrameIndex, MI); break;
+    case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
+    case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
+    case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
+    case X86::ADDri8:  NI = MakeMIInst(X86::ADDmi8 , FrameIndex, MI); break;
+    case X86::ADDri16: NI = MakeMIInst(X86::ADDmi16, FrameIndex, MI); break;
+    case X86::ADDri32: NI = MakeMIInst(X86::ADDmi32, FrameIndex, MI); break;
+    default: assert(0 && "Operand cannot be folded");
+    }
+  } else if (i == 1) {
+    switch(MI->getOpcode()) {
+    case X86::MOVrr8:  NI = MakeRMInst(X86::MOVrm8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeRMInst(X86::MOVrm16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeRMInst(X86::MOVrm32, FrameIndex, MI); break;
+    case X86::ADDrr8:  NI = MakeRMInst(X86::ADDrm8 , FrameIndex, MI); break;
+    case X86::ADDrr16: NI = MakeRMInst(X86::ADDrm16, FrameIndex, MI); break;
+    case X86::ADDrr32: NI = MakeRMInst(X86::ADDrm32, FrameIndex, MI); break;
+    default: assert(0 && "Operand cannot be folded");
+    }
+  } else {
     assert(0 && "Operand cannot be folded");
   }
-  else if (i == 1)
-      switch(MI->getOpcode()) {
-  case X86::MOVrr8:
-    NI = addFrameReference(BuildMI(X86::MOVrm8, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  case X86::MOVrr16:
-    NI = addFrameReference(BuildMI(X86::MOVrm16, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  case X86::MOVrr32:
-    NI = addFrameReference(BuildMI(X86::MOVrm32, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  case X86::ADDrr8:
-    NI = addFrameReference(BuildMI(X86::ADDrm8, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  case X86::ADDrr16:
-    NI = addFrameReference(BuildMI(X86::ADDrm16, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  case X86::ADDrr32:
-    NI = addFrameReference(BuildMI(X86::ADDrm32, 5).addReg(MI->getOperand(0).getReg()), FrameIndex);
-    break;
-  default:
-    assert(0 && "Operand cannot be folded");
-  }
-  else
-    assert(0 && "Operand cannot be folded");
-
+  
   MBB.insert(MBB.erase(MI), NI);
   return 0;
 }




From lattner at cs.uiuc.edu  Mon Feb 16 23:47:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 23:47:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170546.XAA06262@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.50 -> 1.51

---
Log message:

Add support for folding memory operands into AND and IMUL's


---
Diffs of the changes:  (+30 -2)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.50 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.51
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.50	Mon Feb 16 23:35:13 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Mon Feb 16 23:46:06 2004
@@ -85,8 +85,13 @@
   switch(MI->getOpcode()) {
   case X86::ADDrr8:  case X86::ADDrr16: case X86::ADDrr32:
   case X86::ADDri8:  case X86::ADDri16: case X86::ADDri32:
+  case X86::ANDrr8:  case X86::ANDrr16: case X86::ANDrr32:
+  case X86::ANDri8:  case X86::ANDri16: case X86::ANDri32:
   case X86::MOVrr8:  case X86::MOVrr16: case X86::MOVrr32:
     return true;
+  case X86::IMULrr16:  case X86::IMULrr32:
+  case X86::IMULrri16: case X86::IMULrri32:
+    return i == 1;
   default:
     return false;
   }
@@ -106,10 +111,18 @@
 
 static MachineInstr *MakeRMInst(unsigned Opcode, unsigned FrameIndex,
                                 MachineInstr *MI) {
-  return addFrameReference(BuildMI(Opcode, 5)
-          .addReg(MI->getOperand(0).getReg()), FrameIndex);
+  return addFrameReference(BuildMI(Opcode, 5, MI->getOperand(0).getReg()),
+                           FrameIndex);
 }
 
+static MachineInstr *MakeRMIInst(unsigned Opcode, unsigned FrameIndex,
+                                 MachineInstr *MI) {
+  return addFrameReference(BuildMI(Opcode, 5, MI->getOperand(0).getReg()),
+                        FrameIndex).addZImm(MI->getOperand(2).getImmedValue());
+}
+
+
+
 int X86RegisterInfo::foldMemoryOperand(MachineInstr* MI,
                                        unsigned i,
                                        int FrameIndex) const
@@ -129,6 +142,13 @@
     case X86::ADDri8:  NI = MakeMIInst(X86::ADDmi8 , FrameIndex, MI); break;
     case X86::ADDri16: NI = MakeMIInst(X86::ADDmi16, FrameIndex, MI); break;
     case X86::ADDri32: NI = MakeMIInst(X86::ADDmi32, FrameIndex, MI); break;
+    case X86::ANDrr8:  NI = MakeMRInst(X86::ANDmr8 , FrameIndex, MI); break;
+    case X86::ANDrr16: NI = MakeMRInst(X86::ANDmr16, FrameIndex, MI); break;
+    case X86::ANDrr32: NI = MakeMRInst(X86::ANDmr32, FrameIndex, MI); break;
+    case X86::ANDri8:  NI = MakeMIInst(X86::ANDmi8 , FrameIndex, MI); break;
+    case X86::ANDri16: NI = MakeMIInst(X86::ANDmi16, FrameIndex, MI); break;
+    case X86::ANDri32: NI = MakeMIInst(X86::ANDmi32, FrameIndex, MI); break;
+
     default: assert(0 && "Operand cannot be folded");
     }
   } else if (i == 1) {
@@ -139,6 +159,14 @@
     case X86::ADDrr8:  NI = MakeRMInst(X86::ADDrm8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeRMInst(X86::ADDrm16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeRMInst(X86::ADDrm32, FrameIndex, MI); break;
+    case X86::ANDrr8:  NI = MakeRMInst(X86::ANDrm8 , FrameIndex, MI); break;
+    case X86::ANDrr16: NI = MakeRMInst(X86::ANDrm16, FrameIndex, MI); break;
+    case X86::ANDrr32: NI = MakeRMInst(X86::ANDrm32, FrameIndex, MI); break;
+    case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16, FrameIndex, MI); break;
+    case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
+    case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI); break;
+    case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI); break;
+
     default: assert(0 && "Operand cannot be folded");
     }
   } else {




From lattner at cs.uiuc.edu  Mon Feb 16 23:55:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 23:55:02 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/Target/MRegisterInfo.h
Message-ID: <200402170554.XAA11328@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm/Target:

MRegisterInfo.h updated: 1.32 -> 1.33

---
Log message:

Simplify and document the new interface


---
Diffs of the changes:  (+8 -7)

Index: llvm/include/llvm/Target/MRegisterInfo.h
diff -u llvm/include/llvm/Target/MRegisterInfo.h:1.32 llvm/include/llvm/Target/MRegisterInfo.h:1.33
--- llvm/include/llvm/Target/MRegisterInfo.h:1.32	Mon Feb 16 22:33:18 2004
+++ llvm/include/llvm/Target/MRegisterInfo.h	Mon Feb 16 23:54:26 2004
@@ -242,14 +242,15 @@
                            const TargetRegisterClass *RC) const = 0;
 
 
-  virtual bool canFoldMemoryOperand(MachineInstr* MI, unsigned i) const {
+  /// foldMemoryOperand - If this target supports it, fold a load or store of
+  /// the specified stack slot into the specified machine instruction for the
+  /// specified operand.  If this is possible, the target should perform the
+  /// folding and return true, otherwise it should return false.  If it folds
+  /// the instruction, it is likely that the MachineInstruction the iterator
+  /// references has been changed.
+  virtual bool foldMemoryOperand(MachineBasicBlock::iterator &MI,
+                                 unsigned OpNum, int FrameIndex) const {
     return false;
-  }
-
-  virtual int foldMemoryOperand(MachineInstr* MI,
-                                unsigned i,
-                                int FrameIndex) const {
-    return 0;
   }
 
   /// getCallFrameSetup/DestroyOpcode - These methods return the opcode of the




From lattner at cs.uiuc.edu  Mon Feb 16 23:56:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Mon Feb 16 23:56:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp X86RegisterInfo.h
Message-ID: <200402170555.XAA11556@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.51 -> 1.52
X86RegisterInfo.h updated: 1.22 -> 1.23

---
Log message:

Change to match the newer, simpler, interface


---
Diffs of the changes:  (+15 -33)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.51 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.52
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.51	Mon Feb 16 23:46:06 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Mon Feb 16 23:54:56 2004
@@ -79,24 +79,6 @@
   return 1;
 }
 
-bool X86RegisterInfo::canFoldMemoryOperand(MachineInstr* MI,
-                                           unsigned i) const
-{
-  switch(MI->getOpcode()) {
-  case X86::ADDrr8:  case X86::ADDrr16: case X86::ADDrr32:
-  case X86::ADDri8:  case X86::ADDri16: case X86::ADDri32:
-  case X86::ANDrr8:  case X86::ANDrr16: case X86::ANDrr32:
-  case X86::ANDri8:  case X86::ANDri16: case X86::ANDri32:
-  case X86::MOVrr8:  case X86::MOVrr16: case X86::MOVrr32:
-    return true;
-  case X86::IMULrr16:  case X86::IMULrr32:
-  case X86::IMULrri16: case X86::IMULrri32:
-    return i == 1;
-  default:
-    return false;
-  }
-}
-
 static MachineInstr *MakeMRInst(unsigned Opcode, unsigned FrameIndex,
                                 MachineInstr *MI) {
   return addFrameReference(BuildMI(Opcode, 5), FrameIndex)
@@ -122,11 +104,8 @@
 }
 
 
-
-int X86RegisterInfo::foldMemoryOperand(MachineInstr* MI,
-                                       unsigned i,
-                                       int FrameIndex) const
-{
+bool X86RegisterInfo::foldMemoryOperand(MachineBasicBlock::iterator &MI,
+                                        unsigned i, int FrameIndex) const {
   /// FIXME: This should obviously be autogenerated by tablegen when patterns
   /// are available!
   MachineBasicBlock& MBB = *MI->getParent();
@@ -148,8 +127,7 @@
     case X86::ANDri8:  NI = MakeMIInst(X86::ANDmi8 , FrameIndex, MI); break;
     case X86::ANDri16: NI = MakeMIInst(X86::ANDmi16, FrameIndex, MI); break;
     case X86::ANDri32: NI = MakeMIInst(X86::ANDmi32, FrameIndex, MI); break;
-
-    default: assert(0 && "Operand cannot be folded");
+    default: return false; // Cannot fold
     }
   } else if (i == 1) {
     switch(MI->getOpcode()) {
@@ -166,15 +144,14 @@
     case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
     case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI); break;
     case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI); break;
-
-    default: assert(0 && "Operand cannot be folded");
+    default: return false;  // cannot fold.
     }
   } else {
-    assert(0 && "Operand cannot be folded");
+    return false; // cannot fold.
   }
   
-  MBB.insert(MBB.erase(MI), NI);
-  return 0;
+  MI = MBB.insert(MBB.erase(MI), NI);
+  return true;
 }
 
 //===----------------------------------------------------------------------===//


Index: llvm/lib/Target/X86/X86RegisterInfo.h
diff -u llvm/lib/Target/X86/X86RegisterInfo.h:1.22 llvm/lib/Target/X86/X86RegisterInfo.h:1.23
--- llvm/lib/Target/X86/X86RegisterInfo.h:1.22	Mon Feb 16 22:33:17 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.h	Mon Feb 16 23:54:57 2004
@@ -42,10 +42,15 @@
 		   unsigned DestReg, unsigned SrcReg,
 		   const TargetRegisterClass *RC) const;
 
-  virtual bool canFoldMemoryOperand(MachineInstr* MI, unsigned i) const;
+  /// foldMemoryOperand - If this target supports it, fold a load or store of
+  /// the specified stack slot into the specified machine instruction for the
+  /// specified operand.  If this is possible, the target should perform the
+  /// folding and return true, otherwise it should return false.  If it folds
+  /// the instruction, it is likely that the MachineInstruction the iterator
+  /// references has been changed.
+  virtual bool foldMemoryOperand(MachineBasicBlock::iterator &MI,unsigned OpNum,
+                                 int FrameIndex) const;
 
-  virtual int foldMemoryOperand(MachineInstr* MI, unsigned i,
-                                int FrameIndex) const;
 
   void eliminateCallFramePseudoInstr(MachineFunction &MF,
                                      MachineBasicBlock &MBB,




From lattner at cs.uiuc.edu  Tue Feb 17 00:03:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:03:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp
Message-ID: <200402170602.AAA13851@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.18 -> 1.19

---
Log message:

Whoops, got my cases swapped.


---
Diffs of the changes:  (+6 -6)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.18 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.19
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.18	Mon Feb 16 23:25:50 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 00:02:15 2004
@@ -146,12 +146,8 @@
         case X86::XORri32:  Opcode = X86::XORri32b; break;
         }
         unsigned R0 = MI->getOperand(0).getReg();
-        unsigned Scale = MI->getOperand(1).getImmedValue();
-        unsigned R1 = MI->getOperand(2).getReg();
-        unsigned Offset = MI->getOperand(3).getImmedValue();
         I = MBB.insert(MBB.erase(I),
-                       BuildMI(Opcode, 5).addReg(R0).addZImm(Scale).
-                             addReg(R1).addSImm(Offset).addZImm((char)Val));
+                    BuildMI(Opcode, 1, R0, MOTy::UseAndDef).addZImm((char)Val));
         return true;
       }
     }
@@ -171,8 +167,12 @@
         case X86::ANDmi32:  Opcode = X86::ANDmi32b; break;
         }
         unsigned R0 = MI->getOperand(0).getReg();
+        unsigned Scale = MI->getOperand(1).getImmedValue();
+        unsigned R1 = MI->getOperand(2).getReg();
+        unsigned Offset = MI->getOperand(3).getImmedValue();
         I = MBB.insert(MBB.erase(I),
-                    BuildMI(Opcode, 1, R0, MOTy::UseAndDef).addZImm((char)Val));
+                       BuildMI(Opcode, 5).addReg(R0).addZImm(Scale).
+                             addReg(R1).addSImm(Offset).addZImm((char)Val));
         return true;
       }
     }




From lattner at cs.uiuc.edu  Tue Feb 17 00:17:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:17:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/InstSelectSimple.cpp PeepholeOptimizer.cpp Printer.cpp X86InstrInfo.td
Message-ID: <200402170616.AAA16947@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

InstSelectSimple.cpp updated: 1.161 -> 1.162
PeepholeOptimizer.cpp updated: 1.19 -> 1.20
Printer.cpp updated: 1.83 -> 1.84
X86InstrInfo.td updated: 1.27 -> 1.28

---
Log message:

Rename MOVi[mr] instructions to MOV[rm]i


---
Diffs of the changes:  (+42 -36)

Index: llvm/lib/Target/X86/InstSelectSimple.cpp
diff -u llvm/lib/Target/X86/InstSelectSimple.cpp:1.161 llvm/lib/Target/X86/InstSelectSimple.cpp:1.162
--- llvm/lib/Target/X86/InstSelectSimple.cpp:1.161	Mon Feb 16 22:26:43 2004
+++ llvm/lib/Target/X86/InstSelectSimple.cpp	Tue Feb 17 00:16:44 2004
@@ -306,7 +306,7 @@
         RegMap.erase(V);  // Assign a new name to this constant if ref'd again
       } else if (GlobalValue *GV = dyn_cast<GlobalValue>(V)) {
         // Move the address of the global into the register
-        BMI(MBB, IPt, X86::MOVir32, 1, Reg).addGlobalAddress(GV);
+        BMI(MBB, IPt, X86::MOVri32, 1, Reg).addGlobalAddress(GV);
         RegMap.erase(V);  // Assign a new name to this address if ref'd again
       }
 
@@ -423,19 +423,19 @@
     if (Class == cLong) {
       // Copy the value into the register pair.
       uint64_t Val = cast<ConstantInt>(C)->getRawValue();
-      BMI(MBB, IP, X86::MOVir32, 1, R).addZImm(Val & 0xFFFFFFFF);
-      BMI(MBB, IP, X86::MOVir32, 1, R+1).addZImm(Val >> 32);
+      BMI(MBB, IP, X86::MOVri32, 1, R).addZImm(Val & 0xFFFFFFFF);
+      BMI(MBB, IP, X86::MOVri32, 1, R+1).addZImm(Val >> 32);
       return;
     }
 
     assert(Class <= cInt && "Type not handled yet!");
 
     static const unsigned IntegralOpcodeTab[] = {
-      X86::MOVir8, X86::MOVir16, X86::MOVir32
+      X86::MOVri8, X86::MOVri16, X86::MOVri32
     };
 
     if (C->getType() == Type::BoolTy) {
-      BMI(MBB, IP, X86::MOVir8, 1, R).addZImm(C == ConstantBool::True);
+      BMI(MBB, IP, X86::MOVri8, 1, R).addZImm(C == ConstantBool::True);
     } else {
       ConstantInt *CI = cast<ConstantInt>(C);
       BMI(MBB, IP, IntegralOpcodeTab[Class], 1, R).addZImm(CI->getRawValue());
@@ -458,7 +458,7 @@
 
   } else if (isa<ConstantPointerNull>(C)) {
     // Copy zero (null pointer) to the register.
-    BMI(MBB, IP, X86::MOVir32, 1, R).addZImm(0);
+    BMI(MBB, IP, X86::MOVri32, 1, R).addZImm(0);
   } else if (ConstantPointerRef *CPR = dyn_cast<ConstantPointerRef>(C)) {
     unsigned SrcReg = getReg(CPR->getValue(), MBB, IP);
     BMI(MBB, IP, X86::MOVrr32, 1, R).addReg(SrcReg);
@@ -1211,7 +1211,7 @@
       }
     } else {
       // Values other than zero are not implemented yet.
-      BuildMI(BB, X86::MOVir32, 1, TmpReg1).addZImm(0);
+      BuildMI(BB, X86::MOVri32, 1, TmpReg1).addZImm(0);
     }
     return;
 
@@ -1287,7 +1287,7 @@
           CountReg = makeAnotherReg(Type::IntTy);
           BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(1);
         }
-        BuildMI(BB, X86::MOVir16, 1, X86::AX).addZImm((Val << 8) | Val);
+        BuildMI(BB, X86::MOVri16, 1, X86::AX).addZImm((Val << 8) | Val);
         Opcode = X86::REP_STOSW;
         break;
       case 0:   // DWORD aligned
@@ -1298,13 +1298,13 @@
           BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(2);
         }
         Val = (Val << 8) | Val;
-        BuildMI(BB, X86::MOVir32, 1, X86::EAX).addZImm((Val << 16) | Val);
+        BuildMI(BB, X86::MOVri32, 1, X86::EAX).addZImm((Val << 16) | Val);
         Opcode = X86::REP_STOSD;
         break;
       case 1:   // BYTE aligned
       case 3:   // BYTE aligned
         CountReg = getReg(CI.getOperand(3));
-        BuildMI(BB, X86::MOVir8, 1, X86::AL).addZImm(Val);
+        BuildMI(BB, X86::MOVri8, 1, X86::AL).addZImm(Val);
         Opcode = X86::REP_STOSB;
         break;
       }
@@ -1532,12 +1532,12 @@
   }
 
   // Most general case, emit a normal multiply...
-  static const unsigned MOVirTab[] = {
-    X86::MOVir8, X86::MOVir16, X86::MOVir32
+  static const unsigned MOVriTab[] = {
+    X86::MOVri8, X86::MOVri16, X86::MOVri32
   };
 
   unsigned TmpReg = makeAnotherReg(DestTy);
-  BMI(MBB, IP, MOVirTab[Class], 1, TmpReg).addZImm(ConstRHS);
+  BMI(MBB, IP, MOVriTab[Class], 1, TmpReg).addZImm(ConstRHS);
   
   // Emit a MUL to multiply the register holding the index by
   // elementSize, putting the result in OffsetReg.
@@ -1647,7 +1647,7 @@
   static const unsigned Regs[]     ={ X86::AL    , X86::AX     , X86::EAX     };
   static const unsigned MovOpcode[]={ X86::MOVrr8, X86::MOVrr16, X86::MOVrr32 };
   static const unsigned SarOpcode[]={ X86::SARir8, X86::SARir16, X86::SARir32 };
-  static const unsigned ClrOpcode[]={ X86::MOVir8, X86::MOVir16, X86::MOVir32 };
+  static const unsigned ClrOpcode[]={ X86::MOVri8, X86::MOVri16, X86::MOVri32 };
   static const unsigned ExtRegs[]  ={ X86::AH    , X86::DX     , X86::EDX     };
 
   static const unsigned DivOpcode[][4] = {
@@ -1742,12 +1742,12 @@
         if (isLeftShift) {
           BMI(MBB, IP, X86::SHLir32, 2,
               DestReg + 1).addReg(SrcReg).addZImm(Amount);
-          BMI(MBB, IP, X86::MOVir32, 1,
+          BMI(MBB, IP, X86::MOVri32, 1,
               DestReg).addZImm(0);
         } else {
           unsigned Opcode = isSigned ? X86::SARir32 : X86::SHRir32;
           BMI(MBB, IP, Opcode, 2, DestReg).addReg(SrcReg+1).addZImm(Amount);
-          BMI(MBB, IP, X86::MOVir32, 1, DestReg+1).addZImm(0);
+          BMI(MBB, IP, X86::MOVri32, 1, DestReg+1).addZImm(0);
         }
       }
     } else {
@@ -1761,7 +1761,7 @@
       } else {
         // Other shifts use a fixed zero value if the shift is more than 32
         // bits.
-        BMI(MBB, IP, X86::MOVir32, 1, TmpReg).addZImm(0);
+        BMI(MBB, IP, X86::MOVri32, 1, TmpReg).addZImm(0);
       }
 
       // Initialize CL with the shift amount...
@@ -1989,7 +1989,7 @@
 
     if (isLong) {  // Handle upper 32 bits as appropriate...
       if (isUnsigned)     // Zero out top bits...
-        BMI(BB, IP, X86::MOVir32, 1, DestReg+1).addZImm(0);
+        BMI(BB, IP, X86::MOVri32, 1, DestReg+1).addZImm(0);
       else                // Sign extend bottom half...
         BMI(BB, IP, X86::SARir32, 2, DestReg+1).addReg(DestReg).addZImm(31);
     }
@@ -2040,7 +2040,7 @@
       // Make a 64 bit temporary... and zero out the top of it...
       unsigned TmpReg = makeAnotherReg(Type::LongTy);
       BMI(BB, IP, X86::MOVrr32, 1, TmpReg).addReg(SrcReg);
-      BMI(BB, IP, X86::MOVir32, 1, TmpReg+1).addZImm(0);
+      BMI(BB, IP, X86::MOVri32, 1, TmpReg+1).addZImm(0);
       SrcTy = Type::LongTy;
       SrcClass = cLong;
       SrcReg = TmpReg;
@@ -2093,7 +2093,7 @@
     addFrameReference(BMI(BB, IP, X86::MOVmr8, 4, HighPartOfCW), CWFrameIdx, 1);
 
     // Set the high part to be round to zero...
-    addFrameReference(BMI(BB, IP, X86::MOVim8, 5), CWFrameIdx, 1).addZImm(12);
+    addFrameReference(BMI(BB, IP, X86::MOVmi8, 5), CWFrameIdx, 1).addZImm(12);
 
     // Reload the modified control word now...
     addFrameReference(BMI(BB, IP, X86::FLDCWm16, 4), CWFrameIdx);


Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.19 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.20
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.19	Tue Feb 17 00:02:15 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 00:16:44 2004
@@ -179,9 +179,9 @@
     return false;
 
 #if 0
-  case X86::MOVir32: Size++;
-  case X86::MOVir16: Size++;
-  case X86::MOVir8:
+  case X86::MOVri32: Size++;
+  case X86::MOVri16: Size++;
+  case X86::MOVri8:
     // FIXME: We can only do this transformation if we know that flags are not
     // used here, because XOR clobbers the flags!
     if (MI->getOperand(1).isImmediate()) {         // avoid mov EAX, <value>
@@ -373,7 +373,7 @@
   // Attempt to fold instructions used by the base register into the instruction
   if (MachineInstr *DefInst = getDefiningInst(BaseRegOp)) {
     switch (DefInst->getOpcode()) {
-    case X86::MOVir32:
+    case X86::MOVri32:
       // If there is no displacement set for this instruction set one now.
       // FIXME: If we can fold two immediates together, we should do so!
       if (DisplacementOp.isImmediate() && !DisplacementOp.getImmedValue()) {
@@ -461,14 +461,14 @@
 
     // Register to memory stores.  Format: <base,scale,indexreg,immdisp>, srcreg
   case X86::MOVrm32: case X86::MOVrm16: case X86::MOVrm8:
-  case X86::MOVim32: case X86::MOVim16: case X86::MOVim8:
+  case X86::MOVmi32: case X86::MOVmi16: case X86::MOVmi8:
     // Check to see if we can fold the source instruction into this one...
     if (MachineInstr *SrcInst = getDefiningInst(MI->getOperand(4))) {
       switch (SrcInst->getOpcode()) {
         // Fold the immediate value into the store, if possible.
-      case X86::MOVir8:  return Propagate(MI, 4, SrcInst, 1, X86::MOVim8);
-      case X86::MOVir16: return Propagate(MI, 4, SrcInst, 1, X86::MOVim16);
-      case X86::MOVir32: return Propagate(MI, 4, SrcInst, 1, X86::MOVim32);
+      case X86::MOVri8:  return Propagate(MI, 4, SrcInst, 1, X86::MOVmi8);
+      case X86::MOVri16: return Propagate(MI, 4, SrcInst, 1, X86::MOVmi16);
+      case X86::MOVri32: return Propagate(MI, 4, SrcInst, 1, X86::MOVmi32);
       default: break;
       }
     }


Index: llvm/lib/Target/X86/Printer.cpp
diff -u llvm/lib/Target/X86/Printer.cpp:1.83 llvm/lib/Target/X86/Printer.cpp:1.84
--- llvm/lib/Target/X86/Printer.cpp:1.83	Mon Feb 16 22:26:43 2004
+++ llvm/lib/Target/X86/Printer.cpp	Tue Feb 17 00:16:44 2004
@@ -642,13 +642,19 @@
     // These instructions are the same as MRMDestReg, but instead of having a
     // register reference for the mod/rm field, it's a memory reference.
     //
-    assert(isMem(MI, 0) && MI->getNumOperands() == 4+1 &&
-           MI->getOperand(4).isRegister() && "Bad format for MRMDestMem!");
+    assert(isMem(MI, 0) && 
+           (MI->getNumOperands() == 4+1 ||
+            (MI->getNumOperands() == 4+2 && MI->getOperand(5).isImmediate()))
+           && "Bad format for MRMDestMem!");
 
     O << TII.getName(MI->getOpcode()) << " " << sizePtr(Desc) << " ";
     printMemReference(MI, 0);
     O << ", ";
     printOp(MI->getOperand(4));
+    if (MI->getNumOperands() == 4+2) {
+      O << ", ";
+      printOp(MI->getOperand(5));
+    }
     O << "\n";
     return;
   }


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.27 llvm/lib/Target/X86/X86InstrInfo.td:1.28
--- llvm/lib/Target/X86/X86InstrInfo.td:1.27	Mon Feb 16 23:25:50 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 00:16:44 2004
@@ -195,12 +195,12 @@
 def MOVrr8  : X86Inst<"mov", 0x88, MRMDestReg, Arg8>,          Pattern<(set R8 , R8 )>;
 def MOVrr16 : X86Inst<"mov", 0x89, MRMDestReg, Arg16>, OpSize, Pattern<(set R16, R16)>;
 def MOVrr32 : X86Inst<"mov", 0x89, MRMDestReg, Arg32>,         Pattern<(set R32, R32)>;
-def MOVir8  : X86Inst<"mov", 0xB0, AddRegFrm , Arg8>,          Pattern<(set R8 , imm )>;
-def MOVir16 : X86Inst<"mov", 0xB8, AddRegFrm , Arg16>, OpSize, Pattern<(set R16, imm)>;
-def MOVir32 : X86Inst<"mov", 0xB8, AddRegFrm , Arg32>,         Pattern<(set R32, imm)>;
-def MOVim8  : X86Inst<"mov", 0xC6, MRMS0m    , Arg8>;             // [mem] = imm8
-def MOVim16 : X86Inst<"mov", 0xC7, MRMS0m    , Arg16>, OpSize;    // [mem] = imm16
-def MOVim32 : X86Inst<"mov", 0xC7, MRMS0m    , Arg32>;            // [mem] = imm32
+def MOVri8  : X86Inst<"mov", 0xB0, AddRegFrm , Arg8>,          Pattern<(set R8 , imm )>;
+def MOVri16 : X86Inst<"mov", 0xB8, AddRegFrm , Arg16>, OpSize, Pattern<(set R16, imm)>;
+def MOVri32 : X86Inst<"mov", 0xB8, AddRegFrm , Arg32>,         Pattern<(set R32, imm)>;
+def MOVmi8  : X86Inst<"mov", 0xC6, MRMS0m    , Arg8>;             // [mem] = imm8
+def MOVmi16 : X86Inst<"mov", 0xC7, MRMS0m    , Arg16>, OpSize;    // [mem] = imm16
+def MOVmi32 : X86Inst<"mov", 0xC7, MRMS0m    , Arg32>;            // [mem] = imm32
 
 def MOVmr8  : X86Inst<"mov", 0x8A, MRMSrcMem , Arg8>;             // R8  = [mem]
 def MOVmr16 : X86Inst<"mov", 0x8B, MRMSrcMem , Arg16>, OpSize,    // R16 = [mem]




From lattner at cs.uiuc.edu  Tue Feb 17 00:21:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:21:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170620.AAA17439@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.52 -> 1.53

---
Log message:

GRRR.  Move instructions have swapped the order of the r/m operands.


---
Diffs of the changes:  (+6 -6)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.52 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.53
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.52	Mon Feb 16 23:54:56 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 00:20:20 2004
@@ -112,9 +112,9 @@
   MachineInstr* NI = 0;
   if (i == 0) {
     switch(MI->getOpcode()) {
-    case X86::MOVrr8:  NI = MakeMRInst(X86::MOVmr8 , FrameIndex, MI); break;
-    case X86::MOVrr16: NI = MakeMRInst(X86::MOVmr16, FrameIndex, MI); break;
-    case X86::MOVrr32: NI = MakeMRInst(X86::MOVmr32, FrameIndex, MI); break;
+    case X86::MOVrr8:  NI = MakeMRInst(X86::MOVrm8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeMRInst(X86::MOVrm16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeMRInst(X86::MOVrm32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
@@ -131,9 +131,9 @@
     }
   } else if (i == 1) {
     switch(MI->getOpcode()) {
-    case X86::MOVrr8:  NI = MakeRMInst(X86::MOVrm8 , FrameIndex, MI); break;
-    case X86::MOVrr16: NI = MakeRMInst(X86::MOVrm16, FrameIndex, MI); break;
-    case X86::MOVrr32: NI = MakeRMInst(X86::MOVrm32, FrameIndex, MI); break;
+    case X86::MOVrr8:  NI = MakeRMInst(X86::MOVmr8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeRMInst(X86::MOVmr16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeRMInst(X86::MOVmr32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeRMInst(X86::ADDrm8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeRMInst(X86::ADDrm16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeRMInst(X86::ADDrm32, FrameIndex, MI); break;




From lattner at cs.uiuc.edu  Tue Feb 17 00:25:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:25:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/InstSelectSimple.cpp PeepholeOptimizer.cpp X86InstrInfo.td
Message-ID: <200402170624.AAA18770@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

InstSelectSimple.cpp updated: 1.162 -> 1.163
PeepholeOptimizer.cpp updated: 1.20 -> 1.21
X86InstrInfo.td updated: 1.28 -> 1.29

---
Log message:

Fix the last crimes against nature that used the 'ir' ordering to use the
'ri' ordering instead... no it's not possible to store a register into an
immediate!


---
Diffs of the changes:  (+29 -29)

Index: llvm/lib/Target/X86/InstSelectSimple.cpp
diff -u llvm/lib/Target/X86/InstSelectSimple.cpp:1.162 llvm/lib/Target/X86/InstSelectSimple.cpp:1.163
--- llvm/lib/Target/X86/InstSelectSimple.cpp:1.162	Tue Feb 17 00:16:44 2004
+++ llvm/lib/Target/X86/InstSelectSimple.cpp	Tue Feb 17 00:24:02 2004
@@ -1233,7 +1233,7 @@
         CountReg = getReg(ConstantUInt::get(Type::UIntTy, I->getRawValue()/2));
       } else {
         CountReg = makeAnotherReg(Type::IntTy);
-        BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(1);
+        BuildMI(BB, X86::SHRri32, 2, CountReg).addReg(ByteReg).addZImm(1);
       }
       Opcode = X86::REP_MOVSW;
       break;
@@ -1242,7 +1242,7 @@
         CountReg = getReg(ConstantUInt::get(Type::UIntTy, I->getRawValue()/4));
       } else {
         CountReg = makeAnotherReg(Type::IntTy);
-        BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(2);
+        BuildMI(BB, X86::SHRri32, 2, CountReg).addReg(ByteReg).addZImm(2);
       }
       Opcode = X86::REP_MOVSD;
       break;
@@ -1285,7 +1285,7 @@
           CountReg =getReg(ConstantUInt::get(Type::UIntTy, I->getRawValue()/2));
         } else {
           CountReg = makeAnotherReg(Type::IntTy);
-          BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(1);
+          BuildMI(BB, X86::SHRri32, 2, CountReg).addReg(ByteReg).addZImm(1);
         }
         BuildMI(BB, X86::MOVri16, 1, X86::AX).addZImm((Val << 8) | Val);
         Opcode = X86::REP_STOSW;
@@ -1295,7 +1295,7 @@
           CountReg =getReg(ConstantUInt::get(Type::UIntTy, I->getRawValue()/4));
         } else {
           CountReg = makeAnotherReg(Type::IntTy);
-          BuildMI(BB, X86::SHRir32, 2, CountReg).addReg(ByteReg).addZImm(2);
+          BuildMI(BB, X86::SHRri32, 2, CountReg).addReg(ByteReg).addZImm(2);
         }
         Val = (Val << 8) | Val;
         BuildMI(BB, X86::MOVri32, 1, X86::EAX).addZImm((Val << 16) | Val);
@@ -1512,13 +1512,13 @@
     switch (Class) {
     default: assert(0 && "Unknown class for this function!");
     case cByte:
-      BMI(MBB, IP, X86::SHLir32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
+      BMI(MBB, IP, X86::SHLri32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
       return;
     case cShort:
-      BMI(MBB, IP, X86::SHLir32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
+      BMI(MBB, IP, X86::SHLri32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
       return;
     case cInt:
-      BMI(MBB, IP, X86::SHLir32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
+      BMI(MBB, IP, X86::SHLri32, 2, DestReg).addReg(op0Reg).addZImm(Shift-1);
       return;
     }
   }
@@ -1646,7 +1646,7 @@
 
   static const unsigned Regs[]     ={ X86::AL    , X86::AX     , X86::EAX     };
   static const unsigned MovOpcode[]={ X86::MOVrr8, X86::MOVrr16, X86::MOVrr32 };
-  static const unsigned SarOpcode[]={ X86::SARir8, X86::SARir16, X86::SARir32 };
+  static const unsigned SarOpcode[]={ X86::SARri8, X86::SARri16, X86::SARri32 };
   static const unsigned ClrOpcode[]={ X86::MOVri8, X86::MOVri16, X86::MOVri32 };
   static const unsigned ExtRegs[]  ={ X86::AH    , X86::DX     , X86::EDX     };
 
@@ -1706,10 +1706,10 @@
   unsigned Class = getClass (ResultTy);
   
   static const unsigned ConstantOperand[][4] = {
-    { X86::SHRir8, X86::SHRir16, X86::SHRir32, X86::SHRDir32 },  // SHR
-    { X86::SARir8, X86::SARir16, X86::SARir32, X86::SHRDir32 },  // SAR
-    { X86::SHLir8, X86::SHLir16, X86::SHLir32, X86::SHLDir32 },  // SHL
-    { X86::SHLir8, X86::SHLir16, X86::SHLir32, X86::SHLDir32 },  // SAL = SHL
+    { X86::SHRri8, X86::SHRri16, X86::SHRri32, X86::SHRDri32 },  // SHR
+    { X86::SARri8, X86::SARri16, X86::SARri32, X86::SHRDri32 },  // SAR
+    { X86::SHLri8, X86::SHLri16, X86::SHLri32, X86::SHLDri32 },  // SHL
+    { X86::SHLri8, X86::SHLri16, X86::SHLri32, X86::SHLDri32 },  // SAL = SHL
   };
 
   static const unsigned NonConstantOperand[][4] = {
@@ -1740,12 +1740,12 @@
       } else {                 // Shifting more than 32 bits
         Amount -= 32;
         if (isLeftShift) {
-          BMI(MBB, IP, X86::SHLir32, 2,
+          BMI(MBB, IP, X86::SHLri32, 2,
               DestReg + 1).addReg(SrcReg).addZImm(Amount);
           BMI(MBB, IP, X86::MOVri32, 1,
               DestReg).addZImm(0);
         } else {
-          unsigned Opcode = isSigned ? X86::SARir32 : X86::SHRir32;
+          unsigned Opcode = isSigned ? X86::SARri32 : X86::SHRri32;
           BMI(MBB, IP, Opcode, 2, DestReg).addReg(SrcReg+1).addZImm(Amount);
           BMI(MBB, IP, X86::MOVri32, 1, DestReg+1).addZImm(0);
         }
@@ -1757,7 +1757,7 @@
         // If this is a SHR of a Long, then we need to do funny sign extension
         // stuff.  TmpReg gets the value to use as the high-part if we are
         // shifting more than 32 bits.
-        BMI(MBB, IP, X86::SARir32, 2, TmpReg).addReg(SrcReg).addZImm(31);
+        BMI(MBB, IP, X86::SARri32, 2, TmpReg).addReg(SrcReg).addZImm(31);
       } else {
         // Other shifts use a fixed zero value if the shift is more than 32
         // bits.
@@ -1991,7 +1991,7 @@
       if (isUnsigned)     // Zero out top bits...
         BMI(BB, IP, X86::MOVri32, 1, DestReg+1).addZImm(0);
       else                // Sign extend bottom half...
-        BMI(BB, IP, X86::SARir32, 2, DestReg+1).addReg(DestReg).addZImm(31);
+        BMI(BB, IP, X86::SARri32, 2, DestReg+1).addReg(DestReg).addZImm(31);
     }
     return;
   }


Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.20 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.21
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.20	Tue Feb 17 00:16:44 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 00:24:02 2004
@@ -395,7 +395,7 @@
       }
       break;
 
-    case X86::SHLir32:
+    case X86::SHLri32:
       // If this shift could be folded into the index portion of the address if
       // it were the index register, move it to the index register operand now,
       // so it will be folded in below.
@@ -413,7 +413,7 @@
   // Attempt to fold instructions used by the index into the instruction
   if (MachineInstr *DefInst = getDefiningInst(IndexRegOp)) {
     switch (DefInst->getOpcode()) {
-    case X86::SHLir32: {
+    case X86::SHLri32: {
       // Figure out what the resulting scale would be if we folded this shift.
       unsigned ResScale = Scale * (1 << DefInst->getOperand(2).getImmedValue());
       if (isValidScaleAmount(ResScale)) {


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.28 llvm/lib/Target/X86/X86InstrInfo.td:1.29
--- llvm/lib/Target/X86/X86InstrInfo.td:1.28	Tue Feb 17 00:16:44 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 00:24:02 2004
@@ -373,26 +373,26 @@
 def SHLrr8   : I2A8 <"shl", 0xD2, MRMS4r    >        , UsesCL; // R8  <<= cl
 def SHLrr16  : I2A8 <"shl", 0xD3, MRMS4r    >, OpSize, UsesCL; // R16 <<= cl
 def SHLrr32  : I2A8 <"shl", 0xD3, MRMS4r    >        , UsesCL; // R32 <<= cl
-def SHLir8   : I2A8 <"shl", 0xC0, MRMS4r    >;                 // R8  <<= imm8
-def SHLir16  : I2A8 <"shl", 0xC1, MRMS4r    >, OpSize;         // R16 <<= imm16
-def SHLir32  : I2A8 <"shl", 0xC1, MRMS4r    >;                 // R32 <<= imm32
+def SHLri8   : I2A8 <"shl", 0xC0, MRMS4r    >;                 // R8  <<= imm8
+def SHLri16  : I2A8 <"shl", 0xC1, MRMS4r    >, OpSize;         // R16 <<= imm16
+def SHLri32  : I2A8 <"shl", 0xC1, MRMS4r    >;                 // R32 <<= imm32
 def SHRrr8   : I2A8 <"shr", 0xD2, MRMS5r    >        , UsesCL; // R8  >>= cl
 def SHRrr16  : I2A8 <"shr", 0xD3, MRMS5r    >, OpSize, UsesCL; // R16 >>= cl
 def SHRrr32  : I2A8 <"shr", 0xD3, MRMS5r    >        , UsesCL; // R32 >>= cl
-def SHRir8   : I2A8 <"shr", 0xC0, MRMS5r    >;                 // R8  >>= imm8
-def SHRir16  : I2A8 <"shr", 0xC1, MRMS5r    >, OpSize;         // R16 >>= imm16
-def SHRir32  : I2A8 <"shr", 0xC1, MRMS5r    >;                 // R32 >>= imm32
+def SHRri8   : I2A8 <"shr", 0xC0, MRMS5r    >;                 // R8  >>= imm8
+def SHRri16  : I2A8 <"shr", 0xC1, MRMS5r    >, OpSize;         // R16 >>= imm16
+def SHRri32  : I2A8 <"shr", 0xC1, MRMS5r    >;                 // R32 >>= imm32
 def SARrr8   : I2A8 <"sar", 0xD2, MRMS7r    >        , UsesCL; // R8  >>>= cl
 def SARrr16  : I2A8 <"sar", 0xD3, MRMS7r    >, OpSize, UsesCL; // R16 >>>= cl
 def SARrr32  : I2A8 <"sar", 0xD3, MRMS7r    >        , UsesCL; // R32 >>>= cl
-def SARir8   : I2A8 <"sar", 0xC0, MRMS7r    >;                 // R8  >>>= imm8
-def SARir16  : I2A8 <"sar", 0xC1, MRMS7r    >, OpSize;         // R16 >>>= imm16
-def SARir32  : I2A8 <"sar", 0xC1, MRMS7r    >;                 // R32 >>>= imm32
+def SARri8   : I2A8 <"sar", 0xC0, MRMS7r    >;                 // R8  >>>= imm8
+def SARri16  : I2A8 <"sar", 0xC1, MRMS7r    >, OpSize;         // R16 >>>= imm16
+def SARri32  : I2A8 <"sar", 0xC1, MRMS7r    >;                 // R32 >>>= imm32
 
 def SHLDrr32 : I2A8 <"shld", 0xA5, MRMDestReg>, TB, UsesCL;   // R32 <<= R32,R32 cl
-def SHLDir32 : I2A8 <"shld", 0xA4, MRMDestReg>, TB;           // R32 <<= R32,R32 imm8
+def SHLDri32 : I2A8 <"shld", 0xA4, MRMDestReg>, TB;           // R32 <<= R32,R32 imm8
 def SHRDrr32 : I2A8 <"shrd", 0xAD, MRMDestReg>, TB, UsesCL;   // R32 >>= R32,R32 cl
-def SHRDir32 : I2A8 <"shrd", 0xAC, MRMDestReg>, TB;           // R32 >>= R32,R32 imm8
+def SHRDri32 : I2A8 <"shrd", 0xAC, MRMDestReg>, TB;           // R32 >>= R32,R32 imm8
 
 // Condition code ops, incl. set if equal/not equal/...
 def SAHF     : X86Inst<"sahf" , 0x9E, RawFrm, Arg8>, Imp<[AH],[]>;  // flags = AH




From lattner at cs.uiuc.edu  Tue Feb 17 00:29:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:29:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/InstSelectSimple.cpp PeepholeOptimizer.cpp X86InstrInfo.td X86RegisterInfo.cpp
Message-ID: <200402170628.AAA22183@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

InstSelectSimple.cpp updated: 1.163 -> 1.164
PeepholeOptimizer.cpp updated: 1.21 -> 1.22
X86InstrInfo.td updated: 1.29 -> 1.30
X86RegisterInfo.cpp updated: 1.53 -> 1.54

---
Log message:

Fix the mneumonics for the mov instructions to have the source and destination
order in the correct sense!! Arg!


---
Diffs of the changes:  (+50 -50)

Index: llvm/lib/Target/X86/InstSelectSimple.cpp
diff -u llvm/lib/Target/X86/InstSelectSimple.cpp:1.163 llvm/lib/Target/X86/InstSelectSimple.cpp:1.164
--- llvm/lib/Target/X86/InstSelectSimple.cpp:1.163	Tue Feb 17 00:24:02 2004
+++ llvm/lib/Target/X86/InstSelectSimple.cpp	Tue Feb 17 00:28:19 2004
@@ -490,20 +490,20 @@
     switch (getClassB(I->getType())) {
     case cByte:
       FI = MFI->CreateFixedObject(1, ArgOffset);
-      addFrameReference(BuildMI(BB, X86::MOVmr8, 4, Reg), FI);
+      addFrameReference(BuildMI(BB, X86::MOVrm8, 4, Reg), FI);
       break;
     case cShort:
       FI = MFI->CreateFixedObject(2, ArgOffset);
-      addFrameReference(BuildMI(BB, X86::MOVmr16, 4, Reg), FI);
+      addFrameReference(BuildMI(BB, X86::MOVrm16, 4, Reg), FI);
       break;
     case cInt:
       FI = MFI->CreateFixedObject(4, ArgOffset);
-      addFrameReference(BuildMI(BB, X86::MOVmr32, 4, Reg), FI);
+      addFrameReference(BuildMI(BB, X86::MOVrm32, 4, Reg), FI);
       break;
     case cLong:
       FI = MFI->CreateFixedObject(8, ArgOffset);
-      addFrameReference(BuildMI(BB, X86::MOVmr32, 4, Reg), FI);
-      addFrameReference(BuildMI(BB, X86::MOVmr32, 4, Reg+1), FI, 4);
+      addFrameReference(BuildMI(BB, X86::MOVrm32, 4, Reg), FI);
+      addFrameReference(BuildMI(BB, X86::MOVrm32, 4, Reg+1), FI, 4);
       ArgOffset += 4;   // longs require 4 additional bytes
       break;
     case cFP:
@@ -1052,18 +1052,18 @@
         // Promote arg to 32 bits wide into a temporary register...
         unsigned R = makeAnotherReg(Type::UIntTy);
         promote32(R, Args[i]);
-        addRegOffset(BuildMI(BB, X86::MOVrm32, 5),
+        addRegOffset(BuildMI(BB, X86::MOVmr32, 5),
                      X86::ESP, ArgOffset).addReg(R);
         break;
       }
       case cInt:
-        addRegOffset(BuildMI(BB, X86::MOVrm32, 5),
+        addRegOffset(BuildMI(BB, X86::MOVmr32, 5),
                      X86::ESP, ArgOffset).addReg(ArgReg);
         break;
       case cLong:
-        addRegOffset(BuildMI(BB, X86::MOVrm32, 5),
+        addRegOffset(BuildMI(BB, X86::MOVmr32, 5),
                      X86::ESP, ArgOffset).addReg(ArgReg);
-        addRegOffset(BuildMI(BB, X86::MOVrm32, 5),
+        addRegOffset(BuildMI(BB, X86::MOVmr32, 5),
                      X86::ESP, ArgOffset+4).addReg(ArgReg+1);
         ArgOffset += 4;        // 8 byte entry, not 4.
         break;
@@ -1203,7 +1203,7 @@
     if (cast<Constant>(CI.getOperand(1))->isNullValue()) {
       if (ID == Intrinsic::returnaddress) {
         // Just load the return address
-        addFrameReference(BuildMI(BB, X86::MOVmr32, 4, TmpReg1),
+        addFrameReference(BuildMI(BB, X86::MOVrm32, 4, TmpReg1),
                           ReturnAddressIndex);
       } else {
         addFrameReference(BuildMI(BB, X86::LEAr32, 4, TmpReg1),
@@ -1835,13 +1835,13 @@
   unsigned Class = getClassB(I.getType());
 
   if (Class == cLong) {
-    addDirectMem(BuildMI(BB, X86::MOVmr32, 4, DestReg), SrcAddrReg);
-    addRegOffset(BuildMI(BB, X86::MOVmr32, 4, DestReg+1), SrcAddrReg, 4);
+    addDirectMem(BuildMI(BB, X86::MOVrm32, 4, DestReg), SrcAddrReg);
+    addRegOffset(BuildMI(BB, X86::MOVrm32, 4, DestReg+1), SrcAddrReg, 4);
     return;
   }
 
   static const unsigned Opcodes[] = {
-    X86::MOVmr8, X86::MOVmr16, X86::MOVmr32, X86::FLDr32
+    X86::MOVrm8, X86::MOVrm16, X86::MOVrm32, X86::FLDr32
   };
   unsigned Opcode = Opcodes[Class];
   if (I.getType() == Type::DoubleTy) Opcode = X86::FLDr64;
@@ -1859,13 +1859,13 @@
   unsigned Class = getClassB(ValTy);
 
   if (Class == cLong) {
-    addDirectMem(BuildMI(BB, X86::MOVrm32, 1+4), AddressReg).addReg(ValReg);
-    addRegOffset(BuildMI(BB, X86::MOVrm32, 1+4), AddressReg,4).addReg(ValReg+1);
+    addDirectMem(BuildMI(BB, X86::MOVmr32, 1+4), AddressReg).addReg(ValReg);
+    addRegOffset(BuildMI(BB, X86::MOVmr32, 1+4), AddressReg,4).addReg(ValReg+1);
     return;
   }
 
   static const unsigned Opcodes[] = {
-    X86::MOVrm8, X86::MOVrm16, X86::MOVrm32, X86::FSTr32
+    X86::MOVmr8, X86::MOVmr16, X86::MOVmr32, X86::FSTr32
   };
   unsigned Opcode = Opcodes[Class];
   if (ValTy == Type::DoubleTy) Opcode = X86::FSTr64;
@@ -2066,11 +2066,11 @@
       F->getFrameInfo()->CreateStackObject(SrcTy, TM.getTargetData());
 
     if (SrcClass == cLong) {
-      addFrameReference(BMI(BB, IP, X86::MOVrm32, 5), FrameIdx).addReg(SrcReg);
-      addFrameReference(BMI(BB, IP, X86::MOVrm32, 5),
+      addFrameReference(BMI(BB, IP, X86::MOVmr32, 5), FrameIdx).addReg(SrcReg);
+      addFrameReference(BMI(BB, IP, X86::MOVmr32, 5),
                         FrameIdx, 4).addReg(SrcReg+1);
     } else {
-      static const unsigned Op1[] = { X86::MOVrm8, X86::MOVrm16, X86::MOVrm32 };
+      static const unsigned Op1[] = { X86::MOVmr8, X86::MOVmr16, X86::MOVmr32 };
       addFrameReference(BMI(BB, IP, Op1[SrcClass], 5), FrameIdx).addReg(SrcReg);
     }
 
@@ -2090,7 +2090,7 @@
 
     // Load the old value of the high byte of the control word...
     unsigned HighPartOfCW = makeAnotherReg(Type::UByteTy);
-    addFrameReference(BMI(BB, IP, X86::MOVmr8, 4, HighPartOfCW), CWFrameIdx, 1);
+    addFrameReference(BMI(BB, IP, X86::MOVrm8, 4, HighPartOfCW), CWFrameIdx, 1);
 
     // Set the high part to be round to zero...
     addFrameReference(BMI(BB, IP, X86::MOVmi8, 5), CWFrameIdx, 1).addZImm(12);
@@ -2099,7 +2099,7 @@
     addFrameReference(BMI(BB, IP, X86::FLDCWm16, 4), CWFrameIdx);
     
     // Restore the memory image of control word to original value
-    addFrameReference(BMI(BB, IP, X86::MOVrm8, 5),
+    addFrameReference(BMI(BB, IP, X86::MOVmr8, 5),
                       CWFrameIdx, 1).addReg(HighPartOfCW);
 
     // We don't have the facilities for directly storing byte sized data to
@@ -2128,10 +2128,10 @@
     addFrameReference(BMI(BB, IP, Op1[StoreClass], 5), FrameIdx).addReg(SrcReg);
 
     if (DestClass == cLong) {
-      addFrameReference(BMI(BB, IP, X86::MOVmr32, 4, DestReg), FrameIdx);
-      addFrameReference(BMI(BB, IP, X86::MOVmr32, 4, DestReg+1), FrameIdx, 4);
+      addFrameReference(BMI(BB, IP, X86::MOVrm32, 4, DestReg), FrameIdx);
+      addFrameReference(BMI(BB, IP, X86::MOVrm32, 4, DestReg+1), FrameIdx, 4);
     } else {
-      static const unsigned Op2[] = { X86::MOVmr8, X86::MOVmr16, X86::MOVmr32 };
+      static const unsigned Op2[] = { X86::MOVrm8, X86::MOVrm16, X86::MOVrm32 };
       addFrameReference(BMI(BB, IP, Op2[DestClass], 4, DestReg), FrameIdx);
     }
 
@@ -2185,12 +2185,12 @@
   case Type::PointerTyID:
   case Type::UIntTyID:
   case Type::IntTyID:
-    addDirectMem(BuildMI(BB, X86::MOVmr32, 4, DestReg), VAList);
+    addDirectMem(BuildMI(BB, X86::MOVrm32, 4, DestReg), VAList);
     break;
   case Type::ULongTyID:
   case Type::LongTyID:
-    addDirectMem(BuildMI(BB, X86::MOVmr32, 4, DestReg), VAList);
-    addRegOffset(BuildMI(BB, X86::MOVmr32, 4, DestReg+1), VAList, 4);
+    addDirectMem(BuildMI(BB, X86::MOVrm32, 4, DestReg), VAList);
+    addRegOffset(BuildMI(BB, X86::MOVrm32, 4, DestReg+1), VAList, 4);
     break;
   case Type::DoubleTyID:
     addDirectMem(BuildMI(BB, X86::FLDr64, 4, DestReg), VAList);


Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.21 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.22
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.21	Tue Feb 17 00:24:02 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 00:28:19 2004
@@ -460,7 +460,7 @@
   switch (MI->getOpcode()) {
 
     // Register to memory stores.  Format: <base,scale,indexreg,immdisp>, srcreg
-  case X86::MOVrm32: case X86::MOVrm16: case X86::MOVrm8:
+  case X86::MOVmr32: case X86::MOVmr16: case X86::MOVmr8:
   case X86::MOVmi32: case X86::MOVmi16: case X86::MOVmi8:
     // Check to see if we can fold the source instruction into this one...
     if (MachineInstr *SrcInst = getDefiningInst(MI->getOperand(4))) {
@@ -478,9 +478,9 @@
       return true;
     break;
 
-  case X86::MOVmr32:
-  case X86::MOVmr16:
-  case X86::MOVmr8:
+  case X86::MOVrm32:
+  case X86::MOVrm16:
+  case X86::MOVrm8:
     // If we can optimize the addressing expression, do so now.
     if (OptimizeAddress(MI, 1))
       return true;


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.29 llvm/lib/Target/X86/X86InstrInfo.td:1.30
--- llvm/lib/Target/X86/X86InstrInfo.td:1.29	Tue Feb 17 00:24:02 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 00:28:19 2004
@@ -202,15 +202,15 @@
 def MOVmi16 : X86Inst<"mov", 0xC7, MRMS0m    , Arg16>, OpSize;    // [mem] = imm16
 def MOVmi32 : X86Inst<"mov", 0xC7, MRMS0m    , Arg32>;            // [mem] = imm32
 
-def MOVmr8  : X86Inst<"mov", 0x8A, MRMSrcMem , Arg8>;             // R8  = [mem]
-def MOVmr16 : X86Inst<"mov", 0x8B, MRMSrcMem , Arg16>, OpSize,    // R16 = [mem]
+def MOVrm8  : X86Inst<"mov", 0x8A, MRMSrcMem , Arg8>;             // R8  = [mem]
+def MOVrm16 : X86Inst<"mov", 0x8B, MRMSrcMem , Arg16>, OpSize,    // R16 = [mem]
               Pattern<(set R16, (load (plus R32, (plus (times imm, R32), imm))))>;
-def MOVmr32 : X86Inst<"mov", 0x8B, MRMSrcMem , Arg32>,            // R32 = [mem]
+def MOVrm32 : X86Inst<"mov", 0x8B, MRMSrcMem , Arg32>,            // R32 = [mem]
               Pattern<(set R32, (load (plus R32, (plus (times imm, R32), imm))))>;
 
-def MOVrm8  : X86Inst<"mov", 0x88, MRMDestMem, Arg8>;             // [mem] = R8
-def MOVrm16 : X86Inst<"mov", 0x89, MRMDestMem, Arg16>, OpSize;    // [mem] = R16
-def MOVrm32 : X86Inst<"mov", 0x89, MRMDestMem, Arg32>;            // [mem] = R32
+def MOVmr8  : X86Inst<"mov", 0x88, MRMDestMem, Arg8>;             // [mem] = R8
+def MOVmr16 : X86Inst<"mov", 0x89, MRMDestMem, Arg16>, OpSize;    // [mem] = R16
+def MOVmr32 : X86Inst<"mov", 0x89, MRMDestMem, Arg32>;            // [mem] = R32
 
 //===----------------------------------------------------------------------===//
 //  Fixed-Register Multiplication and Division Instructions...
@@ -555,17 +555,17 @@
 // FIXME: This should eventually just be implemented by defining a frameidx as a
 // value address for a load.
 def LOAD_FI16 : Expander<(set R16:$dest, (load frameidx:$fi)),
-                         [(MOVmr16 R16:$dest, frameidx:$fi, 1, 0/*NoReg*/, 0)]>;
+                         [(MOVrm16 R16:$dest, frameidx:$fi, 1, 0/*NoReg*/, 0)]>;
 
 def LOAD_FI32 : Expander<(set R32:$dest, (load frameidx:$fi)),
-                         [(MOVmr32 R32:$dest, frameidx:$fi, 1, 0/*NoReg*/, 0)]>;
+                         [(MOVrm32 R32:$dest, frameidx:$fi, 1, 0/*NoReg*/, 0)]>;
 
 
 def LOAD_R16 : Expander<(set R16:$dest, (load R32:$src)),
-                         [(MOVmr16 R16:$dest, R32:$src, 1, 0/*NoReg*/, 0)]>;
+                         [(MOVrm16 R16:$dest, R32:$src, 1, 0/*NoReg*/, 0)]>;
 
 def LOAD_R32 : Expander<(set R32:$dest, (load R32:$src)),
-                         [(MOVmr32 R32:$dest, R32:$src, 1, 0/*NoReg*/, 0)]>;
+                         [(MOVrm32 R32:$dest, R32:$src, 1, 0/*NoReg*/, 0)]>;
 
 def BR_EQ : Expander<(brcond (seteq R32:$a1, R32:$a2),
                              basicblock:$d1, basicblock:$d2),


Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.53 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.54
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.53	Tue Feb 17 00:20:20 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 00:28:19 2004
@@ -51,7 +51,7 @@
                                          unsigned SrcReg, int FrameIdx,
                                          const TargetRegisterClass *RC) const {
   static const unsigned Opcode[] =
-    { X86::MOVrm8, X86::MOVrm16, X86::MOVrm32, X86::FSTPr80 };
+    { X86::MOVmr8, X86::MOVmr16, X86::MOVmr32, X86::FSTPr80 };
   MachineInstr *I = addFrameReference(BuildMI(Opcode[getIdx(RC)], 5),
 				       FrameIdx).addReg(SrcReg);
   MBB.insert(MI, I);
@@ -63,7 +63,7 @@
                                           unsigned DestReg, int FrameIdx,
                                           const TargetRegisterClass *RC) const{
   static const unsigned Opcode[] =
-    { X86::MOVmr8, X86::MOVmr16, X86::MOVmr32, X86::FLDr80 };
+    { X86::MOVrm8, X86::MOVrm16, X86::MOVrm32, X86::FLDr80 };
   unsigned OC = Opcode[getIdx(RC)];
   MBB.insert(MI, addFrameReference(BuildMI(OC, 4, DestReg), FrameIdx));
   return 1;
@@ -112,9 +112,9 @@
   MachineInstr* NI = 0;
   if (i == 0) {
     switch(MI->getOpcode()) {
-    case X86::MOVrr8:  NI = MakeMRInst(X86::MOVrm8 , FrameIndex, MI); break;
-    case X86::MOVrr16: NI = MakeMRInst(X86::MOVrm16, FrameIndex, MI); break;
-    case X86::MOVrr32: NI = MakeMRInst(X86::MOVrm32, FrameIndex, MI); break;
+    case X86::MOVrr8:  NI = MakeMRInst(X86::MOVmr8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeMRInst(X86::MOVmr16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeMRInst(X86::MOVmr32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
@@ -131,9 +131,9 @@
     }
   } else if (i == 1) {
     switch(MI->getOpcode()) {
-    case X86::MOVrr8:  NI = MakeRMInst(X86::MOVmr8 , FrameIndex, MI); break;
-    case X86::MOVrr16: NI = MakeRMInst(X86::MOVmr16, FrameIndex, MI); break;
-    case X86::MOVrr32: NI = MakeRMInst(X86::MOVmr32, FrameIndex, MI); break;
+    case X86::MOVrr8:  NI = MakeRMInst(X86::MOVrm8 , FrameIndex, MI); break;
+    case X86::MOVrr16: NI = MakeRMInst(X86::MOVrm16, FrameIndex, MI); break;
+    case X86::MOVrr32: NI = MakeRMInst(X86::MOVrm32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeRMInst(X86::ADDrm8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeRMInst(X86::ADDrm16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeRMInst(X86::ADDrm32, FrameIndex, MI); break;
@@ -254,7 +254,7 @@
     }
 
     // Save EBP into the appropriate stack slot...
-    MI = addRegOffset(BuildMI(X86::MOVrm32, 5),    // mov [ESP-<offset>], EBP
+    MI = addRegOffset(BuildMI(X86::MOVmr32, 5),    // mov [ESP-<offset>], EBP
 		      X86::ESP, EBPOffset+NumBytes).addReg(X86::EBP);
     MBB.insert(MBBI, MI);
 




From lattner at cs.uiuc.edu  Tue Feb 17 00:31:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:31:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170630.AAA22683@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.54 -> 1.55

---
Log message:

Add an option to disable spill fusing in the X86 backend


---
Diffs of the changes:  (+5 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.54 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.55
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.54	Tue Feb 17 00:28:19 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 00:30:34 2004
@@ -31,6 +31,9 @@
   cl::opt<bool>
   NoFPElim("disable-fp-elim",
 	   cl::desc("Disable frame pointer elimination optimization"));
+  cl::opt<bool>
+  NoFusing("disable-spill-fusing",
+           cl::desc("Disable fusing of spill code into instructions"));
 }
 
 X86RegisterInfo::X86RegisterInfo()
@@ -106,6 +109,8 @@
 
 bool X86RegisterInfo::foldMemoryOperand(MachineBasicBlock::iterator &MI,
                                         unsigned i, int FrameIndex) const {
+  if (NoFusing) return false;
+
   /// FIXME: This should obviously be autogenerated by tablegen when patterns
   /// are available!
   MachineBasicBlock& MBB = *MI->getParent();




From lattner at cs.uiuc.edu  Tue Feb 17 00:41:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:41:02 2004
Subject: [llvm-commits] CVS: llvm/include/llvm/Support/ToolRunner.h
Message-ID: <200402170640.AAA25004@zion.cs.uiuc.edu>


Changes in directory llvm/include/llvm/Support:

ToolRunner.h updated: 1.6 -> 1.7

---
Log message:

The CBE is no longer in llvm-dis


---
Diffs of the changes:  (+2 -2)

Index: llvm/include/llvm/Support/ToolRunner.h
diff -u llvm/include/llvm/Support/ToolRunner.h:1.6 llvm/include/llvm/Support/ToolRunner.h:1.7
--- llvm/include/llvm/Support/ToolRunner.h:1.6	Tue Nov 11 16:41:31 2003
+++ llvm/include/llvm/Support/ToolRunner.h	Tue Feb 17 00:39:48 2004
@@ -95,10 +95,10 @@
 // CBE Implementation of AbstractIntepreter interface
 //
 class CBE : public AbstractInterpreter {
-  std::string DISPath;          // The path to the `llvm-dis' executable
+  std::string LLCPath;          // The path to the `llc' executable
   GCC *gcc;
 public:
-  CBE(const std::string &disPath, GCC *Gcc) : DISPath(disPath), gcc(Gcc) { }
+  CBE(const std::string &llcPath, GCC *Gcc) : LLCPath(llcPath), gcc(Gcc) { }
   ~CBE() { delete gcc; }
 
   virtual int ExecuteProgram(const std::string &Bytecode,




From lattner at cs.uiuc.edu  Tue Feb 17 00:41:26 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:41:26 2004
Subject: [llvm-commits] CVS: llvm/lib/Support/ToolRunner.cpp
Message-ID: <200402170640.AAA25255@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Support:

ToolRunner.cpp updated: 1.14 -> 1.15

---
Log message:

The C backend is no longer in llvm-dis, it's in llc


---
Diffs of the changes:  (+11 -11)

Index: llvm/lib/Support/ToolRunner.cpp
diff -u llvm/lib/Support/ToolRunner.cpp:1.14 llvm/lib/Support/ToolRunner.cpp:1.15
--- llvm/lib/Support/ToolRunner.cpp:1.14	Mon Jan 26 14:59:33 2004
+++ llvm/lib/Support/ToolRunner.cpp	Tue Feb 17 00:40:06 2004
@@ -215,19 +215,19 @@
                  std::string &OutputCFile) {
   OutputCFile = getUniqueFilename(Bytecode+".cbe.c");
   const char *DisArgs[] = {
-    DISPath.c_str(),
+    LLCPath.c_str(),
     "-o", OutputCFile.c_str(),   // Output to the C file
-    "-c",                        // Output to C
+    "-march=c",                  // Output to C
     "-f",                        // Overwrite as necessary...
     Bytecode.c_str(),            // This is the input bytecode
     0
   };
 
   std::cout << "<cbe>" << std::flush;
-  if (RunProgramWithTimeout(DISPath, DisArgs, "/dev/null", "/dev/null",
+  if (RunProgramWithTimeout(LLCPath, DisArgs, "/dev/null", "/dev/null",
                             "/dev/null")) {                            
     // If dis failed on the bytecode, print error...
-    std::cerr << "Error: `llvm-dis -c' failed!\n";
+    std::cerr << "Error: `llc -march=c' failed!\n";
     return 1;
   }
 
@@ -241,7 +241,7 @@
                         const std::vector<std::string> &SharedLibs) {
   std::string OutputCFile;
   if (OutputC(Bytecode, OutputCFile)) {
-    std::cerr << "Could not generate C code with `llvm-dis', exiting.\n";
+    std::cerr << "Could not generate C code with `llc', exiting.\n";
     exit(1);
   }
 
@@ -252,24 +252,24 @@
   return Result;
 }
 
-/// createCBE - Try to find the 'llvm-dis' executable
+/// createCBE - Try to find the 'llc' executable
 ///
 CBE *AbstractInterpreter::createCBE(const std::string &ProgramPath,
                                     std::string &Message) {
-  std::string DISPath = FindExecutable("llvm-dis", ProgramPath);
-  if (DISPath.empty()) {
+  std::string LLCPath = FindExecutable("llc", ProgramPath);
+  if (LLCPath.empty()) {
     Message = 
-      "Cannot find `llvm-dis' in executable directory or PATH!\n";
+      "Cannot find `llc' in executable directory or PATH!\n";
     return 0;
   }
 
-  Message = "Found llvm-dis: " + DISPath + "\n";
+  Message = "Found llc: " + LLCPath + "\n";
   GCC *gcc = GCC::create(ProgramPath, Message);
   if (!gcc) {
     std::cerr << Message << "\n";
     exit(1);
   }
-  return new CBE(DISPath, gcc);
+  return new CBE(LLCPath, gcc);
 }
 
 //===---------------------------------------------------------------------===//




From lattner at cs.uiuc.edu  Tue Feb 17 00:42:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 00:42:02 2004
Subject: [llvm-commits] CVS: llvm/tools/bugpoint/CodeGeneratorBug.cpp
Message-ID: <200402170641.AAA25964@zion.cs.uiuc.edu>


Changes in directory llvm/tools/bugpoint:

CodeGeneratorBug.cpp updated: 1.34 -> 1.35

---
Log message:

The CBE is now in llc, not llvm-dis


---
Diffs of the changes:  (+1 -1)

Index: llvm/tools/bugpoint/CodeGeneratorBug.cpp
diff -u llvm/tools/bugpoint/CodeGeneratorBug.cpp:1.34 llvm/tools/bugpoint/CodeGeneratorBug.cpp:1.35
--- llvm/tools/bugpoint/CodeGeneratorBug.cpp:1.34	Tue Jan 13 21:38:36 2004
+++ llvm/tools/bugpoint/CodeGeneratorBug.cpp	Tue Feb 17 00:40:51 2004
@@ -262,7 +262,7 @@
     for (unsigned i=0, e = InputArgv.size(); i != e; ++i)
       std::cout << " " << InputArgv[i];
     std::cout << "\n";
-    std::cout << "The shared object was created with:\n  llvm-dis -c "
+    std::cout << "The shared object was created with:\n  llc -march=c "
               << SafeModuleBC << " -o temporary.c\n"
               << "  gcc -xc temporary.c -O2 -o " << SharedObject
 #if defined(sparc) || defined(__sparc__) || defined(__sparcv9)




From lattner at cs.uiuc.edu  Tue Feb 17 01:03:08 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 01:03:08 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/RegAllocLocal.cpp
Message-ID: <200402170702.BAA28995@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

RegAllocLocal.cpp updated: 1.48 -> 1.49

---
Log message:

Fix a bug in my previous refactoring change... arg!


---
Diffs of the changes:  (+3 -1)

Index: llvm/lib/CodeGen/RegAllocLocal.cpp
diff -u llvm/lib/CodeGen/RegAllocLocal.cpp:1.48 llvm/lib/CodeGen/RegAllocLocal.cpp:1.49
--- llvm/lib/CodeGen/RegAllocLocal.cpp:1.48	Mon Feb 16 22:08:37 2004
+++ llvm/lib/CodeGen/RegAllocLocal.cpp	Tue Feb 17 01:02:17 2004
@@ -492,7 +492,9 @@
   const TargetRegisterClass *RC = MF->getSSARegMap()->getRegClass(VirtReg);
   unsigned PhysReg = getFreeReg(RC);
 
-  if (PhysReg == 0) {  // No registers available...
+  if (PhysReg) {  // PhysReg available!
+    PhysReg = getReg(MBB, MI, VirtReg);
+  } else {  // No registers available...
     /// If we can fold this spill into this instruction, do so now.
     if (0) {
       // TODO




From lattner at cs.uiuc.edu  Tue Feb 17 01:37:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 01:37:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp
Message-ID: <200402170736.BAA04271@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.22 -> 1.23

---
Log message:

Disable this peephole for now.  We can't keep track of the fact that the immediate is 8 bits,
but the memory reference is full sized.


---
Diffs of the changes:  (+2 -0)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.22 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.23
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.22	Tue Feb 17 00:28:19 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 01:36:32 2004
@@ -93,6 +93,7 @@
     }
     return false;
 
+#if 0
   case X86::IMULrmi16: case X86::IMULrmi32:
     assert(MI->getNumOperands() == 6 && "These should all have 6 operands!");
     if (MI->getOperand(5).isImmediate()) {
@@ -117,6 +118,7 @@
       }
     }
     return false;
+#endif
 
   case X86::ADDri16:  case X86::ADDri32:
   case X86::ADDmi16:  case X86::ADDmi32:




From lattner at cs.uiuc.edu  Tue Feb 17 01:41:01 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 01:41:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/Printer.cpp X86CodeEmitter.cpp
Message-ID: <200402170740.BAA04662@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

Printer.cpp updated: 1.84 -> 1.85
X86CodeEmitter.cpp updated: 1.51 -> 1.52

---
Log message:

Expand the repertoire of the forms we can print and encode.


---
Diffs of the changes:  (+9 -9)

Index: llvm/lib/Target/X86/Printer.cpp
diff -u llvm/lib/Target/X86/Printer.cpp:1.84 llvm/lib/Target/X86/Printer.cpp:1.85
--- llvm/lib/Target/X86/Printer.cpp:1.84	Tue Feb 17 00:16:44 2004
+++ llvm/lib/Target/X86/Printer.cpp	Tue Feb 17 01:40:44 2004
@@ -699,17 +699,16 @@
     //
     assert(MI->getOperand(0).isRegister() &&
            (MI->getNumOperands() == 1+4 && isMem(MI, 1)) || 
-           (MI->getNumOperands() == 2+4 && MI->getOperand(1).isRegister() && 
-            isMem(MI, 2))
+(MI->getNumOperands() == 2+4 && MI->getOperand(5).isImmediate() && isMem(MI, 1))
            && "Bad format for MRMSrcMem!");
-    if (MI->getNumOperands() == 2+4 &&
-        MI->getOperand(0).getReg() != MI->getOperand(1).getReg())
-      O << "**";
-
     O << TII.getName(MI->getOpcode()) << " ";
     printOp(MI->getOperand(0));
     O << ", " << sizePtr(Desc) << " ";
-    printMemReference(MI, MI->getNumOperands()-4);
+    printMemReference(MI, 1);
+    if (MI->getNumOperands() == 2+4) {
+      O << ", ";
+      printOp(MI->getOperand(5));
+    }
     O << "\n";
     return;
   }


Index: llvm/lib/Target/X86/X86CodeEmitter.cpp
diff -u llvm/lib/Target/X86/X86CodeEmitter.cpp:1.51 llvm/lib/Target/X86/X86CodeEmitter.cpp:1.52
--- llvm/lib/Target/X86/X86CodeEmitter.cpp:1.51	Sun Feb 15 15:37:17 2004
+++ llvm/lib/Target/X86/X86CodeEmitter.cpp	Tue Feb 17 01:40:44 2004
@@ -574,8 +574,9 @@
 
   case X86II::MRMSrcMem:
     MCE.emitByte(BaseOpcode);
-    emitMemModRMByte(MI, MI.getNumOperands()-4,
-                     getX86RegNum(MI.getOperand(0).getReg()));
+    emitMemModRMByte(MI, 1, getX86RegNum(MI.getOperand(0).getReg()));
+    if (MI.getNumOperands() == 2+4)
+      emitConstant(MI.getOperand(5).getImmedValue(), sizeOfPtr(Desc));
     break;
 
   case X86II::MRMS0r: case X86II::MRMS1r:




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 01:48:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 01:48:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170747.i1H7lUM24750@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.55 -> 1.56

---
Log message:

Add support for folding memory operands in MOVri{8,16,32} instructions.


---
Diffs of the changes:  (+3 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.55 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.56
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.55	Tue Feb 17 00:30:34 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 01:47:20 2004
@@ -120,6 +120,9 @@
     case X86::MOVrr8:  NI = MakeMRInst(X86::MOVmr8 , FrameIndex, MI); break;
     case X86::MOVrr16: NI = MakeMRInst(X86::MOVmr16, FrameIndex, MI); break;
     case X86::MOVrr32: NI = MakeMRInst(X86::MOVmr32, FrameIndex, MI); break;
+    case X86::MOVri8:  NI = MakeMIInst(X86::MOVmi8 , FrameIndex, MI); break;
+    case X86::MOVri16: NI = MakeMIInst(X86::MOVmi16, FrameIndex, MI); break;
+    case X86::MOVri32: NI = MakeMIInst(X86::MOVmi32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;




From lattner at cs.uiuc.edu  Tue Feb 17 02:04:02 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 02:04:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170803.CAA09221@zion.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.56 -> 1.57

---
Log message:

Add a (hidden) option to print instructions that fail to fuse.  It's looking
like compares and test's would be the next huge win...


---
Diffs of the changes:  (+16 -8)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.56 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.57
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.56	Tue Feb 17 01:47:20 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 02:03:47 2004
@@ -34,6 +34,11 @@
   cl::opt<bool>
   NoFusing("disable-spill-fusing",
            cl::desc("Disable fusing of spill code into instructions"));
+  cl::opt<bool>
+  PrintFailedFusing("print-failed-fuse-candidates",
+                    cl::desc("Print instructions that the allocator wants to"
+                             " fuse, but the X86 backend currently can't"),
+                    cl::Hidden);
 }
 
 X86RegisterInfo::X86RegisterInfo()
@@ -135,7 +140,7 @@
     case X86::ANDri8:  NI = MakeMIInst(X86::ANDmi8 , FrameIndex, MI); break;
     case X86::ANDri16: NI = MakeMIInst(X86::ANDmi16, FrameIndex, MI); break;
     case X86::ANDri32: NI = MakeMIInst(X86::ANDmi32, FrameIndex, MI); break;
-    default: return false; // Cannot fold
+    default: break; // Cannot fold
     }
   } else if (i == 1) {
     switch(MI->getOpcode()) {
@@ -150,16 +155,19 @@
     case X86::ANDrr32: NI = MakeRMInst(X86::ANDrm32, FrameIndex, MI); break;
     case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16, FrameIndex, MI); break;
     case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
-    case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI); break;
-    case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI); break;
-    default: return false;  // cannot fold.
+    case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI);break;
+    case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI);break;
+    default: break;
     }
+  }
+  if (NI) {
+    MI = MBB.insert(MBB.erase(MI), NI);
+    return true;
   } else {
-    return false; // cannot fold.
+    if (PrintFailedFusing)
+      std::cerr << "We failed to fuse: " << *MI;
+    return false;
   }
-  
-  MI = MBB.insert(MBB.erase(MI), NI);
-  return true;
 }
 
 //===----------------------------------------------------------------------===//




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 02:07:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 02:07:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86InstrInfo.td
Message-ID: <200402170806.i1H86fU31725@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86InstrInfo.td updated: 1.30 -> 1.31

---
Log message:

Add support for ADC{rm.mr}32 and SBB{rm,mr}32.


---
Diffs of the changes:  (+6 -2)

Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.30 llvm/lib/Target/X86/X86InstrInfo.td:1.31
--- llvm/lib/Target/X86/X86InstrInfo.td:1.30	Tue Feb 17 00:28:19 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 02:06:31 2004
@@ -284,7 +284,9 @@
 def ADDmi16b : I2A8 <"add", 0x83, MRMSrcMem >, OpSize; // [mem16] += I8
 def ADDmi32b : I2A8 <"add", 0x83, MRMSrcMem >;         // [mem32] += I32
 
-def ADCrr32  : I2A32<"adc", 0x11, MRMDestReg>;                // R32 += imm32+Carry
+def ADCrr32  : I2A32<"adc", 0x11, MRMDestReg>;         // R32 += R32+Carry
+def ADCrm32  : I2A32<"adc", 0x11, MRMSrcMem >;         // R32 += [mem32]+Carry
+def ADCmr32  : I2A32<"adc", 0x13, MRMDestMem>;         // [mem32] += R32+Carry
 
 def SUBrr8   : I2A8 <"sub", 0x28, MRMDestReg>,         Pattern<(set R8 , (minus R8 , R8 ))>;
 def SUBrr16  : I2A16<"sub", 0x29, MRMDestReg>, OpSize, Pattern<(set R16, (minus R16, R16))>;
@@ -295,7 +297,9 @@
 def SUBri16b : I2A8 <"sub", 0x83, MRMS5r    >, OpSize;
 def SUBri32b : I2A8 <"sub", 0x83, MRMS5r    >;
 
-def SBBrr32  : I2A32<"sbb", 0x19, MRMDestReg>;                // R32 -= R32+Carry
+def SBBrr32  : I2A32<"sbb", 0x19, MRMDestReg>;         // R32 -= R32+Borrow
+def SBBrm32  : I2A32<"sbb", 0x19, MRMSrcMem >;         // R32 -= [mem32]+Borrow
+def SBBmr32  : I2A32<"sbb", 0x1B, MRMDestMem>;         // [mem32] -= R32+Borrow
 
 def IMULrr16 : I2A16<"imul", 0xAF, MRMSrcReg>, TB, OpSize, Pattern<(set R16, (times R16, R16))>;
 def IMULrr32 : I2A32<"imul", 0xAF, MRMSrcReg>, TB        , Pattern<(set R32, (times R32, R32))>;




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 02:10:02 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 02:10:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170809.i1H891O31820@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.57 -> 1.58

---
Log message:

Add support for folding memory operands for ADC, SBB and SUB instructions.


---
Diffs of the changes:  (+13 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.57 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.58
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.57	Tue Feb 17 02:03:47 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 02:08:51 2004
@@ -131,9 +131,17 @@
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
+    case X86::ADCrr32: NI = MakeMRInst(X86::ADCmr32, FrameIndex, MI); break;
     case X86::ADDri8:  NI = MakeMIInst(X86::ADDmi8 , FrameIndex, MI); break;
     case X86::ADDri16: NI = MakeMIInst(X86::ADDmi16, FrameIndex, MI); break;
     case X86::ADDri32: NI = MakeMIInst(X86::ADDmi32, FrameIndex, MI); break;
+    case X86::SUBrr8:  NI = MakeMRInst(X86::SUBmr8 , FrameIndex, MI); break;
+    case X86::SUBrr16: NI = MakeMRInst(X86::SUBmr16, FrameIndex, MI); break;
+    case X86::SUBrr32: NI = MakeMRInst(X86::SUBmr32, FrameIndex, MI); break;
+    case X86::SBBrr32: NI = MakeMRInst(X86::SBBmr32, FrameIndex, MI); break;
+    case X86::SUBri8:  NI = MakeMIInst(X86::SUBmi8 , FrameIndex, MI); break;
+    case X86::SUBri16: NI = MakeMIInst(X86::SUBmi16, FrameIndex, MI); break;
+    case X86::SUBri32: NI = MakeMIInst(X86::SUBmi32, FrameIndex, MI); break;
     case X86::ANDrr8:  NI = MakeMRInst(X86::ANDmr8 , FrameIndex, MI); break;
     case X86::ANDrr16: NI = MakeMRInst(X86::ANDmr16, FrameIndex, MI); break;
     case X86::ANDrr32: NI = MakeMRInst(X86::ANDmr32, FrameIndex, MI); break;
@@ -150,6 +158,11 @@
     case X86::ADDrr8:  NI = MakeRMInst(X86::ADDrm8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeRMInst(X86::ADDrm16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeRMInst(X86::ADDrm32, FrameIndex, MI); break;
+    case X86::ADCrr32: NI = MakeRMInst(X86::ADCrm32, FrameIndex, MI); break;
+    case X86::SUBrr8:  NI = MakeRMInst(X86::SUBrm8 , FrameIndex, MI); break;
+    case X86::SUBrr16: NI = MakeRMInst(X86::SUBrm16, FrameIndex, MI); break;
+    case X86::SUBrr32: NI = MakeRMInst(X86::SUBrm32, FrameIndex, MI); break;
+    case X86::SBBrr32: NI = MakeRMInst(X86::SBBrm32, FrameIndex, MI); break;
     case X86::ANDrr8:  NI = MakeRMInst(X86::ANDrm8 , FrameIndex, MI); break;
     case X86::ANDrr16: NI = MakeRMInst(X86::ANDrm16, FrameIndex, MI); break;
     case X86::ANDrr32: NI = MakeRMInst(X86::ANDrm32, FrameIndex, MI); break;




From lattner at cs.uiuc.edu  Tue Feb 17 02:10:27 2004
From: lattner at cs.uiuc.edu (Chris Lattner)
Date: Tue Feb 17 02:10:27 2004
Subject: [llvm-commits] CVS: llvm/lib/CodeGen/RegAllocLocal.cpp
Message-ID: <200402170809.CAA15997@zion.cs.uiuc.edu>


Changes in directory llvm/lib/CodeGen:

RegAllocLocal.cpp updated: 1.49 -> 1.50

---
Log message:

Add support to the local allocator for fusing spill code into the instructions
that need them.  This is very useful on CISCy targets like the X86 because it
reduces the total spill pressure, and makes better use of it's (large) 
instruction set.  Though the X86 backend doesn't know how to rewrite many 
instructions yet, this already makes a substantial difference on 176.gcc for 
example:

Before:
Time:
   8.0099 ( 31.2%)   0.0100 ( 12.5%)   8.0199 ( 31.2%)   7.7186 ( 30.0%)  Local Register Allocator

Code quality:
734559 asm-printer           - Number of machine instrs printed
111395 ra-local              - Number of registers reloaded
 79902 ra-local              - Number of registers spilled
231554 x86-peephole          - Number of peephole optimization performed

After:
Time:
   7.8700 ( 30.6%)   0.0099 ( 19.9%)   7.8800 ( 30.6%)   7.7892 ( 30.2%)  Local Register Allocator
Code quality:
733083 asm-printer           - Number of machine instrs printed
  2379 ra-local              - Number of reloads fused into instructions
109046 ra-local              - Number of registers reloaded
 79881 ra-local              - Number of registers spilled
230658 x86-peephole          - Number of peephole optimization performed

So by fusing 2300 instructions, we reduced the  static number of instructions 
by 1500, and reduces the number of peepholes (and thus the work) by about 900.
This also clearly reduces the number of reload/spill instructions that are 
emitted.




---
Diffs of the changes:  (+13 -11)

Index: llvm/lib/CodeGen/RegAllocLocal.cpp
diff -u llvm/lib/CodeGen/RegAllocLocal.cpp:1.49 llvm/lib/CodeGen/RegAllocLocal.cpp:1.50
--- llvm/lib/CodeGen/RegAllocLocal.cpp:1.49	Tue Feb 17 01:02:17 2004
+++ llvm/lib/CodeGen/RegAllocLocal.cpp	Tue Feb 17 02:09:40 2004
@@ -30,6 +30,7 @@
 namespace {
   Statistic<> NumSpilled ("ra-local", "Number of registers spilled");
   Statistic<> NumReloaded("ra-local", "Number of registers reloaded");
+  Statistic<> NumFused   ("ra-local", "Number of reloads fused into instructions");
   cl::opt<bool> DisableKill("disable-kill", cl::Hidden,
                             cl::desc("Disable register kill in local-ra"));
 
@@ -491,14 +492,16 @@
   // If we have registers available to hold the value, use them.
   const TargetRegisterClass *RC = MF->getSSARegMap()->getRegClass(VirtReg);
   unsigned PhysReg = getFreeReg(RC);
+  int FrameIndex = getStackSpaceFor(VirtReg, RC);
 
-  if (PhysReg) {  // PhysReg available!
-    PhysReg = getReg(MBB, MI, VirtReg);
-  } else {  // No registers available...
-    /// If we can fold this spill into this instruction, do so now.
-    if (0) {
-      // TODO
-      return MI;
+  if (PhysReg) {   // Register is available, allocate it!
+    assignVirtToPhysReg(VirtReg, PhysReg);
+  } else {         // No registers available.
+    // If we can fold this spill into this instruction, do so now.
+    MachineBasicBlock::iterator MII = MI;
+    if (RegInfo->foldMemoryOperand(MII, OpNum, FrameIndex)) {
+      ++NumFused;
+      return MII;
     }
 
     // It looks like we can't fold this virtual register load into this
@@ -507,8 +510,6 @@
     PhysReg = getReg(MBB, MI, VirtReg);
   }
 
-  int FrameIndex = getStackSpaceFor(VirtReg, RC);
-
   markVirtRegModified(VirtReg, false);   // Note that this reg was just reloaded
 
   DEBUG(std::cerr << "  Reloading %reg" << VirtReg << " into "
@@ -565,9 +566,10 @@
         unsigned VirtReg = KI->second;
         unsigned PhysReg = VirtReg;
         if (MRegisterInfo::isVirtualRegister(VirtReg)) {
+          // If the virtual register was never materialized into a register, it
+          // might not be in the map, but it won't hurt to zero it out anyway.
           unsigned &PhysRegSlot = getVirt2PhysRegMapSlot(VirtReg);
           PhysReg = PhysRegSlot;
-          assert(PhysReg != 0);
           PhysRegSlot = 0;
         }
 
@@ -599,7 +601,7 @@
     for (const unsigned *ImplicitDefs = TID.ImplicitDefs;
          *ImplicitDefs; ++ImplicitDefs) {
       unsigned Reg = *ImplicitDefs;
-      spillPhysReg(MBB, MI, Reg);
+      spillPhysReg(MBB, MI, Reg, true);
       PhysRegsUseOrder.push_back(Reg);
       PhysRegsUsed[Reg] = 0;            // It is free and reserved now
       for (const unsigned *AliasSet = RegInfo->getAliasSet(Reg);




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 02:18:02 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 02:18:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86InstrInfo.td
Message-ID: <200402170817.i1H8HoN04869@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86InstrInfo.td updated: 1.31 -> 1.32

---
Log message:

Add SUB{rm,mr,mi}{8,16,32} instructions.


---
Diffs of the changes:  (+12 -0)

Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.31 llvm/lib/Target/X86/X86InstrInfo.td:1.32
--- llvm/lib/Target/X86/X86InstrInfo.td:1.31	Tue Feb 17 02:06:31 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 02:17:40 2004
@@ -297,6 +297,18 @@
 def SUBri16b : I2A8 <"sub", 0x83, MRMS5r    >, OpSize;
 def SUBri32b : I2A8 <"sub", 0x83, MRMS5r    >;
 
+def SUBmr8   : I2A8 <"sub", 0x28, MRMDestMem>;         // [mem8]  -= R8
+def SUBmr16  : I2A16<"sub", 0x29, MRMDestMem>, OpSize; // [mem16] -= R16
+def SUBmr32  : I2A32<"sub", 0x29, MRMDestMem>;         // [mem32] -= R32
+def SUBrm8   : I2A8 <"sub", 0x2A, MRMSrcMem >;         // R8  -= [mem8]
+def SUBrm16  : I2A16<"sub", 0x2B, MRMSrcMem >, OpSize; // R16 -= [mem16]
+def SUBrm32  : I2A32<"sub", 0x2B, MRMSrcMem >;         // R32 -= [mem32]
+def SUBmi8   : I2A8 <"sub", 0x80, MRMSrcMem >;         // [mem8] -= I8
+def SUBmi16  : I2A16<"sub", 0x81, MRMSrcMem >, OpSize; // [mem16] -= I16
+def SUBmi32  : I2A32<"sub", 0x81, MRMSrcMem >;         // [mem32] -= I8
+def SUBmi16b : I2A8 <"sub", 0x83, MRMSrcMem >, OpSize; // [mem16] -= I8
+def SUBmi32b : I2A8 <"sub", 0x83, MRMSrcMem >;         // [mem32] -= I32
+
 def SBBrr32  : I2A32<"sbb", 0x19, MRMDestReg>;         // R32 -= R32+Borrow
 def SBBrm32  : I2A32<"sbb", 0x19, MRMSrcMem >;         // R32 -= [mem32]+Borrow
 def SBBmr32  : I2A32<"sbb", 0x1B, MRMDestMem>;         // [mem32] -= R32+Borrow




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 02:50:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 02:50:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86InstrInfo.td
Message-ID: <200402170849.i1H8nAk15319@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86InstrInfo.td updated: 1.32 -> 1.33

---
Log message:

Add CMP{rm,mr,mi}{8,16,32}, INCm{8,16,32} and DECm{8,16,32} instructions.


---
Diffs of the changes:  (+22 -6)

Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.32 llvm/lib/Target/X86/X86InstrInfo.td:1.33
--- llvm/lib/Target/X86/X86InstrInfo.td:1.32	Tue Feb 17 02:17:40 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 02:49:00 2004
@@ -253,12 +253,19 @@
 def NOTr16 : I2A16<"not", 0xF7, MRMS2r>, OpSize; // R16 = ~R16 = R16^-1
 def NOTr32 : I2A32<"not", 0xF7, MRMS2r>;         // R32 = ~R32 = R32^-1
 
-def INCr8  : I2A8 <"inc", 0xFE, MRMS0r>;         // R8  = R8 +1
-def INCr16 : I2A16<"inc", 0xFF, MRMS0r>, OpSize; // R16 = R16+1
-def INCr32 : I2A32<"inc", 0xFF, MRMS0r>;         // R32 = R32+1
-def DECr8  : I2A8 <"dec", 0xFE, MRMS1r>;         // R8  = R8 -1
-def DECr16 : I2A16<"dec", 0xFF, MRMS1r>, OpSize; // R16 = R16-1
-def DECr32 : I2A32<"dec", 0xFF, MRMS1r>;         // R32 = R32-1
+def INCr8  : I2A8 <"inc", 0xFE, MRMS0r>;         // ++R8
+def INCr16 : I2A16<"inc", 0xFF, MRMS0r>, OpSize; // ++R16
+def INCr32 : I2A32<"inc", 0xFF, MRMS0r>;         // ++R32
+def INCm8  : I2A8 <"inc", 0xFE, MRMS0m>;         // ++R8
+def INCm16 : I2A16<"inc", 0xFF, MRMS0m>, OpSize; // ++R16
+def INCm32 : I2A32<"inc", 0xFF, MRMS0m>;         // ++R32
+
+def DECr8  : I2A8 <"dec", 0xFE, MRMS1r>;         // --R8
+def DECr16 : I2A16<"dec", 0xFF, MRMS1r>, OpSize; // --R16
+def DECr32 : I2A32<"dec", 0xFF, MRMS1r>;         // --R32
+def DECm8  : I2A8 <"dec", 0xFE, MRMS1m>;         // --[mem8]
+def DECm16 : I2A16<"dec", 0xFF, MRMS1m>, OpSize; // --[mem16]
+def DECm32 : I2A32<"dec", 0xFF, MRMS1m>;         // --[mem32]
 
 
 
@@ -435,9 +442,18 @@
 def CMPrr16 : X86Inst<"cmp", 0x39, MRMDestReg, Arg16>, OpSize;      // compare R16, R16
 def CMPrr32 : X86Inst<"cmp", 0x39, MRMDestReg, Arg32>,              // compare R32, R32
               Pattern<(isVoid (unspec2 R32, R32))>;
+def CMPmr8  : X86Inst<"cmp", 0x38, MRMDestMem, Arg8 >;              // compare [mem8], R8
+def CMPmr16 : X86Inst<"cmp", 0x39, MRMDestMem, Arg16>, OpSize;      // compare [mem16], R16
+def CMPmr32 : X86Inst<"cmp", 0x39, MRMDestMem, Arg32>;              // compare [mem32], R32
+def CMPrm8  : X86Inst<"cmp", 0x3A, MRMSrcMem , Arg8 >;              // compare R8, [mem8]
+def CMPrm16 : X86Inst<"cmp", 0x3B, MRMSrcMem , Arg16>, OpSize;      // compare R16, [mem16]
+def CMPrm32 : X86Inst<"cmp", 0x3B, MRMSrcMem , Arg32>;              // compare R32, [mem32]
 def CMPri8  : X86Inst<"cmp", 0x80, MRMS7r    , Arg8 >;              // compare R8, imm8
 def CMPri16 : X86Inst<"cmp", 0x81, MRMS7r    , Arg16>, OpSize;      // compare R16, imm16
 def CMPri32 : X86Inst<"cmp", 0x81, MRMS7r    , Arg32>;              // compare R32, imm32
+def CMPmi8  : X86Inst<"cmp", 0x80, MRMS7m    , Arg8 >;              // compare [mem8], imm8
+def CMPmi16 : X86Inst<"cmp", 0x81, MRMS7m    , Arg16>, OpSize;      // compare [mem16], imm16
+def CMPmi32 : X86Inst<"cmp", 0x81, MRMS7m    , Arg32>;              // compare [mem32], imm32
 
 // Sign/Zero extenders
 def MOVSXr16r8 : X86Inst<"movsx", 0xBE, MRMSrcReg, Arg8>, TB, OpSize; // R16 = signext(R8)




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 02:50:21 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 02:50:21 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402170849.i1H8nUi15583@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.58 -> 1.59

---
Log message:

Add memory operand folding for CMP{rm,mr,mi}{8,16,32}, INCm{8,16,32}
and DECm{8,16,32} instructions.


---
Diffs of the changes:  (+21 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.58 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.59
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.58	Tue Feb 17 02:08:51 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 02:49:20 2004
@@ -87,6 +87,12 @@
   return 1;
 }
 
+static MachineInstr *MakeMInst(unsigned Opcode, unsigned FrameIndex,
+                               MachineInstr *MI) {
+  return addFrameReference(BuildMI(Opcode, 1, MI->getOperand(0).getReg()),
+                           FrameIndex);
+}
+
 static MachineInstr *MakeMRInst(unsigned Opcode, unsigned FrameIndex,
                                 MachineInstr *MI) {
   return addFrameReference(BuildMI(Opcode, 5), FrameIndex)
@@ -128,6 +134,12 @@
     case X86::MOVri8:  NI = MakeMIInst(X86::MOVmi8 , FrameIndex, MI); break;
     case X86::MOVri16: NI = MakeMIInst(X86::MOVmi16, FrameIndex, MI); break;
     case X86::MOVri32: NI = MakeMIInst(X86::MOVmi32, FrameIndex, MI); break;
+    case X86::INCr8:   NI = MakeMInst(X86::INCm8 , FrameIndex, MI); break;
+    case X86::INCr16:  NI = MakeMInst(X86::INCm16, FrameIndex, MI); break;
+    case X86::INCr32:  NI = MakeMInst(X86::INCm32, FrameIndex, MI); break;
+    case X86::DECr8:   NI = MakeMInst(X86::DECm8 , FrameIndex, MI); break;
+    case X86::DECr16:  NI = MakeMInst(X86::DECm16, FrameIndex, MI); break;
+    case X86::DECr32:  NI = MakeMInst(X86::DECm32, FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
@@ -148,6 +160,12 @@
     case X86::ANDri8:  NI = MakeMIInst(X86::ANDmi8 , FrameIndex, MI); break;
     case X86::ANDri16: NI = MakeMIInst(X86::ANDmi16, FrameIndex, MI); break;
     case X86::ANDri32: NI = MakeMIInst(X86::ANDmi32, FrameIndex, MI); break;
+    case X86::CMPrr8:  NI = MakeMRInst(X86::CMPmr8 , FrameIndex, MI); break;
+    case X86::CMPrr16: NI = MakeMRInst(X86::CMPmr16, FrameIndex, MI); break;
+    case X86::CMPrr32: NI = MakeMRInst(X86::CMPmr32, FrameIndex, MI); break;
+    case X86::CMPri8:  NI = MakeMIInst(X86::CMPmi8 , FrameIndex, MI); break;
+    case X86::CMPri16: NI = MakeMIInst(X86::CMPmi16, FrameIndex, MI); break;
+    case X86::CMPri32: NI = MakeMIInst(X86::CMPmi32, FrameIndex, MI); break;
     default: break; // Cannot fold
     }
   } else if (i == 1) {
@@ -170,6 +188,9 @@
     case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
     case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI);break;
     case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI);break;
+    case X86::CMPrr8:  NI = MakeRMInst(X86::CMPrm8 , FrameIndex, MI); break;
+    case X86::CMPrr16: NI = MakeRMInst(X86::CMPrm16, FrameIndex, MI); break;
+    case X86::CMPrr32: NI = MakeRMInst(X86::CMPrm32, FrameIndex, MI); break;
     default: break;
     }
   }




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 03:15:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 03:15:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp X86InstrInfo.td
Message-ID: <200402170914.i1H9Ebe22476@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.59 -> 1.60
X86InstrInfo.td updated: 1.33 -> 1.34

---
Log message:

Add memory operand folding support for MUL, DIV, IDIV, NEG, NOT,
MOVSX, and MOVZX.


---
Diffs of the changes:  (+45 -0)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.59 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.60
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.59	Tue Feb 17 02:49:20 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 03:14:21 2004
@@ -134,6 +134,21 @@
     case X86::MOVri8:  NI = MakeMIInst(X86::MOVmi8 , FrameIndex, MI); break;
     case X86::MOVri16: NI = MakeMIInst(X86::MOVmi16, FrameIndex, MI); break;
     case X86::MOVri32: NI = MakeMIInst(X86::MOVmi32, FrameIndex, MI); break;
+    case X86::MULr8:   NI = MakeMInst(X86::MULm8 , FrameIndex, MI); break;
+    case X86::MULr16:  NI = MakeMInst(X86::MULm16, FrameIndex, MI); break;
+    case X86::MULr32:  NI = MakeMInst(X86::MULm32, FrameIndex, MI); break;
+    case X86::DIVr8:   NI = MakeMInst(X86::DIVm8 , FrameIndex, MI); break;
+    case X86::DIVr16:  NI = MakeMInst(X86::DIVm16, FrameIndex, MI); break;
+    case X86::DIVr32:  NI = MakeMInst(X86::DIVm32, FrameIndex, MI); break;
+    case X86::IDIVr8:  NI = MakeMInst(X86::IDIVm8 , FrameIndex, MI); break;
+    case X86::IDIVr16: NI = MakeMInst(X86::IDIVm16, FrameIndex, MI); break;
+    case X86::IDIVr32: NI = MakeMInst(X86::IDIVm32, FrameIndex, MI); break;
+    case X86::NEGr8:   NI = MakeMInst(X86::NEGm8 , FrameIndex, MI); break;
+    case X86::NEGr16:  NI = MakeMInst(X86::NEGm16, FrameIndex, MI); break;
+    case X86::NEGr32:  NI = MakeMInst(X86::NEGm32, FrameIndex, MI); break;
+    case X86::NOTr8:   NI = MakeMInst(X86::NOTm8 , FrameIndex, MI); break;
+    case X86::NOTr16:  NI = MakeMInst(X86::NOTm16, FrameIndex, MI); break;
+    case X86::NOTr32:  NI = MakeMInst(X86::NOTm32, FrameIndex, MI); break;
     case X86::INCr8:   NI = MakeMInst(X86::INCm8 , FrameIndex, MI); break;
     case X86::INCr16:  NI = MakeMInst(X86::INCm16, FrameIndex, MI); break;
     case X86::INCr32:  NI = MakeMInst(X86::INCm32, FrameIndex, MI); break;
@@ -191,6 +206,13 @@
     case X86::CMPrr8:  NI = MakeRMInst(X86::CMPrm8 , FrameIndex, MI); break;
     case X86::CMPrr16: NI = MakeRMInst(X86::CMPrm16, FrameIndex, MI); break;
     case X86::CMPrr32: NI = MakeRMInst(X86::CMPrm32, FrameIndex, MI); break;
+
+    case X86::MOVSXr16r8: NI = MakeRMInst(X86::MOVSXr16m8 , FrameIndex, MI); break;
+    case X86::MOVSXr32r8: NI = MakeRMInst(X86::MOVSXr32m8, FrameIndex, MI); break;
+    case X86::MOVSXr32r16:NI = MakeRMInst(X86::MOVSXr32m16, FrameIndex, MI); break;
+    case X86::MOVZXr16r8: NI = MakeRMInst(X86::MOVZXr16m8 , FrameIndex, MI); break;
+    case X86::MOVZXr32r8: NI = MakeRMInst(X86::MOVZXr32m8, FrameIndex, MI); break;
+    case X86::MOVZXr32r16:NI = MakeRMInst(X86::MOVZXr32m16, FrameIndex, MI); break;
     default: break;
     }
   }


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.33 llvm/lib/Target/X86/X86InstrInfo.td:1.34
--- llvm/lib/Target/X86/X86InstrInfo.td:1.33	Tue Feb 17 02:49:00 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 03:14:23 2004
@@ -220,16 +220,25 @@
 def MULr8  : X86Inst<"mul", 0xF6, MRMS4r, Arg8 >, Imp<[AL],[AX]>;               // AL,AH = AL*R8
 def MULr16 : X86Inst<"mul", 0xF7, MRMS4r, Arg16>, Imp<[AX],[AX,DX]>, OpSize;    // AX,DX = AX*R16
 def MULr32 : X86Inst<"mul", 0xF7, MRMS4r, Arg32>, Imp<[EAX],[EAX,EDX]>;         // EAX,EDX = EAX*R32
+def MULm8  : X86Inst<"mul", 0xF6, MRMS4m, Arg8 >, Imp<[AL],[AX]>;               // AL,AH = AL*[mem8]
+def MULm16 : X86Inst<"mul", 0xF7, MRMS4m, Arg16>, Imp<[AX],[AX,DX]>, OpSize;    // AX,DX = AX*[mem16]
+def MULm32 : X86Inst<"mul", 0xF7, MRMS4m, Arg32>, Imp<[EAX],[EAX,EDX]>;         // EAX,EDX = EAX*[mem32]
 
 // unsigned division/remainder
 def DIVr8  : X86Inst<"div", 0xF6, MRMS6r, Arg8 >, Imp<[AX],[AX]>;               // AX/r8 = AL,AH
 def DIVr16 : X86Inst<"div", 0xF7, MRMS6r, Arg16>, Imp<[AX,DX],[AX,DX]>, OpSize; // DX:AX/r16 = AX,DX
 def DIVr32 : X86Inst<"div", 0xF7, MRMS6r, Arg32>, Imp<[EAX,EDX],[EAX,EDX]>;     // EDX:EAX/r32 = EAX,EDX
+def DIVm8  : X86Inst<"div", 0xF6, MRMS6m, Arg8 >, Imp<[AX],[AX]>;               // AX/[mem8] = AL,AH
+def DIVm16 : X86Inst<"div", 0xF7, MRMS6m, Arg16>, Imp<[AX,DX],[AX,DX]>, OpSize; // DX:AX/[mem16] = AX,DX
+def DIVm32 : X86Inst<"div", 0xF7, MRMS6m, Arg32>, Imp<[EAX,EDX],[EAX,EDX]>;     // EDX:EAX/[mem32] = EAX,EDX
 
 // signed division/remainder
 def IDIVr8 : X86Inst<"idiv",0xF6, MRMS7r, Arg8 >, Imp<[AX],[AX]>;               // AX/r8 = AL,AH
 def IDIVr16: X86Inst<"idiv",0xF7, MRMS7r, Arg16>, Imp<[AX,DX],[AX,DX]>, OpSize; // DX:AX/r16 = AX,DX
 def IDIVr32: X86Inst<"idiv",0xF7, MRMS7r, Arg32>, Imp<[EAX,EDX],[EAX,EDX]>;     // EDX:EAX/r32 = EAX,EDX
+def IDIVm8 : X86Inst<"idiv",0xF6, MRMS7m, Arg8 >, Imp<[AX],[AX]>;               // AX/[mem8] = AL,AH
+def IDIVm16: X86Inst<"idiv",0xF7, MRMS7m, Arg16>, Imp<[AX,DX],[AX,DX]>, OpSize; // DX:AX/[mem16] = AX,DX
+def IDIVm32: X86Inst<"idiv",0xF7, MRMS7m, Arg32>, Imp<[EAX,EDX],[EAX,EDX]>;     // EDX:EAX/[mem32] = EAX,EDX
 
 // Sign-extenders for division
 def CBW    : X86Inst<"cbw", 0x98, RawFrm, Arg8 >, Imp<[AL],[AH]>;               // AX = signext(AL)
@@ -249,9 +258,16 @@
 def NEGr8  : I2A8 <"neg", 0xF6, MRMS3r>;         // R8  = -R8  = 0-R8
 def NEGr16 : I2A16<"neg", 0xF7, MRMS3r>, OpSize; // R16 = -R16 = 0-R16
 def NEGr32 : I2A32<"neg", 0xF7, MRMS3r>;         // R32 = -R32 = 0-R32
+def NEGm8  : I2A8 <"neg", 0xF6, MRMS3m>;         // [mem8]  = -[mem8]  = 0-[mem8]
+def NEGm16 : I2A16<"neg", 0xF7, MRMS3m>, OpSize; // [mem16] = -[mem16] = 0-[mem16]
+def NEGm32 : I2A32<"neg", 0xF7, MRMS3m>;         // [mem32] = -[mem32] = 0-[mem32]
+
 def NOTr8  : I2A8 <"not", 0xF6, MRMS2r>;         // R8  = ~R8  = R8^-1
 def NOTr16 : I2A16<"not", 0xF7, MRMS2r>, OpSize; // R16 = ~R16 = R16^-1
 def NOTr32 : I2A32<"not", 0xF7, MRMS2r>;         // R32 = ~R32 = R32^-1
+def NOTm8  : I2A8 <"not", 0xF6, MRMS2m>;         // [mem8]  = ~[mem8]  = [mem8^-1]
+def NOTm16 : I2A16<"not", 0xF7, MRMS2m>, OpSize; // [mem16] = ~[mem16] = [mem16^-1]
+def NOTm32 : I2A32<"not", 0xF7, MRMS2m>;         // [mem32] = ~[mem32] = [mem32^-1]
 
 def INCr8  : I2A8 <"inc", 0xFE, MRMS0r>;         // ++R8
 def INCr16 : I2A16<"inc", 0xFF, MRMS0r>, OpSize; // ++R16
@@ -459,9 +475,16 @@
 def MOVSXr16r8 : X86Inst<"movsx", 0xBE, MRMSrcReg, Arg8>, TB, OpSize; // R16 = signext(R8)
 def MOVSXr32r8 : X86Inst<"movsx", 0xBE, MRMSrcReg, Arg8>, TB;         // R32 = signext(R8)
 def MOVSXr32r16: X86Inst<"movsx", 0xBF, MRMSrcReg, Arg8>, TB;         // R32 = signext(R16)
+def MOVSXr16m8 : X86Inst<"movsx", 0xBE, MRMSrcMem, Arg8>, TB, OpSize; // R16 = signext([mem8])
+def MOVSXr32m8 : X86Inst<"movsx", 0xBE, MRMSrcMem, Arg8>, TB;         // R32 = signext([mem8])
+def MOVSXr32m16: X86Inst<"movsx", 0xBF, MRMSrcMem, Arg8>, TB;         // R32 = signext([mem16])
+
 def MOVZXr16r8 : X86Inst<"movzx", 0xB6, MRMSrcReg, Arg8>, TB, OpSize; // R16 = zeroext(R8)
 def MOVZXr32r8 : X86Inst<"movzx", 0xB6, MRMSrcReg, Arg8>, TB;         // R32 = zeroext(R8)
 def MOVZXr32r16: X86Inst<"movzx", 0xB7, MRMSrcReg, Arg8>, TB;         // R32 = zeroext(R16)
+def MOVZXr16m8 : X86Inst<"movzx", 0xB6, MRMSrcMem, Arg8>, TB, OpSize; // R16 = zeroext([mem8])
+def MOVZXr32m8 : X86Inst<"movzx", 0xB6, MRMSrcMem, Arg8>, TB;         // R32 = zeroext([mem8])
+def MOVZXr32m16: X86Inst<"movzx", 0xB7, MRMSrcMem, Arg8>, TB;         // R32 = zeroext([mem16])
 
 
 //===----------------------------------------------------------------------===//




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 09:11:06 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 09:11:06 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp
Message-ID: <200402171510.i1HFALj01529@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.23 -> 1.24

---
Log message:

ADDmi{16,32} should be in the next case statement.


---
Diffs of the changes:  (+3 -3)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.23 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.24
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.23	Tue Feb 17 01:36:32 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 09:10:11 2004
@@ -121,7 +121,6 @@
 #endif
 
   case X86::ADDri16:  case X86::ADDri32:
-  case X86::ADDmi16:  case X86::ADDmi32:
   case X86::SUBri16:  case X86::SUBri32:
   case X86::ANDri16:  case X86::ANDri32:
   case X86::ORri16:   case X86::ORri32:
@@ -136,8 +135,6 @@
         default: assert(0 && "Unknown opcode value!");
         case X86::ADDri16:  Opcode = X86::ADDri16b; break;
         case X86::ADDri32:  Opcode = X86::ADDri32b; break;
-        case X86::ADDmi16:  Opcode = X86::ADDmi16b; break;
-        case X86::ADDmi32:  Opcode = X86::ADDmi32b; break;
         case X86::SUBri16:  Opcode = X86::SUBri16b; break;
         case X86::SUBri32:  Opcode = X86::SUBri32b; break;
         case X86::ANDri16:  Opcode = X86::ANDri16b; break;
@@ -156,6 +153,7 @@
     return false;
 
 
+  case X86::ADDmi16:  case X86::ADDmi32:
   case X86::ANDmi16:  case X86::ANDmi32:
     assert(MI->getNumOperands() == 5 && "These should all have 5 operands!");
     if (MI->getOperand(4).isImmediate()) {
@@ -165,6 +163,8 @@
         unsigned Opcode;
         switch (MI->getOpcode()) {
         default: assert(0 && "Unknown opcode value!");
+        case X86::ADDmi16:  Opcode = X86::ADDmi16b; break;
+        case X86::ADDmi32:  Opcode = X86::ADDmi32b; break;
         case X86::ANDmi16:  Opcode = X86::ANDmi16b; break;
         case X86::ANDmi32:  Opcode = X86::ANDmi32b; break;
         }




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 09:15:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 09:15:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/PeepholeOptimizer.cpp
Message-ID: <200402171514.i1HFEd102384@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

PeepholeOptimizer.cpp updated: 1.24 -> 1.25

---
Log message:

Peephole optimize SUBmi{16,32} into SUBmi{16,32}b when immediate is 8
bits wide.


---
Diffs of the changes:  (+3 -0)

Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.24 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.25
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.24	Tue Feb 17 09:10:11 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 09:14:29 2004
@@ -154,6 +154,7 @@
 
 
   case X86::ADDmi16:  case X86::ADDmi32:
+  case X86::SUBmi16:  case X86::SUBmi32:
   case X86::ANDmi16:  case X86::ANDmi32:
     assert(MI->getNumOperands() == 5 && "These should all have 5 operands!");
     if (MI->getOperand(4).isImmediate()) {
@@ -165,6 +166,8 @@
         default: assert(0 && "Unknown opcode value!");
         case X86::ADDmi16:  Opcode = X86::ADDmi16b; break;
         case X86::ADDmi32:  Opcode = X86::ADDmi32b; break;
+        case X86::SUBmi16:  Opcode = X86::SUBmi16b; break;
+        case X86::SUBmi32:  Opcode = X86::SUBmi32b; break;
         case X86::ANDmi16:  Opcode = X86::ANDmi16b; break;
         case X86::ANDmi32:  Opcode = X86::ANDmi32b; break;
         }




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 09:34:02 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 09:34:02 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp X86InstrInfo.td PeepholeOptimizer.cpp
Message-ID: <200402171533.i1HFXOO04323@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.60 -> 1.61
X86InstrInfo.td updated: 1.34 -> 1.35
PeepholeOptimizer.cpp updated: 1.25 -> 1.26

---
Log message:

Add OR and XOR memory operand support.


---
Diffs of the changes:  (+55 -4)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.60 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.61
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.60	Tue Feb 17 03:14:21 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 09:33:14 2004
@@ -175,6 +175,18 @@
     case X86::ANDri8:  NI = MakeMIInst(X86::ANDmi8 , FrameIndex, MI); break;
     case X86::ANDri16: NI = MakeMIInst(X86::ANDmi16, FrameIndex, MI); break;
     case X86::ANDri32: NI = MakeMIInst(X86::ANDmi32, FrameIndex, MI); break;
+    case X86::ORrr8:   NI = MakeMRInst(X86::ORmr8 ,  FrameIndex, MI); break;
+    case X86::ORrr16:  NI = MakeMRInst(X86::ORmr16,  FrameIndex, MI); break;
+    case X86::ORrr32:  NI = MakeMRInst(X86::ORmr32,  FrameIndex, MI); break;
+    case X86::ORri8:   NI = MakeMIInst(X86::ORmi8 ,  FrameIndex, MI); break;
+    case X86::ORri16:  NI = MakeMIInst(X86::ORmi16,  FrameIndex, MI); break;
+    case X86::ORri32:  NI = MakeMIInst(X86::ORmi32,  FrameIndex, MI); break;
+    case X86::XORrr8:  NI = MakeMRInst(X86::XORmr8 , FrameIndex, MI); break;
+    case X86::XORrr16: NI = MakeMRInst(X86::XORmr16, FrameIndex, MI); break;
+    case X86::XORrr32: NI = MakeMRInst(X86::XORmr32, FrameIndex, MI); break;
+    case X86::XORri8:  NI = MakeMIInst(X86::XORmi8 , FrameIndex, MI); break;
+    case X86::XORri16: NI = MakeMIInst(X86::XORmi16, FrameIndex, MI); break;
+    case X86::XORri32: NI = MakeMIInst(X86::XORmi32, FrameIndex, MI); break;
     case X86::CMPrr8:  NI = MakeMRInst(X86::CMPmr8 , FrameIndex, MI); break;
     case X86::CMPrr16: NI = MakeMRInst(X86::CMPmr16, FrameIndex, MI); break;
     case X86::CMPrr32: NI = MakeMRInst(X86::CMPmr32, FrameIndex, MI); break;
@@ -199,6 +211,12 @@
     case X86::ANDrr8:  NI = MakeRMInst(X86::ANDrm8 , FrameIndex, MI); break;
     case X86::ANDrr16: NI = MakeRMInst(X86::ANDrm16, FrameIndex, MI); break;
     case X86::ANDrr32: NI = MakeRMInst(X86::ANDrm32, FrameIndex, MI); break;
+    case X86::ORrr8:   NI = MakeRMInst(X86::ORrm8 ,  FrameIndex, MI); break;
+    case X86::ORrr16:  NI = MakeRMInst(X86::ORrm16,  FrameIndex, MI); break;
+    case X86::ORrr32:  NI = MakeRMInst(X86::ORrm32,  FrameIndex, MI); break;
+    case X86::XORrr8:  NI = MakeRMInst(X86::XORrm8 , FrameIndex, MI); break;
+    case X86::XORrr16: NI = MakeRMInst(X86::XORrm16, FrameIndex, MI); break;
+    case X86::XORrr32: NI = MakeRMInst(X86::XORrm32, FrameIndex, MI); break;
     case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16, FrameIndex, MI); break;
     case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
     case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI);break;


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.34 llvm/lib/Target/X86/X86InstrInfo.td:1.35
--- llvm/lib/Target/X86/X86InstrInfo.td:1.34	Tue Feb 17 03:14:23 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 09:33:14 2004
@@ -379,24 +379,51 @@
 
 
 
+
 def ORrr8    : I2A8 <"or" , 0x08, MRMDestReg>,         Pattern<(set R8 , (or  R8 , R8 ))>;
 def ORrr16   : I2A16<"or" , 0x09, MRMDestReg>, OpSize, Pattern<(set R16, (or  R16, R16))>;
 def ORrr32   : I2A32<"or" , 0x09, MRMDestReg>,         Pattern<(set R32, (or  R32, R32))>;
+def ORmr8    : I2A8 <"or" , 0x08, MRMDestMem>;            // [mem8]  |= R8
+def ORmr16   : I2A16<"or" , 0x09, MRMDestMem>, OpSize;    // [mem16] |= R16
+def ORmr32   : I2A32<"or" , 0x09, MRMDestMem>;            // [mem32] |= R32
+def ORrm8    : I2A8 <"or" , 0x0A, MRMSrcMem >;            // R8  |= [mem8]
+def ORrm16   : I2A16<"or" , 0x0B, MRMSrcMem >, OpSize;    // R16 |= [mem16]
+def ORrm32   : I2A32<"or" , 0x0B, MRMSrcMem >;            // R32 |= [mem32]
+
 def ORri8    : I2A8 <"or" , 0x80, MRMS1r    >,         Pattern<(set R8 , (or  R8 , imm))>;
 def ORri16   : I2A16<"or" , 0x81, MRMS1r    >, OpSize, Pattern<(set R16, (or  R16, imm))>;
 def ORri32   : I2A32<"or" , 0x81, MRMS1r    >,         Pattern<(set R32, (or  R32, imm))>;
-def ORri16b  : I2A8 <"or" , 0x83, MRMS1r    >, OpSize;
-def ORri32b  : I2A8 <"or" , 0x83, MRMS1r    >;
+def ORmi8    : I2A8 <"or" , 0x80, MRMS1m    >;            // [mem8]  |= imm8
+def ORmi16   : I2A16<"or" , 0x81, MRMS1m    >, OpSize;    // [mem16] |= imm16
+def ORmi32   : I2A32<"or" , 0x81, MRMS1m    >;            // [mem32] |= imm32
+
+def ORri16b  : I2A8 <"or" , 0x83, MRMS1r    >, OpSize;    // R16 |= imm8
+def ORri32b  : I2A8 <"or" , 0x83, MRMS1r    >;            // R32 |= imm8
+def ORmi16b  : I2A8 <"or" , 0x83, MRMS1m    >, OpSize;    // [mem16] |= imm8
+def ORmi32b  : I2A8 <"or" , 0x83, MRMS1m    >;            // [mem32] |= imm8
 
 
 def XORrr8   : I2A8 <"xor", 0x30, MRMDestReg>,         Pattern<(set R8 , (xor R8 , R8 ))>;
 def XORrr16  : I2A16<"xor", 0x31, MRMDestReg>, OpSize, Pattern<(set R16, (xor R16, R16))>;
 def XORrr32  : I2A32<"xor", 0x31, MRMDestReg>,         Pattern<(set R32, (xor R32, R32))>;
+def XORmr8   : I2A8 <"xor", 0x30, MRMDestMem>;            // [mem8]  ^= R8
+def XORmr16  : I2A16<"xor", 0x31, MRMDestMem>, OpSize;    // [mem16] ^= R16
+def XORmr32  : I2A32<"xor", 0x31, MRMDestMem>;            // [mem32] ^= R32
+def XORrm8   : I2A8 <"xor", 0x32, MRMSrcMem >;            // R8  ^= [mem8]
+def XORrm16  : I2A16<"xor", 0x33, MRMSrcMem >, OpSize;    // R16 ^= [mem16]
+def XORrm32  : I2A32<"xor", 0x33, MRMSrcMem >;            // R32 ^= [mem32]
+
 def XORri8   : I2A8 <"xor", 0x80, MRMS6r    >,         Pattern<(set R8 , (xor R8 , imm))>;
 def XORri16  : I2A16<"xor", 0x81, MRMS6r    >, OpSize, Pattern<(set R16, (xor R16, imm))>;
 def XORri32  : I2A32<"xor", 0x81, MRMS6r    >,         Pattern<(set R32, (xor R32, imm))>;
-def XORri16b : I2A8 <"xor", 0x83, MRMS6r    >, OpSize;
-def XORri32b : I2A8 <"xor", 0x83, MRMS6r    >;
+def XORmi8   : I2A8 <"xor", 0x80, MRMS6m    >;            // [mem8] ^= R8
+def XORmi16  : I2A16<"xor", 0x81, MRMS6m    >, OpSize;    // [mem16] ^= R16
+def XORmi32  : I2A32<"xor", 0x81, MRMS6m    >;            // [mem32] ^= R32
+
+def XORri16b : I2A8 <"xor", 0x83, MRMS6r    >, OpSize;    // R16 ^= imm8
+def XORri32b : I2A8 <"xor", 0x83, MRMS6r    >;            // R32 ^= imm8
+def XORmi16b : I2A8 <"xor", 0x83, MRMS6m    >, OpSize;    // [mem16] ^= imm8
+def XORmi32b : I2A8 <"xor", 0x83, MRMS6m    >;            // [mem32] ^= imm8
 
 // Test instructions are just like AND, except they don't generate a result.
 def TESTrr8  : X86Inst<"test", 0x84, MRMDestReg, Arg8 >;          // flags = R8  & R8


Index: llvm/lib/Target/X86/PeepholeOptimizer.cpp
diff -u llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.25 llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.26
--- llvm/lib/Target/X86/PeepholeOptimizer.cpp:1.25	Tue Feb 17 09:14:29 2004
+++ llvm/lib/Target/X86/PeepholeOptimizer.cpp	Tue Feb 17 09:33:14 2004
@@ -156,6 +156,8 @@
   case X86::ADDmi16:  case X86::ADDmi32:
   case X86::SUBmi16:  case X86::SUBmi32:
   case X86::ANDmi16:  case X86::ANDmi32:
+  case X86::ORmi16:  case X86::ORmi32:
+  case X86::XORmi16:  case X86::XORmi32:
     assert(MI->getNumOperands() == 5 && "These should all have 5 operands!");
     if (MI->getOperand(4).isImmediate()) {
       int Val = MI->getOperand(4).getImmedValue();
@@ -170,6 +172,10 @@
         case X86::SUBmi32:  Opcode = X86::SUBmi32b; break;
         case X86::ANDmi16:  Opcode = X86::ANDmi16b; break;
         case X86::ANDmi32:  Opcode = X86::ANDmi32b; break;
+        case X86::ORmi16:   Opcode = X86::ORmi16b; break;
+        case X86::ORmi32:   Opcode = X86::ORmi32b; break;
+        case X86::XORmi16:  Opcode = X86::XORmi16b; break;
+        case X86::XORmi32:  Opcode = X86::XORmi32b; break;
         }
         unsigned R0 = MI->getOperand(0).getReg();
         unsigned Scale = MI->getOperand(1).getImmedValue();




From alkis at niobe.cs.uiuc.edu  Tue Feb 17 09:49:01 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 09:49:01 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp X86InstrInfo.td
Message-ID: <200402171548.i1HFmqh11280@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.61 -> 1.62
X86InstrInfo.td updated: 1.35 -> 1.36

---
Log message:

Add TEST and XCHG memory operand support.


---
Diffs of the changes:  (+31 -1)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.61 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.62
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.61	Tue Feb 17 09:33:14 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 09:48:42 2004
@@ -128,6 +128,9 @@
   MachineInstr* NI = 0;
   if (i == 0) {
     switch(MI->getOpcode()) {
+    case X86::XCHGrr8: NI = MakeMRInst(X86::XCHGmr8 ,FrameIndex, MI); break;
+    case X86::XCHGrr16:NI = MakeMRInst(X86::XCHGmr16,FrameIndex, MI); break;
+    case X86::XCHGrr32:NI = MakeMRInst(X86::XCHGmr32,FrameIndex, MI); break;
     case X86::MOVrr8:  NI = MakeMRInst(X86::MOVmr8 , FrameIndex, MI); break;
     case X86::MOVrr16: NI = MakeMRInst(X86::MOVmr16, FrameIndex, MI); break;
     case X86::MOVrr32: NI = MakeMRInst(X86::MOVmr32, FrameIndex, MI); break;
@@ -187,6 +190,12 @@
     case X86::XORri8:  NI = MakeMIInst(X86::XORmi8 , FrameIndex, MI); break;
     case X86::XORri16: NI = MakeMIInst(X86::XORmi16, FrameIndex, MI); break;
     case X86::XORri32: NI = MakeMIInst(X86::XORmi32, FrameIndex, MI); break;
+    case X86::TESTrr8: NI = MakeMRInst(X86::TESTmr8 , FrameIndex, MI); break;
+    case X86::TESTrr16:NI = MakeMRInst(X86::TESTmr16, FrameIndex, MI); break;
+    case X86::TESTrr32:NI = MakeMRInst(X86::TESTmr32, FrameIndex, MI); break;
+    case X86::TESTri8: NI = MakeMIInst(X86::TESTmi8 , FrameIndex, MI); break;
+    case X86::TESTri16:NI = MakeMIInst(X86::TESTmi16, FrameIndex, MI); break;
+    case X86::TESTri32:NI = MakeMIInst(X86::TESTmi32, FrameIndex, MI); break;
     case X86::CMPrr8:  NI = MakeMRInst(X86::CMPmr8 , FrameIndex, MI); break;
     case X86::CMPrr16: NI = MakeMRInst(X86::CMPmr16, FrameIndex, MI); break;
     case X86::CMPrr32: NI = MakeMRInst(X86::CMPmr32, FrameIndex, MI); break;
@@ -197,6 +206,9 @@
     }
   } else if (i == 1) {
     switch(MI->getOpcode()) {
+    case X86::XCHGrr8: NI = MakeRMInst(X86::XCHGrm8 ,FrameIndex, MI); break;
+    case X86::XCHGrr16:NI = MakeRMInst(X86::XCHGrm16,FrameIndex, MI); break;
+    case X86::XCHGrr32:NI = MakeRMInst(X86::XCHGrm32,FrameIndex, MI); break;
     case X86::MOVrr8:  NI = MakeRMInst(X86::MOVrm8 , FrameIndex, MI); break;
     case X86::MOVrr16: NI = MakeRMInst(X86::MOVrm16, FrameIndex, MI); break;
     case X86::MOVrr32: NI = MakeRMInst(X86::MOVrm32, FrameIndex, MI); break;
@@ -217,6 +229,9 @@
     case X86::XORrr8:  NI = MakeRMInst(X86::XORrm8 , FrameIndex, MI); break;
     case X86::XORrr16: NI = MakeRMInst(X86::XORrm16, FrameIndex, MI); break;
     case X86::XORrr32: NI = MakeRMInst(X86::XORrm32, FrameIndex, MI); break;
+    case X86::TESTrr8: NI = MakeRMInst(X86::TESTrm8 , FrameIndex, MI); break;
+    case X86::TESTrr16:NI = MakeRMInst(X86::TESTrm16, FrameIndex, MI); break;
+    case X86::TESTrr32:NI = MakeRMInst(X86::TESTrm32, FrameIndex, MI); break;
     case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16, FrameIndex, MI); break;
     case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
     case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI);break;
@@ -224,7 +239,6 @@
     case X86::CMPrr8:  NI = MakeRMInst(X86::CMPrm8 , FrameIndex, MI); break;
     case X86::CMPrr16: NI = MakeRMInst(X86::CMPrm16, FrameIndex, MI); break;
     case X86::CMPrr32: NI = MakeRMInst(X86::CMPrm32, FrameIndex, MI); break;
-
     case X86::MOVSXr16r8: NI = MakeRMInst(X86::MOVSXr16m8 , FrameIndex, MI); break;
     case X86::MOVSXr32r8: NI = MakeRMInst(X86::MOVSXr32m8, FrameIndex, MI); break;
     case X86::MOVSXr32r16:NI = MakeRMInst(X86::MOVSXr32m16, FrameIndex, MI); break;


Index: llvm/lib/Target/X86/X86InstrInfo.td
diff -u llvm/lib/Target/X86/X86InstrInfo.td:1.35 llvm/lib/Target/X86/X86InstrInfo.td:1.36
--- llvm/lib/Target/X86/X86InstrInfo.td:1.35	Tue Feb 17 09:33:14 2004
+++ llvm/lib/Target/X86/X86InstrInfo.td	Tue Feb 17 09:48:42 2004
@@ -170,6 +170,12 @@
 def XCHGrr8  : X86Inst<"xchg", 0x86, MRMDestReg, Arg8>;         // xchg R8, R8
 def XCHGrr16 : X86Inst<"xchg", 0x87, MRMDestReg, Arg16>, OpSize;// xchg R16, R16
 def XCHGrr32 : X86Inst<"xchg", 0x87, MRMDestReg, Arg32>;        // xchg R32, R32
+def XCHGmr8  : X86Inst<"xchg", 0x86, MRMDestMem, Arg8>;         // xchg [mem8], R8
+def XCHGmr16 : X86Inst<"xchg", 0x87, MRMDestMem, Arg16>, OpSize;// xchg [mem16], R16
+def XCHGmr32 : X86Inst<"xchg", 0x87, MRMDestMem, Arg32>;        // xchg [mem32], R32
+def XCHGrm8  : X86Inst<"xchg", 0x86, MRMSrcMem , Arg8>;         // xchg R8, [mem8]
+def XCHGrm16 : X86Inst<"xchg", 0x87, MRMSrcMem , Arg16>, OpSize;// xchg R16, [mem16]
+def XCHGrm32 : X86Inst<"xchg", 0x87, MRMSrcMem , Arg32>;        // xchg R32, [mem32]
 
 def LEAr16 : X86Inst<"lea", 0x8D, MRMSrcMem, Arg16>, OpSize; // R16 = lea [mem]
 def LEAr32 : X86Inst<"lea", 0x8D, MRMSrcMem, Arg32>;         // R32 = lea [mem]
@@ -429,9 +435,19 @@
 def TESTrr8  : X86Inst<"test", 0x84, MRMDestReg, Arg8 >;          // flags = R8  & R8
 def TESTrr16 : X86Inst<"test", 0x85, MRMDestReg, Arg16>, OpSize;  // flags = R16 & R16
 def TESTrr32 : X86Inst<"test", 0x85, MRMDestReg, Arg32>;          // flags = R32 & R32
+def TESTmr8  : X86Inst<"test", 0x84, MRMDestMem, Arg8 >;          // flags = [mem8]  & R8
+def TESTmr16 : X86Inst<"test", 0x85, MRMDestMem, Arg16>, OpSize;  // flags = [mem16] & R16
+def TESTmr32 : X86Inst<"test", 0x85, MRMDestMem, Arg32>;          // flags = [mem32] & R32
+def TESTrm8  : X86Inst<"test", 0x84, MRMSrcMem , Arg8 >;          // flags = R8  & [mem8]
+def TESTrm16 : X86Inst<"test", 0x85, MRMSrcMem , Arg16>, OpSize;  // flags = R16 & [mem16]
+def TESTrm32 : X86Inst<"test", 0x85, MRMSrcMem , Arg32>;          // flags = R32 & [mem32]
+
 def TESTri8  : X86Inst<"test", 0xF6, MRMS0r    , Arg8 >;          // flags = R8  & imm8
 def TESTri16 : X86Inst<"test", 0xF7, MRMS0r    , Arg16>, OpSize;  // flags = R16 & imm16
 def TESTri32 : X86Inst<"test", 0xF7, MRMS0r    , Arg32>;          // flags = R32 & imm32
+def TESTmi8  : X86Inst<"test", 0xF6, MRMS0m    , Arg8 >;          // flags = [mem8]  & imm8
+def TESTmi16 : X86Inst<"test", 0xF7, MRMS0m    , Arg16>, OpSize;  // flags = [mem16] & imm16
+def TESTmi32 : X86Inst<"test", 0xF7, MRMS0m    , Arg32>;          // flags = [mem32] & imm32
 
 // Shift instructions
 class UsesCL { list<Register> Uses = [CL]; bit printImplicitUses = 1; }




From criswell at cs.uiuc.edu  Tue Feb 17 09:50:00 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:50:00 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/
Message-ID: <200402171549.JAA20815@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Tue Feb 17 09:50:20 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:50:20 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/INPUT/
Message-ID: <200402171549.JAA20823@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/INPUT:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/INPUT added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Tue Feb 17 09:50:40 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:50:40 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/glob/
Message-ID: <200402171549.JAA20828@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/glob:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/glob added to the repository


---
Diffs of the changes:  (+0 -0)



From criswell at cs.uiuc.edu  Tue Feb 17 09:51:00 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:51:00 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/make-3.62/
Message-ID: <200402171549.JAA20831@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/make-3.62:


---
Log message:

Directory /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/make-3.62 added to the repository


---
Diffs of the changes:  (+0 -0)



From alkis at niobe.cs.uiuc.edu  Tue Feb 17 09:53:44 2004
From: alkis at niobe.cs.uiuc.edu (Alkis Evlogimenos)
Date: Tue Feb 17 09:53:44 2004
Subject: [llvm-commits] CVS: llvm/lib/Target/X86/X86RegisterInfo.cpp
Message-ID: <200402171550.i1HFop011534@niobe.cs.uiuc.edu>


Changes in directory llvm/lib/Target/X86:

X86RegisterInfo.cpp updated: 1.62 -> 1.63

---
Log message:

Align case statements.


---
Diffs of the changes:  (+32 -32)

Index: llvm/lib/Target/X86/X86RegisterInfo.cpp
diff -u llvm/lib/Target/X86/X86RegisterInfo.cpp:1.62 llvm/lib/Target/X86/X86RegisterInfo.cpp:1.63
--- llvm/lib/Target/X86/X86RegisterInfo.cpp:1.62	Tue Feb 17 09:48:42 2004
+++ llvm/lib/Target/X86/X86RegisterInfo.cpp	Tue Feb 17 09:50:41 2004
@@ -137,27 +137,27 @@
     case X86::MOVri8:  NI = MakeMIInst(X86::MOVmi8 , FrameIndex, MI); break;
     case X86::MOVri16: NI = MakeMIInst(X86::MOVmi16, FrameIndex, MI); break;
     case X86::MOVri32: NI = MakeMIInst(X86::MOVmi32, FrameIndex, MI); break;
-    case X86::MULr8:   NI = MakeMInst(X86::MULm8 , FrameIndex, MI); break;
-    case X86::MULr16:  NI = MakeMInst(X86::MULm16, FrameIndex, MI); break;
-    case X86::MULr32:  NI = MakeMInst(X86::MULm32, FrameIndex, MI); break;
-    case X86::DIVr8:   NI = MakeMInst(X86::DIVm8 , FrameIndex, MI); break;
-    case X86::DIVr16:  NI = MakeMInst(X86::DIVm16, FrameIndex, MI); break;
-    case X86::DIVr32:  NI = MakeMInst(X86::DIVm32, FrameIndex, MI); break;
-    case X86::IDIVr8:  NI = MakeMInst(X86::IDIVm8 , FrameIndex, MI); break;
-    case X86::IDIVr16: NI = MakeMInst(X86::IDIVm16, FrameIndex, MI); break;
-    case X86::IDIVr32: NI = MakeMInst(X86::IDIVm32, FrameIndex, MI); break;
-    case X86::NEGr8:   NI = MakeMInst(X86::NEGm8 , FrameIndex, MI); break;
-    case X86::NEGr16:  NI = MakeMInst(X86::NEGm16, FrameIndex, MI); break;
-    case X86::NEGr32:  NI = MakeMInst(X86::NEGm32, FrameIndex, MI); break;
-    case X86::NOTr8:   NI = MakeMInst(X86::NOTm8 , FrameIndex, MI); break;
-    case X86::NOTr16:  NI = MakeMInst(X86::NOTm16, FrameIndex, MI); break;
-    case X86::NOTr32:  NI = MakeMInst(X86::NOTm32, FrameIndex, MI); break;
-    case X86::INCr8:   NI = MakeMInst(X86::INCm8 , FrameIndex, MI); break;
-    case X86::INCr16:  NI = MakeMInst(X86::INCm16, FrameIndex, MI); break;
-    case X86::INCr32:  NI = MakeMInst(X86::INCm32, FrameIndex, MI); break;
-    case X86::DECr8:   NI = MakeMInst(X86::DECm8 , FrameIndex, MI); break;
-    case X86::DECr16:  NI = MakeMInst(X86::DECm16, FrameIndex, MI); break;
-    case X86::DECr32:  NI = MakeMInst(X86::DECm32, FrameIndex, MI); break;
+    case X86::MULr8:   NI = MakeMInst( X86::MULm8 ,  FrameIndex, MI); break;
+    case X86::MULr16:  NI = MakeMInst( X86::MULm16,  FrameIndex, MI); break;
+    case X86::MULr32:  NI = MakeMInst( X86::MULm32,  FrameIndex, MI); break;
+    case X86::DIVr8:   NI = MakeMInst( X86::DIVm8 ,  FrameIndex, MI); break;
+    case X86::DIVr16:  NI = MakeMInst( X86::DIVm16,  FrameIndex, MI); break;
+    case X86::DIVr32:  NI = MakeMInst( X86::DIVm32,  FrameIndex, MI); break;
+    case X86::IDIVr8:  NI = MakeMInst( X86::IDIVm8 , FrameIndex, MI); break;
+    case X86::IDIVr16: NI = MakeMInst( X86::IDIVm16, FrameIndex, MI); break;
+    case X86::IDIVr32: NI = MakeMInst( X86::IDIVm32, FrameIndex, MI); break;
+    case X86::NEGr8:   NI = MakeMInst( X86::NEGm8 ,  FrameIndex, MI); break;
+    case X86::NEGr16:  NI = MakeMInst( X86::NEGm16,  FrameIndex, MI); break;
+    case X86::NEGr32:  NI = MakeMInst( X86::NEGm32,  FrameIndex, MI); break;
+    case X86::NOTr8:   NI = MakeMInst( X86::NOTm8 ,  FrameIndex, MI); break;
+    case X86::NOTr16:  NI = MakeMInst( X86::NOTm16,  FrameIndex, MI); break;
+    case X86::NOTr32:  NI = MakeMInst( X86::NOTm32,  FrameIndex, MI); break;
+    case X86::INCr8:   NI = MakeMInst( X86::INCm8 ,  FrameIndex, MI); break;
+    case X86::INCr16:  NI = MakeMInst( X86::INCm16,  FrameIndex, MI); break;
+    case X86::INCr32:  NI = MakeMInst( X86::INCm32,  FrameIndex, MI); break;
+    case X86::DECr8:   NI = MakeMInst( X86::DECm8 ,  FrameIndex, MI); break;
+    case X86::DECr16:  NI = MakeMInst( X86::DECm16,  FrameIndex, MI); break;
+    case X86::DECr32:  NI = MakeMInst( X86::DECm32,  FrameIndex, MI); break;
     case X86::ADDrr8:  NI = MakeMRInst(X86::ADDmr8 , FrameIndex, MI); break;
     case X86::ADDrr16: NI = MakeMRInst(X86::ADDmr16, FrameIndex, MI); break;
     case X86::ADDrr32: NI = MakeMRInst(X86::ADDmr32, FrameIndex, MI); break;
@@ -190,12 +190,12 @@
     case X86::XORri8:  NI = MakeMIInst(X86::XORmi8 , FrameIndex, MI); break;
     case X86::XORri16: NI = MakeMIInst(X86::XORmi16, FrameIndex, MI); break;
     case X86::XORri32: NI = MakeMIInst(X86::XORmi32, FrameIndex, MI); break;
-    case X86::TESTrr8: NI = MakeMRInst(X86::TESTmr8 , FrameIndex, MI); break;
-    case X86::TESTrr16:NI = MakeMRInst(X86::TESTmr16, FrameIndex, MI); break;
-    case X86::TESTrr32:NI = MakeMRInst(X86::TESTmr32, FrameIndex, MI); break;
-    case X86::TESTri8: NI = MakeMIInst(X86::TESTmi8 , FrameIndex, MI); break;
-    case X86::TESTri16:NI = MakeMIInst(X86::TESTmi16, FrameIndex, MI); break;
-    case X86::TESTri32:NI = MakeMIInst(X86::TESTmi32, FrameIndex, MI); break;
+    case X86::TESTrr8: NI = MakeMRInst(X86::TESTmr8 ,FrameIndex, MI); break;
+    case X86::TESTrr16:NI = MakeMRInst(X86::TESTmr16,FrameIndex, MI); break;
+    case X86::TESTrr32:NI = MakeMRInst(X86::TESTmr32,FrameIndex, MI); break;
+    case X86::TESTri8: NI = MakeMIInst(X86::TESTmi8 ,FrameIndex, MI); break;
+    case X86::TESTri16:NI = MakeMIInst(X86::TESTmi16,FrameIndex, MI); break;
+    case X86::TESTri32:NI = MakeMIInst(X86::TESTmi32,FrameIndex, MI); break;
     case X86::CMPrr8:  NI = MakeMRInst(X86::CMPmr8 , FrameIndex, MI); break;
     case X86::CMPrr16: NI = MakeMRInst(X86::CMPmr16, FrameIndex, MI); break;
     case X86::CMPrr32: NI = MakeMRInst(X86::CMPmr32, FrameIndex, MI); break;
@@ -229,11 +229,11 @@
     case X86::XORrr8:  NI = MakeRMInst(X86::XORrm8 , FrameIndex, MI); break;
     case X86::XORrr16: NI = MakeRMInst(X86::XORrm16, FrameIndex, MI); break;
     case X86::XORrr32: NI = MakeRMInst(X86::XORrm32, FrameIndex, MI); break;
-    case X86::TESTrr8: NI = MakeRMInst(X86::TESTrm8 , FrameIndex, MI); break;
-    case X86::TESTrr16:NI = MakeRMInst(X86::TESTrm16, FrameIndex, MI); break;
-    case X86::TESTrr32:NI = MakeRMInst(X86::TESTrm32, FrameIndex, MI); break;
-    case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16, FrameIndex, MI); break;
-    case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32, FrameIndex, MI); break;
+    case X86::TESTrr8: NI = MakeRMInst(X86::TESTrm8 ,FrameIndex, MI); break;
+    case X86::TESTrr16:NI = MakeRMInst(X86::TESTrm16,FrameIndex, MI); break;
+    case X86::TESTrr32:NI = MakeRMInst(X86::TESTrm32,FrameIndex, MI); break;
+    case X86::IMULrr16:NI = MakeRMInst(X86::IMULrm16,FrameIndex, MI); break;
+    case X86::IMULrr32:NI = MakeRMInst(X86::IMULrm32,FrameIndex, MI); break;
     case X86::IMULrri16: NI = MakeRMIInst(X86::IMULrmi16, FrameIndex, MI);break;
     case X86::IMULrri32: NI = MakeRMIInst(X86::IMULrmi32, FrameIndex, MI);break;
     case X86::CMPrr8:  NI = MakeRMInst(X86::CMPrm8 , FrameIndex, MI); break;




From criswell at cs.uiuc.edu  Tue Feb 17 09:54:08 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:54:08 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile
Message-ID: <200402171551.JAA20928@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench:

Makefile updated: 1.1 -> 1.2

---
Log message:

Added the GNU Make benchmark.



---
Diffs of the changes:  (+1 -1)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile
diff -u llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile:1.1 llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile:1.2
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile:1.1	Mon Feb 16 17:44:03 2004
+++ llvm/test/Programs/MultiSource/Benchmarks/MallocBench/Makefile	Tue Feb 17 09:50:58 2004
@@ -1,3 +1,3 @@
 LEVEL = ../../../../..
-PARALLEL_DIRS  := p2c
+PARALLEL_DIRS  := p2c make
 include $(LEVEL)/test/Programs/Makefile.programs




From criswell at cs.uiuc.edu  Tue Feb 17 09:54:31 2004
From: criswell at cs.uiuc.edu (John Criswell)
Date: Tue Feb 17 09:54:31 2004
Subject: [llvm-commits] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/LICENSE.TXT Makefile ar.c arscan.c commands.c commands.h default.c dep.h dir.c expand.c file.c file.h function.c implicit.c job.c job.h load.c main.c make.h misc.c read.c remake.c remote-stub.c remote.c rule.c rule.h variable.c variable.h version.c vpath.c
Message-ID: <200402171550.JAA20914@choi.cs.uiuc.edu>


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make:

LICENSE.TXT added (r1.1)
Makefile added (r1.1)
ar.c added (r1.1)
arscan.c added (r1.1)
commands.c added (r1.1)
commands.h added (r1.1)
default.c added (r1.1)
dep.h added (r1.1)
dir.c added (r1.1)
expand.c added (r1.1)
file.c added (r1.1)
file.h added (r1.1)
function.c added (r1.1)
implicit.c added (r1.1)
job.c added (r1.1)
job.h added (r1.1)
load.c added (r1.1)
main.c added (r1.1)
make.h added (r1.1)
misc.c added (r1.1)
read.c added (r1.1)
remake.c added (r1.1)
remote-stub.c added (r1.1)
remote.c added (r1.1)
rule.c added (r1.1)
rule.h added (r1.1)
variable.c added (r1.1)
variable.h added (r1.1)
version.c added (r1.1)
vpath.c added (r1.1)

---
Log message:

Commit of GNU Make Malloc Benchmark.



---
Diffs of the changes:  (+13068 -0)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/LICENSE.TXT
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/LICENSE.TXT:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/LICENSE.TXT	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,10 ----
+ make - Part of the Malloc Benchmark Suite
+ -------------------------------------------------------------------------------
+ All files are licensed under the LLVM license with the following additions:
+ 
+ These files are licensed to you under the GNU General Public License (version
+ 2).  Redistribution must follow the additional restrictions required by
+ the GPL.
+ 
+ Please see individiual files for additional copyright information.
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/Makefile
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/Makefile:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/Makefile	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,9 ----
+ LEVEL = ../../../../../..
+ PROG = make
+ CPPFLAGS += -DHAVE_SIGLIST -DNO_LDAV
+ Source=commands.c job.c dir.c file.c load.c misc.c main.c read.c \
+        remake.c remote.c rule.c implicit.c default.c variable.c expand.c \
+        function.c vpath.c version.c arscan.c ar.c
+ 
+ RUN_OPTIONS = -n -f $(BUILD_SRC_DIR)/INPUT/GNUmakefile.make USEROPT=BWGC VPATH=$(BUILD_SRC_DIR)
+ include ../../../Makefile.multisrc


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/ar.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/ar.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/ar.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,172 ----
+ /* Copyright (C) 1988-1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "make.h"
+ #include "file.h"
+ 
+ 
+ /* Defined in arscan.c.  */
+ extern long int ar_scan ();
+ extern int ar_member_touch ();
+ extern int ar_name_equal ();
+ 
+ 
+ /* Return nonzero if NAME is an archive-member reference, zero if not.
+    An archive-member reference is a name like `lib(member)'.
+    If a name like `lib((entry))' is used, a fatal error is signaled at
+    the attempt to use this unsupported feature.  */
+ 
+ int
+ ar_name (name)
+      char *name;
+ {
+   char *p = index (name, '('), *end = name + strlen (name) - 1;
+   
+   if (p == 0 || p == name || *end != ')')
+     return 0;
+ 
+   if (p[1] == '(' && end[-1] == ')')
+     fatal ("attempt to use unsupported feature: `%s'", name);
+ 
+   return 1;
+ }
+ 
+ 
+ /* Parse the archive-member reference NAME into the archive and member names.
+    Put the malloc'd archive name in *ARNAME_P if ARNAME_P is non-nil;
+    put the malloc'd member name in *MEMNAME_P if MEMNAME_P is non-nil.  */
+ 
+ void
+ ar_parse_name (name, arname_p, memname_p)
+      char *name, **arname_p, **memname_p;
+ {
+   char *p = index (name, '('), *end = name + strlen (name) - 1;
+ 
+   if (arname_p != 0)
+     *arname_p = savestring (name, p - name);
+ 
+   if (memname_p != 0)
+     *memname_p = savestring (p + 1, end - (p + 1));
+ }  
+ 
+ static long int ar_member_date_1 ();
+ 
+ /* Return the modtime of NAME.  */
+ 
+ time_t
+ ar_member_date (name)
+      char *name;
+ {
+   char *arname;
+   int arname_used = 0;
+   char *memname;
+   long int val;
+ 
+   ar_parse_name (name, &arname, &memname);
+ 
+   /* Make sure we know the modtime of the archive itself because
+      we are likely to be called just before commands to remake a
+      member are run, and they will change the archive itself.  */
+   {
+     struct file *arfile;
+     arfile = lookup_file (arname);
+     if (arfile == 0)
+       {
+ 	arfile = enter_file (arname);
+ 	arname_used = 1;
+       }
+ 
+     (void) f_mtime (arfile, 0);
+   }
+ 
+   val = ar_scan (arname, ar_member_date_1, (long int) memname);
+ 
+   if (!arname_used)
+     free (arname);
+   free (memname);
+ 
+   return (val <= 0 ? (time_t) -1 : (time_t) val);
+ }
+ 
+ /* This function is called by `ar_scan' to find which member to look at.  */
+ 
+ /* ARGSUSED */
+ static long int
+ ar_member_date_1 (desc, mem, hdrpos, datapos, size, date, uid, gid, mode, name)
+      int desc;
+      char *mem;
+      long int hdrpos, datapos, size, date;
+      int uid, gid, mode;
+      char *name;
+ {
+   return ar_name_equal (name, mem) ? date : 0;
+ }
+ 
+ /* Set the archive-member NAME's modtime to now.  */
+ 
+ int
+ ar_touch (name)
+      char *name;
+ {
+   char *arname, *memname;
+   int arname_used = 0;
+   register int val;
+ 
+   ar_parse_name (name, &arname, &memname);
+ 
+   /* Make sure we know the modtime of the archive itself before we
+      touch the member, since this will change the archive itself.  */
+   {
+     struct file *arfile;
+     arfile = lookup_file (arname);
+     if (arfile == 0)
+       {
+ 	arfile = enter_file (arname);
+ 	arname_used = 1;
+       }
+ 
+     (void) f_mtime (arfile, 0);
+   }
+ 
+   val = 1;
+   switch (ar_member_touch (arname, memname))
+     {
+     case -1:
+       error ("touch: Archive `%s' does not exist", arname);
+       break;
+     case -2:
+       error ("touch: `%s' is not a valid archive", arname);
+       break;
+     case -3:
+       perror_with_name ("touch: ", arname);
+       break;
+     case 1:
+       error ("touch: Member `%s' does not exist in `%s'", memname, arname);
+       break;
+     case 0:
+       val = 0;
+       break;
+     default:
+       error ("touch: Bad return code from ar_member_touch on `%s'", name);
+     }
+ 
+   if (!arname_used)
+     free (arname);
+   free (memname);
+ 
+   return val;
+ }


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/arscan.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/arscan.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/arscan.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,477 ----
+ /* Library function for scanning an archive file.
+    Copyright (C) 1987, 1989, 1991 Free Software Foundation, Inc.
+ 
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2, or (at your option)
+    any later version.
+ 
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+ 
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ /* On the sun386i and in System V rel 3, ar.h defines two different archive
+    formats depending upon whether you have defined PORTAR (normal) or PORT5AR
+    (System V Release 1).  There is no default, one or the other must be defined
+    to have a nonzero value.  */
+ 
+ #if (defined(sun386) || defined(USGr3) || defined(HPUX) \
+      && !defined(PORTAR) && !defined(PORT5AR))
+ #define PORTAR 1
+ #endif
+ 
+ #include <ar.h>
+ #include <stdio.h>
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ 
+ #if	defined (USG) || defined (POSIX)
+ #include <fcntl.h>
+ #else
+ #include <sys/file.h>
+ #endif
+ 
+ #if	(defined (STDC_HEADERS) || defined (__GNU_LIBRARY__) \
+ 	 || defined (POSIX))
+ #include <stdlib.h>
+ #include <string.h>
+ #define	ANSI_STRING
+ #else	/* No standard headers.  */
+ 
+ #ifdef	USG
+ 
+ #include <string.h>
+ #include <memory.h>
+ #define	ANSI_STRING
+ 
+ #else	/* Not USG.  */
+ #include <strings.h>
+ 
+ #ifndef	bcmp
+ extern int bcmp ();
+ #endif
+ #ifndef	bzero
+ extern void bzero ();
+ #endif
+ #ifndef	bcopy
+ extern void bcopy ();
+ #endif
+ 
+ #endif	/* USG.  */
+ 
+ extern char *malloc (), *realloc ();
+ extern void free ();
+ 
+ #endif	/* Standard headers.  */
+ 
+ #ifdef	ANSI_STRING
+ #define	index(s, c)	strchr((s), (c))
+ #define	rindex(s, c)	strrchr((s), (c))
+ 
+ #define bcmp(s1, s2, n)	memcmp ((s1), (s2), (n))
+ #define bzero(s, n)	memset ((s), 0, (n))
+ #define bcopy(s, d, n)	memcpy ((d), (s), (n))
+ #endif	ANSI_STRING
+ #undef	ANSI_STRING
+ 
+ 
+ #ifndef	AIAMAG
+ #if	(defined(APOLLO) || defined(HPUX) || defined(hpux) || \
+ 	 (PORTAR == 1 && (defined(USGr3) || defined(u3b2) || defined(sun386))))
+ #define	AR_NAMELEN	14
+ #define	AR_TRAILING_SLASH	/* Member names have a trailing slash.  */
+ #else
+ #define	AR_NAMELEN	15
+ #endif
+ #else	/* AIX.  */
+ #define	AR_NAMELEN	255
+ #endif
+ 
+ #if	defined(__GNU_LIBRARY__) || defined(POSIX) || defined(_IBMR2)
+ #include <unistd.h>
+ #else
+ extern int read (), open (), close (), write (), fstat ();
+ extern long int lseek (), atol ();
+ extern int atoi ();
+ #endif
+ 
+ /* Takes three arguments ARCHIVE, FUNCTION and ARG.
+ 
+    Open the archive named ARCHIVE, find its members one by one,
+    and for each one call FUNCTION with the following arguments:
+      archive file descriptor for reading the data,
+      member name,
+      member header position in file,
+      member data position in file,
+      member data size,
+      member date,
+      member uid,
+      member gid,
+      member protection mode,
+      ARG.
+ 
+    The descriptor is poised to read the data of the member
+    when FUNCTION is called.  It does not matter how much
+    data FUNCTION reads.
+ 
+    If FUNCTION returns nonzero, we immediately return
+    what FUNCTION returned.
+ 
+    Returns -1 if archive does not exist,
+    Returns -2 if archive has invalid format.
+    Returns 0 if have scanned successfully.  */
+ 
+ long int
+ ar_scan (archive, function, arg)
+      char *archive;
+      long int (*function) ();
+      long int arg;
+ {
+ #ifdef AIAMAG
+   FL_HDR fl_header;
+ #endif
+   register int desc = open (archive, O_RDONLY, 0);
+   if (desc < 0)
+     return -1;
+ #ifdef SARMAG
+   {
+     char buf[SARMAG];
+     register int nread = read (desc, buf, SARMAG);
+     if (nread != SARMAG || bcmp (buf, ARMAG, SARMAG))
+       {
+ 	(void) close (desc);
+ 	return -2;
+       }
+   }
+ #else
+ #ifdef AIAMAG
+   {
+     register int nread = read (desc, &fl_header, FL_HSZ);
+     if (nread != FL_HSZ || bcmp (fl_header.fl_magic, AIAMAG, SAIAMAG))
+       {
+ 	(void) close (desc);
+ 	return -2;
+       }
+   }
+ #else
+   {
+ #ifndef M_XENIX
+     int buf;
+ #else
+     unsigned short int buf;
+ #endif
+     register int nread = read(desc, &buf, sizeof (buf));
+     if (nread != sizeof (buf) || buf != ARMAG)
+       {
+ 	(void) close (desc);
+ 	return -2;
+       }
+   }
+ #endif
+ #endif
+ 
+   /* Now find the members one by one.  */
+   {
+ #ifdef SARMAG
+     register long int member_offset = SARMAG;
+ #else
+ #ifdef AIAMAG
+     long int member_offset;
+     long int last_member_offset;
+ 
+     sscanf (fl_header.fl_fstmoff, "%12ld", &member_offset);
+     sscanf (fl_header.fl_lstmoff, "%12ld", &last_member_offset);
+ #else
+ #ifndef	M_XENIX
+     register long int member_offset = sizeof (int);
+ #else	/* Xenix.  */
+     register long int member_offset = sizeof (unsigned short int);
+ #endif	/* Not Xenix.  */
+ #endif
+ #endif
+ 
+     while (1)
+       {
+ 	register int nread;
+ 	struct ar_hdr member_header;
+ #ifdef AIAMAG
+ 	char name[AR_NAMELEN + 1];
+ 	int name_len;
+ 	long int dateval;
+ 	int uidval, gidval;
+ 	long int data_offset;
+ #else
+ 	char name[sizeof member_header.ar_name + 1];
+ #endif
+ 	long int eltsize;
+ 	int eltmode;
+ 	long int fnval;
+ 
+ 	if (lseek (desc, member_offset, 0) < 0)
+ 	  {
+ 	    (void) close (desc);
+ 	    return -2;
+ 	  }
+ 
+ #ifdef AIAMAG
+ #define	AR_MEMHDR	\
+ 	(sizeof (member_header) - sizeof (member_header._ar_name))
+ 	nread = read (desc, (char *) &member_header, AR_MEMHDR);
+ 
+ 	if (nread != AR_MEMHDR)
+ 	  {
+ 	    (void) close (desc);
+ 	    return -2;
+ 	  }
+ 
+ 	sscanf (member_header.ar_namlen, "%4d", &name_len);
+ 	nread = read (desc, name, name_len);
+ 
+ 	if (nread != name_len)
+ 	  {
+ 	    (void) close (desc);
+ 	    return -2;
+ 	  }
+ 	
+ 	name[name_len] = 0;
+ 
+ 	sscanf (member_header.ar_date, "%12ld", &dateval);
+ 	sscanf (member_header.ar_uid, "%12d", &uidval);
+ 	sscanf (member_header.ar_gid, "%12d", &gidval);
+ 	sscanf (member_header.ar_mode, "%12o", &eltmode);
+ 	sscanf (member_header.ar_size, "%12ld", &eltsize);
+ 
+ 	if ((data_offset = member_offset + AR_MEMHDR + name_len + 2) % 2)
+ 	    ++data_offset;
+ 
+ 	fnval =
+ 	  (*function) (desc, name, member_offset, data_offset, eltsize,
+ 		       dateval, uidval, gidval,
+ 		       eltmode, arg);
+ 
+ #else
+ 	nread = read (desc, (char *) &member_header, sizeof (struct ar_hdr));
+ 	if (nread == 0)
+ 	  /* No data left means end of file; that is OK.  */
+ 	  break;
+ 
+ 	if (nread != sizeof (member_header)
+ #ifdef ARFMAG
+ 	    || bcmp (member_header.ar_fmag, ARFMAG, 2)
+ #endif
+ 	    )
+ 	  {
+ 	    (void) close (desc);
+ 	    return -2;
+ 	  }
+ 
+ 	bcopy (member_header.ar_name, name, sizeof member_header.ar_name);
+ 	{
+ 	  register char *p = name + sizeof member_header.ar_name;
+ 	  while (p > name && *--p == ' ')
+ 	    *p = '\0';
+ #ifdef	AR_TRAILING_SLASH
+ 	  if (*p == '/')
+ 	    *p = '\0';
+ #endif
+ 	}
+ 
+ #ifndef	M_XENIX
+ 	sscanf (member_header.ar_mode, "%o", &eltmode);
+ 	eltsize = atol (member_header.ar_size);
+ #else	/* Xenix.  */
+ 	eltmode = (unsigned short int) member_header.ar_mode;
+ 	eltsize = member_header.ar_size;
+ #endif	/* Not Xenix.  */
+ 
+ 	fnval =
+ 	  (*function) (desc, name, member_offset,
+ 		       member_offset + sizeof (member_header), eltsize,
+ #ifndef	M_XENIX
+ 		       atol (member_header.ar_date),
+ 		       atoi (member_header.ar_uid),
+ 		       atoi (member_header.ar_gid),
+ #else	/* Xenix.  */
+ 		       member_header.ar_date,
+ 		       member_header.ar_uid,
+ 		       member_header.ar_gid,
+ #endif	/* Not Xenix.  */
+ 		       eltmode, arg);
+ 
+ #endif  /* Not AIAMAG */
+ 
+ 	if (fnval)
+ 	  {
+ 	    (void) close (desc);
+ 	    return fnval;
+ 	  }
+ 
+ #ifdef AIAMAG
+ 	if (member_offset == last_member_offset) /* end of chain? */
+ 	    break;
+ 
+ 	sscanf (member_header.ar_nxtmem, "%12ld", &member_offset);
+ 
+ 	if (lseek (desc, member_offset, 0) != member_offset)
+ 	  {
+ 	    (void) close (desc);
+ 	    return -2;
+ 	  }
+ #else
+ 	member_offset += sizeof (member_header) + eltsize;
+ 	if (member_offset & 1) member_offset++;
+ #endif
+       }
+   }
+ 
+   close (desc);
+   return 0;
+ }
+ 
+ /* Return nonzero iff NAME matches MEM.  If NAME is longer than
+    sizeof (struct ar_hdr.ar_name), MEM may be the truncated version.  */
+ 
+ int
+ ar_name_equal (name, mem)
+      char *name, *mem;
+ {
+   char *p;
+ 
+   p = rindex (name, '/');
+   if (p != 0)
+     name = p + 1;
+ 
+ #ifndef	APOLLO
+ 
+   if (!strncmp (name, mem, AR_NAMELEN))
+     return 1;
+ 
+   if (!strncmp (name, mem, AR_NAMELEN - 2))
+     {
+       unsigned int namelen, memlen;
+ 
+       namelen = strlen (name);
+       memlen = strlen (mem);
+ 
+       if (memlen == AR_NAMELEN
+ 	  && mem[AR_NAMELEN - 2] == '.' && mem[AR_NAMELEN - 1] == 'o'
+ 	  && name[namelen - 2] == '.' && name[namelen -1] == 'o')
+ 	return 1;
+     }
+   return 0;
+ 
+ #else	/* APOLLO.  */
+   return !strcmp (name, mem);
+ #endif
+ }
+ 
+ /* ARGSUSED */
+ static long int
+ ar_member_pos (desc, mem, hdrpos, datapos, size, date, uid, gid, mode, name)
+      int desc;
+      char *mem;
+      long int hdrpos, datapos, size, date;
+      int uid, gid, mode;
+      char *name;
+ {
+   if (!ar_name_equal (name, mem))
+     return 0;
+   return hdrpos;
+ }
+ 
+ /* Set date of member MEMNAME in archive ARNAME to current time.
+    Returns 0 if successful,
+    -1 if file ARNAME does not exist,
+    -2 if not a valid archive,
+    -3 if other random system call error (including file read-only),
+    1 if valid but member MEMNAME does not exist.  */
+ 
+ int
+ ar_member_touch (arname, memname)
+      char *arname, *memname;
+ {
+   register long int pos = ar_scan (arname, ar_member_pos, (long int) memname);
+   register int fd;
+   struct ar_hdr ar_hdr;
+   register int i;
+   extern int errno;
+   struct stat statbuf;
+ 
+   if (pos < 0)
+     return (int) pos;
+   if (!pos)
+     return 1;
+ 
+   fd = open (arname, O_RDWR, 0666);
+   if (fd < 0)
+     return -3;
+   /* Read in this member's header */
+   if (lseek (fd, pos, 0) < 0)
+     goto lose;
+   if (sizeof ar_hdr != read (fd, (char *) &ar_hdr, sizeof ar_hdr))
+     goto lose;
+   /* Write back the header, thus touching the archive file.  */
+   if (lseek (fd, pos, 0) < 0)
+     goto lose;
+   if (sizeof ar_hdr != write (fd, (char *) &ar_hdr, sizeof ar_hdr))
+     goto lose;
+   /* The file's mtime is the time we we want.  */
+   fstat (fd, &statbuf);
+ #if defined(ARFMAG) || defined(AIAMAG)
+   /* Advance member's time to that time */
+   for (i = 0; i < sizeof ar_hdr.ar_date; i++)
+     ar_hdr.ar_date[i] = ' ';
+   sprintf (ar_hdr.ar_date, "%ld", (long int) statbuf.st_mtime);
+ #ifdef AIAMAG
+   ar_hdr.ar_date[strlen(ar_hdr.ar_date)] = ' ';
+ #endif
+ #else
+   ar_hdr.ar_date = statbuf.st_mtime;
+ #endif
+   /* Write back this member's header */
+   if (lseek (fd, pos, 0) < 0)
+     goto lose;
+   if (sizeof ar_hdr != write (fd, (char *) &ar_hdr, sizeof ar_hdr))
+     goto lose;
+   close (fd);
+   return 0;
+ 
+  lose:
+   i = errno;
+   close (fd);
+   errno = i;
+   return -3;
+ }
+ 
+ #ifdef TEST
+ 
+ long int
+ describe_member (desc, name, hdrpos, datapos, size, date, uid, gid, mode)
+      int desc;
+      char *name;
+      long int hdrpos, datapos, size, date;
+      int uid, gid, mode;
+ {
+   extern char *ctime ();
+ 
+   printf ("Member %s: %ld bytes at %ld (%ld).\n", name, size, hdrpos, datapos);
+   printf ("  Date %s", ctime (&date));
+   printf ("  uid = %d, gid = %d, mode = 0%o.\n", uid, gid, mode);
+ 
+   return 0;
+ }
+ 
+ main (argc, argv)
+      int argc;
+      char **argv;
+ {
+   ar_scan (argv[1], describe_member);
+   return 0;
+ }
+ 
+ #endif	/* TEST.  */


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,478 ----
+ /* Command processing for GNU Make.
+ Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "make.h"
+ #include "dep.h"
+ #include "commands.h"
+ #include "file.h"
+ #include "variable.h"
+ #include "job.h"
+ 
+ extern int remote_kill ();
+ 
+ #if	!defined(POSIX) && !defined(__GNU_LIBRARY__)
+ extern int getpid ();
+ #endif
+ 
+ /* Set FILE's automatic variables up.  */
+ 
+ static void
+ set_file_variables (file)
+      register struct file *file;
+ {
+   register char *p;
+   char *at, *percent, *star, *less;
+ 
+ #define	DEFINE_VARIABLE(name, len, value) \
+   (void) define_variable_for_file (name, len, value, o_automatic, 0, file)
+ 
+ #ifndef	NO_ARCHIVES
+   /* If the target is an archive member `lib(member)',
+      then $@ is `lib' and $% is `member'.  */
+ 
+   if (ar_name (file->name))
+     {
+       p = index (file->name, '(');
+       at = savestring (file->name, p - file->name);
+       ++p;
+       percent = savestring (p, strlen (p) - 1);
+     }
+   else
+ #endif	/* NO_ARCHIVES.  */
+     {
+       at = savestring (file->name, strlen (file->name));
+       percent = "";
+     }
+ 
+   DEFINE_VARIABLE ("@", 1, at);
+   DEFINE_VARIABLE ("%", 1, percent);
+ 
+ #define	LASTSLASH(s)	rindex ((s), '/')
+ #define	FILEONLY(s)	(p != 0 ? p + 1 : (s))
+ #define	DIRONLY(s)	(p == 0 ? "./" : p == (s) ? "/" \
+ 			 : savestring ((s), (p - (s)) + 1))
+ 
+   /* $* is the stem from an implicit or static pattern rule.  */
+   if (file->stem == 0)
+     {
+       /* In Unix make, $* is set to the target name with
+ 	 any suffix in the .SUFFIXES list stripped off for
+ 	 explicit rules.  We store this in the `stem' member.  */
+       register struct dep *d;
+       for (d = enter_file (".SUFFIXES")->deps; d != 0; d = d->next)
+ 	{
+ 	  unsigned int len = strlen (file->name);
+ 	  unsigned int slen = strlen (dep_name (d));
+ 	  if (len > slen && streq (dep_name (d), file->name + len - slen))
+ 	    {
+ 	      file->stem = savestring (file->name, len - slen);
+ 	      break;
+ 	    }
+ 	}
+       if (d == 0)
+ 	file->stem = "";
+     }
+   star = file->stem;
+ 
+   DEFINE_VARIABLE ("*", 1, star);
+ 
+   /* $< is the first dependency.  */
+   less = file->deps != 0 ? dep_name (file->deps) : "";
+ 
+   if (file->cmds == default_file->cmds)
+     /* This file got its commands from .DEFAULT.
+        In this case $< is the same as $@.  */
+     less = at;
+ 
+   DEFINE_VARIABLE ("<", 1, less);
+ 
+   /* Set up the D and F versions.  */
+   p = LASTSLASH (at);
+   DEFINE_VARIABLE ("@D", 2, DIRONLY (at));
+   DEFINE_VARIABLE ("@F", 2, FILEONLY (at));
+   p = LASTSLASH (star);
+   DEFINE_VARIABLE ("*D", 2, DIRONLY (star));
+   DEFINE_VARIABLE ("*F", 2, FILEONLY (star));
+   p = LASTSLASH (less);
+   DEFINE_VARIABLE ("<D", 2, DIRONLY (less));
+   DEFINE_VARIABLE ("<F", 2, FILEONLY (less));
+   p = LASTSLASH (percent);
+   DEFINE_VARIABLE ("%D", 2, DIRONLY (percent));
+   DEFINE_VARIABLE ("%F", 2, FILEONLY (percent));
+ 
+   /* Compute the values for $^ and $? and their F and D versions.  */
+ 
+   {
+     register unsigned int caret_len, qmark_len;
+     char *caret_value, *caretD_value, *caretF_value;
+     register char *cp, *cDp, *cFp;
+     char *qmark_value, *qmarkD_value, *qmarkF_value;
+     register char *qp, *qDp, *qFp;
+     register struct dep *d;
+     unsigned int len;
+ 
+     caret_len = qmark_len = 0;
+     for (d = file->deps; d != 0; d = d->next)
+       {
+ 	register unsigned int i = strlen (dep_name (d)) + 1;
+ 	caret_len += i;
+ 	if (d->changed)
+ 	  qmark_len += i;
+       }
+ 
+     len = caret_len == 0 ? 1 : caret_len;
+     cp = caret_value = (char *) xmalloc (len);
+     cDp = caretD_value = (char *) xmalloc (len);
+     cFp = caretF_value = (char *) xmalloc (len);
+     len = qmark_len == 0 ? 1 : qmark_len;
+     qp = qmark_value = (char *) xmalloc (len);
+     qDp = qmarkD_value = (char *) xmalloc (len);
+     qFp = qmarkF_value = (char *) xmalloc (len);
+ 
+     for (d = file->deps; d != 0; d = d->next)
+       {
+ 	char *c, *cD, *cF;
+ 	unsigned int Dlen, Flen;
+ 
+ 	c = dep_name (d);
+ 	len = strlen (c);
+ 	bcopy (c, cp, len);
+ 	cp += len;
+ 	*cp++ = ' ';
+ 
+ 	p = LASTSLASH (c);
+ 	if (p == 0)
+ 	  {
+ 	    cF = c;
+ 	    Flen = len;
+ 	    cD = "./";
+ 	    Dlen = 2;
+ 	  }
+ 	else if (p == c)
+ 	  {
+ 	    cD = c;
+ 	    Dlen = 1;
+ 	    cF = c + 1;
+ 	    Flen = len - 1;
+ 	  }
+ 	else
+ 	  {
+ 	    cF = p + 1;
+ 	    Flen = len - (p + 1 - c);
+ 	    cD = c;
+ 	    Dlen = p - c;
+ 	  }
+ 	bcopy (cD, cDp, Dlen);
+ 	cDp += Dlen;
+ 	*cDp++ = ' ';
+ 	bcopy (cF, cFp, Flen);
+ 	cFp += Flen;
+ 	*cFp++ = ' ';
+ 
+ 	if (d->changed)
+ 	  {
+ 	    bcopy (c, qp, len);
+ 	    qp += len;
+ 	    *qp++ = ' ';
+ 	    bcopy (cD, qDp, Dlen);
+ 	    qDp += Dlen;
+ 	    *qDp++ = ' ';
+ 	    bcopy (cF, qFp, Flen);
+ 	    qFp += Flen;
+ 	    *qFp++ = ' ';
+ 	  }
+       }
+ 
+     /* Kill the last spaces and define the variables.  */
+ 
+     cp[cp > caret_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("^", 1, caret_value);
+     cDp[cDp > caretD_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("^D", 2, caretD_value);
+     cFp[cFp > caretF_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("^F", 2, caretF_value);
+ 
+     qp[qp > qmark_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("?", 1, qmark_value);
+     qDp[qDp > qmarkD_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("?D", 2, qmarkD_value);
+     qFp[qFp > qmarkF_value ? -1 : 0] = '\0';
+     DEFINE_VARIABLE ("?F", 2, qmarkF_value);
+   }
+ 
+ #undef	LASTSLASH
+ #undef	FILEONLY
+ #undef	DIRONLY
+ 
+ #undef	DEFINE_VARIABLE
+ }
+ 
+ /* Chop CMDS up into individual command lines if necessary.  */
+ 
+ void
+ chop_commands (cmds)
+      register struct commands *cmds;
+ {
+   if (cmds != 0 && cmds->command_lines == 0)
+     {
+       /* Chop CMDS->commands up into lines in CMDS->command_lines.
+ 	 Also set the corresponding CMDS->lines_recurse elements,
+ 	 and the CMDS->any_recurse flag.  */
+       register char *p;
+       unsigned int nlines, idx;
+       char **lines;
+ 
+       nlines = 5;
+       lines = (char **) xmalloc (5 * sizeof (char *));
+       idx = 0;
+       p = cmds->commands;
+       while (*p != '\0')
+ 	{
+ 	  char *end = p;
+ 	find_end:;
+ 	  end = index (end, '\n');
+ 	  if (end == 0)
+ 	    end = p + strlen (p);
+ 	  else if (end > p && end[-1] == '\\')
+ 	    {
+ 	      int backslash = 1;
+ 	      register char *b;
+ 	      for (b = end - 2; b >= p && *b == '\\'; --b)
+ 		backslash = !backslash;
+ 	      if (backslash)
+ 		{
+ 		  ++end;
+ 		  goto find_end;
+ 		}
+ 	    }
+ 
+ 	  if (idx == nlines)
+ 	    {
+ 	      nlines += 2;
+ 	      lines = (char **) xrealloc ((char *) lines,
+ 					  nlines * sizeof (char *));
+ 	    }
+ 	  lines[idx++] = savestring (p, end - p);
+ 	  p = end;
+ 	  if (*p != '\0')
+ 	    ++p;
+ 	}
+ 
+       if (idx != nlines)
+ 	{
+ 	  nlines = idx;
+ 	  lines = (char **) xrealloc ((char *) lines,
+ 				      nlines * sizeof (char *));
+ 	}
+ 
+       cmds->ncommand_lines = nlines;
+       cmds->command_lines = lines;
+ 
+       cmds->any_recurse = 0;
+       cmds->lines_recurse = (char *) xmalloc (nlines);
+       for (idx = 0; idx < nlines; ++idx)
+ 	{
+ 	  unsigned int len;
+ 	  int recursive;
+ 	  p = lines[idx];
+ 	  len = strlen (p);
+ 	  recursive = (sindex (p, len, "$(MAKE)", 7) != 0
+ 		       || sindex (p, len, "${MAKE}", 7) != 0);
+ 	  cmds->lines_recurse[idx] = recursive;
+ 	  cmds->any_recurse |= recursive;
+ 	}
+     }
+ }
+ 
+ /* Execute the commands to remake FILE.  If they are currently executing,
+    return or have already finished executing, just return.  Otherwise,
+    fork off a child process to run the first command line in the sequence.  */
+ 
+ void
+ execute_file_commands (file)
+      struct file *file;
+ {
+   register char *p;
+ 
+   /* Don't go through all the preparations if
+      the commands are nothing but whitespace.  */
+ 
+   for (p = file->cmds->commands; *p != '\0'; ++p)
+     if (!isspace (*p) && *p != '-' && *p != '@')
+       break;
+   if (*p == '\0')
+     {
+       file->update_status = 0;
+       notice_finished_file (file);
+       return;
+     }
+ 
+   /* First set the automatic variables according to this file.  */
+ 
+   initialize_file_variables (file);
+ 
+   set_file_variables (file);
+ 
+   /* Start the commands running.  */
+   new_job (file);
+ }
+ 
+ #define	PROPAGATED_SIGNAL_MASK \
+   (sigmask (SIGTERM) | sigmask (SIGINT) | sigmask (SIGHUP) | sigmask (SIGQUIT))
+ 
+ /* Handle fatal signals.  */
+ 
+ int
+ fatal_error_signal (sig)
+      int sig;
+ {
+   signal (sig, SIG_DFL);
+ #ifndef USG
+   (void) sigsetmask (0);
+ #endif
+ 
+   /* A termination signal won't be sent to the entire
+      process group, but it means we want to kill the children.  */
+ 
+   if (sig == SIGTERM)
+     {
+       register struct child *c;
+       push_signals_blocked_p (1);
+       for (c = children; c != 0; c = c->next)
+ 	if (!c->remote)
+ 	  (void) kill (c->pid, SIGTERM);
+       pop_signals_blocked_p ();
+     }
+ 
+   /* If we got a signal that means the user
+      wanted to kill make, remove pending targets.  */
+ 
+   if (PROPAGATED_SIGNAL_MASK & sigmask (sig))
+     {
+       register struct child *c;
+       push_signals_blocked_p (1);
+ 
+       /* Remote children won't automatically get signals sent
+ 	 to the process group, so we must send them.  */
+       for (c = children; c != 0; c = c->next)
+ 	if (c->remote)
+ 	  (void) remote_kill (c->pid, sig);
+ 
+       for (c = children; c != 0; c = c->next)
+ 	delete_child_targets (c);
+ 
+       pop_signals_blocked_p ();
+ 
+       /* Clean up the children.  We don't just use the call below because
+ 	 we don't want to print the "Waiting for children" message.  */
+       wait_for_children (0, 0);
+     }
+   else
+     /* Wait for our children to die.  */
+     wait_for_children (0, 1);
+ 
+   /* Delete any non-precious intermediate files that were made.  */
+ 
+   remove_intermediates (1);
+ 
+   if (sig == SIGQUIT)
+     /* We don't want to send ourselves SIGQUIT, because it will
+        cause a core dump.  Just exit instead.  */
+     exit (1);
+ 
+   /* Signal the same code; this time it will really be fatal.  */
+   if (kill (getpid (), sig) < 0)
+     /* It shouldn't return, but if it does, die anyway.  */
+     pfatal_with_name ("kill");
+ 
+   return 0;
+ }
+ 
+ /* Delete all non-precious targets of CHILD unless they were already deleted.
+    Set the flag in CHILD to say they've been deleted.  */
+ 
+ void
+ delete_child_targets (child)
+      struct child *child;
+ {
+   struct stat st;
+   struct dep *d;
+ 
+   if (child->deleted)
+     return;
+ 
+   /* Delete the file unless it's precious.  */
+   if (!child->file->precious
+       && stat (child->file->name, &st) == 0
+       && S_ISREG (st.st_mode)
+       && (time_t) st.st_mtime != child->file->last_mtime)
+     {
+       error ("*** Deleting file `%s'", child->file->name);
+       if (unlink (child->file->name) < 0)
+ 	perror_with_name ("unlink: ", child->file->name);
+     }
+ 
+   /* Also remove any non-precious targets listed
+      in the `also_make' member.  */
+   for (d = child->file->also_make; d != 0; d = d->next)
+     if (!d->file->precious)
+       if (stat (d->file->name, &st) == 0
+ 	  && S_ISREG (st.st_mode)
+ 	  && (time_t) st.st_mtime != d->file->last_mtime)
+ 	{
+ 	  error ("*** [%s] Deleting file `%s'", child->file->name,
+ 		 d->file->name);
+ 	  if (unlink (d->file->name) < 0)
+ 	    perror_with_name ("unlink: ", d->file->name);
+ 	}
+ 
+   child->deleted = 1;
+ }
+ 
+ /* Print out the commands in CMDS.  */
+ 
+ void
+ print_commands (cmds)
+      register struct commands *cmds;
+ {
+   register char *s;
+ 
+   fputs ("#  commands to execute", stdout);
+ 
+   if (cmds->filename == 0)
+     puts (" (built-in):");
+   else
+     printf (" (from `%s', line %u):\n", cmds->filename, cmds->lineno);
+ 
+   s = cmds->commands;
+   while (*s != '\0')
+     {
+       char *end;
+ 
+       while (isspace (*s))
+ 	++s;
+ 
+       end = index (s, '\n');
+       if (end == 0)
+ 	end = s + strlen (s);
+ 
+       printf ("\t%.*s\n", end - s, s);
+ 
+       s = end;
+     }
+ }


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.h:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/commands.h	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,36 ----
+ /* Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ /* Structure that gives the commands to make a file
+    and information about where these commands came from.  */
+ 
+ struct commands
+   {
+     char *filename;		/* File that contains commands.  */
+     unsigned int lineno;	/* Line number in file.  */
+     char *commands;		/* Commands text.  */
+     unsigned int ncommand_lines;/* Number of command lines.  */
+     char **command_lines;	/* Commands chopped up into lines.  */
+     char *lines_recurse;	/* One flag for each line.  */
+     char any_recurse;		/* Nonzero if any `lines_recurse' elt is.  */
+   };
+ 
+ 
+ extern void execute_file_commands ();
+ extern void print_commands ();
+ extern void delete_child_targets ();
+ extern void chop_commands ();


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/default.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/default.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/default.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,323 ----
+ /* Data base of default implicit rules for GNU Make.
+ Copyright (C) 1988-1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "make.h"
+ #include "rule.h"
+ #include "dep.h"
+ #include "file.h"
+ #include "commands.h"
+ #include "variable.h"
+ 
+ 
+ /* This is the default list of suffixes for suffix rules.
+    `.s' must come last, so that a `.o' file will be made from
+    a `.c' or `.p' or ... file rather than from a .s file.  */
+ 
+ static char default_suffixes[]
+   = ".out .a .ln .o .c .cc .C .p .f .F .r .y .l .s .S \
+ .mod .sym .def .h .info .dvi .tex .texinfo .texi .cweb .web .sh .elc .el";
+ 
+ static struct pspec default_pattern_rules[] =
+   {
+     "(%)", "%",
+     "$(AR) $(ARFLAGS) $@ $<",
+ 
+     /* The X.out rules are only in BSD's default set because
+        BSD Make has no null-suffix rules, so `foo.out' and
+        `foo' are the same thing.  */
+     "%.out", "%",
+     "@rm -f $@ \n cp $< $@",
+ 
+     0, 0, 0
+   };
+ 
+ static struct pspec default_terminal_rules[] =
+   {
+     /* RCS.  */
+     "%", "%,v",
+     "test -f $@ || $(CO) $(COFLAGS) $< $@",
+     "%", "RCS/%,v",
+     "test -f $@ || $(CO) $(COFLAGS) $< $@",
+ 
+     /* SCCS.  */
+     "%", "s.%",
+     "$(GET) $(GFLAGS) $<",
+     "%", "SCCS/s.%",
+     "$(GET) $(GFLAGS) $<",
+ 
+     0, 0, 0
+   };
+ 
+ static char *default_suffix_rules[] =
+   {
+     ".o",
+     "$(LINK.o) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".s",
+     "$(LINK.s) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".S",
+     "$(LINK.S) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".c",
+     "$(LINK.c) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".cc",
+     "$(LINK.cc) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".C",
+     "$(LINK.C) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".f",
+     "$(LINK.f) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".p",
+     "$(LINK.p) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".F",
+     "$(LINK.F) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".r",
+     "$(LINK.r) $^ $(LOADLIBES) $(LDLIBS) -o $@",
+     ".mod",
+     "$(COMPILE.mod) -o $@ -e $@ $^",
+ 
+     ".def.sym", 
+     "$(COMPILE.def) -o $@ $<",
+ 
+     ".sh",
+     "cat $< >$@ \n chmod a+x $@",
+ 
+     ".s.o",
+ #if !defined(M_XENIX) || defined(__GNUC__)
+     "$(COMPILE.s) -o $@ $<",
+ #else	/* Xenix.  */
+     "$(COMPILE.s) -o$@ $<",
+ #endif	/* Not Xenix.  */
+     ".S.o",
+ #if !defined(M_XENIX) || defined(__GNUC__)
+     "$(COMPILE.S) -o $@ $<",
+ #else	/* Xenix.  */
+     "$(COMPILE.S) -o$@ $<",
+ #endif	/* Not Xenix.  */
+     ".c.o",
+     "$(COMPILE.c) $< $(OUTPUT_OPTION)",
+     ".cc.o",
+     "$(COMPILE.cc) $< $(OUTPUT_OPTION)",
+     ".C.o",
+     "$(COMPILE.C) $< $(OUTPUT_OPTION)",
+     ".f.o",
+     "$(COMPILE.f) $< $(OUTPUT_OPTION)",
+     ".p.o",
+     "$(COMPILE.p) $< $(OUTPUT_OPTION)",
+     ".F.o",
+     "$(COMPILE.F) $< $(OUTPUT_OPTION)",
+     ".r.o",
+     "$(COMPILE.r) $< $(OUTPUT_OPTION)",
+     ".mod.o",
+     "$(COMPILE.mod) -o $@ $<",
+ 
+     ".c.ln",
+     "$(LINT.c) -C$* $<",
+     ".y.ln",
+     "$(YACC.y) $< \n $(LINT.c) -C$* y.tab.c \n $(RM) y.tab.c",
+     ".l.ln",
+     "@$(RM) $*.c \n $(LEX.l) $< > $*.c \n\
+ $(LINT.c) -i $*.c -o $@ \n $(RM) $*.c",
+ 
+     ".y.c",
+     "$(YACC.y) $< \n mv -f y.tab.c $@",
+     ".l.c",
+     "@$(RM) $@ \n $(LEX.l) $< > $@",
+ 
+     ".F.f",
+     "$(PREPROCESS.F) $< $(OUTPUT_OPTION)",
+     ".r.f",
+     "$(PREPROCESS.r) $< $(OUTPUT_OPTION)",
+ 
+     /* This might actually make lex.yy.c if there's no %R%
+        directive in $*.l, but in that case why were you
+        trying to make $*.r anyway?  */
+     ".l.r",
+     "$(LEX.l) $< > $@ \n mv -f lex.yy.r $@",
+ 
+     ".S.s",
+     "$(PREPROCESS.S) $< > $@",
+ 
+     ".texinfo.info",
+     "$(MAKEINFO) $<",
+ 
+     ".texi.info",
+     "$(MAKEINFO) $<",
+ 
+     ".tex.dvi",
+     "$(TEX) $<",
+ 
+     ".texinfo.dvi",
+     "$(TEXI2DVI) $<",
+ 
+     ".texi.dvi",
+     "$(TEXI2DVI) $<",
+ 
+     ".cweb.c",
+     "$(CTANGLE) $<",
+ 
+     ".web.p",
+     "$(TANGLE) $<",
+ 
+     ".cweb.tex",
+     "$(CWEAVE) $<",
+ 
+     ".web.tex",
+     "$(WEAVE) $<",
+ 
+     0}
+ ;
+ 
+ static char *default_variables[] =
+   {
+     "AR", "ar",
+     "ARFLAGS", "rv",
+     "AS", "as",
+     "CC", "cc",
+     "C++", "g++",
+     "CO", "co",
+     "CPP", "$(CC) -E",
+     "FC", "f77",
+     /* System V uses these, so explicit rules using them should work.
+        However, there is no way to make implicit rules use them and FC.  */
+     "F77", "$(FC)",
+     "F77FLAGS", "$(FFLAGS)",
+ #ifdef	USG
+     "GET", "get",
+ #else
+     "GET", "/usr/sccs/get",
+ #endif
+     "LD", "ld",
+     "LEX", "lex",
+     "LINT", "lint",
+     "M2C", "m2c",
+ #ifdef	pyr
+     "PC", "pascal",
+ #else
+     "PC", "pc",
+ #endif
+     "YACC", "yacc",	/* Or "bison -y"  */
+     "MAKEINFO", "makeinfo",
+     "TEX", "tex",
+     "TEXI2DVI", "texi2dvi",
+     "WEAVE", "weave",
+     "CWEAVE", "cweave",
+     "TANGLE", "tangle",
+     "CTANGLE", "ctangle",
+ 
+     "RM", "rm -f",
+ 
+     "LINK.o", "$(CC) $(LDFLAGS) $(TARGET_ARCH)",
+     "COMPILE.c", "$(CC) $(CFLAGS) $(CPPFLAGS) $(TARGET_ARCH) -c",
+     "LINK.c", "$(CC) $(CFLAGS) $(CPPFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "COMPILE.cc", "$(C++) $(C++FLAGS) $(CPPFLAGS) $(TARGET_ARCH) -c",
+     "COMPILE.C", "$(COMPILE.cc)",
+     "LINK.cc", "$(C++) $(C++FLAGS) $(CPPFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "LINK.C", "$(LINK.cc)",
+     "YACC.y", "$(YACC) $(YFLAGS)",
+     "LEX.l", "$(LEX) $(LFLAGS) -t",
+     "COMPILE.f", "$(FC) $(FFLAGS) $(TARGET_ARCH) -c",
+     "LINK.f", "$(FC) $(FFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "COMPILE.F", "$(FC) $(FFLAGS) $(CPPFLAGS) $(TARGET_ARCH) -c",
+     "LINK.F", "$(FC) $(FFLAGS) $(CPPFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "COMPILE.r", "$(FC) $(FFLAGS) $(RFLAGS) $(TARGET_ARCH) -c",
+     "LINK.r", "$(FC) $(FFLAGS) $(RFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "COMPILE.def", "$(M2C) $(M2FLAGS) $(DEFFLAGS) $(TARGET_ARCH)",
+     "COMPILE.mod", "$(M2C) $(M2FLAGS) $(MODFLAGS) $(TARGET_ARCH)",
+     "COMPILE.p", "$(PC) $(PFLAGS) $(CPPFLAGS) $(TARGET_ARCH) -c",
+     "LINK.p", "$(PC) $(PFLAGS) $(CPPFLAGS) $(LDFLAGS) $(TARGET_ARCH)",
+     "LINK.s", "$(CC) $(ASFLAGS) $(LDFLAGS) $(TARGET_MACH)",
+     "COMPILE.s", "$(AS) $(ASFLAGS) $(TARGET_MACH)",
+     "LINK.S", "$(CC) $(ASFLAGS) $(CPPFLAGS) $(LDFLAGS) $(TARGET_MACH)",
+     "COMPILE.S", "$(CC) $(ASFLAGS) $(CPPFLAGS) $(TARGET_MACH) -c",
+ #if !defined(M_XENIX) || defined(__GNUC__)
+     "PREPROCESS.S", "$(CC) -E $(CPPFLAGS)",
+ #else	/* Xenix.  */
+     "PREPROCESS.S", "$(CC) -EP $(CPPFLAGS)",
+ #endif	/* Not Xenix.  */
+     "PREPROCESS.F", "$(FC) $(FFLAGS) $(CPPFLAGS) $(TARGET_ARCH) -F",
+     "PREPROCESS.r", "$(FC) $(FFLAGS) $(RFLAGS) $(TARGET_ARCH) -F",
+     "LINT.c", "$(LINT) $(LINTFLAGS) $(CPPFLAGS) $(TARGET_ARCH)",
+ 
+ #ifndef	NO_MINUS_C_MINUS_O
+ #if !defined(M_XENIX) || defined(__GNUC__)
+     "OUTPUT_OPTION", "-o $@",
+ #else	/* Xenix.  */
+     "OUTPUT_OPTION", "-Fo$@",
+ #endif	/* Not Xenix.  */
+ #endif
+ 
+     0, 0
+   };
+ 
+ /* Set up the default .SUFFIXES list.  */
+ 
+ void
+ set_default_suffixes ()
+ {
+   suffix_file = enter_file (".SUFFIXES");
+ 
+   if (no_builtin_rules_flag)
+     (void) define_variable ("SUFFIXES", 8, "", o_default, 0);
+   else
+     {
+       char *p = default_suffixes;
+       suffix_file->deps = (struct dep *)
+ 	multi_glob (parse_file_seq (&p, '\0', sizeof (struct dep)),
+ 		    sizeof (struct dep));
+       (void) define_variable ("SUFFIXES", 8, default_suffixes, o_default, 0);
+     }
+ }
+ 
+ /* Install the default pattern rules and enter
+    the default suffix rules as file rules.  */
+ 
+ void
+ install_default_implicit_rules ()
+ {
+   register struct pspec *p;
+   register char **s;
+   
+   if (no_builtin_rules_flag)
+     return;
+ 
+   for (p = default_pattern_rules; p->target != 0; ++p)
+     install_pattern_rule (p, 0);
+ 
+   for (p = default_terminal_rules; p->target != 0; ++p)
+     install_pattern_rule (p, 1);
+ 
+   for (s = default_suffix_rules; *s != 0; s += 2)
+     {
+       register struct file *f = enter_file (s[0]);
+       /* Don't clobber cmds given in a makefile if there were any.  */
+       if (f->cmds == 0)
+ 	{
+ 	  f->cmds = (struct commands *) xmalloc (sizeof (struct commands));
+ 	  f->cmds->filename = 0;
+ 	  f->cmds->commands = s[1];
+ 	  f->cmds->command_lines = 0;
+ 	}
+     }
+ }
+ 
+ void
+ define_default_variables ()
+ {
+   register char **s;
+ 
+   for (s = default_variables; *s != 0; s += 2)
+     (void) define_variable (s[0], strlen (s[0]), s[1], o_default, 1);
+ }


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dep.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dep.h:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dep.h	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,50 ----
+ /* Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ /* Structure representing one dependency of a file.
+    Each struct file's `deps' points to a chain of these,
+    chained through the `next'.
+ 
+    Note that the first three words of this match a struct nameseq.  */
+ 
+ struct dep
+   {
+     struct dep *next;
+     char *name;
+     struct file *file;
+     int changed;
+   };
+ 
+ 
+ /* Structure used in chains of names, for parsing and globbing */
+ 
+ struct nameseq
+   {
+     struct nameseq *next;
+     char *name;
+   };
+ 
+ 
+ extern struct nameseq *multi_glob (), *parse_file_seq ();
+ 
+ 
+ #ifndef	iAPX286
+ #define dep_name(d) ((d)->name == 0 ? (d)->file->name : (d)->name)
+ #else
+ /* Buggy compiler can't hack this.  */
+ extern char *dep_name ();
+ #endif


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dir.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dir.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/dir.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,401 ----
+ /* Directory hashing for GNU Make.
+ Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "make.h"
+ 
+ #if defined (USGr3) && !defined (DIRENT)
+ #define DIRENT
+ #endif /* USGr3 */
+ #if defined (Xenix) && !defined (SYSNDIR)
+ #define SYSNDIR
+ #endif /* Xenix */
+ 
+ #if defined (POSIX) || defined (DIRENT) || defined (__GNU_LIBRARY__)
+ #include <dirent.h>
+ #define direct dirent
+ #define D_NAMLEN(d) strlen((d)->d_name)
+ #else /* not POSIX or DIRENT */
+ #define D_NAMLEN(d) ((d)->d_namlen)
+ #if defined (USG) && !defined (sgi)
+ #if defined (SYSNDIR)
+ #include <sys/ndir.h>
+ #else /* SYSNDIR */
+ #include "ndir.h"
+ #endif /* not SYSNDIR */
+ #else /* not USG */
+ #include <sys/dir.h>
+ #endif /* USG */
+ #endif /* POSIX or DIRENT or __GNU_LIBRARY__ */
+ 
+ #if defined (POSIX) && !defined (__GNU_LIBRARY__)
+ /* Posix does not require that the d_ino field be present, and some
+    systems do not provide it. */
+ #define REAL_DIR_ENTRY(dp) 1
+ #else
+ #define REAL_DIR_ENTRY(dp) (dp->d_ino != 0)
+ #endif /* POSIX */
+ 
+ /* Hash table of directories.  */
+ 
+ struct directory
+   {
+     struct directory *next;
+     char *name;			/* Name of the directory.  */
+     struct dirfile **files;	/* Files in this directory.  */
+     DIR *dirstream;		/* Stream reading this directory.  */
+   };
+ 
+ #ifndef	DIRECTORY_BUCKETS
+ #define DIRECTORY_BUCKETS 23
+ #endif
+ 
+ static struct directory *directories[DIRECTORY_BUCKETS];
+ 
+ 
+ /* Never have more than this many directories open at once.  */
+ 
+ #define MAX_OPEN_DIRECTORIES 10
+ 
+ static unsigned int open_directories = 0;
+ 
+ 
+ /* Hash table of files in each directory.  */
+ 
+ struct dirfile
+   {
+     struct dirfile *next;
+     char *name;			/* Name of the file.  */
+     char impossible;		/* This file is impossible.  */
+   };
+ 
+ #ifndef	DIRFILE_BUCKETS
+ #define DIRFILE_BUCKETS 1007
+ #endif
+ 
+ /* Find the directory named NAME and return its `struct directory'.  */
+ 
+ static struct directory *
+ find_directory (name)
+      register char *name;
+ {
+   register unsigned int hash = 0;
+   register char *p;
+   register struct directory *dir;
+ 
+   for (p = name; *p != '\0'; ++p)
+     HASH (hash, *p);
+   hash %= DIRECTORY_BUCKETS;
+ 
+   for (dir = directories[hash]; dir != 0; dir = dir->next)
+     if (streq (dir->name, name))
+       break;
+ 
+   if (dir == 0)
+     {
+       /* The directory was not found.  Create a new entry
+ 	 for it and start its directory stream reading.  */
+       dir = (struct directory *) xmalloc (sizeof (struct directory));
+       dir->next = directories[hash];
+       directories[hash] = dir;
+       dir->name = savestring (name, p - name);
+       dir->dirstream = opendir (name);
+       if (dir->dirstream == 0)
+ 	/* Couldn't open the directory.  Mark this by
+ 	   setting the `files' member to a nil pointer.  */
+ 	dir->files = 0;
+       else
+ 	{
+ 	  /* Allocate an array of hash buckets for files and zero it.  */
+ 	  dir->files = (struct dirfile **)
+ 	    xmalloc (sizeof (struct dirfile) * DIRFILE_BUCKETS);
+ 	  bzero ((char *) dir->files,
+ 		 sizeof (struct dirfile) * DIRFILE_BUCKETS);
+ 
+ 	  /* Keep track of how many directories are open.  */
+ 	  ++open_directories;
+ 	  if (open_directories == MAX_OPEN_DIRECTORIES)
+ 	    /* Read the entire directory and then close it.  */
+ 	    (void) dir_file_exists_p (dir->name, (char *) 0);
+ 	}
+     }
+ 
+   return dir;
+ }
+ 
+ /* Return 1 if the name FILENAME in directory DIRNAME
+    is entered in the dir hash table.
+    FILENAME must contain no slashes.  */
+ 
+ int
+ dir_file_exists_p (dirname, filename)
+      register char *dirname;
+      register char *filename;
+ {
+   register unsigned int hash;
+   register char *p;
+   register struct directory *dir;
+   register struct dirfile *df;
+   register struct direct *d;
+   dir = find_directory (dirname);
+ 
+   if (dir->files == 0)
+     /* The directory could not be opened.  */
+     return 0;
+ 
+   hash = 0;
+   if (filename != 0)
+     {
+       if (*filename == '\0')
+ 	/* Checking if the directory exists.  */
+ 	return 1;
+ 
+       for (p = filename; *p != '\0'; ++p)
+ 	HASH (hash, *p);
+       hash %= DIRFILE_BUCKETS;
+ 
+       /* Search the list of hashed files.  */
+ 
+       for (df = dir->files[hash]; df != 0; df = df->next)
+ 	if (streq (df->name, filename))
+ 	  return !df->impossible;
+     }
+ 
+   /* The file was not found in the hashed list.
+      Try to read the directory further.  */
+ 
+   if (dir->dirstream == 0)
+     /* The directory has been all read in.  */
+     return 0;
+ 
+   while ((d = readdir (dir->dirstream)) != 0)
+     {
+       /* Enter the file in the hash table.  */
+       register unsigned int newhash = 0;
+       register unsigned int i;
+ 
+       if (!REAL_DIR_ENTRY (d))
+ 	continue;
+ 
+       for (i = 0; i < D_NAMLEN(d); ++i)
+ 	HASH (newhash, d->d_name[i]);
+       newhash %= DIRFILE_BUCKETS;
+ 
+       df = (struct dirfile *) xmalloc (sizeof (struct dirfile));
+       df->next = dir->files[newhash];
+       dir->files[newhash] = df;
+       df->name = savestring (d->d_name, D_NAMLEN(d));
+       df->impossible = 0;
+ 
+       /* Check if the name matches the one we're searching for.  */
+       if (filename != 0
+ 	  && newhash == hash && streq (d->d_name, filename))
+ 	return 1;
+     }
+ 
+   /* If the directory has been completely read in,
+      close the stream and reset the pointer to nil.  */
+   if (d == 0)
+     {
+       --open_directories;
+       closedir (dir->dirstream);
+       dir->dirstream = 0;
+     }
+ 
+   return 0;
+ }
+ 
+ /* Return 1 if the file named NAME exists.  */
+ 
+ int
+ file_exists_p (name)
+      register char *name;
+ {
+   char *dirend;
+   char *dirname;
+ 
+ #ifndef	NO_ARCHIVES
+   if (ar_name (name))
+     return ar_member_date (name) != (time_t) -1;
+ #endif
+ 
+   dirend = rindex (name, '/');
+   if (dirend == 0)
+     return dir_file_exists_p (".", name);
+ 
+   dirname = (char *) alloca (dirend - name + 1);
+   bcopy (name, dirname, dirend - name);
+   dirname[dirend - name] = '\0';
+   return dir_file_exists_p (dirname, dirend + 1);
+ }
+ 
+ /* Mark FILENAME as `impossible' for `file_impossible_p'.
+    This means an attempt has been made to search for FILENAME
+    as an intermediate file, and it has failed.  */
+ 
+ void
+ file_impossible (filename)
+      register char *filename;
+ {
+   char *dirend;
+   register char *p = filename;
+   register unsigned int hash;
+   register struct directory *dir;
+   register struct dirfile *new;
+ 
+   dirend = rindex (p, '/');
+   if (dirend == 0)
+     dir = find_directory (".");
+   else
+     {
+       char *dirname = (char *) alloca (dirend - p + 1);
+       bcopy (p, dirname, dirend - p);
+       dirname[dirend - p] = '\0';
+       dir = find_directory (dirname);
+       filename = p = dirend + 1;
+     }
+ 
+   for (hash = 0; *p != '\0'; ++p)
+     HASH (hash, *p);
+   hash %= DIRFILE_BUCKETS;
+ 
+   if (dir->files == 0)
+     {
+       /* The directory was not opened; we must allocate the hash buckets.  */
+       dir->files = (struct dirfile **)
+ 	xmalloc (sizeof (struct dirfile) * DIRFILE_BUCKETS);
+       bzero ((char *) dir->files, sizeof (struct dirfile) * DIRFILE_BUCKETS);
+     }
+ 
+   /* Make a new entry and put it in the table.  */
+ 
+   new = (struct dirfile *) xmalloc (sizeof (struct dirfile));
+   new->next = dir->files[hash];
+   dir->files[hash] = new;
+   new->name = savestring (filename, strlen (filename));
+   new->impossible = 1;
+ }
+ 
+ /* Return nonzero if FILENAME has been marked impossible.  */
+ 
+ int
+ file_impossible_p (filename)
+      char *filename;
+ {
+   char *dirend;
+   register char *p = filename;
+   register unsigned int hash;
+   register struct directory *dir;
+   register struct dirfile *next;
+ 
+   dirend = rindex (filename, '/');
+   if (dirend == 0)
+     dir = find_directory (".");
+   else
+     {
+       char *dirname = (char *) alloca (dirend - filename + 1);
+       bcopy (p, dirname, dirend - p);
+       dirname[dirend - p] = '\0';
+       dir = find_directory (dirname);
+       p = dirend + 1;
+     }
+ 
+   if (dir->files == 0)
+     /* There are no files entered for this directory.  */
+     return 0;
+ 
+   for (hash = 0; *p != '\0'; ++p)
+     HASH (hash, *p);
+   hash %= DIRFILE_BUCKETS;
+ 
+   for (next = dir->files[hash]; next != 0; next = next->next)
+     if (streq (filename, next->name))
+       return next->impossible;
+ 
+   return 0;
+ }
+ 
+ /* Return the already allocated name in the
+    directory hash table that matches DIR.  */
+ 
+ char *
+ dir_name (dir)
+      char *dir;
+ {
+   return find_directory (dir)->name;
+ }
+ 
+ /* Print the data base of directories.  */
+ 
+ void
+ print_dir_data_base ()
+ {
+   register unsigned int i, dirs, files, impossible;
+   register struct directory *dir;
+ 
+   puts ("\n# Directories\n");
+ 
+   dirs = files = impossible = 0;
+   for (i = 0; i < DIRECTORY_BUCKETS; ++i)
+     for (dir = directories[i]; dir != 0; dir = dir->next)
+       {
+ 	++dirs;
+ 	if (dir->files == 0)
+ 	  printf ("# %s: could not be opened.\n", dir->name);
+ 	else
+ 	  {
+ 	    register unsigned int f = 0, im = 0;
+ 	    register unsigned int j;
+ 	    register struct dirfile *df;
+ 	    for (j = 0; j < DIRFILE_BUCKETS; ++j)
+ 	      for (df = dir->files[j]; df != 0; df = df->next)
+ 		if (df->impossible)
+ 		  ++im;
+ 		else
+ 		  ++f;
+ 	    printf ("# %s: ", dir->name);
+ 	    if (f == 0)
+ 	      fputs ("No", stdout);
+ 	    else
+ 	      printf ("%u", f);
+ 	    fputs (" files, ", stdout);
+ 	    if (im == 0)
+ 	      fputs ("no", stdout);
+ 	    else
+ 	      printf ("%u", im);
+ 	    fputs (" impossibilities", stdout);
+ 	    if (dir->dirstream == 0)
+ 	      puts (".");
+ 	    else
+ 	      puts (" so far.");
+ 	    files += f;
+ 	    impossible += im;
+ 	  }
+       }
+ 
+   fputs ("\n# ", stdout);
+   if (files == 0)
+     fputs ("No", stdout);
+   else
+     printf ("%u", files);
+   fputs (" files, ", stdout);
+   if (impossible == 0)
+     fputs ("no", stdout);
+   else
+     printf ("%u", impossible);
+   printf (" impossibilities in %u directories.\n", dirs);
+ }


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/expand.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/expand.c:1.1
*** /dev/null	Tue Feb 17 09:50:44 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/make/expand.c	Tue Feb 17 09:50:33 2004
***************
*** 0 ****
--- 1,342 ----
+ /* Variable expansion functions for GNU Make.
+ Copyright (C) 1988, 1989, 1991 Free Software Foundation, Inc.
+ This file is part of GNU Make.
+ 
+ GNU Make is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+ 
+ GNU Make is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with GNU Make; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "make.h"
+ #include "commands.h"
+ #include "file.h"
+ #include "variable.h"
+ 
+ 
+ /* Recursively expand V.  The returned string is malloc'd.  */
+ 
+ static char *
+ recursively_expand (v)
+      register struct variable *v;
+ {
+   char *value;
+ 
+   if (v->expanding)
+     {
+       /* Expanding V causes infinite recursion.  Lose.  */
+       if (reading_filename == 0)
+ 	fatal ("Recursive variable `%s' references itself (eventually)",
+ 	       v->name);
+       else
+ 	makefile_fatal
+ 	  (reading_filename, *reading_lineno_ptr, 
+ 	   "Recursive variable `%s' references itself (eventually)",
+ 	   v->name);
+     }
+ 
+   v->expanding = 1;
+   value = allocated_variable_expand (v->value);
+   v->expanding = 0;
+ 
+   return value;
+ }
+ 
+ /* Scan LINE for variable references and expansion-function calls.
+    Build in `variable_buffer' the result of expanding the references and calls.
+    Return the address of the resulting string, which is null-terminated
+    and is valid only until the next time this function is called.  */
+ 
+ char *
+ variable_expand (line)
+      register char *line;
+ {
+   register struct variable *v;
+   register char *p, *o, *p1;
+ 
+   p = line;
+   o = initialize_variable_output ();
+ 
+   while (1)
+     {
+       /* Copy all following uninteresting chars all at once to the
+          variable output buffer, and skip them.  Uninteresting chars end
+ 	 at the next $ or the end of the input.  */
+ 
+       p1 = index (p, '$');
+ 
+       o = variable_buffer_output (o, p, p1 != 0 ? p1 - p : strlen (p) + 1);
+ 
+       if (p1 == 0)
+ 	break;
+       p = p1 + 1;
+ 
+       /* Dispatch on the char that follows the $.  */
+ 
+       switch (*p)
+ 	{
+ 	case '$':
+ 	  /* $$ seen means output one $ to the variable output buffer.  */
+ 	  o = variable_buffer_output (o, p, 1);
+ 	  break;
+ 
+ 	case '(':
+ 	case '{':
+ 	  /* $(...) or ${...} is the general case of substitution.  */
+ 	  {
+ 	    char openparen = *p;
+ 	    char closeparen = (openparen == '(') ? ')' : '}';
+ 	    register char *beg = p + 1;
+ 	    char *op, *begp;
+ 	    char *end;
+ 
+ 	    op = o;
+ 	    begp = p;
+ 	    if (handle_function (&op, &begp))
+ 	      {
+ 		o = op;
+ 		p = begp;
+ 		break;
+ 	      }
+ 
+ 	    /* Is there a variable reference inside the parens or braces?
+ 	       If so, expand it before expanding the entire reference.  */
+ 
+ 	    p1 = index (beg, closeparen);
+ 	    if (p1 != 0)
+ 	      p1 = lindex (beg, p1, '$');
+ 	    if (p1 != 0)
+ 	      {
+ 		/* BEG now points past the opening paren or brace.
+ 		   Count parens or braces until it is matched.  */
+ 		int count = 0;
+ 		for (p = beg; *p != '\0'; ++p)
+ 		  {
+ 		    if (*p == openparen)
+ 		      ++count;
+ 		    else if (*p == closeparen && --count < 0)
+ 		      break;
+ 		  }
+ 		/* If count is >= 0, there were unmatched opening parens
+ 		   or braces, so we go to the simple case of a variable name
+ 		   such as `$($(a)'.  */
+ 		if (count < 0)
+ 		  {
+ 		    char *name = expand_argument (beg, p);
+ 		    static char start[3] = { '$', }, end[2];
+ 		    start[1] = openparen;
+ 		    end[0] = closeparen;
+ 		    p1 = concat (start, name, end);
+ 		    free (name);
+ 		    name = allocated_variable_expand (p1);
+ 		    o = variable_buffer_output (o, name, strlen (name));
+ 		    free (name);
+ 		    break;
+ 		  }
+ 	      }
+ 
+ 	    /* This is not a reference to a built-in function and
+ 	       it does not contain any variable references inside.
+ 	       There are several things it could be.  */
+ 
+ 	    p = index (beg, ':');
+ 	    if (p != 0 && lindex (beg, p, closeparen) == 0)
+ 	      {
+ 		/* This is a substitution reference: $(FOO:A=B).  */
+ 		int count;
+ 		char *subst_beg, *replace_beg;
+ 		unsigned int subst_len, replace_len;
+ 
+ 		v = lookup_variable (beg, p - beg);
+ 
+ 		subst_beg = p + 1;
+ 		count = 0;
+ 		for (p = subst_beg; *p != '\0'; ++p)
+ 		  {
+ 		    if (*p == openparen)
+ 		      ++count;
+ 		    else if (*p == closeparen)
+ 		      --count;
+ 		    else if (*p == '=' && count <= 0)
+ 		      break;
+ 		  }
+ 		if (count > 0)
+ 		  /* There were unmatched opening parens.  */
+ 		  return initialize_variable_output ();
+ 		subst_len = p - subst_beg;
+ 
+ 		replace_beg = p + 1;
+ 		count = 0;
+ 		for (p = replace_beg; *p != '\0'; ++p)
+ 		  {
+ 		    if (*p == openparen)
+ 		      ++count;
+ 		    else if (*p == closeparen && --count < 0)
+ 		      break;
+ 		  }
+ 		if (count > 0)
+ 		  /* There were unmatched opening parens.  */
+ 		  return initialize_variable_output ();
+ 		end = p;
+ 		replace_len = p - replace_beg;
+ 
+ 		if (v != 0 && *v->value != '\0')
+ 		  {
+ 		    char *value = (v->recursive ? recursively_expand (v)
+ 				   : v->value);
+ 		    if (lindex (subst_beg, subst_beg + subst_len, '%') != 0)
+ 		      {
+ 			p = savestring (subst_beg, subst_len);
+ 			p1 = savestring (replace_beg, replace_len);
+ 			o = patsubst_expand (o, value, p, p1,
+ 					     index (p, '%'), index (p1, '%'));
+ 			free (p);
+ 			free (p1);
+ 		      }
+ 		    else
+ 		      o = subst_expand (o, value, subst_beg, replace_beg,
+ 					subst_len, replace_len, 0, 1);
+ 		    if (v->recursive)
+ 		      free (value);
+ 		  }
+ 	      }
+ 
+ 	    /* No, this must be an ordinary variable reference.  */
+ 	    else
+ 	      {
+ 		/* Look up the value of the variable.  */
+ 		end = index (beg, closeparen);
+ 		if (end == 0)
+ 		  return initialize_variable_output ();
+ 		v = lookup_variable (beg, end - beg);
+ 
+ 		if (v != 0 && *v->value != '\0')
+ 		  {
+ 		    char *value = (v->recursive ? recursively_expand (v)
+ 				   : v->value);
+ 		    o = variable_buffer_output (o, value, strlen (value));
+ 		    if (v->recursive)
+ 		      free (value);
+ 		  }
+ 	      }
+ 
+ 	    /* Advance p past the variable reference to resume scan.  */
+ 	    p = end;
+ 	  }
+ 	  break;
+ 
+ 	case '\0':
+ 	  break;
+ 
+ 	default:
+ 	  if (isblank (p[-1]))
+ 	    break;
+ 
+ 	  /* A $ followed by a random char is a variable reference:
+ 	     $a is equivalent to $(a).  */
+ 	  {
+ 	    /* We could do the expanding here, but this way
+ 	       avoids code repetition at a small performance cost.  */
+ 	    char name[5];
+ 	    name[0] = '$';
+ 	    name[1] = '(';
+ 	    name[2] = *p;
+ 	    name[3] = ')';
+ 	    name[4] = '\0';
+ 	    p1 = allocated_variable_expand (name);
+ 	    o = variable_buffer_output (o, p1, strlen (p1));
+ 	    free (p1);
+ 	  }
+ 
+ 	  break;
+ 	}      
+ 
+       if (*p == '\0')
+ 	break;
+       else
+ 	++p;
+     }
+ 
+   (void) variable_buffer_output (o, "", 1);
+   return initialize_variable_output ();
+ }
+ 
+ /* Expand an argument for an expansion function.
+    The text starting at STR and ending at END is variable-expanded
+    into a null-terminated string that is returned as the value.
+    This is done without clobbering `variable_buffer' or the current
+    variable-expansion that is in progress.  */
+ 
+ char *
+ expand_argument (str, end)
+      char *str, *end;
+ {
+   char *tmp = savestring (str, end - str);
+   char *value = allocated_variable_expand (tmp);
+ 
+   free (tmp);
+ 
+   return value;
+ }
+ 
+ /* Expand LINE for FILE.  Error messages refer to the file and line where
+    FILE's commands were found.  Expansion uses FILE's variable set list.  */
+ 
+ char *
+ variable_expand_for_file (line, file)
+      char *line;
+      register struct file *file;
+ {
+   char *result;
+   struct variable_set_list *save;
+ 
+   if (file == 0)
+     return variable_expand (line);
+ 
+   save = current_variable_set_list;
+   current_variable_set_list = file->variables;
+   reading_filename = file->cmds->filename;
+   reading_lineno_ptr = &file->cmds->lineno;
+   result = variable_expand (line);
+   current_variable_set_list = save;
+   reading_filename = 0;
+   reading_lineno_ptr = 0;
+ 
+   return result;
+ }
+ 
+ /* Like variable_expand, but the returned string is malloc'd.  */
+ char *
+ allocated_variable_expand (line)
+      char *line;
+ {
+   return allocated_variable_expand_for_file (line, (struct file *) 0);
+ }
+ 
+ /* Like variable_expand_for_file, but the returned string is malloc'd.  */
+ 
+ char *
+ allocated_variable_expand_for_file (line, file)
+      char *line;
+      struct file *file;
+ {
+   char *save;
+   char *value;