Initial population.

187 files changed, 143547 insertions, 0 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
new file mode 100644
index 00000000..ec6554e2
--- /dev/null
+++ b/src/interp/ChangeLog
@@ -0,0 +1,1078 @@
+2007-08-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* union.lisp.pamphlet: Import vmlisp.
+	* ggreater.lisp.pamphlet ("vmlisp"): Import vmlisp.
+	* Makefile.pamphlet 
+	(DEP): Remove ggreater.lisp, hash.lisp, and union.lisp.
+	(ggreater.$(FASLEXT)): New rule.
+	(union.$(FASLEXT)): Likewise.
+	(${DEPSYS}): Load compiled form of ggreater and union.
+	* Makefile.in: Regenerate.
+
+2007-08-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet: Import vmlisp.
+	* Makefile.pamphlet (depsys_lisp_noncompiled_sources): Remove.
+	(${DEPSYS}): Load compiled form of util.
+	(util.$(FASLEXT)): New rule.
+	* Makefile.in: Regenerate.
+	
+2007-08-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* bookvol5.pamphlet (spad, runspad, ncToplevel, ncIntLoop,
+	intloop, SpadInterpretStream, intloopReadConsole): Move original
+	Boot code into int-top.boot.pamphlet.  Delete translated Lisp
+	code.
+	(makeInitialModemapFrame,$historyFileType, $oldHistoryFileName,
+	$internalHistoryTable, $useInternalHistoryTable, makeHistFileName,
+	oldHistFileName, histFileName, histInputFileName, initHist,
+	initHistList, history, historySpad2Cmd, setHistoryCore,
+	writeInputLines, resetInCoreHist, changeHistListLen, updateHist,
+	updateInCoreHist, putHist, recordNewValue, recordNewValue0,
+	recordOldValue, recordOldValue0, undoInCore, undoChanges,
+	undoFromFile, saveHistory, restoreHistory, showHistory,
+	setIOIndex, showInput, showInOut, fetchOutput, readHifi,
+	writeHifi, disableHist, writeHistModesAndValues, SPADWRITE0,
+	SPADWRITE, SPADREAD, unwritable? writifyComplain, safeWritify,
+	writify, spadClosure?, dewritify, ScanOrPairVec, histFileErase,
+	frameName, frameNames, frameEnvironment, emptyInterpreterFrame,
+	createCurrentInterpreterFrame, updateFromCurrentInterpreterFrame,
+	findFrameInRing, updateCurrentInterpreterFrame,
+	initializeInterpreterFrame, nextInterpreterFrame,
+	changeToNamedInterpreterFrame, previousInterpreterFrame,
+	addNewInterpreterFrame, closeInterpreterFrame, displayFrameNames,
+	importFromFrame, frame, frameSpad2Cmd, $undoFlag, $frameRecord,
+	$previousBindings, undo, recordFrame, diffAlist, reportUndo,
+	clearFrame, undoCount, undoSteps, undoSingleStep,
+	undoLocalModemapHack, removeUndoLines): Move original Boot code
+	back to i-syscmd.boot.pamphlet.  Delete translated Lisp code. 
+	(charDigitVal, gensymInt): Move original Boot code to
+	g-util.boot.pamphlet. 
+
+	* g-util.boot.pamphlet (charDigitVal, gensymInt): Move Boot code
+	from bookvol5.pamphlet.
+
+	* i-syscmd.boot.pamphlet (makeInitialModemapFrame,
+	$historyFileType, $oldHistoryFileName, 
+	$internalHistoryTable, $useInternalHistoryTable, makeHistFileName,
+	oldHistFileName, histFileName, histInputFileName, initHist,
+	initHistList, history, historySpad2Cmd, setHistoryCore,
+	writeInputLines, resetInCoreHist, changeHistListLen, updateHist,
+	updateInCoreHist, putHist, recordNewValue, recordNewValue0,
+	recordOldValue, recordOldValue0, undoInCore, undoChanges,
+	undoFromFile, saveHistory, restoreHistory, showHistory,
+	setIOIndex, showInput, showInOut, fetchOutput, readHifi,
+	writeHifi, disableHist, writeHistModesAndValues, SPADWRITE0,
+	SPADWRITE, SPADREAD, unwritable? writifyComplain, safeWritify,
+	writify, spadClosure?, dewritify, ScanOrPairVec, histFileErase,
+	frameName, frameNames, frameEnvironment, emptyInterpreterFrame,
+	createCurrentInterpreterFrame, updateFromCurrentInterpreterFrame,
+	findFrameInRing, updateCurrentInterpreterFrame,
+	initializeInterpreterFrame, nextInterpreterFrame,
+	changeToNamedInterpreterFrame, previousInterpreterFrame,
+	addNewInterpreterFrame, closeInterpreterFrame, displayFrameNames,
+	importFromFrame, frame, frameSpad2Cmd, $undoFlag, $frameRecord,
+	$previousBindings, undo, recordFrame, diffAlist, reportUndo,
+	clearFrame, undoCount, undoSteps, undoSingleStep,
+	undoLocalModemapHack, removeUndoLines): Move Boot code from
+	bookvol5.pamphlet. 
+
+	* Makefile.pamphlet (${DEPSYS}): Load compiled form of bookvol5.
+	(bookvol5.$(FASLEXT)): New.
+	* Makefile.in: Regenerate.
+
+2007-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Load compiled form of nocompil.
+	* Makefile.in: Regenerate.
+
+2007-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (OBJS): Replace setq.lisp and property.lisp
+	with their compiled forms, thus making all codes in interpsys and
+	AXIOMsys compiled.
+	(interpsys_modules, IN_modules, AS_modules): New.
+	(makeint.lisp): Use them.
+	* Makefile.in: Regenerate.
+
+	* util.lisp.pamphlet (build-interpsys): Use importModule instead
+	of pain LOAD.
+
+2007-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet: Stop hijacking BOOTTRAN::BOOTTOCL.
+	(OLD-BOOT::BOOT): Rename from BOOTTRAN::BOOTTOCL.  Unconditionally
+	define. 
+	(build-depsys): Don't push :OLDBOOT.  It is no longer needed.
+	(build-interpsys): Likewise.
+	* Makefile.pamphlet: Rename BOOTTRAN::BOOTTOCL to OLD-BOOT::BOOT
+	throughout. 
+	(${DEPSYS}): Don't push :OLDBOOT.
+	* Makefile.in: Regenerate.
+
+2007-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet ("VMLISP"): Use AxiomCore.
+	(EQUABLE): Defin in compile, load, and execution situations.
+	Needed to compile macro EQCAR.
+	* hash.lisp.pamphlet: Import "vmlisp".
+	* g-util.boot.pamphlet (AxiomCore::$sysScope): New.
+	* bootfuns.lisp.pamphlet ("BOOT"): Import "hash.  Use VMLISP and
+	AxiomCore.
+	* Makefile.pamphlet (BOOT_TO_LISP, COMPILE_LISP): Simplify.
+	(<<save depsys image>>): Now use --load-directory to resolve
+	dependencies.
+	(${DEPSYS}): Now depend on vmlisp.$(FASLEXT), hash.$(FASLEXT), and
+	bootfuns.$(FASLEXT).  Use them instead of source form.
+	(bootfuns.$(FASLEXT)): New rule.  Compile with $(BOOTSYS) instead
+	of $(DEPSYS).	
+	(hash.$(FASLEXT)): Likewise.
+	(vmlisp.$(FASLEXT)): Likewise.
+	(makeint.lisp): Use |importModule| instead of plain load.
+	(${SAVESYS}): Use --load-directory to resolve dependencies.
+	(${AXIOMSYS}): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-08-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Remove existing makedep.lisp.
+	(makeint.lisp): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-08-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* hypertex.boot.pamphlet ($SendXEventToHyperTeX): Don't set
+	here.  It is a constant variable.
+
+	* Makefile.pamphlet (${SAVESYS}): Tidy.
+	(${AXIOMSYS}): Likewise.
+	(<<save depsys image>>): Likewise.
+	(${DEBUGSYS}): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (depsys_lisp_noncompiled_sources): Dont'
+	reference sys-pkg.lisp.
+	(PROCLAIMS): Remove.
+	(${DEPSYS}): Don't depend on sys-pkg.lisp.  Explicitly load
+	vmlisp.lisp, hash.lisp, and bootfuns.lisp.
+	(makeint.lisp): Don't depend on sys-pkg.lisp.
+	(DEP): Remove vmlisp.lisp, bootfuns.lisp, and hash.lisp.
+	(makeint.lisp): Explicitly load "vmlisp", "hash", and "bootfuns".
+	* Makefile.in: Regenerate.
+	* sys-pkg.lisp.pamphlet: Move BOOT package definition to
+	bootfuns.lisp.pamphlet.
+	Move VMLISP package definition to vmlisp.lisp.pamphlet.
+	Delete.
+	* bootfuns.lisp.pamphlet: Define package BOOT.
+	* vmlisp.lisp.pamphlet: Define package VMLISP.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet: Remove BOOT imports and exports.  Add
+	more VMLISP export. 
+	* nlib.lisp.pamphlet (directory?): Explicilty qualify directoryp
+	by BOOT.
+	* bookvol5.pamphlet (spad-save): Don't define in package "USER".
+	* Makefile.pamphlet (${AXIOMSYS}): User boot::spad-save, not
+	user::spad-save. 
+	(${DEBUGSYS}): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet (<<Missing DFLOAT Transcendental
+	functions>>, <<manexp>>, <<acot>>, <<cot>>, <<getCD>>): Move
+	to... 
+	* bootfuns.lisp.pamphlet(<<Missing DFLOAT Transcendental
+	functions>>, <<manexp>>, <<acot>>, <<cot>>, <<getCD>>): ...here.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* unlisp.lisp.pamphlet (|ListMember?|): Move to...
+	* msg.boot.pamphlet (ListMember?): ...here.  Rewrite in Boot.
+	* vmlisp.lisp.pamphlet (|ListMember?|): Remove duplicate.
+	(|stringLE1|, |sortCarString|, |insertString|): Remove unused
+	functions.
+	(|AlistAssocQ|): Remove duplicate.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet ("FOAM", "FOAM-USER"): Move to ...
+	* foam_l.lisp.pamphlet ("FOAM", "FOAM-USER"): ...here.
+	* cparse.boot.pamphlet: Tidy.
+	* Makefile.pamphlet (OBJS): Include foam_l.$(FASLEXT) because
+	daase.lisp references it.
+	(PROCLAIMS): Disable cached proclaims for now.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet ($npPParg, npPPff, npPPf, npPPg, npPP,
+	$npPCff, npPCff, npPCg, npPC): Move to ...
+	* cparse.boot.pamphlet ($npPParg, npPPff, npPPf, npPPg, npPP,
+	$npPCff, npPCff, npPCg, npPC):  ... here. Rewrite back in Boot.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet (|$npPCff|): Rename from *npPCff*.
+	(npPCff): Adjust.
+
+2007-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* cparse.boot.pamphlet: Tidy formatting.
+	* vmlisp.lisp.pamphlet (|$npPParg|): Rename from *npPParg* to
+	follow general Boot naming convention.
+	(npPPff, |npPP|): Adjust.
+
+2007-08-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet: Push into user package before defining
+	packages.  That way, we don't suffer from suddenly hidden
+	symbols such as defpackage::defpackage in inventive Lisps.  Create
+	packages with defpackage.
+
+2007-08-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet: Remove imports that have been commented
+	out. 
+
+2007-08-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* macros.lisp.pamphlet (|shoeConsole|): Move from
+	vmlisp.lisp.pamphlet.
+	(|shoeInputFile|): Likewise.
+	(|shoeread-line|): Likewise.
+	* sys-pkg.lisp.pamphlet (vmlisp::|shoeConsole|): Don't import into
+	BOOT anymore.
+	(vmlisp::|shoeread-line|): Likewise.
+	(vmlisp::|shoeInputFile|): Likewise.
+
+2007-08-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* macros.lisp.pamphlet: Tidy formatting.
+	* foam_l.lisp.pamphlet: Likewise.
+	* nlib.lisp.pamphlet: Likewise.
+	* ggreater.lisp.pamphlet: Likewise.
+	* union.lisp.pamphlet: Likewise.
+	* comp.lisp.pamphlet: Likewise.
+	* spaderror.lisp.pamphlet: Likewise.
+	* spad.lisp.pamphlet: Likewise.
+	* bits.lisp.pamphlet: Likewise.
+	* unlisp.lisp.pamphlet: Likewise.
+	* axext_l.lisp.pamphlet: Likewise.
+
+2007-07-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet (MACRO-MISSINGARGS): Fix thinko in case
+	statement. 
+
+2007-06-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet (MACRO-MISSINGARGS): Fix thinko.
+
+2007-06-25  Gabriel Dos Reis  <gdr@cs.tamu.net>
+
+	* Makefile.pamphlet (${SAVESYS}): Use --mode=link to produce
+	executable. 
+	(<<save depsts image>>): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-06-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* br-data.boot.pamphlet (dbHasExamplePage): Fix HyperTex page
+	pathname. 
+	* ht-root.boot.pamphlet (htTutorialSearch): Likewise.
+	* htcheck.boot.pamphlet (buildHtMacroTable): Likewise.
+	* util.lisp.pamphlet ($relative-directory-list): Fix path to catalogs.
+
+2007-05-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Remove use of NOISE throughout.
+	* Makefile.in: Regenerate.
+
+2007-05-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* spad.lisp.pamphlet (S-PROCESS): Reformat.  Enable Lisp pretty
+	printing.
+
+2007-05-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* metalex.lisp.pamphlet (make-adjustable-string): Use character as
+	string element type, not string-char.
+	* parsing.lisp.pamphlet (underscore, make-string-adjustable):
+	Likewise. 
+	* unlisp.lisp.pamphlet (c-to-lisp-string, |ByteFileReadLine|,
+	|FullString|): Likewise.
+	* vmlisp.lisp.pamphlet (make-cvec): Likewise.
+
+2007-05-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* bootfuns.lisp.pamphlet: Work around non-portable codes.
+	* foam_l.lisp.pamphlet: Replace type "string-char" with type
+	"character".
+	Replace "0.0d0" with "0.0l0" because DFlo is actually long-float,
+	not double-float.  Revisit the definition of DFlo in a broader
+	context. 
+
+2007-05-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* vmlisp.lisp.pamphlet (equable): Move definition before use.
+	Spell BOOT package name in all caps.
+
+2007-05-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* c-doc.boot.pamphlet (checkRecordHash): Use GET instead of GETL.
+	(checkTransformFirsts): Likewise.
+	* format.boot.pamphlet (formatOpSymbol): Likewise.
+	* i-output.boot.pamphlet (exptNeedsPren): Likewise.
+	(charyTrouble1): Likewise.
+	* postpar.boot.pamphlet (postForm): Likewise.
+	* pspad1.boot.pamphlet (format, getOp, formatSelectionOp,
+	formatPrefixOp):  Likewise.
+	* pspad2.boot.pamphlet (isNewspadOperator): Likewise.
+	* i-map.boot.pamphlet (getUserIdentifiersIn): Likewise.
+	Non-atomic objects don't have Nud or Led properties.
+
+2007-05-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* as.boot.pamphlet: Replace UNION with union
+	* br-con.boot.pamphlet: Likewise.
+	* br-data.boot.pamphlet: Likewise.
+	* br-saturn.boot.pamphlet: Likewise.
+	* br-search.boot.pamphlet: Likewise.
+	* category.boot.pamphlet: Likewise.
+	* database.boot.pamphlet: Likewise.
+	* define.boot.pamphlet: Likewise.
+	* functor.boot.pamphlet: Likewise.
+	* i-map.boot.pamphlet: Likewise.
+	* i-resolv.boot.pamphlet: Likewise.
+	* lisplib.boot.pamphlet: Likewise.
+	* mark.boot.pamphlet: Likewise.
+	* nruncomp.boot.pamphlet: Likewise.
+	* nrunopt.boot.pamphlet: Likewise.
+	* package.boot.pamphlet: Likewise.
+	* pspad1.boot.pamphlet: Likewise.
+	* showimp.boot.pamphlet: Likewise.
+	* trace.boot.pamphlet: Likewise.
+	* wi1.boot.pamphlet: Likewise.
+
+2007-05-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* database.boot.pamphlet: Replace INTERSECTION with intersection.
+	* i-coerfn.boot.pamphlet: Likewise.
+	* i-resolv.boot.pamphlet: Likewise.
+	* mark.boot.pamphlet: Likewise.
+	* topics.boot.pamphlet: Likewise.
+	* trace.boot.pamphlet: Likewise.
+
+2007-04-30  Gabriel Dos Reis  <gdr@cs.tamu,edu>
+
+	* Makefile.pamphlet (<<package.clisp>>): Remove.
+	* interop.boot.pamphlet (<<interop.clisp>>): Likewise.
+
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu,edu>
+
+	* apply.boot.pamphlet: Replace MEMBER with member. 
+	* br-con.boot.pamphlet: Likewise.
+	* br-op1.boot.pamphlet: Likewise.
+	* br-op2.boot.pamphlet: Likewise.
+	* br-saturn.boot.pamphlet: Likewise.
+	* br-search.boot.pamphlet: Likewise.
+	* br-util.boot.pamphlet: Likewise.
+	* category.boot.pamphlet: Likewise.
+	* cattable.boot.pamphlet: Likewise.
+	* c-doc.boot.pamphlet: Likewise.
+	* compiler.boot.pamphlet: Likewise.
+	* c-util.boot.pamphlet: Likewise.
+	* database.boot.pamphlet: Likewise.
+	* define.boot.pamphlet: Likewise.
+	* functor.boot.pamphlet: Likewise.
+	* g-error.boot.pamphlet: Likewise.
+	* g-util.boot.pamphlet: Likewise.
+	* htcheck.boot.pamphlet: Likewise.
+	* i-coerce.boot.pamphlet: Likewise.
+	* i-coerfn.boot.pamphlet: Likewise.
+	* i-funsel.boot.pamphlet: Likewise.
+	* i-map.boot.pamphlet: Likewise.
+	* incl.boot.pamphlet: Likewise.
+	* info.boot.pamphlet: Likewise.
+	* interop.boot.pamphlet: Likewise.
+	* i-output.boot.pamphlet: Likewise.
+	* i-resolv.boot.pamphlet: Likewise.
+	* i-syscmd.boot.pamphlet: Likewise.
+	* iterator.boot.pamphlet: Likewise.
+	* i-util.boot.pamphlet: Likewise.
+	* mark.boot.pamphlet: Likewise.
+	* modemap.boot.pamphlet: Likewise.
+	* msg.boot.pamphlet: Likewise.
+	* msgdb.boot.pamphlet: Likewise.
+	* nruncomp.boot.pamphlet: Likewise.
+	* nrunopt.boot.pamphlet: Likewise.
+	* record.boot.pamphlet: Likewise.
+	* trace.boot.pamphlet: Likewise.
+	* wi1.boot.pamphlet: Likewise.
+	* wi2.boot.pamphlet: Likewise.
+	* xruncomp.boot.pamphlet: Likewise.
+	
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* apply.boot.pamphlet (compApplication, applyMapping,
+	compApplyModemap, compMapCond''): Use lower case member instead of
+	uppercase MEMBER.
+	* g-error.boot.pamphlet (errorSupervisor1): Likewise.
+	* incl.boot.pamphlet (incActive?, incNConsoles): Likewise.
+	* interop.boot.pamphlet (isDomain, getFunctionFromDomain): Likewise.
+	* mark.boot.pamphlet (markCoerceByModemap, markFinish1,
+	markExtractLeadingMacros, markRemImportsAndLeadingMacros,
+	buildNewDefinition): Likewise.
+	* msg.boot.pamphlet (redundant, initToWhere, getMsgTag?,
+	getMsgFTTag?): Likewise.
+	* wi1.boot.pamphlet (compAtom, compSymbol, compColon,
+	coerceExtraHard, comp3): Likewise.
+	* wi2.boot.pamphlet (compDefineCapsuleFunction, mkUnion,
+	getInverseEnvironment, applyMapping, compApplyModemap,
+	compMapCond'', genDeltaEntry, chaseInferences, doItLet1): Likewise.
+
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* br-con.boot.pamphlet (domainDescendantsOf): Use uppercase delete
+	instead of uppercase DELETE.
+	* br-op2.boot.pamphlet (dbChooseOperandName): Likewise.
+	* category.boot.pamphlet (mkCategory, SigListUnion, mkOr2,
+	mkAnd2, FindFundAncs, JoinInner): Likewise. 
+	* compiler.boot.pamphlet (getInverseEnvironment, modeEqual): Likewise.
+	* database.boot.pamphlet (orderPredTran): 
+	* define.boot.pamphlet (compDefWhereClause, getSignature): Likewise.
+	* format.boot.pamphlet (findSubstitutionOrder?, removeIsDomainD):
+	Likewise. 
+	* functor.boot.pamphlet (DescendCodeAdd1, ICformat): Likewise.
+	* i-coerfn.boot.pamphlet (Mp2Up): Likewise.
+	* i-map.boot.pamphlet (clearDep1): Likewise.
+	* info.boot.pamphlet (chaseInferences): Likewise.
+	* i-spec1.boot.pamphlet (checkForFreeVariables): Likewise.
+	* i-syscmd.boot.pamphlet (workfilesSpad2Cmd): Likewise.
+	* mark.boot.pamphlet (markFinish1, moveTruePred2End): Likewise.
+	* modemap.boot.pamphlet (putDomainsInScope): Likewise.
+	* nrunopt.boot.pamphlet (orderByContainment, depthAssocList): Likewise.
+	* setvars.boot.pamphlet (setExposeAddConstr, setExposeDropGroup,
+	setExposeDropConstr): Likewise. 
+	* trace.boot.pamphlet (trace1, untraceDomainConstructor, tracelet,
+	breaklet): Likewise.
+	* wi2.boot.pamphlet (getInverseEnvironment, chaseInferences): Likewise.
+
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* c-doc.boot.pamphlet (checkBalance): Use lowercase rassoc instead
+	of uppercase RASSOC.
+	* c-util.boot.pamphlet (sublisR): Likewise.
+	* database.boot.pamphlet (modemapPattern): Likewise.
+	* mark.boot.pamphlet (reduceImports1): Likewise.
+	* pspad2.boot.pamphlet (formatDeftranIf): Likewise.
+	* trace.boot.pamphlet (saveMapSig, rassocSub): Likewise.
+
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* as.boot.pamphlet (asytranForm1, asyTypeUnit): Replace GET with
+	GETL. 
+	* br-con.boot.pamphlet (dbShowConsDoc1, dbSpecialOperations,
+	dbSpecialExports):  Likewise.
+	* br-op1.boot.pamphlet (niladicHack): Likewise.
+	* br-util.boot.pamphlet (dbInfovec, isLoaded?): Likewise.
+	* buildom.boot.pamphlet (constructorCategory): Likewise.
+	* category.boot.pamphlet (SourceLevelSubset, MachineLevelSubset):
+	Likewise. 
+	* c-doc.boot.pamphlet (checkRecordHash, checkTransformFirsts):
+	Likewise. 
+	* clam.boot.pamphlet (clearClam, reportCircularCacheStats,
+	reportHashCacheStats, clamStats): Likewise.
+	* cparse.boot.pamphlet (npPushId, npInfixOp): Likewise.
+	* c-util.boot.pamphlet (isFunction,, isSubset): Likewise.
+	* database.boot.pamphlet (updateDatabase): Likewise.
+	* define.boot.pamphlet (mustInstantiate): Likewise.
+	* format.boot.pamphlet (formatOpSymbol): Likewise.
+	* g-opt.boot.pamphlet (optimize, optSpecialCall): Likewise.
+	* g-timer.boot.pamphlet (printNamedStatsByProperty,
+	makeLongStatStringByProperty, updateTimedName,
+	computeElapsedTime): Likewise. 
+	* i-analy.boot.pamphlet (bottomUp): Likewise.
+	* i-coerce.boot.pamphlet (coerceRetract, coerceIntCommute): Likewise.
+	* i-funsel.boot.pamphlet (findFunctionInCategory): Likewise.
+	* i-map.boot.pamphlet (getUserIdentifiersIn): Likewise.
+	* interop.boot.pamphlet (instantiate, hashNewLookupInCategories):
+	Likewise. 
+	* i-output.boot.pamphlet (APP, exptNeedsPren, needStar, appSum,
+	appInfix, putWidth, opWidth, outputOp, charyTrouble1, split2,
+	subspan, superspan): Likewise.
+	* i-syscmd.boot.pamphlet(reportOpsFromUnitDirectly): Likewise.
+	* iterator.boot.pamphlet (getIdentity): Likewise.
+	* i-util.boot.pamphlet (mkPredList): Likewise.
+	* lisplib.boot.pamphlet (loadLibIfNotLoaded, loadLibIfNecessary,
+	autoLoad, augModemapsFromDomain1): Likewise.
+	* mark.boot.pamphlet (markPathsEqual, markPartOp?, markWrapPart):
+	Likewise. 
+	* modemap.boot.pamphlet (compCat, addConstructorModemaps): Likewise.
+	* nruncomp.boot.pamphlet (NOTES): Likewise.
+	* nrunfast.boot.pamphlet (newLookupInCategories,
+	newLookupInCategories1): Likewise. 
+	* nrunopt.boot.pamphlet (stuffDomainSlots, getInfovec, dcSizeAll):
+	Likewise. 
+	* parse.boot.pamphlet (parseTran): Likewise.
+	* pathname.boot.pamphlet (getFunctionSourceFile1): Likewise.
+	* postpar.boot.pamphlet (postTran, postForm): Likewise.
+	* pspad1.boot.pamphlet (format, getOp, formatDollar,
+	formatDollar1, formatFunctionCall1, formatSelectionOp,
+	formatPrefixOp, formatOpBindingPower): Likewise.
+	* pspad2.boot.pamphlet (isNewspadOperator): Likewise.
+	* wi1.boot.pamphlet (compExpression): Likewise.
+	* wi2.boot.pamphlet (optDeltaEntry): Likewise.
+	* xrun.boot.pamphlet (findFunctionInCategory): Likewise.
+	* xruncomp.boot.pamphlet (addConstructorModemaps): Likewise.
+
+2007-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* i-coerfn.boot.pamphlet (Dmp2Up): Use lowercase "remove" instead
+	or uppercase REMOVE.
+
+2007-04-28  Gabriel Dos Reis  <gdr@cs.tamu,edu>
+
+	* interop.boot.pamphlet (hashNewLookupInTable): Instead
+	^= instead of NE.
+
+2007-04-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (<<parse.clisp>>): Remove.
+	* Makefile.in: Regenerate.
+
+2007-04-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* parse.boot.pamphlet: Push into package BOOT.  Consistently
+	double-quote AST tags.  Remove cached Lisp translation.
+
+2007-04-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* postpar.boot.pamphlet: Double-qoute AST tags.
+	(<<postpar.clisp>>): Remove.
+	* Makefile.pamphlet (<<postpar.clisp>>): Remove.
+	* Makefile.in: Regenerate.
+
+2007-04-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* i-output.boot.pamphlet (checkArgs): Remove bogus comments.
+
+2007-04-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (<<pathname.clisp>>): Delete.
+	(<<package.clisp>>): Likewise.
+	* Makefile.in: Regenerate.
+
+	* pathname.boot.pamphlet: Push into package BOOT. 
+	(pathnameDirectory): Use LispKeyword.
+	* package.boot.pamphlet: Push into package BOOT.  Use
+	lowercase for DELETE, NREVERSE.
+
+2007-04-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (<<simpbool.clisp>>): Remove.
+	* Makefile.in: Regenerate.
+	* simpbool.boot.pamphlet: Push into package "BOOT".
+	Use lowercase for NREVERSE, MKPF, MEMBER.
+
+2007-04-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* compress.boot.pamphlet: Push into package "BOOT".
+	* Makefile.pamphlet: Remove explicit stanzas for translating and
+	compiling compress.boot.
+	* Makefile.in: Regenerate.
+
+2007-04-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (<<applu.clisp>>): Remove.
+	(<<hashcode.clisp>>): Likewise.
+	(<<interop.clisp>>): Likewise.
+	(<<xrun.clisp>>): Likewise.
+	(<<wi1.clisp>>): Likewise.
+	(<<wi2.clisp>>): Likewise.
+	(<<pspad1.clisp>>): Likewise.
+	(<<pspad2.clisp>>): Likewise.
+	(<<mark.clisp>>): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-04-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* setvars.boot.pamphlet: Push into package "BOOT".
+	Remove cached Lisp translation.
+	* Makefile.pamphlet (<<newaux.lisp (OUT from MID)>>): Remove
+	(<<newaux.${LISP}>>): Likewise.
+	(<<setvars.lisp (OUT from MID)>>): Likewise
+	(<<setvars.clisp>>): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-04-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Require g-boot.clisp.
+	<<g-boot.clisp>>: Remove.
+	<<g-boot.lisp (OUT from IN)>>: Likewise.
+	* Makefile.in: Regenerate.
+	* g-boot.boot.pamphlet: Push into package BOOT.
+	Remove cached Lisp translation.
+
+2007-04-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Require clam.clisp.  Remove
+	reference to clam.${LISP}.
+	<<clam.clisp>>: Remove.
+	<<clam.lisp>>: Likewise.
+	* clam.boot.pamphlet: Push into package "BOOT".  Remove cached
+	Lisp translation.
+
+2007-04-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (DEPSYS): Point to depsys in build-dir.
+	(SAVESYS): Likewise
+	(${AUTO}/wi1.$(FASLEXT)): Copy from build-dir version.
+	(${AUTO}/wi2.$(FASLEXT)): Likewise.
+	(${AUTO}/pspad1.$(FASLEXT)): Likewise.
+	(${AUTO}/pspad2.$(FASLEXT)): Likewise.
+	(${AUTO}/mark.$(FASLEXT)): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-03-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Remove fasl file after depsys it
+	built. 
+	* Makefile.in: Regenerate.
+
+2007-03-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* g-error.boot.pamphlet: Explicitly puch into package "BOOT".
+
+	* Makefile.pamphlet (${DEPSYS}): Add g-error.clisp to
+	requirements.  Load it g-error.$(FASLEXT) too.
+	(depsys_objects): Include g-error.$(FASLEXT).
+	(depsys_boot_sources): Icnlude g-error.boot.
+	(<<g-error.clisp>>): Remove.
+	* Makefile.in: Regenerate.
+
+2007-03-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* g-util.boot.pamphlet: Remove cached Lisp translation.  Push into
+	package "BOOT" at the beginning.
+	* Makefile.pamphlet (${DEPSYS}): Require g-util.clisp, not
+	g-util.${LISP}.
+	Remove explicit stanzas for g-util.clisp and g-util.{LISP}.
+	* Makefile.in: Regenerate.
+
+2007-03-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* slam.boot.pamphlet: Remove cached Lisp translation.  Push into
+	package "BOOT" at the beginning.
+	* Makefile.pamphlet (${DEPSYS}): Require slam.clisp, not
+	slam.${LISP}.
+	Remove explicit stanzas for slam.clisp and slam.{LISP}.
+	* Makefile.in: Regenerate.
+
+2007-03-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* def.lisp.pamphlet (|defLETdcq|): Use a gensym'd variable name
+	instead of special character control-b.
+
+2007-03-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (mostlyclean-local): Remove .lib files too.
+	* Makefile.in: Regenerate.
+	* vmlisp.lisp.pamphlet: Fix various typos.
+	* nocompil.lisp.pamphlet: Fix trailing parenthesis typo.
+
+2007-03-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Replace $(OBJECT) with $(FASLEXT).
+	* Makefile.in: Regenerate.
+
+2007-03-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet (GCL.PNAME): Remove.
+
+2007-03-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* sys-pkg.lisp.pamphlet (GCL.MEMQ): Remove.
+
+2007-03-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet (boottocl): Remove prefix.  Do pretty print
+	translations.
+	* sys-pkg.lisp.pamphlet (BOOTTRAN): Don't define here.
+	* interp-proclaims.lisp (BOOT::|findStringInFile|): Comment out
+	proclamation. 
+	* cfuns.lisp.pamphlet (|findString|): Comment out external linkage
+	declaration. 
+	(|findStringInFile|): Comment out definition.	
+	* Makefile.pamphlet:  Use implicit rules to compiler .clisp files
+	to native object codes.  Remove redundant special cased rules.
+	(YEARWEEK): Qualify symbols names.
+	(<<save depsys image>>): Use local Lisp image.
+	(makeint.lisp): Remove in-package declaration.  Qualify symbol
+	names. Turn on stratified garbage collection.
+	(${SAVESYS}): Use axiom_build_document to build interpsys.
+	(${AXIOMSYS}): Garbage collection is already turned on in
+	makeint.lisp. 
+	* Makefile.in: Regenerate.
+
+2007-03-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Adjust call to build-depsys.
+	* Makefile.in: Regenerate.
+	* util.lisp.pamphlet (make-depsys): Remove.
+	(build-depsys): Adjust.
+
+2007-03-24  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Document Lisp files needed
+	to make depsys.
+	Remove obsolete Make rules for building documentation.
+	* Makefile.in: Regenerate.
+
+	* vmlisp.lisp.pamphlet (define-macro): Likewise.
+	* sys-pkg.lisp.pamphlet: Remove dead packages SCRATCHPAD_COMPILER
+	and SPECFNSF.
+	(define-macro): Remove.
+	Remove explicit import of GCL's system::getenv.
+
+2007-03-24  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${DEPSYS}): Don't load proclamations.
+	* Makefile.in: Regenerate.
+
+2007-03-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (BOOT_TO_LISP): Adjust.
+	(COMPILE_LISP): Likewise.
+	* Makefile.in: Regenerate.
+
+2007-01-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* ptrees.boot.pamphlet (pfExpr?): Don't duplicate test for
+	Typing and Sequence.  They are part of DeclPart.
+
+2006-12-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Eradicate use of ENV.
+
+2006-12-21  Vanuxem Gregory  <g.vanuxem@wanadoo.fr>
+
+	* patches.lisp.pamphlet: Set $saturn to nil on Windows too.
+
+2006-12-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (warm.data): Extract into ../algebra.
+	(makeint.lisp): Adjust dependency.
+
+2006-12-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Use general implicit rules to extract Boot
+	source code from pamphlets.  Refrain from excessive sub-shells
+	creation. 
+	* Makefile.in: Regenerate.
+
+2006-12-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* alql.boot.pamphlet (getBrowseDatabase): Directly call member.
+
+2006-12-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet (gazonk-name): Special-case Win32 too.
+
+	* patches.lisp.pamphlet (|xdrOpen|): Special-case for DOS and
+	Windows platforms when using GCL.
+	(|xrdRead|): Likewise.
+	(|xrdWrite|): Likewise.
+
+2006-12-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Put object files in the current build
+	directory. 
+	* Makefile.in: Regenerate.
+2006-12-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Extract source code into current build
+	directory.
+	* Makefile.in: Regenerate.
+
+2006-12-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet (boottran::boottocl): Create the file
+	containing the translated program in the same directory as the
+	input file.
+
+2006-12-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (YEARWEEK): Use PACKAGE_STRING.
+	* Makefile.in: Regenerate.
+
+2006-12-01  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	* src/interp/alql.boot.pamphlet: Add FUNCALL to fix problem
+	with previous patch.
+	
+2006-12-01  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	Port from wh-sandbox.
+	* src/interp/alql.boot.pamphlet: Add package declaration,
+	getBrowseDatabase: modify to work with shoe.
+		
+2006-11-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Add support for OS that require extension for
+	exectuble files.
+	* Makefile.in: Regenerate.
+
+2006-11-24  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (all-axiomsys): Rename from axiomsys.
+	(all-debugsys, all-depsys): Likewise.
+	* Makefile.in: Regenerate.
+
+2006-11-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* ccl-debugsys.lsp.pamphlet: Move from ../boot.
+
+2006-11-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (BOOT_TO_LISP): Use $(axiom_build_document)
+	for translation from Boot.
+	(COMPILE_LISP): Use $(axiom_build_document) to compile Lisp code.
+	* Makefile.in: Regenerate.
+
+2006-11-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* as.boot.pamphlet (displayDatabase): Properly escape end-of-line
+	in multi-line list.
+
+2006-11-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (alql.boot): Translate with bootsys.
+	* Makefile.in: Regenerate.
+
+2006-11-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (BOOT_TO_LISP): Use boottoclc.
+
+2006-11-15  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	* daase.lisp.pamphlet: Document preloading of databases.
+	* Makefile.pamphlet (axiomsys): Add separate rule needed
+	to implement it.
+	* Makefile.in: Regenerate.
+	
+2006-11-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* daase.lisp.pamphlet: Sync with silver (revision 247).
+	* setq.lisp.pamphlet: Likewise.
+
+2006-11-05  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	* libdb.text, temp.text: remove
+	
+2006-11-03  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	* sockio.lisp.pamphlet (sock_get_string_buf_wrapper): new
+	function
+	(sock_get_string_buf): call it
+
+2006-10-31  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Make extracted Boot .PRECIOUS.
+	* Makefile.in: Regenerate.
+
+2006-10-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* trace.boot.pamphlet (ptimers): Fix string literals that
+	accidently spreads over two lines.
+
+2006-10-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Explain why def.$(OBJEXT) may be loaded
+	twice. 
+
+2006-10-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* newfort.boot.pamphlet (updateSymbolTable): Escape ! in names.
+
+2006-10-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* debugsys.lisp.pamphlet: Adjust path to Common Lisp source files,
+	to reflect changes in Makefile.
+
+	* Makefile.pamphlet (depsys_lisp_noncompiled_sources): Fix typo.
+	(DEP): Adjust paths to Lisp source files.
+	(OBJS): Have Lisp source filenames end with the extension .lisp.
+	(AXIOMsys_noncompiled_lisp_sources): New.
+	(AXIOMsys_compiled_lisp_sources): Likewise.
+	(OPOBJS): Use compiled form of postprop.
+	(<<extract source codes>>): New.
+	(PROCLAIMS): Adjust path to sys-pkg.
+	(${DEPSYS}): Adjust path to Lisp source files.
+	(${SAVESYS}): Likewise.
+
+	Remove indivudial rules for compiling Common Lisp source files.
+	We now use the implicit rules from <<extract source codes>>.
+
+2006-10-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* debugsys.lisp.pamphlet (build-interpsys): Load def.lisp only once.
+
+2006-10-26  Vanuexm Grégory  <g.vanuxem@wanadoo.fr>
+
+	* bookvol5.pamphlet (|importFromFrame|): Fix typo.
+
+2006-10-26  Camm Maguire  <camm@enhanced.com>
+
+	* sockio.lisp.pamphlet: Fix second argument-type for
+	sock_send_float defentry.
+
+2006-10-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* debugsys.lisp.pamphlet (build-interpsys): Adjust pathname to
+	files that are local to the current build directory.
+
+	* Makefile.pamphlet: Remove individual rules for making object
+	codes out of Boot pamphlet using bootsys.
+	(BOOT_TO_LISP, COMPILE_LISP): New.
+	(AXIOMsys_boot_sources): Likewise.  List core Boot files here.
+	(<<extract source codes>>): New chunk.  Abstract over special
+	individual rules to translate Boot to object code, using bootsys.
+	* Makefile.in: Regenerate.
+
+2006-10-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* bookvol5.pamphlet (\subsection{*default-pathname-defaults*}): Remove.
+	(restart): Don't set *default-pathname-defaults*.
+	(reroot): Likewise.
+	* patches.lisp.pamphlet (|cd|): Likewise.
+
+2006-10-20  Waldek Hebisch  <hebisch@math.uni.wroc.pl>
+
+	* Makefile.pamphlet: Correct misleading information about
+	TRANOBJS
+
+2006-10-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* g-util.boot.pamphlet (str2Tex): Change local variable name "of"
+	to "outf".
+
+2006-10-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (depsys_lisp_noncompiled_sources, 
+	depsys_lisp_compiled_sources): New.
+	(depsys_lisp_sources): USe them.
+	(depsys_boot_sources): New.
+	(depsys_lisp_macro_sources): Rename from depsys_lisp_sources.
+	(makedep.lisp): Create in builddir.
+
+2006-10-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (all-ax): Depend on $(MID) and $(AUTO).
+
+2006-10-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Remove references to ${MNT} throughout.
+	* Makefile.in: Regenerate.
+
+2006-10-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (<<document>>): Remove.
+
+2006-10-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (all): Rework.  Always keep stamp up-to-date
+	with respect to dependencies.
+	* Makefile.in: Regenerate.
+
+2006-10-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* debugsys.lisp.pamphlet: Fix misplaced parenthesis.
+
+2006-10-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (AXIOMSYS): Leave dirname to ${MNT}/${SYS}/bin
+	for the moment.
+	* Makefile.in: Regenerate.
+
+2006-09-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (BOOTSYS): Adjust definition.
+	(SAVESYS, AXIOMSYS): Likewise.
+	(<<save depsys image>>): Use "$@".
+	($(DEPSYS), $(SAVESYS)): Add dependency on $(axiom_build_bindir).
+	* Makefile.in: Regenerate.
+
+2006-09-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* util.lisp.pamphlet (build-depsys): Replace last six parameters
+	with only indicating the build directory.
+	(make_depsys): Likewise.
+	(build-interpsys): Lose last six parameters.
+	* Makefile.pamphlet (${DEPSYS}): Adjust call to build-depsys.
+	($(SAVESYS)) Adjust call to build-interpsys.
+	* debugsys.lisp.pamphlet: Likewise.
+
+2006-09-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (all): Create stamp file.
+	* Makefile.in: Regenerate.
+
+2006-09-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* debugsys.lisp.pamphlet: Don't load interp/sockio.o twice.
+
+2006-09-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (all): Don't build $(DOCFILES) yet.
+
+2006-09-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (subdir): New.
+	* Makefile.in: Regenerate.
+
+2006-09-17  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (LISPSYS, LOADSYS): Point to
+	$(axiom_build_bindir)/lisp. 
+	* Makefile.in: Regenerate.
+
+2006-09-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Throughout replace {O} with (OBJEXT).  OBJEXT
+	is Autoconf-detected.
+	* Makefile.in: Regenerate.
+
+2006-09-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (${SAVESYS}): Don't set
+	si::*system-directory*. 
+	* Makefile.in: Regenerate.
+	
+2006-09-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet:  Throughout, substitute $(srcdir) for ${IN}.
+	Use $(axiom_build_document) --tangle in lieu of ${TANGLE}.
+	Use $(axiom_src_srcdir) in lieu of ${SRC}.
+	Use simplify ${SRC}/doc to $(axiom_src_docdir).
+	
+
+2006-09-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Throughout, remove special rules for making
+	DVI files.  Use generic rules.
+	* Makefile.in: New.
+
+2006-08-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet: Don't overwrite $(TMP)/trace; append instead.
+
+2006-08-26  Camm Maguire  <camm@enhanced.com>
+
+	* hash.lisp.pamphlet (mem_value): no longer static.
+	* sockio.lisp.pamphlet (sock_get_float): Value type is now a double.
+	* cfuns.lisp.pamphlet (MYCOMBINE): Now take ints and return an int.
+
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
new file mode 100644
index 00000000..876e13cc
--- /dev/null
+++ b/src/interp/Makefile.in
@@ -0,0 +1,1113 @@
+
+subdir = src/interp/
+
+IN=$(srcdir)
+DOC=$(axiom_target_docdir)/src/interp
+BOOK=$(axiom_target_docdir)
+
+# Command to translate Boot to Common Lisp
+BOOT_TO_LISP = $(BOOTSYS) -- --translate $< 
+
+# Command to translate Common Lisp to native object code
+COMPILE_LISP = $(DEPSYS) -- --compile --output=$@ $<
+AUTO=$(axiom_targetdir)/autoload
+
+autoload_objects =
+
+# Build platform-dependent Lisp image, at the base of other
+# derived Lisp images (depsys, interpsys, AXIOMsys)
+LISPSYS= $(axiom_build_bindir)/lisp
+
+BOOTSYS= $(axiom_build_bindir)/bootsys    
+
+DEPSYS = ./depsys
+depsys_lisp_compiled_sources += parsing.lisp metalex.lisp bootlex.lisp \
+	newaux.lisp preparse.lisp postprop.lisp def.lisp metameta.lisp \
+	fnewmeta.lisp
+
+depsys_lisp_sources = $(depsys_lisp_noncompiled_sources) \
+			$(depsys_lisp_compiled_sources)
+
+depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \
+	g-boot.boot g-error.boot c-util.boot g-util.boot
+DEP=	nlib.lisp	\
+	macros.lisp	comp.lisp	\
+	spaderror.lisp	debug.lisp	\
+	spad.lisp	bits.lisp	\
+	setq.lisp	property.lisp	\
+	unlisp.lisp     foam_l.lisp      \
+	axext_l.lisp
+
+depsys_lisp_macro_sources = vmlisp.lisp ggreater.lisp hash.lisp \
+	bootfuns.lisp union.lisp nlib.lisp macros.lisp	\
+	comp.lisp spaderror.lisp debug.lisp \
+	spad.lisp bits.lisp setq.lisp property.lisp \
+	unlisp.lisp foam_l.lisp axext_l.lisp
+
+depsys_lisp_noncompiled_sources += $(depsys_lisp_macro_sources)
+depsys_lisp_SOURCES = $(addsuffix .pamphlet, $(depsys_lisp_sources))
+LOADSYS= $(axiom_build_bindir)/lisp$(EXEEXT)
+SAVESYS= interpsys$(EXEEXT)
+AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT)
+
+DEBUGSYS=$(axiom_build_bindir)/debugsys$(EXEEXT)
+
+OBJS=	vmlisp.$(FASLEXT)	hash.$(FASLEXT)	\
+	bootfuns.$(FASLEXT)	macros.$(FASLEXT)	\
+	unlisp.$(FASLEXT)	setq.$(FASLEXT)	\
+	astr.$(FASLEXT)	bits.$(FASLEXT)	\
+	alql.$(FASLEXT)	buildom.$(FASLEXT)	\
+	cattable.$(FASLEXT)				\
+	cformat.$(FASLEXT)	cfuns.$(FASLEXT)	\
+	clam.$(FASLEXT)	clammed.$(FASLEXT)	\
+	comp.$(FASLEXT)	        foam_l.$(FASLEXT) \
+	compat.$(FASLEXT)	compress.$(FASLEXT)	\
+	cparse.$(FASLEXT)	cstream.$(FASLEXT)	\
+	database.$(FASLEXT)	\
+	debug.$(FASLEXT)	dq.$(FASLEXT)		\
+	fname.$(FASLEXT)	format.$(FASLEXT)	\
+	g-boot.$(FASLEXT)	g-cndata.$(FASLEXT)	\
+	g-error.$(FASLEXT)	g-opt.$(FASLEXT)	\
+	g-timer.$(FASLEXT)	g-util.$(FASLEXT)	\
+	ggreater.$(FASLEXT)				\
+	hypertex.$(FASLEXT)	i-analy.$(FASLEXT)	\
+	i-code.$(FASLEXT)	i-coerce.$(FASLEXT)	\
+	i-coerfn.$(FASLEXT)	i-eval.$(FASLEXT)	\
+	i-funsel.$(FASLEXT)	bookvol5.$(FASLEXT)	\
+	i-intern.$(FASLEXT)	i-map.$(FASLEXT)	\
+	i-output.$(FASLEXT)	i-resolv.$(FASLEXT)	\
+	i-spec1.$(FASLEXT)				\
+	i-spec2.$(FASLEXT)	i-syscmd.$(FASLEXT)	\
+	i-toplev.$(FASLEXT)	i-util.$(FASLEXT)	\
+	incl.$(FASLEXT)	int-top.$(FASLEXT)	\
+	intfile.$(FASLEXT)				\
+	lisplib.$(FASLEXT)	macex.$(FASLEXT)	\
+	match.$(FASLEXT)				\
+	monitor.$(FASLEXT)	msg.$(FASLEXT)		\
+	msgdb.$(FASLEXT)	nci.$(FASLEXT)		\
+	newaux.$(FASLEXT)	newfort.$(FASLEXT)	\
+	nlib.$(FASLEXT)	nrunfast.$(FASLEXT)	\
+	nrungo.$(FASLEXT)	nrunopt.$(FASLEXT)	\
+	nruntime.$(FASLEXT)	osyscmd.$(FASLEXT)	\
+	packtran.$(FASLEXT)	pathname.$(FASLEXT)	\
+	pf2sex.$(FASLEXT)	pile.$(FASLEXT)	\
+	posit.$(FASLEXT)	property.$(FASLEXT)	\
+	ptrees.$(FASLEXT)	ptrop.$(FASLEXT)	\
+	record.$(FASLEXT)				\
+	rulesets.$(FASLEXT)	\
+	scan.$(FASLEXT)	serror.$(FASLEXT)	\
+	server.$(FASLEXT)				\
+	setvars.$(FASLEXT)	\
+	sfsfun-l.$(FASLEXT)	sfsfun.$(FASLEXT)	\
+	simpbool.$(FASLEXT)	slam.$(FASLEXT)	\
+	sockio.$(FASLEXT)	spad.$(FASLEXT)	\
+	spaderror.$(FASLEXT)				\
+	template.$(FASLEXT)	termrw.$(FASLEXT)	\
+	trace.$(FASLEXT)	\
+	union.$(FASLEXT)       daase.$(FASLEXT)  	\
+	fortcall.$(FASLEXT)
+
+interpsys_modules = $(patsubst %.$(FASLEXT), "%", $(OBJS))
+
+AXIOMsys_noncompiled_lisp_sources = bootfuns.lisp nocompil.lisp \
+	postprop.lisp property.lisp setq.lisp 
+
+AXIOMsys_compiled_lisp_sources = bits.lisp \
+	bootlex.lisp cfuns.lisp comp.lisp construc.lisp daase.lisp \
+	debug.lisp def.lisp fname.lisp fnewmeta.lisp ggreater.lisp \
+	hash.lisp macros.lisp metalex.lisp monitor.lisp newaux.lisp \
+	nlib.lisp nspadaux.lisp parsing.lisp \
+	patches.lisp preparse.lisp \
+	sockio.lisp spad.lisp spaderror.lisp \
+	union.lisp util.lisp vmlisp.lisp obey.lisp \
+	unlisp.lisp intint.lisp nci.lisp sfsfun-l.lisp \
+	axext_l.lisp foam_l.lisp
+
+AXIOMsys_boot_sources = astr.boot alql.boot buildom.boot cattable.boot \
+	cformat.boot clam.boot clammed.boot compat.boot compress.boot \
+	cparse.boot cstream.boot database.boot dq.boot format.boot \
+	g-boot.boot g-cndata.boot g-error.boot g-opt.boot g-timer.boot \
+	g-util.boot hypertex.boot i-analy.boot i-code.boot i-coerce.boot \
+	i-coerfn.boot i-eval.boot i-funsel.boot i-intern.boot i-map.boot \
+	i-output.boot i-resolv.boot i-spec1.boot i-spec2.boot \
+	i-syscmd.boot i-toplev.boot i-util.boot incl.boot int-top.boot \
+	intfile.boot lisplib.boot macex.boot match.boot msg.boot \
+	msgdb.boot newfort.boot nrunfast.boot nrungo.boot nrunopt.boot \
+	nruntime.boot osyscmd.boot packtran.boot pathname.boot \
+	pf2sex.boot pile.boot posit.boot ptrees.boot ptrop.boot \
+	record.boot rulesets.boot scan.boot serror.boot server.boot \
+	setvars.boot sfsfun.boot simpbool.boot slam.boot template.boot \
+	termrw.boot trace.boot fortcall.boot
+INOBJS=	varini.$(FASLEXT)	parini.$(FASLEXT)	\
+	setvart.$(FASLEXT)	intint.$(FASLEXT)	\
+        xrun.$(FASLEXT)        interop.$(FASLEXT)     \
+        patches.$(FASLEXT)
+
+IN_modules = $(patsubst %.$(FASLEXT), "%", $(INOBJS))
+
+# These are autloaded old parser files
+OPOBJS=	${AUTO}/parsing.$(FASLEXT)	${AUTO}/bootlex.$(FASLEXT)	\
+        ${AUTO}/def.$(FASLEXT)	\
+	${AUTO}/fnewmeta.$(FASLEXT)	${AUTO}/metalex.$(FASLEXT)	\
+	${AUTO}/metameta.$(FASLEXT)	\
+	${AUTO}/parse.$(FASLEXT)	${AUTO}/postpar.$(FASLEXT)	\
+	${AUTO}/postprop.$(FASLEXT)	${AUTO}/preparse.$(FASLEXT)
+
+autoload_objects += $(OPBJS)
+OCOBJS=	${AUTO}/apply.$(FASLEXT)	${AUTO}/c-doc.$(FASLEXT)	\
+	${AUTO}/c-util.$(FASLEXT)	${AUTO}/profile.$(FASLEXT)	\
+	${AUTO}/category.$(FASLEXT)	${AUTO}/compiler.$(FASLEXT)	\
+	${AUTO}/define.$(FASLEXT)	${AUTO}/functor.$(FASLEXT)	\
+	${AUTO}/info.$(FASLEXT)	${AUTO}/iterator.$(FASLEXT)	\
+	${AUTO}/modemap.$(FASLEXT)	${AUTO}/nruncomp.$(FASLEXT)	\
+	${AUTO}/package.$(FASLEXT)	${AUTO}/htcheck.$(FASLEXT)	\
+        ${AUTO}/xruncomp.$(FASLEXT)   
+
+autoload_objects += $(OCOBJS)
+
+BROBJS=	${AUTO}/bc-matrix.$(FASLEXT)				\
+	${AUTO}/bc-misc.$(FASLEXT)	${AUTO}/bc-solve.$(FASLEXT)	\
+	${AUTO}/bc-util.$(FASLEXT)				\
+	${AUTO}/ht-util.$(FASLEXT)	${AUTO}/htsetvar.$(FASLEXT)	\
+	${AUTO}/ht-root.$(FASLEXT)	\
+	${AUTO}/br-con.$(FASLEXT)	\
+	${AUTO}/br-data.$(FASLEXT)	${AUTO}/showimp.$(FASLEXT)    \
+	${AUTO}/br-op1.$(FASLEXT)	${AUTO}/br-op2.$(FASLEXT)	\
+	${AUTO}/br-search.$(FASLEXT)	${AUTO}/br-util.$(FASLEXT)	\
+	${AUTO}/topics.$(FASLEXT)     ${AUTO}/br-prof.$(FASLEXT)    \
+	${AUTO}/br-saturn.$(FASLEXT)
+
+autoload_objects += $(BFOBJS)
+
+TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT) \
+	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT) \
+	  ${AUTO}/def.$(FASLEXT)
+
+autoload_objects += $(TRANOBJS)
+
+NAGBROBJS= ${AUTO}/nag-c02.$(FASLEXT)   ${AUTO}/nag-c05.$(FASLEXT) \
+           ${AUTO}/nag-c06.$(FASLEXT)   ${AUTO}/nag-d01.$(FASLEXT) \
+           ${AUTO}/nag-d02.$(FASLEXT)   ${AUTO}/nag-d03.$(FASLEXT) \
+           ${AUTO}/nag-e01.$(FASLEXT)   ${AUTO}/nag-e02.$(FASLEXT) \
+           ${AUTO}/nag-e04.$(FASLEXT)   ${AUTO}/nag-f01.$(FASLEXT) \
+           ${AUTO}/nag-f02.$(FASLEXT)   ${AUTO}/nag-f04.$(FASLEXT) \
+           ${AUTO}/nag-f07.$(FASLEXT)   ${AUTO}/nag-s.$(FASLEXT) 
+
+autoload_objects += $(NAGBROBJS)
+
+ASCOMP= hashcode.$(FASLEXT) as.$(FASLEXT) \
+	foam_l.$(FASLEXT) axext_l.$(FASLEXT)
+
+AS_modules = $(patsubst %.$(FASLEXT), "%", $(ASCOMP))
+
+ASAUTO= ${AUTO}/ax.$(FASLEXT)
+
+autoload_objects += $(ASAUTO)
+TIMESTAMP=$(axiom_targetdir)/timestamp
+YEARWEEK=(progn (setq boot::timestamp "${TIMESTAMP}") \
+                (setq boot::*build-version* "$(PACKAGE_STRING)") \
+                (boot::yearweek))
+
+
+.PRECIOUS:	${DEPSYS}
+.PRECIOUS:	${SAVESYS}
+.PRECIOUS:	${AXIOMSYS}
+
+UNUSED= ${DOC}/anna.boot.dvi ${DOC}/construc.lisp.dvi \
+	${DOC}/domain.lisp.dvi 	${DOC}/guess.boot.dvi \
+	${DOC}/interp-fix.boot.dvi \
+	${DOC}/nhyper.boot.dvi ${DOC}/pf2atree.boot.dvi \
+	${DOC}/redefs.boot.dvi 	${DOC}/word.boot.dvi 
+
+
+.SUFFIXES:
+.SUFFIXES: .boot .clisp .lisp .pamphlet
+
+.PHONY: all all-ax all-depsys all-interpsys all-axiomsys all-debugsys
+
+all: all-ax
+
+all-ax: stamp
+	@echo finished $(srcdir)
+
+stamp: $(AUTO) remove-stamp build-images
+	$(STAMP) stamp
+
+.PHONY: remove-stamp
+remove-stamp:
+	-rm -f stamp
+
+.PHONY: build-images
+build-images: remove-stamp all-interpsys all-debugsys
+
+all-interpsys: all-depsys 
+	$(mkinstalldirs) $(AUTO)
+	$(MAKE) $(SAVESYS)
+
+all-axiomsys: all-depsys 
+	$(MAKE) $(AXIOMSYS)
+
+all-debugsys: all-interpsys
+	$(MAKE) $(DEBUGSYS)
+
+all-depsys: $(DEPSYS)
+
+.PRECIOUS: %.boot
+%.boot: $(srcdir)/%.boot.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+.PRECIOUS: %.clisp
+%.clisp: %.boot
+	$(BOOT_TO_LISP)
+.PRECIOUS: %.$(FASLEXT)
+%.$(FASLEXT): %.clisp
+	$(COMPILE_LISP)
+# Extract and compile the part of the interpreter written
+# in Common Lisp
+.PRECIOUS: %.lisp
+%.$(FASLEXT): %.lisp
+	$(COMPILE_LISP)
+
+%.lisp: $(srcdir)/%.lisp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+
+mostlyclean-local:
+	@rm -f *.fn *.data *.$(FASLEXT) *.lib
+
+clean-local: mostlyclean-local
+	@rm -f *.clisp *.lsp
+
+distclean-local: clean-local
+
+makeint.lisp:	${DEPSYS} ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
+                nocompil.lisp \
+	        ${OUTINTERP} ${OCOBJS} ${OPOBJS} ${BROBJS} obey.$(FASLEXT) \
+		database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \
+		${NAGBROBJS} ${TRANOBJS} \
+	        ${LOADSYS} \
+		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
+		$(axiom_src_docdir)/msgs/s2-us.msgs \
+	        ../algebra/warm.data
+	@ echo 5 invoking make in `pwd` with parms:
+	@rm -f makeint.lisp
+	@ echo SYS= ${SYS} 
+	@ echo LISP=${LISP} BYE=${BYE}
+	$(mkinstalldirs) $(axiom_target_datadir)/msgs
+	$(INSTALL_DATA) $(axiom_src_docdir)/msgs/s2-us.msgs \
+		 $(axiom_target_datadir)/msgs
+	@ echo '(|importModule| "vmlisp")' >> makeint.lisp
+	@ echo '(|importModule| "hash")' >> makeint.lisp
+	@ echo '(|importModule| "bootfuns")' >> makeint.lisp
+	@ echo '(gbc t)' >> makeint.lisp
+	@ echo '(load "nocompil.lisp")' >> makeint.lisp
+	@ echo '(|importModule| "bookvol5")' >> makeint.lisp
+	@ echo '(|importModule| "util")' >> makeint.lisp
+	@ echo '(in-package "BOOT")' >> makeint.lisp
+	@ touch ${TIMESTAMP}
+	@ echo '${YEARWEEK}' >> makeint.lisp
+	@ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${OPOBJS}))) (quote ($(patsubst %, "%", ${OCOBJS}))) (quote ($(patsubst %, "%", ${BROBJS}))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${NAGBROBJS}))) (quote ($(patsubst %, "%", ${ASAUTO})))  "${AXIOM}")' >> makeint.lisp
+	@ echo '(boot::set-restart-hook)' >> makeint.lisp
+	@ echo '(in-package "BOOT")' >> makeint.lisp
+	@ echo '(load "../algebra/warm.data")' >> makeint.lisp
+	@ echo '(boot::|clearClams|)' >> makeint.lisp
+	@ echo '(load "obey")' >> makeint.lisp
+	@ echo '#+:akcl (setq compiler::*suppress-compiler-notes* t)' >> makeint.lisp
+	@ echo '#+:akcl (si::gbc-time 0)' >> makeint.lisp
+	@ echo '(gbc t)' >> makeint.lisp
+
+${SAVESYS}: makeint.lisp
+	AXIOM="$(AXIOM)" DAASE="$(axiom_src_datadir)" \
+		$(LOADSYS) -- --make --output=$@ --main="BOOT::RESTART" \
+			 --load-directory=. makeint.lisp
+	@ echo 6 ${SAVESYS} created
+	$(mkinstalldirs) $(axiom_target_bindir)
+depsys_lisp_sources += parsing.lisp metalex.lisp bootlex.lisp \
+			newaux.lisp preparse.lisp postprop.lisp \
+			metameta.lisp fnewmeta.lisp
+
+depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \
+			g-boot.boot g-error.boot c-util.boot g-util.boot
+
+depsys_SOURCES = $(depsys_lisp_SOURCES) $(depsys_boot_SOURCES)
+
+depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \
+		util.$(FASLEXT) postpar.$(FASLEXT) parse.$(FASLEXT) \
+		parsing.$(FASLEXT) metalex.$(FASLEXT) bootlex.$(FASLEXT) \
+		newaux.$(FASLEXT) preparse.$(FASLEXT) postprop.$(FASLEXT) \
+		metameta.$(FASLEXT) fnewmeta.$(FASLEXT) clam.$(FASLEXT) \
+		slam.$(FASLEXT) g-boot.$(FASLEXT) c-util.$(FASLEXT) \
+		g-util.$(FASLEXT)
+
+${DEPSYS}:	vmlisp.$(FASLEXT) \
+		hash.$(FASLEXT) \
+		ggreater.$(FASLEXT) \
+		union.$(FASLEXT) \
+		bootfuns.$(FASLEXT) \
+		${DEP} \
+		nocompil.$(FASLEXT) \
+	        bookvol5.$(FASLEXT)\
+		util.$(FASLEXT) \
+	        postpar.clisp parse.clisp \
+	        parsing.lisp metalex.lisp \
+	        bootlex.lisp newaux.lisp \
+	        preparse.lisp \
+	        postprop.lisp def.lisp \
+	        metameta.lisp fnewmeta.lisp \
+		g-error.clisp \
+	        g-boot.clisp c-util.${LISP} \
+	        g-util.clisp \
+	        clam.clisp \
+	        slam.clisp
+	@ echo 3 making ${DEPSYS} 
+	@ rm -f makedep.lisp
+	@ $(mkinstalldirs) $(axiom_build_bindir)
+	@ echo '(|importModule| "vmlisp")' >> makedep.lisp
+	@ echo '(|importModule| "hash")' >> makedep.lisp
+	@ echo '(|importModule| "ggreater")' >> makedep.lisp
+	@ echo '(|importModule| "union")' >> makedep.lisp
+	@ echo '(|importModule| "bootfuns")' >> makedep.lisp
+	@ echo '(|importModule| "nocompil")' >> makedep.lisp
+	@ echo '(|importModule| "bookvol5")' >> makedep.lisp
+	@ echo '(|importModule| "util")' >> makedep.lisp
+	@ echo '(in-package "BOOT")' >> makedep.lisp
+	@ echo '(build-depsys (quote ($(patsubst %, "%", ${DEP}))) "${AXIOM}")' >> makedep.lisp
+	@ echo '(unless (probe-file "postpar.$(FASLEXT)") (compile-file "postpar.clisp" :output-file "postpar.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "postpar")' >> makedep.lisp
+	@ echo '(unless (probe-file "parse.$(FASLEXT)") (compile-file "parse.clisp" :output-file "parse.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "parse")' >> makedep.lisp
+	@ echo '(unless (probe-file "parsing.$(FASLEXT)") (compile-file "parsing.lisp" :output-file "parsing.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "parsing")' >> makedep.lisp
+	@ echo '(unless (probe-file "metalex.$(FASLEXT)") (compile-file "metalex.lisp" :output-file "metalex.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "metalex")' >> makedep.lisp
+	@ echo '(unless (probe-file "bootlex.$(FASLEXT)") (compile-file "bootlex.lisp" :output-file "bootlex.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "bootlex")' >> makedep.lisp
+	@ echo '(unless (probe-file "newaux.$(FASLEXT)") (compile-file "newaux.lisp" :output-file "newaux.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "newaux")' >> makedep.lisp
+	@ echo '(unless (probe-file "preparse.$(FASLEXT)") (compile-file "preparse.lisp" :output-file "preparse.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "preparse")' >> makedep.lisp
+	@ echo '(unless (probe-file "postprop.$(FASLEXT)") (compile-file "postprop.lisp" :output-file "postprop.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "postprop")' >> makedep.lisp
+	@ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "def")' >> makedep.lisp
+	@ echo '(unless (probe-file "metameta.$(FASLEXT)") (compile-file "metameta.lisp" :output-file "metameta.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "metameta")' >> makedep.lisp
+	@ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "fnewmeta.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "fnewmeta")' >> makedep.lisp
+	@ echo '(unless (probe-file "clam.$(FASLEXT)") (compile-file "clam.clisp" :output-file "clam.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "clam")' >> makedep.lisp
+	@ echo '(unless (probe-file "slam.$(FASLEXT)") (compile-file "slam.clisp" :output-file "slam.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "slam")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-error.$(FASLEXT)") (compile-file "g-error.clisp" :output-file "g-error.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-error")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-boot.$(FASLEXT)") (compile-file "g-boot.clisp" :output-file "g-boot.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-boot")' >> makedep.lisp
+	@ echo '(unless (probe-file "c-util.$(FASLEXT)") (compile-file "c-util.${LISP}" :output-file "c-util.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "c-util")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-util.$(FASLEXT)") (compile-file "g-util.clisp" :output-file "g-util.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-util")' >> makedep.lisp
+	../lisp/base-lisp$(EXEEXT) -- --make --output=$@ \
+		--load-directory=. makedep.lisp
+	@rm $(addsuffix .$(FASLEXT), \
+		postpar parse parsing metalex bootlex newaux preparse \
+		postprop def metameta fnewmeta clam slam g-error \
+		g-boot c-util g-util)
+	@ echo 4 ${DEPSYS} created
+
+
+util.$(FASLEXT): util.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+bookvol5.$(FASLEXT): bookvol5.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+nocompil.$(FASLEXT): nocompil.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+hash.$(FASLEXT): hash.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+union.$(FASLEXT): union.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+ggreater.$(FASLEXT): ggreater.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+vmlisp.$(FASLEXT): vmlisp.lisp
+	$(BOOTSYS) -- --compile --output=$@ $<
+
+.PHONY: all-axiomsys
+
+all-axiomsys: ${AXIOMSYS}
+
+${AXIOMSYS}: makeint.lisp
+	AXIOM="$(AXIOM)" DAASE="$(axiom_targetdir)" \
+		$(LOADSYS) -- --make --output=$@ --main="BOOT::RESTART" \
+			--load-directory=. makeint.lisp
+	@ echo 6a ${AXIOMSYS} created
+${DEBUGSYS}: debugsys.lisp
+	@ echo 7 building debugsys
+	@ echo '(progn (gbc t) (load "debugsys.lisp") (in-package "BOOT") (spad-save "$@"))' | ${LISPSYS}
+	@ echo 8 ${DEBUGSYS} created
+
+exposed.lsp: $(axiom_src_algdir)/exposed.lsp.pamphlet
+	@ echo 615 making exposed.lsp from $(axiom_src_algdir)/exposed.lsp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+
+$(axiom_targetdir)/algebra/exposed.$(FASLEXT) : exposed.lsp ${LISPSYS}
+	@ echo 616 making $@ from exposed.lsp
+	$(mkinstalldirs) $(axiom_targetdir)/algebra
+	@ echo '(progn  (compile-file "exposed.lsp" :output-file "$(axiom_targetdir)/algebra/exposed.$(FASLEXT)"))' | ${LISPSYS} 
+
+database.date:
+	@ echo 617 the database was updated...remaking interpsys
+	@ touch database.date
+
+
+${AUTO}/apply.$(FASLEXT): apply.$(FASLEXT)
+	@ echo 9 making ${AUTO}/apply.$(FASLEXT) from apply.$(FASLEXT)
+	@ cp apply.$(FASLEXT) ${AUTO}
+
+
+as.clisp: as.boot
+	@ echo 417 making $@ from $<
+	@ echo '(progn (old-boot::boot "as.boot"))' | ${DEPSYS}
+
+${AUTO}/ax.$(FASLEXT): ax.$(FASLEXT)
+	@ echo 461 making ${AUTO}/ax.$(FASLEXT) from ax.$(FASLEXT)
+	@ cp ax.$(FASLEXT) ${AUTO}
+
+ax.clisp: ax.boot
+	@ echo 463 making $@ $<
+	@ echo '(progn (old-boot::boot "ax.boot"))' | ${DEPSYS} 
+
+${AUTO}/bc-matrix.$(FASLEXT): bc-matrix.$(FASLEXT)
+	@ echo 422 making ${AUTO}/bc-matrix.$(FASLEXT) from bc-matrix.$(FASLEXT)
+	@ cp bc-matrix.$(FASLEXT) ${AUTO}
+
+bc-matrix.clisp: bc-matrix.boot
+	@ echo 424 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-matrix.boot"))' | ${DEPSYS}
+
+${AUTO}/bc-misc.$(FASLEXT): bc-misc.$(FASLEXT)
+	@ echo 426 making ${AUTO}/bc-misc.$(FASLEXT) from bc-misc.$(FASLEXT)
+	@ cp bc-misc.$(FASLEXT) ${AUTO}
+
+bc-misc.clisp: bc-misc.boot
+	@ echo 428 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-misc.boot"))' | ${DEPSYS}
+
+${AUTO}/bc-solve.$(FASLEXT): bc-solve.$(FASLEXT)
+	@ echo 430 making ${AUTO}/bc-solve.$(FASLEXT) from bc-solve.$(FASLEXT)
+	@ cp bc-solve.$(FASLEXT) ${AUTO}
+
+bc-solve.clisp: bc-solve.boot
+	@ echo 432 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-solve.boot"))' | ${DEPSYS}
+
+${AUTO}/bc-util.$(FASLEXT): bc-util.$(FASLEXT)
+	@ echo 434 making ${AUTO}/bc-util.$(FASLEXT) from bc-util.$(FASLEXT)
+	@ cp bc-util.$(FASLEXT) ${AUTO}
+
+bc-util.clisp: bc-util.boot
+	@ echo 436 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-util.boot"))' | ${DEPSYS}
+
+${AUTO}/bootlex.$(FASLEXT): bootlex.$(FASLEXT)
+	@ echo 19 making ${AUTO}/bootlex.$(FASLEXT) from bootlex.$(FASLEXT)
+	@ cp bootlex.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/br-con.$(FASLEXT): br-con.$(FASLEXT)
+	@ echo 465 making ${AUTO}/br-con.$(FASLEXT) from br-con.$(FASLEXT)
+	@ cp br-con.$(FASLEXT) ${AUTO}
+
+br-con.clisp: br-con.boot
+	@ echo 467 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-con.boot"))' | ${DEPSYS} 
+
+${AUTO}/br-data.$(FASLEXT): br-data.$(FASLEXT)
+	@ echo 481 making ${AUTO}/br-data.$(FASLEXT) from br-data.$(FASLEXT)
+	@ cp br-data.$(FASLEXT) ${AUTO}
+
+br-data.clisp: br-data.boot
+	@ echo 483 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-data.boot"))' | ${DEPSYS} 
+
+${AUTO}/br-op1.$(FASLEXT): br-op1.$(FASLEXT)
+	@ echo 473 making ${AUTO}/br-op1.$(FASLEXT) from br-op1.$(FASLEXT)
+	@ cp br-op1.$(FASLEXT) ${AUTO}
+
+br-op1.clisp: br-op1.boot
+	@ echo 475 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-op1.boot"))' | ${DEPSYS}
+
+${AUTO}/br-op2.$(FASLEXT): br-op2.$(FASLEXT)
+	@ echo 477 making ${AUTO}/br-op2.$(FASLEXT) from br-op2.$(FASLEXT)
+	@ cp br-op2.$(FASLEXT) ${AUTO}
+
+br-op2.clisp: br-op2.boot
+	@ echo 479 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-op2.boot"))' | ${DEPSYS} 
+
+${AUTO}/br-prof.$(FASLEXT): br-prof.$(FASLEXT)
+	@ echo 497 making ${AUTO}/br-prof.$(FASLEXT) from br-prof.$(FASLEXT)
+	@ cp br-prof.$(FASLEXT) ${AUTO}
+
+br-prof.clisp: br-prof.boot
+	@ echo 499 making $@ from $<
+	@ ($(axiom_build_document) --tangle --output=br-prof.boot $< ;\
+	  echo '(progn (old-boot::boot "br-prof.boot"))' | ${DEPSYS}; \
+	  rm br-prof.boot )
+
+
+${AUTO}/br-saturn.$(FASLEXT): br-saturn.$(FASLEXT)
+	@ echo 489 making ${AUTO}/br-saturn.$(FASLEXT) from br-saturn.$(FASLEXT)
+	@ cp br-saturn.$(FASLEXT) ${AUTO}
+
+br-saturn.clisp: br-saturn.boot
+	@ echo 491 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-saturn.boot"))' | ${DEPSYS}
+
+${AUTO}/br-search.$(FASLEXT): br-search.$(FASLEXT)
+	@ echo 469 making ${AUTO}/br-search.$(FASLEXT) from br-search.$(FASLEXT)
+	@ cp br-search.$(FASLEXT) ${AUTO}
+
+br-search.clisp: br-search.boot
+	@ echo 471 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-search.boot"))' | ${DEPSYS} 
+
+${AUTO}/br-util.$(FASLEXT): br-util.$(FASLEXT)
+	@ echo 485 making ${AUTO}/br-util.$(FASLEXT) from br-util.$(FASLEXT)
+	@ cp br-util.$(FASLEXT) ${AUTO}
+
+br-util.clisp: br-util.boot
+	@ echo 487 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-util.boot"))' | ${DEPSYS}
+
+buildom.clisp: buildom.boot
+	@ echo 143 making $@ from $<
+	@ echo '(progn (old-boot::boot "buildom.boot"))' | ${DEPSYS}
+
+
+${AUTO}/category.$(FASLEXT): category.$(FASLEXT)
+	@ echo 210 making ${AUTO}/ category.$(FASLEXT) from category.$(FASLEXT)
+	@ cp category.$(FASLEXT) ${AUTO}
+
+category.clisp: category.boot
+	@ echo 212 making $@ from $<
+	@ echo '(progn (old-boot::boot "category.boot"))' | ${DEPSYS} 
+
+cattable.clisp: cattable.boot
+	@ echo 215 making $@ from $<
+	@ echo '(progn (old-boot::boot "cattable.boot"))' | ${DEPSYS}
+
+${AUTO}/c-doc.$(FASLEXT): c-doc.$(FASLEXT)
+	@ echo 217 making ${AUTO}/c-doc.$(FASLEXT) from c-doc.$(FASLEXT)
+	@ cp c-doc.$(FASLEXT) ${AUTO}
+
+c-doc.clisp: c-doc.boot
+	@ echo 219 making $@ from $<
+	@ echo '(progn (old-boot::boot "c-doc.boot"))' | ${DEPSYS} 
+
+clammed.clisp: clammed.boot
+	@ echo 226 making $@ from $<
+	@ echo '(progn (old-boot::boot "clammed.boot"))' | ${DEPSYS} 
+
+compat.clisp: compat.boot
+	@ echo 229 making $@ from $<
+	@ echo '(progn (old-boot::boot "compat.boot"))' | ${DEPSYS} 
+
+${AUTO}/compiler.$(FASLEXT): compiler.$(FASLEXT)
+	@ echo 231 making ${AUTO}/compiler.$(FASLEXT) from compiler.$(FASLEXT)
+	@ cp compiler.$(FASLEXT) ${AUTO}
+
+compiler.clisp: compiler.boot
+	@ echo 233 making $@ from $<
+	@ echo '(progn (old-boot::boot "compiler.boot"))' | ${DEPSYS}
+
+${AUTO}/c-util.$(FASLEXT): c-util.$(FASLEXT)
+	@ echo 145 making ${AUTO}/c-util.$(FASLEXT) from c-util.$(FASLEXT)
+	@ cp c-util.$(FASLEXT) ${AUTO}
+
+c-util.${LISP}: $(srcdir)/c-util.boot.pamphlet
+	@ echo 146 making c-util.${LISP} from $(srcdir)/c-util.boot.pamphlet
+	@ rm -f c-util.$(FASLEXT)
+	$(axiom_build_document) --tangle=c-util.clisp --output=$@ $<
+
+c-util.clisp: c-util.boot
+	@ echo 148 making $@ from $<
+	@ echo '(progn (old-boot::boot "c-util.boot"))' | ${DEPSYS}
+
+
+database.clisp: database.boot
+	@ echo 243 making $@ from $<
+	@ echo '(progn (old-boot::boot "database.boot"))' | ${DEPSYS}
+
+debugsys.lisp: $(srcdir)/debugsys.lisp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+
+${AUTO}/def.$(FASLEXT): def.$(FASLEXT)
+	@ echo 41 making ${AUTO}/def.$(FASLEXT) from def.$(FASLEXT)
+	@ cp def.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/define.$(FASLEXT): define.$(FASLEXT)
+	@ echo 245 making ${AUTO}/define.$(FASLEXT) from define.$(FASLEXT)
+	@ cp define.$(FASLEXT) ${AUTO}
+
+define.clisp: define.boot
+	@ echo 247 making $@ from $<
+	@ echo '(progn (old-boot::boot "define.boot"))' | ${DEPSYS}
+
+${AUTO}/fnewmeta.$(FASLEXT): fnewmeta.$(FASLEXT)
+	@ echo 49 making ${AUTO}/fnewmeta.$(FASLEXT) from fnewmeta.$(FASLEXT)
+	@ cp fnewmeta.$(FASLEXT) ${AUTO}
+
+
+format.clisp: format.boot
+	@ echo 250 making $@ from $<
+	@ echo '(progn (old-boot::boot "format.boot"))' | ${DEPSYS}
+
+fortcall.clisp: fortcall.boot
+	@ echo 55 making $@ from $<
+	@ echo '(progn (old-boot::boot "fortcall.boot"))' | ${DEPSYS}
+
+
+${AUTO}/functor.$(FASLEXT): functor.$(FASLEXT)
+	@ echo 252 making ${AUTO}/functor.$(FASLEXT) from functor.$(FASLEXT)
+	@ cp functor.$(FASLEXT) ${AUTO}
+
+functor.clisp: functor.boot
+	@ echo 254 making $@ from $<
+	@ echo '(progn (old-boot::boot "functor.boot"))' | ${DEPSYS}
+
+g-cndata.clisp: g-cndata.boot
+	@ echo 261 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-cndata.boot"))' | ${DEPSYS}
+
+g-opt.clisp: g-opt.boot
+	@ echo 267 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-opt.boot"))' | ${DEPSYS}
+
+g-timer.clisp: g-timer.boot
+	@ echo 270 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-timer.boot"))' | ${DEPSYS}
+
+${AUTO}/htcheck.$(FASLEXT): htcheck.$(FASLEXT)
+	@ echo 453 making ${AUTO}/htcheck.$(FASLEXT) from htcheck.$(FASLEXT)
+	@ cp htcheck.$(FASLEXT) ${AUTO}
+
+htcheck.clisp: htcheck.boot
+	@ echo 455 making $@ from $<
+	@ echo '(progn (old-boot::boot "htcheck.boot"))' | ${DEPSYS}
+
+${AUTO}/ht-root.$(FASLEXT): ht-root.$(FASLEXT)
+	@ echo 449 making ${AUTO}/ht-root.$(FASLEXT) from ht-root.$(FASLEXT)
+	@ cp ht-root.$(FASLEXT) ${AUTO}
+
+ht-root.clisp: ht-root.boot
+	@ echo 451 making $@ from $<
+	@ echo '(progn (old-boot::boot "ht-root.boot"))' | ${DEPSYS}
+
+${AUTO}/htsetvar.$(FASLEXT): htsetvar.$(FASLEXT)
+	@ echo 442 making ${AUTO}/htsetvar.$(FASLEXT) from htsetvar.$(FASLEXT)
+	@ cp htsetvar.$(FASLEXT) ${AUTO}
+
+htsetvar.clisp: htsetvar.boot
+	@ echo 444 making $@ from $<
+	@ echo '(progn (old-boot::boot "htsetvar.boot"))' | ${DEPSYS}
+
+${AUTO}/ht-util.$(FASLEXT): ht-util.$(FASLEXT)
+	@ echo 438 making ${AUTO}/ht-util.$(FASLEXT) from ht-util.$(FASLEXT)
+	@ cp ht-util.$(FASLEXT) ${AUTO}
+
+ht-util.clisp: ht-util.boot
+	@ echo 440 making $@ from $<
+	@ echo '(progn (old-boot::boot "ht-util.boot"))' | ${DEPSYS}
+
+hypertex.clisp: hypertex.boot
+	@ echo 277 making $@ from $<
+	@ echo '(progn (old-boot::boot "hypertex.boot"))' | ${DEPSYS}
+
+i-analy.clisp: i-analy.boot
+	@ echo 280 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-analy.boot"))' | ${DEPSYS}
+
+i-code.clisp: i-code.boot
+	@ echo 283 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-code.boot"))' | ${DEPSYS}
+
+i-coerce.clisp: i-coerce.boot
+	@ echo 286 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-coerce.boot"))' | ${DEPSYS}
+
+i-coerfn.clisp: i-coerfn.boot
+	@ echo 289 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-coerfn.boot"))' | ${DEPSYS}
+
+i-eval.clisp: i-eval.boot
+	@ echo 292 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-eval.boot"))' | ${DEPSYS}
+
+i-funsel.clisp: i-funsel.boot
+	@ echo 295 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-funsel.boot"))' | ${DEPSYS}
+
+bookvol5.lisp: $(srcdir)/bookvol5.pamphlet
+	@ echo 298 making $@ from $<
+	$(axiom_build_document) --tangle=Interpreter --output=$@ $<
+
+i-intern.clisp: i-intern.boot
+	@ echo 301 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-intern.boot"))' | ${DEPSYS}
+
+i-map.clisp: i-map.boot
+	@ echo 304 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-map.boot"))' | ${DEPSYS} 
+
+${AUTO}/info.$(FASLEXT): info.$(FASLEXT)
+	@ echo 327 making ${AUTO}/info.$(FASLEXT) from info.$(FASLEXT)
+	@ cp info.$(FASLEXT) ${AUTO}
+
+info.clisp: info.boot
+	@ echo 329 making $@ from $<
+	@ echo '(progn (old-boot::boot "info.boot"))' | ${DEPSYS}
+
+i-output.clisp: i-output.boot
+	@ echo 307 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-output.boot"))' | ${DEPSYS}
+
+i-resolv.clisp: i-resolv.boot
+	@ echo 310 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-resolv.boot"))' | ${DEPSYS}
+
+i-spec1.clisp: i-spec1.boot
+	@ echo 313 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-spec1.boot"))' | ${DEPSYS}
+
+i-spec2.clisp: i-spec2.boot
+	@ echo 316 making $@ from i-spec2.boot
+	@ echo '(progn (old-boot::boot "i-spec2.boot"))' | ${DEPSYS} 
+
+i-syscmd.clisp: i-syscmd.boot
+	@ echo 319 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-syscmd.boot"))' | ${DEPSYS}
+
+${AUTO}/iterator.$(FASLEXT): iterator.$(FASLEXT)
+	@ echo 331 making ${AUTO}/iterator.$(FASLEXT) from iterator.$(FASLEXT)
+	@ cp iterator.$(FASLEXT) ${AUTO}
+
+iterator.clisp: iterator.boot
+	@ echo 333 making $@ from $<
+	@ echo '(progn (old-boot::boot "iterator.boot"))' | ${DEPSYS}
+
+i-toplev.clisp: i-toplev.boot
+	@ echo 322 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-toplev.boot"))' | ${DEPSYS}
+
+i-util.clisp: i-util.boot
+	@ echo 325 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-util.boot"))' | ${DEPSYS}
+
+lisplib.clisp: lisplib.boot
+	@ echo 336 making $@ from $<
+	@ echo '(progn (old-boot::boot "lisplib.boot"))' | ${DEPSYS}
+
+${AUTO}/mark.$(FASLEXT): mark.$(FASLEXT)
+	@ cp $< $@
+
+
+match.clisp: match.boot
+	@ echo 339 making $@ from $<
+	@ echo '(progn (old-boot::boot "match.boot"))' | ${DEPSYS}
+
+${AUTO}/metalex.$(FASLEXT): metalex.$(FASLEXT)
+	@ echo 66 making ${AUTO}/metalex.$(FASLEXT) from metalex.$(FASLEXT)
+	@ cp metalex.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/metameta.$(FASLEXT): metameta.$(FASLEXT)
+	@ echo 71 making ${AUTO}/metameta.$(FASLEXT) from metameta.$(FASLEXT)
+	@ cp metameta.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/modemap.$(FASLEXT): modemap.$(FASLEXT)
+	@ echo 341 making ${AUTO}/modemap.$(FASLEXT) from modemap.$(FASLEXT)
+	@ cp modemap.$(FASLEXT) ${AUTO}
+
+modemap.clisp: modemap.boot
+	@ echo 343 making $@ from $<
+	@ echo '(progn (old-boot::boot "modemap.boot"))' | ${DEPSYS}
+
+msgdb.clisp: msgdb.boot
+	@ echo 346 making $@ from $<
+	@ echo '(progn (old-boot::boot "msgdb.boot"))' | ${DEPSYS}
+
+${AUTO}/nag-c02.$(FASLEXT): nag-c02.$(FASLEXT)
+	@ echo 150 making${AUTO}/nag-c02.$(FASLEXT) from nag-c02.$(FASLEXT)
+	@ cp nag-c02.$(FASLEXT) ${AUTO}
+
+nag-c02.clisp: nag-c02.boot
+	@ echo 152 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c02.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-c05.$(FASLEXT): nag-c05.$(FASLEXT)
+	@ echo 154 making ${AUTO}/nag-c05.$(FASLEXT) from nag-c05.$(FASLEXT)
+	@ cp nag-c05.$(FASLEXT) ${AUTO}
+
+nag-c05.clisp: nag-c05.boot
+	@ echo 156 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c05.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-c06.$(FASLEXT): nag-c06.$(FASLEXT)
+	@ echo 158 making${AUTO}/nag-c06.$(FASLEXT) from nag-c06.$(FASLEXT)
+	@ cp nag-c06.$(FASLEXT) ${AUTO}
+
+nag-c06.clisp: nag-c06.boot
+	@ echo 160 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c06.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-d01.$(FASLEXT): nag-d01.$(FASLEXT)
+	@ echo 162 making${AUTO}/nag-d01.$(FASLEXT) from nag-d01.$(FASLEXT)
+	@ cp nag-d01.$(FASLEXT) ${AUTO}
+
+nag-d01.clisp: nag-d01.boot
+	@ echo 164 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d01.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-d02.$(FASLEXT): nag-d02.$(FASLEXT)
+	@ echo 166 making${AUTO}/nag-d02.$(FASLEXT) from nag-d02.$(FASLEXT)
+	@ cp nag-d02.$(FASLEXT) ${AUTO}
+
+nag-d02.clisp: nag-d02.boot
+	@ echo 168 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d02.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-d03.$(FASLEXT): nag-d03.$(FASLEXT)
+	@ echo 170 making${AUTO}/nag-d03.$(FASLEXT) from nag-d03.$(FASLEXT)
+	@ cp nag-d03.$(FASLEXT) ${AUTO}
+
+nag-d03.clisp: nag-d03.boot
+	@ echo 172 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d03.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-e01.$(FASLEXT): nag-e01.$(FASLEXT)
+	@ echo 174 making ${AUTO}/nag-e01.$(FASLEXT) from nag-e01.$(FASLEXT)
+	@ cp nag-e01.$(FASLEXT) ${AUTO}
+
+nag-e01.clisp: nag-e01.boot
+	@ echo 176 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e01.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-e02.$(FASLEXT): nag-e02.$(FASLEXT)
+	@ echo 182 making ${AUTO}/nag-e02.$(FASLEXT) from nag-e02.$(FASLEXT)
+	@ cp nag-e02.$(FASLEXT) ${AUTO}
+
+nag-e02.clisp: nag-e02.boot
+	@ echo 184 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e02.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-e04.$(FASLEXT): nag-e04.$(FASLEXT)
+	@ echo 186 making ${AUTO}/nag-e04.$(FASLEXT) from nag-e04.$(FASLEXT)
+	@ cp nag-e04.$(FASLEXT) ${AUTO}
+
+nag-e04.clisp: nag-e04.boot
+	@ echo 188 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e04.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-f01.$(FASLEXT): nag-f01.$(FASLEXT)
+	@ echo 190 making ${AUTO}/nag-f01.$(FASLEXT) from nag-f01.$(FASLEXT)
+	@ cp nag-f01.$(FASLEXT) ${AUTO}
+
+nag-f01.clisp: nag-f01.boot
+	@ echo 192 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f01.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-f02.$(FASLEXT): nag-f02.$(FASLEXT)
+	@ echo 194 making ${AUTO}/nag-f02.$(FASLEXT) from nag-f02.$(FASLEXT)
+	@ cp nag-f02.$(FASLEXT) ${AUTO}
+
+nag-f02.clisp: nag-f02.boot
+	@ echo 196 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f02.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-f04.$(FASLEXT): nag-f04.$(FASLEXT)
+	@ echo 198 making ${AUTO}/nag-f04.$(FASLEXT) from nag-f04.$(FASLEXT)
+	@ cp nag-f04.$(FASLEXT) ${AUTO}
+
+nag-f04.clisp: nag-f04.boot
+	@ echo 200 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f04.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-f07.$(FASLEXT): nag-f07.$(FASLEXT)
+	@ echo 202 making ${AUTO}/nag-f07.$(FASLEXT) from nag-f07.$(FASLEXT)
+	@ cp nag-f07.$(FASLEXT) ${AUTO}
+
+nag-f07.clisp: nag-f07.boot
+	@ echo 204 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f07.boot"))' | ${DEPSYS}
+
+
+${AUTO}/nag-s.$(FASLEXT): nag-s.$(FASLEXT)
+	@ echo 206 making ${AUTO}/nag-s.$(FASLEXT) from nag-s.$(FASLEXT)
+	@ cp nag-s.$(FASLEXT) ${AUTO}
+
+nag-s.clisp: nag-s.boot
+	@ echo 208 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-s.boot"))' | ${DEPSYS}
+
+
+newfort.clisp: newfort.boot
+	@ echo 349 making $@ from $<
+	@ echo '(progn (old-boot::boot "newfort.boot"))' | ${DEPSYS}
+
+${AUTO}/nruncomp.$(FASLEXT): nruncomp.$(FASLEXT)
+	@ echo 351 making ${AUTO}/nruncomp.$(FASLEXT) from nruncomp.$(FASLEXT)
+	@ cp nruncomp.$(FASLEXT) ${AUTO}
+
+nruncomp.clisp: nruncomp.boot
+	@ echo 353 making $@ from $<
+	@ echo '(progn (old-boot::boot "nruncomp.boot"))' | ${DEPSYS}
+
+nrunfast.clisp: nrunfast.boot
+	@ echo 356 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrunfast.boot"))' | ${DEPSYS}
+
+nrungo.clisp: nrungo.boot
+	@ echo 359 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrungo.boot"))' | ${DEPSYS}
+
+nruntime.clisp: nruntime.boot
+	@ echo 362 making $@ from $<
+	@ echo '(progn (old-boot::boot "nruntime.boot"))' | ${DEPSYS}
+
+nrunopt.clisp: nrunopt.boot
+	@ echo 365 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrunopt.boot"))' | ${DEPSYS}
+
+${AUTO}/nspadaux.$(FASLEXT): nspadaux.$(FASLEXT)
+	@ echo 89 making ${AUTO}/nspadaux.$(FASLEXT) from nspadaux.$(FASLEXT)
+	@ cp nspadaux.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/package.$(FASLEXT): package.$(FASLEXT)
+	@ echo 370 making ${AUTO}/package.$(FASLEXT) from package.$(FASLEXT)
+	@ cp package.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/parse.$(FASLEXT): parse.$(FASLEXT)
+	@ echo 374 making ${AUTO}/parse.$(FASLEXT) from parse.$(FASLEXT)
+	@ cp parse.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/parsing.$(FASLEXT): parsing.$(FASLEXT)
+	@ echo 94 making ${AUTO}/parsing.$(FASLEXT) from parsing.$(FASLEXT)
+	@ cp parsing.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/postpar.$(FASLEXT): postpar.$(FASLEXT)
+	@ echo 382 making ${AUTO}/postpar.$(FASLEXT) from postpar.$(FASLEXT)
+	@ cp postpar.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/postprop.$(FASLEXT): postprop.$(FASLEXT)
+	@ echo 102 making $@ from $<
+	@ cp $< ${AUTO}
+
+
+${AUTO}/preparse.$(FASLEXT): preparse.$(FASLEXT)
+	@ echo 106 making ${AUTO}/preparse.$(FASLEXT) from preparse.$(FASLEXT)
+	@ cp preparse.$(FASLEXT) ${AUTO}
+
+
+${AUTO}/profile.$(FASLEXT): profile.$(FASLEXT)
+	@ echo 235 making ${AUTO}/profile.$(FASLEXT) from profile.$(FASLEXT)
+	@ cp profile.$(FASLEXT) ${AUTO}
+
+profile.clisp: profile.boot
+	@ echo 237 making $@ from $<
+	@ echo '(progn (old-boot::boot "profile.boot"))' | ${DEPSYS}
+
+${AUTO}/pspad1.$(FASLEXT):  pspad1.$(FASLEXT)
+	@ cp $< $@
+
+${AUTO}/pspad2.$(FASLEXT):  pspad2.$(FASLEXT)
+	@ cp $< $@
+
+record.clisp: record.boot
+	@ echo 447 making $@ $<
+	@ echo '(progn (old-boot::boot "record.boot"))' | ${DEPSYS}
+
+rulesets.clisp: rulesets.boot
+	@ echo 388 making $@ from $<
+	@ echo '(progn (old-boot::boot "rulesets.boot"))' | ${DEPSYS}
+
+server.clisp: server.boot
+	@ echo 391 making $@ from $<
+	@ echo '(progn (old-boot::boot "server.boot"))' | ${DEPSYS}
+
+setvart.clisp: setvart.boot
+	@ echo 398 making $@ from $<
+	@ echo '(progn (old-boot::boot "setvart.boot"))' | ${DEPSYS}
+
+${AUTO}/showimp.$(FASLEXT): showimp.$(FASLEXT)
+	@ echo 579 making ${AUTO}/showimp.$(FASLEXT) from showimp.$(FASLEXT)
+	@ cp showimp.$(FASLEXT) ${AUTO}
+
+
+template.clisp: template.boot
+	@ echo 408 making $@ from $<
+	@ echo '(progn (old-boot::boot "template.boot"))' | ${DEPSYS} 
+
+termrw.clisp: termrw.boot
+	@ echo 411 making $@ from $<
+	@ echo '(progn (old-boot::boot "termrw.boot"))' | ${DEPSYS} 
+
+${AUTO}/topics.$(FASLEXT): topics.$(FASLEXT)
+	@ echo 493 making ${AUTO}/topics.$(FASLEXT) from topics.$(FASLEXT)
+	@ cp topics.$(FASLEXT) ${AUTO}
+
+topics.clisp: topics.boot
+	@ echo 495 making $@ from $<
+	@ echo '(progn (old-boot::boot "topics.boot"))' | ${DEPSYS} 
+
+trace.clisp: trace.boot
+	@ echo 414 making $@ from $<
+	@ echo '(progn (old-boot::boot "trace.boot"))' | ${DEPSYS}
+
+../algebra/warm.data: $(srcdir)/Makefile.pamphlet
+	@ echo 2 building warm.data
+	$(axiom_build_document) --tangle=warm.data --output=$@ $<
+
+
+${AUTO}/wi1.$(FASLEXT): wi1.$(FASLEXT) 
+	@ cp $< $@
+
+${AUTO}/wi2.$(FASLEXT):  wi2.$(FASLEXT)
+	@ cp $< $@
+
+${AUTO}/xruncomp.$(FASLEXT): xruncomp.$(FASLEXT)
+	@ echo 457 making ${AUTO}/xruncomp.$(FASLEXT) from xruncomp.$(FASLEXT)
+	@ cp xruncomp.$(FASLEXT) ${AUTO}
+
+xruncomp.clisp: xruncomp.boot
+	@ echo 459 making $@ from $<
+	@ echo '(progn (old-boot::boot "xruncomp.boot"))' | ${DEPSYS}
+
+$(axiom_build_texdir)/diagrams.tex: $(axiom_src_docdir)/diagrams.tex
+	$(INSTALL_DATA) $< $@
+
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
new file mode 100644
index 00000000..a5024ddb
--- /dev/null
+++ b/src/interp/Makefile.pamphlet
@@ -0,0 +1,2835 @@
+%% Oh Emacs, this is a -*- Makefile -*-, so give me tabs.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/Makefile} Pamphlet}
+\author{Timothy Daly \and Gabriel Dos~Reis}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\begin{verbatim}
+notes for understanding this makefile:
+re: postpar.clisp and parse.clisp stanzas: 
+NOTE: the .clisp file is copies back into the src directory so that
+it is possible to create a new obootsys system from scratch for a 
+new platform. parse.clisp needs to be compiled in a depsys.
+one thing need to be done to create an obootsys by hand:
+  parse and postpar must be loaded along with the depsys files
+     into a bare lisp system.
+if these two things are done then a obootsys image can be bootstrapped
+to a new platform.
+
+IMPORTANT: all source file names in this Makefile must be lowercase
+  This is for cross-platform compatibility and also makes getting
+  them into Lisp much easier at the Makefile level.
+
+\end{verbatim}
+
+
+\section{The Environment}
+
+We define 3 directories for this build. The first two are
+the traditional {\bf IN}, which is where the source pamphlets are,
+and {\bf OUT} which is where we will put the binaries.
+
+In this case the {\bf IN} files are usually written in Boot \cite{2}.
+These will be compiled in a \Tool{bootsys} image to translate from
+Boot to Common Lisp. 
+
+\subsection{Documentation}
+
+The dvi files will be generated from the pamphlet files in the
+final ship \File{doc/src/} directory. Since they are system independent 
+but machine generated and part of the final ship they will exist 
+in the [[\$(axiom_target_docdir)/src/interp/]] directory.
+
+<<environment>>=
+IN=$(srcdir)
+DOC=$(axiom_target_docdir)/src/interp
+BOOK=$(axiom_target_docdir)
+
+# Command to translate Boot to Common Lisp
+BOOT_TO_LISP = $(BOOTSYS) -- --translate $< 
+
+# Command to translate Common Lisp to native object code
+COMPILE_LISP = $(DEPSYS) -- --compile --output=$@ $<
+@
+
+
+\subsection{Autloload}
+
+In order to minimize the size of the Axiom image at load time
+we put some of the compiled files into a separate directory
+that will be autoloaded on demand. This directory of code
+will be shipped with the final system and so it belongs in
+the [[$(axiom_targetdir)]] subtree.
+<<environment>>=
+AUTO=$(axiom_targetdir)/autoload
+
+autoload_objects =
+
+@
+
+
+\subsection{Initial Lisp image}
+
+We need a raw Lisp image --- running on the build platform ---
+that we can use as a base to construct
+the other images. This is called {\bf LISPSYS} and is located in the
+build platform sub-directory.
+<<environment>>=
+# Build platform-dependent Lisp image, at the base of other
+# derived Lisp images (depsys, interpsys, AXIOMsys)
+LISPSYS= $(axiom_build_bindir)/lisp
+
+@
+
+\subsection{Boot translator}
+
+Most of the interpreter is written in the Boot programming language. 
+Thus we need a program to translate Boot to Common
+Lisp.  That program is called the {\bf BOOTSYS} image (because the
+translator is written in {\bf boot} and needs to translate
+itself to bootstrap the system).  This image is assumed to
+have been built (on the build platform) by a previous step in the
+make process.
+<<environment>>=
+BOOTSYS= $(axiom_build_bindir)/bootsys    
+
+@
+
+Note also that another translator (built into [[depsys]]) translates
+a variant og Boot (called ``old Boot'') to Common Lisp.
+
+
+\subsection{The old Boot translator}
+
+<<environment>>=
+DEPSYS = ./depsys
+@
+
+Some of the Common Lisp code we compile uses macros which
+are assumed to be available at compile time. The [[DEPSYS]]
+image is created to contain the compile time environment
+and saved.  Furthermore, it is also used to translate codes written
+in ``old Boot'' to Common Lisp.  That translator is in the process of
+being phased out in favor of the ``new Boot'' translator found in
+\File{src/boot/}.
+
+\subsubsection{Structure of [[depsys]]}
+
+The [[depsys]] image is made of the following Lisp source files
+
+\begin{description}
+\item[Interpreted Lisp source files]
+  The following files are currently part of [[depsys]] in interpreted
+  form.  The exact reasons for that are not well articulated.
+
+  \begin{description}
+    \item[\File{nocompil.lisp}]  This file defines obscure functions
+    that seem to be there only for obscure reasons.  Most of them are not
+    really needed for translating Boot codes.
+  
+    \item[\File{bookvol5.lisp}]  This file defines functions for
+    the Spad interpreter.  None of which seems relevant for translating
+    Boot codes to Common Lisp.
+
+    \item[\File{util.lisp}] This file defines various ``system-level''
+    helper functions, for building [[depsys]], [[interpsys]], etc.
+
+    \item[\File{vmlisp.lisp}]  This is a collection of various utility
+    functions, encapsulations of variabilities of Lisp implementations.
+    All those symbols are defined in the package [[VMLISP]].
+    It needs some strip down, and possibly have its contents moved
+    to the package [[BOOT]].
+
+    \item[\File{ggreater.lisp}]  This file defines various orderings 
+    on collections and other aggregates.  Its content is defined in the
+    package [[VMLISP]].
+
+    \item[\File{hash.lisp}]  This file defines a ``hash table'' module.
+    Its content is defined in package [[VMLISP]].
+
+    \item[\File{bootfuns.lisp}]  This file collects forward references
+    of functions that are needed in the [[BOOT]] package, to be defined
+    latter.  It is not at all clear that this file is needed to
+    build the Boot to Common Lisp translator.  Its content is
+    defined in package [[BOOT]].
+
+    \item[\File{union.lisp}]  This file defines functions that
+    compute set-theoretic operations (union, difference, intersection, etc.).
+    Its content is in package [[VMLISP]].
+
+    \item[\File{nlib.lisp}]  This file defines to work around problems
+    with GCL when compiling Spad files.  It is not necessary for
+    translating Boot codes to Common Lisp.  Its content is in package
+    [[VMLISP]].
+
+    \item[\File{macros.lisp}]  This file collects various helper macros
+    and functions for Boot and Spad codes.
+
+    \item[\File{comp.lisp}]  This file defines several functions that
+    desugar Boot and Spad codes; in particular, they infer local
+    variables from their position in assignment expressions.  Its
+    content is defined in package [[BOOT]].
+
+    \item[\File{spaderror.lisp}]  This file defines error handling functions
+    that are useful only for Spad codes -- not for translating Boot codes.
+    Its content is defined in package [[BOOT]].
+
+    \item[\File{debug.lisp}] This file defines debug utilities for
+    essentially Spad codes.  Its content is defined in package [[BOOT]].
+
+    \item[\File{spad.lisp}]  This files defines the entry points for
+    processing Spad and Boot codes.  Its content is defined in package
+    [[BOOT]].
+
+    \item[\File{bits.lisp}]  This file implements a ``bit vector''
+    data type.  Its content is in package [[BOOT]].
+
+    \item[\File{setq.lisp}]  This file defines several global
+    variables.  Its content is defined in package [[BOOT]].
+
+    \item[\File{property.lisp}]  This file defines properties of
+     Spad and Boot tokens, as well as several constructors.  Its
+    content is defined in package [[BOOT]].
+ 
+    \item[\File{unlisp.lisp}]  This file attempts to define interfaces
+    to the Operating System, that are not found in strict ANSI 
+    Common Lisp (though they may be present as extensions with
+    varying spellings.).  Its content is defined in package [[BOOT]].
+
+    \item[\File{foam\_l.lisp}]  This file defines the FOAM functions.
+    The packages [[FOAM]] and [[FOAM-USER]] are defined here.
+    It is not needed for translating Boot codes to Common Lisp.
+
+    \item[\File{axext\_l.lisp}]  This file defines various macros and
+    functions for interoperability between Aldor and Axiom.  Not needed
+    for translating Boot codes to Common Lisp.
+  \end{description}
+
+\item[Compiled Lisp source files]
+  \begin{description}
+    \item[\File{parsing.lisp}]
+   
+    \item[\File{metalex.lisp}]
+
+    \item[\File{bootlex.lisp}]
+
+    \item[\File{newaux.lisp}]
+
+    \item[\File{preparse.lisp}]
+
+    \item[\File{postprop.lisp}]
+
+    \item[\File{def.lisp}]
+
+    \item[\File{metameta.lisp}]
+ 
+    \item[\File{fnewmeta.lisp}]
+  \end{description}
+
+\item[Compiled Boot source files]
+  \begin{description}
+    \item[\File{postpar.boot}]
+
+    \item[\File{parse.boot}]
+
+    \item[\File{clam.boot}]
+
+    \item[\File{slam.boot}]
+
+    \item[\File{g-boot.boot}]
+
+    \item[\File{c-util.boot}]
+
+    \item[\File{g-util.boot}]
+  \end{description}
+
+\end{description}
+
+%
+<<environment>>=
+depsys_lisp_compiled_sources += parsing.lisp metalex.lisp bootlex.lisp \
+	newaux.lisp preparse.lisp postprop.lisp def.lisp metameta.lisp \
+	fnewmeta.lisp
+
+depsys_lisp_sources = $(depsys_lisp_noncompiled_sources) \
+			$(depsys_lisp_compiled_sources)
+
+depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \
+	g-boot.boot g-error.boot c-util.boot g-util.boot
+@
+
+The {\bf DEP} variable contains the list of files that
+will be loaded into {\bf DEPSYS}. Notice that these files
+are loaded in interpreted form. We are not concerned about
+the compile time performance so we can use interpreted code.
+We do, however, care about the macros as these will be
+expanded in later compiles. All macros are assumed to be
+in this list of files.
+<<environment>>=
+DEP=	nlib.lisp	\
+	macros.lisp	comp.lisp	\
+	spaderror.lisp	debug.lisp	\
+	spad.lisp	bits.lisp	\
+	setq.lisp	property.lisp	\
+	unlisp.lisp     foam_l.lisp      \
+	axext_l.lisp
+
+depsys_lisp_macro_sources = vmlisp.lisp ggreater.lisp hash.lisp \
+	bootfuns.lisp union.lisp nlib.lisp macros.lisp	\
+	comp.lisp spaderror.lisp debug.lisp \
+	spad.lisp bits.lisp setq.lisp property.lisp \
+	unlisp.lisp foam_l.lisp axext_l.lisp
+
+depsys_lisp_noncompiled_sources += $(depsys_lisp_macro_sources)
+depsys_lisp_SOURCES = $(addsuffix .pamphlet, $(depsys_lisp_sources))
+@
+
+Once we've compile all of the Common Lisp files we fire up
+a clean lisp image called {\bf LOADSYS} (from the build platform), load all 
+of the
+final executable code and save it out as {\bf SAVESYS}.  This image
+is used to bootstrap the Algebra files and generate the
+databases.  
+The {\bf SAVESYS} image is copied to the [[$(axiom_target_bindir)]]
+subdirectory and becomes the axiom executable image.  Technically, that is
+not right because the host plaform may not be the same as the build
+platform.  However, we don't yet support cross compilation, so that
+is alright for the time being.
+<<environment>>=
+LOADSYS= $(axiom_build_bindir)/lisp$(EXEEXT)
+SAVESYS= interpsys$(EXEEXT)
+AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT)
+
+@
+
+\subsection{Debugging [[depsys]]}
+
+Occasionally we need to really get into the system internals.
+The best way to do this is to run almost all of the lisp code
+interpreted rather than compiled (note that cfuns.lisp and sockio.lisp
+still need to be loaded in compiled form as they depend on the 
+loader to link with lisp internals). This image is nothing more
+than a load of the file \File{src/interp/debugsys.lisp.pamphlet}. If
+you need to make test modifications you can add code to that
+file and it will show up here.
+<<environment>>=
+DEBUGSYS=$(axiom_build_bindir)/debugsys$(EXEEXT)
+
+@
+
+These are the files that need to be compiled (in {\bf BOOTSYS}),
+loaded into a clean lisp image ({\bf LOADSYS}) and saved as
+a runnable \Tool{Axiom} interpreter ({\bf SAVESYS}) usually named
+\Tool{interpsys}. Most of these files
+are translated from Boot to Common Lisp and then 
+compiled. There are two exceptions, \File{bootfuns.lisp}
+and \File{setq.lisp}. The \File{bootfuns.lisp} \cite{3} file
+contains forward references for Boot code. The \File{setq.lisp}
+file contains constant initialization code which gains nothing
+by being compiled.
+
+\subsection{The Spad interpreter and compiler}
+
+The value of the variable [[AXIOMsys_boot_sources]] is the (currently
+partial) list of Boot source files that make up the interpreter.
+Similarly, the value of the variable [[AXIOMsys_compiled_lisp_sources]]
+is the list of Common Lisp source files that are compiled into
+the interpreter.  Notice that some of these files are loaded (\eg{},
+interpreted) in [[depsys]].
+
+<<environment>>=
+OBJS=	vmlisp.$(FASLEXT)	hash.$(FASLEXT)	\
+	bootfuns.$(FASLEXT)	macros.$(FASLEXT)	\
+	unlisp.$(FASLEXT)	setq.$(FASLEXT)	\
+	astr.$(FASLEXT)	bits.$(FASLEXT)	\
+	alql.$(FASLEXT)	buildom.$(FASLEXT)	\
+	cattable.$(FASLEXT)				\
+	cformat.$(FASLEXT)	cfuns.$(FASLEXT)	\
+	clam.$(FASLEXT)	clammed.$(FASLEXT)	\
+	comp.$(FASLEXT)	        foam_l.$(FASLEXT) \
+	compat.$(FASLEXT)	compress.$(FASLEXT)	\
+	cparse.$(FASLEXT)	cstream.$(FASLEXT)	\
+	database.$(FASLEXT)	\
+	debug.$(FASLEXT)	dq.$(FASLEXT)		\
+	fname.$(FASLEXT)	format.$(FASLEXT)	\
+	g-boot.$(FASLEXT)	g-cndata.$(FASLEXT)	\
+	g-error.$(FASLEXT)	g-opt.$(FASLEXT)	\
+	g-timer.$(FASLEXT)	g-util.$(FASLEXT)	\
+	ggreater.$(FASLEXT)				\
+	hypertex.$(FASLEXT)	i-analy.$(FASLEXT)	\
+	i-code.$(FASLEXT)	i-coerce.$(FASLEXT)	\
+	i-coerfn.$(FASLEXT)	i-eval.$(FASLEXT)	\
+	i-funsel.$(FASLEXT)	bookvol5.$(FASLEXT)	\
+	i-intern.$(FASLEXT)	i-map.$(FASLEXT)	\
+	i-output.$(FASLEXT)	i-resolv.$(FASLEXT)	\
+	i-spec1.$(FASLEXT)				\
+	i-spec2.$(FASLEXT)	i-syscmd.$(FASLEXT)	\
+	i-toplev.$(FASLEXT)	i-util.$(FASLEXT)	\
+	incl.$(FASLEXT)	int-top.$(FASLEXT)	\
+	intfile.$(FASLEXT)				\
+	lisplib.$(FASLEXT)	macex.$(FASLEXT)	\
+	match.$(FASLEXT)				\
+	monitor.$(FASLEXT)	msg.$(FASLEXT)		\
+	msgdb.$(FASLEXT)	nci.$(FASLEXT)		\
+	newaux.$(FASLEXT)	newfort.$(FASLEXT)	\
+	nlib.$(FASLEXT)	nrunfast.$(FASLEXT)	\
+	nrungo.$(FASLEXT)	nrunopt.$(FASLEXT)	\
+	nruntime.$(FASLEXT)	osyscmd.$(FASLEXT)	\
+	packtran.$(FASLEXT)	pathname.$(FASLEXT)	\
+	pf2sex.$(FASLEXT)	pile.$(FASLEXT)	\
+	posit.$(FASLEXT)	property.$(FASLEXT)	\
+	ptrees.$(FASLEXT)	ptrop.$(FASLEXT)	\
+	record.$(FASLEXT)				\
+	rulesets.$(FASLEXT)	\
+	scan.$(FASLEXT)	serror.$(FASLEXT)	\
+	server.$(FASLEXT)				\
+	setvars.$(FASLEXT)	\
+	sfsfun-l.$(FASLEXT)	sfsfun.$(FASLEXT)	\
+	simpbool.$(FASLEXT)	slam.$(FASLEXT)	\
+	sockio.$(FASLEXT)	spad.$(FASLEXT)	\
+	spaderror.$(FASLEXT)				\
+	template.$(FASLEXT)	termrw.$(FASLEXT)	\
+	trace.$(FASLEXT)	\
+	union.$(FASLEXT)       daase.$(FASLEXT)  	\
+	fortcall.$(FASLEXT)
+
+interpsys_modules = $(patsubst %.$(FASLEXT), "%", $(OBJS))
+
+AXIOMsys_noncompiled_lisp_sources = bootfuns.lisp nocompil.lisp \
+	postprop.lisp property.lisp setq.lisp 
+
+AXIOMsys_compiled_lisp_sources = bits.lisp \
+	bootlex.lisp cfuns.lisp comp.lisp construc.lisp daase.lisp \
+	debug.lisp def.lisp fname.lisp fnewmeta.lisp ggreater.lisp \
+	hash.lisp macros.lisp metalex.lisp monitor.lisp newaux.lisp \
+	nlib.lisp nspadaux.lisp parsing.lisp \
+	patches.lisp preparse.lisp \
+	sockio.lisp spad.lisp spaderror.lisp \
+	union.lisp util.lisp vmlisp.lisp obey.lisp \
+	unlisp.lisp intint.lisp nci.lisp sfsfun-l.lisp \
+	axext_l.lisp foam_l.lisp
+
+AXIOMsys_boot_sources = astr.boot alql.boot buildom.boot cattable.boot \
+	cformat.boot clam.boot clammed.boot compat.boot compress.boot \
+	cparse.boot cstream.boot database.boot dq.boot format.boot \
+	g-boot.boot g-cndata.boot g-error.boot g-opt.boot g-timer.boot \
+	g-util.boot hypertex.boot i-analy.boot i-code.boot i-coerce.boot \
+	i-coerfn.boot i-eval.boot i-funsel.boot i-intern.boot i-map.boot \
+	i-output.boot i-resolv.boot i-spec1.boot i-spec2.boot \
+	i-syscmd.boot i-toplev.boot i-util.boot incl.boot int-top.boot \
+	intfile.boot lisplib.boot macex.boot match.boot msg.boot \
+	msgdb.boot newfort.boot nrunfast.boot nrungo.boot nrunopt.boot \
+	nruntime.boot osyscmd.boot packtran.boot pathname.boot \
+	pf2sex.boot pile.boot posit.boot ptrees.boot ptrop.boot \
+	record.boot rulesets.boot scan.boot serror.boot server.boot \
+	setvars.boot sfsfun.boot simpbool.boot slam.boot template.boot \
+	termrw.boot trace.boot fortcall.boot
+@
+
+Before we save the {\bf SAVESYS} image we need to run some
+initialization code. These files perform initialization
+for various parts of the system. The {\bf patches.lisp} \cite{5}
+file contains last-minute changes to various functions and
+constants.
+<<environment>>=
+INOBJS=	varini.$(FASLEXT)	parini.$(FASLEXT)	\
+	setvart.$(FASLEXT)	intint.$(FASLEXT)	\
+        xrun.$(FASLEXT)        interop.$(FASLEXT)     \
+        patches.$(FASLEXT)
+
+IN_modules = $(patsubst %.$(FASLEXT), "%", $(INOBJS))
+
+@
+
+Certain functions do not need to be in the running system.
+If the running image never calls the compiler or does not
+use the hypertex browser we will never call the functions
+in these files. The code that calls these functions in the
+running system will autoload the appropriate files the
+first time they are called. Loading the files overwrites
+the autoload function call and re-calls the function. 
+Any subsequent calls will run the compiled code.
+
+The {\bf OPOBJS} list contains files from the old parser. The use of
+``old'' is something of a subtle concept as there were several
+generations of ``old'' and all meaning of the term is lost.
+
+Notice that the object file [[def.$(FASLEXT)]] appears on both the
+[[OPBJS]] and [[TRANOBJS]] lists.  In normal situation, parsing 
+precedes translation; consequently the file [[def]] is loaded by the 
+parser, so that it does not need to be reloaded by the translator. 
+However, it may theoretically be that a translation could happen without 
+prior parsing (in case someone types in a parse tree for SPAD code).  
+Consequently, it must be ensured that [[def.]] is still loaded in that
+configuration.  In the long term, the autoload machinery need
+rethinking.
+
+<<environment>>=
+# These are autloaded old parser files
+OPOBJS=	${AUTO}/parsing.$(FASLEXT)	${AUTO}/bootlex.$(FASLEXT)	\
+        ${AUTO}/def.$(FASLEXT)	\
+	${AUTO}/fnewmeta.$(FASLEXT)	${AUTO}/metalex.$(FASLEXT)	\
+	${AUTO}/metameta.$(FASLEXT)	\
+	${AUTO}/parse.$(FASLEXT)	${AUTO}/postpar.$(FASLEXT)	\
+	${AUTO}/postprop.$(FASLEXT)	${AUTO}/preparse.$(FASLEXT)
+
+autoload_objects += $(OPBJS)
+@
+
+The {\bf OCOBJS} list contains files from the old compiler. Again,
+``old'' is meaningless. These files should probably be autoloaded.
+<<environment>>=
+OCOBJS=	${AUTO}/apply.$(FASLEXT)	${AUTO}/c-doc.$(FASLEXT)	\
+	${AUTO}/c-util.$(FASLEXT)	${AUTO}/profile.$(FASLEXT)	\
+	${AUTO}/category.$(FASLEXT)	${AUTO}/compiler.$(FASLEXT)	\
+	${AUTO}/define.$(FASLEXT)	${AUTO}/functor.$(FASLEXT)	\
+	${AUTO}/info.$(FASLEXT)	${AUTO}/iterator.$(FASLEXT)	\
+	${AUTO}/modemap.$(FASLEXT)	${AUTO}/nruncomp.$(FASLEXT)	\
+	${AUTO}/package.$(FASLEXT)	${AUTO}/htcheck.$(FASLEXT)	\
+        ${AUTO}/xruncomp.$(FASLEXT)   
+
+autoload_objects += $(OCOBJS)
+
+@
+
+The {\bf BROBJS} list contains files only used by the hypertex
+browser. These files should probably be autoloaded.
+<<environment>>=
+BROBJS=	${AUTO}/bc-matrix.$(FASLEXT)				\
+	${AUTO}/bc-misc.$(FASLEXT)	${AUTO}/bc-solve.$(FASLEXT)	\
+	${AUTO}/bc-util.$(FASLEXT)				\
+	${AUTO}/ht-util.$(FASLEXT)	${AUTO}/htsetvar.$(FASLEXT)	\
+	${AUTO}/ht-root.$(FASLEXT)	\
+	${AUTO}/br-con.$(FASLEXT)	\
+	${AUTO}/br-data.$(FASLEXT)	${AUTO}/showimp.$(FASLEXT)    \
+	${AUTO}/br-op1.$(FASLEXT)	${AUTO}/br-op2.$(FASLEXT)	\
+	${AUTO}/br-search.$(FASLEXT)	${AUTO}/br-util.$(FASLEXT)	\
+	${AUTO}/topics.$(FASLEXT)     ${AUTO}/br-prof.$(FASLEXT)    \
+	${AUTO}/br-saturn.$(FASLEXT)
+
+autoload_objects += $(BFOBJS)
+
+@
+
+The {\bf TRANOBJS} list contains files used by Spad to Aldor convertor.
+The files probably are also used by the {\bf boot}
+to Common Lisp translator and are probably never used by anyone
+but the developers.
+
+When a user requests converting a file from Spad to Aldor the
+function
+[[spad2AsTranslatorAutoloadOnceTrigger]] is called triggering
+load of this group of files. Loading [[$TRANOBJS]] in turn replaces
+many compiler functions by versions contain in this files.
+ These files should probably be autoloaded
+(at least [[${AUTO}/wi1.$(FASLEXT)]] and [[${AUTO}/wi2.$(FASLEXT)]]
+(which replace compiler functions) {\em must} be autoloaded).
+<<environment>>=
+TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT) \
+	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT) \
+	  ${AUTO}/def.$(FASLEXT)
+
+autoload_objects += $(TRANOBJS)
+
+@
+
+The {\bf NAGBROBJS} list contains files used to access the 
+Numerical Algorithms Group (NAG) fortran libraries. 
+These files should probably be autoloaded.
+Note that [[${AUTO}/nag-e02a.$(FASLEXT)]] is not included in this
+list as it is a subset of [[${AUTO}/nag-e02.$(FASLEXT)]].
+<<environment>>=
+NAGBROBJS= ${AUTO}/nag-c02.$(FASLEXT)   ${AUTO}/nag-c05.$(FASLEXT) \
+           ${AUTO}/nag-c06.$(FASLEXT)   ${AUTO}/nag-d01.$(FASLEXT) \
+           ${AUTO}/nag-d02.$(FASLEXT)   ${AUTO}/nag-d03.$(FASLEXT) \
+           ${AUTO}/nag-e01.$(FASLEXT)   ${AUTO}/nag-e02.$(FASLEXT) \
+           ${AUTO}/nag-e04.$(FASLEXT)   ${AUTO}/nag-f01.$(FASLEXT) \
+           ${AUTO}/nag-f02.$(FASLEXT)   ${AUTO}/nag-f04.$(FASLEXT) \
+           ${AUTO}/nag-f07.$(FASLEXT)   ${AUTO}/nag-s.$(FASLEXT) 
+
+autoload_objects += $(NAGBROBJS)
+
+@
+
+The {\bf ASCOMP} list contains files used by the {\bf Aldor}
+\cite{5} compiler. These files should probably be autoloaded.
+<<environment>>=
+ASCOMP= hashcode.$(FASLEXT) as.$(FASLEXT) \
+	foam_l.$(FASLEXT) axext_l.$(FASLEXT)
+
+AS_modules = $(patsubst %.$(FASLEXT), "%", $(ASCOMP))
+
+@
+
+The {\bf ASAUTO} list contains files used by the {\bf Aldor}
+\cite{5} compiler. These files are autoloaded as needed.
+<<environment>>=
+ASAUTO= ${AUTO}/ax.$(FASLEXT)
+
+autoload_objects += $(ASAUTO)
+@
+
+Axiom versions are given as a string of the form:
+"Sunday September 21, 2003 at 20:38:05 "
+which describe the day, date, and time of the build.
+This is used for reporting bugs. It is only partially useful
+in identifying which source code was used. Ideally we could create
+a tar file of all of the date/time stamps of all of the source files
+and use the MD5 hash of that file as the version stamp. Ultimately
+though, this would be chasing the elusive "perfect information" idea.
+
+A new variable [[boot::*build-version*]] is set here and used by the
+[[yearweek]] function to display the version number of the Axiom build.
+This information is set by hand in the top level Makefile.
+<<environment>>=
+TIMESTAMP=$(axiom_targetdir)/timestamp
+YEARWEEK=(progn (setq boot::timestamp "${TIMESTAMP}") \
+                (setq boot::*build-version* "$(PACKAGE_STRING)") \
+                (boot::yearweek))
+
+@
+
+The {\bf .PRECIOUS} setting will keep make from deleting these
+images if the build is stopped. Since once they are built they
+are likely to be useable we don't need to redo the work if they
+exist.
+<<environment>>=
+
+.PRECIOUS:	${DEPSYS}
+.PRECIOUS:	${SAVESYS}
+.PRECIOUS:	${AXIOMSYS}
+
+@
+
+\section{Codes from Pamphlets}
+
+As noted earlier, the Boot codes are first extrated from the pamphlet
+files:
+<<extract source codes>>=
+.PRECIOUS: %.boot
+%.boot: $(srcdir)/%.boot.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+@
+
+The extracted Boot codes are then fed into \Tool{bootsys} which translates
+them into Common Lisp codes:
+<<extract source codes>>=
+.PRECIOUS: %.clisp
+%.clisp: %.boot
+	$(BOOT_TO_LISP)
+@
+
+The resulting Common Lips codes are, in turn, compiled to object codes
+using the \Tool{depsys} image.
+<<extract source codes>>=
+.PRECIOUS: %.$(FASLEXT)
+%.$(FASLEXT): %.clisp
+	$(COMPILE_LISP)
+@
+
+Part of the interpreter is written directly in Common Lisp (instead of the 
+sugared dialect Boot).  That part is extracted from the pamphlet files
+and compiled to native object code, as usual.
+<<extract source codes>>=
+# Extract and compile the part of the interpreter written
+# in Common Lisp
+.PRECIOUS: %.lisp
+%.$(FASLEXT): %.lisp
+	$(COMPILE_LISP)
+
+%.lisp: $(srcdir)/%.lisp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+@
+
+\section{Proclaim optimization}
+
+\Tool{GCL}, and possibly other common lisps, can generate much better
+code if the function argument types and return values are proclaimed.
+
+In theory what we should do is scan all of the functions in the system
+and create a file of proclaim definitions. These proclaim definitions
+should be loaded into the image before we do any compiles so they can
+allow the compiler to optimize function calling.
+
+\Tool{GCL} has an approximation to this scanning which we use here. 
+
+The first step is to build a version of GCL that includes [[gcl_collectfn]].
+This file contains code that enhances the lisp compiler and creates a
+hash table of structs. Each struct in the hash table describes information
+that about the types of the function being compiled and the types of its
+arguments. At the end of the compile-file this hash table is written out
+to a ".fn" file. 
+
+The second step is to build axiom images (depsys, interpsys, AXIOMsys)
+which contain the [[gcl_collectfn]] code.
+
+The third step is to build the system. This generates a .fn file for 
+each lisp file that gets compiled.
+
+The fourth step is to build the proclaims.lisp files. There is one
+proclaims.lisp file for 
+boot (boot-proclaims.lisp), 
+interp (interp-proclaims.lisp), and 
+algebra (algebra-proclaims.lisp).
+
+To build the proclaims file (e.g. for interp) we:
+\begin{verbatim}
+(a) cd to obj/linux/interp
+(b) (yourpath)/axiom/obj/linux/bin/lisp
+(c) (load "sys-pkg.lsp") 
+(d) (mapcar #'load (directory "*.fn"))
+(e) (with-open-file (out "interp-proclaims.lisp" :direction :output) 
+      (compiler::make-proclaims out))
+\end{verbatim}
+Note that step (c) is only used for interp, not for boot.
+
+The fifth step is to copy the newly constructed proclaims file back
+into the src/interp diretory (or boot, algebra).
+
+\section{The warm.data file}
+
+This is a file of commands that will be loaded into interpsys
+at the last minute. It execute functions that will likely be
+used in a running system so all of the required routines will
+be in the lisp image thus minimizing their startup time.
+<<warm.data.stanza>>=
+../algebra/warm.data: $(srcdir)/Makefile.pamphlet
+	@ echo 2 building warm.data
+	$(axiom_build_document) --tangle=warm.data --output=$@ $<
+
+@
+
+<<warm.data>>=
+(in-package 'boot)
+(setq |$topicHash| (make-hash-table))
+(setf (gethash '|basic| |$topicHash|) 2)
+(setf (gethash '|algebraic| |$topicHash|) 4)
+(setf (gethash '|miscellaneous| |$topicHash|) 13)
+(setf (gethash '|extraction| |$topicHash|) 6)
+(setf (gethash '|conversion| |$topicHash|) 7)
+(setf (gethash '|hidden| |$topicHash|) 3)
+(setf (gethash '|extended| |$topicHash|) 1)
+(setf (gethash '|destructive| |$topicHash|) 5)
+(setf (gethash '|transformation| |$topicHash|) 10)
+(setf (gethash '|hyperbolic| |$topicHash|) 12)
+(setf (gethash '|construct| |$topicHash|) 9)
+(setf (gethash '|predicate| |$topicHash|) 8)
+(setf (gethash '|trignometric| |$topicHash|) 11)
+
+@
+
+\section{UNUSED}
+
+These files were in the interp distribution from NAG but have
+no purpose at the moment. This belief is no doubt due to my
+lack of understanding. Rather than erase them they are documented
+here for future reference. [[${DOC}/nag-e02a.boot.dvi]] and
+[[${DOC}/nag-e02b.boot.dvi]] appear to be two halfs of the file
+[[${DOC}/nag-e02.boot.dvi]] and have been removed.
+<<environment>>=
+UNUSED= ${DOC}/anna.boot.dvi ${DOC}/construc.lisp.dvi \
+	${DOC}/domain.lisp.dvi 	${DOC}/guess.boot.dvi \
+	${DOC}/interp-fix.boot.dvi \
+	${DOC}/nhyper.boot.dvi ${DOC}/pf2atree.boot.dvi \
+	${DOC}/redefs.boot.dvi 	${DOC}/word.boot.dvi 
+
+@
+
+\section{Building DEPSYS}
+
+\begin{verbatim}
+NOTES: depsys proceeds all else. it is the compile-time environment
+for all interpreter code. 
+[[OLD-BOOT::BOOT]] emulates the new boot parser command [[BOOTTOCL]]. since
+we eventually plan to move to the new boot parser this function
+should disappear.
+the load of postpar and parse (without extensions) allows the .${LISP} form
+to be loaded in a virgin system. however, if depsys is recreated then
+the compiled form will get loaded.
+\end{verbatim}
+
+\subsection{save depsys image}
+
+Once the appropriate commands are in the [[makedep.lisp]] file
+we can load the file into an initial Lisp image and save it.
+In freebsd we cannot do this so we have to use
+a much more complicated procedure.
+This code used to read:
+\begin{verbatim}
+<<save depsys image>>=
+	../lisp/base-lisp$(EXEEXT) -- --make --output=$@ \
+		--load-directory=. makedep.lisp
+@
+\end{verbatim}
+
+Now game is much more difficult. 
+\begin{verbatim}
+
+ '(progn \
+
+\end{verbatim}
+
+[[si::*collect-binary-modules*]] instructs GCL to build a list of 
+binary object modules loaded into the current session with (load ...)
+The list will be stored in [[si::*binary-modules*]].
+\begin{verbatim}
+
+	       (setq si::*collect-binary-modules* t) \
+	       (load "makedep.lisp") \
+
+\end{verbatim}
+
+[[compiler::link]] is a lisp interface to the ``ld'' C-based system linker.
+The first argumet is a list of [[.o]] binary object modules to link into a
+fresh gcl image. The second argument is the name of the new output
+image.  The third argument is a string containing an initialization
+command to run in the new image to reinitialize the heap.  The fourth
+argument is a list of external C libraries, either static or dynamic,
+that one wishes to link into the fresh image.  The last argument is a
+flag which indicates whether GCL should initialize all of the freshly
+linked in new lisp modules, or whether it should transparently
+redirect load calls in the new image to initialization calls for the
+already linked in module.
+
+Some lisp systems, such as acl2, have a complex heap initialization,
+in which load calls must be interspersed with other form evaluation
+comprising the logic of the heap construction.  Others, such as
+maxima, have no such complex initialization sequence.
+\begin{verbatim}
+
+	       (compiler::link \
+
+\end{verbatim}
+[[si::*binary-modules*]] here has the list of compiled lisp binary module
+.o files loaded by makedep.lsp above.
+\begin{verbatim}
+
+				 (remove-duplicates si::*binary-modules* :test (quote equal)) \
+
+\end{verbatim}
+
+The name of the output image.
+\begin{verbatim}
+
+				 "$(DEPSYS)" \
+
+\end{verbatim}
+
+This will be run in the newly linked sub-image.
+\begin{verbatim}
+
+				 (format nil "\
+
+\end{verbatim}
+
+Collect loaded binary modules again to make sure that there are none,
+as all should be already linked in via ld.  For error checking
+purposes.
+\begin{verbatim}
+
+(setq si::*collect-binary-modules* t) \
+
+\end{verbatim}
+
+We need to find [[gcl_collectfn.lsp]], so set the [[*load-path*]], and make
+sure the source, not the binary, form is loaded here, as we're only
+using this entire sequence on machines which cannot load binary object
+modules and preserve them in saved images.
+\begin{verbatim}
+
+(let ((si::*load-path* (cons ~S si::*load-path*))\
+                                     (si::*load-types* ~S))\
+
+\end{verbatim}
+
+Turn on function analyzation and autoload thereby [[gcl_collectfn.lsp]].
+\begin{verbatim}
+
+(compiler::emit-fn t))\
+
+\end{verbatim}
+
+Load the heap creation sequence again in the fresh new image, this
+time transparently redirecting all calls to load of binary modules
+invoked thereby into initialization calls for the already linkned in
+module.
+
+Load has code in it to recognize when a module is already linked in,
+and to forgo in this case the actual load and replace with a mere
+initialization call instead.
+\begin{verbatim}
+
+(load \"makedep.lisp\")\
+
+(gbc t)\
+
+\end{verbatim}
+
+It is an error to load a binary module. Calling load will not
+reload them but only run initialization.
+Throw an error if we've actually loaded any binary modules.
+\begin{verbatim}
+
+(when si::*binary-modules* \
+(error si::*binary-modules*))\
+
+\end{verbatim}
+
+Unset the binary module collection flags.
+\begin{verbatim}
+
+(setq si::collect-binary-modules* nil si::*binary-modules* nil)\
+(gbc t)\
+
+\end{verbatim}
+
+Turn on SGC (Stratified Garbage Collection) in the final image.  This
+is a optional gbc algorithm which is suitable for images which will
+not grow much further.  It marks a large fraction of the heap
+read-only, eliminating such pages from the time-consuming gbc
+processing.  When writes are actually made to such pages, a segfault
+is triggered which is handled by a function which remarks the pages
+read-write and continues.
+\begin{verbatim}
+
+(when (fboundp (quote si::sgc-on)) (si::sgc-on t))\
+
+\end{verbatim}
+
+This is a flag which instructs the GCL compiler to make unique
+initialzation function C names.  This is necessary when using ld, as
+all function names must be unique.
+\begin{verbatim}
+
+(setq compiler::*default-system-p* t)\
+
+si::*system-directory* goes into the *load-path*, and .lsp in the *load-types*.
+
+" si::*system-directory* (quote (list ".lsp")))\
+
+\end{verbatim}
+No C libraries to link in here.
+\begin{verbatim}
+
+"" \
+
+\end{verbatim}
+
+Do not run the initialization code for the newly linked in lisp
+modules ``by hand'', but rather rely on the transparent load redirection
+described above to initialize at the proper moment in the heap
+initialization sequence.
+\begin{verbatim}
+
+nil))' | $(LISPSYS))
+
+\end{verbatim}
+The [[save depsys image]] was supposed to read:
+\begin{verbatim}
+	@ (cd ${OBJ}/${SYS}/bin ; \
+	   echo '(progn \
+		(setq si::*collect-binary-modules* t) \
+		(load "makedep.lisp") \
+		(compiler::link \
+			(remove-duplicates si::*binary-modules* :test (quote equal)) \
+			"$(DEPSYS)" \
+			(format nil "\
+				(setq si::*collect-binary-modules* t) \
+				(let ((si::*load-path* (cons ~S si::*load-path*))\
+					(si::*load-types* ~S))\
+					(compiler::emit-fn t))\
+				(load \"makedep.lisp\")\
+				(gbc t)\
+				(when si::*binary-modules* \
+					(error si::*binary-modules*))\
+				(setq si::collect-binary-modules* nil si::*binary-modules* nil)\
+				(gbc t)\
+				(when (fboundp (quote si::sgc-on)) (si::sgc-on t))\
+				(setq compiler::*default-system-p* t)\
+			" si::*system-directory* (quote (list ".lsp")))\
+			"" \
+			nil))' | $(LISPSYS))
+\end{verbatim}
+
+This scheme does not work. It fails during loading with multiple messages
+of the form:
+\begin{verbatim}
+/home/axiom--main--1--patch-33/obj/linux/interp/parse.o(.text+0x5660): In function `init_code':
+: multiple definition of `init_code'
+/home/axiom--main--1--patch-33/obj/linux/interp/postpar.o(.text+0x4e78): first defined here
+\end{verbatim}
+
+<<depsys>>=
+depsys_lisp_sources += parsing.lisp metalex.lisp bootlex.lisp \
+			newaux.lisp preparse.lisp postprop.lisp \
+			metameta.lisp fnewmeta.lisp
+
+depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \
+			g-boot.boot g-error.boot c-util.boot g-util.boot
+
+depsys_SOURCES = $(depsys_lisp_SOURCES) $(depsys_boot_SOURCES)
+
+depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \
+		util.$(FASLEXT) postpar.$(FASLEXT) parse.$(FASLEXT) \
+		parsing.$(FASLEXT) metalex.$(FASLEXT) bootlex.$(FASLEXT) \
+		newaux.$(FASLEXT) preparse.$(FASLEXT) postprop.$(FASLEXT) \
+		metameta.$(FASLEXT) fnewmeta.$(FASLEXT) clam.$(FASLEXT) \
+		slam.$(FASLEXT) g-boot.$(FASLEXT) c-util.$(FASLEXT) \
+		g-util.$(FASLEXT)
+
+${DEPSYS}:	vmlisp.$(FASLEXT) \
+		hash.$(FASLEXT) \
+		ggreater.$(FASLEXT) \
+		union.$(FASLEXT) \
+		bootfuns.$(FASLEXT) \
+		${DEP} \
+		nocompil.$(FASLEXT) \
+	        bookvol5.$(FASLEXT)\
+		util.$(FASLEXT) \
+	        postpar.clisp parse.clisp \
+	        parsing.lisp metalex.lisp \
+	        bootlex.lisp newaux.lisp \
+	        preparse.lisp \
+	        postprop.lisp def.lisp \
+	        metameta.lisp fnewmeta.lisp \
+		g-error.clisp \
+	        g-boot.clisp c-util.${LISP} \
+	        g-util.clisp \
+	        clam.clisp \
+	        slam.clisp
+	@ echo 3 making ${DEPSYS} 
+	@ rm -f makedep.lisp
+	@ $(mkinstalldirs) $(axiom_build_bindir)
+	@ echo '(|importModule| "vmlisp")' >> makedep.lisp
+	@ echo '(|importModule| "hash")' >> makedep.lisp
+	@ echo '(|importModule| "ggreater")' >> makedep.lisp
+	@ echo '(|importModule| "union")' >> makedep.lisp
+	@ echo '(|importModule| "bootfuns")' >> makedep.lisp
+	@ echo '(|importModule| "nocompil")' >> makedep.lisp
+	@ echo '(|importModule| "bookvol5")' >> makedep.lisp
+	@ echo '(|importModule| "util")' >> makedep.lisp
+	@ echo '(in-package "BOOT")' >> makedep.lisp
+	@ echo '(build-depsys (quote ($(patsubst %, "%", ${DEP}))) "${AXIOM}")' >> makedep.lisp
+	@ echo '(unless (probe-file "postpar.$(FASLEXT)") (compile-file "postpar.clisp" :output-file "postpar.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "postpar")' >> makedep.lisp
+	@ echo '(unless (probe-file "parse.$(FASLEXT)") (compile-file "parse.clisp" :output-file "parse.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "parse")' >> makedep.lisp
+	@ echo '(unless (probe-file "parsing.$(FASLEXT)") (compile-file "parsing.lisp" :output-file "parsing.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "parsing")' >> makedep.lisp
+	@ echo '(unless (probe-file "metalex.$(FASLEXT)") (compile-file "metalex.lisp" :output-file "metalex.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "metalex")' >> makedep.lisp
+	@ echo '(unless (probe-file "bootlex.$(FASLEXT)") (compile-file "bootlex.lisp" :output-file "bootlex.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "bootlex")' >> makedep.lisp
+	@ echo '(unless (probe-file "newaux.$(FASLEXT)") (compile-file "newaux.lisp" :output-file "newaux.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "newaux")' >> makedep.lisp
+	@ echo '(unless (probe-file "preparse.$(FASLEXT)") (compile-file "preparse.lisp" :output-file "preparse.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "preparse")' >> makedep.lisp
+	@ echo '(unless (probe-file "postprop.$(FASLEXT)") (compile-file "postprop.lisp" :output-file "postprop.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "postprop")' >> makedep.lisp
+	@ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "def")' >> makedep.lisp
+	@ echo '(unless (probe-file "metameta.$(FASLEXT)") (compile-file "metameta.lisp" :output-file "metameta.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "metameta")' >> makedep.lisp
+	@ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "fnewmeta.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "fnewmeta")' >> makedep.lisp
+	@ echo '(unless (probe-file "clam.$(FASLEXT)") (compile-file "clam.clisp" :output-file "clam.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "clam")' >> makedep.lisp
+	@ echo '(unless (probe-file "slam.$(FASLEXT)") (compile-file "slam.clisp" :output-file "slam.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "slam")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-error.$(FASLEXT)") (compile-file "g-error.clisp" :output-file "g-error.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-error")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-boot.$(FASLEXT)") (compile-file "g-boot.clisp" :output-file "g-boot.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-boot")' >> makedep.lisp
+	@ echo '(unless (probe-file "c-util.$(FASLEXT)") (compile-file "c-util.${LISP}" :output-file "c-util.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "c-util")' >> makedep.lisp
+	@ echo '(unless (probe-file "g-util.$(FASLEXT)") (compile-file "g-util.clisp" :output-file "g-util.$(FASLEXT)"))' >> makedep.lisp
+	@ echo '(load "g-util")' >> makedep.lisp
+<<save depsys image>>
+	@rm $(addsuffix .$(FASLEXT), \
+		postpar parse parsing metalex bootlex newaux preparse \
+		postprop def metameta fnewmeta clam slam g-error \
+		g-boot c-util g-util)
+	@ echo 4 ${DEPSYS} created
+
+
+util.$(FASLEXT): util.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+bookvol5.$(FASLEXT): bookvol5.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+nocompil.$(FASLEXT): nocompil.lisp bootfuns.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+hash.$(FASLEXT): hash.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+union.$(FASLEXT): union.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+ggreater.$(FASLEXT): ggreater.lisp vmlisp.$(FASLEXT)
+	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+vmlisp.$(FASLEXT): vmlisp.lisp
+	$(BOOTSYS) -- --compile --output=$@ $<
+
+@
+
+\section{Building SAVESYS and AXIOMSYS}
+
+GCL likes to tell you when it has replaced a function call by a 
+tail-recursive call. This happens when the last form in a function
+is a call to the same function. In general, we don't care so we set
+compiler::*suppress-compiler-notes* to true in order to reduce the noise.
+
+Notice that when Axiom uses GCL as the Lisp platform, it is usually not 
+a good idea to mess with GCL's internal variables.  In particular, GCL
+has its own idea about what to do with [[si::*system-directory*]], which 
+should not be set here just because we happen to save an GCL-based image.
+Doing otherwise causes havoc.
+
+<<savesys>>=
+makeint.lisp:	${DEPSYS} ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
+                nocompil.lisp \
+	        ${OUTINTERP} ${OCOBJS} ${OPOBJS} ${BROBJS} obey.$(FASLEXT) \
+		database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \
+		${NAGBROBJS} ${TRANOBJS} \
+	        ${LOADSYS} \
+		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
+		$(axiom_src_docdir)/msgs/s2-us.msgs \
+	        ../algebra/warm.data
+	@ echo 5 invoking make in `pwd` with parms:
+	@rm -f makeint.lisp
+	@ echo SYS= ${SYS} 
+	@ echo LISP=${LISP} BYE=${BYE}
+	$(mkinstalldirs) $(axiom_target_datadir)/msgs
+	$(INSTALL_DATA) $(axiom_src_docdir)/msgs/s2-us.msgs \
+		 $(axiom_target_datadir)/msgs
+	@ echo '(|importModule| "vmlisp")' >> makeint.lisp
+	@ echo '(|importModule| "hash")' >> makeint.lisp
+	@ echo '(|importModule| "bootfuns")' >> makeint.lisp
+	@ echo '(gbc t)' >> makeint.lisp
+	@ echo '(load "nocompil.lisp")' >> makeint.lisp
+	@ echo '(|importModule| "bookvol5")' >> makeint.lisp
+	@ echo '(|importModule| "util")' >> makeint.lisp
+	@ echo '(in-package "BOOT")' >> makeint.lisp
+	@ touch ${TIMESTAMP}
+	@ echo '${YEARWEEK}' >> makeint.lisp
+	@ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${OPOBJS}))) (quote ($(patsubst %, "%", ${OCOBJS}))) (quote ($(patsubst %, "%", ${BROBJS}))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${NAGBROBJS}))) (quote ($(patsubst %, "%", ${ASAUTO})))  "${AXIOM}")' >> makeint.lisp
+	@ echo '(boot::set-restart-hook)' >> makeint.lisp
+	@ echo '(in-package "BOOT")' >> makeint.lisp
+	@ echo '(load "../algebra/warm.data")' >> makeint.lisp
+	@ echo '(boot::|clearClams|)' >> makeint.lisp
+	@ echo '(load "obey")' >> makeint.lisp
+	@ echo '#+:akcl (setq compiler::*suppress-compiler-notes* t)' >> makeint.lisp
+	@ echo '#+:akcl (si::gbc-time 0)' >> makeint.lisp
+	@ echo '(gbc t)' >> makeint.lisp
+
+${SAVESYS}: makeint.lisp
+	AXIOM="$(AXIOM)" DAASE="$(axiom_src_datadir)" \
+		$(LOADSYS) -- --make --output=$@ --main="BOOT::RESTART" \
+			 --load-directory=. makeint.lisp
+	@ echo 6 ${SAVESYS} created
+	$(mkinstalldirs) $(axiom_target_bindir)
+@
+
+\section{Building SAVESYS and AXIOMSYS}
+
+We want to cache database data in the final image, so we dump it only
+after databases are build.
+Note that having dependency on databases is not enough, since databases
+are re-generated after leaving \File{interp/} directory.
+
+<<axiomsys>>=
+.PHONY: all-axiomsys
+
+all-axiomsys: ${AXIOMSYS}
+
+${AXIOMSYS}: makeint.lisp
+	AXIOM="$(AXIOM)" DAASE="$(axiom_targetdir)" \
+		$(LOADSYS) -- --make --output=$@ --main="BOOT::RESTART" \
+			--load-directory=. makeint.lisp
+	@ echo 6a ${AXIOMSYS} created
+@
+
+\section{Building debugsys}
+
+Note that we assume you've already built interpsys so all of the
+files are known to exist and be up to date. We don't list any of
+the preconditions here. 
+<<debugsys>>=
+${DEBUGSYS}: debugsys.lisp
+	@ echo 7 building debugsys
+	@ echo '(progn (gbc t) (load "debugsys.lisp") (in-package "BOOT") (spad-save "$@"))' | ${LISPSYS}
+	@ echo 8 ${DEBUGSYS} created
+
+@
+
+\section{The Interpreter files}
+
+\subsection{DVI files from pmaphlet files}
+
+<<DVI from pamphlet>>=
+$(axiom_build_texdir)/diagrams.tex: $(axiom_src_docdir)/diagrams.tex
+	$(INSTALL_DATA) $< $@
+@
+
+\subsection{apply.boot \cite{7}}
+
+<<apply.o (AUTO from OUT)>>=
+${AUTO}/apply.$(FASLEXT): apply.$(FASLEXT)
+	@ echo 9 making ${AUTO}/apply.$(FASLEXT) from apply.$(FASLEXT)
+	@ cp apply.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{bootlex.lisp \cite{9}}
+
+<<bootlex.o (AUTO from OUT)>>=
+${AUTO}/bootlex.$(FASLEXT): bootlex.$(FASLEXT)
+	@ echo 19 making ${AUTO}/bootlex.$(FASLEXT) from bootlex.$(FASLEXT)
+	@ cp bootlex.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{debugsys.lisp \cite{14}}
+
+The {\bf debugsys.lisp} file is used to create a {\bf debugsys} runnable image.
+This image contains almost all of the lisp code that make up the axiom
+interpreter in lisp form. It is useful for deep system debugging but
+otherwise worthless. This file is certain to drift over time as changes
+are made elsewhere to add or remove files. It is assumed that you know
+what you are doing if you change this file or use debugsys.
+
+This file is basically the same as the one created during the build of
+interpsys. See the echo lines in the {\bf SAVESYS} block above. These
+are echoed into a temporary file which gets loaded into the lisp image.
+We simply captured that temporary file, replaced the .o files with .lisp
+files (or .lsp or .clisp) and saved it here.
+<<debugsys.lisp>>=
+debugsys.lisp: $(srcdir)/debugsys.lisp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+@
+
+\subsection{def.lisp \cite{15}}
+
+<<def.o (AUTO from OUT)>>=
+${AUTO}/def.$(FASLEXT): def.$(FASLEXT)
+	@ echo 41 making ${AUTO}/def.$(FASLEXT) from def.$(FASLEXT)
+	@ cp def.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{fnewmeta.lisp \cite{18}}
+
+<<fnewmeta.o (AUTO from OUT)>>=
+${AUTO}/fnewmeta.$(FASLEXT): fnewmeta.$(FASLEXT)
+	@ echo 49 making ${AUTO}/fnewmeta.$(FASLEXT) from fnewmeta.$(FASLEXT)
+	@ cp fnewmeta.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{fortcall.boot \cite{16}}
+
+<<fortcall.clisp>>=
+fortcall.clisp: fortcall.boot
+	@ echo 55 making $@ from $<
+	@ echo '(progn (old-boot::boot "fortcall.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{metalex.lisp \cite{22}}
+
+<<metalex.o (AUTO from OUT)>>=
+${AUTO}/metalex.$(FASLEXT): metalex.$(FASLEXT)
+	@ echo 66 making ${AUTO}/metalex.$(FASLEXT) from metalex.$(FASLEXT)
+	@ cp metalex.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{metameta.lisp \cite{23}}
+
+<<metameta.o (AUTO from OUT)>>=
+${AUTO}/metameta.$(FASLEXT): metameta.$(FASLEXT)
+	@ echo 71 making ${AUTO}/metameta.$(FASLEXT) from metameta.$(FASLEXT)
+	@ cp metameta.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{nspadaux.lisp \cite{28}}
+
+<<nspadaux.o (AUTO from OUT)>>=
+${AUTO}/nspadaux.$(FASLEXT): nspadaux.$(FASLEXT)
+	@ echo 89 making ${AUTO}/nspadaux.$(FASLEXT) from nspadaux.$(FASLEXT)
+	@ cp nspadaux.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{parsing.lisp \cite{29}}
+
+<<parsing.o (AUTO from OUT)>>=
+${AUTO}/parsing.$(FASLEXT): parsing.$(FASLEXT)
+	@ echo 94 making ${AUTO}/parsing.$(FASLEXT) from parsing.$(FASLEXT)
+	@ cp parsing.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{postprop.lisp \cite{30}}
+
+<<postprop.lisp (AUTO from OUT)>>=
+${AUTO}/postprop.$(FASLEXT): postprop.$(FASLEXT)
+	@ echo 102 making $@ from $<
+	@ cp $< ${AUTO}
+
+@
+
+\subsection{preparse.lisp \cite{31}}
+
+<<preparse.o (AUTO from OUT)>>=
+${AUTO}/preparse.$(FASLEXT): preparse.$(FASLEXT)
+	@ echo 106 making ${AUTO}/preparse.$(FASLEXT) from preparse.$(FASLEXT)
+	@ cp preparse.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{buildom.boot \cite{41}}
+
+<<buildom.clisp>>=
+buildom.clisp: buildom.boot
+	@ echo 143 making $@ from $<
+	@ echo '(progn (old-boot::boot "buildom.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{c-util.boot \cite{42}}
+
+<<c-util.o (AUTO from OUT)>>=
+${AUTO}/c-util.$(FASLEXT): c-util.$(FASLEXT)
+	@ echo 145 making ${AUTO}/c-util.$(FASLEXT) from c-util.$(FASLEXT)
+	@ cp c-util.$(FASLEXT) ${AUTO}
+
+@
+Note that the {\bf c-util.boot.pamphlet} file contains both the
+original {\bf boot} code and a saved copy of the {\bf c-util.clisp}
+code. We need to keep the translated code around so we can bootstrap
+the system. In other words, we need this boot code translated so we
+can build the boot translator.
+
+{\bf NOTE WELL: IF YOU CHANGE THE BOOT CODE IN C-UTIL.BOOT.PAMPHLET
+YOU MUST TRANSLATE THIS CODE TO LISP AND STORE THE RESULTING LISP
+CODE BACK INTO THE C-UTIL.BOOT.PAMPHLET FILE. THIS IS NOT AUTOMATED.}
+<<c-util.lisp (OUT from IN)>>=
+c-util.${LISP}: $(srcdir)/c-util.boot.pamphlet
+	@ echo 146 making c-util.${LISP} from $(srcdir)/c-util.boot.pamphlet
+	@ rm -f c-util.$(FASLEXT)
+	$(axiom_build_document) --tangle=c-util.clisp --output=$@ $<
+
+@
+<<c-util.clisp>>=
+c-util.clisp: c-util.boot
+	@ echo 148 making $@ from $<
+	@ echo '(progn (old-boot::boot "c-util.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-c02.boot \cite{43}}
+
+<<nag-c02.o (AUTO from OUT)>>=
+${AUTO}/nag-c02.$(FASLEXT): nag-c02.$(FASLEXT)
+	@ echo 150 making${AUTO}/nag-c02.$(FASLEXT) from nag-c02.$(FASLEXT)
+	@ cp nag-c02.$(FASLEXT) ${AUTO}
+
+@
+<<nag-c02.clisp>>=
+nag-c02.clisp: nag-c02.boot
+	@ echo 152 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c02.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-c05.boot \cite{44}}
+
+<<nag-c05.o (AUTO from OUT)>>=
+${AUTO}/nag-c05.$(FASLEXT): nag-c05.$(FASLEXT)
+	@ echo 154 making ${AUTO}/nag-c05.$(FASLEXT) from nag-c05.$(FASLEXT)
+	@ cp nag-c05.$(FASLEXT) ${AUTO}
+
+@
+<<nag-c05.clisp>>=
+nag-c05.clisp: nag-c05.boot
+	@ echo 156 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c05.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-c06.boot \cite{45}}
+
+<<nag-c06.o (AUTO from OUT)>>=
+${AUTO}/nag-c06.$(FASLEXT): nag-c06.$(FASLEXT)
+	@ echo 158 making${AUTO}/nag-c06.$(FASLEXT) from nag-c06.$(FASLEXT)
+	@ cp nag-c06.$(FASLEXT) ${AUTO}
+
+@
+<<nag-c06.clisp>>=
+nag-c06.clisp: nag-c06.boot
+	@ echo 160 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-c06.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-d01.boot \cite{46}}
+
+<<nag-d01.o (AUTO from OUT)>>=
+${AUTO}/nag-d01.$(FASLEXT): nag-d01.$(FASLEXT)
+	@ echo 162 making${AUTO}/nag-d01.$(FASLEXT) from nag-d01.$(FASLEXT)
+	@ cp nag-d01.$(FASLEXT) ${AUTO}
+
+@
+<<nag-d01.clisp>>=
+nag-d01.clisp: nag-d01.boot
+	@ echo 164 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d01.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-d02.boot \cite{47}}
+
+<<nag-d02.o (AUTO from OUT)>>=
+${AUTO}/nag-d02.$(FASLEXT): nag-d02.$(FASLEXT)
+	@ echo 166 making${AUTO}/nag-d02.$(FASLEXT) from nag-d02.$(FASLEXT)
+	@ cp nag-d02.$(FASLEXT) ${AUTO}
+
+@
+<<nag-d02.clisp>>=
+nag-d02.clisp: nag-d02.boot
+	@ echo 168 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d02.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-d03.boot \cite{48}}
+
+<<nag-d03.o (AUTO from OUT)>>=
+${AUTO}/nag-d03.$(FASLEXT): nag-d03.$(FASLEXT)
+	@ echo 170 making${AUTO}/nag-d03.$(FASLEXT) from nag-d03.$(FASLEXT)
+	@ cp nag-d03.$(FASLEXT) ${AUTO}
+
+@
+<<nag-d03.clisp>>=
+nag-d03.clisp: nag-d03.boot
+	@ echo 172 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-d03.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-e01.boot \cite{49}}
+
+<<nag-e01.o (AUTO from OUT)>>=
+${AUTO}/nag-e01.$(FASLEXT): nag-e01.$(FASLEXT)
+	@ echo 174 making ${AUTO}/nag-e01.$(FASLEXT) from nag-e01.$(FASLEXT)
+	@ cp nag-e01.$(FASLEXT) ${AUTO}
+
+@
+<<nag-e01.clisp>>=
+nag-e01.clisp: nag-e01.boot
+	@ echo 176 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e01.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-e02.boot \cite{51}}
+
+<<nag-e02.o (AUTO from OUT)>>=
+${AUTO}/nag-e02.$(FASLEXT): nag-e02.$(FASLEXT)
+	@ echo 182 making ${AUTO}/nag-e02.$(FASLEXT) from nag-e02.$(FASLEXT)
+	@ cp nag-e02.$(FASLEXT) ${AUTO}
+
+@
+<<nag-e02.clisp>>=
+nag-e02.clisp: nag-e02.boot
+	@ echo 184 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e02.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-e04.boot \cite{52}}
+
+<<nag-e04.o (AUTO from OUT)>>=
+${AUTO}/nag-e04.$(FASLEXT): nag-e04.$(FASLEXT)
+	@ echo 186 making ${AUTO}/nag-e04.$(FASLEXT) from nag-e04.$(FASLEXT)
+	@ cp nag-e04.$(FASLEXT) ${AUTO}
+
+@
+<<nag-e04.clisp>>=
+nag-e04.clisp: nag-e04.boot
+	@ echo 188 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-e04.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-f01.boot \cite{53}}
+
+<<nag-f01.o (AUTO from OUT)>>=
+${AUTO}/nag-f01.$(FASLEXT): nag-f01.$(FASLEXT)
+	@ echo 190 making ${AUTO}/nag-f01.$(FASLEXT) from nag-f01.$(FASLEXT)
+	@ cp nag-f01.$(FASLEXT) ${AUTO}
+
+@
+<<nag-f01.clisp>>=
+nag-f01.clisp: nag-f01.boot
+	@ echo 192 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f01.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-f02.boot \cite{54}}
+
+<<nag-f02.o (AUTO from OUT)>>=
+${AUTO}/nag-f02.$(FASLEXT): nag-f02.$(FASLEXT)
+	@ echo 194 making ${AUTO}/nag-f02.$(FASLEXT) from nag-f02.$(FASLEXT)
+	@ cp nag-f02.$(FASLEXT) ${AUTO}
+
+@
+<<nag-f02.clisp>>=
+nag-f02.clisp: nag-f02.boot
+	@ echo 196 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f02.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-f04.boot \cite{55}}
+
+<<nag-f04.o (AUTO from OUT)>>=
+${AUTO}/nag-f04.$(FASLEXT): nag-f04.$(FASLEXT)
+	@ echo 198 making ${AUTO}/nag-f04.$(FASLEXT) from nag-f04.$(FASLEXT)
+	@ cp nag-f04.$(FASLEXT) ${AUTO}
+
+@
+<<nag-f04.clisp>>=
+nag-f04.clisp: nag-f04.boot
+	@ echo 200 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f04.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-f07.boot \cite{56}}
+
+<<nag-f07.o (AUTO from OUT)>>=
+${AUTO}/nag-f07.$(FASLEXT): nag-f07.$(FASLEXT)
+	@ echo 202 making ${AUTO}/nag-f07.$(FASLEXT) from nag-f07.$(FASLEXT)
+	@ cp nag-f07.$(FASLEXT) ${AUTO}
+
+@
+<<nag-f07.clisp>>=
+nag-f07.clisp: nag-f07.boot
+	@ echo 204 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-f07.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{nag-s.boot \cite{57}}
+
+<<nag-s.o (AUTO from OUT)>>=
+${AUTO}/nag-s.$(FASLEXT): nag-s.$(FASLEXT)
+	@ echo 206 making ${AUTO}/nag-s.$(FASLEXT) from nag-s.$(FASLEXT)
+	@ cp nag-s.$(FASLEXT) ${AUTO}
+
+@
+<<nag-s.clisp>>=
+nag-s.clisp: nag-s.boot
+	@ echo 208 making $@ from $<
+	@ echo '(progn (boot::reroot "${AXIOM}") (old-boot::boot "nag-s.boot"))' | ${DEPSYS}
+
+@
+
+\subsection{category.boot \cite{58}}
+
+<<category.o (AUTO from OUT)>>=
+${AUTO}/category.$(FASLEXT): category.$(FASLEXT)
+	@ echo 210 making ${AUTO}/ category.$(FASLEXT) from category.$(FASLEXT)
+	@ cp category.$(FASLEXT) ${AUTO}
+
+@
+<<category.clisp>>=
+category.clisp: category.boot
+	@ echo 212 making $@ from $<
+	@ echo '(progn (old-boot::boot "category.boot"))' | ${DEPSYS} 
+@
+
+\subsection{cattable.boot \cite{59}}
+
+<<cattable.clisp>>=
+cattable.clisp: cattable.boot
+	@ echo 215 making $@ from $<
+	@ echo '(progn (old-boot::boot "cattable.boot"))' | ${DEPSYS}
+@
+
+\subsection{c-doc.boot \cite{60}}
+
+<<c-doc.o (AUTO from OUT)>>=
+${AUTO}/c-doc.$(FASLEXT): c-doc.$(FASLEXT)
+	@ echo 217 making ${AUTO}/c-doc.$(FASLEXT) from c-doc.$(FASLEXT)
+	@ cp c-doc.$(FASLEXT) ${AUTO}
+
+@
+<<c-doc.clisp>>=
+c-doc.clisp: c-doc.boot
+	@ echo 219 making $@ from $<
+	@ echo '(progn (old-boot::boot "c-doc.boot"))' | ${DEPSYS} 
+@
+
+
+\subsection{clammed.boot \cite{62}}
+
+<<clammed.clisp>>=
+clammed.clisp: clammed.boot
+	@ echo 226 making $@ from $<
+	@ echo '(progn (old-boot::boot "clammed.boot"))' | ${DEPSYS} 
+@
+
+\subsection{compat.boot \cite{63}}
+
+<<compat.clisp>>=
+compat.clisp: compat.boot
+	@ echo 229 making $@ from $<
+	@ echo '(progn (old-boot::boot "compat.boot"))' | ${DEPSYS} 
+@
+
+\subsection{compiler.boot \cite{64}}
+
+<<compiler.o (AUTO from OUT)>>=
+${AUTO}/compiler.$(FASLEXT): compiler.$(FASLEXT)
+	@ echo 231 making ${AUTO}/compiler.$(FASLEXT) from compiler.$(FASLEXT)
+	@ cp compiler.$(FASLEXT) ${AUTO}
+
+@
+<<compiler.clisp>>=
+compiler.clisp: compiler.boot
+	@ echo 233 making $@ from $<
+	@ echo '(progn (old-boot::boot "compiler.boot"))' | ${DEPSYS}
+@
+
+\subsection{profile.boot \cite{65}}
+
+<<profile.o (AUTO from OUT)>>=
+${AUTO}/profile.$(FASLEXT): profile.$(FASLEXT)
+	@ echo 235 making ${AUTO}/profile.$(FASLEXT) from profile.$(FASLEXT)
+	@ cp profile.$(FASLEXT) ${AUTO}
+
+@
+<<profile.clisp>>=
+profile.clisp: profile.boot
+	@ echo 237 making $@ from $<
+	@ echo '(progn (old-boot::boot "profile.boot"))' | ${DEPSYS}
+@
+
+\subsection{database.boot \cite{67}}
+
+<<database.clisp>>=
+database.clisp: database.boot
+	@ echo 243 making $@ from $<
+	@ echo '(progn (old-boot::boot "database.boot"))' | ${DEPSYS}
+@
+
+\subsection{define.boot}
+
+<<define.o (AUTO from OUT)>>=
+${AUTO}/define.$(FASLEXT): define.$(FASLEXT)
+	@ echo 245 making ${AUTO}/define.$(FASLEXT) from define.$(FASLEXT)
+	@ cp define.$(FASLEXT) ${AUTO}
+
+@
+<<define.clisp>>=
+define.clisp: define.boot
+	@ echo 247 making $@ from $<
+	@ echo '(progn (old-boot::boot "define.boot"))' | ${DEPSYS}
+@
+
+\subsection{format.boot}
+
+<<format.clisp>>=
+format.clisp: format.boot
+	@ echo 250 making $@ from $<
+	@ echo '(progn (old-boot::boot "format.boot"))' | ${DEPSYS}
+@
+
+\subsection{functor.boot}
+
+<<functor.o (AUTO from OUT)>>=
+${AUTO}/functor.$(FASLEXT): functor.$(FASLEXT)
+	@ echo 252 making ${AUTO}/functor.$(FASLEXT) from functor.$(FASLEXT)
+	@ cp functor.$(FASLEXT) ${AUTO}
+
+@
+<<functor.clisp>>=
+functor.clisp: functor.boot
+	@ echo 254 making $@ from $<
+	@ echo '(progn (old-boot::boot "functor.boot"))' | ${DEPSYS}
+@
+
+\subsection{g-cndata.boot}
+
+<<g-cndata.clisp>>=
+g-cndata.clisp: g-cndata.boot
+	@ echo 261 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-cndata.boot"))' | ${DEPSYS}
+@
+
+\subsection{g-opt.boot}
+
+<<g-opt.clisp>>=
+g-opt.clisp: g-opt.boot
+	@ echo 267 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-opt.boot"))' | ${DEPSYS}
+@
+
+\subsection{g-timer.boot}
+
+<<g-timer.clisp>>=
+g-timer.clisp: g-timer.boot
+	@ echo 270 making $@ from $<
+	@ echo '(progn (old-boot::boot "g-timer.boot"))' | ${DEPSYS}
+@
+
+
+\subsection{hypertex.boot}
+
+<<hypertex.clisp>>=
+hypertex.clisp: hypertex.boot
+	@ echo 277 making $@ from $<
+	@ echo '(progn (old-boot::boot "hypertex.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-analy.boot}
+
+<<i-analy.clisp>>=
+i-analy.clisp: i-analy.boot
+	@ echo 280 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-analy.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-code.boot}
+
+<<i-code.clisp>>=
+i-code.clisp: i-code.boot
+	@ echo 283 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-code.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-coerce.boot}
+
+<<i-coerce.clisp>>=
+i-coerce.clisp: i-coerce.boot
+	@ echo 286 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-coerce.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-coerfn.boot}
+
+<<i-coerfn.clisp>>=
+i-coerfn.clisp: i-coerfn.boot
+	@ echo 289 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-coerfn.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-eval.boot}
+
+<<i-eval.clisp>>=
+i-eval.clisp: i-eval.boot
+	@ echo 292 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-eval.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-funsel.boot}
+
+<<i-funsel.clisp>>=
+i-funsel.clisp: i-funsel.boot
+	@ echo 295 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-funsel.boot"))' | ${DEPSYS}
+@
+
+\subsection{bookvol5.lsp}
+
+
+<<bookvol5.lisp>>=
+bookvol5.lisp: $(srcdir)/bookvol5.pamphlet
+	@ echo 298 making $@ from $<
+	$(axiom_build_document) --tangle=Interpreter --output=$@ $<
+@
+
+\subsection{i-intern.boot}
+
+<<i-intern.clisp>>=
+i-intern.clisp: i-intern.boot
+	@ echo 301 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-intern.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-map.boot}
+
+<<i-map.clisp>>=
+i-map.clisp: i-map.boot
+	@ echo 304 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-map.boot"))' | ${DEPSYS} 
+@
+
+\subsection{i-output.boot}
+
+<<i-output.clisp>>=
+i-output.clisp: i-output.boot
+	@ echo 307 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-output.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-resolv.boot}
+
+<<i-resolv.clisp>>=
+i-resolv.clisp: i-resolv.boot
+	@ echo 310 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-resolv.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-spec1.boot}
+
+<<i-spec1.clisp>>=
+i-spec1.clisp: i-spec1.boot
+	@ echo 313 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-spec1.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-spec2.boot}
+
+<<i-spec2.clisp>>=
+i-spec2.clisp: i-spec2.boot
+	@ echo 316 making $@ from i-spec2.boot
+	@ echo '(progn (old-boot::boot "i-spec2.boot"))' | ${DEPSYS} 
+@
+
+\subsection{i-syscmd.boot}
+
+<<i-syscmd.clisp>>=
+i-syscmd.clisp: i-syscmd.boot
+	@ echo 319 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-syscmd.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-toplev.boot}
+
+<<i-toplev.clisp>>=
+i-toplev.clisp: i-toplev.boot
+	@ echo 322 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-toplev.boot"))' | ${DEPSYS}
+@
+
+\subsection{i-util.boot}
+
+<<i-util.clisp>>=
+i-util.clisp: i-util.boot
+	@ echo 325 making $@ from $<
+	@ echo '(progn (old-boot::boot "i-util.boot"))' | ${DEPSYS}
+@
+
+\subsection{info.boot}
+
+<<info.o (AUTO from OUT)>>=
+${AUTO}/info.$(FASLEXT): info.$(FASLEXT)
+	@ echo 327 making ${AUTO}/info.$(FASLEXT) from info.$(FASLEXT)
+	@ cp info.$(FASLEXT) ${AUTO}
+
+@
+<<info.clisp>>=
+info.clisp: info.boot
+	@ echo 329 making $@ from $<
+	@ echo '(progn (old-boot::boot "info.boot"))' | ${DEPSYS}
+@
+
+\subsection{iterator.boot}
+
+<<iterator.o (AUTO from OUT)>>=
+${AUTO}/iterator.$(FASLEXT): iterator.$(FASLEXT)
+	@ echo 331 making ${AUTO}/iterator.$(FASLEXT) from iterator.$(FASLEXT)
+	@ cp iterator.$(FASLEXT) ${AUTO}
+
+@
+<<iterator.clisp>>=
+iterator.clisp: iterator.boot
+	@ echo 333 making $@ from $<
+	@ echo '(progn (old-boot::boot "iterator.boot"))' | ${DEPSYS}
+@
+
+\subsection{lisplib.boot}
+
+<<lisplib.clisp>>=
+lisplib.clisp: lisplib.boot
+	@ echo 336 making $@ from $<
+	@ echo '(progn (old-boot::boot "lisplib.boot"))' | ${DEPSYS}
+@
+
+\subsection{match.boot}
+
+<<match.clisp>>=
+match.clisp: match.boot
+	@ echo 339 making $@ from $<
+	@ echo '(progn (old-boot::boot "match.boot"))' | ${DEPSYS}
+@
+
+\subsection{modemap.boot}
+
+<<modemap.o (AUTO from OUT)>>=
+${AUTO}/modemap.$(FASLEXT): modemap.$(FASLEXT)
+	@ echo 341 making ${AUTO}/modemap.$(FASLEXT) from modemap.$(FASLEXT)
+	@ cp modemap.$(FASLEXT) ${AUTO}
+
+@
+<<modemap.clisp>>=
+modemap.clisp: modemap.boot
+	@ echo 343 making $@ from $<
+	@ echo '(progn (old-boot::boot "modemap.boot"))' | ${DEPSYS}
+@
+
+\subsection{msgdb.boot}
+
+<<msgdb.clisp>>=
+msgdb.clisp: msgdb.boot
+	@ echo 346 making $@ from $<
+	@ echo '(progn (old-boot::boot "msgdb.boot"))' | ${DEPSYS}
+@
+
+\subsection{newfort.boot}
+
+<<newfort.clisp>>=
+newfort.clisp: newfort.boot
+	@ echo 349 making $@ from $<
+	@ echo '(progn (old-boot::boot "newfort.boot"))' | ${DEPSYS}
+@
+
+\subsection{nruncomp.boot}
+
+<<nruncomp.o (AUTO from OUT)>>=
+${AUTO}/nruncomp.$(FASLEXT): nruncomp.$(FASLEXT)
+	@ echo 351 making ${AUTO}/nruncomp.$(FASLEXT) from nruncomp.$(FASLEXT)
+	@ cp nruncomp.$(FASLEXT) ${AUTO}
+
+@
+<<nruncomp.clisp>>=
+nruncomp.clisp: nruncomp.boot
+	@ echo 353 making $@ from $<
+	@ echo '(progn (old-boot::boot "nruncomp.boot"))' | ${DEPSYS}
+@
+
+\subsection{nrunfast.boot}
+
+<<nrunfast.clisp>>=
+nrunfast.clisp: nrunfast.boot
+	@ echo 356 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrunfast.boot"))' | ${DEPSYS}
+@
+
+\subsection{nrungo.boot}
+
+<<nrungo.clisp>>=
+nrungo.clisp: nrungo.boot
+	@ echo 359 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrungo.boot"))' | ${DEPSYS}
+@
+
+\subsection{nruntime.boot}
+
+<<nruntime.clisp>>=
+nruntime.clisp: nruntime.boot
+	@ echo 362 making $@ from $<
+	@ echo '(progn (old-boot::boot "nruntime.boot"))' | ${DEPSYS}
+@
+
+\subsection{nrunopt.boot}
+
+<<nrunopt.clisp>>=
+nrunopt.clisp: nrunopt.boot
+	@ echo 365 making $@ from $<
+	@ echo '(progn (old-boot::boot "nrunopt.boot"))' | ${DEPSYS}
+@
+
+\subsection{package.boot}
+
+<<package.o (AUTO from OUT)>>=
+${AUTO}/package.$(FASLEXT): package.$(FASLEXT)
+	@ echo 370 making ${AUTO}/package.$(FASLEXT) from package.$(FASLEXT)
+	@ cp package.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{parse.boot}
+
+\begin{verbatim}
+NOTE: this is used to build a depsys on a virgin copy of the system
+\end{verbatim}
+<<parse.o (AUTO from OUT)>>=
+${AUTO}/parse.$(FASLEXT): parse.$(FASLEXT)
+	@ echo 374 making ${AUTO}/parse.$(FASLEXT) from parse.$(FASLEXT)
+	@ cp parse.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{pathname.boot}
+
+\begin{verbatim}
+NOTE: the .clisp file is copies back into the src directory so that
+it is possible to create a new obootsys system from scratch for a 
+new platform. parse.clisp needs to be compiled in a depsys.
+One thing need to be done to create an obootsys by hand:
+  parse and postpar must be loaded along with the depsys files
+     into a bare lisp system.
+if these two things are done then a obootsys image can be bootstrapped
+to a new platform.
+\end{verbatim}
+<<pathname.clisp>>=
+pathname.clisp: pathname.boot
+	@ echo 380 making $@ from $<
+	@ echo '(progn (old-boot::boot "pathname.boot"))' | ${DEPSYS}
+@
+
+\subsection{postpar.boot}
+
+\begin{verbatim}
+NOTE: this is used to build a depsys on a virgin copy of the system
+\end{verbatim}
+<<postpar.o (AUTO from OUT)>>=
+${AUTO}/postpar.$(FASLEXT): postpar.$(FASLEXT)
+	@ echo 382 making ${AUTO}/postpar.$(FASLEXT) from postpar.$(FASLEXT)
+	@ cp postpar.$(FASLEXT) ${AUTO}
+
+@
+
+\begin{verbatim}
+NOTE: One thing need to be done to create an DEPSYS by hand:
+  parse and postpar must be loaded along with the depsys files
+     into a bare lisp system.
+if these two things are done then a DEPSYS image can be bootstrapped
+to a new platform.
+\end{verbatim}
+
+\subsection{rulesets.boot}
+
+<<rulesets.clisp>>=
+rulesets.clisp: rulesets.boot
+	@ echo 388 making $@ from $<
+	@ echo '(progn (old-boot::boot "rulesets.boot"))' | ${DEPSYS}
+@
+
+\subsection{server.boot}
+
+<<server.clisp>>=
+server.clisp: server.boot
+	@ echo 391 making $@ from $<
+	@ echo '(progn (old-boot::boot "server.boot"))' | ${DEPSYS}
+@
+
+
+\subsection{setvart.boot}
+
+<<setvart.clisp>>=
+setvart.clisp: setvart.boot
+	@ echo 398 making $@ from $<
+	@ echo '(progn (old-boot::boot "setvart.boot"))' | ${DEPSYS}
+@
+
+\subsection{template.boot}
+
+<<template.clisp>>=
+template.clisp: template.boot
+	@ echo 408 making $@ from $<
+	@ echo '(progn (old-boot::boot "template.boot"))' | ${DEPSYS} 
+@
+
+\subsection{termrw.boot}
+
+<<termrw.clisp>>=
+termrw.clisp: termrw.boot
+	@ echo 411 making $@ from $<
+	@ echo '(progn (old-boot::boot "termrw.boot"))' | ${DEPSYS} 
+@
+
+\subsection{trace.boot}
+
+<<trace.clisp>>=
+trace.clisp: trace.boot
+	@ echo 414 making $@ from $<
+	@ echo '(progn (old-boot::boot "trace.boot"))' | ${DEPSYS}
+@
+
+\subsection{as.boot}
+
+<<as.clisp>>=
+as.clisp: as.boot
+	@ echo 417 making $@ from $<
+	@ echo '(progn (old-boot::boot "as.boot"))' | ${DEPSYS}
+@
+
+\subsection{bc-matrix.boot}
+
+<<bc-matrix.o (AUTO from OUT)>>=
+${AUTO}/bc-matrix.$(FASLEXT): bc-matrix.$(FASLEXT)
+	@ echo 422 making ${AUTO}/bc-matrix.$(FASLEXT) from bc-matrix.$(FASLEXT)
+	@ cp bc-matrix.$(FASLEXT) ${AUTO}
+
+@
+<<bc-matrix.clisp>>=
+bc-matrix.clisp: bc-matrix.boot
+	@ echo 424 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-matrix.boot"))' | ${DEPSYS}
+@
+
+\subsection{bc-misc.boot}
+
+<<bc-misc.o (AUTO from OUT)>>=
+${AUTO}/bc-misc.$(FASLEXT): bc-misc.$(FASLEXT)
+	@ echo 426 making ${AUTO}/bc-misc.$(FASLEXT) from bc-misc.$(FASLEXT)
+	@ cp bc-misc.$(FASLEXT) ${AUTO}
+
+@
+<<bc-misc.clisp>>=
+bc-misc.clisp: bc-misc.boot
+	@ echo 428 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-misc.boot"))' | ${DEPSYS}
+@
+
+\subsection{bc-solve.boot}
+
+<<bc-solve.o (AUTO from OUT)>>=
+${AUTO}/bc-solve.$(FASLEXT): bc-solve.$(FASLEXT)
+	@ echo 430 making ${AUTO}/bc-solve.$(FASLEXT) from bc-solve.$(FASLEXT)
+	@ cp bc-solve.$(FASLEXT) ${AUTO}
+
+@
+<<bc-solve.clisp>>=
+bc-solve.clisp: bc-solve.boot
+	@ echo 432 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-solve.boot"))' | ${DEPSYS}
+@
+
+\subsection{bc-util.boot}
+
+<<bc-util.o (AUTO from OUT)>>=
+${AUTO}/bc-util.$(FASLEXT): bc-util.$(FASLEXT)
+	@ echo 434 making ${AUTO}/bc-util.$(FASLEXT) from bc-util.$(FASLEXT)
+	@ cp bc-util.$(FASLEXT) ${AUTO}
+
+@
+<<bc-util.clisp>>=
+bc-util.clisp: bc-util.boot
+	@ echo 436 making $@ from $<
+	@ echo '(progn (old-boot::boot "bc-util.boot"))' | ${DEPSYS}
+@
+
+\subsection{ht-util.boot}
+
+<<ht-util.o (AUTO from OUT)>>=
+${AUTO}/ht-util.$(FASLEXT): ht-util.$(FASLEXT)
+	@ echo 438 making ${AUTO}/ht-util.$(FASLEXT) from ht-util.$(FASLEXT)
+	@ cp ht-util.$(FASLEXT) ${AUTO}
+
+@
+<<ht-util.clisp>>=
+ht-util.clisp: ht-util.boot
+	@ echo 440 making $@ from $<
+	@ echo '(progn (old-boot::boot "ht-util.boot"))' | ${DEPSYS}
+@
+
+\subsection{htsetvar.boot}
+
+<<htsetvar.o (AUTO from OUT)>>=
+${AUTO}/htsetvar.$(FASLEXT): htsetvar.$(FASLEXT)
+	@ echo 442 making ${AUTO}/htsetvar.$(FASLEXT) from htsetvar.$(FASLEXT)
+	@ cp htsetvar.$(FASLEXT) ${AUTO}
+
+@
+<<htsetvar.clisp>>=
+htsetvar.clisp: htsetvar.boot
+	@ echo 444 making $@ from $<
+	@ echo '(progn (old-boot::boot "htsetvar.boot"))' | ${DEPSYS}
+@
+
+\subsection{record.boot}
+
+<<record.clisp>>=
+record.clisp: record.boot
+	@ echo 447 making $@ $<
+	@ echo '(progn (old-boot::boot "record.boot"))' | ${DEPSYS}
+@
+
+\subsection{ht-root.boot}
+
+<<ht-root.o (AUTO from OUT)>>=
+${AUTO}/ht-root.$(FASLEXT): ht-root.$(FASLEXT)
+	@ echo 449 making ${AUTO}/ht-root.$(FASLEXT) from ht-root.$(FASLEXT)
+	@ cp ht-root.$(FASLEXT) ${AUTO}
+
+@
+<<ht-root.clisp>>=
+ht-root.clisp: ht-root.boot
+	@ echo 451 making $@ from $<
+	@ echo '(progn (old-boot::boot "ht-root.boot"))' | ${DEPSYS}
+@
+
+\subsection{htcheck.boot}
+
+<<htcheck.o (AUTO from OUT)>>=
+${AUTO}/htcheck.$(FASLEXT): htcheck.$(FASLEXT)
+	@ echo 453 making ${AUTO}/htcheck.$(FASLEXT) from htcheck.$(FASLEXT)
+	@ cp htcheck.$(FASLEXT) ${AUTO}
+
+@
+<<htcheck.clisp>>=
+htcheck.clisp: htcheck.boot
+	@ echo 455 making $@ from $<
+	@ echo '(progn (old-boot::boot "htcheck.boot"))' | ${DEPSYS}
+@
+
+\subsection{xruncomp.boot}
+
+<<xruncomp.o (AUTO from OUT)>>=
+${AUTO}/xruncomp.$(FASLEXT): xruncomp.$(FASLEXT)
+	@ echo 457 making ${AUTO}/xruncomp.$(FASLEXT) from xruncomp.$(FASLEXT)
+	@ cp xruncomp.$(FASLEXT) ${AUTO}
+
+@
+<<xruncomp.clisp>>=
+xruncomp.clisp: xruncomp.boot
+	@ echo 459 making $@ from $<
+	@ echo '(progn (old-boot::boot "xruncomp.boot"))' | ${DEPSYS}
+@
+
+\subsection{ax.boot}
+
+<<ax.o (AUTO from OUT)>>=
+${AUTO}/ax.$(FASLEXT): ax.$(FASLEXT)
+	@ echo 461 making ${AUTO}/ax.$(FASLEXT) from ax.$(FASLEXT)
+	@ cp ax.$(FASLEXT) ${AUTO}
+
+@
+<<ax.clisp>>=
+ax.clisp: ax.boot
+	@ echo 463 making $@ $<
+	@ echo '(progn (old-boot::boot "ax.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-con.boot}
+
+<<br-con.o (AUTO from OUT)>>=
+${AUTO}/br-con.$(FASLEXT): br-con.$(FASLEXT)
+	@ echo 465 making ${AUTO}/br-con.$(FASLEXT) from br-con.$(FASLEXT)
+	@ cp br-con.$(FASLEXT) ${AUTO}
+
+@
+<<br-con.clisp>>=
+br-con.clisp: br-con.boot
+	@ echo 467 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-con.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-search.boot}
+
+<<br-search.o (AUTO from OUT)>>=
+${AUTO}/br-search.$(FASLEXT): br-search.$(FASLEXT)
+	@ echo 469 making ${AUTO}/br-search.$(FASLEXT) from br-search.$(FASLEXT)
+	@ cp br-search.$(FASLEXT) ${AUTO}
+
+@
+<<br-search.clisp>>=
+br-search.clisp: br-search.boot
+	@ echo 471 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-search.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-op1.boot}
+
+<<br-op1.o (AUTO from OUT)>>=
+${AUTO}/br-op1.$(FASLEXT): br-op1.$(FASLEXT)
+	@ echo 473 making ${AUTO}/br-op1.$(FASLEXT) from br-op1.$(FASLEXT)
+	@ cp br-op1.$(FASLEXT) ${AUTO}
+
+@
+<<br-op1.clisp>>=
+br-op1.clisp: br-op1.boot
+	@ echo 475 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-op1.boot"))' | ${DEPSYS}
+@
+
+\subsection{br-op2.boot}
+
+<<br-op2.o (AUTO from OUT)>>=
+${AUTO}/br-op2.$(FASLEXT): br-op2.$(FASLEXT)
+	@ echo 477 making ${AUTO}/br-op2.$(FASLEXT) from br-op2.$(FASLEXT)
+	@ cp br-op2.$(FASLEXT) ${AUTO}
+
+@
+<<br-op2.clisp>>=
+br-op2.clisp: br-op2.boot
+	@ echo 479 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-op2.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-data.boot}
+
+<<br-data.o (AUTO from OUT)>>=
+${AUTO}/br-data.$(FASLEXT): br-data.$(FASLEXT)
+	@ echo 481 making ${AUTO}/br-data.$(FASLEXT) from br-data.$(FASLEXT)
+	@ cp br-data.$(FASLEXT) ${AUTO}
+
+@
+<<br-data.clisp>>=
+br-data.clisp: br-data.boot
+	@ echo 483 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-data.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-util.boot}
+
+<<br-util.o (AUTO from OUT)>>=
+${AUTO}/br-util.$(FASLEXT): br-util.$(FASLEXT)
+	@ echo 485 making ${AUTO}/br-util.$(FASLEXT) from br-util.$(FASLEXT)
+	@ cp br-util.$(FASLEXT) ${AUTO}
+
+@
+<<br-util.clisp>>=
+br-util.clisp: br-util.boot
+	@ echo 487 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-util.boot"))' | ${DEPSYS}
+@
+
+\subsection{br-saturn.boot}
+
+<<br-saturn.o (AUTO from OUT)>>=
+${AUTO}/br-saturn.$(FASLEXT): br-saturn.$(FASLEXT)
+	@ echo 489 making ${AUTO}/br-saturn.$(FASLEXT) from br-saturn.$(FASLEXT)
+	@ cp br-saturn.$(FASLEXT) ${AUTO}
+
+@
+<<br-saturn.clisp>>=
+br-saturn.clisp: br-saturn.boot
+	@ echo 491 making $@ from $<
+	@ echo '(progn (old-boot::boot "br-saturn.boot"))' | ${DEPSYS}
+@
+
+\subsection{topics.boot}
+
+<<topics.o (AUTO from OUT)>>=
+${AUTO}/topics.$(FASLEXT): topics.$(FASLEXT)
+	@ echo 493 making ${AUTO}/topics.$(FASLEXT) from topics.$(FASLEXT)
+	@ cp topics.$(FASLEXT) ${AUTO}
+
+@
+<<topics.clisp>>=
+topics.clisp: topics.boot
+	@ echo 495 making $@ from $<
+	@ echo '(progn (old-boot::boot "topics.boot"))' | ${DEPSYS} 
+@
+
+\subsection{br-prof.boot}
+
+<<br-prof.o (AUTO from OUT)>>=
+${AUTO}/br-prof.$(FASLEXT): br-prof.$(FASLEXT)
+	@ echo 497 making ${AUTO}/br-prof.$(FASLEXT) from br-prof.$(FASLEXT)
+	@ cp br-prof.$(FASLEXT) ${AUTO}
+
+@
+<<br-prof.clisp>>=
+br-prof.clisp: br-prof.boot
+	@ echo 499 making $@ from $<
+	@ ($(axiom_build_document) --tangle --output=br-prof.boot $< ;\
+	  echo '(progn (old-boot::boot "br-prof.boot"))' | ${DEPSYS}; \
+	  rm br-prof.boot )
+
+@
+
+\subsection{showimp.boot}
+
+system level hacking files
+<<showimp.o (AUTO from OUT)>>=
+${AUTO}/showimp.$(FASLEXT): showimp.$(FASLEXT)
+	@ echo 579 making ${AUTO}/showimp.$(FASLEXT) from showimp.$(FASLEXT)
+	@ cp showimp.$(FASLEXT) ${AUTO}
+
+@
+
+\subsection{wi1.boot}
+
+translate files
+<<wi1.o (AUTO from MID)>>=
+${AUTO}/wi1.$(FASLEXT): wi1.$(FASLEXT) 
+	@ cp $< $@
+@
+
+\subsection{wi2.boot}
+
+<<wi2.o (AUTO from MID)>>=
+${AUTO}/wi2.$(FASLEXT):  wi2.$(FASLEXT)
+	@ cp $< $@
+@
+
+\subsection{pspad1.boot}
+
+<<pspad1.o (AUTO from MID)>>=
+${AUTO}/pspad1.$(FASLEXT):  pspad1.$(FASLEXT)
+	@ cp $< $@
+@
+
+\subsection{pspad2.boot}
+
+<<pspad2.o (AUTO from MID)>>=
+${AUTO}/pspad2.$(FASLEXT):  pspad2.$(FASLEXT)
+	@ cp $< $@
+@
+
+\subsection{mark.boot}
+
+<<mark.o (AUTO from MID)>>=
+${AUTO}/mark.$(FASLEXT): mark.$(FASLEXT)
+	@ cp $< $@
+
+@
+
+\section{The databases}
+
+\begin{verbatim}
+ autoload dependencies
+
+ if you are adding a file which is to be autoloaded the following step
+ information is useful:
+  there are 2 cases:
+   1) adding files to currently autoloaded parts
+      (as of 2/92: browser old parser and old compiler)
+   2) adding new files
+   case 1:
+     a) you have to add the file to the list of files currently there
+        (e.g. see BROBJS above)
+     b) add an autolaod rule
+        (e.g. ${AUTO}/parsing.$(FASLEXT): parsing.$(FASLEXT))
+     c) edit util.lisp to add the 'external' function (those that
+        should trigger the autoload
+   case 2:
+     build-interpsys (in util.lisp) needs an extra argument for the
+     new autoload things and several functions in util.lisp need hacking.
+
+ database.date is a marker file used to force a rebuild of interpsys if the
+ database is rebuilt (src/algebra/Makefile).
+
+\end{verbatim}
+<<databases>>=
+exposed.lsp: $(axiom_src_algdir)/exposed.lsp.pamphlet
+	@ echo 615 making exposed.lsp from $(axiom_src_algdir)/exposed.lsp.pamphlet
+	$(axiom_build_document) --tangle --output=$@ $<
+
+$(axiom_targetdir)/algebra/exposed.$(FASLEXT) : exposed.lsp ${LISPSYS}
+	@ echo 616 making $@ from exposed.lsp
+	$(mkinstalldirs) $(axiom_targetdir)/algebra
+	@ echo '(progn  (compile-file "exposed.lsp" :output-file "$(axiom_targetdir)/algebra/exposed.$(FASLEXT)"))' | ${LISPSYS} 
+
+database.date:
+	@ echo 617 the database was updated...remaking interpsys
+	@ touch database.date
+
+@
+
+\section{The Makefile}
+<<*>>=
+
+subdir = src/interp/
+
+<<environment>>
+
+.SUFFIXES:
+.SUFFIXES: .boot .clisp .lisp .pamphlet
+
+.PHONY: all all-ax all-depsys all-interpsys all-axiomsys all-debugsys
+
+all: all-ax
+
+all-ax: stamp
+	@echo finished $(srcdir)
+
+stamp: $(AUTO) remove-stamp build-images
+	$(STAMP) stamp
+
+.PHONY: remove-stamp
+remove-stamp:
+	-rm -f stamp
+
+.PHONY: build-images
+build-images: remove-stamp all-interpsys all-debugsys
+
+all-interpsys: all-depsys 
+	$(mkinstalldirs) $(AUTO)
+	$(MAKE) $(SAVESYS)
+
+all-axiomsys: all-depsys 
+	$(MAKE) $(AXIOMSYS)
+
+all-debugsys: all-interpsys
+	$(MAKE) $(DEBUGSYS)
+
+all-depsys: $(DEPSYS)
+
+<<extract source codes>>
+
+mostlyclean-local:
+	@rm -f *.fn *.data *.$(FASLEXT) *.lib
+
+clean-local: mostlyclean-local
+	@rm -f *.clisp *.lsp
+
+distclean-local: clean-local
+
+<<savesys>>
+<<depsys>>
+<<axiomsys>>
+<<debugsys>>
+<<databases>>
+
+<<apply.o (AUTO from OUT)>>
+
+<<as.clisp>>
+
+<<ax.o (AUTO from OUT)>>
+<<ax.clisp>>
+
+<<bc-matrix.o (AUTO from OUT)>>
+<<bc-matrix.clisp>>
+
+<<bc-misc.o (AUTO from OUT)>>
+<<bc-misc.clisp>>
+
+<<bc-solve.o (AUTO from OUT)>>
+<<bc-solve.clisp>>
+
+<<bc-util.o (AUTO from OUT)>>
+<<bc-util.clisp>>
+
+<<bootlex.o (AUTO from OUT)>>
+
+<<br-con.o (AUTO from OUT)>>
+<<br-con.clisp>>
+
+<<br-data.o (AUTO from OUT)>>
+<<br-data.clisp>>
+
+<<br-op1.o (AUTO from OUT)>>
+<<br-op1.clisp>>
+
+<<br-op2.o (AUTO from OUT)>>
+<<br-op2.clisp>>
+
+<<br-prof.o (AUTO from OUT)>>
+<<br-prof.clisp>>
+
+<<br-saturn.o (AUTO from OUT)>>
+<<br-saturn.clisp>>
+
+<<br-search.o (AUTO from OUT)>>
+<<br-search.clisp>>
+
+<<br-util.o (AUTO from OUT)>>
+<<br-util.clisp>>
+
+<<buildom.clisp>>
+
+<<category.o (AUTO from OUT)>>
+<<category.clisp>>
+
+<<cattable.clisp>>
+
+<<c-doc.o (AUTO from OUT)>>
+<<c-doc.clisp>>
+
+<<clammed.clisp>>
+
+<<compat.clisp>>
+
+<<compiler.o (AUTO from OUT)>>
+<<compiler.clisp>>
+
+<<c-util.o (AUTO from OUT)>>
+<<c-util.lisp (OUT from IN)>>
+<<c-util.clisp>>
+
+<<database.clisp>>
+
+<<debugsys.lisp>>
+
+<<def.o (AUTO from OUT)>>
+
+<<define.o (AUTO from OUT)>>
+<<define.clisp>>
+
+<<fnewmeta.o (AUTO from OUT)>>
+
+<<format.clisp>>
+
+<<fortcall.clisp>>
+
+<<functor.o (AUTO from OUT)>>
+<<functor.clisp>>
+
+<<g-cndata.clisp>>
+
+<<g-opt.clisp>>
+
+<<g-timer.clisp>>
+
+<<htcheck.o (AUTO from OUT)>>
+<<htcheck.clisp>>
+
+<<ht-root.o (AUTO from OUT)>>
+<<ht-root.clisp>>
+
+<<htsetvar.o (AUTO from OUT)>>
+<<htsetvar.clisp>>
+
+<<ht-util.o (AUTO from OUT)>>
+<<ht-util.clisp>>
+
+<<hypertex.clisp>>
+
+<<i-analy.clisp>>
+
+<<i-code.clisp>>
+
+<<i-coerce.clisp>>
+
+<<i-coerfn.clisp>>
+
+<<i-eval.clisp>>
+
+<<i-funsel.clisp>>
+
+<<bookvol5.lisp>>
+
+<<i-intern.clisp>>
+
+<<i-map.clisp>>
+
+<<info.o (AUTO from OUT)>>
+<<info.clisp>>
+
+<<i-output.clisp>>
+
+<<i-resolv.clisp>>
+
+<<i-spec1.clisp>>
+
+<<i-spec2.clisp>>
+
+<<i-syscmd.clisp>>
+
+<<iterator.o (AUTO from OUT)>>
+<<iterator.clisp>>
+
+<<i-toplev.clisp>>
+
+<<i-util.clisp>>
+
+<<lisplib.clisp>>
+
+<<mark.o (AUTO from MID)>>
+
+<<match.clisp>>
+
+<<metalex.o (AUTO from OUT)>>
+
+<<metameta.o (AUTO from OUT)>>
+
+<<modemap.o (AUTO from OUT)>>
+<<modemap.clisp>>
+
+<<msgdb.clisp>>
+
+<<nag-c02.o (AUTO from OUT)>>
+<<nag-c02.clisp>>
+
+<<nag-c05.o (AUTO from OUT)>>
+<<nag-c05.clisp>>
+
+<<nag-c06.o (AUTO from OUT)>>
+<<nag-c06.clisp>>
+
+<<nag-d01.o (AUTO from OUT)>>
+<<nag-d01.clisp>>
+
+<<nag-d02.o (AUTO from OUT)>>
+<<nag-d02.clisp>>
+
+<<nag-d03.o (AUTO from OUT)>>
+<<nag-d03.clisp>>
+
+<<nag-e01.o (AUTO from OUT)>>
+<<nag-e01.clisp>>
+
+<<nag-e02.o (AUTO from OUT)>>
+<<nag-e02.clisp>>
+
+<<nag-e04.o (AUTO from OUT)>>
+<<nag-e04.clisp>>
+
+<<nag-f01.o (AUTO from OUT)>>
+<<nag-f01.clisp>>
+
+<<nag-f02.o (AUTO from OUT)>>
+<<nag-f02.clisp>>
+
+<<nag-f04.o (AUTO from OUT)>>
+<<nag-f04.clisp>>
+
+<<nag-f07.o (AUTO from OUT)>>
+<<nag-f07.clisp>>
+
+<<nag-s.o (AUTO from OUT)>>
+<<nag-s.clisp>>
+
+<<newfort.clisp>>
+
+<<nruncomp.o (AUTO from OUT)>>
+<<nruncomp.clisp>>
+
+<<nrunfast.clisp>>
+
+<<nrungo.clisp>>
+
+<<nruntime.clisp>>
+
+<<nrunopt.clisp>>
+
+<<nspadaux.o (AUTO from OUT)>>
+
+<<package.o (AUTO from OUT)>>
+
+<<parse.o (AUTO from OUT)>>
+
+<<parsing.o (AUTO from OUT)>>
+
+<<postpar.o (AUTO from OUT)>>
+
+<<postprop.lisp (AUTO from OUT)>>
+
+<<preparse.o (AUTO from OUT)>>
+
+<<profile.o (AUTO from OUT)>>
+<<profile.clisp>>
+
+<<pspad1.o (AUTO from MID)>>
+
+<<pspad2.o (AUTO from MID)>>
+
+<<record.clisp>>
+
+<<rulesets.clisp>>
+
+<<server.clisp>>
+
+<<setvart.clisp>>
+
+<<showimp.o (AUTO from OUT)>>
+
+<<template.clisp>>
+
+<<termrw.clisp>>
+
+<<topics.o (AUTO from OUT)>>
+<<topics.clisp>>
+
+<<trace.clisp>>
+
+<<warm.data.stanza>>
+
+<<wi1.o (AUTO from MID)>>
+
+<<wi2.o (AUTO from MID)>>
+
+<<xruncomp.o (AUTO from OUT)>>
+<<xruncomp.clisp>>
+
+<<DVI from pamphlet>>
+
+@
+pp
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} \File{Makefile.pamphlet}
+\bibitem{2} \File{src/boot/Makefile.pamphlet}
+\bibitem{3} \File{src/interp/bootfuns.lisp.pamphlet}
+\bibitem{4} \File{src/interp/setq.lisp.pamphlet}
+\bibitem{5} \File{src/interp/patches.lisp.pamphlet}
+\bibitem{6} {\bf www.aldor.org}
+\bibitem{7} \File{src/interp/apply.boot.pamphlet}
+\bibitem{8} \File{src/interp/bits.lisp.pamphlet}
+\bibitem{9} \File{src/interp/bootlex.lisp.pamphlet}
+\bibitem{10} \File{src/interp/cfuns.lisp.pamphlet}
+\bibitem{11} \File{src/interp/comp.lisp.pamphlet}
+\bibitem{12} \File{src/interp/construc.lisp.pamphlet}
+\bibitem{13} \File{src/interp/daase.lisp.pamphlet}
+\bibitem{14} \File{src/interp/debug.lisp.pamphlet}
+\bibitem{15} \File{src/interp/def.lisp.pamphlet}
+\bibitem{16} \File{src/interp/fortcall.boot.pamphlet}
+\bibitem{17} \File{src/interp/fname.lisp.pamphlet}
+\bibitem{18} \File{src/interp/fnewmeta.lisp.pamphlet}
+\bibitem{19} \File{src/interp/ggreater.lisp.pamphlet}
+\bibitem{20} \File{src/interp/hash.lisp.pamphlet}
+\bibitem{21} \File{src/interp/macros.lisp.pamphlet}
+\bibitem{22} \File{src/interp/metalex.lisp.pamphlet}
+\bibitem{23} \File{src/interp/metameta.lisp.pamphlet}
+\bibitem{24} \File{src/interp/monitor.lisp.pamphlet}
+\bibitem{25} \File{src/interp/newaux.lisp.pamphlet}
+\bibitem{26} \File{src/interp/nlib.lisp.pamphlet}
+\bibitem{27} \File{src/interp/nocompil.lisp.pamphlet}
+\bibitem{28} \File{src/interp/nspadaux.lisp.pamphlet}
+\bibitem{29} \File{src/interp/parsing.lisp.pamphlet}
+\bibitem{30} \File{src/interp/postprop.lisp.pamphlet}
+\bibitem{31} \File{src/interp/preparse.lisp.pamphlet}
+\bibitem{32} \File{src/interp/property.lisp.pamphlet}
+\bibitem{33} \File{src/interp/sockio.lisp.pamphlet}
+\bibitem{34} \File{src/interp/spad.lisp.pamphlet}
+\bibitem{35} \File{src/interp/spaderror.lisp.pamphlet}
+\bibitem{37} \File{src/interp/union.lisp.pamphlet}
+\bibitem{38} \File{src/interp/util.lisp.pamphlet}
+\bibitem{39} \File{src/interp/vmlisp.lisp.pamphlet}
+\bibitem{40} \File{src/interp/alql.boot.pamphlet}
+\bibitem{41} \File{src/interp/buildom.boot.pamphlet}
+\bibitem{42} \File{src/interp/c-util.boot.pamphlet}
+\bibitem{43} \File{src/interp/nag-c02.boot.pamphlet}
+\bibitem{44} \File{src/interp/nag-c05.boot.pamphlet}
+\bibitem{45} \File{src/interp/nag-c06.boot.pamphlet}
+\bibitem{46} \File{src/interp/nag-d01.boot.pamphlet}
+\bibitem{47} \File{src/interp/nag-d02.boot.pamphlet}
+\bibitem{48} \File{src/interp/nag-d03.boot.pamphlet}
+\bibitem{49} \File{src/interp/nag-e01.boot.pamphlet}
+\bibitem{51} \File{src/interp/nag-e02.boot.pamphlet}
+\bibitem{52} \File{src/interp/nag-e04.boot.pamphlet}
+\bibitem{53} \File{src/interp/nag-f01.boot.pamphlet}
+\bibitem{54} \File{src/interp/nag-f02.boot.pamphlet}
+\bibitem{55} \File{src/interp/nag-f04.boot.pamphlet}
+\bibitem{56} \File{src/interp/nag-f07.boot.pamphlet}
+\bibitem{57} \File{src/interp/nag-s.boot.pamphlet}
+\bibitem{58} \File{src/interp/category.boot.pamphlet}
+\bibitem{59} \File{src/interp/cattable.boot.pamphlet}
+\bibitem{60} \File{src/interp/c-doc.boot.pamphlet}
+\bibitem{61} \File{src/interp/clam.boot.pamphlet}
+\bibitem{62} \File{src/interp/clammed.boot.pamphlet}
+\bibitem{63} \File{src/interp/compat.boot.pamphlet}
+\bibitem{64} \File{src/interp/compiler.boot.pamphlet}
+\bibitem{65} \File{src/interp/profile.boot.pamphlet}
+\bibitem{66} \File{src/interp/compress.boot.pamphlet}
+\bibitem{67} \File{src/interp/database.boot.pamphlet}
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/alql.boot.pamphlet b/src/interp/alql.boot.pamphlet
new file mode 100644
index 00000000..2a19727f
--- /dev/null
+++ b/src/interp/alql.boot.pamphlet
@@ -0,0 +1,78 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp alql.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+getBrowseDatabase(kind) ==
+  $includeUnexposed? : local := true
+  not member(kind,'("o" "k" "c" "d" "p")) => nil
+  grepConstruct('"*",INTERN kind)
+
+stringMatches?(pattern,subject) ==
+  FIXP basicMatch?(pattern,subject) => true
+  false
+alqlGetKindString(x) ==
+  x.0 = char 'a or x.0 = char 'o => SUBSTRING(dbPart(x,5,1),0,1)
+  SUBSTRING(x,0,1)
+alqlGetOrigin(x) ==
+  field :=dbPart(x,5,1)
+  k := charPosition(char '_(,field,2)
+  SUBSTRING(field,1,k-1)
+alqlGetParams(x) ==
+  field :=dbPart(x,5,1)
+  k := charPosition(char '_(,field,2)
+  SUBSTRING(field,k,nil)
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/anna.boot.pamphlet b/src/interp/anna.boot.pamphlet
new file mode 100644
index 00000000..4a7ef6e7
--- /dev/null
+++ b/src/interp/anna.boot.pamphlet
@@ -0,0 +1,1932 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp anna.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+annaGen command ==
+  htInitPage('"AXIOM/NAG Expert System Command",nil)
+  string :=
+    #command < 50 => STRCONC('"{\centerline{\tt ",command,'" }}")
+    STRCONC('"{\tt ",command,'" }")
+  htMakePage [
+     '(text
+        "\center{{\em Here is the AXIOM command}}"
+          "\center{{\em you could have issued to compute this result:}}"
+            "\vspace{2}\newline "),
+      ['text,: string]]
+  htMakeDoitButton('"Do It", command)
+  htShowPage()
+
+annaInt() ==
+  htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\blankline ")
+    (text . "Analyses the function for various attributes, chooses and ")
+    (text . "then uses a suitable integration routine to ")
+    (text . "evaluate the finite, semi-infinite or infinite integral ")
+    (text . "\blankline ")
+    (text . "\tab{22} \space{1} \vspace{-32} ")
+    (text . "\inputbitmap{\htbmdir{}/ing.bitmap} \vspace{-34} f(x) dx ")
+    (text . "\blankline ")
+    (text . "\newline")
+    (text . "\newline \menuitemstyle{} \tab{2} {\em Lower} bound of the interval {\em a}: ")
+    (radioButtons lower
+        ("" "  Finite" lowerFinite)
+        ("" "  Minus Infinity" lowerInfinite))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} {\em Upper} bound of the interval {\em b}: ")
+    (radioButtons upper
+        ("" "  Finite" upperFinite)
+        ("" "  Plus Infinity" upperInfinite)))
+  htMakeDoneButton('"Continue",'annaIntSolve)
+  htShowPage()
+
+annaDan() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "(log(2-x)*log(x))/((2-x)^(2/3)*sqrt(x))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "2.0" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaBar() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "exp(-y)/sqrt(y)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "%plusInfinity" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaFoo() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "(exp(-x^3)+exp(-3*x^2))/sqrt(x)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "%plusInfinity" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaBlah() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "exp(-omega)/((omega-5)*(omega-1/2))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "%plusInfinity" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaJoe() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "(exp(-x^3)+exp(-3*x^2))/(x^2-2)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "2.0" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaSue() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "1/(x^6-1)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0.0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "2.0" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaAnn() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "cos(t^2)+sin(t)+cos(sin(t^3))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "-%pi" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "%pi" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaBab() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "x*product(x-i/10,i=-4..4)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "-1" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "1" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaFnar() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "cos(20*rho)*(sin(rho^2) + cos(rho^2))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "0" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "1" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaTub() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "exp(-z^2/2)/sqrt(2*%pi)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "%minusInfinity" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "%plusInfinity" upper EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaRats() ==
+
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (50 "log(u*u)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "-1" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "1" upper EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htShowPage()
+
+annaIntSolve htPage ==
+
+  l := htpButtonValue(htPage,'lower)
+  u := htpButtonValue(htPage,'upper)
+  a := 
+    l = 'lowerFinite => '"finite"
+    '"%minusInfinity"
+  b := 
+    u = 'upperFinite => '"finite"
+    '"%plusInfinity"
+  (a = b) => annaDan()
+  a = '"finite" => annaFoo()
+  b = '"%plusInfinity" => annaTub()
+  page := htInitPage('"Integration using AXIOM/NAG Expert System",htPage)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
+    (bcStrings (45 "exp(-x^2/2)/sqrt(2*%pi)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\em a}: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} ")
+    (text . "{\em Upper} bound of the interval {\em b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (15 "%minusInfinity" lower EM))
+    (text . "\tab{32} ")
+    (bcStrings (15 "0.0" upper EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-6" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaIntGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+annaIntGen htPage ==
+  lower := htpLabelInputString(htPage,'lower)
+  upper := htpLabelInputString(htPage,'upper)
+  expression := htpLabelInputString(htPage,'expression)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  annaGen STRCONC('"integrate(",expression,", ",lower,"..",upper,", ",epsabs,", ",epsrel,")")
+
+annaMInt() ==
+  htInitPage('"Integration using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "Analyses the function for various attributes, chooses and ")
+    (text . "then uses a suitable integration routine ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f of the form: ")
+    (text . "\center{\inputbitmap{\htbmdir{}/d01fcf.bitmap}} ")
+    (text . "\newline ")
+    (text . "to be integrated in terms of subscripted ") 
+    (text . "variables e.g. X[1]...X[n]: \newline \tab{2} ")
+    (bcStrings (58 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of dimensions n in the integral, 2 \htbitmap{less=} ")
+    (text . "{\it N} \htbitmap{less=} 15: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (2 4 n PI))
+    (text . "\blankline ")
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue", 'annaMIntSolve)
+  htShowPage()
+
+annaMIntSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  n = '4 => annaMIntDefaultSolve(htPage)
+  expression := htpLabelInputString(htPage,'expression)
+  rangeList :=
+    "append"/[f(i,n) for i in 1..n] where f(i,n) ==
+      prefix := ('"\newline a")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'"\space{1}")
+      post   := ('"\tab{30} b")
+      post   := STRCONC(post,STRINGIMAGE i,'"\space{1}")
+      rnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      inam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[5, 0.0, rnam, 'EM]],
+       ['text,:post],['bcStrings,[5, 1.0, inam, 'EM]]]
+  errList :=
+    errtext := ('"\newline \blankline \menuitemstyle{}\tab{2}")
+    errtext := STRCONC(errtext,'"Absolute accuracy required:")
+    errtext := STRCONC(errtext,'"\tab{30} \menuitemstyle{}\tab{32}")
+    errtext := STRCONC(errtext,'"Relative accuracy required: \newline\tab{2} ")
+    [['text,:errtext],['bcStrings,[10, 0.0, 'abserr, 'F]],
+     ['text,"\tab{32} "],['bcStrings,[10, 1.0e-4, 'relerr, 'F]]]
+  equationPart := [
+     '(domainConditions
+        (isDomain EM ($EmptyMode))
+         (isDomain F (Float))
+          (isDomain S (String))
+            (isDomain PI (PositiveInteger))),
+              :rangeList,:errList]
+  page := htInitPage("AXIOM/NAG Multiple Integration", htpPropertyList htPage)
+  htSay '"Please enter the limits of integration:-  "
+  htSay '"\blankline \menuitemstyle{} \tab{2} "
+  htSay '"Lower Limits: \tab{30} \menuitemstyle{} \tab{32} "
+  htSay '"Upper Limits: \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'annaMIntGen)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+annaMIntDefaultSolve (htPage) ==
+
+  page := htInitPage('"AXIOM/NAG Multiple Integration",nil)
+  expression := htpLabelInputString(htPage,'expression)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+        (isDomain EM $EmptyMode))
+    (text . "\newline ")
+    (text . "Please enter the limits of integration:- ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Lower limits: \tab{30} ")
+    (text . "\menuitemstyle{} \tab{32} Upper limits: ")
+    (text . "\newline a1 ")
+    (bcStrings (10 "0.0" a1 F))
+    (text . "\tab{30} b1 ")
+    (bcStrings (10 "1.0" b1 F))
+    (text . "\newline a2 ")
+    (bcStrings (10 "0.0" a2 F))
+    (text . "\tab{30} b2 ")
+    (bcStrings (10 "1.0" b2 F))
+    (text . "\newline a3 ")
+    (bcStrings (10 "0.0" a3 F))
+    (text . "\tab{30} b3 ")
+    (bcStrings (10 "1.0" b3 F))
+    (text . "\newline a4 ")
+    (bcStrings (10 "0.0" a4 F))
+    (text . "\tab{30} b4 ")
+    (bcStrings (10 "1.0" b4 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{30} \menuitemstyle{}\tab{32}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaMIntGen)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+annaMIntGen htPage ==
+  expression := htpProperty(htPage,'expression)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  epsrel := STRCONC((first y).1,'"")
+  y := rest y
+  epsabs := STRCONC((first y).1,'"")
+  y := rest y
+  while y repeat
+    right := STRCONC((first y).1,'"")
+    y := rest y
+    left := STRCONC((first y).1,"..")
+    y := rest y
+    rangelist := [STRCONC(left,right),:rangelist]
+  rangestring := bcwords2liststring rangelist
+  annaGen STRCONC ('"integrate( ",expression,", ",rangestring,", ",epsabs,", ",epsrel,")")
+
+annaOde() ==
+  htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "Analyses the function for various attributes, chooses and ")
+    (text . "then uses a suitable ODE solver to provide a ")
+    (text . "solution to the system of n ODEs \center{\htbitmap{d02gaf},}" )
+    (text . "for i = 1,2,...,n.")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} Is there any stopping criteria (i.e. some function ")
+    (text . "G(X,Y) such that the algorithm should stop when G(X,Y) = 0)? ")
+    (radioButtons stoppingCriteria
+        ("" "  No \space{1} If No, G(X,Y) is set to 1.0" nostop)
+        ("" "  Yes" stop))
+    (text . "\blankline")
+    (text . "\newline \menuitemstyle{} \tab{2} Are intermediate values required? ")
+    (radioButtons intermediateValues
+        ("" "  No" noint)
+        ("" "  Yes" int))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Size of the system of equations:\space{1}")
+    (bcStrings (3 3 n PI))
+    (text . "\newline"))
+  htMakeDoneButton('"Continue",'annaOdeSolve)
+  htShowPage()
+
+annaOdeSolve htPage ==
+
+  s := htpButtonValue(htPage,'stoppingCriteria)
+  i := htpButtonValue(htPage,'intermediateValues)
+  stoppingCriteria := 
+    s = 'nostop => '"no"
+    '"stopping"
+  intermediateValues := 
+    i = 'noint => '"no"
+    '"intervals"
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  (n = '3) => 
+    (stoppingCriteria = intermediateValues) => annaOdeDefaultSolve()
+    (stoppingCriteria = '"stopping") =>
+      (intermediateValues = '"intervals") => annaOdeDefaultSolve1() 
+      annaOdeDefaultSolve2()
+    annaOdeDefaultSolve3()
+  expressionList :=
+    "append"/[fe(i,n) for i in 1..n] where fe(i,n) ==
+      prefix := ('"\blankline \newline Y")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'"'\space{1}")
+      expression := INTERN STRCONC ('"Y",STRINGIMAGE i)
+      [['text,:prefix],
+       ['bcStrings,[45, STRCONC ('"Y[",STRINGIMAGE i,'"]"), expression, 'EM]]]
+  xList :=
+    prefix := ('"\blankline \newline \menuitemstyle{} \tab{2} Initial Value for X: ")
+    middle := ('"\tab{24} \menuitemstyle{} \tab{26} Final Value for X: ")
+    [['text,:prefix],['bcStrings,[5, "0.0", "xinit", 'EM]],
+     ['text,:middle],['bcStrings,[5, "10.0", "xend", 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Initial Value for Y[i]: ")
+  middle := STRCONC(middle,"\newline ")
+  yinitList := 
+    "append"/[fy(i,n) for i in 1..n] where fy(i,n) ==
+      prefix := ('"\newline Y")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'"\space{1}")
+      yinit := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, '"0.0", yinit, 'EM]]]
+  yinitList := [['text,:middle],:yinitList]
+  if stoppingCriteria = '"no" then
+    sExpression := []
+  else 
+    sText := '"\blankline \newline \menuitemstyle{} \tab{2}"
+    sText := STRCONC(sText,'"\newline Enter the function G(x,y) (The Stopping Criteria): ")
+    sText := STRCONC(sText,'"\newline \tab{2}")
+    sExpression := [['bcStrings,[15, '"Y[1]", "stop", 'EM]]]
+    sExpression := [['text,sText],:sExpression]
+  if intermediateValues = '"no" then
+    ilist := []
+  else 
+    iText := '"\blankline \newline \menuitemstyle{} \tab{2}"
+    iText := STRCONC(iText,'"Enter the list of Intermediate Values required: ")
+    iText := STRCONC(iText,"\newline \tab{2}")
+    iList := [['bcStrings,[15, '"[2,4,6,8]", "ivals", 'EM]]]
+    iList := [['text,iText],:iList]
+  tolList := 
+    tolText := '"\blankline \newline \menuitemstyle{} \tab{2}"
+    tolText := STRCONC(tolText,'"Relative accuracy required:\space{1}")
+    [['text,tolText],['bcStrings,[10, '"1.0e-4", "relerr", 'F]]]
+  expressionPart := [
+     '(domainConditions
+        (isDomain EM ($EmptyMode))
+         (isDomain F (Float))
+           (isDomain S (String))
+            (isDomain PI (PositiveInteger))),
+              :expressionList,:xList,:yinitList,:sExpression,:iList,:tolList]
+  page := htInitPage("AXIOM/NAG ODE Solvers", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e.~the derivatives "
+  htSay '"Y[1]'..Y[n]') in terms of Y[1]..Y[n]: "
+  htSay '"\newline "
+  htMakePage expressionPart
+  htMakeDoneButton('"Continue",'annaOdeGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
+  htpSetProperty(page,'intermediateValues,intermediateValues)
+  htShowPage()
+
+
+annaOdeDefaultSolve() ==
+
+  n := '3
+  stoppingCriteria := '"no"
+  intermediateValues :=  '"no"
+  page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
+    (text . "in terms of Y[1]..Y[n]: ")
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
+    (bcStrings (42 "tan(Y[3])" Y1 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
+    (bcStrings (42 "-0.032*tan(Y[3])/Y[2]-0.02*Y[2]/cos(Y[3])" Y2 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
+    (bcStrings (42 "-0.032/(Y[2]**2)" Y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for X: ")
+    (text . "\tab{24} \menuitemstyle{}\tab{26} ")
+    (text . "Final Value for X:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" xinit EM))
+    (text . "\tab{26} ")
+    (bcStrings (10 "10.0" xend EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for Y[i]: ")
+    (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
+    (bcStrings (10 "0.5" y1 EM))
+    (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
+    (bcStrings (10 "0.5" y2 EM))
+    (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
+    (bcStrings (10 "%pi*0.2" y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Relative accuracy required:\space{1}")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'annaOdeGen)
+  htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
+  htpSetProperty(page,'intermediateValues,intermediateValues)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOdeDefaultSolve3() ==
+
+  n := '3
+  stoppingCriteria := '"no"
+  intermediateValues := '"intervals"
+  page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
+    (text . "in terms of Y[1]..Y[n]:  ")
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
+    (bcStrings (42 "-0.04*Y[1]+1.0e4*Y[2]*Y[3]" Y1 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
+    (bcStrings (42 "0.04*Y[1]-1.0e4*Y[2]*Y[3]-3.0e7*Y[2]*Y[2]" Y2 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
+    (bcStrings (42 "3.0e7*Y[2]*Y[2]" Y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for X: ")
+    (text . "\tab{24} \menuitemstyle{}\tab{26} ")
+    (text . "Final Value for X:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" xinit EM))
+    (text . "\tab{26} ")
+    (bcStrings (10 "10.0" xend EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for Y[i]: ")
+    (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
+    (bcStrings (10 "1.0" y1 EM))
+    (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
+    (bcStrings (10 "0.0" y2 EM))
+    (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
+    (bcStrings (10 "0.0" y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Enter the list of Intermediate Values required: ")
+    (bcStrings (10 "[2,4,6,8]" intvals EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Relative accuracy required:\space{1}")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'annaOdeGen)
+  htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
+  htpSetProperty(page,'intermediateValues,intermediateValues)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOdeDefaultSolve2() ==
+
+  n := '3
+  stoppingCriteria := '"stopping"
+  intermediateValues := '"no"
+  page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
+    (text . "in terms of Y[1]..Y[n]:  ")
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
+    (bcStrings (42 "tan(Y[3])" Y1 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
+    (bcStrings (42 "-0.032*tan(Y[3])/Y[2]-0.02*Y[2]/cos(Y[3])" Y2 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
+    (bcStrings (42 "-0.032/(Y[2]**2)" Y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for X: ")
+    (text . "\tab{24} \menuitemstyle{}\tab{26} ")
+    (text . "Final Value for X:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" xinit EM))
+    (text . "\tab{26} ")
+    (bcStrings (10 "10.0" xend EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for Y[i]: ")
+    (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
+    (bcStrings (10 "0.5" y1 EM))
+    (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
+    (bcStrings (10 "0.5" y2 EM))
+    (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
+    (bcStrings (10 "%pi*0.2" y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Enter the function G(x,y) (The Stopping Criteria): ")
+    (bcStrings (10 "Y[1]" g EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Relative accuracy required:\space{1}")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'annaOdeGen)
+  htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
+  htpSetProperty(page,'intermediateValues,intermediateValues)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOdeDefaultSolve1() ==
+
+  n := '3
+  stoppingCriteria := '"stopping"
+  intermediateValues := '"intervals"
+  page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger))
+        (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
+    (text . "in terms of Y[1]..Y[n]:  ")
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
+    (bcStrings (42 "-0.04*Y[1]+1.0e4*Y[2]*Y[3]" Y1 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
+    (bcStrings (42 "0.04*Y[1]-1.0e4*Y[2]*Y[3]-3.0e7*Y[2]*Y[2]" Y2 EM))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
+    (bcStrings (42 "3.0e7*Y[2]*Y[2]" Y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for X: ")
+    (text . "\tab{24} \menuitemstyle{}\tab{26} ")
+    (text . "Final Value for X:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" xinit EM))
+    (text . "\tab{26} ")
+    (bcStrings (10 "10.0" xend EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Initial Value for Y[i]: ")
+    (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
+    (bcStrings (10 "1.0" y1 EM))
+    (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
+    (bcStrings (10 "0.0" y2 EM))
+    (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
+    (bcStrings (10 "0.0" y3 EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Enter the function G(x,y) (The Stopping Criteria): ")
+    (bcStrings (10 "Y[1]-0.9" g EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Enter the list of Intermediate Values required: ")
+    (bcStrings (10 "[2,4,6,8]" intvals EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Relative accuracy required:\space{1}")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'annaOdeGen)
+  htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
+  htpSetProperty(page,'intermediateValues,intermediateValues)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOdeGen htPage ==
+
+  n := htpProperty(htPage,'n)
+  stoppingCriteria := htpProperty(htPage,'stoppingCriteria)
+  intermediateValues := htpProperty(htPage,'intermediateValues)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  epsrel := STRCONC((first y).1,'"")
+  epsrelString := STRCONC(", ",epsrel)
+  y := rest y
+  if intermediateValues = '"no" then 
+    intvalsString := '""
+  else 
+    intvals := STRCONC((first y).1,'"")
+    intvalsString := STRCONC(", ",intvals)
+    y := rest y
+  if stoppingCriteria = '"no" then
+    gString := '""
+  else 
+    g := STRCONC((first y).1,'"")
+    gString := STRCONC(", ",g)
+    y := rest y
+  for i in 1..n repeat
+    yi := STRCONC((first y).1,'"")
+    yiList := [yi,:yiList]
+    y := rest y
+  yiString := bcwords2liststring yiList
+  xend := STRCONC((first y).1,'"")
+  y := rest y
+  xinit := STRCONC((first y).1,'"")
+  y := rest y
+  for i in 1..n repeat
+    fi := STRCONC((first y).1,'"")
+    fiList := [fi,:fiList]
+    y := rest y
+  fiString := bcwords2liststring fiList
+  prefix := STRCONC('"solve(",fiString,", ", xinit,", ", xend,", ")
+  prefix := STRCONC(prefix,yiString,gString,intvalsString,epsrelString)
+  prefix := STRCONC(prefix,")")
+  annaGen prefix
+
+--d03fafVariables() ==
+--  htInitPage('"Helmholtz Equation in 3-D, Cartesian Coordinates",nil)
+--  htMakePage '(
+--    (domainConditions
+--      (isDomain F (Float))
+--        (isDomain S (String)))
+--    (text . "Descretizing the PDE:")
+--    (text . "\newline\centerline{\inputbitmap{\htbmdir{}/d03faf.xbm}}")
+--    (text . "\newline and solving the resulting seven-diagonal finite ") 
+--    (text . "difference equations using a method based on the Fast ")
+--    (text . "Fourier Transform.\blankline Entering the names of pre-prepared ")
+--    (text . "variables for xCond, yCond, zCond and f(x,y,z)")
+--    (text . "\blankline Please enter the names of the condition variables")
+--    (text . "\blankline \menuitemstyle{}\tab{2} xCond:\space{1} ")
+--    (bcStrings (10 "xCond" x S))
+--    (text . "\newline \menuitemstyle{}\tab{2} yCond:\space{1} ")
+--    (bcStrings (10 "yCond" y S))
+--    (text . "\newline \menuitemstyle{}\tab{2} zCond:\space{1} ")
+--    (bcStrings (10 "zCond" z S))
+--    (text . "\blankline \menuitemstyle{}\tab{2} Please enter the value of lambda:\space{1} ")
+--    (bcStrings (8 "-1.0" lambda F))
+--    (text . "\blankline \menuitemstyle{}\tab{2} Please enter the name of the variable for f(x,y,z):")
+--    (text . "\space{1} ")
+--    (bcStrings (10 "foo" f S))
+--    (text . "\blankline "))
+--  htMakeDoneButton('"Continue",'annaOptSolve)
+--  htShowPage()
+
+annaPDESolve() ==
+  htInitPage('"Second Order Elliptic Partial Differential Equation",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+        (isDomain S (String))
+          (isDomain EM $EmptyMode))
+    (text . "Descretizing the PDE:")
+    (text . "\newline\centerline{\inputbitmap{\htbmdir{}/d03eef.xbm}}")
+    (text . "\newline defined on a rectangular region with boundary conditions of the form ")
+    (text . "\centerline{\inputbitmap{\htbmdir{}/d03eef1.bitmap}} ")
+    (text . " and solving the resulting seven-diagonal finite ") 
+    (text . "difference equations using a multigrid technique. \blankline ")
+    (text . "\menuitemstyle{} \tab{2} Enter the rectangle on which to discretize the PDE : \newline ")
+    (text . "\tab{11} Start \tab{20} Number of grid lines \tab{41} End ")
+    (text . " \newline \tab{6} X : \space{1} " ) 
+    (bcStrings(7 "0.0" xmin F))
+    (text . "\space{7} ")
+    (bcStrings(3 "9" ngx I))
+    (text . "\space{7} ")
+    (bcStrings(7 "1.0" xmax F))
+    (text . "\newline \tab{6} Y : \space{1} " )
+    (bcStrings(7 "0.0" ymin F))
+    (text . "\space{7} ")
+    (bcStrings(3 "9" ngy I))
+    (text . "\space{7} ")
+    (bcStrings(7 "1.0" ymax F))
+    (text . "\blankline \menuitemstyle{} Enter the values of the expressions\space{1}")
+    (text . " \inputbitmap{\htbmdir{}/alpha.xbm}(X,Y) to\space{1}")
+    (text . " \inputbitmap{\htbmdir{}/psi.xbm}(X,Y) : ")
+    (text . "\blankline \tab{3} \inputbitmap{\htbmdir{}/alpha.xbm}(X,Y) : ")
+    (bcStrings (36 "1" alpha EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/beta.xbm}(X,Y) : ")
+    (bcStrings (36 "0" beta EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/gamma.xbm}(X,Y) : ")
+    (bcStrings (36 "1" gamma EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/delta.xbm}(X,Y) : ")
+    (bcStrings (36 "50" delta EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/epsilon.xbm}(X,Y) : ")
+    (bcStrings (36 "50" epsilon EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/phi.xbm}(X,Y) : ")
+    (bcStrings (36 "0" phi EM))
+    (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/psi.xbm}(X,Y) : ")
+    (bcStrings (36 "-2*sin(X)*sin(Y) + 50*cos(X)*sin(Y) + 50*sin(X)*cos(Y)" psi EM))
+    (text . "\blankline \menuitemstyle{} Enter the values of the boundary ")
+    (text . " condition expressions for the bottom, top, left and right sides : ")
+    (text . " \blankline \tab{2} \menuitemstyle{} Bottom boundary conditions :")
+    (text . " (Y := \inputbitmap{\htbmdir{}/ys.xbm})")
+    (text . "\newline \tab{4} a(X,Y) : ")
+    (bcStrings (34 "0" ba EM))
+    (text . "\newline \tab{4} b(X,Y) : ")
+    (bcStrings (34 "1" bb EM))
+    (text . "\newline \tab{4} c(X,Y) : ")
+    (bcStrings (34 "-sin(X)" bc EM))
+    (text . " \blankline \tab{2} \menuitemstyle{} Top boundary conditions :")
+    (text . " (Y := \inputbitmap{\htbmdir{}/ye.xbm})")
+    (text . "\newline \tab{4} a(X,Y) : ")
+    (bcStrings (34 "1" ta EM))
+    (text . "\newline \tab{4} b(X,Y) : ")
+    (bcStrings (34 "0" tb EM))
+    (text . "\newline \tab{4} c(X,Y) : ")
+    (bcStrings (34 "sin(X)*sin(Y)" tc EM))
+    (text . " \blankline \tab{2} \menuitemstyle{} Left boundary conditions :")
+    (text . " (X := \inputbitmap{\htbmdir{}/xs.xbm})")
+    (text . "\newline \tab{4} a(X,Y) : ")
+    (bcStrings (34 "0" la EM))
+    (text . "\newline \tab{4} b(X,Y) : ")
+    (bcStrings (34 "1" lb EM))
+    (text . "\newline \tab{4} c(X,Y) : ")
+    (bcStrings (34 "-sin(Y)" lc EM))
+    (text . " \blankline \tab{2} \menuitemstyle{} Right boundary conditions :")
+    (text . " (Y := \inputbitmap{\htbmdir{}/xe.xbm})")
+    (text . "\newline \tab{4} a(X,Y) : ")
+    (bcStrings (34 "1" ra EM))
+    (text . "\newline \tab{4} b(X,Y) : ")
+    (bcStrings (34 "0" rb EM))
+    (text . "\newline \tab{4} c(X,Y) : ")
+    (bcStrings (34 "sin(X)*sin(Y)" rc EM))
+    (text . "\blankline \menuitemstyle{} Do you know that the PDE described is elliptic? \space{2}")
+    (text . "\newline \tab{6} ")
+    (bcRadioButtons ell
+        ("" " Yes \space{2} " yes)
+        ("" " Unknown" no))
+    (text . "\blankline \menuitemstyle{} Required Tolerance : ")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . " \newline "))
+  htMakeDoneButton('"Continue",'annaPDESolve2)
+  htShowPage()
+
+annaPDESolve2 htPage ==
+  e := htpButtonValue(htPage,'ell)
+  ell := 
+    e = 'yes => '"elliptic"
+    '"unknown"
+  xmin := htpLabelInputString(htPage,'xmin)
+  ngx := htpLabelInputString(htPage,'ngx)
+  xmax := htpLabelInputString(htPage,'xmax)
+  ymin := htpLabelInputString(htPage,'ymin)
+  ngy := htpLabelInputString(htPage,'ngy)
+  ymax := htpLabelInputString(htPage,'ymax)
+  alpha := htpLabelInputString(htPage,'alpha)
+  beta := htpLabelInputString(htPage,'beta)
+  gamma := htpLabelInputString(htPage,'gamma)
+  delta := htpLabelInputString(htPage,'delta)
+  epsilon := htpLabelInputString(htPage,'epsilon)
+  phi := htpLabelInputString(htPage,'phi)
+  psi := htpLabelInputString(htPage,'psi)
+  ba := htpLabelInputString(htPage,'ba)
+  bb := htpLabelInputString(htPage,'bb)
+  bc := htpLabelInputString(htPage,'bc)
+  ta := htpLabelInputString(htPage,'ta)
+  tb := htpLabelInputString(htPage,'tb)
+  tc := htpLabelInputString(htPage,'tc)
+  la := htpLabelInputString(htPage,'la)
+  lb := htpLabelInputString(htPage,'lb)
+  lc := htpLabelInputString(htPage,'lc)
+  ra := htpLabelInputString(htPage,'ra)
+  rb := htpLabelInputString(htPage,'rb)
+  rc := htpLabelInputString(htPage,'rc)
+  tol := htpLabelInputString(htPage,'tol)
+  bCond := STRCONC('"[[ ", ba, '", ", bb, '", ", bc, '"],")
+  bCond := STRCONC(bCond, '"[ ", ra, '", ", rb, '", ", rc, '"],")
+  bCond := STRCONC(bCond, '"[ ", ta, '", ", tb, '", ", tc, '"],")
+  bCond := STRCONC(bCond, '"[ ", la, '", ", lb, '", ", lc, '"]]")
+  pde := STRCONC('"[", alpha, '", ", beta, '", ", gamma, '", ", delta)
+  pde := STRCONC( pde, '", ", epsilon, '", ", phi, '", ", psi, '"]")
+  outputString := STRCONC('"solve(", xmin, '", ", xmax, '", ", ymin, '", ", ymax, '", ")
+  outputString := STRCONC(outputString , ngx, '", ", ngy, '", ", pde, '", ")
+  outputString := STRCONC(outputString , bCond, '", _"", ell ,'"_", ", tol, " )")
+  annaGen outputString
+
+annaOpt() ==
+  htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain NNI (NonNegativeInteger))
+        (isDomain S (String))
+         (isDomain PI (PositiveInteger))
+          (isDomain I (Integer))
+           (isDomain EM $EmptyMode))
+    (text . "Analyses the function for various attributes, chooses and ")
+    (text . "then uses a suitable optimization routine for finding the ")
+    (text . "minimum of a nonlinear function {\it F(x)} of {\it n} variables.")
+    (text . "\newline {\bf Minimize F(x)} where \center{\htbitmap{e04fdf1}} possibly subject to linear or non-linear ")
+    (text . "constraints on the variables. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables \htbitmap{xj}, {\it n}:")
+    (text . "\space{1} ")
+    (bcStrings (2 4 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} Are there any constraints ")
+    (text . "on the function?")
+    (radioButtons constraints
+        (" " "  No" nocons)
+        (" " "  Yes" cFunctions))
+    (text . "\blankline \menuitemstyle{}")
+    (text . "Number of linear and/or non-linear constraint functions:\space{1}")
+    (bcStrings (2 "0" cons NNI))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'annaOptSolve)
+  htShowPage()
+
+annaOptSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  c := htpButtonValue(htPage,'constraints)
+  constraints := 
+    c = 'nocons => '"none"
+    '"cf"
+  cons :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'cons)
+    objValUnwrap htpLabelSpadValue(htPage, 'cons)
+  constraints = '"none" => annaOptSolve1(n)
+  ((n = '4) and (cons = '0)) => annaOptDefaultSolve2()
+  ((n = '4) and (cons = '3)) => annaOptDefaultSolve3()
+  ((n = '7) and (cons = '7)) => annaOptDefaultSolve4()
+  cText := ('"\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
+  cText := STRCONC(cText,'"boundary conditions {\it bl(n)} and {\it bu(n)}: ")
+  cText := STRCONC(cText,'"\newline \tab{5} Lower \tab{25} Constraint ")
+  cText := STRCONC(cText,'"\tab{45} Upper ")
+  cList := 
+    "append"/[fc(i) for i in 1..n] where fc(i) ==
+      prefix := ('"\newline \tab{2}")
+      xn := INTERN STRCONC ("\tab{27}",'"X",STRINGIMAGE i,"\tab{42}")
+      blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, '"-1.0", blnam, 'F]],['text,:xn],
+       ['bcStrings,[8, '"1.0", bunam, 'F]]]
+  consList := 
+    "append"/[fe(i) for i in n+1..n+cons] where fe(i) ==
+      lineEnd := ('"\newline\tab{2}")
+      space := ('"\space{1}")
+      space2 := ('"\tab{42}")
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['text,:lineEnd],['bcStrings,[8, '"-1.0", blnam, 'F]],['text,:space],
+       ['bcStrings,[26, '"X[1]", cnam, 'EM]],['text,:space2],
+        ['bcStrings,[8, '"1.0", bunam, 'F]]]
+  cList := [['text,:cText],:cList,:consList]
+  funcList := [['bcStrings,[48, '"X[1]", 'f, 'EM]]]
+  xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+  xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:xmiddle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))),
+              :funcList,:cList,:xList]
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptSolve1(n) ==
+
+  n = '2 => annaOptDefaultSolve1()
+  constraints := '"none"
+  cons := '0
+  funcList := [['bcStrings,[48, "X[1]", 'f, 'EM]]]
+  xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+  xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:xmiddle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+           (isDomain F (Float))),
+                  :funcList,:xList]
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptDefaultSolve5() ==
+  n := '7
+  constraints := '"cf"
+  cons := '7
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (51 "(X[1]-0.02)*X[1]+(X[2]-0.2)*X[2]+(X[3]-0.2)*X[3]+(X[4]+2*X[3]-0.2)*X[4]+(X[5]-0.2)*X[5]+(0.04-X[6])*X[6]+(0.04-2*X[6]-X[7])*X[7]" f EM))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
+    (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
+    (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl1 F))
+    (text . "\tab{27} X1 \tab{42}")
+    (bcStrings (8 "0.01" bu1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.1" bl2 F))
+    (text . "\tab{27} X2 \tab{42}")
+    (bcStrings (8 "0.15" bu2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl3 F))
+    (text . "\tab{27} X3 \tab{42}")
+    (bcStrings (8 "0.03" bu3 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.04" bl4 F))
+    (text . "\tab{27} X4 \tab{42}")
+    (bcStrings (8 "0.04" bu4 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.1" bl5 F))
+    (text . "\tab{27} X5 \tab{42}")
+    (bcStrings (8 "0.05" bu5 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl6 F))
+    (text . "\tab{27} X6 \tab{42}")
+    (bcStrings (8 "1.0E21" bu6 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl7 F))
+    (text . "\tab{27} X7 \tab{42}")
+    (bcStrings (8 "1.0E21" bu7 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.13" bl8 F))
+    (text . "\space{1}")
+    (bcStrings (26 "X[1]+X[2]+X[3]+X[4]+X[5]+X[6]+X[7]" c8 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.13" bu8 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl9 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.15*X[1]+0.04*X[2]+0.02*X[3]+0.04*X[4]+0.02*X[5]+0.01*X[6]+0.03*X[7]" c9 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0049" bu9 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl10 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.03*X[1]+0.05*X[2]+0.08*X[3]+0.02*X[4]+0.06*X[5]+0.01*X[6]" c10 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0064" bu10 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl11 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.04*X[2]+0.01*X[3]+0.02*X[4]+0.02*X[5]" c11 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0037" bu11 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl12 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.03*X[2]+0.01*X[5]" c12 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0012" bu12 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.0992" bl13 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.7*X[1]+0.75*X[2]+0.8*X[3]+0.75*X[4]+0.8*X[5]+0.97*X[6]" c13 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "1.0E21" bu13 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.003" bl14 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.06*X[2]+0.08*X[3]+0.12*X[4]+0.02*X[5]+0.01*X[6]+0.97*X[7]" c14 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "0.002" bu14 F))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+    (text . " solution vector {\it x(n)}: \newline \tab{2} ")
+    (bcStrings (8 "-0.01" x1 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.03" x2 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.0" x3 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.01" x4 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.1" x5 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.02" x6 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.01" x7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptDefaultSolve4() ==
+  n := '7
+  constraints := '"cf"
+  cons := '7
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (51 "-0.2*(0.1*X[1]+X[2]+X[3]+X[4]+X[5]-0.2*(X[6]+X[7]))" f EM))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
+    (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
+    (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl1 F))
+    (text . "\tab{27} X1 \tab{42}")
+    (bcStrings (8 "0.01" bu1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.1" bl2 F))
+    (text . "\tab{27} X2 \tab{42}")
+    (bcStrings (8 "0.15" bu2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl3 F))
+    (text . "\tab{27} X3 \tab{42}")
+    (bcStrings (8 "0.03" bu3 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.04" bl4 F))
+    (text . "\tab{27} X4 \tab{42}")
+    (bcStrings (8 "0.04" bu4 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.1" bl5 F))
+    (text . "\tab{27} X5 \tab{42}")
+    (bcStrings (8 "0.05" bu5 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl6 F))
+    (text . "\tab{27} X6 \tab{42}")
+    (bcStrings (8 "1.0E21" bu6 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.01" bl7 F))
+    (text . "\tab{27} X7 \tab{42}")
+    (bcStrings (8 "1.0E21" bu7 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.13" bl8 F))
+    (text . "\space{1}")
+    (bcStrings (26 "X[1]+X[2]+X[3]+X[4]+X[5]+X[6]+X[7]" c8 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.13" bu8 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl9 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.15*X[1]+0.04*X[2]+0.02*X[3]+0.04*X[4]+0.02*X[5]+0.01*X[6]+0.03*X[7]" c9 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0049" bu9 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl10 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.03*X[1]+0.05*X[2]+0.08*X[3]+0.02*X[4]+0.06*X[5]+0.01*X[6]" c10 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0064" bu10 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl11 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.04*X[2]+0.01*X[3]+0.02*X[4]+0.02*X[5]" c11 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0037" bu11 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E21" bl12 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.03*X[2]+0.01*X[5]" c12 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "-0.0012" bu12 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.0992" bl13 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.7*X[1]+0.75*X[2]+0.8*X[3]+0.75*X[4]+0.8*X[5]+0.97*X[6]" c13 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "1.0E21" bu13 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.003" bl14 F))
+    (text . "\space{1}")
+    (bcStrings (26 "0.02*X[1]+0.06*X[2]+0.08*X[3]+0.12*X[4]+0.02*X[5]+0.01*X[6]+0.97*X[7]" c14 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "0.002" bu14 F))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+    (text . " solution vector {\it x(n)}: \newline \tab{2} ")
+    (bcStrings (8 "-0.01" x1 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.03" x2 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.0" x3 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.01" x4 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-0.1" x5 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.02" x6 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0.01" x7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptDefaultSolve3() ==
+  n := '4
+  constraints := '"cf"
+  cons := '3
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (48 "X[1]*X[4]*(X[1]+X[2]+X[3])+X[3]" f EM))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
+    (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
+    (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" bl1 F))
+    (text . "\tab{27} X1 \tab{42}")
+    (bcStrings (8 "5.0" bu1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" bl2 F))
+    (text . "\tab{27} X2 \tab{42}")
+    (bcStrings (8 "5.0" bu2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" bl3 F))
+    (text . "\tab{27} X3 \tab{42}")
+    (bcStrings (8 "5.0" bu3 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" bl4 F))
+    (text . "\tab{27} X4 \tab{42}")
+    (bcStrings (8 "5.0" bu4 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.E25" bl5 F))
+    (text . "\space{1}")
+    (bcStrings (26 "X[1]+X[2]+X[3]+X[4]" c5 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "20.0" bu5 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.E25" bl6 F))
+    (text . "\space{1}")
+    (bcStrings (26 "X[1]**2+X[2]**2+X[3]**2+X[4]**2" c6 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "40.0" bu6 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "25.0" bl7 F))
+    (text . "\space{1}")
+    (bcStrings (26 "X[1]*X[2]*X[3]*X[4]" c7 EM))
+    (text . "\tab{42}")
+    (bcStrings (8 "1.E25" bu7 F))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+    (text . " solution vector {\it x(n)}: \newline \tab{2} ")
+    (bcStrings (8 "1.0" x1 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "5.0" x2 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "5.0" x3 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "1.0" x4 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptDefaultSolve2() ==
+  n := '4
+  constraints := '"cf"
+  cons := '0
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (70 "(X[1]+10*X[2])**2+5*(X[3]-X[4])**2+(X[2]-2*X[3])**4+10*(X[1]-X[4])**4" f EM))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
+    (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
+    (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1" bl1 F))
+    (text . "\tab{27} X1 \tab{42}")
+    (bcStrings (8 "3" bu1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-2" bl2 F))
+    (text . "\tab{27} X2 \tab{42}")
+    (bcStrings (8 "0" bu2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0E-6" bl3 F))
+    (text . "\tab{27} X3 \tab{42}")
+    (bcStrings (8 "1.0E6" bu3 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1" bl4 F))
+    (text . "\tab{27} X4 \tab{42}")
+    (bcStrings (8 "3" bu4 F))
+    (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+    (text . " solution vector {\it x(n)}: \newline \tab{2} ")
+    (bcStrings (8 "3" x1 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "-1" x2 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "0" x3 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "1" x4 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptDefaultSolve1() ==
+
+  n := '2
+  constraints := '"none"
+  cons := '0
+  page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float))
+       (isDomain EM $EmptyMode))
+    (text . "\menuitemstyle{} \tab{2} Enter the objective function,")
+    (text . " {\it F(x)} in terms of X[1]...X[n]: \newline \tab{2} ")
+    (bcStrings (52 "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" f EM))
+    (text . "\blankline \menuitemstyle{} \tab{2} Enter initial guess of the ")
+    (text . "solution vector {\it x(n)}: \newline\tab{2}") 
+    (bcStrings (8 "-1.0" x1 F))
+    (text . "\newline\tab{2}")
+    (bcStrings (8 "1.0" x2 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'annaOptGen)
+  htpSetProperty(page,'constraints,constraints)
+  htpSetProperty(page,'cons,cons)
+  htpSetProperty(page,'n,n)
+  htShowPage()
+
+annaOptGen htPage ==
+  n := htpProperty(htPage,'n)
+  cons := htpProperty(htPage,'cons)
+  constraints := htpProperty(htPage,'constraints)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    init := STRCONC((first y).1,'"")
+    initList := [init,:initList]
+    y := rest y
+  initString := bcwords2liststring initList
+  if constraints = '"cf" then
+    for i in 1..cons repeat 
+      upper := STRCONC((first y).1,'"") 
+      uList := [upper,:uList]
+      y := rest y
+      con := STRCONC((first y).1," ")
+      cList := [con,:cList]
+      y := rest y
+      lower := STRCONC((first y).1,'"")
+      lList := [lower,:lList]
+      y := rest y
+    for i in 1..n repeat
+      upper := STRCONC((first y).1,'"")
+      uList := [upper,:uList]
+      y := rest y
+      lower := STRCONC((first y).1,'"")
+      lList := [lower,:lList]
+      y := rest y
+  uString := bcwords2liststring uList
+  cString := bcwords2liststring cList
+  lString := bcwords2liststring lList
+  f := STRCONC((first y).1,'"")
+  prefix := STRCONC('"optimize(",f,", ")
+  if constraints = '"none" then
+    midfix := initString
+  else
+    if cons = '0 then
+      midfix := STRCONC(initString,", ",lString,", ",uString)
+    else
+      midfix := STRCONC(initString,", ",lString,", ",cString,", ",uString)
+  suffix := STRCONC(prefix, midfix,")")
+  annaGen suffix
+
+annaOpt2() ==
+  htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions
+     (isDomain PI (PositiveInteger)))
+    (text . "Analyses the functions for various attributes, chooses and ")
+    (text . "then uses a suitable optimization routine for finding the ")
+    (text . "minimum of a sum of squares of {\it m} nonlinear functions in ")
+    (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ")
+    (text . "is applicable to problems of the form ")
+    (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}")
+    (text . "The routines are intended for ")
+    (text . "functions which have continous first and second derivatives, ")
+    (text . "though they will usually work if the derivatives have occasional ")
+    (text . "discontinuities. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 15 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables \htbitmap{xj}, {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} Do you wish for a check for ")
+    (text . "goodness of fit of the least squares model?")
+    (radioButtons goodness
+        (" " "  No" nogood)
+        (" " "  Yes" good))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue", 'annaOpt2Solve)
+  htShowPage()
+
+annaOpt2Solve htPage ==
+  g := htpButtonValue(htPage,'goodness)
+  goodness := 
+    g = 'nogood => '"nogood"
+    '"good"
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  m = '15 and n = '3 and goodness = '"nogood" => annaOpt2DefaultSolve()
+  m = '15 and n = '3  => annaOpt2DefaultSolve2()
+  fList := 
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      lineEnd := ('"\newline\tab{2}")
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      [['text,:lineEnd], ['bcStrings,[42, '"X[1]", fnam, 'EM]]]
+  xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
+  xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:xmiddle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))),
+              :fList,:xList]
+  page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the objective functions, {\it F(x)} in terms of X[1]...X[n]: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'annaOpt2Gen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'goodness,goodness)
+  htShowPage()
+
+annaOpt2DefaultSolve() ==
+  goodness := '"nogood"
+  n := '3
+  m := '15
+  page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below ")
+    (text . "in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "(X[3]+15*X[2])**(-1)+X[1]-0.14" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "2*(2*X[3]+14*X[2])**(-1)+X[1]-0.18" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "3*(3*X[3]+13*X[2])**(-1)+X[1]-0.22" f3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "4*(4*X[3]+12*X[2])**(-1)+X[1]-0.25" f4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "5*(5*X[3]+11*X[2])**(-1)+X[1]-0.29" f5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "6*(6*X[3]+10*X[2])**(-1)+X[1]-0.32" f6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "7*(7*X[3]+9*X[2])**(-1)+X[1]-0.35" f7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "8*(8*X[3]+8*X[2])**(-1)+X[1]-0.39" f8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "9*(7*X[3]+7*X[2])**(-1)+X[1]-0.37" f9 EM))
+    (text . "\newline {\em Function 10:} \space{1}")
+    (bcStrings (42 "10*(6*X[3]+6*X[2])**(-1)+X[1]-0.58" f10 EM))
+    (text . "\newline {\em Function 11:} \space{1}")
+    (bcStrings (42 "11*(5*X[3]+5*X[2])**(-1)+X[1]-0.73" f11 EM))
+    (text . "\newline {\em Function 12:} \space{1}")
+    (bcStrings (42 "12*(4*X[3]+4*X[2])**(-1)+X[1]-0.96" f12 EM))
+    (text . "\newline {\em Function 13:} \space{1}")
+    (bcStrings (42 "13*(3*X[3]+3*X[2])**(-1)+X[1]-1.34" f13 EM))
+    (text . "\newline {\em Function 14:} \space{1}")
+    (bcStrings (42 "14*(2*X[3]+2*X[2])**(-1)+X[1]-2.1" f14 EM))
+    (text . "\newline {\em Function 15:} \space{1}")
+    (bcStrings (42 "15*(X[3]+X[2])**(-1)+X[1]-4.39" f15 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x(n)}: \newline \tab{2}")
+    (bcStrings (8 "0.5" x1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" x2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.5" x3 F)))
+  htMakeDoneButton('"Continue",'annaOpt2Gen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'goodness,goodness)
+  htShowPage()
+
+annaOpt2DefaultSolve2() ==
+  goodness := '"good"
+  n := '3
+  m := '15
+  page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below ")
+    (text . "in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "(X[3]+15*X[2])**(-1)+X[1]-0.14" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "2*(2*X[3]+14*X[2])**(-1)+X[1]-0.18" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "3*(3*X[3]+13*X[2])**(-1)+X[1]-0.22" f3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "4*(4*X[3]+12*X[2])**(-1)+X[1]-0.25" f4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "5*(5*X[3]+11*X[2])**(-1)+X[1]-0.29" f5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "6*(6*X[3]+10*X[2])**(-1)+X[1]-0.32" f6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "7*(7*X[3]+9*X[2])**(-1)+X[1]-0.35" f7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "8*(8*X[3]+8*X[2])**(-1)+X[1]-0.39" f8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "9*(7*X[3]+7*X[2])**(-1)+X[1]-0.37" f9 EM))
+    (text . "\newline {\em Function 10:} \space{1}")
+    (bcStrings (42 "10*(6*X[3]+6*X[2])**(-1)+X[1]-0.58" f10 EM))
+    (text . "\newline {\em Function 11:} \space{1}")
+    (bcStrings (42 "11*(5*X[3]+5*X[2])**(-1)+X[1]-0.73" f11 EM))
+    (text . "\newline {\em Function 12:} \space{1}")
+    (bcStrings (42 "12*(4*X[3]+4*X[2])**(-1)+X[1]-0.96" f12 EM))
+    (text . "\newline {\em Function 13:} \space{1}")
+    (bcStrings (42 "13*(3*X[3]+3*X[2])**(-1)+X[1]-1.34" f13 EM))
+    (text . "\newline {\em Function 14:} \space{1}")
+    (bcStrings (42 "14*(2*X[3]+2*X[2])**(-1)+X[1]-2.1" f14 EM))
+    (text . "\newline {\em Function 15:} \space{1}")
+    (bcStrings (42 "15*(X[3]+X[2])**(-1)+X[1]-4.39" f15 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x(n)}: \newline \tab{2}")
+    (bcStrings (8 "0.5" x1 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" x2 F))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.5" x3 F)))
+  htMakeDoneButton('"Continue",'annaOpt2Gen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'goodness,goodness)
+  htShowPage()
+
+annaOpt2Gen htPage ==
+
+  goodness := htpProperty(htPage,'goodness)
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    init := STRCONC((first y).1,'"")
+    initList := [init,:initList]
+    y := rest y
+  initString := bcwords2liststring initList
+  for i in 1..m repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fString := bcwords2liststring fList
+  prefix :=
+    goodness = '"good" => '"goodnessOfFit( "
+    '"optimize( "
+  midfix := STRCONC(fString,", ",initString)
+  suffix := STRCONC(prefix, midfix,")")
+  annaGen suffix
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/apply.boot.pamphlet b/src/interp/apply.boot.pamphlet
new file mode 100644
index 00000000..a859aa3d
--- /dev/null
+++ b/src/interp/apply.boot.pamphlet
@@ -0,0 +1,276 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/apply.boot} Papmhlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+oldCompilerAutoloadOnceTrigger() == nil
+
+compAtomWithModemap(x,m,e,v) ==
+  Tl :=
+    [[transImplementation(x,map,fn),target,e]
+      for map in v | map is [[.,target],[.,fn]]] =>
+                                         --accept only monadic operators
+        T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T
+        1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl
+        0<#Tl and m=$NoValueMode => first Tl
+        nil
+
+transImplementation(op,map,fn) ==
+--+
+  fn := genDeltaEntry [op,:map]
+  fn is ["XLAM",:.] => [fn]
+  ["call",fn]
+
+compApply(sig,varl,body,argl,m,e) ==
+  argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl]
+  contour:=
+    [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]])
+      for x in varl for m' in sig.source for a in argl]
+  code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]]
+  m':= resolve(m,sig.target)
+  body':= (comp(body,m',addContour(contour,e))).expr
+  [code,m',e]
+
+compToApply(op,argl,m,e) ==
+  T:= compNoStacking(op,$EmptyMode,e) or return nil
+  m1:= T.mode
+  T.expr is ["QUOTE", =m1] => nil
+  compApplication(op,argl,m,T.env,T)
+
+compApplication(op,argl,m,e,T) ==
+  T.mode is ['Mapping, retm, :argml] =>
+    #argl ^= #argml => nil
+    retm := resolve(m, retm)
+    retm = $Category or isCategoryForm(retm,e) => nil  -- not handled
+    argTl := [[.,.,e] := comp(x,m,e) or return "failed"
+              for x in argl for m in argml]
+    argTl = "failed" => nil
+    form:=
+      not (member(op,$formalArgList) or member(T.expr,$formalArgList)) and ATOM T.expr =>
+        nprefix := $prefix or
+        -- following needed for referencing local funs at capsule level
+           getAbbreviation($op,#rest $form)
+        [op',:[a.expr for a in argTl],"$"] where
+          op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr)
+      ['call, ['applyFun, T.expr], :[a.expr for a in argTl]]
+    coerce([form, retm, e],resolve(retm,m))
+  op = 'elt => nil
+  eltForm := ['elt, op, :argl]
+  comp(eltForm, m, e)
+
+compFormWithModemap(form is [op,:argl],m,e,modemap) ==
+  [map:= [.,target,:.],[pred,impl]]:= modemap
+  -- this fails if the subsuming modemap is conditional
+  --impl is ['Subsumed,:.] => nil
+  if isCategoryForm(target,e) and isFunctor op then
+    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
+    [map:= [.,target,:.],:cexpr]:= modemap
+  sv:=listOfSharpVars map
+  if sv then
+     -- SAY [ "compiling ", op, " in compFormWithModemap,
+     -- mode= ",map," sharp vars=",sv]
+    for x in argl for ss in $FormalMapVariableList repeat
+      if ss in sv then
+        [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap)
+        -- SAY ["new map is",map]
+  not (target':= coerceable(target,m,e)) => nil
+  map:= [target',:rest map]
+  [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil
+
+  --generate code; return
+  T:=
+    [x',m',e'] where
+      m':= SUBLIS(sl,map.(1))
+      x':=
+        form':= [f,:[t.expr for t in Tl]]
+        m'=$Category or isCategoryForm(m',e) => form'
+        -- try to deal with new-style Unions where we know the conditions
+        op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and
+          (c:=get(z,'condition,e)) and
+            c is [['case,=z,c1]] and
+              (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
+-- first is a full tag, as placed by getInverseEnvironment
+-- second is what getSuccessEnvironment will place there
+                ["CDR",z]
+        ["call",:form']
+      e':=
+        Tl => (LAST Tl).env
+        e
+  convert(T,m)
+
+-- This version tends to give problems with #1 and categories
+-- applyMapping([op,:argl],m,e,ml) ==
+--   #argl^=#ml-1 => nil
+--   mappingHasCategoryTarget :=
+--     isCategoryForm(first ml,e) => --is op a functor?
+--       form:= [op,:argl']
+--       pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
+--       ml:= SUBLIS(pairlis,ml)
+--       true
+--     false
+--   argl':=
+--     [T.expr for x in argl for m' in rest ml] where
+--       T() == [.,.,e]:= comp(x,m',e) or return "failed"
+--   if argl'="failed" then return nil
+--   mappingHasCategoryTarget => convert([form,first ml,e],m)
+--   form:=
+--     not member(op,$formalArgList) and ATOM op =>
+--       [op',:argl',"$"] where
+--         op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op)
+--     ["call",["applyFun",op],:argl']
+--   pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
+--   convert([form,SUBLIS(pairlis,first ml),e],m)
+
+applyMapping([op,:argl],m,e,ml) ==
+  #argl^=#ml-1 => nil
+  isCategoryForm(first ml,e) =>
+                                --is op a functor?
+    pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
+    ml' := SUBLIS(pairlis, ml)
+    argl':=
+      [T.expr for x in argl for m' in rest ml'] where
+        T() == [.,.,e]:= comp(x,m',e) or return "failed"
+    if argl'="failed" then return nil
+    form:= [op,:argl']
+    convert([form,first ml',e],m)
+  argl':=
+    [T.expr for x in argl for m' in rest ml] where
+      T() == [.,.,e]:= comp(x,m',e) or return "failed"
+  if argl'="failed" then return nil
+  form:=
+    not member(op,$formalArgList) and ATOM op and not get(op,'value,e) =>
+      nprefix := $prefix or
+   -- following needed for referencing local funs at capsule level
+        getAbbreviation($op,#rest $form)
+      [op',:argl',"$"] where
+        op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
+    ['call,['applyFun,op],:argl']
+  pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
+  convert([form,SUBLIS(pairlis,first ml),e],m)
+
+--% APPLY MODEMAPS
+
+compApplyModemap(form,modemap,$e,sl) ==
+  [op,:argl] := form                   --form to be compiled
+  [[mc,mr,:margl],:fnsel] := modemap   --modemap we are testing
+
+  -- $e     is the current environment
+  -- sl     substitution list, nil means bottom-up, otherwise top-down
+
+  -- 0.  fail immediately if #argl=#margl
+
+  if #argl^=#margl then return nil
+
+  -- 1.  use modemap to evaluate arguments, returning failed if
+  --     not possible
+
+  lt:=
+    [[.,m',$e]:=
+      comp(y,g,$e) or return "failed" where
+        g:= SUBLIS(sl,m) where
+            sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl]
+  lt="failed" => return nil
+
+  -- 2.  coerce each argument to final domain, returning failed
+  --     if not possible
+
+  lt':= [coerce(y,d) or return "failed"
+         for y in lt for d in SUBLIS(sl,margl)]
+  lt'="failed" => return nil
+
+  -- 3.  obtain domain-specific function, if possible, and return
+
+  --$bindings is bound by compMapCond
+  [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil
+
+--+ can no longer trust what the modemap says for a reference into
+--+ an exterior domain (it is calculating the displacement based on view
+--+ information which is no longer valid; thus ignore this index and
+--+ store the signature instead.
+
+--$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) =>
+  f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
+    [genDeltaEntry [op,:modemap],lt',$bindings]
+  [f,lt',$bindings]
+
+compMapCond(op,mc,$bindings,fnsel) ==
+  or/[compMapCond'(u,op,mc,$bindings) for u in fnsel]
+
+compMapCond'([cexpr,fnexpr],op,dc,bindings) ==
+  compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings)
+  stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d]
+
+compMapCond''(cexpr,dc) ==
+  cexpr=true => true
+  --cexpr = "true" => true
+  cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l]
+  cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l]
+  cexpr is ["not",u] => not compMapCond''(u,dc)
+  cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
+        --for the time being we'll stop here - shouldn't happen so far
+        --$disregardConditionIfTrue => true
+        --stackSemanticError(("not known that",'%b,name,
+        -- '%d,"has",'%b,cat,'%d),nil)
+  --now it must be an attribute
+  member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true
+  --for the time being we'll stop here - shouldn't happen so far
+  stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d]
+  false
+
+compMapCondFun(fnexpr,op,dc,bindings) == [fnexpr,bindings]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/as.boot.pamphlet b/src/interp/as.boot.pamphlet
new file mode 100644
index 00000000..fd848ab2
--- /dev/null
+++ b/src/interp/as.boot.pamphlet
@@ -0,0 +1,1223 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/as.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{New Aldor compiler changes}
+
+This mod is used to make the open source version of Axiom work
+with the new aldor compiler.
+Aldor does not want the [[attributeAlist]].
+This used to read:
+\begin{verbatim}
+  HPUT($opHash,con,[ancestorAlist,attributeAlist,:opalist])
+\end{verbatim}
+but was changed to:
+<<aldor mod>>=
+  HPUT($opHash,con,[ancestorAlist,nil,:opalist])
+@
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--global hash tables for new compiler
+$docHash  := MAKE_-HASH_-TABLE()
+$conHash  := MAKE_-HASH_-TABLE()
+$opHash   := MAKE_-HASH_-TABLE()
+$asyPrint := false
+
+asList() ==
+  OBEY '"rm -f temp.text"
+  OBEY '"ls as/*.asy > temp.text"
+  instream := OPEN '"temp.text"
+  lines := [READLINE instream while not EOFP instream]
+  CLOSE instream
+  lines
+
+asAll lines ==
+  for x in lines repeat
+    sayBrightly ['"-----> ",x]
+    asTran x
+  'done
+
+as name ==
+  astran STRCONC(STRINGIMAGE name,'".asy")
+--  astran STRCONC(getEnv('"AXIOM"),
+--     '"/../../obj/rios/as/",STRINGIMAGE name,'".asy")
+  'done
+
+astran asyFile ==
+--global hash tables for new compiler
+  $docHash  := MAKE_-HASH_-TABLE()
+  $conHash := MAKE_-HASH_-TABLE()
+  $constantHash := MAKE_-HASH_-TABLE()
+  $niladics : local := nil
+  $asyFile: local := asyFile
+  $asFilename: local := STRCONC(PATHNAME_-NAME asyFile,'".as")
+  asytran asyFile
+  conlist := [x for x in HKEYS $conHash | HGET($conHash,x) isnt [.,.,"function",:.]]
+  $mmAlist : local :=
+    [[con,:asyConstructorModemap con] for con in conlist]
+  $docAlist : local :=
+    [[con,:REMDUP asyDocumentation con] for con in conlist]
+  $parentsHash : local := MAKE_-HASH_-TABLE()
+--$childrenHash: local := MAKE_-HASH_-TABLE()
+  for con in conlist repeat
+    parents := asyParents con
+    HPUT($parentsHash,con,asyParents con)
+--  for [parent,:pred] in parents repeat
+--    parentOp := opOf parent
+--    HPUT($childrenHash,parentOp,insert([con,:pred],HGET($childrenHash,parentOp)))
+  $newConlist := union(conlist, $newConlist)
+  [[x,:asMakeAlist x] for x in HKEYS $conHash]
+
+asyParents(conform) ==
+  acc := nil
+  con:= opOf conform
+--formals := TAKE(#formalParams,$TriangleVariableList)
+  modemap := LASSOC(con,$mmAlist)
+  $constructorCategory :local := asySubstMapping CADAR modemap
+  for x in folks $constructorCategory repeat
+--  x := SUBLISLIS(formalParams,formals,x)
+--  x := SUBLISLIS(IFCDR conform,formalParams,x)
+--  x := SUBST('Type,'Object,x)
+    acc := [:explodeIfs x,:acc]
+  NREVERSE acc
+
+asySubstMapping u ==
+  u is [op,:r] =>
+    op = "->" =>
+       [s, t] := r
+       args :=
+          s is [op,:u] and asyComma? op => [asySubstMapping y for y in u]
+          [asySubstMapping s]
+       ['Mapping, asySubstMapping t, :args]
+    [asySubstMapping x for x in u]
+  u
+
+--asyFilePackage asyFile ==
+--  name := INTERN PATHNAME_-NAME asyFile
+--  modemap :=
+--    [[[name],['CATEGORY,'domain,
+--      :[asyMkSignature(con,CDAR mm) for [con,:mm] in $mmAlist]]],['T,name]]
+--  opAlist := [[con,[CDAR mm]] for [con,:mm] in $mmAlist]
+--  documentation :=
+--    [[con,[CDAR mm,fn LASSOC(con,$docAlist)]] for [con,:mm] in $mmAlist]
+--      where fn u ==
+--            LASSOC('constructor,u) is [[=nil,doc]] => doc
+--            '""
+--  res := [['constructorForm,name],['constant,:'true],
+--           ['constructorKind,:'file],
+--             ['constructorModemap,:modemap],
+--               ['sourceFile,:PNAME name],
+--                 ['operationAlist,:zeroOneConversion opAlist],
+--                     ['documentation,:documentation]]
+--asyDisplay(name,res)
+--  [name,:res]
+
+asyMkSignature(con,sig) ==
+--  atom sig => ['TYPE,con,sig]
+-- following line converts constants into nullary functions
+  atom sig => ['SIGNATURE,con,[sig]]
+  ['SIGNATURE,con,sig]
+
+asMakeAlist con ==
+  record := HGET($conHash,con)
+  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := first record
+--TTT in case we put the wrong thing in for niladic catgrs
+--if ATOM(form) and kind='category then form:=[form]
+  if ATOM(form) then form:=[form]
+  kind = 'function => asMakeAlistForFunction con
+  abb := asyAbbreviation(con,#(KDR sig))
+  if null KDR form then PUT(opOf form,'NILADIC,'T)
+  modemap := asySubstMapping LASSOC(con,$mmAlist)
+  $constructorCategory :local := CADAR modemap
+  parents := mySort HGET($parentsHash,con)
+--children:= mySort HGET($childrenHash,con)
+  alists  := HGET($opHash,con)
+  opAlist := SUBLISLIS($FormalMapVariableList,KDR form,CDDR alists)
+  ancestorAlist:= SUBLISLIS($FormalMapVariableList,KDR form,CAR alists)
+  catAttrs := [[x,:true] for x in getAttributesFromCATEGORY $constructorCategory]
+  attributeAlist := REMDUP [:CADR alists,:catAttrs]
+  documentation :=
+    SUBLISLIS($FormalMapVariableList,KDR form,LASSOC(con,$docAlist))
+  filestring := STRCONC(PATHNAME_-NAME STRINGIMAGE filename,'".as")
+  constantPart := HGET($constantHash,con) and [['constant,:true]]
+  niladicPart := MEMQ(con,$niladics) and [['NILADIC,:true]]
+  falist :=  TAKE(#KDR form,$FormalMapVariableList)
+  constructorCategory :=
+    kind = 'category =>
+      talist := TAKE(#KDR form, $TriangleVariableList)
+      SUBLISLIS(talist, falist, $constructorCategory)
+    SUBLISLIS(falist,KDR form,$constructorCategory)
+  if constructorCategory='Category then kind := 'category
+  exportAlist := asGetExports(kind, form, constructorCategory)
+  constructorModemap  := SUBLISLIS(falist,KDR form,modemap)
+--TTT fix a niladic category constructormodemap (remove the joins)
+  if kind = 'category then
+     SETF(CADAR(constructorModemap),['Category])
+  res := [['constructorForm,:form],:constantPart,:niladicPart,
+           ['constructorKind,:kind],
+             ['constructorModemap,:constructorModemap],
+              ['abbreviation,:abb],
+               ['constructorCategory,:constructorCategory],
+                ['parents,:parents],
+                 ['attributes,:attributeAlist],
+                  ['ancestors,:ancestorAlist],
+                   --                ['children,:children],
+                   ['sourceFile,:filestring],
+                    ['operationAlist,:zeroOneConversion opAlist],
+                     ['modemaps,:asGetModemaps(exportAlist,form,kind,modemap)],
+                       ['sourcefile,:$asFilename],
+                         ['typeCode,:typeCode],
+                          ['documentation,:documentation]]
+  if $asyPrint then asyDisplay(con,res)
+  res
+
+asGetExports(kind, conform, catform) ==
+  u := asCategoryParts(kind, conform, catform, true) or return nil
+  -- ensure that signatures are lists
+  [[op, sigpred] for [op,sig,:pred] in CDDR u] where
+    sigpred ==
+      pred :=
+        pred = "T" => nil
+        pred
+      [sig, nil, :pred]
+
+asMakeAlistForFunction fn ==
+  record := HGET($conHash,fn)
+  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := first record
+  modemap := LASSOC(fn,$mmAlist)
+  newsig := asySignature(sig,nil)
+  opAlist := [[fn,[newsig,nil,:predlist]]]
+  res := [['modemaps,:asGetModemaps(opAlist,fn,'function,modemap)],
+            ['typeCode,:typeCode]]
+  if $asyPrint then asyDisplay(fn,res)
+  res
+
+getAttributesFromCATEGORY catform ==
+  catform is ['CATEGORY,.,:r] => [y for x in r | x is ['ATTRIBUTE,y]]
+  catform is ['Join,:m,x]     => getAttributesFromCATEGORY x
+  nil
+
+displayDatabase x == main where
+  main ==
+    for y in
+     '(CONSTRUCTORFORM CONSTRUCTORKIND _
+       CONSTRUCTORMODEMAP _
+       ABBREVIATION _
+       CONSTRUCTORCATEGORY _
+       PARENTS _
+       ATTRIBUTES _
+       ANCESTORS _
+       SOURCEFILE _
+       OPERATIONALIST _
+       MODEMAPS _
+       SOURCEFILE _
+       DOCUMENTATION) repeat fn(x,y)
+  fn(x,y) ==
+    sayBrightly ['"----------------- ",y,'" --------------------"]
+    pp GETDATABASE(x,y)
+
+-- For some reason Dick has modified as.boot to convert the
+-- identifier |0| or |1| to an integer in the list of operations.
+-- This is WRONG, all existing code assumes that operation names
+-- are always identifiers not numbers.
+-- This function breaks the ability of the interpreter to find
+-- |0| or |1| as exports of new compiler domains.
+-- Unless someone has a strong reason for keeping the change,
+-- this function should be no-opped, i.e.
+-- zeroOneConversion opAlist == opAlist
+-- If this change is made, then we are able to find asharp constants again.
+--   bmt Mar 26, 1994  and executed by rss
+
+zeroOneConversion opAlist == opAlist
+--   for u in opAlist repeat
+--     [op,:.] := u
+--     DIGITP (PNAME op).0 => RPLACA(u, string2Integer PNAME op)
+--   opAlist
+
+asyDisplay(con,alist) ==
+  banner := '"=============================="
+  sayBrightly [banner,'" ",con,'" ",banner]
+  for [prop,:value] in alist repeat
+    sayBrightlyNT [prop,'": "]
+    pp value
+
+asGetModemaps(opAlist,oform,kind,modemap) ==
+  acc:= nil
+  rpvl:=
+    MEMQ(kind, '(category function)) => rest $PatternVariableList -- *1 is special for $
+    $PatternVariableList
+  form := [opOf oform,:[y for x in KDR oform for y in rpvl]]
+  dc :=
+    MEMQ(kind, '(category function)) => "*1"
+    form
+  pred1 :=
+    kind = 'category => [["*1",form]]
+    nil
+  signature  := CDAR modemap
+  domainList :=
+    [[a,m] for a in rest form for m in rest signature |
+       asIsCategoryForm m]
+  catPredList:=
+    kind = 'function => [["isFreeFunction","*1",opOf form]]
+    [['ofCategory,:u] for u in [:pred1,:domainList]]
+--  for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat
+--  the code seems to oscillate between generating $FormalMapVariableList 
+--  and generating $TriangleVariableList
+  for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat
+    for [sig0, pred] in itemlist repeat
+      sig := SUBST(dc,"$",sig0)
+      pred:= SUBST(dc,"$",pred)
+      sig := SUBLISLIS(rpvl,KDR oform,sig)
+      pred:= SUBLISLIS(rpvl,KDR oform,pred)
+      pred := pred or 'T
+  ----------> Constants change <--------------
+      if IDENTP sig0 then
+          sig := [sig]
+          pred := MKPF([pred,'(isAsConstant)],'AND)
+      pred' := MKPF([pred,:catPredList],'AND)
+      mm := [[dc,:sig],[pred']]
+      acc := [[op,:interactiveModemapForm mm],:acc]
+  NREVERSE acc
+
+asIsCategoryForm m ==
+  m = 'BasicType or GETDATABASE(opOf m,'CONSTRUCTORKIND) = 'category
+
+asyDocumentation con ==
+  docHash := HGET($docHash,con)
+  u := [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash
+           | rec := HGET(docHash,op)] where fn(x,op) ==
+    [form,sig,pred,origin,where?,comments,:.] := x
+    ----------> Constants change <--------------
+    if IDENTP sig then sig := [sig]
+    [asySignature(sig,nil),trimComments comments]
+  [form,sig,pred,origin,where?,comments] := first HGET($conHash,con)
+  --above "first" assumes only one entry
+  comments := trimComments asyExtractDescription comments
+  [:u,['constructor,[nil,comments]]]
+
+asyExtractDescription str ==
+  k := STRPOS('"Description:",str,0,nil) => asyExtractDescription SUBSTRING(str,k + 12,nil)
+  k := STRPOS('"Author:",str,0,nil) => asyExtractDescription SUBSTRING(str,0,k)
+  str
+
+trimComments str ==
+  null str or str = '"" => '""
+  m := MAXINDEX str
+  str := SUBSTRING(str,0,m)
+  trimString str
+
+asyExportAlist con ==
+--format of 'operationAlist property of LISPLIBS (as returned from koOps):
+--    <sig slotNumberOrNil optPred optELT>
+--    <sig sig'            predOrT "Subsumed">
+--!!! asyFile NEED: need to know if function is implemented by domain!!!
+  docHash := HGET($docHash,con)
+  [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash | rec := HGET(docHash,op)]
+       where fn(x,op) ==
+    [form,sig,pred,origin,where?,comments,:.] := x
+    tail :=
+      pred => [pred]
+      nil
+    newSig := asySignature(sig,nil)
+    [newSig,nil,:tail]
+
+asyMakeOperationAlist(con,proplist, key) ==
+  oplist :=
+    u := LASSOC('domExports,proplist) =>
+      kind := 'domain
+      u
+    u := LASSOC('catExports,proplist) =>
+      kind := 'category
+      u
+    key = 'domain =>
+      kind := 'domain
+      u := NIL
+    return nil
+  ht := MAKE_-HASH_-TABLE()
+  ancestorAlist := nil
+  for ['Declare,id,form,r] in oplist repeat
+    id = "%%" =>
+      opOf form = con => nil
+      y := asyAncestors form
+      [attrs, na] := asyFindAttrs y
+      y := na
+      if opOf(y)^=con then ancestorAlist := [ [y,:true],:ancestorAlist]
+    idForm   :=
+      form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
+  ----------> Constants change <--------------
+      id
+    pred :=
+      LASSOC('condition,r) is p => hackToRemoveAnd p
+      nil
+    sig := asySignature(asytranForm(form,[idForm],nil),nil)
+    entry :=
+      --id ^= "%%" and IDENTP idForm => [[sig],nil,nil,'ASCONST]
+      id ^= "%%" and IDENTP idForm =>
+          pred => [[sig],nil,asyPredTran pred,'ASCONST]
+          [[sig],nil,true,'ASCONST]
+      pred => [sig,nil,asyPredTran pred]
+      [sig]
+    HPUT(ht,id,[entry,:HGET(ht,id)])
+  opalist := [[op,:REMDUP HGET(ht,op)] for op in HKEYS ht]
+  --HPUT($opHash,con,[ancestorAlist,attributeAlist,:opalist])
+<<aldor mod>>
+
+hackToRemoveAnd p ==
+---remove this as soon as .asy files do not contain forms (And pred) forms
+  p is ['And,q,:r] =>
+    r => ['AND,q,:r]
+    q
+  p
+
+asyAncestors x ==
+  x is ['Apply,:r] => asyAncestorList r
+  x is [op,y,:.] and MEMQ(op, '(PretendTo RestrictTo)) => asyAncestors y
+  atom x =>
+    x = '_% => '_$
+    MEMQ(x, $niladics)       => [x]
+    GETDATABASE(x ,'NILADIC) => [x]
+    x
+  asyAncestorList x
+
+asyAncestorList x == [asyAncestors y for y in x]
+--============================================================================
+--       Build Operation Alist from sig
+--============================================================================
+
+--format of operations as returned from koOps
+--    <sig pred pakOriginOrNil TifPakExposedOrNil>
+--    <sig pred origin         exposed?>
+
+--abb,kind,file,sourcefile,coSig,dbLineNumber,constructorArgs,libfile
+--((sig  where(NIL or #)  condition(T or pred)  ELTorSubsumed) ...
+--expanded lists are: sig, predicate, origin, exposeFlag, comments
+
+--============================================================================
+--       Building Hash Tables for Operations/Constructors
+--============================================================================
+asytran fn ==
+--put operations into table format for browser:
+--    <sig pred origin         exposed? comments>
+  inStream := OPEN fn
+  sayBrightly ['"   Reading ",fn]
+  u := READ inStream
+  $niladics := mkNiladics u
+  for x in $niladics repeat PUT(x,'NILADIC,true)
+  for d in u repeat
+    ['Declare,name,:.] := d
+    name = "%%" => 'skip       --skip over top-level properties
+    $docHashLocal: local := MAKE_-HASH_-TABLE()
+    asytranDeclaration(d,'(top),nil,false)
+    if null name then hohohoho()
+    HPUT($docHash,name,$docHashLocal)
+  CLOSE inStream
+  'done
+
+mkNiladics u ==
+  [name for x in u | x is ['Declare,name,y,:.] and y isnt ['Apply,'_-_>,:.]]
+
+--OLD DEFINITION FOLLOWS
+asytranDeclaration(dform,levels,predlist,local?) ==
+  ['Declare,id,form,r] := dform
+  id = 'failed => id
+  KAR dform ^= 'Declare => systemError '"asytranDeclaration"
+  if levels = '(top) then
+    if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true)
+  comments := LASSOC('documentation,r) or '""
+  idForm   :=
+    levels is ['top,:.] =>
+      form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
+      id
+  ----------> Constants change <--------------
+    id
+  newsig  := asytranForm(form,[idForm,:levels],local?)
+  key :=
+    levels is ['top,:.] =>
+      MEMQ(id,'(%% Category Type)) => 'constant
+      asyLooksLikeCatForm? form => 'category
+      form is ['Apply, '_-_>,.,u] =>
+        if u is ['Apply, construc,:.] then u:= construc
+        GETDATABASE(opOf u,'CONSTRUCTORKIND) = 'domain  => 'function
+        asyLooksLikeCatForm? u => 'category
+        'domain
+      'domain
+    first levels
+  typeCode := LASSOC('symeTypeCode,r)
+  record := [idForm,newsig,asyMkpred predlist,key,true,comments,typeCode,:$asyFile]
+  if not local? then
+    ht :=
+      levels = '(top) => $conHash
+      $docHashLocal
+    HPUT(ht,id,[record,:HGET(ht,id)])
+  if levels = '(top) then asyMakeOperationAlist(id,r, key)
+  ['Declare,id,newsig,r]
+
+asyLooksLikeCatForm? x ==
+--TTT don't see a Third in my version ....
+  x is ['Define, ['Declare, ., ['Apply, 'Third,:.],:.],:.] or
+   x is ['Define, ['Declare, ., 'Category ],:.]
+
+--asytranDeclaration(dform,levels,predlist,local?) ==
+--  ['Declare,id,form,r] := dform
+--  id = 'failed => id
+--  levels isnt ['top,:.] => asytranForm(form,[id,:levels],local?)
+--  idForm   :=
+--    form is ['Apply,'_-_>,source,target] => [id,:asyArgs source]
+--    id
+--  if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true)
+--  comments := LASSOC('documentation,r) or '""
+--  newsig  := asytranForm(form,[idForm,:levels],local?)
+--  key :=
+--    MEMQ(id,'(%% Category Type)) => 'constant
+--    form is ['Apply,'Third,:.] => 'category
+--    form is ['Apply,.,.,target] and target is ['Apply,name,:.]
+--      and MEMQ(name,'(Third Join)) => 'category
+--    'domain
+--  record := [newsig,asyMkpred predlist,key,true,comments,:$asyFile]
+--  if not local? then
+--    ht :=
+--      levels = '(top) => $conHash
+--      $docHashLocal
+--    HPUT(ht,id,[record,:HGET(ht,id)])
+--  if levels = '(top) then asyMakeOperationAlist(id,r)
+--  ['Declare,id,newsig,r]
+
+asyIsCatForm form ==
+  form is ['Apply,:r] =>
+    r is ['_-_>,.,a] => asyIsCatForm a
+    r is ['Third,'Type,:.] => true
+    false
+  false
+
+asyArgs source ==
+  args :=
+    source is [op,:u] and asyComma? op => u
+    [source]
+  [asyArg x for x in args]
+
+asyArg x ==
+  x is ['Declare,id,:.] => id
+  x
+
+asyMkpred predlist ==
+  null predlist => nil
+  predlist is [p] => p
+  ['AND,:predlist]
+
+asytranForm(form,levels,local?) ==
+  u := asytranForm1(form,levels,local?)
+  null u => hahah()
+  u
+
+asytranForm1(form,levels,local?) ==
+  form is ['With,left,cat] =>
+--  left ^= nil       => error '"WITH cannot take a left argument yet"
+    asytranCategory(form,levels,nil,local?)
+  form is ['Apply,:.]   => asytranApply(form,levels,local?)
+  form is ['Declare,:.] => asytranDeclaration(form,levels,nil,local?)
+  form is ['Comma,:r]  => ['Comma,:[asytranForm(x,levels,local?) for x in r]]
+--form is ['_-_>,:s] => asytranMapping(s,levels,local?)
+  form is [op,a,b] and MEMQ(a,'(PretendTo RestrictTo)) =>
+    asytranForm1(a,levels,local?)
+  form is ['LitInteger,s] =>
+	READ_-FROM_-STRING(s)
+  form is ['Define,:.]  =>
+    form is ['Define,['Declare,.,x,:.],rest] =>
+--TTT i don't know about this one but looks ok
+      x = 'Category => asytranForm1(rest,levels, local?)
+      asytranForm1(x,levels,local?)
+    error '"DEFINE forms are not handled yet"
+  if form = '_% then $hasPerCent := true
+  IDENTP form =>
+    form = "%" => "$"
+    GETL(form,'NILADIC) => [form]
+    form
+  [asytranForm(x,levels,local?) for x in form]
+
+asytranApply(['Apply,name,:arglist],levels,local?) ==
+  MEMQ(name,'(Record Union)) =>
+    [name,:[asytranApplySpecial(x, levels, local?) for x in arglist]]
+  null arglist => [name]
+  name is [ 'RestrictTo, :.] => 
+    asytranApply(['Apply, CAR CDR name,:arglist], levels, local?)
+  name is [ 'Qualify, :.] => 
+    asytranApply(['Apply, CAR CDR name,:arglist], levels, local?)
+  name is 'string => asytranLiteral CAR arglist
+  name is 'integer => asytranLiteral CAR arglist
+  name is 'float => asytranLiteral CAR arglist
+  name = 'Enumeration =>
+    ["Enumeration",:[asytranEnumItem arg for arg in arglist]]
+  [:argl,lastArg] := arglist
+  [name,:[asytranFormSpecial(arg,levels,true) for arg in argl],
+          asytranFormSpecial(lastArg,levels,false)]
+
+asytranLiteral(lit) ==
+  CAR CDR lit
+
+asytranEnumItem arg ==
+  arg is ['Declare, name, :.] => name
+  error '"Bad Enumeration entry"
+
+asytranApplySpecial(x, levels, local?) ==
+  x is ['Declare, name, typ, :.] => [":",name,asytranForm(typ, levels, local?)]
+  asytranForm(x, levels, local?)
+
+asytranFormSpecial(x, levels, local?) ==  --> this throws away variable name (revise later)
+  x is ['Declare, name, typ, :.] => asytranForm(typ, levels, local?)
+  asytranForm(x, levels, local?)
+
+asytranCategory(form,levels,predlist,local?) ==
+  cat :=
+    form is ['With,left,right] =>
+      right is ['Blank,:.] => ['Sequence]
+      right
+    form
+  left :=
+    form is ['With,left,right] =>
+      left is ['Blank,:.] => nil
+      left
+    nil
+  $hasPerCent: local := nil
+  items :=
+    cat is ['Sequence,:s] => s
+    [cat]
+  catTable := MAKE_-HASH_-TABLE()
+  catList  := nil
+  for x in items | x repeat
+    if null x then systemError()
+    dform := asytranCategoryItem(x,levels,predlist,local?)
+    null dform => nil
+    dform is ['Declare,id,record,r] =>
+      HPUT(catTable,id,[asyWrap(record,predlist),:HGET(catTable,id)])
+    catList := [asyWrap(dform,predlist),:catList]
+  keys := listSort(function GLESSEQP,HKEYS catTable)
+  right1 := NREVERSE catList
+  right2 := [[key,:HGET(catTable,key)] for key in keys]
+  right :=
+    right2 => [:right1,['Exports,:right2]]
+    right1
+  res :=
+    left => [left,:right]
+    right
+  res is [x] and x is ['IF,:.] => x
+  ['With,:res]
+
+asyWrap(record,predlist) ==
+  predlist => ['IF,MKPF(predlist,'AND),record]
+  record
+
+asytranCategoryItem(x,levels,predlist,local?) ==
+  x is ['If,predicate,item,:r] =>
+    IFCAR r => error '"ELSE expressions not allowed yet in conditionals"
+    pred :=
+      predicate is ['Test,r] => r
+      predicate
+    asytranCategory(item,levels,[pred,:predlist],local?)
+  MEMQ(KAR x,'(Default Foreign)) => nil
+  x is ['Declare,:.] => asytranDeclaration(x,levels,predlist,local?)
+  x
+
+--============================================================================
+--          Extending Constructor Datatable
+--============================================================================
+--FORMAT of $constructorDataTable entry:
+--abb kind libFile sourceFile coSig constructorArgs
+--alist is ((kind . domain) (libFile . MATRIX) (sourceFile . "matrix")
+--         (coSig NIL T) (dbLineNumber . 29187) (constructorArgs R)
+--  (modemap . (
+--    (|Matrix| |#1|)
+--      (Join (MatrixCategory #1 (Vector #1) (Vector #1))
+--        (CATEGORY domain
+--          (SIGNATURE diagonalMatrix ($ (Vector #1)))
+--          (IF (has #1 (Field))
+--            (SIGNATURE inverse ((Union $ "failed") $)) noBranch)))
+--      (Ring))
+--    (T Matrix))   )
+extendConstructorDataTable() ==
+--  tb := $constructorDataTable
+  for x in listSort(function GLESSEQP,HKEYS $conHash) repeat
+--     if LASSOC(x,tb) then tb := DELLASOS(x,tb)
+     record := HGET($conHash,x)
+     [form,sig,predlist,origin,exposure,comments,typeCode,:filename] := first record
+     abb := asyAbbreviation(x,#(rest sig))
+     kind := 'domain
+     --Note: this "first" assumes that there is ONLY one sig per name
+     cosig := [nil,:asyCosig sig]
+     args  := asyConstructorArgs sig
+     tb :=
+       [[x,abb,
+          ['kind,:kind],
+            ['cosig,:cosig],
+              ['libfile,filename],
+                ['sourceFile,STRINGIMAGE filename],
+                  ['constructorArgs,:args]],:tb]
+  listSort(function GLESSEQP,ASSOCLEFT tb)
+
+asyConstructorArgs sig ==
+  sig is ['With,:.] => nil
+  sig is ['_-_>,source,target] =>
+    source is [op,:argl] and asyComma? op => [asyConstructorArg x for x in argl]
+    [asyConstructorArg source]
+
+asyConstructorArg x ==
+  x is ['Declare,name,t,:.] => name
+  x
+
+asyCosig sig ==    --can be a type or could be a signature
+  atom sig or sig is ['With,:.] => nil
+  sig is ['_-_>,source,target] =>
+    source is [op,:argl] and asyComma? op => [asyCosigType x for x in argl]
+    [asyCosigType source]
+  error false
+
+asyCosigType u ==
+  u is [name,t] =>
+    t is [fn,:.] =>
+      asyComma? fn => fn
+      fn = 'With  => 'T
+      nil
+    t = 'Type => 'T
+    error '"Unknown atomic type"
+  error false
+
+asyAbbreviation(id,n) ==  chk(id,main) where   --> n = number of arguments
+  main ==
+    a := createAbbreviation id => a
+    name := PNAME id
+--  #name < 8 => INTERN UPCASE name
+    parts := asySplit(name,MAXINDEX name)
+    newname := "STRCONC"/[asyShorten x for x in parts]
+    #newname < 8 => INTERN newname
+    tryname := SUBSTRING(name,0,7)
+    not createAbbreviation tryname => INTERN UPCASE tryname
+    nil
+  chk(conname,abb) ==
+    (xx := asyGetAbbrevFromComments conname) => xx
+    con := abbreviation? abb =>
+      conname = con => abb
+      conname
+    abb
+
+asyGetAbbrevFromComments con ==
+  docHash := HGET($docHash,con)
+  u := [[op,:[fn(x,op) for x in rec]] for op in HKEYS docHash
+           | rec := HGET(docHash,op)] where fn(x,op) ==
+    [form,sig,pred,origin,where?,comments,:.] := x
+    ----------> Constants change <--------------
+    if IDENTP sig then sig := [sig]
+    [asySignature(sig,nil),trimComments comments]
+  [form,sig,pred,origin,where?,comments] := first HGET($conHash,con)
+  --above "first" assumes only one entry
+  x := asyExtractAbbreviation comments
+  x => intern x
+  NIL
+
+asyExtractAbbreviation str ==
+	not (k:= STRPOS('"Abbrev: ",str,0,nil)) => NIL
+	str := SUBSTRING(str, k+8, nil)
+	k := STRPOS($stringNewline, str,0,nil)
+	k => SUBSTRING(str, 0, k)
+	str
+
+asyShorten x ==
+  y := createAbbreviation x
+    or LASSOC(x,
+        '(("Small" . "SM") ("Single" ."S") ("Half" . "H")("Point" . "PT")
+            ("Floating" . "F") ("System" . "SYS") ("Number" . "N")
+	     ("Inventor" . "IV")
+              ("Finite" . "F") ("Double" . "D") ("Builtin" . "BI"))) => y
+  UPCASE x
+
+asySplit(name,end) ==
+  end < 1 => [name]
+  k := 0
+  for i in 1..end while LOWER_-CASE_-P name.i repeat k := i
+  k := k + 1
+  [SUBSTRING(name,0,k),:asySplit(SUBSTRING(name,k,nil),end-k)]
+
+createAbbreviation s ==
+  if STRINGP s then s := INTERN s
+  a := constructor? s
+  a ^= s => a
+  nil
+
+--============================================================================
+--       extending getConstructorModemap Property
+--============================================================================
+--Note: modemap property is built when getConstructorModemap is called
+
+asyConstructorModemap con ==
+  HGET($conHash,con) isnt [record,:.] => nil   --not there
+  [form,sig,predlist,kind,exposure,comments,typeCode,:filename] := record
+  $kind: local := kind
+  --NOTE: sig has the form (-> source target) or simply (target)
+  $constructorArgs: local := KDR form
+  signature := asySignature(sig,false)
+  formals := ['_$,:TAKE(#$constructorArgs,$FormalMapVariableList)]
+  mm := [[[con,:$constructorArgs],:signature],['T,con]]
+  SUBLISLIS(formals,['_%,:$constructorArgs],mm)
+
+asySignature(sig,names?) ==
+  sig is ['Join,:.] => [asySig(sig,nil)]
+  sig is ['With,:.] => [asySig(sig,nil)]
+  sig is ['_-_>,source,target] =>
+    target :=
+      names? => ['dummy,target]
+      target
+    source is [op,:argl] and asyComma? op =>
+      [asySigTarget(target,names?),:[asySig(x,names?) for x in argl]]
+    [asySigTarget(target,names?),asySig(source,names?)]
+  ----------> The following is a hack for constants which are category names<--
+  sig is ['Third,:.] => [asySig(sig,nil)]
+  ----------> Constants change <--------------
+  asySig(sig,nil)
+
+asySigTarget(u,name?) == asySig1(u,name?,true)
+
+asySig(u,name?) == asySig1(u,name?,false)
+
+asySig1(u,name?,target?) ==
+  x :=
+    name? and u is [name,t] => t
+    u
+  x is [fn,:r] =>
+    fn = 'Join => asyTypeJoin r       ---------> jump out to newer code 4/94
+    MEMQ(fn, '(RestrictTo PretendTo)) => asySig(first r,name?)
+    asyComma? fn =>
+      u := [asySig(x,name?) for x in r]
+      target? =>
+        null u => '(Void)
+        -- this implies a multiple value return, not currently supported
+        -- in the interpreter
+        ['Multi,:u]
+      u
+    fn = 'With  => asyCATEGORY r
+    fn = 'Third =>
+      r is [b] =>
+        b is ['With,:s]  => asyCATEGORY s
+        b is ['Blank,:.] => asyCATEGORY nil
+      error x
+    fn = 'Apply and r is ['_-_>,:s] => asyMapping(s,name?)
+    fn = '_-_> => asyMapping(r,name?)
+    fn = 'Declare and r is [name,typ,:.] =>
+	asySig1(typ, name?, target?)
+    x is '(_%) => '(_$)
+    [fn,:[asySig(x,name?) for x in r]]
+--x = 'Type => '(Type)
+  x = '_% => '_$
+  x
+
+-- old version was :
+--asyMapping([a,b],name?) ==
+--  a := asySig(a,name?)
+--  b := asySig(b,name?)
+--  args :=
+--    a is [op,:r] and asyComma? op => r
+--    [a]
+--  ['Mapping,b,:args]
+
+asyMapping([a,b],name?) ==
+  newa := asySig(a,name?)
+  b    := asySig(b,name?)
+  args :=
+    a is [op,:r] and asyComma? op => newa
+    [a]
+  ['Mapping,b,:args]
+
+--============================================================================
+--       code for asySignatures of the form (Join,:...)
+--============================================================================
+asyType x ==
+  x is [fn,:r] =>
+    fn = 'Join => asyTypeJoin r
+    MEMQ(fn, '(RestrictTo PretendTo)) => asyType first r
+    asyComma? fn =>
+      u := [asyType x for x in r]
+      u
+    fn = 'With  => asyCATEGORY r
+    fn = '_-_> => asyTypeMapping r
+    fn = 'Apply => r
+--  fn = 'Declare and r is [name,typ,:.] => typ
+    x is '(_%) => '(_$)
+    x
+--x = 'Type => '(Type)
+  x = '_% => '_$
+  x
+
+asyTypeJoin r ==
+  $conStack : local := nil
+  $opStack  : local := nil
+  $predlist : local := nil
+  for x in r repeat asyTypeJoinPart(x,$predlist)
+  catpart :=
+    $opStack => ['CATEGORY,$kind,:asyTypeJoinStack REVERSE $opStack]
+    nil
+  conpart := asyTypeJoinStack REVERSE $conStack
+  conpart =>
+    catpart     => ['Join,:conpart,catpart]
+    CDR conpart => ['Join,:conpart]
+    conpart
+  catpart
+
+asyTypeJoinPart(x,$predlist) ==
+  x is ['Join,:y] => for z in y repeat asyTypeJoinPart(z, $predlist)
+  x is ['With,:y] => for p in y repeat asyTypeJoinPartWith p
+  asyTypeJoinPartWith x
+
+asyTypeJoinPartWith x ==
+  x is ['Exports,:y] => for p in y repeat asyTypeJoinPartExport p
+  x is ['Exports,:.] => systemError 'exports
+  x is ['Comma]  => nil
+  x is ['Export,:y]  => nil
+  x is ['IF,:r] => asyTypeJoinPartIf r
+  x is ['Sequence,:x] => for y in x repeat asyTypeJoinItem y
+  asyTypeJoinItem x
+
+asyTypeJoinPartIf [pred,value] ==
+  predlist := [asyTypeJoinPartPred pred,:$predlist]
+  asyTypeJoinPart(value,predlist)
+
+asyTypeJoinPartPred x ==
+  x is ['Test, y] => asyTypeUnit y
+  asyTypeUnit x
+
+asyTypeJoinItem x ==
+  result := asyTypeUnit x
+  isLowerCaseLetter (PNAME opOf result).0 =>
+    $opStack := [[['ATTRIBUTE,result],:$predlist],:$opStack]
+  $conStack := [[result,:$predlist],:$conStack]
+
+asyTypeMapping([a,b]) ==
+  a := asyTypeUnit a
+  b := asyTypeUnit b
+  args :=
+    a is [op,:r] and asyComma? op => r
+    [a]
+  ['Mapping,b,:args]
+
+asyTypeUnit x ==
+  x is [fn,:r] =>
+    fn = 'Join => systemError 'Join ----->asyTypeJoin r
+    MEMQ(fn, '(RestrictTo PretendTo)) => asyTypeUnit first r
+    asyComma? fn =>
+      u := [asyTypeUnit x for x in r]
+      u
+    fn = 'With  => asyCATEGORY r
+    fn = '_-_> => asyTypeMapping r
+    fn = 'Apply => asyTypeUnitList r
+    fn = 'Declare and r is [name,typ,:.] => asyTypeUnitDeclare(name,typ)
+    x is '(_%) => '(_$)
+    [fn,:asyTypeUnitList r]
+  GETL(x,'NILADIC) => [x]
+--x = 'Type => '(Type)
+  x = '_% => '_$
+  x
+
+asyTypeUnitList x == [asyTypeUnit y for y in x]
+
+asyTypeUnitDeclare(op,typ) ==
+  typ is ['Apply, :r] => asyCatSignature(op,r)
+  asyTypeUnit typ
+--============================================================================
+--               Translator for ['With,:.]
+--============================================================================
+asyCATEGORY x ==
+  if x is [join,:y] and join is ['Apply,:s] then
+    exports := y
+    joins :=
+      s is ['Join,:r] => [asyJoinPart u for u in r]
+      [asyJoinPart s]
+  else if x is [id,:y] and IDENTP id then
+    joins := [[id]]
+    exports := y
+  else
+    joins   := nil
+    exports := x
+  cats       := exports
+  operations := nil
+  if exports is [:r,['Exports,:ops]] then
+    cats := r
+    operations := ops
+  exportPart :=
+    ['CATEGORY,'domain,:"APPEND"/[asyCatItem y for y in operations]]
+  [attribs, na] := asyFindAttrs joins
+  joins := na
+  cats := "append"/[asyCattran c for c in cats]
+  [a, na] := asyFindAttrs cats
+  cats := na
+  attribs := APPEND(attribs, a)
+  attribs := [['ATTRIBUTE, x] for x in attribs]
+  exportPart := [:exportPart,:attribs]
+  joins or cats or attribs =>
+    ['Join,:joins,:cats, exportPart]
+  exportPart
+
+asyFindAttrs l ==
+  attrs := []
+  notattrs := []
+  for x in l repeat 
+    x0 := x
+    while CONSP x repeat x := CAR x
+    if MEMQ(x, _*ATTRIBUTES_*) then attrs := [:attrs, x]
+    else notattrs := [:notattrs, x0]
+  [attrs, notattrs]
+
+simpCattran x ==
+  u := asyCattran x
+  u is [y] => y
+  ['Join,:u]
+
+asyCattran x ==
+  x is ['With,:r] => "append"/[asyCattran1 x for x in r]
+  x is ['IF,:.]   => "append"/[asyCattranConstructors(x,nil)]
+  [x]
+
+asyCattran1 x ==
+  x is ['Exports,:y] => "append"/[asyCattranOp u for u in y]
+  x is ['IF,:.]      => "append"/[asyCattranConstructors(x,nil)]
+  systemError nil
+
+asyCattranOp [op,:items] ==
+  "append"/[asyCattranOp1(op,item,nil) for item in items]
+
+asyCattranOp1(op, item, predlist) ==
+  item is ['IF, p, x] =>
+    pred := asyPredTran
+      p is ['Test,t] => t
+      p
+--    x is ['IF,:.] => "append"/[asyCattranOp1('IF, x, [pred,:predlist])]
+--  This line used to call asyCattranOp1 with too few arguments.  Following
+--  fix suggested by RDJ.
+    x is ['IF,:.] => "append"/[asyCattranOp1(op,y,[pred,:predlist]) for y in x]
+    [['IF, asySimpPred(pred,predlist), asyCattranSig(op,x), 'noBranch]]
+  [asyCattranSig(op,item)]
+
+asyPredTran p == asyPredTran1 asyJoinPart p
+
+asyPredTran1 p ==
+  p is ['Has,x,y] => ['has,x, simpCattran y]
+  p is ['Test, q] => asyPredTran1 q
+  p is [op,:r] and MEMQ(op,'(AND OR NOT)) =>
+    [op,:[asyPredTran1 q for q in r]]
+  p
+
+asyCattranConstructors(item, predlist) ==
+  item is ['IF, p, x] =>
+    pred := asyPredTran
+      p is ['Test,t] => t
+      p
+    x is ['IF,:.] => "append"/[asyCattranConstructors(x, [pred,:predlist])]
+    form := ['ATTRIBUTE, asyJoinPart x]
+    [['IF, asySimpPred(pred,predlist), form, 'noBranch]]
+  systemError()
+
+asySimpPred(p, predlist) ==
+  while predlist is [q,:predlist] repeat p := quickAnd(q,p)
+  p
+
+asyCattranSig(op,y) ==
+  y isnt ["->",source,t] =>
+--     ['SIGNATURE, op, asyTypeUnit y]
+-- following makes constants into nullary functions
+     ['SIGNATURE, op, [asyTypeUnit y]]
+  s :=
+    source is ['Comma,:s] => [asyTypeUnit z for z in s]
+    [asyTypeUnit source]
+  t := asyTypeUnit t
+  null t => ['SIGNATURE,op,s]
+  ['SIGNATURE,op,[t,:s]]
+
+asyJoinPart x ==
+  IDENTP x => [x]
+  asytranForm(x,nil,true)
+
+asyCatItem item ==
+  atom item  => [item]
+  item is ['IF,.,.] => [item]
+  [op,:sigs] := item
+  [asyCatSignature(op,sig) for sig in sigs | sig]
+
+asyCatSignature(op,sig) ==
+  sig is ['_-_>,source,target] =>
+     ['SIGNATURE,op, [asyTypeItem target,:asyUnTuple source]]
+  ----------> Constants change <--------------
+--  ['TYPE,op,asyTypeItem sig]
+-- following line converts constants into nullary functions
+  ['SIGNATURE,op,[asyTypeItem sig]]
+
+asyUnTuple x ==
+  x is [op,:u] and asyComma? op => [asyTypeItem y for y in u]
+  [asyTypeItem x]
+
+asyTypeItem x ==
+  atom x =>
+    x = '_%         => '_$
+    x
+  x is ['_-_>,a,b] =>
+      ['Mapping,b,:asyUnTuple a]
+  x is ['Apply,:r] =>
+    r is ['_-_>,a,b] =>
+      ['Mapping,b,:asyUnTuple a]
+    r is ['Record,:parts] =>
+      ['Record,:[[":",a,b] for ['Declare,a,b,:.] in parts]]
+    r is ['Segment,:parts] =>
+      ['Segment,:[asyTypeItem x for x in parts]]
+    asytranApply(x,nil,true)
+  x is ['Declare,.,t,:.] => asyTypeItem t
+  x is ['Comma,:args] =>
+    -- this implies a multiple value return, not currently supported
+    -- in the interpreter
+    args => ['Multi,:[asyTypeItem y for y in args]]
+    ['Void]
+  [asyTypeItem y for y in x]
+
+--============================================================================
+--               Utilities
+--============================================================================
+asyComma? op == MEMQ(op,'(Comma Multi))
+
+
+hput(table,name,value) ==
+  if null name then systemError()
+  HPUT(table,name,value)
+
+--============================================================================
+--               category parts
+--============================================================================
+
+-- this constructs operation information from a category.
+-- NB: This is categoryParts, but with the kind supplied by
+-- an arguments
+asCategoryParts(kind,conform,category,:options) == main where
+  main ==
+    cons? := IFCAR options  --means to include constructors as well
+    $attrlist: local := nil
+    $oplist  : local := nil
+    $conslist: local := nil
+    conname := opOf conform
+    for x in exportsOf(category) repeat build(x,true)
+    $attrlist := listSort(function GLESSEQP,$attrlist)
+    $oplist   := listSort(function GLESSEQP,$oplist)
+    res := [$attrlist,:$oplist]
+    if cons? then res := [listSort(function GLESSEQP,$conslist),:res]
+    if kind = 'category then
+      tvl := TAKE(#rest conform,$TriangleVariableList)
+      res := SUBLISLIS($FormalMapVariableList,tvl,res)
+    res
+  build(item,pred) ==
+    item is ['SIGNATURE,op,sig,:.] => $oplist   := [[opOf op,sig,:pred],:$oplist]
+    --note: opOf is needed!!! Bug in compiler puts in (One) and (Zero)
+    item is ['ATTRIBUTE,attr] =>
+      constructor? opOf attr =>
+        $conslist := [[attr,:pred],:$conslist]
+        nil
+      opOf attr = 'nothing => 'skip
+      $attrlist := [[opOf attr,IFCDR attr,:pred],:$attrlist]
+    item is ['TYPE,op,type] =>
+        $oplist := [[op,[type],:pred],:$oplist]
+    item is ['IF,pred1,s1,s2] =>
+      build(s1,quickAnd(pred,pred1))
+      s2 => build(s2,quickAnd(pred,['NOT,pred1]))
+    item is ['PROGN,:r] => for x in r repeat build(x,pred)
+    item in '(noBranch) => 'ok
+    null item => 'ok
+    systemError '"build error"
+  exportsOf(target) ==
+    target is ['CATEGORY,.,:r] => r
+    target is ['Join,:r,f] =>
+      for x in r repeat $conslist := [[x,:true],:$conslist]
+      exportsOf f
+    $conslist := [[target,:true],:$conslist]
+    nil
+
+--============================================================================
+--               Dead Code (for a very odd value of 'dead')
+--============================================================================
+asyTypeJoinPartExport x ==
+  [op,:items] := x
+  for y in items repeat
+    y isnt ["->",source,t] =>
+--       sig := ['TYPE, op, asyTypeUnit y]
+-- converts constants to nullary functions (this code isn't dead)
+       sig := ['SIGNATURE, op, [asyTypeUnit y]]
+       $opStack := [[sig,:$predlist],:$opStack]
+    s :=
+      source is ['Comma,:s] => [asyTypeUnit z for z in s]
+      [asyTypeUnit source]
+    t := asyTypeUnit t
+    sig :=
+      null t => ['SIGNATURE,op,s]
+      ['SIGNATURE,op,[t,:s]]
+    $opStack := [[sig,:$predlist],:$opStack]
+
+--============================================================================
+--               Code to create opDead Code
+--============================================================================
+asyTypeJoinStack r ==
+  al := [[[x while r is [[x, :q],:s] and p = q and (r := s; true)],:p]
+           while r is [[.,:p],:.]]
+  result := "append"/[fn for [y,:p] in al] where fn ==
+    p => [['IF,asyTypeMakePred p,:y]]
+    y
+  result
+
+asyTypeMakePred [p,:u] ==
+  while u is [q,:u] repeat p := quickAnd(q,p)
+  p
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/astr.boot.pamphlet b/src/interp/astr.boot.pamphlet
new file mode 100644
index 00000000..b8f9eb0b
--- /dev/null
+++ b/src/interp/astr.boot.pamphlet
@@ -0,0 +1,99 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp astr.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Attributed Structures (astr)
+-- For objects which are pairs where the CAR field is either just a tag
+-- (an identifier) or a pair which is the tag and an association list.
+ 
+-- Pick off the tag
+ncTag x ==
+   not PAIRP x => ncBug('S2CB0031,[])
+   x := QCAR x
+   IDENTP x => x
+   not PAIRP x => ncBug('S2CB0031,[])
+   QCAR x
+ 
+-- Pick off the property list
+ncAlist x ==
+   not PAIRP x => ncBug('S2CB0031,[])
+   x := QCAR x
+   IDENTP x => NIL
+   not PAIRP x => ncBug('S2CB0031,[])
+   QCDR x
+
+ --- Get the entry for key k on x's association list
+ncEltQ(x,k) ==
+   r := QASSQ(k,ncAlist x)
+   NULL r => ncBug ('S2CB0007,[k])
+   CDR r
+ 
+-- Put (k . v) on the association list of x and return v
+-- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value
+--        put the pair (k . v) on the association list of x and return v
+-- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values
+--        equivalent to [ncPutQ(x,key,val) for key in k for val in v]
+ncPutQ(x,k,v) ==
+   LISTP k =>
+      for key in k for val in v repeat ncPutQ(x,key,val)
+      v
+   r := QASSQ(k,ncAlist x)
+   if NULL r then
+      r := CONS( CONS(k,v), ncAlist x)
+      RPLACA(x,CONS(ncTag x,r))
+   else
+      RPLACD(r,v)
+   v
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ax.boot.pamphlet b/src/interp/ax.boot.pamphlet
new file mode 100644
index 00000000..2234b1eb
--- /dev/null
+++ b/src/interp/ax.boot.pamphlet
@@ -0,0 +1,428 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp ax.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{New Aldor compiler changes}
+This was changed so the open source version of axiom can work with the new
+aldor compiler.
+This used to read:
+\begin{verbatim}
+  axForm := ['Sequence, ['Import, [], 'AxiomLib], :axForms]
+\end{verbatim}
+but was changed to read:
+<<aldor mod 1>>=
+  axForm := ['Sequence, _
+               ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms]
+@
+\subsection{makeAxExportForm}
+<<makeAxExportForm>>=
+makeAxExportForm(filename, constructors) ==
+  $defaultFlag : local := false
+  $literals := []
+  axForms :=
+     [modemapToAx(modemap) for cname in constructors |
+            (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and
+              (not cname in '(Tuple Exit Type)) and
+                not isDefaultPackageName cname]
+  if $baseForms then
+     axForms := [:$baseForms, :axForms]
+  if $defaultFlag then
+     axForms :=
+        [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms]
+  axForms := APPEND(axDoLiterals(), axForms)
+  axForm := ['Sequence, _
+               ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms]
+  axForm
+
+@
+\subsection{axFormatPref}
+Here we add an else clause. The original code read:
+\begin{verbatim}
+      if name = '$ then name := '%
+\end{verbatim}
+It appears that Aldor allows a richer syntax for [[has]]
+conditions since the call to [[axFormatOp]] appears to allow
+nested IF conditions.OQ
+<<axFormatPred aldor change>>=
+axFormatPred pred ==
+   atom pred => pred
+   [op,:args] := pred
+   op = 'IF => axFormatOp pred
+   op = 'has =>
+      [name,type] := args
+      if name = '$ then name := '%
+      else name := axFormatOp name
+      ftype := axFormatOp type
+      if ftype is ['Declare,:.] then
+           ftype := ['With, [], ftype]
+      ['Test,['Has,name, ftype]]
+   axArglist := [axFormatPred arg for arg in args]
+   op = 'AND => ['And,:axArglist]
+   op = 'OR  => ['Or,:axArglist]
+   op = 'NOT => ['Not,:axArglist]
+   error "unknown predicate"
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+$stripTypes := false
+$pretendFlag := false
+$defaultFlag := false
+$baseForms := nil
+$literals  := nil
+
+spad2AxTranslatorAutoloadOnceTrigger any == true
+
+sourceFilesToAxFile(filename, sourceFiles) ==
+  makeAxFile(filename, MAPCAN('fileConstructors, sourceFiles))
+
+
+$extendedDomains := nil
+
+setExtendedDomains(l) == 
+	$extendedDomains := l
+
+fileConstructors name ==
+   [INTERN(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name]
+
+makeAxFile(filename, constructors) ==
+  $defaultFlag : local := false
+  $literals := []
+  axForms :=
+     [modemapToAx(modemap) for cname in constructors |
+            (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and
+              (not cname in '(Tuple Exit Type)) and
+                not isDefaultPackageName cname]
+  if $baseForms then
+     axForms := [:$baseForms, :axForms]
+  if $defaultFlag then
+     axForms :=
+        [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms]
+  axForms := APPEND(axDoLiterals(), axForms)
+<<aldor mod 1>>
+  st := MAKE_-OUTSTREAM(filename)
+  PPRINT(axForm,st)
+  CLOSE st
+
+<<makeAxExportForm>>
+
+stripType type ==
+  $stripTypes =>
+     categoryForm? type => 'Type
+     type
+  type
+
+modemapToAx(modemap) ==
+  modemap is [[consform, target,:argtypes],.]
+  consform is [constructor,:args]
+  argdecls:=['Comma, : [axFormatDecl(a,stripType t) for a in args for t in argtypes]]
+  resultType :=  axFormatType stripType target
+  categoryForm? constructor =>
+      categoryInfo := GETDATABASE(constructor,'CONSTRUCTORCATEGORY)
+      categoryInfo := SUBLISLIS($FormalMapVariableList, $TriangleVariableList,
+                       categoryInfo)
+      NULL args =>
+          ['Define,['Declare, constructor,'Category],
+               addDefaults(constructor, axFormatType categoryInfo)]
+      ['Define,
+          ['Declare, constructor, ['Apply, "->", optcomma argdecls, 'Category]],
+           ['Lambda, argdecls, 'Category,
+ 	     ['Label, constructor,
+               addDefaults(constructor, axFormatType categoryInfo)]]]
+  constructor in $extendedDomains =>
+     NULL args =>
+        ['Extend, ['Define, ['Declare, constructor, resultType],
+            ['Add, ['PretendTo, ['Add, [], []], resultType], []]]]
+     conscat := INTERN(STRCONC(SYMBOL_-NAME(constructor), "ExtendCategory"),"BOOT")
+     rtype := ['Apply, conscat, :args]
+--     if resultType is ['With,a,b] then
+--        if not(b is ['Sequence,:withseq]) then withseq := [b]
+--        cosigs := rest GETDATABASE(constructor, 'COSIG)
+--        exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p]
+--        resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]]
+     consdef := ['Define,
+        ['Declare, conscat, ['Apply, "->", optcomma argdecls, 'Category]],
+          ['Lambda, argdecls, 'Category, ['Label, conscat, resultType]]]
+     ['Sequence, consdef,
+      ['Extend, ['Define,
+        ['Declare, constructor, ['Apply, "->", optcomma argdecls, rtype]],
+          ['Lambda, argdecls, rtype,
+            ['Label, constructor,
+                ['Add, ['PretendTo, ['Add, [], []], rtype], []]]]]]]
+  NULL args =>
+     ['Export, ['Declare, constructor, resultType],[],[]]
+--  if resultType is ['With,a,b] then
+--     if not(b is ['Sequence,:withseq]) then withseq := [b]
+--     cosigs := rest GETDATABASE(constructor, 'COSIG)
+--     exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p]
+--     resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]]
+  ['Export, ['Declare, constructor, ['Apply, "->", optcomma argdecls, resultType]],[],[]]
+
+optcomma [op,:args] ==
+   # args = 1 => first args
+   [op,:args]
+
+axFormatDecl(sym, type) ==
+   if sym = '$ then sym := '%
+   opOf type in '(StreamAggregate FiniteLinearAggregate) =>
+        ['Declare, sym, 'Type]
+   ['Declare, sym, axFormatType type]
+
+makeTypeSequence l ==
+   ['Sequence,: delete('Type, l)]
+
+axFormatAttrib(typeform) ==
+  atom typeform => typeform
+  axFormatType typeform
+
+axFormatType(typeform) ==
+  atom typeform =>
+     typeform = '$ => '%
+     STRINGP typeform =>
+        ['Apply,'Enumeration, INTERN typeform]
+     INTEGERP typeform =>
+       -- need to test for PositiveInteger vs Integer
+        axAddLiteral('integer, 'PositiveInteger, 'Literal)
+        ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger]
+     FLOATP typeform => ['LitFloat, STRINGIMAGE typeform]
+     MEMQ(typeform,$TriangleVariableList) =>
+        SUBLISLIS($FormalMapVariableList, $TriangleVariableList, typeform)
+     MEMQ(typeform, $FormalMapVariableList) => typeform
+     axAddLiteral('string, 'Symbol, 'Literal)
+     ['RestrictTo, ['LitString, PNAME typeform], 'Symbol]
+  typeform is ['construct,: args] =>
+      axAddLiteral('bracket, ['Apply, 'List, 'Symbol], [ 'Apply, 'Tuple, 'Symbol])
+      axAddLiteral('string, 'Symbol, 'Literal)
+      ['RestrictTo, ['Apply, 'bracket, 
+         		:[axFormatType a for a in args]],
+			  ['Apply, 'List, 'Symbol] ]
+  typeform is [op] =>
+    op = '$ => '%
+    op = 'Void => ['Comma]
+    op
+  typeform is ['local, val] => axFormatType val
+  typeform is ['QUOTE, val] => axFormatType val
+  typeform is ['Join,:cats,lastcat] =>
+      lastcat is ['CATEGORY,type,:ops] =>
+         ['With, [],
+            makeTypeSequence(
+               APPEND([axFormatType c for c in cats],
+               	        [axFormatOp op for op in ops]))]
+      ['With, [], makeTypeSequence([axFormatType c for c in rest typeform])]
+  typeform is ['CATEGORY, type, :ops] =>
+      ['With, [],  axFormatOpList ops]
+  typeform is ['Mapping, target, :argtypes] =>
+      ['Apply, "->",
+               ['Comma, :[axFormatType t for t in argtypes]],
+                axFormatType target]
+  typeform is ['_:, name, type] => axFormatDecl(name,type)
+  typeform is ['Union, :args] =>
+      first args is ['_:,.,.] =>
+         ['Apply, 'Union, :[axFormatType a for a in args]]
+      taglist := []
+      valueCount := 0
+      for x in args repeat
+          tag :=
+            STRINGP x => INTERN x
+            x is ['QUOTE,val] and STRINGP val => INTERN val
+            valueCount := valueCount + 1
+            INTERNL("value", STRINGIMAGE valueCount)
+          taglist := [tag ,: taglist]
+      ['Apply, 'Union, :[axFormatDecl(name,type) for name in reverse taglist
+                                for type in args]]
+  typeform is ['Dictionary,['Record,:args]] =>
+      ['Apply, 'Dictionary,
+          ['PretendTo, axFormatType CADR typeform, 'SetCategory]]
+  typeform is ['FileCategory,xx,['Record,:args]] =>
+      ['Apply, 'FileCategory, axFormatType xx,
+          ['PretendTo, axFormatType CADDR typeform, 'SetCategory]]
+  typeform is [op,:args] =>
+      $pretendFlag and constructor? op and
+        GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,:argtypes],.] =>
+          ['Apply, op,
+               :[['PretendTo, axFormatType a, axFormatType t]
+                     for a in args for t in argtypes]]
+      MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct
+         DirectProductCategory RadixExpansion)) and
+            GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,arg1type,:restargs],.] =>
+               ['Apply, op,
+                  ['PretendTo, axFormatType first args, axFormatType arg1type],
+                     :[axFormatType a for a in rest args]]
+      ['Apply, op, :[axFormatType a for a in args]]
+  error "unknown entry type"
+
+axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]]
+
+axOpTran(name) ==
+   ATOM name =>
+      name = 'elt => 'apply
+      name = 'setelt => 'set!
+      name = 'SEGMENT => ".."
+      name = 1 => '_1
+      name = 0 => '_0
+      name
+   opOf name = 'Zero => '_0
+   opOf name = 'One => '_1
+   error "bad op name"
+
+axFormatOpSig(name, [result,:argtypes]) ==
+   ['Declare, axOpTran name,
+         ['Apply, "->", ['Comma, :[axFormatType t for t in argtypes]],
+                        axFormatType result]]
+
+axFormatConstantOp(name, [result]) ==
+   ['Declare, axOpTran name, axFormatType result]
+
+<<axFormatPred aldor change>>
+
+axFormatCondOp op ==
+  $pretendFlag:local := true
+  axFormatOp op
+
+
+axFormatOp op ==
+   op is ['IF, pred, trueops, falseops] =>
+      NULL(trueops) or trueops='noBranch =>
+         ['If, ['Test,['Not, axFormatPred pred]],
+              axFormatCondOp falseops,
+                axFormatCondOp trueops]
+      ['If, axFormatPred pred,
+             axFormatCondOp trueops,
+              axFormatCondOp falseops]
+       -- ops are either single op or ['PROGN, ops]
+   op is ['SIGNATURE, name, type] => axFormatOpSig(name,type)
+   op is ['SIGNATURE, name, type, 'constant] =>
+            axFormatConstantOp(name,type)
+   op is ['ATTRIBUTE, attributeOrCategory] =>
+       categoryForm? attributeOrCategory =>
+           axFormatType attributeOrCategory
+       ['RestrictTo, axFormatAttrib attributeOrCategory, 'Category]
+   op is ['PROGN, :ops] => axFormatOpList ops
+   op is 'noBranch => []
+   axFormatType op
+
+addDefaults(catname, withform) ==
+  withform isnt ['With, joins, ['Sequence,: oplist]] =>
+     error "bad category body"
+  null(defaults := getDefaultingOps catname) => withform
+  defaultdefs := [makeDefaultDef(decl) for decl in defaults]
+  ['With, joins,
+     ['Sequence, :oplist, ['Default, ['Sequence,: defaultdefs]]]]
+
+makeDefaultDef(decl) ==
+  decl isnt ['Declare, op, type] =>
+       error "bad default definition"
+  $defaultFlag := true
+  type is ['Apply, "->", args, result] =>
+       ['Define, decl, ['Lambda, makeDefaultArgs args, result,
+                    ['Label, op, 'dummyDefault]]]
+  ['Define, ['Declare, op, type], 'dummyDefault]
+
+makeDefaultArgs args ==
+  args isnt ['Comma,:argl] => error "bad default argument list"
+  ['Comma,: [['Declare,v,t] for v in $TriangleVariableList for t in argl]]
+
+getDefaultingOps catname ==
+  not(name:=hasDefaultPackage catname) => nil
+  $infovec: local := getInfovec name
+  opTable := $infovec.1
+  $opList:local  := nil
+  for i in 0..MAXINDEX opTable repeat
+    op := opTable.i
+    i := i + 1
+    startIndex := opTable.i
+    stopIndex :=
+      i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector()
+      opTable.(i + 2)
+    curIndex := startIndex
+    while curIndex < stopIndex repeat
+      curIndex := get1defaultOp(op,curIndex)
+  $pretendFlag : local := true
+  catops := GETDATABASE(catname, 'OPERATIONALIST)
+  [axFormatDefaultOpSig(op,sig,catops) for opsig in $opList | opsig is [op,sig]]
+
+axFormatDefaultOpSig(op, sig, catops) ==
+  #sig > 1 => axFormatOpSig(op,sig)
+  nsig := MSUBST('$,'($), sig) -- dcSig listifies '$ ??
+  (catsigs := LASSOC(op, catops)) and
+    (catsig := assoc(nsig, catsigs)) and last(catsig) = 'CONST =>
+       axFormatConstantOp(op, sig)
+  axFormatOpSig(op,sig)
+
+get1defaultOp(op,index) ==
+  numvec := getCodeVector()
+  segment := getOpSegment index
+  numOfArgs := numvec.index
+  index := index + 1
+  predNumber := numvec.index
+  index := index + 1
+  signumList :=
+ -- following substitution fixes the problem that default packages
+ -- have $ added as a first arg, thus other arg counts are off by 1.
+    SUBLISLIS($FormalMapVariableList, rest $FormalMapVariableList,
+             dcSig(numvec,index,numOfArgs))
+  index := index + numOfArgs + 1
+  slotNumber := numvec.index
+  if not([op,signumList] in $opList) then
+     $opList := [[op,signumList],:$opList]
+  index + 1
+
+axAddLiteral(name, type, dom) == 
+  elt := [name, type, dom]
+  if not member( elt, $literals) then
+     $literals := [elt, :$literals]
+
+axDoLiterals() == 
+  [ [ 'Import,
+	  [ 'With, [], 
+ 	    ['Declare, name, [ 'Apply, '_-_> , dom , '_% ]]],
+		 type ] for [name, type, dom] in $literals]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/axext_l.lisp.pamphlet b/src/interp/axext_l.lisp.pamphlet
new file mode 100644
index 00000000..3d03127c
--- /dev/null
+++ b/src/interp/axext_l.lisp.pamphlet
@@ -0,0 +1,230 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/axext\_l.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;; File containing primitives needed by exextend in order to interop with axiom
+;; This file could do with some declares
+
+(in-package "FOAM-USER")
+
+;; tacky but means we can run programs
+
+(defun H-integer (l e)
+  (|AXL-LiteralToInteger| l))
+	
+(defun  H-string (l e)
+  (|AXL-LiteralToString| l))
+
+(defun  H-error (l e)
+  (|AXL-error| l))
+
+(eval-when (load eval)
+	   (defconstant |G-axclique_string_305639517| (cons #'H-String nil))
+	   (defconstant |G-axclique_integer_685864888| (cons #'H-integer nil))
+	   (defconstant |G-axclique_error_011667951| (cons #'H-error nil)))
+
+;; Literals should be null-terminated strings
+
+;; SingleInteger
+
+(defmacro |AXL-LiteralToSingleInteger| (l)
+  `(parse-integer ,l :junk-allowed t))
+
+(defmacro |AXL-LiteralToInteger| (l)
+  `(parse-integer ,l :junk-allowed t))
+
+(defmacro |AXL-LiteralToDoubleFloat| (l)
+  `(read-from-string ,l nil (|DFlo0|)
+		     :preserve-whitespace t))
+
+(defmacro |AXL-LiteralToString| (l)
+  `(subseq ,l 0 (- (length ,l) 1)))
+
+(defmacro |AXL-SingleIntegerToInteger| (si)
+  `(coerce (the |SInt| ,si) |BInt|))
+
+(defmacro |AXL-StringToFloat| (s)
+  `(boot::|string2Float| ,s))
+
+(defmacro |AXL-IntegerIsNonNegative| (i)
+  `(not (< ,i 0)))
+
+(defmacro |AXL-IntegerIsPositive| (i)
+  `(< 0 (the |BInt| ,i)))
+
+(defmacro |AXL-plusInteger| (a b)
+  `(the |BInt| (+ (the |BInt| ,a)
+		  (the |BInt| ,b))))
+
+(defmacro |AXL-minusInteger| (a b)
+  `(the |BInt| (- (the |BInt| ,a)
+		  (the |BInt| ,b))))
+
+(defmacro |AXL-timesInteger| (a b)
+  `(the |BInt| (* (the |BInt| ,a)
+		  (the |BInt| ,b))))
+
+(defmacro |AXL-eqInteger| (a b)
+  `(= (the |BInt| ,a)
+      (the |BInt| ,b)))
+
+(defmacro |AXL-ltInteger| (a b)
+  `(< (the |BInt| ,a)
+      (the |BInt| ,b)))
+
+(defmacro |AXL-leInteger| (a b)
+  `(<= (the |BInt| ,a)
+       (the |BInt| ,b)))
+
+(defmacro |AXL-gtInteger| (a b)
+  `(> (the |BInt| ,a)
+      (the |BInt| ,b)))
+
+(defmacro |AXL-geInteger| (a b)
+  `(>= (the |BInt| ,a)
+       (the |BInt| ,b)))
+
+(defmacro |AXL-plusSingleInteger| (a b)
+  `(the |SInt| (+ (the |SInt| ,a)
+		  (the |SInt| ,b))))
+
+(defmacro |AXL-minusSingleInteger| (a b)
+  `(the |SInt| (- (the |SInt| ,a)
+		  (the |SInt| ,b))))
+
+(defmacro |AXL-timesSingleInteger| (a b)
+  `(the |SInt| (* (the |SInt| ,a)
+		  (the |SInt| ,b))))
+
+(defmacro |AXL-eqSingleInteger| (a b)
+  `(= (the |SInt| ,a)
+      (the |SInt| ,b)))
+
+(defmacro |AXL-ltSingleInteger| (a b)
+  `(< (the |SInt| ,a)
+      (the |SInt| ,b)))
+
+(defmacro |AXL-leSingleInteger| (a b)
+  `(<= (the |SInt| ,a)
+       (the |SInt| ,b)))
+
+(defmacro |AXL-gtSingleInteger| (a b)
+  `(> (the |SInt| ,a)
+      (the |SInt| ,b)))
+
+(defmacro |AXL-geSingleInteger| (a b)
+  `(>= (the |SInt| ,a)
+       (the |SInt| ,b)))
+
+(defmacro |AXL-incSingleInteger| (i)
+  `(the |SInt| (+ (the |SInt| ,i) 1)))
+
+(defmacro |AXL-decSingleInteger| (i)
+  `(- (the |SInt| ,i)
+     (the |SInt| 1)))
+
+(defmacro |AXL-onefnSingleInteger|  () '(the |SInt| 1))
+(defmacro |AXL-zerofnSingleInteger| () '(the |SInt| 0))
+
+(defmacro |AXL-cons| (x y)
+  `(cons ,x ,y))
+
+(defmacro |AXL-nilfn| () nil)
+
+(defmacro |AXL-car| (x) `(car ,x))
+
+(defmacro |AXL-cdr| (x) `(cdr ,x))
+
+(defmacro |AXL-null?| (x) `(null ,x))
+
+(defmacro |AXL-rplaca| (x y) `(rplaca ,x ,y))
+
+(defmacro |AXL-rplacd| (x y) `(rplacd ,x ,y))
+
+(defmacro |AXL-error| (msg) `(error ,msg))
+  
+;; arrays
+;; 0 based!
+(defmacro |AXL-arrayRef| (arr i)
+  `(|AElt| ,arr ,i))
+
+(defmacro |AXL-arraySet| (arr i v)
+  `(setf (|AElt| ,arr ,i) ,v))
+
+(defmacro |AXL-arrayToList| (x)
+  `(coerce ,x 'list))
+
+(defmacro |AXL-arraySize| (x)
+  `(length ,x))
+
+(defmacro |AXL-arrayNew| (n)
+  `(make-array ,n))
+
+(defmacro |AXL-arrayCopy| (x)
+  `(copy-seq ,x))
+
+;; Vectors
+
+
+;; Testing
+
+(defun |AXL-spitSInt| (x)
+  (print x))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bc-matrix.boot.pamphlet b/src/interp/bc-matrix.boot.pamphlet
new file mode 100644
index 00000000..008722a6
--- /dev/null
+++ b/src/interp/bc-matrix.boot.pamphlet
@@ -0,0 +1,175 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp bc-matrix.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- Basic Command matrix entry
+
+bcMatrix() ==  bcReadMatrix nil
+  
+bcReadMatrix exitFunctionOrNil ==
+  page := htInitPage('"Matrix Basic Command", nil)
+  htpSetProperty(page,'exitFunction,exitFunctionOrNil)
+  htMakePage 
+   '((domainConditions 
+     (isDomain PI (PositiveInteger)))  
+    (text . "Enter the size of the matrix:")
+    (inputStrings
+     ("Number of {\em rows}:\space{3}" "" 5 2 rows PI)
+     ("Number of {\em columns}: " "" 5 2 cols PI))
+    (text . "\blankline ")
+    (text . "How would you like to enter the matrix?")
+    (text . "\beginmenu")
+    (text . "\item ")
+    (bcLinks ("\menuitemstyle{By entering individual entries}" "" bcInputExplicitMatrix  explicit))
+    (text . "\item ")
+    (bcLinks ("\menuitemstyle{By formula}" "" bcInputMatrixByFormula formula))
+    (text . "\endmenu"))
+  htShowPage()
+
+bcInputMatrixByFormula(htPage,junk) ==
+  page := htInitPage('"Basic Matrix Command", htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions
+      (isDomain S (Symbol))
+      (isDomain FE (Expression (Integer))))
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em row variable}: ")
+    (text . "\tab{36}")
+    (bcStrings (6 i rowVar S))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em column variable}: ")
+    (text . "\tab{36}")
+    (bcStrings (6 j colVar S))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text .  "Enter the general {\em formula} for the entries:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (40 "1/(x - i - j - 1)" formula FE)))
+  htMakeDoneButton('"Continue", 'bcInputMatrixByFormulaGen)
+  nrows := 
+    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows)
+    PARSE_-INTEGER htpLabelInputString(htPage,'rows)
+  ncols := 
+    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols)
+    PARSE_-INTEGER htpLabelInputString(htPage,'cols)
+  htpSetProperty(page, 'nrows, nrows)
+  htpSetProperty(page, 'ncols, ncols)
+  htShowPage()
+
+bcInputMatrixByFormulaGen htPage ==
+  fun :=  htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage)
+  formula := htpLabelInputString(htPage,'formula)
+  rowVar := htpLabelInputString(htPage,'rowVar)
+  colVar := htpLabelInputString(htPage,'colVar)
+  nrows := htpProperty(htPage,'nrows)
+  ncols := htpProperty(htPage,'ncols)
+  bcGen STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..",
+    STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])")
+
+bcInputExplicitMatrix(htPage,junk) ==
+  nrows := 
+    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows)
+    PARSE_-INTEGER htpLabelInputString(htPage,'rows)
+  ncols := 
+    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols)
+    PARSE_-INTEGER htpLabelInputString(htPage,'cols)
+  cond := nil
+  k := 0
+  wrows := # STRINGIMAGE nrows
+  wcols := # STRINGIMAGE ncols
+  labelList := 
+    "append"/[[f for j in 1..ncols] for i in 1..nrows] where f ==
+      rowpart := STRCONC('"{\em Row",htStringPad(i,wrows))
+      colpart := STRCONC('", Column",htStringPad(j,wcols),'":}\space{2}")
+      prefix := STRCONC(rowpart,colpart)
+ --     name := INTERN STRCONC(htMkName('"row",i),htMkName('"col",j))
+      name := INTERN STRINGIMAGE (k := k + 1)
+      [prefix,'"",30, 0,name,'P]
+  labelList := 
+    [['domainConditions, '(isDomain P (Polynomial $EmptyMode)), cond],
+     ['inputStrings, :labelList] ]
+  page := htInitPage('"Solve Basic Command", htpPropertyList htPage)
+  bcHt '"Enter the entries of the matrix:"
+  htMakePage labelList
+  htMakeDoneButton('"Continue", 'bcGenExplicitMatrix)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'ncols,ncols)
+  htShowPage()
+
+bcGenExplicitMatrix htPage == 
+  htpSetProperty(htPage,'matrix,htpInputAreaAlist htPage)
+  fun :=  htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage)
+  bcGen bcMatrixGen htPage
+
+bcMatrixGen htPage ==
+  nrows := htpProperty(htPage,'nrows)
+  ncols := htpProperty(htPage,'ncols)
+  mat := htpProperty(htPage,'matrix)
+  formula := LASSOC('formula,mat) =>
+    formula := formula.0
+    rowVar := LASSOC('rowVar,mat).0
+    colVar := LASSOC('colVar,mat).0
+    STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..",
+      STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])")
+  mat := htpProperty(htPage,'matrix) =>
+    mat := REVERSE mat
+    k := -1
+    matform := [[mat.(k := k + 1).1
+      for j in 0..(ncols-1)] for i in 0..(nrows-1)]
+    matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+    STRCONC('"matrix(",matstring,'")")
+  systemError nil
+  
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bc-misc.boot.pamphlet b/src/interp/bc-misc.boot.pamphlet
new file mode 100644
index 00000000..8e879add
--- /dev/null
+++ b/src/interp/bc-misc.boot.pamphlet
@@ -0,0 +1,946 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp bc-misc.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--Hypertex commands other than solve and matrix
+
+bcDrawIt2(ind,a,b) == STRCONC('"{}",ind,'"=",a,'"{}..",b,'"{}")
+
+bcIndefiniteIntegrate() ==
+  htInitPage("Indefinite Integration Basic Command",nil)
+  htMakePage '(
+     (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "Enter the {\em function} you would like to integrate:")
+     (text . "\newline\tab{2} ")
+     (bcStrings (45 "1/(x**2 + 6)" integrand EM))
+     (text . "\blankline")
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "Enter the {\em variable of integration}:")
+     (text . "\tab{37}")
+     (bcStrings (10 x symbol SY))
+     (doneButton "Continue" bcIndefiniteIntegrateGen))
+  htShowPage()
+
+bcIndefiniteIntegrateGen htPage ==
+  integrand := htpLabelInputString(htPage,'integrand)
+  var := htpLabelInputString(htPage,'symbol)
+  bcGen STRCONC('"integrate(",integrand,'",",var,")")
+
+
+bcDefiniteIntegrate() ==
+  htInitPage("Definite Integration Basic Command",nil)
+  htMakePage '(
+     (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "Enter the {\em function} you would like to integrate:")
+     (text . "\newline\tab{2} ")
+     (bcStrings (45 "1/(x**2 + 6)" integrand EM))
+     (text . "\blankline")
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "Enter the {\em variable of integration}:")
+     (text . "\tab{37}")
+     (bcStrings (10 x symbol SY))
+     (text . "\blankline")
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "\newline Enter {\em lower limit}:")
+     (radioButtons fromButton
+       ("" "Minus infinity" minusInfinity)
+       (""  (
+         (text . "A finite point:\tab{15}")
+         (bcStrings (10 0 from EM . bcOptional))) fromPoint))
+     (text . "\blankline")
+     (text . "\newline ")
+     (text . "\menuitemstyle{}\tab{2}")
+     (text . "\indent{2}\newline Enter {\em upper limit}:")
+     (radioButtons toButton
+       ("" "Plus infinity" plusInfinity)
+       ("" (
+         (text "A finite point:\tab{15}")
+         (bcStrings (10 y to EM . bcOptional))) toPoint))
+     (doneButton "Continue" bcDefiniteIntegrateGen))
+  htShowPage()
+
+bcDefiniteIntegrateGen htPage ==
+  integrand := htpLabelInputString(htPage,'integrand)
+  var := htpLabelInputString(htPage,'symbol)
+  lowerLimit :=
+    htpButtonValue(htPage,'fromButton) = 'fromPoint =>
+      htpLabelInputString(htPage,'from)
+    '"%minusInfinity"
+  upperLimit :=
+    htpButtonValue(htPage,'toButton) = 'toPoint =>
+      htpLabelInputString(htPage,'to)
+    '"%plusInfinity"
+  varpart := STRCONC(var,'" = ",lowerLimit,'"..",upperLimit)
+  bcGen
+   STRCONC('"integrate(",integrand,'",",varpart,'")")
+
+bcSum() ==
+  htInitPage("Sum Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em function} you would like to sum:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (44 "i**3" summand EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em summation index}:")
+    (text . "\tab{36}")
+    (bcStrings (10 i index SY))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the limits of the sum:")
+    (text . "\newline\tab{10}{\em From:}")
+    (bcStrings (10 1 first S))
+    (text . "\tab{32}{\em To:}")
+    (text . "\tab{36}")
+    (bcStrings (10  n  last S))
+    (doneButton "Continue" bcSumGen))
+  htShowPage()
+
+bcSumGen htPage ==
+  mand := htpLabelInputString(htPage,'summand)
+  index := htpLabelInputString(htPage,'index)
+  first := htpLabelInputString(htPage,'first)
+  last := htpLabelInputString(htPage,'last)
+  bcGen STRCONC('"sum(",mand,'",",index,'" = ",first,'"..",last,'")")
+
+bcProduct() ==
+  htInitPage("Product Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+    (text . "Enter the {\em function} you would like to compute the product of:")
+    (inputStrings ("" "" 45 "i**2" mand EM))
+    (text . "\vspace{1}\newline")
+    (inputStrings ("Enter the {\em index of the product}:" "" 5 i index SY))
+    (text . "\vspace{1}\newline Enter the limits of the index:")
+    (inputStrings
+      ("\newline{\em From:}" "" 10 "1" first  EM)
+      ("{\em To:}\space{2}" "" 10  "n" last   EM))
+    (doneButton "Continue" bcProductGen))
+  htShowPage()
+
+bcProductGen htPage ==
+  mand := htpLabelInputString(htPage,'mand)
+  index := htpLabelInputString(htPage,'index)
+  first := htpLabelInputString(htPage,'first)
+  last := htpLabelInputString(htPage,'last)
+  bcGen STRCONC('"product(",mand,'",",index,'",",first,'",",last,'")")
+
+bcDifferentiate() ==
+  htInitPage("Differentiate Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em function} you want to differentiate:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "sin(x*y)" diffand EM))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline List the {\em variables} you want to differentiate with respect to?")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "x y" variables S . quoteString))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline List the number of {\em times} you want to differentiate with respect to each variable (leave blank if once for each)")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "1 2" times S . quoteString)))
+  htMakeDoneButton('"Continue", 'bcDifferentiateGen)
+  htShowPage()
+
+bcDifferentiateGen htPage ==
+  mand := htpLabelInputString(htPage,'diffand)
+  varlist := bcString2WordList htpLabelInputString(htPage,'variables)
+  indexList := bcString2WordList htpLabelInputString(htPage,'times)
+  varpart :=
+    #varlist > 1 => bcwords2liststring varlist
+    first varlist
+  indexpart :=
+    null indexList => nil
+    null rest indexList => first indexList
+    #indexList = #varlist => bcwords2liststring indexList
+    bcError '"You must say how many times you want to differentiate with respect to each variable---or leave that entry blank"
+  lastPart :=
+    indexpart => STRCONC('",",indexpart,'")")
+    '")"
+  bcGen STRCONC('"differentiate(",mand,'",",varpart,lastPart)
+
+bcDraw() ==
+  htInitPage('"Draw Basic Command",nil)
+  bcHt '"What would you like to draw?"
+  bcHt '"\newline\centerline{{\em Two Dimensional Plots}}\newline"
+  bcHt '"\lispdownlink{A function of one variable}{(|bcDraw2Dfun|)}"
+  bcHt '"\space{2}y = f(x)\newline"
+  bcHt '"\lispdownlink{A parametrically defined curve}{(|bcDraw2Dpar|)}"
+  bcHt '"\space{2}(x(t), y(t))\newline"
+  bcHt '"\lispdownlink{A solution to a polynomial equation}{(|bcDraw2DSolve|)}"
+  bcHt '"\space{2} p(x,y) = 0\newline"
+  bcHt '"\vspace{1}\newline "
+  bcHt '"\centerline{{\em Three Dimensional Surfaces}}\newline\newline"
+  bcHt '"\lispdownlink{A function of two variables}{(|bcDraw3Dfun|)}"
+  bcHt '"\space{2} z = f(x,y)\newline"
+  bcHt '"\lispdownlink{A parametrically defined tube}{(|bcDraw3Dpar|)}"
+  bcHt '"\space{2}(x(t), y(t), z(t))\newline"
+  bcHt '"\lispdownlink{A parameterically defined surface}{(|bcDraw3Dpar1|)}"
+  bcHt '"\space{2}(x(u,v), y(u,v), z(u,v))\newline"
+  htShowPage()
+
+
+bcDraw2Dfun() ==
+  htInitPage('"Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Drawing {\em y = f(x)}}\newline "
+      "\centerline{where {\em y} is the dependent variable and}\newline "
+      "\centerline{where {\em x} is the independent variable}\vspace{1}\newline "
+      "\menuitemstyle{}\tab{2}What {\em function} f would you like to draw?\newline\tab{2}")
+    (bcStrings (55 "x*cos(x)" function EM))
+    (text . "\vspace{1}\newline\menuitemstyle{}\tab{2}Enter {\em dependent} variable:")
+    (bcStrings (6 y dependent SY))
+    (text . "\newline\vspace{1}\newline ")
+    (text . "\menuitemstyle{}\tab{2}Enter {\em independent} variable and {\em range}:\newline\tab{2} ")
+    (text . "{\em Variable:}")
+    (bcStrings (6 x ind SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 0 from1 F))
+    (text . "{\em to:}")
+    (bcStrings (9 30 to1 F))
+    (text
+      "\indent{0}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "Optionally enter a {\em title} for your curve:"
+      )
+    (bcStrings (15 "y = x*cos(x)" title S))
+    (text . "\indent{0}")
+    (doneButton "Continue" bcDraw2DfunGen)
+    (text . "{}"))
+  htShowPage()
+
+bcDraw2DfunGen htPage ==
+  fun := htpLabelInputString(htPage,'function)
+  dep := htpLabelInputString(htPage,'dependent)
+  ind := htpLabelInputString(htPage,'ind)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  title := htpLabelInputString(htPage,'title)
+  if (title ^= '"") then
+    titlePart := STRCONC('"{}",'"title ==_"",title,'"_"")
+    bcFinish('"draw",fun,bcDrawIt2(ind,from1,to1),titlePart)
+  else
+    bcFinish('"draw",fun,bcDrawIt2(ind,from1,to1))
+
+
+bcDraw2Dpar() ==
+  htInitPage('"Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Drawing a parametrically defined curve:}\newline "
+      "\centerline{{\em ( f1(t), f2(t) )}}\newline "
+      "\centerline{in terms of two functions {\em f1} and {\em f2}}"
+      "\centerline{and an independent variable {\em t}}\vspace{1}\newline"
+      "\menuitemstyle{}\tab{2}Enter the two {\em functions:}")
+    (text . "\newline\tab{2}{\em Function 1:}")
+    (bcStrings (44 "-9*sin(4*t/5)" function1 EM))
+    (text . "\newline\tab{2}{\em Function 2:}")
+    (bcStrings (44 "8*sin(t)" function2 EM))
+    (text ."\vspace{1}\newline\menuitemstyle{}\tab{2}Enter {\em independent} variable and range:\newline\tab{2} ")
+    (text . "{\em Variable:}")
+    (bcStrings (6 t ind SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 "-5*\%pi" from1 F))
+    (text . "{\em to:}")
+    (bcStrings (9 "5*\%pi" to1 F))
+    (text
+      "\vspace{1}\newline\menuitemstyle{}\tab{2}"
+      "Optionally enter a {\em title} for your curve:")
+    (bcStrings (15 "Lissajous" title S))
+    (text . "\indent{0}")
+    (doneButton "Continue" bcDraw2DparGen))
+  htShowPage()
+
+bcDraw2DparGen htPage ==
+  fun1 := htpLabelInputString(htPage,'function1)
+  fun2 := htpLabelInputString(htPage,'function2)
+  ind := htpLabelInputString(htPage,'ind)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  title := htpLabelInputString(htPage,'title)
+  curvePart := STRCONC('"curve(",'"{}",fun1,'",{}",fun2,'")")
+  if (title ^= '"") then
+    titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_""))
+    bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),titlePart)
+  else
+    bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1))
+
+bcDraw2DSolve() ==
+  htInitPage('"Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Plotting the solution to {\em p(x,y) = 0}, where} "
+      "\centerline{{\em p} is a polynomial in two variables {\em x} and {\em y}}"
+      "\vspace{1}\newline\menuitemstyle{}\tab{2}Enter the {\em polynomial} p:"
+      "\newline\tab{2}")
+    (bcStrings (40 "y**2+7*x*y-(x**3+16*x)" function EM))
+    (text . "\vspace{1}\newline\menuitemstyle{}\tab{2}Enter the {\em variables}:")
+    (text . "\newline\tab{2}{\em Variable 1:} ")
+    (bcStrings (4 x independent1 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 -15 from1 F))
+    (text . "{\em to:}")
+    (bcStrings (9 10 to1 F))
+    (text . "\newline\tab{2}{\em Variable 2:} ")
+    (bcStrings (4 y independent2 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 -10 from2 F))
+    (text . "{\em to:}")
+    (bcStrings (9 50 to2 F))
+    (text
+      "\indent{0}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "Optionally enter a {\em title} for your curve:")
+    (bcStrings (15 "" title S))
+    (text . "\indent{0}"))
+  htMakeDoneButton('"Continue",'bcDraw2DSolveGen)
+  htShowPage()
+
+bcDraw2DSolveGen htPage ==
+  fun := htpLabelInputString(htPage,'function)
+  ind1 := htpLabelInputString(htPage,'independent1)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  ind2 := htpLabelInputString(htPage,'independent2)
+  from2 := htpLabelInputString(htPage,'from2)
+  to2 := htpLabelInputString(htPage,'to2)
+  title := htpLabelInputString(htPage,'title)
+  clipPart := STRCONC('"{}",'"range==[{}",from1,'"..",to1,",{}",from2,'"..",to2,'"]")
+  if (title ^= '"") then
+    titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_""))
+    bcFinish('"draw",STRCONC(fun,'" = 0 "),ind1,ind2,clipPart,titlePart)
+  else
+    bcFinish('"draw",STRCONC(fun,'" = 0 "),ind1,ind2,clipPart)
+
+bcDraw3Dfun() ==
+  htInitPage('"Three Dimensional Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Drawing {\em z = f(x,y)}}\newline "
+      "\centerline{where {\em z} is the dependent variable and}\newline "
+      "\centerline{where {\em x, y} are the independent variables}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "What {\em function} f which you like to draw?\newline\tab{2}")
+    (bcStrings (55 "exp(cos(x-y)-sin(x*y))-2" function EM))
+    (text . "\newline\menuitemstyle{}\tab{2}Enter {\em dependent} variable:")
+    (bcStrings (6 z dependent SY))
+    (text
+      "\vspace{1}\newline\menuitemstyle{}\tab{2}"
+      "Enter {\em independent} variables and ranges:\newline\tab{2} "
+      "{\em Variable:}")
+    (bcStrings (6 x independent1 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 -5 from1 F))
+    (text . "{\em to:}")
+    (bcStrings (9 5 to1 F))
+    (text . "\newline\tab{2}{\em Variable:}")
+    (bcStrings (6 y independent2 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 -5 from2 F))
+    (text . "{\em to:}")
+    (bcStrings (9 5 to2 F))
+    (text
+      "\indent{0}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "Optionally enter a {\em title} for your surface:")
+    (bcStrings (15 "" title S))
+    (text . "\indent{0}")
+    (doneButton "Continue" bcDraw3DfunGen))
+  htShowPage()
+
+bcDraw3DfunGen htPage ==
+  fun := htpLabelInputString(htPage,'function)
+  dep := htpLabelInputString(htPage,'dependent)
+  ind1 := htpLabelInputString(htPage,'independent1)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  ind2 := htpLabelInputString(htPage,'independent2)
+  from2 := htpLabelInputString(htPage,'from2)
+  to2 := htpLabelInputString(htPage,'to2)
+  title := htpLabelInputString(htPage,'title)
+  if (title ^= '"") then
+    titlePart := (title = '"" => nil;STRCONC('"{}",'"title ==_"",title,'"_""))
+    bcFinish('"draw",fun,bcDrawIt2(ind1,from1,to1),bcDrawIt2(ind2,from2,to2),titlePart)
+  else
+    bcFinish('"draw",fun,bcDrawIt2(ind1,from1,to1),bcDrawIt2(ind2,from2,to2))
+
+bcDraw3Dpar() ==
+  htInitPage('"Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Drawing a parametrically defined curve:"
+      "{\em ( f1(t), f2(t), f3(t) )}}\newline "
+      "\centerline{in terms of three functions {\em f1}, {\em f2}, and {\em f3}}\newline "
+      "\centerline{and an independent variable {\em t}}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "Enter the three {\em functions} of the independent variable:")
+    (text . "\newline\tab{2}{\em Function f1:}")
+    (bcStrings (42 "1.3*cos(2*t)*cos(4*t) + sin(4*t)*cos(t)" function1 EM))
+    (text . "\newline\tab{2}{\em Function f2:}")
+    (bcStrings  (42 "1.3*sin(2*t)*cos(4*t) - sin(4*t)*sin(t)" function2 EM))
+    (text . "\newline\tab{2}{\em Function f3:}")
+    (bcStrings  (42 "2.5*cos(4*t)" function3 EM))
+    (text ."\vspace{1}\newline\menuitemstyle{}\tab{2}Enter {\em independent} variable and range:\newline\tab{2} ")
+    (text ."{\em Variable:}")
+    (bcStrings (6 t ind SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 0 from1 F))
+    (text "{\em to:}")
+    (bcStrings (9 "4*\%pi" to1 F))
+    (text
+      "\indent{0}\vspace{1}\newline\menuitemstyle{}\tab{2} "
+      "Optionally enter a {\em title} for your surface:")
+    (bcStrings (15 "knot" title S))
+    (text . "\indent{0}")
+    (doneButton "Continue" bcDraw3DparGen))
+  htShowPage()
+
+bcDraw3DparGen htPage ==
+  fun1 := htpLabelInputString(htPage,'function1)
+  fun2 := htpLabelInputString(htPage,'function2)
+  fun3 := htpLabelInputString(htPage,'function3)
+  ind := htpLabelInputString(htPage,'ind)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  title := htpLabelInputString(htPage,'title)
+  curvePart := STRCONC('"curve(",'"{}",fun1,'",{}",fun2,'",{}",fun3,'")")
+  tubePart := '"{}tubeRadius==.25,{}tubePoints==16"
+  if (title ^= '"") then
+    titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_""))
+    bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),tubePart,titlePart)
+  else
+    bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),tubePart)
+
+bcDraw3Dpar1() ==
+  htInitPage('"Draw Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text
+      "\centerline{Drawing a parametrically defined surface:}\newline "
+      "\centerline{{\em ( f1(u,v), f2(u,v), f3(u,v) )}}\newline "
+      "\centerline{in terms of three functions {\em f1}, {\em f2}, and {\em f3}}\newline "
+      "\centerline{and two independent variables {\em u} and {\em v}}\vspace{1}\newline\menuitemstyle{}\tab{2}"
+      "Enter the three {\em functions} of the independent variables:")
+    (text . "\newline\tab{2}")
+    (text . "{\em Function f1:}")
+    (bcStrings (43 "u*sin(v)" function1 EM))
+    (text . "\newline\tab{2}")
+    (text . "{\em Function f2:}")
+    (bcStrings (43 "v*cos(u)" function2 EM))
+    (text . "\newline\tab{2}")
+    (text . "{\em Function f3:}")
+    (bcStrings (43 "u*cos(v)" function3 EM))
+    (text . "\newline\menuitemstyle{}\tab{2}Enter independent {\em variables} and ranges:")
+    (text . "\newline\tab{2}")
+    (text . "{\em Variable 1:}")
+    (bcStrings (5 u ind1 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 "-\%pi" from1 F))
+    (text . "{\em to:}")
+    (bcStrings (9 "\%pi" to1 F))
+    (text . "\newline\tab{2}")
+    (text . "{\em Variable 2:}")
+    (bcStrings (5 v ind2 SY))
+    (text . "ranges {\em from:}")
+    (bcStrings (9 "-\%pi/2" from2 F))
+    (text . "{\em to:}")
+    (bcStrings (9 "\%pi/2" to2 F))
+    (text
+      "\indent{0}\newline\menuitemstyle{}\tab{2} "
+      "Optionally enter a {\em title} for your surface:")
+    (bcStrings (15 "surface" title S))
+    (text . "\indent{0}"))
+  htMakeDoneButton ('"Continue",'bcDraw3Dpar1Gen)
+  htShowPage()
+
+bcDraw3Dpar1Gen htPage ==
+  fun1 := htpLabelInputString(htPage,'function1)
+  fun2 := htpLabelInputString(htPage,'function2)
+  fun3 := htpLabelInputString(htPage,'function3)
+  ind1 := htpLabelInputString(htPage,'ind1)
+  from1 := htpLabelInputString(htPage,'from1)
+  to1 := htpLabelInputString(htPage,'to1)
+  ind2 := htpLabelInputString(htPage,'ind2)
+  from2 := htpLabelInputString(htPage,'from2)
+  to2 := htpLabelInputString(htPage,'to2)
+  title := htpLabelInputString(htPage,'title)
+  r1 := bcDrawIt2(ind1,from1,to1)
+  r2 := bcDrawIt2(ind2,from2,to2)
+  surfacePart := STRCONC('"surface(",'"{}",fun1,'",{}",fun2,'",{}",fun3,'")")
+  if (title ^= '"") then
+    titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_""))
+    bcFinish('"draw",surfacePart,r1,r2,titlePart)
+  else
+    bcFinish('"draw",surfacePart,r1,r2)
+
+bcSeries() ==
+  htInitPage('"Series Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+   (text .  "Create a series by: ")
+   (text . "\beginmenu")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{Expansion}" "" bcSeriesExpansion NILl))
+   (text . "\tab{11}Expand a function in a series around a point")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{Formula}"  "" bcSeriesByFormula NIL))
+   (text . "\tab{11}Give a formula for the {\em i}'th coefficient")
+   (text . "\endmenu"))
+  htShowPage()
+
+bcSeriesExpansion(a,b) ==
+  htInitPage('"Series Expansion Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain EEM (Expression $EmptyMode))
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em function} you want to expand in a power series")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "log(cot(x))" function EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em power series variable}")
+    (text . "\tab{49}")
+    (bcStrings (8 x variable SY))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em point} about which you want to expand")
+    (text . "\tab{49}")
+    (bcStrings (8 "\%pi/2" point EM)))
+  htMakeDoneButton('"Continue",'bcSeriesExpansionGen)
+  htShowPage()
+
+bcSeriesExpansionGen htPage ==
+  fun := htpLabelInputString(htPage,'function)
+  var := htpLabelInputString(htPage,'variable)
+  point := htpLabelInputString(htPage,'point)
+  terms := htpLabelInputString(htPage,'numberOfTerms)
+  bcFinish("series",fun,STRCONC(var,'" = ",point))
+
+bcSeriesByFormula(a,b) ==
+  htInitPage('"Power Series Basic Command",nil)
+  htMakePage '(
+    (text . "Select the kind of power series you want to create:")
+    (text . "\beginmenu")
+    (text . "\item ")
+    (bcLinks ("\menuitemstyle{Taylor Series}" "" bcTaylorSeries taylor))
+    (text . "\newline Series where the exponent ranges over the integers from a {\em non-negative integer} value to plus infinity by an arbitrary {\em positive integer} step size")
+    (text . "\item ")
+    (bcLinks ("\menuitemstyle{Laurent Series}" "" bcLaurentSeries laurent))
+    (text . "\newline Series where the exponent ranges from an arbitrary {\em integer} value to plus infinity by an arbitrary {\em positive integer} step size")
+    (text . "\item ")
+    (bcLinks ("\menuitemstyle{Puiseux Series}" "" bcPuiseuxSeries puiseux))
+    (text . "\newline Series where the exponent ranges from an arbitrary {\em rational value} to plus infinity by an arbitrary {\em positive rational number} step size")
+    (text . "\endmenu"))
+  htShowPage()
+
+bcTaylorSeries(a,b) ==
+  htInitPage('"Taylor Series Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain EEM (Expression $EmptyMode))
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the formula for the general coefficient of the series")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "1/factorial(i)" formula EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em index variable} for your formula")
+    (text . "\tab{49}")
+    (bcStrings (8 i index SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em power series variable}")
+    (text . "\tab{49}")
+    (bcStrings (8 x variable SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em point} about which you want to expand")
+    (text . "\tab{49}")
+    (bcStrings (8 0 point EM))
+    (text . "\blankline ")
+    (text ."For Taylor Series, the exponent of the power series variable ranges  from an {\em initial value}, an arbitrary non-negative integer, to plus infinity; the {\em step size} is any positive integer.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em initial value} of the index (an integer)")
+    (text . "\tab{49}")
+    (bcStrings (8 "0" min I))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em step size} (a positive integer)")
+    (text . "\tab{49}")
+    (bcStrings (8 "1" step PI))
+    (doneButton "Continue" bcTaylorSeriesGen))
+  htShowPage()
+
+bcSeriesByFormulaGen htPage == bcNotReady()
+
+bcLaurentSeries(a,b) ==
+  htInitPage('"Laurent Series Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain EEM (Expression $EmptyMode))
+       (isDomain S (String))
+       (isDomain I (Integer))
+       (isDomain PI (PositiveInteger))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the formula for the general coefficient of the series")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "(-1)**(n - 1)/(n + 2)" formula EM))
+    (text . "\vspace{1}\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em index variable} for your formula")
+    (text . "\tab{49}")
+    (bcStrings (8 n index SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em power series variable}")
+    (text . "\tab{49}")
+    (bcStrings (8 x variable SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em point} about which you want to expand")
+    (text . "\tab{49}")
+    (bcStrings (8 0 point F))
+    (text . "\blankline")
+    (text . "\newline For Laurent Series, the exponent of the power series variable ranges from an {\em initial value}, an arbitrary integer value, to plus infinity; the {\em step size} is any positive integer.")
+    (text . "\blankline")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em initial value} of the index (an integer)")
+    (text . "\tab{49}")
+    (bcStrings (8 "-1" min I))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em step size} (a positive integer)")
+    (text . "\tab{49}")
+    (bcStrings (8 "1" step PI))
+    (doneButton "Continue" bcLaurentSeriesGen))
+  htShowPage()
+
+bcPuiseuxSeries(a,b) ==
+  htInitPage('"Puiseux Series Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain EEM (Expression $EmptyMode))
+       (isDomain S (String))
+       (isDomain I (Integer))
+       (isDomain PI (PositiveInteger))
+       (isDOmain RN (Fraction (Integer)))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text ."Enter the {\em formula} for the general coefficient of the series")
+    (text . "\newline\tab{2} ")
+    (bcStrings(55 "(-1)**((3*n - 4)/6)/factorial(n - 1/3)" formula EM))
+    (text . "\vspace{1}\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em index variable} for your formula")
+    (text . "\tab{49}")
+    (bcStrings (8 n index SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em power series variable}")
+    (text . "\tab{49}")
+    (bcStrings (8 x variable SY))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em point} about which you want to expand")
+    (text . "\tab{49}")
+    (bcStrings (8 0 point F))
+    (text . "\blankline ")
+    (text . "For Puiseux Series, the exponent of the power series variable ranges from an {\em initial value}, an arbitary rational number, to plus infinity; the {\em step size} is an any positive rational number.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em initial value} of index (a rational number)")
+    (text . "\tab{51}")
+    (bcStrings (6 "4/3" min RN))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em step size} (a positive rational number)")
+    (text . "\tab{51}")
+    (bcStrings (6 "2" step RN))
+    (doneButton "Continue" bcPuiseuxSeriesGen))
+  htShowPage()
+
+bcTaylorSeriesGen htPage == bcSeriesGen(htPage)
+
+bcLaurentSeriesGen htPage ==
+  bcSeriesGen(htPage)
+
+bcPuiseuxSeriesGen htPage ==
+  bcSeriesGen(htPage)
+
+bcSeriesGen(htPage) ==
+  step:= htpLabelInputString(htPage,'step)
+  min := htpLabelInputString(htPage,'min)
+  formula := htpLabelInputString(htPage,'formula)
+  index   := htpLabelInputString(htPage,'index)
+  var := htpLabelInputString(htPage,'variable)
+  point := htpLabelInputString(htPage,'point)
+  varPart := STRCONC(var,'" = ",point)
+  minPart := STRCONC(min,'"..")
+  bcFinish('"series",STRCONC(index,'" +-> ",formula),varPart,minPart,step)
+
+bcLimit() ==
+  htInitPage('"Limit Basic Command",nil)
+  htMakePage '(
+   (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain SY (Symbol)))
+   (text . "What kind of limit do you want to compute? ")
+   (text . "\blankline ")
+   (text . "\beginmenu")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{A real limit?}" "" bcRealLimit real))
+   (text . "\indentrel{17}\tab{0}")
+   (text . "The limit as the variable approaches a {\em real} value along the real axis")
+   (text . "\indentrel{-17}")
+   (text . "\item ")
+   (text . "\blankline ")
+   (bcLinks ("\menuitemstyle{A complex limit?}" "" bcComplexLimit complex))
+   (text . "\indentrel{17}\tab{0}")
+   (text . "The limit as the variable approaches a {\em complex} value along any path in the complex plane")
+   (text . "\indentrel{-17}")
+   (text . "\endmenu")
+    )
+  htShowPage()
+
+bcRealLimit(a,b) ==
+  htInitPage('"Real Limit Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em function} you want to compute the limit of:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (45 "x*sin(1/x)" expression EM))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the name of the {\em variable}: ")
+    (text . "\tab{41}")
+    (bcStrings (6 x variable SY))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Compute the limit at")
+    (radioButtons location
+      ("A finite point:" (
+        (text . "\tab{33}")
+        (bcStrings (6 0 point F))) finitePoint)
+      ("Plus infinity" "" plusInfinity)
+      ("Minus infinity" "" minusInfinity))
+    (doneButton "Continue" bcRealLimitGen))
+  htShowPage()
+
+bcRealLimitGen htPage ==
+  (p := htpButtonValue(htPage,'location)) ^= 'finitePoint =>
+    fun := htpLabelInputString(htPage,'expression)
+    var := htpLabelInputString(htPage,'variable)
+    loc :=
+      p = 'plusInfinity => '"%plusInfinity"
+      '"%minusInfinity"
+    bcFinish('"limit",fun,STRCONC(var,'" = ",loc))
+  page := htInitPage('"Real Limit Basic Command",nil)
+  htMakePage '(
+    (text . "Compute the limit")
+    (lispLinks
+       ("\menuitemstyle{From both directions}" "" bcRealLimitGen1 both)
+       ("\menuitemstyle{From the right}" "" bcRealLimitGen1 right)
+       ("\menuitemstyle{From the left}" "" bcRealLimitGen1 left)))
+  htpSetProperty(page,'fun,htpLabelInputString(htPage,'expression))
+  htpSetProperty(page,'var,htpLabelInputString(htPage,'variable))
+  htpSetProperty(page,'loc,htpLabelInputString(htPage,'point))
+  htShowPage()
+
+bcRealLimitGen1(htPage,key) ==
+  direction :=
+    key = 'right => '"_"right_""
+    key = 'left => '"_"left_""
+    nil
+  fun := htpProperty(htPage,'fun)
+  var := htpProperty(htPage,'var)
+  loc := htpProperty(htPage,'loc)
+  varPart := STRCONC(var,'" = ",loc)
+  bcFinish('"limit",fun,varPart,direction)
+
+bcComplexLimit(a,b) ==
+  htInitPage('"Complex Limit Basic Command",nil)
+  htMakePage '(
+    (domainConditions
+        (isDomain EM $EmptyMode)
+       (isDomain S (String))
+       (isDomain F (Float))
+       (isDomain SY (Symbol)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the {\em function} you want to compute the limit of:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (40 "sin(a*x)/tan(b*x)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the name of the {\em variable}: ")
+    (text . "\tab{37}")
+    (bcStrings (5 x variable SY))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Compute the limit at")
+    (radioButtons location
+      ("A finite point:" (
+       (text . "\newline\space{0}Real part:\space{3}")
+       (bcStrings (20 0 real F))
+       (text . "\newline Complex part:")
+       (bcStrings (20 0 complex F))) finitePoint)
+      ("Complex infinity" "" complexInfinity))
+     (doneButton "Continue" bcComplexLimitGen))
+  htShowPage()
+
+bcComplexLimitGen htPage ==
+  fun := htpLabelInputString(htPage,'expression)
+  var := htpLabelInputString(htPage,'variable)
+  loc :=
+    (p := htpButtonValue(htPage,'location)) = 'finitePoint =>
+      real := htpLabelInputString(htPage,'real)
+      comp := htpLabelInputString(htPage,'complex)
+      complexPart :=
+        comp = '"0" => '""
+        comp = '"1" => '"%i"
+        STRCONC(comp,'"*%i")
+      real = '"0" =>
+        complexPart = '"" => "0"
+        complexPart
+      complexPart = '"" => real
+      STRCONC(real,'" + ",complexPart)
+    '"%infinity"
+  varPart := STRCONC(var,'" = ",loc)
+  bcFinish('"complexLimit",fun,varPart)
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bc-solve.boot.pamphlet b/src/interp/bc-solve.boot.pamphlet
new file mode 100644
index 00000000..56314441
--- /dev/null
+++ b/src/interp/bc-solve.boot.pamphlet
@@ -0,0 +1,384 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp bc-solve.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+  -- HyperTeX basic Solve Command
+$systemType := nil
+$numberOfEquations := 0
+$solutionMethod := nil 
+
+bcSolve() ==
+  htInitPage('"Solve Basic Command", nil)
+  htMakePage '(
+   (text . "What do you want to solve? ") 
+   (text . "\beginmenu")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{A System Of Linear Equations}" "" bcLinearSolve linear)) 
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{A System of Polynomial Equations}" "" bcSystemSolve  polynomial))
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{A Single Polynomial Equation}" "" bcSolveSingle onePolynomial))
+   (text . "\endmenu"))
+  htShowPage()
+
+bcLinearSolve(p,nn) ==
+  htInitPage('"Basic Solve Command", nil)
+  htMakePage '(
+    (text . "How do you want to enter the equations?")    
+    (text . "\beginmenu")
+    (text . "\item ")
+    (text . "\newline ")
+    (bcLinks ("\menuitemstyle{Directly as equations}" "" bcLinearSolveEqns equations))
+    (text . "\item ")
+    (text . "\newline ")
+    (bcLinks ("\menuitemstyle{In matrix form}" "" bcLinearSolveMatrix matrix))
+    (text . "\indentrel{16}\tab{0}")
+    (text . " \spad{AX = B}, where \spad{A} is a matrix of coefficients and \spad{B} is a vector" )
+    (text . "\indentrel{-16}\item ")
+    (text . "\endmenu"))
+  htShowPage()
+
+bcLinearSolveEqns(htPage, p) ==
+  htInitPage('"Basic Solve Command", nil)
+  htMakePage '(
+    (domainConditions (isDomain PI (PositiveInteger)))
+    (inputStrings  
+      ("Enter the {\em number} of equations:" "" 5 2 numberOfEquations PI)))
+  htMakeDoneButton('"Continue", 'bcLinearSolveEqns1)
+  htShowPage()
+
+bcSystemSolve(htPage, p) ==
+  htInitPage('"Basic Solve Command", nil)
+  htMakePage '(
+    (domainConditions (isDomain PI (PositiveInteger)))
+    (inputStrings  
+      ("Enter the {\em number} of equations:" "" 5 2 numberOfEquations PI)))
+  htMakeDoneButton('"Continue", 'bcSystemSolveEqns1)
+  htShowPage()
+
+bcSolveSingle(htPage,p) ==
+  htpSetProperty(htPage,'systemType, 'onePolynomial)
+  htpSetProperty(htPage,'exitFunction,'bcInputSolveInfo)
+  bcInputEquations(htPage,'exact)
+
+bcSystemSolveEqns1 htPage ==
+  htpSetProperty(htPage,'systemType,'polynomial)
+  htpSetProperty(htPage,'exitFunction,'bcInputSolveInfo)
+  bcInputEquations(htPage,'exact)
+ 
+bcLinearSolveEqns1 htPage ==
+  htpSetProperty(htPage,'systemType,'linear)
+  htpSetProperty(htPage,'exitFunction,'bcLinearSolveEqnsGen)
+  bcInputEquations(htPage,'exact)
+ 
+bcInputSolveInfo htPage ==
+  page := htInitPage('"Solve Basic Command", htpPropertyList htPage)
+  htpSetProperty(page,'numberOfEquations,htpProperty(htPage,'numberOfEquations))
+  htpSetProperty(page,'inputArea,htpInputAreaAlist htPage)
+  htMakePage '(
+   (domainConditions (isDomain PI (PositiveInteger)))
+   (text . "What would you like?")  
+   (text . "\beginmenu")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{Exact Solutions}" "" bcSolveEquations exact))
+   (text . "\indentrel{18}\tab{0} ")
+   (text . "Solutions expressed in terms of {\em roots} of irreducible polynomials")  
+   (text . "\indentrel{-18}")
+   (text . "\item ")
+   (bcLinks ("\menuitemstyle{Numeric Solutions}" "" bcSolveEquationsNumerically numeric))
+   (text . "\indentrel{18}\tab{0} ")
+   (text . "Solutions expressed in terms of approximate real or complex {\em numbers}") 
+   (text . "\indentrel{-18}")
+   (text . "\item ")  
+   (bcLinks ("\menuitemstyle{Radical Solutions}" "" bcSolveEquations radical))
+   (text . "\indentrel{18}\tab{0} ")
+   (text . "Solutions expressed in terms of {\em radicals} if it is possible")
+   (text . "\indentrel{-18}")
+   (text . "\endmenu"))
+  htShowPage()
+
+bcInputEquations(htPage,solutionMethod) ==
+  numEqs := 
+    htpProperty(htPage, 'systemType) = 'onePolynomial => 1
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage,'numberOfEquations)
+    objValUnwrap htpLabelSpadValue(htPage, 'numberOfEquations)
+  linearPred := htpProperty(htPage,'systemType) = 'linear
+  labelList := 
+    numEqs = 1 => '(
+      (bcStrings (42 "x^2+1" l1 P))
+      (text . " = ")
+      (bcStrings (6 0 r1 P)))
+    "append"/[f(i,numEqs,linearPred) for i in 1..numEqs] where f(i,n,linearp) ==
+      spacer := (i > 99 => 0; i > 9 => 1; 2)
+      prefix := STRCONC('"\newline\tab{2}{\em Equation ",STRINGIMAGE i,'":}")
+      prefix := STRCONC(prefix,'"\space{",STRINGIMAGE spacer,'"}")
+      lnam := INTERN STRCONC('"l",STRINGIMAGE i)
+      rnam := INTERN STRCONC('"r",STRINGIMAGE i)
+      var:= 
+	linearp => bcMakeLinearEquations(i,n)
+	bcMakeEquations(i,n)
+      [['text,:prefix],['bcStrings,[30,var,lnam,'P]],'(text . " = "),['bcStrings,[5,"0",rnam,'P]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain PI (PositiveInteger))),
+            :labelList]
+  page := htInitPage('"Solve Basic Command", htpPropertyList htPage)
+  htpSetProperty(page, 'numberOfEquations, numEqs)
+  htpSetProperty(page, 'solutionMethod,solutionMethod)
+  htSay '"\newline\menuitemstyle{}\tab{2}"
+  htSay
+    numEqs = 1 => '"Enter the {\em Equation}:"
+    '"Enter the {\em Equations}:"
+  htSay '"\newline\tab{2}"
+  htMakePage equationPart
+  bcHt '"\blankline "
+  htSay '"\newline\menuitemstyle{}\tab{2}"
+  htMakePage 
+    numEqs = 1 =>  '(
+      (text ."Enter the {\em unknown} (leave blank if implied): ")
+      (text . "\tab{48}")
+      (bcStrings (6 "x" unknowns S . quoteString)))
+    ['(text . "Enter the unknowns (leave blank if implied):"),
+     '(text . "\tab{44}"),
+      ['bcStrings, [10,bcMakeUnknowns(numEqs),'unknowns,'P]]]
+  htMakeDoneButton('"Continue", 'bcInputEquationsEnd)
+  htShowPage()
+
+bcCreateVariableString(i) == 
+   STRCONC('"x",STRINGIMAGE i)
+
+bcMakeUnknowns(number)==
+   APPLY('CONCAT,[STRCONC(bcCreateVariableString(i)," ") for i in 1..number])
+   
+bcMakeEquations(i,number)==
+   number =1 => STRCONC(bcCreateVariableString(1),"^2+1")
+   bcCreateVariableString(i)
+   STRCONC(
+     STRCONC(
+      APPLY('CONCAT,[STRCONC(bcCreateVariableString(j),"+") for j in 1..number]),"1"),
+	STRCONC("-2*",STRCONC(bcCreateVariableString(i),"^2")))
+
+
+bcMakeLinearEquations(i,number)==
+   number = 1 => bcCreateVariableString(1)
+   number = 2 => 
+	i=1 => STRCONC(bcCreateVariableString(1),STRCONC("+",bcCreateVariableString(2)))
+	STRCONC(bcCreateVariableString(1),STRCONC("-",bcCreateVariableString(2)))
+   STRCONC(
+     STRCONC(
+      APPLY('CONCAT,[STRCONC(bcCreateVariableString(j),"+") for j in 1..number]),"1"),
+	STRCONC("-2*",bcCreateVariableString(i)))
+      
+
+bcInputEquationsEnd htPage ==
+  fun := htpProperty(htPage, 'exitFunction) => FUNCALL(fun,htPage)
+  systemError nil
+
+bcSolveEquationsNumerically(htPage,p) ==
+  page := htInitPage('"Solve Basic Command", htpPropertyList htPage)
+  htMakePage '(
+    (text . "What would you like?")
+    (radioButtons choice
+      ("Real roots expressed as rational numbers" "" rr)
+      ("Real roots expressed as floats" "" rf)
+      ("Complex roots expressed as rational numbers" "" cr)
+      ("Complex roots expressed as floats" "" cf))
+      (text . "\vspace{1}\newline")
+      (inputStrings
+        ("Enter the number of desired {\em digits} of accuracy" "" 5 20 acc PI)))
+  htMakeDoneButton('"Continue", 'bcSolveNumerically1)
+  htShowPage()
+
+bcSolveNumerically1(htPage) ==
+ bcSolveEquations(htPage,'numeric)
+
+--bcSolveNumerically1(htPage,kind) ==
+-- htpSetProperty(htPage,'kind,kind)
+-- bcSolveEquations(htPage,'numeric)
+    
+bcSolveEquations(htPage,solutionMethod) ==
+  if solutionMethod = 'numeric then
+    digits := htpLabelInputString(htPage,'acc)
+    kind := htpButtonValue(htPage,'choice)
+    accString :=
+      kind in '(rf cf) => STRCONC('"1.e-",digits)
+      STRCONC('"1/10**",digits)
+  alist := htpProperty(htPage,'inputArea)
+  [[.,varpart,:.],:r] := alist
+  varlist := bcString2WordList varpart
+  varString := (rest varlist => bcwords2liststring varlist; first varlist)
+  eqnString := bcGenEquations r
+  solutionMethod = 'numeric =>
+    name :=
+      kind in '(rf rr) => '"solve"
+      '"complexSolve"
+    bcFinish(name,eqnString,accString)
+  name :=
+    solutionMethod = 'radical => '"radicalSolve"
+    '"solve"
+  bcFinish(name,eqnString,varString,accString)
+
+bcLinearSolveMatrix(htPage,junk) ==
+  bcReadMatrix 'bcLinearSolveMatrix1
+
+bcLinearSolveMatrix1 htPage ==
+  page := htInitPage('"Linear Solve Basic Command",htpPropertyList htPage)
+  htpSetProperty(page,'matrix,bcLinearExtractMatrix htPage)
+  htMakePage '(
+    (text . "The right side vector B is:")
+    (lispLinks
+      ("Zero:" "the system is homogeneous" bcLinearSolveMatrixHomo homo)
+      ("Not zero:" "the system is not homogeneous" bcLinearSolveMatrixInhomo nothomo)))
+  htShowPage()
+
+bcLinearExtractMatrix htPage == REVERSE htpInputAreaAlist htPage
+ 
+bcLinearSolveMatrixInhomo(htPage,junk) ==
+  nrows := htpProperty(htPage,'nrows)
+  ncols := htpProperty(htPage,'ncols)
+  labelList := 
+    [f(i) for i in 1..ncols] where f(i) ==
+      spacer := (i > 99 => 0; i > 9 => 1; 2)
+      prefix := STRCONC('"{\em Coefficient ",STRINGIMAGE i,'":}")
+      if spacer ^= 0 then
+        prefix := STRCONC(prefix,'"\space{",STRINGIMAGE spacer,'"}")
+      name := INTERN STRCONC('"c",STRINGIMAGE i)
+      [prefix,"",30, 0,name, 'P]
+  page := htInitPage('"Linear Solve Basic Command",htpPropertyList htPage)
+  htpSetProperty(page,'matrix,htpProperty(htPage,'matrix))
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'ncols,ncols)
+  htMakePage [
+   '(domainConditions (isDomain P (Polynomial $EmptyMode))),
+    '(text . "Enter the right side vector B:"),
+        ['inputStrings, :labelList],
+          '(text . "\vspace{1}\newline Do you want:" ),
+             '(lispLinks
+                 ("All the solutions?" "" bcLinearSolveMatrixInhomoGen all)
+                  ("A particular solution?" "" bcLinearSolveMatrixInhomoGen particular))]
+  htShowPage()
+
+bcLinearSolveMatrixInhomoGen(htPage,key) ==  bcLinearMatrixGen(htPage,key)
+
+bcLinearSolveMatrixHomo(htPage,key) == bcLinearMatrixGen(htPage,'homo)
+
+bcLinearMatrixGen(htPage,key) == 
+  matform := bcMatrixGen htPage
+  key = 'homo => bcFinish('"nullSpace",matform)
+  vector := [x.1 for x in REVERSE htpInputAreaAlist htPage]
+  vecform := bcVectorGen vector 
+  form := bcMkFunction('"solve",matform,[vecform])
+  bcGen
+    key = 'particular => STRCONC(form,'".particular")
+    form
+  
+linearFinalRequest(nhh,mat,vect) ==     
+  sayBrightly '"Do you want more information on the meaning of the output"
+  sayBrightly '"   (1) no "
+  sayBrightly '"   (2) yes "
+  tt := bcQueryInteger(1,2,true)
+  tt=1 => sayBrightly '"Bye Bye"
+  tt=2 => explainLinear(nhh)
+ 
+explainLinear(flag) ==
+  flag="notHomogeneous" =>
+   '("solve returns a particular solution and a basis for"
+     "the vector space of solutions for the homogeneous part."
+     "The particular solution is _"failed_" if one cannot be found.")
+  flag= "homogeneous" =>
+    '("solve returns a basis for"
+      "the vector space of solutions for the homogeneous part")
+  systemError nil
+ 
+finalExactRequest(equations,unknowns) ==
+  sayBrightly '"Do you like:"
+  sayBrightly '"   (1) the solutions how they are displayed"
+  sayBrightly '"   (2) to get ????"
+  sayBrightly '"   (3) more information on the meaning of the output"
+  tt := bcQueryInteger(1,3,true)
+  tt=1 => sayBrightly '"Bye Bye"
+  tt=2 => moreExactSolution(equations,unknowns,flag)
+  tt=3 => explainExact(equations,unknowns)
+
+bcLinearSolveEqnsGen htPage == 
+  alist := htpInputAreaAlist htPage
+  if vars := htpLabelInputString(htPage,'unknowns) then 
+    varlist := bcString2WordList vars
+    varString := (rest varlist => bcwords2liststring varlist; first varlist)
+    alist := rest alist  --know these are first on the list
+  eqnString := bcGenEquations alist
+  bcFinish('"solve",eqnString,varString)
+
+bcGenEquations alist ==
+  y := alist
+  while y repeat
+    right := (first y).1
+    y := rest y
+    left := (first y).1
+    y := rest y
+    eqnlist := [STRCONC(left,'" = ",right),:eqnlist]
+  rest eqnlist => bcwords2liststring eqnlist
+  first eqnlist
+  
+ 
+
+
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bc-util.boot.pamphlet b/src/interp/bc-util.boot.pamphlet
new file mode 100644
index 00000000..56287145
--- /dev/null
+++ b/src/interp/bc-util.boot.pamphlet
@@ -0,0 +1,147 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp bc-util.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+bcFinish(name,arg,:args) == bcGen bcMkFunction(name,arg,args)
+
+bcMkFunction(name,arg,args) ==
+  args := [x for x in args | x]
+  STRCONC(name,'"(",arg,"STRCONC"/[STRCONC('",", x) for x in args],'")")
+
+bcString2HyString2 s ==
+  (STRINGP s) and (s.0 = char '_")  =>
+    len := #s
+    STRCONC('"\_"", SUBSTRING(s, 1, len-2), '"\_"")
+  s
+
+bcString2HyString s == s
+
+bcFindString(s,i,n,char) ==  or/[j for j in i..n | s.j = char]
+
+bcGen command ==
+  htInitPage('"Basic Command",nil)
+  string :=
+    #command < 50 => STRCONC('"{\centerline{\tt ",command,'" }}")
+    STRCONC('"{\tt ",command,'" }")
+  htMakePage [
+     '(text
+        "{Here is the AXIOM command you could have issued to compute this result:}"
+            "\vspace{2}\newline "),
+      ['text,:string]]
+  htMakeDoitButton('"Do It", command)
+  htShowPage()
+
+-- bcGen for axiom - nag link
+linkGen command ==
+  htInitPage('"AXIOM-Nag Link Command",nil)
+  string := 
+    #command < 50 => STRCONC('"{\centerline{ ",command,'" }}")
+    command
+  htMakePage [
+     '(text 
+        "\centerline{{\em Here is the AXIOM command}}"
+          "\centerline{{\em you could have issued to compute this result:}}"
+            "\vspace{2}\newline "),
+      ['text,:string]]
+  htMakeDoitButton('"Do It", command)
+  htShowPage()
+
+bcOptional s ==
+  s = '"" => '"2"
+  s
+
+bcvspace() == bcHt '"\vspace{1}\newline "
+
+bcString2WordList s == fn(s,0,MAXINDEX s) where
+  fn(s,i,n) ==
+    i > n => nil
+    k := or/[j for j in i..n | s.j ^= char '_  ]
+    null INTEGERP k => nil
+    l := bcFindString(s,k + 1,n,char '_  )
+    null INTEGERP l => [SUBSTRING(s,k,nil)]
+    [SUBSTRING(s,k,l-k),:fn(s,l + 1,n)]
+
+
+bcwords2liststring u ==
+  null u => nil
+  STRCONC('"[",first u,fn rest u) where
+    fn(u) ==
+      null u => '"]"
+      STRCONC('", ",first u,fn rest u)
+
+bcVectorGen vec == bcwords2liststring vec
+
+bcError string ==
+  sayBrightlyNT '"NOTE: "
+  sayBrightly string
+
+bcDrawIt(ind,a,b) == STRCONC(ind,'"=",a,'"..",b)
+
+bcNotReady htPage ==
+  htInitPage('"Basic Command",nil)
+  htMakePage '(
+     (text .
+        "{\centerline{\em This facility will soon be available}}"))
+  htShowPage()
+
+htStringPad(n,w) ==
+  s := STRINGIMAGE n
+  ws := #s
+  STRCONC('"\space{",STRINGIMAGE (w - ws + 1),'"}",s)
+
+stringList2String x ==
+  null x => '"()"
+  STRCONC('"(",first x,"STRCONC"/[STRCONC('",",y) for y in rest x],'")")
+
+htMkName(s,n) == STRCONC(s,STRINGIMAGE n)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bits.lisp.pamphlet b/src/interp/bits.lisp.pamphlet
new file mode 100644
index 00000000..1b38eadf
--- /dev/null
+++ b/src/interp/bits.lisp.pamphlet
@@ -0,0 +1,99 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/bits.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;;; The types "bit" and "bit vector" are implemented differently
+;;; in different variants of lisp.
+;;; These lisp macros/functions will have different implementations 
+;;; on different lisp systems.
+
+;;; The operations which traverse entire vectors are given as functions
+;;; since the function calling overhead will be relatively small.
+;;; The operations which extract or set a single part of the vector are
+;;; provided as macros.
+
+(in-package "BOOT")
+
+;;; SMW Nov 88: Created
+ 
+(defmacro truth-to-bit (x) `(cond (,x 1) ('else 0)))
+(defmacro bit-to-truth (b) `(eq ,b 1))
+
+(defun    bvec-make-full (n x) 
+    (make-array (list n) :element-type 'bit :initial-element x))
+
+(defmacro bvec-elt       (bv i)    `(sbit ,bv ,i))
+(defmacro bvec-setelt    (bv i x)  `(setf (sbit ,bv ,i) ,x))
+(defmacro bvec-size      (bv)      `(size ,bv))
+
+(defun    bvec-copy      (bv)      (copy-seq bv))
+(defun    bvec-concat    (bv1 bv2) (concatenate '(vector bit) bv1 bv2))
+(defun    bvec-equal     (bv1 bv2) (equal    bv1 bv2))
+(defun    bvec-greater   (bv1 bv2)
+  (let ((pos (mismatch bv1 bv2)))
+    (cond ((or (null pos) (>= pos (length bv1))) nil)
+	  ((< pos (length bv2)) (> (bit bv1 pos) (bit bv2 pos)))
+	  ((find 1 bv1 :start pos) t)
+	  (t nil))))
+(defun    bvec-and       (bv1 bv2) (bit-and  bv1 bv2))
+(defun    bvec-or        (bv1 bv2) (bit-ior  bv1 bv2))
+(defun    bvec-xor       (bv1 bv2) (bit-xor  bv1 bv2))
+(defun    bvec-nand      (bv1 bv2) (bit-nand bv1 bv2))
+(defun    bvec-nor       (bv1 bv2) (bit-nor  bv1 bv2))
+(defun    bvec-not       (bv)      (bit-not  bv))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bookvol5.pamphlet b/src/interp/bookvol5.pamphlet
new file mode 100644
index 00000000..5a7bd281
--- /dev/null
+++ b/src/interp/bookvol5.pamphlet
@@ -0,0 +1,1659 @@
+\documentclass{book}
+\usepackage{axiom}
+\usepackage{graphicx}
+% struggle with latex figure-floating behavior
+\renewcommand\floatpagefraction{.9}
+\renewcommand\topfraction{.9}
+\renewcommand\bottomfraction{.9}
+\renewcommand\textfraction{.1}
+\setcounter{totalnumber}{50}
+\setcounter{topnumber}{50}
+\setcounter{bottomnumber}{50}
+
+\begin{document}
+\begin{titlepage}
+\center{\includegraphics{ps/axiomFront.ps}}
+\vskip 0.1in
+\includegraphics{ps/bluebayou.ps}\\
+\vskip 0.1in
+{\Huge{The 30 Year Horizon}}
+\vskip 0.1in
+$$
+\begin{array}{lll}
+Manuel\ Bronstein      & William\ Burge   & Timothy\ Daly \\
+James\ Davenport       & Michael\ Dewar   & Martin\ Dunstan \\
+Albrecht\ Fortenbacher & Patrizia\ Gianni & Johannes\ Grabmeier \\
+Jocelyn\ Guidry        & Richard\ Jenks   & Larry\ Lambe \\
+Michael\ Monagan       & Scott\ Morrison  & William\ Sit \\
+Jonathan\ Steinbach    & Robert\ Sutor    & Barry\ Trager \\
+Stephen\ Watt          & Jim\ Wen         & Clifton\ Williamson
+\end{array}
+$$
+\center{\large{VOLUME 5: THE AXIOM INTERPRETER}}
+\end{titlepage}
+\pagenumbering{roman}
+\begin{verbatim}
+The Blue Bayou image Copyright (c) 2004 Jocelyn Guidry
+
+Portions Copyright (c) 2004 Martin Dunstan
+
+Portions Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+All rights reserved.
+
+This book and the Axiom software is licensed as follows:
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    - Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    - Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in
+      the documentation and/or other materials provided with the
+      distribution.
+
+    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+      names of its contributors may be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+\end{verbatim}
+\tableofcontents
+\vfill
+\eject
+\setlength{\parindent}{0em}
+\setlength{\parskip}{1ex}
+{\Large{\bf New Foreword}}
+\vskip .25in
+
+On October 1, 2001 Axiom was withdrawn from the market and ended
+life as a commercial product.
+On September 3, 2002 Axiom was released under the Modified BSD
+license, including this document.
+On August 27, 2003 Axiom was released as free and open source
+software available for download from the Free Software Foundation's
+website, Savannah.
+
+Work on Axiom has had the generous support of the Center for 
+Algorithms and Interactive Scientific Computation (CAISS) at
+City College of New York. Special thanks go to Dr. Gilbert 
+Baumslag for his support of the long term goal.
+
+The online version of this documentation is roughly 1000 pages.
+In order to make printed versions we've broken it up into three
+volumes. The first volume is tutorial in nature. The second volume
+is for programmers. The third volume is reference material. We've
+also added a fourth volume for developers. All of these changes
+represent an experiment in print-on-demand delivery of documentation.
+Time will tell whether the experiment succeeded.
+
+Axiom has been in existence for over thirty years. It is estimated to
+contain about three hundred man-years of research and has, as of
+September 3, 2003, 143 people listed in the credits. All of these
+people have contributed directly or indirectly to making Axiom
+available.  Axiom is being passed to the next generation. I'm looking
+forward to future milestones.
+
+With that in mind I've introduced the theme of the ``30 year horizon''.
+We must invent the tools that support the Computational Mathematician
+working 30 years from now. How will research be done when every bit of
+mathematical knowledge is online and instantly available? What happens
+when we scale Axiom by a factor of 100, giving us 1.1 million domains?
+How can we integrate theory with code? How will we integrate theorems
+and proofs of the mathematics with space-time complexity proofs and
+running code? What visualization tools are needed? How do we support
+the conceptual structures and semantics of mathematics in effective
+ways? How do we support results from the sciences? How do we teach
+the next generation to be effective Computational Mathematicians?
+
+The ``30 year horizon'' is much nearer than it appears.
+
+\vskip .25in
+%\noindent
+Tim Daly\\
+CAISS, City College of New York\\
+November 10, 2003 ((iHy))
+\vfill
+\eject
+\pagenumbering{arabic}
+\setcounter{chapter}{0} % Chapter 1
+\chapter{The Interpreter}
+\section{Star Global Variables}
+\begin{tabular}{lll}
+NAME                        & SET              & USE \\
+*eof*                       & ncTopLevel       & \\
+*features*                  &                  & restart \\
+*package*                   &                  & restart \\
+*standard-input*            &                  & ncIntLoop \\
+*standard-output*           &                  & ncIntLoop \\
+*top-level-hook*            & set-restart-hook & \\
+\end{tabular}
+
+\subsection{*eof*}
+The [[*eof*]] variable is set to [[NIL]] in [[ncTopLevel]].
+\subsection{*features*}
+The [[*features*]] variable from common lisp is tested for the presence
+of the [[:unix]] keyword. Apparently this controls the use of Saturn,
+a previous Axiom frontend. The Saturn frontend was never released as
+open source and so this test and the associated variables are probably
+not used.
+
+\subsection{*package*}
+The [[*package*]] variable, from common lisp, is set in [[restart]]
+to the [[BOOT]] package where the intepreter lives.
+\subsection{*standard-input*}
+The [[*standard-input*]] common lisp variable is used to set the 
+[[curinstream]] variable in [[ncIntLoop]]. 
+
+This variable is an argument to [[serverReadLine]] in
+the [[intloopReadConsole]] function.
+
+\subsection{*standard-output*}
+The [[*standard-output*]] common lisp variable is used to set the 
+[[curoutstream]] variable in [[ncIntLoop]].
+
+\subsection{*top-level-hook*}
+The [[*top-level-hook*]] common lisp variable contains the name of
+a function to invoke when an image is started. In our case it is
+called [[restart]]. This is the entry point to the Axiom interpreter.
+
+\section{Dollar Global Variables}
+\begin{tabular}{lll}
+NAME                         & SET                 & USE \\
+\$boot                       & ncTopLevel          & \\
+coerceFailure                &                     & runspad \\
+curinstream                  & ncIntLoop           & \\
+curoutstream                 & ncIntLoop           & \\
+vmlisp::\$current-directory  & restart             & \\
+                             & reroot              & \\
+\$currentLine                & restart             & removeUndoLines \\
+\$dalymode                   &                     & intloopReadConsole \\
+\$defaultMsgDatabaseName     & reroot              & \\
+\$directory-list             & reroot              & \\
+\$displayStartMsgs           &                     & restart \\
+\$e                          & ncTopLevel          & \\
+\$erMsgToss                  & SpadInterpretStream & \\
+\$fn                         & SpadInterpretStream & \\
+\$frameRecord                & initvars            & \\
+                             & clearFrame          & \\
+                             & undoSteps           & undoSteps \\
+                             & recordFrame         & recordFrame \\
+\$HiFiAccess                 & initHist            & historySpad2Cmd \\
+                             & historySpad2Cmd     & \\
+                             &                     & setHistoryCore \\
+\$HistList                   & initHist            & \\
+\$HistListAct                & initHist            & \\
+\$HistListLen                & initHistList        & \\
+\$HistRecord                 & initHistList        & \\
+\$historyDirectory           &                     & makeHistFileName \\
+                             &                     & makeHistFileName \\
+\$historyFileType            & initvars           & histInputFileName \\
+\$inclAssertions             & SpadInterpretStream & \\
+\$inLispVM                   & spad                & \\
+\$InteractiveFrame           & restart             & ncTopLevel \\
+                             & undo                & recordFrame \\
+                             & undoSteps           & undoSteps \\
+                             &                     & reportUndo \\
+\$InteractiveMode            & ncTopLevel          & \\
+\$internalHistoryTable       & initvars            & \\
+\$interpreterFrameName       & initializeInterpreterFrameRing & \\
+\$interpreterFrameRing       & initializeInterpreterFrameRing & \\
+\$InitialModemapFrame        &                     & makeInitialModemapFrame \\
+\$intRestart                 &                     & intloop \\
+\$intTopLevel                & intloop             & \\
+\$IOindex                    & restart             & historySpad2Cmd \\
+                             & removeUndoLines     & undoCount \\
+\$lastPos                    & SpadInterpretStream & \\
+\$libQuiet                   & SpadInterpretStream & \\
+\$library-directory-list     & reroot              & \\
+\$msgDatabaseName            & reroot              * \\
+\$ncMsgList                  & SpadInterpretStream & \\
+\$newcompErrorCount          & SpadInterpretStream & \\
+\$newcompMode                & SpadInterpretStream & \\
+\$newspad                    & ncTopLevel          & \\
+\$nopos                      &                     & SpadInterpretStream \\
+\$okToExecuteMachineCode     & SpadInterpretStream & \\
+\$oldHistoryFileName         & initvars            & oldHistFileName \\
+\$openServerIfTrue           & restart             & restart \\
+                             & spad-save           & \\
+                             & initvars            & \\
+\$options                    &                     & history \\
+                             & historySpad2Cmd     & historySpad2Cmd \\
+                             &                     & undo \\
+\$previousBindings           & initvars            & \\
+                             & clearFrame          & \\
+                             & recordFrame         & recordFrame \\
+\$printLoadMsgs              & restart             & \\
+\$PrintCompilerMessageIfTrue & spad                & \\
+\$promptMsg                  & SpadInterpretStream & \\
+\$relative-directory-list    &                     & reroot \\
+\$relative-library-directory-list &                & reroot \\
+\$reportUndo                 & initvars            & diffAlist \\
+\$shoeReadLineFunction       & SpadInterpretStream & \\
+\$spad                       & ncTopLevel          & \\
+\$spadroot                   & reroot              & initroot \\
+                             &                     & make-absolute-filename \\
+                             &                     & reroot \\
+\$SpadServer                 & restart             & \\
+\$SpadServerName             & initvars            & restart \\
+\$systemCommandFunction      & SpadInterpretStream & \\
+top\_level                   &                     & runspad \\
+\$quitTag                    &                     & runspad \\
+\$useInternalHistoryTable    & initvars            & initHist \\
+                             & setHistoryCore      & setHistoryCore \\
+\$undoFlag                   & initvars            & recordFrame \\
+\end{tabular}
+
+\subsection{\$boot}
+The [[$boot]] variable is set to [[NIL]] in [[ncTopLevel]].
+
+\subsection{coerceFailure}
+The [[coerceFailure]] symbol is a catch tag used in [[runspad]]
+to catch an exit from [[ncTopLevel]].
+
+\subsection{curinstream}
+The [[curinstream]] variable is set to the value of the 
+[[*standard-input*]] common lisp
+variable in [[ncIntLoop]]. While not using the
+``dollar'' convention this variable is still ``global''.
+
+\subsection{curinstream}
+The [[curoutstream]] variable is set to the value of the 
+[[*standard-output*]] common lisp variable in [[ncIntLoop]].
+While not using the ``dollar'' convention this variable is still ``global''.
+
+\subsection{vmlisp::\$current-directory}
+When running in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe
+([[:ibm/370]]) this variable is used in place of the 
+[[*default-pathname-defaults*]] common lisp variable. 
+Otherwise this variable is
+set to the empty string in [[restart]]. 
+
+Notice that the variable [[*default-pathname-defaults*]] is a Common
+Lisp standard variable with implementation defined meaning.
+Typically, its value is an object that represents the directory from
+where the Lisp image has been started.
+
+The [[reroot]] function sets this variable to the value of
+[[$spadroot]] which itself has the value of the argument to the
+[[reroot]] function. Since the argument to the [[reroot]] function is
+an string which represents an absolute pathname pointing to AXIOM the
+net result is that the [[$current-directory]] is set to point to the
+shell [[AXIOM]] variable.
+
+So during execute both [[$current-directory]] and [[$spadroot]] reflect
+the value of the [[AXIOM]] shell variable.
+
+\subsection{\$currentLine}
+The [[$currentLine]] line is set to [[NIL]] in [[restart]].
+It is used in [[removeUndoLines]] in the undo mechanism.
+
+\subsection{\$dalymode}
+The [[$dalymode]] variable is used in a case statement in 
+[[intloopReadConsole]]. This variable can be set to any non-nil
+value. When not nil the interpreter will send any line that begins
+with an ``[[(]]'' to be sent to the underlying lisp. This is useful
+for debugging Axiom. The normal value of this variable is [[NIL]].
+
+This variable was created as an alternative to prefixing every lisp
+command with [[)lisp]]. When doing a lot of debugging this is tedious
+and error prone. This variable was created to shortcut that process.
+Clearly it breaks some semantics of the language accepted by the
+interpreter as parens are used for grouping expressions.
+
+\subsection{\$defaultMsgDatabaseName}
+The [[$defaultMsgDatabaseName]] is the absolute path to the 
+[[s2-us.msgs]] file which contains all of the english language
+messages output by the system.
+
+\subsection{\$directory-list}
+The [[$directory-list]] is a list of absolute directory names.
+These names are made absolute by mapping the [[make-absolute-filename]]
+over the variable [[$relative-directory-list]].
+
+\subsection{\$displayStartMsgs}
+The [[$displayStartMsgs]] variable is used in [[restart]] but is not
+set so this is likely a bug.
+
+\subsection{\$e}
+The [[$e]] variable is set to the value of
+[[$InteractiveFrame]] which is set in [[restart]] to the value of the
+call to the [[makeInitialModemapFrame]] function. This function simply
+returns a copy of the variable [[$InitialModemapFrame]].
+
+Thus [[$e]] is a copy of the variable [[$InitialModemapFrame]].
+
+This variable is used in the undo mechanism.
+
+\subsection{\$erMsgToss}
+The [[$erMsgToss]] variable is set to [[NIL]] in [[SpadInterpretStream]].
+
+\subsection{\$fn}
+The [[$fn]] variable is set in [[SpadInterpretStream]]. It is set to
+the second argument which is a list. It appears that this list has the
+same structure as an argument to the LispVM [[rdefiostream]] function.
+
+\subsection{\$frameRecord}
+[[$frameRecord = [delta1, delta2,... ] ]] where
+[[delta(i)]] contains changes in the ``backwards'' direction.
+Each [[delta(i)]] has the form [[((var . proplist)...)]] where
+proplist denotes an ordinary proplist. For example, an entry
+of the form [[((x (value) (mode (Integer)))...)]] indicates that
+to undo 1 step, [[x]]'s value is cleared and its mode should be set
+to [[(Integer)]].
+
+A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special
+delta indicating changes due to system commands executed between
+the last command and the current command. By recording these deltas
+separately, it is possible to undo to either BEFORE or AFTER
+the command. These special [[delta(i)]]s are given ONLY when a
+a system command is given which alters the environment.
+
+Note: [[recordFrame('system)]] is called before a command is executed, and
+[[recordFrame('normal)]] is called after (see processInteractive1).
+If no changes are found for former, no special entry is given.
+
+This is part of the undo mechanism.
+
+\subsection{\$HiFiAccess}
+The [[$HiFiAccess]] is set by [[initHist]] to [[T]]. It is a flag
+used by the history mechanism to record whether the history function
+is currently on. It can be reset by using the axiom
+command
+\begin{verbatim}
+  )history off
+\end{verbatim}
+It appears that the name means ``History File Access''.
+
+The [[$HiFiAccess]] variable is used by [[historySpad2Cmd]] to check
+whether history is turned on. [[T]] means it is, [[NIL]] means it is not.
+
+\subsection{\$HistList}
+Thie [[$HistList]] variable is set by [[initHistList]] to an initial
+value of [[NIL]] elements. The last element of the list is smashed to
+point to the first element to make the list circular.
+This is a circular list of length [[$HistListLen]].
+
+\subsection{\$HistListAct}
+The [[$HistListAct]] variable is set by [[initHistList]] to [[0]].
+This variable holds the actual number of elements in the history list.
+This is the number of ``undoable'' steps.
+
+\subsection{\$HistListLen}
+The [[$HistListLen]] variable is set by [[initHistList]] to [[20]].
+This is the length of a circular list maintained in the variable
+[[$HistList]].
+
+\subsection{\$HistRecord}
+The [[$HistRecord]] variable is set by [[initHistList]] to [[NIL]].
+[[$HistRecord]] collects the input line, all variable bindings
+and the output of a step, before it is written to the file named by
+the function [[histFileName]].
+
+\subsection{\$historyFileType}
+The [[$historyFileType]] is set at load time by a call to 
+[[initvars]] to a value of ``[[axh]]''. It appears that this
+is intended to be used as a filetype extension.
+It is part of the history mechanism. It is used in [[makeHistFileName]]
+as part of the history file name.
+
+\subsection{\$inclAssertions}
+The [[$inclAssertions]] is set 
+in the function [[SpadInterpretStream]] to the list [[(aix |CommonLisp|)]]
+
+\subsection{\$internalHistoryTable}
+The [[$internalHistoryTable]] variable is set at load time by a call to
+[[initvars]] to a value of [[NIL]].
+It is part of the history mechanism.
+
+\subsection{\$interpreterFrameName}
+The [[$interpreterFrameName]] variable, set in 
+[[initializeInterpreterFrameRing]] to the constant
+[[initial]] to indicate that this is the initial (default) frame.
+
+Frames are structures that capture all of the variables defined in a
+session. There can be multiple frames and the user can freely switch
+between them. Frames are kept in a ring data structure so you can 
+move around the ring.
+
+\subsection{\$interpreterFrameRing}
+The [[$interpreterFrameRing]] is set to a pair whose car is set to
+the result of [[emptyInterpreterFrame]]
+
+\subsection{\$InitialModemapFrame}
+This variable is copied and returned by the function 
+[[makeInitialModemapFrame]]. There is no initial value so this
+is probably a bug.
+
+\subsection{\$inLispVM}
+The [[$inLispVM]] is set to [[NIL]] in [[spad]]. LispVM is a
+non-common lisp that runs on IBM/370 mainframes. This is probably dead
+code.  It appears that this list has the same structure as an argument
+to the LispVM [[rdefiostream]] function.
+
+\subsection{\$InteractiveFrame}
+The [[$InteractiveFrame]] is set in [[restart]] to the value of the
+call to the [[makeInitialModemapFrame]] function. This function simply
+returns a copy of the variable [[$InitialModemapFrame]]
+
+\subsection{\$InteractiveMode}
+The [[$InteractiveMode]] is set to [[T]] in [[ncTopLevel]].
+
+\subsection{\$intRestart}
+The [[$intRestart]] variable is used in [[intloop]] but has no value.
+This is probably a bug. While the variable's value is unchanged the
+system will continually reenter the [[SpadInterpretStream]] function.
+
+\subsection{\$intTopLevel}
+The [[$intTopLevel]] is a catch tag. Throwing to this tags which is
+caught in the [[intloop]] will 
+restart the [[SpadInterpretStream]] function.
+
+\subsection{\$IOindex}
+The [[$IOindex]] index variable is set to [[1]] in [[restart]].
+This variable is used in the [[historySpad2Cmd]] function in the
+history mechanism. It is set in the [[removeUndoLines]] function
+in the undo mechanism.
+
+This is used in the undo mechanism in function [[undoCount]]
+to compute the number of undos. You can't undo more actions then
+have already happened.
+
+\subsection{\$lastPos}
+The [[$lastPos]] variable is set in [[SpadInterpretStream]]
+to the value of the [[$nopos]] variable.
+Since [[$nopos]] appears to have no value
+this is likely a bug.
+
+\subsection{\$libQuiet}
+The [[$libQuiet]] variable is set to the third argument of the
+[[SpadInterpretStream]] function. This is passed from [[intloop]]
+with the value of [[T]]. This variable appears to be intended to
+control the printing of library loading messages which would need
+to be suppressed if input was coming from a file.
+
+\subsection{\$library-directory-list}
+The [[$library-directory-list]] variable is set by [[reroot]] by
+mapping the function [[make-absolute-filename]] across the 
+[[$relative-library-directory-list]] variable which is not yet set so this
+is probably a bug.
+
+\subsection{\$msgDatabaseName}
+The [[$msgDatabaseName]] is set to [[NIL]] in [[reroot]].
+
+\subsection{\$ncMsgList}
+The [[$ncMsgList]] is set to [[NIL]] in [[SpadInterpretStream]].
+
+\subsection{\$newcompErrorCount}
+The [[$newcompErrorCount]] is set to [[0]] in [[SpadInterpretStream]].
+
+\subsection{\$newcompMode}
+The [[$newcompMode]] is set to [[NIL]] in [[SpadInterpretStream]].
+
+\subsection{\$newspad}
+The [[$newspad]] is set to [[T]] in [[ncTopLevel]].
+
+\subsection{\$nopos}
+The [[$nopos]] variable is used in [[SpadInterpretStream]] but does
+not appear to have a value and is likely a bug.
+
+\subsection{\$oldHistoryFileName}
+The [[$oldHistoryFileName]] is set at load time by a call to 
+[[initvars]] to a value of ``[[last]]''. 
+It is part of the history mechanism. It is used in the function
+[[oldHistFileName]] and [[restoreHistory]].
+
+\subsection{\$okToExecuteMachineCode}
+The [[$okToExecuteMachineCode]] is set to [[T]] in [[SpadInterpretStream]].
+
+\subsection{\$options}
+The [[$options]] variable is tested by the [[history]] function.
+If it is [[NIL]] then output the message 
+\begin{verbatim}
+  You have not used the correct syntax for the history command.
+  Issue )help history for more information.
+\end{verbatim}
+
+The [[$options]] variable is tested in the [[historySpad2Cmd]] function.
+It appears to record the options that were given to a spad command on
+the input line. The function [[selectOptionLC]] appears to take a list
+off options to scan.
+
+This variable is not yet set and is probably a bug.
+
+\subsection{\$previousBindings}
+The [[$previousBindings]] is a copy of the 
+[[CAAR $InteractiveFrame]]. This is used to
+compute the [[delta(i)]]s stored in [[$frameRecord]].
+This is part of the undo mechanism.
+
+\subsection{\$printLoadMsgs}
+The [[$printLoadMsgs]] variable is set to [[T]] in [[restart]].
+
+\subsection{\$PrintCompilerMessageIfTrue}
+The [[$PrintCompilerMessageIfTrue]] variable is set to [[NIL]] in [[spad]].
+
+\subsection{\$openServerIfTrue}
+The [[$openServerIfTrue]] is tested in [[restart]] before it has been
+set (and is thus a bug). It appears to control whether the interpreter
+will be used as an open server, probably for OpenMath use.
+
+If an open server is not requested then this variable to [[NIL]]
+
+\subsection{\$promptMsg}
+The [[$promptMsg]] variable is set to the constant [[S2CTP023]]. This 
+constant points to a message in [[src/doc/msgs/s2-us.msgs]]. This message
+does nothing but print the argument value.
+
+\subsection{\$relative-directory-list}
+The [[$relative-directory-list]] is used in [[reroot]] to create 
+[[$directory-list]] which is a list of absolute directory names.
+It is not yet set and is probably a bug.
+
+\subsection{\$relative-library-directory-list}
+The [[$relative-library-directory-list]] is used in [[reroot]] to create
+a list of absolute directory names from [[$library-directory-list]] (which is 
+It is not yet set and is probably a bug).
+
+\subsection{\$reportUndo}
+The [[$reportUndo]] variable is used in [[diffAlist]]. It was not normally
+bound but has been set to [[T]] in [[initvars]]. If the variable is set
+to [[T]] then we call [[reportUndo]].
+
+It is part of the undo mechanism.
+
+\subsection{\$shoeReadLineFunction}
+The [[$shoeReadLineFunction]] is set in [[SpadInterpretStream]]
+to point to the 
+[[serverReadLine]] 
+
+\subsection{\$spadroot}
+The [[$spadroot]] variable is the internal name for the [[AXIOM]]
+shell variable. 
+
+The [[$spadroot]] variable is set in [[reroot]] to the value of the
+argument. The argument is expected to be a directory name. 
+
+The [[$spadroot]] variable is tested in [[initroot]].
+
+The [[$spadroot]] variable is used by the function 
+[[make-absolute-filename]]. It concatenates this variable to the 
+front of a relative pathname to make it absolute.
+\subsection{\$spad}
+The [[$spad]] variable is set to [[T]] in [[ncTopLevel]].
+
+\subsection{\$SpadServer}
+If an open server is not requested then this variable to [[T]].
+It has no value before this time (and is thus a bug).
+
+\subsection{\$SpadServerName}
+The [[$SpadServerName]] is passed to the [[openServer]] function, if the
+function exists. 
+
+\subsection{\$systemCommandFunction}
+The [[$systemCommandFunction]] is set in [[SpadInterpretStream]]
+to point to the function
+[[InterpExecuteSpadSystemCommand]].
+
+\subsection{top\_level}
+The [[top\_level]] symbol is a catch tag used in [[runspad]]
+to catch an exit from [[ncTopLevel]].
+
+\subsection{\$quitTag}
+The [[$quitTag]] is used as a variable in a [[catch]] block. 
+It appears that it can be thrown somewhere below [[ncTopLevel]].
+
+\subsection{\$useInternalHistoryTable}
+The [[$useInternalHistoryTable]] variable is set at load time by a call to
+[[initvars]] to a value of [[NIL]]. It is part of the history mechanism.
+
+\subsection{\$undoFlag}
+The [[$undoFlag]] is used in [[recordFrame]] to decide whether to do
+undo recording. It is initially set to [[T]] in [[initvars]].
+This is part of the undo mechanism.
+
+\chapter{Starting Axiom}
+Axiom starts by invoking a function value of the lisp symbol
+[[*top-level-hook*]]. The function invocation path to from this
+point until the prompt is approximates (skipping initializations):
+\begin{verbatim}
+  lisp -> restart
+       -> |spad|
+       -> |runspad|
+       -> |ncTopLevel|
+       -> |ncIntLoop|
+       -> |intloop|
+       -> |SpadInterpretStream|
+       -> |intloopReadConsole|
+\end{verbatim}
+The [[|intloopReadConsole|]] function does tail-recursive calls to
+itself (don't break this) and never exits.
+\section{Variables Used}
+\section{Data Structures}
+\section{Functions}
+\subsection{defun set-restart-hook}
+When a lisp image containing code is reloaded there is a hook to
+allow a function to be called. In our case it is the [[restart]]
+function which is the entry to the Axiom interpreter.
+<<defun set-restart-hook>>=
+(defun set-restart-hook ()
+  #+KCL (setq system::*top-level-hook* 'restart)
+  #+Lucid (setq boot::restart-hook 'restart)
+  'restart
+ )
+
+@
+\subsection{defun restart}
+The restart function is the real root of the world. It sets up memory
+if we are working in a GCL/akcl version of the system. It sets the
+current package to be the ``BOOT'' package which is the standard
+package in which the interpreter runs. It calls initroot \cite{1}
+to set the \$spadroot variable (usually the \$AXIOM variable).
+
+The [[compiler::*compile-verbose*]] flag has been set to nil globally.
+We do not want to know about the microsteps of GCL's compile facility.
+
+The [[compiler::*suppress-compiler-warnings*]] flag has been set to t.
+We do not care that certain generated variables are not used.
+
+The [[compiler::*suppress-compiler-notes*]] flag has been set to t.
+We do not care that tail recursion occurs.
+<<defun restart>>=
+(defun restart ()
+#+:akcl
+  (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+    :array 400 :string 500 :cfun 100 :cpages 3000 :rpages 1000 :hole 2000)
+#+:akcl (setq compiler::*compile-verbose* nil)
+#+:akcl (setq compiler::*suppress-compiler-warnings* t)
+#+:akcl (setq compiler::*suppress-compiler-notes* t)
+#-:CCL
+  (in-package "BOOT")
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:CCL (setpchar "") ;; Turn off CCL read prompts
+#+(OR :akcl :CCL) (initroot)
+#+:akcl (system:gbc-time 0)
+#+:akcl
+  (when (and $openServerIfTrue (fboundp '|openServer|))
+   (prog (os)
+    (setq os (|openServer| $SpadServerName))
+    (if (zerop os) 
+     (progn 
+      (setq $openServerIfTrue nil) 
+      (setq |$SpadServer| t)))))
+;; We do the following test at runtime to allow us to use the same images
+;; with Saturn and Sman.  MCD 30-11-95
+#+:CCL
+  (when 
+     (and (memq :unix *features*) $openServerIfTrue (fboundp '|openServer|))
+   (prog (os)
+    (setq os (|openServer| $SpadServerName))
+    (if (zerop os) 
+     (progn 
+      (setq $openServerIfTrue nil) 
+      (setq |$SpadServer| t)))))
+  (setq |$IOindex| 1)
+  (setq |$InteractiveFrame| (|makeInitialModemapFrame|))
+  (setq |$printLoadMsgs| t)
+#+(and :lucid :ibm/370)
+  (setq vmlisp::$current-directory "")
+#-(and :lucid :ibm/370)
+  (setq vmlisp::$current-directory
+     (make-directory *default-pathname-defaults*))
+  (|loadExposureGroupData|)
+  (|statisticsInitialization|)
+  (|initHist|)
+  (|initializeInterpreterFrameRing|)
+
+  (when |$displayStartMsgs| 
+   (|spadStartUpMsgs|))
+  (setq |$currentLine| nil)
+  (restart0)
+  (|readSpadProfileIfThere|)
+  (|spad|))
+
+@
+
+\subsection{defun SpadInterpretStream}
+The [[SpadInterpretStream]] function takes three arguments
+\begin{list}{}
+\item [[str]] This is passed as an argument to [[intloopReadConsole]]
+\item [[source]] This is the name of a source file but appears not
+to be used. It is set to the list [[(tim daly ?)]].
+\item [[interactive?]] If this is false then various messages are 
+suppressed and input does not use piles. If this is true then the
+library loading routines might output messages and piles are expected
+on input (as from a file).
+\end{list}
+
+
+\section{Helper Functions}
+\subsection{defun reclaim}
+Call the garbage collector on various platforms.
+<<defun reclaim>>=
+#+abcl 
+(defun reclaim () (ext::gc))
+#+:allegro
+(defun reclaim () (excl::gc t))
+#+:CCL
+(defun reclaim () (gc))
+#+clisp
+(defun reclaim () (#+lisp=cl ext::gc #-lisp=cl lisp::gc))
+#+(or :cmulisp :cmu)
+(defun reclaim () (ext:gc))
+#+cormanlisp
+(defun reclaim () (cl::gc))
+#+(OR IBCL KCL GCL)
+(defun reclaim () (si::gbc t))
+#+lispworks 
+(defun reclaim () (hcl::normal-gc))
+#+Lucid
+(defun reclaim () (lcl::gc))
+#+sbcl
+(defun reclaim () (sb-ext::gc))
+@
+\subsection{defun getenviron}
+<<defun getenviron>>=
+(defun getenviron (shellvar)
+ #+allegro (sys::getenv (string var))
+ #+clisp (ext:getenv (string var))
+ #+(or cmu scl)
+  (cdr 
+   (assoc (string var) ext:*environment-list* :test #'equalp :key #'string))
+ #+(or kcl akcl gcl) (si::getenv (string var))
+ #+lispworks (lw:environment-variable (string var))
+ #+lucid (lcl:environment-variable (string var))
+ #+mcl (ccl::getenv var)
+ #+sbcl (sb-ext:posix-getenv var)
+ )
+@
+\subsection{defun init-memory-config}
+Austin-Kyoto Common Lisp (AKCL), now known as Gnu Common Lisp (GCL)
+requires some changes to the default memory setup to run Axiom efficently.
+This function performs those setup commands. 
+<<defun init-memory-config>>=
+(defun init-memory-config (&key
+			   (cons 500)
+			   (fixnum 200)
+			   (symbol 500)
+			   (package 8)
+			   (array 400)
+			   (string 500)
+			   (cfun 100)
+			   (cpages 3000)
+			   (rpages 1000)
+			   (hole 2000) )
+  ;; initialize AKCL memory allocation parameters
+  #+:AKCL
+  (progn
+    (system:allocate 'cons cons)
+    (system:allocate 'fixnum fixnum)
+    (system:allocate 'symbol symbol)
+    (system:allocate 'package package)
+    (system:allocate 'array array)
+    (system:allocate 'string string)
+    (system:allocate 'cfun cfun)
+    (system:allocate-contiguous-pages cpages)
+    (system:allocate-relocatable-pages rpages)
+    (system:set-hole-size hole))
+  #-:AKCL
+  nil)
+
+@
+\subsection{defun initroot}
+Sets up the system to use the {\bf AXIOM} shell variable if we can
+and default to the {\bf \$spadroot} variable (which was the value
+of the {\bf AXIOM} shell variable at build time) if we can't.
+<<defun initroot>>=
+(defun initroot (&optional (newroot (BOOT::|getEnv| "AXIOM")))
+  (reroot (or newroot $spadroot (error "setenv AXIOM or (setq $spadroot)"))))
+
+@
+\subsection{defun loadExposureGroupData}
+<<defun loadExposureGroupData>>=
+#+:AKCL
+(defun |loadExposureGroupData| ()
+ (cond
+  ((load "./exposed" :verbose nil :if-does-not-exist nil)
+    '|done|)
+  ((load (concat (system:getenv "AXIOM") "/algebra/exposed")
+     :verbose nil :if-does-not-exist nil)
+   '|done|)
+  (t '|failed|) ))
+
+#+:CCL
+(defun |loadExposureGroupData| ()
+ (cond
+  ((load "./exposed.lsp" :verbose NIL :if-does-not-exist NIL) '|done|)
+  ((load (concat (BOOT::|getEnv| "AXIOM") "/../../src/algebra/exposed.lsp") 
+    :verbose nil :if-does-not-exist nil) '|done|)
+  (t nil) ))
+
+@
+\subsection{make-absolute-filename}
+Prefix a filename with the {\bf AXIOM} shell variable.
+<<defun make-absolute-filename>>=
+(defun make-absolute-filename (name)
+ (concatenate 'string $spadroot name))
+
+@
+
+\subsection{defun reroot}
+The reroot function is used to reset the important variables used by
+the system. In particular, these variables are sensitive to the
+{\bf AXIOM} shell variable. That variable is renamed internally to
+be {\bf \$spadroot}. The {\bf reroot} function will change the
+system to use a new root directory and will have the same effect
+as changing the {\bf AXIOM} shell variable and rerunning the system
+from scratch. Note that we have changed from the
+NAG distribution back to the original form. If you need the NAG
+version you can push {\bf :tpd} on the {\bf *features*} variable
+before compiling this file. A correct call looks like:
+\begin{verbatim}
+(in-package "BOOT")
+(reroot "/spad/mnt/${SYS}")
+\end{verbatim}
+where the [[${SYS}]] variable is the same one set at build time.
+<<defun reroot>>=
+(defun reroot (dir)
+  (setq $spadroot dir)
+  (setq $directory-list
+   (mapcar #'make-absolute-filename $relative-directory-list))
+  (setq $library-directory-list
+   (mapcar #'make-absolute-filename $relative-library-directory-list))
+  (setq |$defaultMsgDatabaseName|
+	(pathname (make-absolute-filename "/share/msgs/s2-us.msgs")))
+  (setq |$msgDatabaseName| ())
+  (setq $current-directory $spadroot))
+
+@
+\subsection{defun statisticsInitialization}
+<<defun statisticsInitialization>>=
+(defun |statisticsInitialization| () 
+ "initialize the garbage collection timer"
+ #+:akcl (system:gbc-time 0)
+ nil)
+
+@
+\chapter{The History Mechanism}
+\section{)history}
+\index{ugSysCmdhistory}
+
+\index{history}
+
+
+\par\noindent{\bf User Level Required:} interpreter
+
+\par\noindent{\bf Command Syntax:}
+\begin{list}{}
+\item{\tt )history )on}
+\item{\tt )history )off}
+\item{\tt )history )write} {\it historyInputFileName}
+\item{\tt )history )show [{\it n}] [both]}
+\item{\tt )history )save} {\it savedHistoryName}
+\item{\tt )history )restore} [{\it savedHistoryName}]
+\item{\tt )history )reset}
+\item{\tt )history )change} {\it n}
+\item{\tt )history )memory}
+\item{\tt )history )file}
+\item{\tt \%}
+\item{\tt \%\%({\it n})}
+\item{\tt )set history on | off}
+\end{list}
+
+\par\noindent{\bf Command Description:}
+
+The {\it history} facility within Axiom allows you to restore your
+environment to that of another session and recall previous
+computational results.
+Additional commands allow you to review previous
+input lines and to create an {\bf .input} file of the lines typed to
+\index{file!input}
+Axiom.
+
+Axiom saves your input and output if the history facility is
+turned on (which is the default).
+This information is saved if either of
+\begin{verbatim}
+)set history on
+)history )on
+\end{verbatim}
+has been issued.
+Issuing either
+\begin{verbatim}
+)set history off
+)history )off
+\end{verbatim}
+will discontinue the recording of information.
+\index{history )on}
+\index{set history on}
+\index{set history off}
+\index{history )off}
+
+Whether the facility is disabled or not,
+the value of {\tt \%} in Axiom always
+refers to the result of the last computation.
+If you have not yet entered anything,
+{\tt \%} evaluates to an object of type
+{\tt Variable('\%)}.
+The function {\tt \%\%} may be  used to refer
+to other previous results if the history facility is enabled.
+In that case,
+{\tt \%\%(n)} is  the output from step {\tt n} if {\tt n > 0}.
+If {\tt n < 0}, the step is computed relative to the current step.
+Thus {\tt \%\%(-1)} is also the previous step,
+{\tt \%\%(-2)}, is the  step before that, and so on.
+If an invalid step number is given, Axiom will signal an error.
+
+The {\it environment} information can either be saved in a file or entirely in
+memory (the default).
+Each frame 
+(\ref{ugSysCmdframe} on page~\pageref{ugSysCmdframe})
+has its own history database.
+When it is kept in a file, some of it may also be kept in memory for
+efficiency.
+When the information is saved in a file, the name of the file is
+of the form {\bf FRAME.axh} where ``{\bf FRAME}'' is the name of the
+current frame.
+The history file is placed in the current working directory
+(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}).
+Note that these history database files are not text files (in fact,
+they are directories themselves), and so are not in human-readable
+format.
+
+The options to the {\tt )history} command are as follows:
+
+\begin{description}
+\item[{\tt )change} {\it n}]
+will set the number of steps that are saved in memory to {\it n}.
+This option only has effect when the history data is maintained in a
+file.
+If you have issued {\tt )history )memory} (or not changed the default)
+there is no need to use {\tt )history )change}.
+\index{history )change}
+
+\item[{\tt )on}]
+will start the recording of information.
+If the workspace is not empty, you will be asked to confirm this
+request.
+If you do so, the workspace will be cleared and history data will begin
+being saved.
+You can also turn the facility on by issuing {\tt )set history on}.
+
+\item[{\tt )off}]
+will stop the recording of information.
+The {\tt )history )show} command will not work after issuing this
+command.
+Note that this command may be issued to save time, as there is some
+performance penalty paid for saving the environment data.
+You can also turn the facility off by issuing {\tt )set history off}.
+
+\item[{\tt )file}]
+indicates that history data should be saved in an external file on disk.
+
+\item[{\tt )memory}]
+indicates that all history data should be kept in memory rather than
+saved in a file.
+Note that if you are computing with very large objects it may not be
+practical to kept this data in memory.
+
+\item[{\tt )reset}]
+will flush the internal list of the most recent workspace calculations
+so that the data structures may be garbage collected by the underlying
+Common Lisp system.
+Like {\tt )history )change}, this option only has real effect when
+history data is being saved in a file.
+
+\item[{\tt )restore} [{\it savedHistoryName}]]
+completely clears the environment and restores it to a saved session, if
+possible.
+The {\tt )save} option below allows you to save a session to a file
+with a given name. If you had issued
+{\tt )history )save jacobi}
+the command
+{\tt )history )restore jacobi}
+would clear the current workspace and load the contents of the named
+saved session. If no saved session name is specified, the system looks
+for a file called {\bf last.axh}.
+
+\item[{\tt )save} {\it savedHistoryName}]
+is used to save  a snapshot of the environment in a file.
+This file is placed in the current working directory
+(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}).
+Use {\tt )history )restore} to restore the environment to the state
+preserved in the file.
+This option also creates an input file containing all the lines of input
+since you created the workspace frame (for example, by starting your
+Axiom session) or last did a {\tt )clear all} or
+{\tt )clear completely}.
+
+\item[{\tt )show} [{\it n}] [{\tt both}]]
+can show previous input lines and output results.
+{\tt )show} will display up to twenty of the last input lines
+(fewer if you haven't typed in twenty lines).
+{\tt )show} {\it n} will display up to {\it n} of the last input lines.
+{\tt )show both} will display up to five of the last input lines and
+output results.
+{\tt )show} {\it n} {\tt both} will display up to {\it n} of the last
+input lines and output results.
+
+\item[{\tt )write} {\it historyInputFile}]
+creates an {\bf .input} file with the input lines typed since the start
+of the session/frame or the last {\tt )clear all} or {\tt )clear
+completely}.
+If {\it historyInputFileName} does not contain a period (``.'') in the filename,
+{\bf .input} is appended to it.
+For example,
+{\tt )history )write chaos}
+and
+{\tt )history )write chaos.input}
+both write the input lines to a file called {\bf chaos.input} in your
+current working directory.
+If you issued one or more {\tt )undo} commands,
+{\tt )history )write}
+eliminates all
+input lines backtracked over as a result of {\tt )undo}.
+You can edit this file and then use {\tt )read} to have Axiom process
+the contents.
+\end{description}
+
+\par\noindent{\bf Also See:}
+{\tt )frame} \index{ugSysCmdframe},
+{\tt )read} \index{ugSysCmdread},
+{\tt )set} \index{ugSysCmdset}, and
+{\tt )undo} \index{ugSysCmdundo}.
+
+
+History recording is done in two different ways:
+\begin{itemize}
+\item all changes in variable bindings (i.e. previous values) are
+    written to [[$HistList]], which is a circular list
+\item all new bindings (including the binding to [[%]]) are written to a
+    file called [[histFileName()]]
+    one older session is accessible via the file [[$oldHistFileName()]]
+\end{itemize}
+
+\section{Variables Used}
+The following global variables are used:
+\begin{list}{}
+\item [[$HistList]], [[$HistListLen]] and [[$HistListAct]] which is the
+       actual number of ``undoable'' steps)
+\item [[$HistRecord]] collects the input line, all variable bindings
+      and the output of a step, before it is written to the file
+      [[histFileName()]].
+\item [[$HiFiAccess]] is a flag, which is reset by [[)history )off]]
+\end{list}
+The result of step n can be accessed by [[%n]], which is translated
+into a call of [[fetchOutput(n)]]. The 
+[[updateHist]] is called after every interpreter step. The 
+[[putHist]] function records all changes in the environment to [[$HistList]]
+  and [[$HistRecord]]
+ 
+\subsection{Initialized history variables}
+\begin{verbatim}
+\end{verbatim}
+ 
+<<initvars>>=
+(defvar |$historyDirectory| 'A        "vm/370 filename disk component")
+(defvar |$HiFiAccess| t               "t means turn on history mechanism")
+@
+
+\section{Data Structures}
+\section{Functions}
+
+\subsection{defun setHistoryCore}
+We [[case]] on the [[inCore]] argument value
+\begin{list}{}
+\item If history is already on and is kept in the same location as requested
+(file or memory) then complain.
+\item If history is not in use then start using the file or memory as 
+requested. This is done by simply setting the [[$useInternalHistoryTable]] 
+to the requested value, where [[T]] means use memory and [[NIL]] means
+use a file. We tell the user.
+\item If history should be in memory, that is [[inCore]] is not [[NIL]],
+and the history file already contains information we read the information
+from the file, store it in memory, and erase the history file. We modify
+[[$useInternalHistoryTable]] to [[T]] to indicate that we're maintining
+the history in memory and tell the user.
+\item Otherwise history must be on and in memory. We erase any old history
+file and then write the in-memory history to a new file
+\end{list}
+
+
+\section{History File Messages}
+<<History File Messages>>=
+S2IH0001
+ You have not reached step %1b yet, and so its value cannot be
+ supplied.
+S2IH0002
+ Cannot supply value for step %1b because 1 is the first step.
+S2IH0003
+ Step %1b has no value.
+S2IH0004
+ The history facility is not on, so you cannot use %b %% %d .
+S2IH0006
+ You have not used the correct syntax for the %b history %d command.
+ Issue %b )help history %d for more information.
+S2IH0007
+ The history facility is already on.
+S2IH0008
+ The history facility is now on.
+S2IH0009
+ Turning on the history facility will clear the contents of the
+ workspace.
+ Please enter %b y %d or %b yes %d if you really want to do this:
+S2IH0010
+ The history facility is still off.
+S2IH0011
+ The history facility is already off.
+S2IH0012
+ The history facility is now off.
+S2IH0013
+ The history facility is not on, so the .input file containing your user input
+ cannot be created.
+S2IH0014
+ Edit %b %1 %d to see the saved input lines.
+S2IH0015
+ The argument %b n %d for %b )history )change n must be a nonnegative
+ integer and your argument, %1b , is not one.
+S2IH0016
+ The history facility is not on, so no information can be saved.
+S2IH0018
+ The saved history file is %1b .
+S2IH0019
+ There is no history file, so value of step %1b is
+ undefined.
+S2IH0022
+ No history information had been saved yet.
+S2IH0023
+ %1b is not a valid filename for the history file.
+S2IH0024
+ History information cannot be restored from %1b because the file does
+ not exist.
+S2IH0025
+ The workspace has been successfully restored from the history file
+ %1b .
+S2IH0026
+ The history facility command %1b cannot be performed because the
+ history facility is not on.
+S2IH0027
+ A value containing a %1b is being saved in a history file or a
+ compiled input file INLIB. This type
+ is not yet usable in other history operations.  You might want to issue
+ %b )history )off %d
+S2IH0029
+ History information is already being maintained in an external file
+ (and not in memory).
+S2IH0030
+ History information is already being maintained in memory (and not
+ in an external file).
+S2IH0031
+ When the history facility is active, history information will be
+ maintained in a file (and not in an internal table).
+S2IH0032
+ When the history facility is active, history information will be
+ maintained in memory (and not in an external file).
+S2IH0034
+ Missing element in internal history table.
+S2IH0035
+ Can't save the value of step number %1b.  You can re-generate this value
+ by running the input file %2b.
+S2IH0036
+ The value specified cannot be saved to a file.
+S2IH0037
+ You must specify a file name to the history save command
+S2IH0038
+ You must specify a file name to the history write command
+@
+
+\chapter{The Frame Mechanism}
+\section{)frame}
+%\label{ugSysCmdframe}
+%\index{frame}
+\par\noindent{\bf Command Syntax:}
+\begin{list}{}
+\item{\tt )frame  new  {\it frameName}}
+\item{\tt )frame  drop  {\it [frameName]}}
+\item{\tt )frame  next}
+\item{\tt )frame  last}
+\item{\tt )frame  names}
+\item{\tt )frame  import {\it frameName} {\it [objectName1 [objectName2 ...]]}}
+\item{\tt )set message frame on | off}
+\item{\tt )set message prompt frame}
+\end{list}
+
+\par\noindent{\bf Command Description:}
+
+A {\it frame} can be thought of as a logical session within the
+physical session that you get when you start the system.  You can
+have as many frames as you want, within the limits of your computer's
+storage, paging space, and so on.
+Each frame has its own {\it step number}, {\it environment} and {\it history.}
+You can have a variable named {\tt a} in one frame and it will
+have nothing to do with anything that might be called {\tt a} in
+any other frame.
+
+Some frames are created by the HyperDoc program and these can
+have pretty strange names, since they are generated automatically.
+\index{frame names}
+To find out the names
+of all frames, issue
+\begin{verbatim}
+)frame names
+\end{verbatim}
+It will indicate the name of the current frame.
+
+You create a new frame
+\index{frame new}
+``{\bf quark}'' by issuing
+\begin{verbatim}
+)frame new quark
+\end{verbatim}
+The history facility can be turned on by issuing either
+{\tt )set history on} or {\tt )history )on}.
+If the history facility is on and you are saving history information
+in a file rather than in the Axiom environment
+then a history file with filename {\bf quark.axh} will
+be created as you enter commands.
+If you wish to go back to what
+you were doing in the
+\index{frame next}
+``{\bf initial}'' frame, use
+\index{frame last}
+\begin{verbatim}
+)frame next
+\end{verbatim}
+or
+\begin{verbatim}
+)frame last
+\end{verbatim}
+to cycle through the ring of available frames to get back to
+``{\bf initial}''.
+
+If you want to throw
+away a frame (say ``{\bf quark}''), issue
+\begin{verbatim}
+)frame drop quark
+\end{verbatim}
+If you omit the name, the current frame is dropped.
+\index{frame drop}
+
+If you do use frames with the history facility on and writing to a file,
+you may want to delete some of the older history files.
+\index{file!history}
+These are directories, so you may want to issue a command like
+{\tt rm -r quark.axh} to the operating system.
+
+You can bring things from another frame by using
+\index{frame import}
+{\tt )frame import}.
+For example, to bring the {\tt f} and {\tt g} from the frame ``{\bf quark}''
+to the current frame, issue
+\begin{verbatim}
+)frame import quark f g
+\end{verbatim}
+If you want everything from the frame ``{\bf quark}'', issue
+\begin{verbatim}
+)frame import quark
+\end{verbatim}
+You will be asked to verify that you really want everything.
+
+There are two {\tt )set} flags
+\index{set message frame}
+to make it easier to tell where you are.
+\begin{verbatim}
+)set message frame on | off
+\end{verbatim}
+will print more messages about frames when it is set on.
+By default, it is off.
+\begin{verbatim}
+)set message prompt frame
+\end{verbatim}
+will give a prompt
+\index{set message prompt frame}
+that looks like
+\begin{verbatim}
+initial (1) ->
+\end{verbatim}
+\index{prompt!with frame name}
+when you start up. In this case, the frame name and step make up the
+prompt.
+
+\par\noindent{\bf Also See:}
+{\tt )history} \index{ugSysCmdhistory} and
+{\tt )set} \index{ugSysCmdset}.
+
+
+@
+\section{Variables Used}
+\section{Data Structures}
+\section{Functions}
+
+
+\section{Frame File Messages}
+<<Frame File Messages>>=
+S2IZ0016
+ The %1b system command takes arguments but no options.
+S2IZ0017
+ %1b is not a valid frame name
+S2IZ0018
+ You must provide a name for the new frame.
+S2IZ0019
+ You cannot use the name %1b for a new frame because an existing
+ frame already has that name.
+S2IZ0020
+ There is only one frame active and therefore that cannot be closed.
+ Furthermore, the frame name you gave is not the name of the current frame.
+ The current frame is called %1b .
+S2IZ0021
+ The current frame is the only active one.  Issue %b )clear all %d to
+ clear its contents.
+S2IZ0022
+ There is no frame called %1b and so your command cannot be
+ processed.
+S2IZ0024
+ The names of the existing frames are: %1 %l
+ The current frame is the first one listed.
+S2IZ0073
+ %b )frame import %d must be followed by the frame name. The names
+ of objects in that frame can then optionally follow the frame name.
+ For example,
+ %ceon %b )frame import calculus %d %ceoff
+ imports all objects in the %b calculus %d frame, and
+ %ceon %b )frame import calculus epsilon delta %d %ceoff
+ imports the objects named %b epsilon %d and %b delta %d from the
+ frame %b calculus %d .
+ Please note that if the current frame contained any information
+ about objects with these names, then that information would be
+ cleared before the import took place.
+S2IZ0074
+ You cannot import anything from the frame %1b because that is not
+ the name of an existing frame.
+S2IZ0075
+ You cannot import from the current frame (nor is there a need!).
+S2IZ0076
+ User verification required:
+ do you really want to import everything from the frame %1b ?
+ If so, please enter %b y %d or %b yes %d :
+S2IZ0077
+ On your request, AXIOM will not import everything from frame %1b.
+S2IZ0078
+ Import from frame %1b is complete. Please issue %b )display all %d
+ if you wish to see the contents of the current frame.
+S2IZ0079
+ AXIOM cannot import %1b from frame %2b because it cannot be found.
+@
+\chapter{The Undo Mechanism}
+\section{)undo}
+\index{ugSysCmdundo}
+
+\index{undo}
+
+
+\par\noindent{\bf User Level Required:} interpreter
+
+\par\noindent{\bf Command Syntax:}
+\begin{list}{}
+\item{\tt )undo}
+\item{\tt )undo} {\it integer}
+\item{\tt )undo} {\it integer [option]}
+\item{\tt )undo} {\tt )redo}
+\end{list}
+%
+where {\it option} is one of
+%
+\begin{list}{}
+\item{\tt )after}
+\item{\tt )before}
+\end{list}
+
+\par\noindent{\bf Command Description:}
+
+This command is used to
+restore the state of the user environment to an earlier
+point in the interactive session.
+The argument of an {\tt )undo} is an integer which must designate some
+step number in the interactive session.
+
+\begin{verbatim}
+)undo n
+)undo n )after
+\end{verbatim}
+These commands return the state of the interactive
+environment to that immediately after step {\tt n}.
+If {\tt n} is a positive number, then {\tt n} refers to step nummber
+{\tt n}. If {\tt n} is a negative number, it refers to the \tt n-th
+previous command (that is, undoes the effects of the last $-n$
+commands).
+
+A {\tt )clear all} resets the {\tt )undo} facility.
+Otherwise, an {\tt )undo} undoes the effect of {\tt )clear} with
+options {\tt properties}, {\tt value}, and {\tt mode}, and
+that of a previous {\tt undo}.
+If any such system commands are given between steps $n$ and
+$n + 1$ ($n > 0$), their effect is undone
+for {\tt )undo m} for any $0 < m \leq n$..
+
+The command {\tt )undo} is equivalent to {\tt )undo -1} (it undoes
+the effect of the previous user expression).
+The command {\tt )undo 0} undoes any of the above system commands
+issued since the last user expression.
+
+\begin{verbatim}
+)undo n )before
+\end{verbatim}
+This command returns the state of the interactive
+environment to that immediately before step {\tt n}.
+Any {\tt )undo} or {\tt )clear} system commands
+given before step {\tt n} will not be undone.
+
+\begin{verbatim}
+)undo )redo
+\end{verbatim}
+This command reads the file {\tt redo.input}.
+created by the last {\tt )undo} command.
+This file consists of all user input lines, excluding those
+backtracked over due to a previous {\tt )undo}.
+
+\par\noindent{\bf Also See:}
+{\tt )history} \index{ugSysCmdhistory}.
+The command {\tt )history )write} will eliminate the ``undone'' command
+lines of your program.
+\section{Variables Used}
+\section{Data Structures}
+[[$frameRecord = [delta1, delta2,... ] ]] where
+[[delta(i)]] contains changes in the ``backwards'' direction.
+Each [[delta(i)]] has the form [[((var . proplist)...)]] where
+proplist denotes an ordinary proplist. For example, an entry
+of the form [[((x (value) (mode (Integer)))...)]] indicates that
+to undo 1 step, [[x]]'s value is cleared and its mode should be set
+to [[(Integer)]].
+
+A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special
+delta indicating changes due to system commands executed between
+the last command and the current command. By recording these deltas
+separately, it is possible to undo to either BEFORE or AFTER
+the command. These special [[delta(i)]]s are given ONLY when a
+a system command is given which alters the environment.
+
+Note: [[recordFrame('system)]] is called before a command is executed, and
+[[recordFrame('normal)]] is called after (see processInteractive1).
+If no changes are found for former, no special entry is given.
+
+The [[$previousBindings]] is a copy of the 
+[[CAAR $InteractiveFrame]]. This is used to
+compute the [[delta(i)]]s stored in [[$frameRecord]].
+\section{Functions}
+\subsection{Initial Undo Variables}
+\begin{verbatim}
+\end{verbatim}
+<<initvars>>=
+(defvar |$reportUndo| nil "t means we report the steps undo takes")
+@
+
+
+\subsection{defun reportUndo}
+This function is enabled by setting [[|$reportUndo]] to a non-nil value.
+An example of the output generated is:
+\begin{verbatim}
+r := binary(22/7)
+ 
+
+           ___
+   (1)  11.001
+                                                        Type: BinaryExpansion
+Properties of % ::
+  value was: NIL
+  value is:  ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1)))
+Properties of r ::
+  value was: NIL
+  value is:  ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1)))
+
+\end{verbatim}
+
+
+\chapter{The Spad Server Mechanism}
+<<initvars>>=
+(defvar $openServerIfTrue t "t means try starting an open server")
+(defconstant $SpadServerName "/tmp/.d" "the name of the spad server socket")
+(defvar |$SpadServer| nil "t means Scratchpad acts as a remote server")
+
+@
+
+\chapter{Axiom Build-time Functions}
+\subsection{defun spad-save}
+The {\bf spad-save} function is just a cover function for more
+lisp system specific save functions. There is no standard name
+for saving a lisp image so we make one and conditionalize it
+at compile time.
+
+This function is passed the name of an image that will be saved.
+The saved image contains all of the loaded functions.
+
+This is used in the [[src/interp/Makefile.pamphlet]] in three places:
+\begin{list}{}
+\item creating depsys, an image for compiling axiom.
+
+Some of the Common Lisp code we compile uses macros which
+are assumed to be available at compile time. The {\bf DEPSYS}
+image is created to contain the compile time environment
+and saved. We pipe compile commands into this environment
+to compile from Common Lisp to machine dependent code.
+\begin{verbatim}
+DEPSYS=	${OBJ}/${SYS}/bin/depsys
+\end{verbatim}
+
+\item creating savesys, an image for running axiom.
+
+Once we've compile all of the Common Lisp files we fire up
+a clean lisp image called {\bf LOADSYS}, load all of the
+final executable code and save it out as {\bf SAVESYS}.
+The {\bf SAVESYS} image is copied to the [[${MNT}/${SYS}/bin]]
+subdirectory and becomes the axiom executable image.
+\begin{verbatim}
+LOADSYS= ${OBJ}/${SYS}/bin/lisp
+SAVESYS= ${OBJ}/${SYS}/bin/interpsys
+AXIOMSYS= ${MNT}/${SYS}/bin/AXIOMsys
+\end{verbatim}
+
+
+\item creating debugsys, an image with all interpreted functions loaded.
+
+Occasionally we need to really get into the system internals.
+The best way to do this is to run almost all of the lisp code
+interpreted rather than compiled (note that cfuns.lisp and sockio.lisp
+still need to be loaded in compiled form as they depend on the 
+loader to link with lisp internals). This image is nothing more
+than a load of the file src/interp/debugsys.lisp.pamphlet. If
+you need to make test modifications you can add code to that
+file and it will show up here.
+\begin{verbatim}
+DEBUGSYS=${OBJ}/${SYS}/bin/debugsys
+\end{verbatim}
+\end{list}
+<<defun spad-save>>=
+(defun spad-save (save-file)
+  (setq |$SpadServer| nil)
+  (setq $openServerIfTrue t)
+#+:AKCL
+  (system::save-system save-file)
+#+:allegro
+  (if (fboundp 'boot::restart)
+   (excl::dumplisp :name save-file :restart-function #'boot::restart)
+   (excl::dumplisp :name save-file))
+#+Lucid
+  (if (fboundp 'boot::restart)
+   (sys::disksave save-file :restart-function #'boot::restart)
+   (sys::disksave save-file))
+#+:CCL
+  (preserve)
+)
+
+@
+
+\chapter{The Interpreter}
+<<Interpreter>>=
+(IMPORT-MODULE "vmlisp")
+(in-package "BOOT")
+<<initvars>>
+
+
+<<defun getenviron>>
+
+<<defun init-memory-config>>
+<<defun initroot>>
+
+<<defun loadExposureGroupData>>
+
+<<defun make-absolute-filename>>
+
+<<defun reclaim>>
+
+<<defun reroot>>
+<<defun restart>>
+
+<<defun set-restart-hook>>
+<<defun spad-save>>
+<<defun statisticsInitialization>>
+
+@
+\chapter{Makefile.bookvol5}
+<<*>>=
+LATEX=/usr/bin/latex
+LISP=${AXIOM}/obj/linux/bin/lisp
+TANGLE=/usr/local/bin/NOTANGLE
+WEAVE=/usr/local/bin/NOWEAVE -delay
+
+all: bookvol5
+	@echo 0 done
+
+bookvol5: bookvol5.pamphlet
+	@echo 1 extracting the bookvol5reter
+	${WEAVE} bookvol5.pamphlet >bookvol5.tex
+	${LATEX} bookvol5.tex
+	${LATEX} bookvol5.tex
+	${TANGLE} -R"Interpreter" bookvol5.pamphlet >bookvol5.lisp
+
+remake:	
+	@echo 2 rebuilding the makefile
+	@${TANGLE} bookvol5.pamphlet >Makefile.bookvol5
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bootfuns.lisp.pamphlet b/src/interp/bootfuns.lisp.pamphlet
new file mode 100644
index 00000000..1afbe294
--- /dev/null
+++ b/src/interp/bootfuns.lisp.pamphlet
@@ -0,0 +1,601 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/bootfuns.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+
+
+\section{The [[BOOT]] package}
+
+Everything in axiom that the user references eventually shows
+up here. The interpreter and the algebra are run after switching
+to the boot package (in-package "BOOT") so any symbol that the
+interpreter or algebra uses has to (cough, cough) appear here.
+<<*>>=
+<<license>>
+
+(IMPORT-MODULE "hash")
+(defpackage "BOOT"
+  #+:common-lisp (:use "COMMON-LISP")
+  #-:common-lisp (:use "LISP")
+  (:use "VMLISP" "AxiomCore"))
+
+@
+
+Note that it is confusing the package \Tool{Axiom}'s compiler and
+interpreter use is called [[BOOT]].  It should have been
+[[Spad]], or better yet [[Axiom]].
+
+
+\section{Constants}
+
+\subsection{\$EmptyMode}
+
+[[$EmptyMode]] is a contant whose value is [[$EmptyMode]].
+It is used by [[isPartialMode]] (in [[i-funsel.boot]]) to
+decide if a modemap is partially constructed. If the [[$EmptyMode]]
+constant occurs anywhere in the modemap structure at any depth
+then the modemap is still incomplete. To find this constant the
+[[isPartialMode]] function calls [[CONTAINED |$EmptyMode| Y]]
+which will walk the structure $Y$ looking for this constant.
+<<EmptyMode>>=
+(def-boot-val |$EmptyMode| '|$EmptyMode|    "compiler constant")
+@
+
+
+\section{Portability issues}
+
+This section discusses some portability issues known to affect
+this module.
+
+\subsection{[[compiler-let]]}
+
+The construct [[compiler-let]] is not part of ANSI Lisp, although
+it had been described in CLTL.  Therefore some Lisp implementations
+offer it as extensions.
+
+<<non-portable-codes>>=
+#+:clisp (import 'ext:compiler-let)
+@
+
+\subsection{Missing DFLOAT Transcendental functions}
+
+These functions should be defined for DoubleFloat inputs but are not.
+These are cheap and easy definitions that work but should be rewritten.
+<<Missing DFLOAT Transcendental functions>>=
+(defun sec (x) (/ 1 (cos x)))
+(defun csc (x) (/ 1 (sin x)))
+(defun acsc (x) (asin (/ 1 x)))
+(defun asec (x) (acos (/ 1 x)))
+(defun csch (x) (/ 1 (sinh x)))
+(defun coth (x) (* (cosh x) (csch x)))
+(defun sech (x) (/ 1 (cosh x)))
+(defun acsch (x) (asinh (/ 1 x)))
+(defun acoth (x) (atanh (/ 1 x)))
+(defun asech (x) (acosh (/ 1 x)))
+@
+
+\subsection{The manexp fix}
+
+Contributed by Juergen Weiss from a suggestion by Arthur Norman.
+This is a Mantissa and Exponent function. 
+<<manexp>>=
+#+(or :cmu :akcl :gcl)
+(defun manexp (u)
+  (multiple-value-bind (f e s) 
+    (decode-float u)
+    (cons (* s f) e)))
+
+@
+
+\subsection{The arc cotangent function}
+
+Contributed by Juergen Weiss from Arthur Norman's CCL.
+<<acot>>=
+#+(or :cmu :akcl :gcl)
+(defun acot (a)
+  (if (> a 0.0)
+    (if (> a 1.0)
+       (atan (/ 1.0 a))
+       (- (/ pi 2.0) (atan a)))
+    (if (< a -1.0)
+       (- pi (atan (/ -1.0 a)))
+       (+ (/ pi 2.0) (atan (- a))))))
+
+@
+
+\subsection{The arc cotangent function}
+
+Contributed by Juergen Weiss from Arthur Norman's CCL.
+<<cot>>=
+#+(or :cmu :akcl :gcl)
+(defun cot (a)
+  (if (or (> a 1000.0) (< a -1000.0))
+    (/ (cos a) (sin a))
+    (/ 1.0 (tan a))))
+
+@
+
+\subsection{The get-current-directory function}
+
+Contributed by Juergen Weiss.
+<<getCD>>=
+#+:cmu
+(defun get-current-directory ()
+  (namestring (extensions::default-directory)))
+
+#+(or :akcl :gcl)
+(defun get-current-directory ()
+  (namestring (truename "")))
+
+@
+
+
+<<*>>=
+
+; NAME:	   Boot Package
+; PURPOSE: Provide forward references to Boot Code for functions to be at
+;	   defined at the boot level, but which must be accessible
+;	   not defined at lower levels.
+
+(in-package "BOOT")
+
+<<non-portable-codes>>
+
+(defmacro def-boot-fun (f args where)
+  `(compiler-let nil
+     (defun ,f ,args ,where (print (list ',f . ,args)))
+     (export '(,f) "BOOT")))
+
+(defmacro def-boot-var (p where)
+  `(compiler-let nil
+     (defparameter ,p nil ,where)
+     (export '(,p) "BOOT")))
+
+(defmacro def-boot-val (p val where)
+  `(compiler-let nil
+     (defparameter ,p ,val ,where)
+     (export '(,p) "BOOT")))
+
+(def-boot-fun |initializeSetVariables| (arg) "early temp def")
+(def-boot-fun |updateSourceFiles| (x) "temp def")
+#-:CCL
+(def-boot-val |$timerTicksPerSecond| INTERNAL-TIME-UNITS-PER-SECOND
+    "for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME")
+#+:CCL
+(def-boot-val |$timerTicksPerSecond| 1000
+    "for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME")
+(def-boot-val $boxString
+  (concatenate 'string (list (code-char #x1d) (code-char #xe2)))
+  "this string of 2 chars displays as a box")
+(def-boot-val |$quadSymbol| $boxString "displays an APL quad")
+(def-boot-val |$quadSym| '|$quadSym| "unbound symbol referenced in format.boot")
+(def-boot-val $escapeString  (string (code-char 27))
+   "string for single escape character")
+(def-boot-val $boldString (concatenate 'string $escapeString "[12m")
+  "switch into bold font")
+(def-boot-val $normalString (concatenate 'string $escapeString "[0;10m")
+  "switch back into normal font")
+(def-boot-val $reverseVideoString (concatenate 'string $escapeString "[7m")
+  "switch into reverse video")
+(def-boot-val $underlineString (concatenate 'string $escapeString "[4m")
+  "switch into underline mode")
+(def-boot-val $COMPILE t  "checked in COMP-2 to skip compilation")
+(def-boot-var |$abbreviationTable|		    "???")
+(def-boot-val |$algebraList|
+	'(|QuotientField| |Polynomial|
+	  |UnivariatePoly|
+	  |MultivariatePolynomial|
+	  |DistributedMultivariatePolynomial|
+	  |HomogeneousDistributedMultivariatePolynomial|
+	  |Gaussian| |SquareMatrix|
+	  |RectangularMatrix|)			"???")
+(def-boot-val |$BasicDomains|
+	  '(|Integer| |Float| |Symbol|
+	    |Boolean| |String|)			"???")
+(def-boot-val |$BasicPredicates|
+	  '(FIXP STRINGP FLOATP)		"???")
+(def-boot-val |$BFtag| '-BF-	   "big float marker")
+(def-boot-val |$BigFloat| '(|Float|)		    "???")
+(def-boot-val |$BigFloatOpt| '(|BigFloat| . OPT)    "???")
+(def-boot-val |$Boolean| '(|Boolean|)		    "???")
+(def-boot-val |$BooleanOpt| '(|Boolean| . OPT)	    "???")
+(def-boot-val |$bootStrapMode| ()  "if T compCapsule skips body")
+(def-boot-fun |bootUnionPrint| (x s tt)		    "Interpreter>Coerce.boot")
+(def-boot-fun |break| (msg)			    "Interpreter>Trace.boot")
+(def-boot-fun |breaklet| (fn vars)		    "Interpreter>Trace.boot")
+(def-boot-var |$brightenCommentsFlag|		    "???")
+(def-boot-var |$brightenCommentsIfTrue|		    "???")
+(def-boot-val |$BreakMode| '|query|		    "error.boot")
+(def-boot-var |$cacheAlist|			    "Interpreter>System.boot")
+(def-boot-val |$cacheCount| 0			    "???")
+(def-boot-val |$Category| '(|Category|)		    "???")
+;  modemap:==  ( <map> (p e) (p e) ... (p e) )
+;  modemaplist:= ( modemap ... )
+
+(def-boot-val |$CategoryFrame|
+	  '((((|Category| . ((|modemap| (((|Category|) (|Category|)) (T *)))))
+	      (|Join| . ((|modemap|
+      (((|Category|) (|Category|) (|Category|) (|Category|)) (T *))
+      (((|Category|) (|Category|) (|List| |Category|)) (|Category|)) (T *))
+	)))))
+	"Compiler>CUtil.boot")
+(def-boot-val |$CategoryNames|
+	'(|Category| |CATEGORY| |RecordCategory| |Join|
+	  |StringCategory| |SubsetCategory| |UnionCategory|)
+	"???")
+(def-boot-val |$clamList|
+	  '((|getModemapsFromDatabase| |hash| UEQUAL |count|)
+	    (|getOperationAlistFromLisplib| |hash| UEQUAL |count|)
+	    (|getFileProperty| |hash| UEQUAL |count|)
+	    (|canCoerceFrom| |hash| UEQUAL |count|)
+	    (|selectMms1| |hash| UEQUAL |count|)
+	    (|coerceMmSelection| |hash| UEQUAL |count|)
+	    (|isValidType| |hash| UEQUAL |count|))
+						"Interpreter>Clammed.boot")
+(def-boot-val |$CommonDomains|
+	 '(|Record| |Union| |List| |Vector|
+	   |String| |Float| |Integer|
+	   |NonNegativeInteger| |Expression|
+	   |NonPositiveInteger|
+	   |PositiveInteger| |SmallInteger|
+	   |Boolean|) "???")
+
+(def-boot-var |$compCount|			    "???")
+(def-boot-var |$compileMapFlag|			    "Interpreter>SetVars.boot")
+(def-boot-var |$compUniquelyIfTrue|		    "Compiler>Compiler.boot")
+(def-boot-val |$consistencyCheck| nil		    "Interpreter>Consis.boot")
+(def-boot-val |$ConstructorCache| (MAKE-HASHTABLE 'ID)	"???")
+(def-boot-var |$constructorsNotInDatabase|	    "Interpreter>Database.boot")
+(def-boot-var |$createUpdateFiles|		    "Interpreter>SetVarT.boot")
+(def-boot-var |$croakIfTrue|			    "See moan in U.")
+(def-boot-var |$currentFunction|		    "???")
+(def-boot-val |$currentLine|	""          "current input line for history")
+(def-boot-val $delay 0				    "???")
+(def-boot-var $Directory			    "???")
+(def-boot-var $DISPLAY				    "???")
+(def-boot-val |$Domain| '(|Domain|)		    "???")
+(def-boot-var |$DomainFrame|			    "???")
+(def-boot-val |$DomainNames|
+	'(|Integer| |Float| |Symbol| |Boolean|
+	  |String| |Expression|
+	  |Mapping| |SubDomain| |List| |Union|
+	  |Record| |Vector|)			"???")
+(def-boot-val |$DomainsInScope| '(NIL)		    "???")
+(def-boot-val |$domainTraceNameAssoc| ()    "association list of trace domains")
+(def-boot-val |$DomainVariableList|
+  '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11
+       $12 $13 $14 $15)				"???")
+(def-boot-val |$DoubleQuote| "\""                   "???")
+(def-boot-val |$DummyFunctorNames|
+	  '(|Boolean| |Mapping|)		"???")
+(def-boot-var |$eltIfNil|			    "SpecialFunctions>PSpad.boot")
+(def-boot-val |$EmptyEnvironment| '((NIL))	    "???")
+(def-boot-val |$EmptyList| ()			    "???")
+<<EmptyMode>>
+(def-boot-val |$EM| |$EmptyMode|		    "???")
+(def-boot-val |$EmptyString| ""                     "???")
+(def-boot-val |$EmptyVector| '#()		     "???")
+(def-boot-val |$Expression| '(|Expression|)	    "???")
+(def-boot-val |$ExpressionOpt|
+	  '(|Expression| . OPT)			"???")
+(def-boot-var |$evalDomain|			    "???")
+(def-boot-val |$Exit| '(Exit)	      "compiler constant")
+(def-boot-var |$exitMode|			    "???")
+(def-boot-var |$exitModeStack|			    "???")
+(def-boot-val |$failure| (GENSYM)	    "Symbol denoting a failed operation.")
+(def-boot-val |$false| NIL			    "???")
+(def-boot-val |$Float| '(|Float|)		    "???")
+(def-boot-val |$FloatOpt| '(|Float| . OPT)	    "???")
+(def-boot-val |$FontTable| '(|FontTable|)	    "???")
+(def-boot-var |$forceDatabaseUpdate|		    "See load function.")
+(def-boot-var |$form|				    "???")
+(def-boot-val |$FormalMapVariableList|
+  '(\#1 \#2 \#3 \#4 \#5 \#6 \#7 \#8 \#9
+    \#10 \#11 \#12 \#13 \#14 \#15)		"???")
+(def-boot-val |$FormalMapVariableList2|
+  '(\#\#1 \#\#2 \#\#3 \#\#4 \#\#5 \#\#6 \#\#7 \#\#8 \#\#9
+    \#\#10 \#\#11 \#\#12 \#\#13 \#\#14 \#\#15)		    "???")
+(def-boot-var |$fromSpadTrace|			    "Interpreter>Trace.boot")
+(def-boot-var $function				    "Interpreter>System.boot")
+(def-boot-var $FunName				    "???")
+(def-boot-var $FunName_Tail			    "???")
+(def-boot-val |$ConstructorNames|
+	'(|SubDomain| |List| |Union| |Record| |Vector|)
+	"Used in isFunctor test, and compDefine.")
+(def-boot-val |$gauss01| '(|gauss| 0 1)		    "???")
+(def-boot-var |$genFVar|			    "???")
+(def-boot-val |$genSDVar| 0	    "counter for genSomeVariable" )
+(def-boot-val |$hasCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???")
+(def-boot-var |$hasYield|			    "???")
+(def-boot-var |$ignoreCommentsIfTrue|		    "???")
+(def-boot-var |$Index|				    "???")
+(def-boot-val |$InitialDomainsInScope|
+	  '((|Boolean|) |$EmptyMode| |$NoValueMode|)
+	  "???")
+(def-boot-val |$InitialModemapFrame| '((NIL))	    "???")
+(def-boot-var |$inLispVM|			    "Interpreter>Eval.boot")
+(def-boot-var |$insideCapsuleFunctionIfTrue|	    "???")
+(def-boot-var |$insideCategoryIfTrue|		    "???")
+(def-boot-var |$insideCoerceInteractiveHardIfTrue|  "???")
+(def-boot-val |$insideCompTypeOf| NIL  "checked in comp3")
+(def-boot-val |$insideConstructIfTrue| NIL "checked in parse.boot")
+(def-boot-var |$insideExpressionIfTrue|		    "???")
+(def-boot-var |$insideFunctorIfTrue|		    "???")
+(def-boot-var |$insideWhereIfTrue|		    "???")
+(def-boot-val |$instantRecord| (MAKE-HASHTABLE 'ID) "???")
+(def-boot-val |$Integer| '(|Integer|)		    "???")
+(def-boot-val |$IntegerOpt| '(|Integer| . OPT)	    "???")
+(def-boot-val |$InteractiveFrame| '((NIL))	    "top level environment")
+(def-boot-var |$InteractiveMode|		    "Interactive>System.boot")
+(def-boot-val |$InteractiveModemapFrame| '((NIL))   "???")
+(def-boot-var |$InteractiveTimingStatsIfTrue|	    "???")
+(def-boot-var |$LastCxArg|			    "???")
+(def-boot-val $lastprefix "S-"                      "???")
+(def-boot-val |$lastUntraced| NIL      "Used for )restore option of )trace.")
+(def-boot-var |$leaveLevelStack|		    "???")
+(def-boot-var |$leaveMode|			    "???")
+(def-boot-val |$leftPren| "("                       "For use in SAY expressions.")
+(def-boot-val |$letAssoc| NIL	    "Used for trace of assignments in SPAD code.")
+(def-boot-var |$libFile|			    "Compiler>LispLib.boot")
+(def-boot-var $LINENUMBER			    "???")
+(def-boot-var $linestack			    "???")
+(def-boot-val |$Lisp| '(|Lisp|)			    "???")
+(def-boot-val $LISPLIB nil		    "whether to produce a lisplib or not")
+(def-boot-var |$lisplibDependentCategories|	    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibDomainDependents|	    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibForm|			    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibKind|			    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibModemapAlist|		    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibModemap|			    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibOperationAlist|		    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibSignatureAlist|		    "Compiler>LispLib.boot")
+(def-boot-var |$lisplibVariableAlist|		    "Compiler>LispLib.boot")
+(def-boot-var |$lisp2lispRenameAssoc|		    "???")
+(def-boot-val |$LocalFrame| '((NIL))		    "???")
+(def-boot-var |$mapSubNameAlist|		    "Interpreter>Trace.boot")
+(def-boot-var |$mathTrace|			    "Interpreter>Trace.boot")
+(def-boot-var |$mathTraceList|		    "Controls mathprint output for )trace.")
+(def-boot-var $maxlinenumber			    "???")
+(def-boot-val |$Mode| '(Mode)	   "compiler constant")
+(def-boot-var |$ModemapFrame|			    "???")
+(def-boot-val |$ModeVariableList|
+  '(&1 &2 &3 &4 &5 &6 &7 &8 &9 &10 &11
+       &12 &13 &14 &15)				"???")
+(def-boot-var |$mostRecentOpAlist|		    "???")
+(def-boot-var $NBOOT				    "???")
+(def-boot-val |$NegativeIntegerOpt| '(|NegativeInteger| . OPT) "???")
+(def-boot-val |$NegativeInteger| '(|NegativeInteger|) "???")
+(def-boot-val |$NETail| (CONS |$EmptyEnvironment| NIL) "???")
+(def-boot-var $NEWLINSTACK			    "???")
+(def-boot-var |$noEnv|				    "???")
+(def-boot-val |$NonMentionableDomainNames| '($ |Rep| |Mapping|) "???")
+(def-boot-val |$NonNegativeIntegerOpt| '(|NonNegativeInteger| . OPT) "???")
+(def-boot-val |$NonNegativeInteger| '(|NonNegativeInteger|) "???")
+(def-boot-val |$NonPositiveIntegerOpt| '(|NonPositiveInteger| . OPT) "???")
+(def-boot-val |$NonPositiveInteger| '(|NonPositiveInteger|) "???")
+(def-boot-var |$noParseCommands|		    "???")
+(def-boot-val |$NoValueMode| '|$NoValueMode|   "compiler literal")
+(def-boot-val |$NoValue| '|$NoValue|   "compiler literal")
+(def-boot-val $num_of_meta_errors 0		    "Number of errors seen so far")
+(def-boot-var $OLDLINE				    "Used to output command lines.")
+(def-boot-val |$oldTime| 0			    "???")
+(def-boot-val |$One| '(|One|)			    "???")
+(def-boot-val |$OneCoef| '(1 1 . 1)		    "???")
+(def-boot-val |$operationNameList| NIL		 "op names for apropos")
+(def-boot-var |$opFilter|			    "Used to /s a function")
+(def-boot-var |OptionList|			    "???")
+(def-boot-val |$optionAlist| nil       "info for trace boot")
+(def-boot-var |$OutsideStringIfTrue|		    "???")
+(def-boot-val |$PatternVariableList|
+  '(*1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11
+       *12 *13 *14 *15)				"???")
+(def-boot-var |$PolyMode|			    "???")
+(def-boot-val |$Polvar| '(WRAPPED . ((1 . 1)))	    "???")
+(def-boot-var |$polyDefaultAssoc|		    "???")
+(def-boot-val |$PolyDomains|
+	'(|Polynomial| |MultivariatePolynomial|
+	  |UnivariatePoly|
+	  |DistributedMultivariatePolynomial|
+	  |HomogeneousDistributedMultivariatePolynomial|)
+	"???")
+(def-boot-val |$PositiveIntegerOpt| '(|PositiveInteger| . OPT) "???")
+(def-boot-val |$PositiveInteger| '(|PositiveInteger|) "???")
+(def-boot-var |$postStack|			    "???")
+(def-boot-var |$prefix|				    "???")
+(def-boot-val |$PrettyPrint| nil "if t generated code is prettyprinted")
+(def-boot-var |$previousTime|			    "???")
+(def-boot-val |$PrimitiveDomainNames| nil
+"Used in mkCategory to avoid generating vector slot
+for primitive domains.	Also used by putInLocalDomainReferences and optCal.")
+(def-boot-val |$optimizableDomainNames|
+      '(|FactoredForm| |List| |Vector|
+	|Integer| |NonNegativeInteger| |PositiveInteger|
+	|SmallInteger| |String| |Boolean| |Symbol| |BooleanFunctions|)
+   "used in optCall to decide which domains can be optimized")
+(def-boot-val |$PrintBox| '(|PrintBox|)		    "???")
+(def-boot-var |$PrintCompilerMessagesIfTrue|	    "???")
+(def-boot-val |$printConStats| nil  "display constructor cache totals")
+(def-boot-val |$printLoadMsgs|	't	    "Interpreter>SetVarT.boot")
+(def-boot-var |$PrintOnly|			    "Compiler>LispLib.boot")
+(def-boot-val |$UserSynonyms| ()    "list of user defined synonyms")
+(def-boot-val |$SystemSynonyms| () "list of system defined synonyms")
+(def-boot-val |$QuickCode| NIL	    "Controls generation of QREFELT, etc.")
+(def-boot-val |$QuickLet| NIL	    "Set to T for no LET tracing.")
+(def-boot-var |$QuietIfNil|			    "???")
+(def-boot-val |$RationalNumberOpt| '(|RationalNumber| . OPT) "???")
+(def-boot-val |$RationalNumber| '(|RationalNumber|) "???")
+(def-boot-var |$readingFile|			    "???")
+(def-boot-val |$report3| nil	 "addMap report info")
+(def-boot-var |$reportBottomUpFlag|		    "Interpreter>SetVarT.boot")
+(def-boot-var |$reportCoerce|			    "???")
+(def-boot-var |$reportCoerceIfTrue|		    "???")
+(def-boot-var |$reportCompilation|		    "???")
+(def-boot-var |$reportExitModeStack|		    "???")
+(def-boot-var |$reportFlag|			    "Interpreter>SetVars.boot")
+(def-boot-val |$reportSpadTrace| ()    "report list of traced functions")
+(def-boot-var |$resolveFlag|			    "Interpreter>SetVars.boot")
+(def-boot-var |$returnMode|			    "???")
+(def-boot-val |$rightPren| ")"                      "???")
+(def-boot-var |$scanModeFlag|			    "???")
+(def-boot-var |$semanticErrorStack|		    "???")
+(def-boot-val |$SetFunctions| nil  "checked in SetFunctionSlots")
+(def-boot-val |$SideEffectFreeFunctionList|
+  '(|null| |case| |Zero| |One| \: \:\: |has| |Mapping|
+    |elt| = \> \>= \< \<= MEMBER |is| |isnt| ATOM
+    $= $\> $\>= $\< $\<= $^= $MEMBER)		"???")
+(def-boot-var |$slamFlag|			    "Interpreter>SetVars.boot")
+(def-boot-val |$SmallInteger| '(|SmallInteger|)	    "???")
+(def-boot-val |$SmallIntegerOpt| '(|SmallInteger| . OPT) "???")
+(def-boot-val |$sourceFileTypes|
+	  '(SPAD BOOT LISP LISP370 META)
+	  "Interpreter>System.boot")
+(def-boot-val $SPAD nil				    "Is this Spad code?")
+(def-boot-var $SPAD_ERRORS			    "???")
+(def-boot-val |$spadLibFT| 'LISPLIB		    "???")
+(def-boot-var |$spadOpList|			    "???")
+(def-boot-var |$spadSystemDisks|		    "Interpreter>Database.boot")
+(def-boot-val |$SpecialDomainNames|
+  '(|add| |CAPSULE| |SubDomain| |List| |Union| |Record| |Vector|)
+  "Used in isDomainForm, addEmptyCapsuleIfnecessary.")
+(def-boot-var |$streamAlist|			    "???")
+(def-boot-val |$streamCount| 0			    "???")
+(def-boot-var |$streamIndexing|			    "???")
+(def-boot-val |$StreamIndex| 0			    "???")
+(def-boot-val |$StringCategory| '(|StringCategory|) "???")
+(def-boot-val |$StringOpt| '(|String| . OPT)	    "???")
+(def-boot-val |$String| '(|String|)		    "???")
+(def-boot-var |$suffix|				    "???")
+(def-boot-val |$Symbol| '(|Symbol|)		    "???")
+(def-boot-val |$SymbolOpt| '(|Symbol| . OPT)	    "???")
+(def-boot-var |$systemCommands|			    "Interpreter>System.boot")
+(def-boot-val |$systemCreation| (currenttime)	    "???")
+(def-boot-val |$systemLastChanged|
+	  |$systemCreation|			"???")
+(def-boot-val |$tempCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???")
+(def-boot-val |$ThrowAwayMode| '|$ThrowAwayMode|    "interp constant")
+(def-boot-val |$timerOn| t			    "???")
+(def-boot-var |$topOp|				   "See displayPreCompilationErrors")
+(def-boot-var |$tokenCommands|			    "???")
+(def-boot-var $TOKSTACK				    "???")
+(def-boot-val $TOP_LEVEL t			    "???")
+(def-boot-var $top_stack			    "???")
+(def-boot-var |$tracedModemap|			    "Interpreter>Trace.boot")
+(def-boot-val |$traceDomains| t			     "enables domain tracing")
+(def-boot-val |$TraceFlag| t			    "???")
+(def-boot-var |$tracedSpadModemap|		    "Interpreter>Trace.boot")
+(def-boot-var |$traceletFunctions|		    "???")
+(def-boot-var |$traceNoisely|			    "Interpreter>Trace.boot")
+(def-boot-var |$TranslateOnly|			    "???")
+(def-boot-var |$tripleCache|			    "Compiler>Compiler.boot")
+(def-boot-val |$true| ''T			    "???")
+(def-boot-var $Type				    "???")
+(def-boot-val |$underDomainAlist|
+	'((|DistributedMultivariatePolynomial| . 2)
+	  (|FactoredForm| . 1)
+	  (|FactoredRing| . 1)
+	  (|Gaussian| . 1)
+	  (|List| . 1)
+	  (|Matrix| . 1)
+	  (|MultivariatePolynomial| . 2)
+	  (|HomogeneousDistributedMultivariatePolynomial| . 2)
+	  (|Polynomial| . 1)
+	  (|QuotientField| . 1)
+	  (|RectangularMatrix| . 3)
+	  (|SquareMatrix| . 2)
+	  (|UnivariatePoly| . 2)
+	  (|Vector| . 1)
+	  (|VVectorSpace| . 2))			"???")
+
+(def-boot-val |$updateCatTableIfTrue| T	   "update category table on load")
+(def-boot-var |$updateIfTrue|
+	  "Should SPAD databases be updated&squeezed?")
+(def-boot-val |$useBFasDefault| T
+	  "Determines whether to use BF as default floating point type.")
+(def-boot-val |$useDCQnotLET| () "checked in DEF-LET for use of DCQ")
+(def-boot-fun BUMPCOMPERRORCOUNT ()		    "errorSupervisor1")
+(def-boot-var |$VariableCount|			    "???")
+(def-boot-val |$Void| '(|Void|) "compiler constant")
+(def-boot-var |$warningStack|			    "???")
+(def-boot-val |$whereList| () "referenced in format boot formDecl2String")
+(def-boot-var |$xCount|				    "???")
+(def-boot-var |$xeditIsConsole|			    "???")
+(def-boot-var |$xyCurrent|			    "???")
+(def-boot-var |$xyInitial|			    "???")
+(def-boot-var |$xyMax|				    "???")
+(def-boot-var |$xyMin|				    "???")
+(def-boot-var |$xyStack|			    "???")
+(def-boot-val |$Zero| '(|Zero|)			    "???")
+
+(def-boot-val |$domainsWithUnderDomains|
+	  (mapcar #'car |$underDomainAlist|)	"???")
+(def-boot-val |$inputPromptType| '|step|  "checked in MKPROMPT")
+(def-boot-val |$IOindex| 0		   "step counter")
+
+(defun |printLoadMessages| (u)
+  (if (memq u '(|%display%| |%describe%|)) 
+        (if |$printLoadMsgs| "on" "off")
+        (seq 
+          (setq |$printLoadMsgs| (and (listp u) (equal (car u) '|on|)))
+#+:CCL    (verbos (if |$printLoadMsgs| 2 0))
+)))
+
+<<manexp>>
+<<acot>>
+<<cot>>
+<<getCD>>
+<<Missing DFLOAT Transcendental functions>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet
new file mode 100644
index 00000000..37ddf16d
--- /dev/null
+++ b/src/interp/bootlex.lisp.pamphlet
@@ -0,0 +1,488 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp bootlex.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; NAME:		BootLex.lisp
+; PURPOSE:	Parsing support routines for Boot and Spad code
+; CONTENTS:
+;
+;		0. Global parameters
+;		1. BOOT File Handling
+;		2. BOOT Line Handling
+;		3. BOOT Token Handling
+;		4. BOOT Token Parsing Actions
+;		5. BOOT Error Handling
+
+(in-package "BOOT")
+
+; *** 0. Global parameters
+
+(defparameter Boot-Line-Stack nil	"List of lines returned from PREPARSE.")
+
+(defun Next-Lines-Clear () (setq Boot-Line-Stack nil))
+
+(defun Next-Lines-Show ()
+  (and Boot-Line-Stack (format t "Currently preparsed lines are:~%~%"))
+  (mapcar #'(lambda (line)
+	      (format t "~&~5D> ~A~%" (car line) (cdr Line)))
+	  Boot-Line-Stack))
+
+; *** 1. BOOT file handling
+
+(defun init-boot/spad-reader ()
+  (setq $SPAD_ERRORS (VECTOR 0 0 0))
+  (setq SPADERRORSTREAM *standard-output*)
+  (setq XTokenReader 'get-BOOT-token)
+  (setq Line-Handler 'next-BOOT-line)
+  (setq Meta_Error_Handler 'spad_syntax_error)
+  (setq File-Closed nil)
+  (Next-Lines-Clear)
+  (setq Boot-Line-Stack nil)
+  (ioclear))
+
+(defmacro test (x &rest y)
+  `(progn
+     (setq spaderrorstream t)
+     (in-boot)
+     (initialize-preparse *terminal-io*)
+     (,(intern (strconc "PARSE-" x)) . ,y)))
+
+(defun |oldParserAutoloadOnceTrigger| () nil)
+
+(defun print-defun (name body)
+   (let* ((sp (assoc 'vmlisp::compiler-output-stream vmlisp::optionlist))
+	  (st (if sp (cdr sp) *standard-output*)))
+     (if (and (is-console st) (symbolp name) (fboundp name)
+	      (not (compiled-function-p (symbol-function name))))
+	 (compile name))
+     (when (or |$PrettyPrint| (not (is-console st)))
+	   (print-full body st) (force-output st))))
+
+(defun boot-parse-1 (in-stream
+	      &aux
+	     (Echo-Meta nil)
+	     (current-fragment nil)
+	     ($INDEX 0)
+	     ($LineList nil)
+	     ($EchoLineStack nil)
+	     ($preparse-last-line nil)
+	     ($BOOT T)
+	     (*EOF* NIL)
+	     (OPTIONLIST NIL))
+  (declare (special echo-meta *comp370-apply* *EOF* File-Closed
+		    $index $linelist $echolinestack $preparse-last-line))
+  (init-boot/spad-reader)
+  (let* ((Boot-Line-Stack (PREPARSE in-stream))
+	 (parseout (prog2 (|PARSE-Expression|) (pop-stack-1)) ) )
+    ;(setq parseout (|new2OldLisp| parseout))
+    ; (setq parseout (DEF-RENAME parseout))
+    ; (DEF-PROCESS parseout)
+    parseout))
+
+(defun boot (&optional
+	      (*boot-input-file* nil)
+	      (*boot-output-file* nil)
+	     &aux
+	     (Echo-Meta t)
+	     ($BOOT T)
+	     (|$InteractiveMode| NIL)
+	     (XCape #\_)
+	     (File-Closed NIL)
+	     (*EOF* NIL)
+	     (OPTIONLIST NIL)
+	     (*fileactq-apply* (function print-defun))
+	     (*comp370-apply* (function print-defun)))
+  (declare (special echo-meta *comp370-apply* *EOF* File-Closed XCape))
+  (init-boot/spad-reader)
+  (with-open-stream
+    (in-stream (if *boot-input-file* (open *boot-input-file* :direction :input)
+		    *standard-input*))
+    (initialize-preparse in-stream)
+    (with-open-stream
+      (out-stream (if *boot-output-file*
+		      (open *boot-output-file* :direction :output)
+		      #-:cmulisp (make-broadcast-stream *standard-output*)
+		      #+:cmulisp *standard-output*
+		      ))
+      (when *boot-output-file*
+	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+	 (print-package "BOOT"))
+      (loop (if (and (not File-Closed)
+		     (setq Boot-Line-Stack (PREPARSE in-stream)))
+		(progn
+		       (|PARSE-Expression|)
+		       (let ((parseout (pop-stack-1)) )
+			 (setq parseout (|new2OldLisp| parseout))
+			 (setq parseout (DEF-RENAME parseout))
+			 (let ((*standard-output* out-stream))
+			   (DEF-PROCESS parseout))
+			 (format out-stream "~&")
+			 (if (null parseout) (ioclear)) ))
+		(return nil)))
+      (if *boot-input-file*
+	  (format out-stream ";;;Boot translation finished for ~a~%"
+		  (namestring *boot-input-file*)))
+      (IOClear in-stream out-stream)))
+  T)
+
+(defun spad (&optional
+	      (*spad-input-file* nil)
+	      (*spad-output-file* nil)
+	     &aux
+	 ;;  (Echo-Meta *spad-input-file*)
+	 ;;  (*comp370-apply* (function print-and-eval-defun))
+	   (*comp370-apply* (function print-defun))
+	   (*fileactq-apply* (function print-defun))
+	 ;;  (|$InteractiveMode| nil)
+	   ($SPAD T)
+	   ($BOOT nil)
+	   (XCape #\_)
+	   (OPTIONLIST nil)
+	   (*EOF* NIL)
+	   (File-Closed NIL)
+	 ;;  ($current-directory "/spad/libraries/")
+	   (/editfile *spad-input-file*)
+	   (|$noSubsumption| |$noSubsumption|)
+	   in-stream out-stream)
+  (declare (special echo-meta /editfile *comp370-apply* *EOF*
+		    File-Closed Xcape |$noSubsumption|))
+  ;; only rebind |$InteractiveFrame| if compiling
+  (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
+	 (if (not |$InteractiveMode|)
+	     (list (|addBinding|
+		    '|$DomainsInScope|
+		    `((FLUID . |true|)
+		      (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
+		    (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
+  (init-boot/spad-reader)
+  (unwind-protect
+    (progn
+      (setq in-stream (if *spad-input-file*
+			 (open *spad-input-file* :direction :input)
+			 *standard-input*))
+      (initialize-preparse in-stream)
+      (setq out-stream (if *spad-output-file*
+			   (open *spad-output-file* :direction :output)
+			 *standard-output*))
+      (when *spad-output-file*
+	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+	 (print-package "BOOT"))
+      (setq curoutstream out-stream)
+      (loop
+       (if (or *eof* file-closed) (return nil))
+       (catch 'SPAD_READER
+	 (if (setq Boot-Line-Stack (PREPARSE in-stream))
+	     (let ((LINE (cdar Boot-Line-Stack)))
+	       (declare (special LINE))
+	       (|PARSE-NewExpr|)
+	       (let ((parseout (pop-stack-1)) )
+		 (when parseout
+		       (let ((*standard-output* out-stream))
+			 (S-PROCESS parseout))
+		       (format out-stream "~&")))
+	       ;(IOClear in-stream out-stream)
+	       )))
+      (IOClear in-stream out-stream)))
+    (if *spad-input-file* (shut in-stream))
+    (if *spad-output-file* (shut out-stream)))
+  T))
+
+(defun READ-BOOT (FN FM TO)
+  (let (($boot t)) (READ-SPAD1 FN 'BOOT FM TO)))
+
+(defun READ-SPAD1 (FN FT FM TO)
+    (LET ((STRM IN-STREAM))
+      (SETQ $MAXLINENUMBER 0)
+      (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
+      (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
+      ($ERASE (LIST FN 'ERROR 'A))
+      (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
+      (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
+      (READ-SPAD-1)
+      (close SPADERRORSTREAM)
+      (SETQ IN-STREAM STRM)
+      (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
+	  (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
+	    '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
+	    '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
+      (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
+
+(defun READBOOT ()
+  (let (form expr ($BOOT 'T))
+    (declare (special $BOOT))
+    (ADVANCE-TOKEN)
+    (|PARSE-Expression|)
+   ;; (|pp| (setq form (|postTransform| (FIRST STACK))))
+    (|pp| (setq form (|postTransform| (pop-STACK-1))))
+    (setq EXPR (DEF-RENAME form))
+    (DEF-PROCESS EXPR)
+    (TERSYSCOMMAND)))
+
+;  *** 2. BOOT Line Handling ***
+
+; See the file PREPARSE.LISP for the hard parts of BOOT line processing.
+
+(defun next-BOOT-line (&optional (in-stream t))
+
+  "Get next line, trimming trailing blanks and trailing comments.
+One trailing blank is added to a non-blank line to ease between-line
+processing for Next Token (i.e., blank takes place of return).	Returns T
+if it gets a non-blank line, and NIL at end of stream."
+
+  (if Boot-Line-Stack
+      (let ((Line-Number (caar Boot-Line-Stack))
+	    (Line-Buffer (suffix #\Space (cdar Boot-Line-Stack))))
+	(pop Boot-Line-Stack)
+	(Line-New-Line Line-Buffer Current-Line Line-Number)
+	(setq |$currentLine| (setq LINE Line-Buffer))
+	Line-Buffer)))
+
+;  *** 3. BOOT Token Handling ***
+
+(defparameter xcape #\_ "Escape character for Boot code.")
+
+(defun get-BOOT-token (token)
+
+  "If you have an _, go to the next line.
+If you have a . followed by an integer, get a floating point number.
+Otherwise, get a .. identifier."
+
+  (if (not (boot-skip-blanks))
+      nil
+      (let ((token-type (boot-token-lookahead-type (current-char))))
+	(case token-type
+	  (eof			(token-install nil '*eof token nonblank))
+	  (escape		(advance-char)
+				(get-boot-identifier-token token t))
+	  (argument-designator	(get-argument-designator-token token))
+	  (id			(get-boot-identifier-token token))
+	  (num			(get-number-token token))
+	  (string		(get-SPADSTRING-token token))
+	  (special-char		(get-special-token token))
+	  (t			(get-gliph-token token token-type))))))
+
+(defun boot-skip-blanks ()
+  (setq nonblank t)
+  (loop (let ((cc (current-char)))
+	  (if (not cc) (return nil))
+	  (if (eq (boot-token-lookahead-type cc) 'white)
+	      (progn (setq nonblank nil) (if (not (advance-char)) (return nil)))
+	      (return t)))))
+
+(defun boot-token-lookahead-type (char)
+  "Predicts the kind of token to follow, based on the given initial character."
+  (cond ((not char)					   'eof)
+	((char= char #\_)				   'escape)
+	((and (char= char #\#) (digitp (next-char)))	   'argument-designator)
+	((digitp char)					   'num)
+	((and (char= char #\$) $boot
+	      (alpha-char-p (next-char)))		   'id)
+	((or (char= char #\%) (char= char #\?)
+	     (char= char #\!) (alpha-char-p char))	   'id)
+	((char= char #\")                                  'string)
+	((member char
+		 '(#\Space #\Tab #\Return)
+		 :test #'char=)				   'white)
+	((get (intern (string char)) 'Gliph))
+	(t						   'special-char)))
+
+(defun get-argument-designator-token (token)
+  (advance-char)
+  (get-number-token token)
+  (token-install (intern (strconc "#" (format nil "~D" (token-symbol token))))
+		 'argument-designator token nonblank))
+
+(defvar Keywords '(|or| |and| |isnt| |is| |otherwise| |when| |where|
+		  |has| |with| |add| |case| |in| |by| |pretend| |mod|
+		  |exquo| |div| |quo| |else| |rem| |then| |suchthat|
+		  |if| |yield| |iterate| |from| |exit| |leave| |return|
+		  |not| |unless| |repeat| |until| |while| |for| |import|)
+
+
+
+"Alphabetic literal strings occurring in the New Meta code constitute
+keywords.   These are recognized specifically by the AnyId production,
+GET-BOOT-IDENTIFIER will recognize keywords but flag them
+as keywords.")
+
+(defun get-boot-identifier-token (token &optional (escaped? nil))
+  "An identifier consists of an escape followed by any character, a %, ?,
+or an alphabetic, followed by any number of escaped characters, digits,
+or the chracters ?, !, ' or %"
+  (prog ((buf (make-adjustable-string 0))
+	 (default-package NIL))
+      (suffix (current-char) buf)
+      (advance-char)
+   id (let ((cur-char (current-char)))
+	 (cond ((char= cur-char XCape)
+		(if (not (advance-char)) (go bye))
+		(suffix (current-char) buf)
+		(setq escaped? t)
+		(if (not (advance-char)) (go bye))
+		(go id))
+	       ((and (null default-package)
+		     (char= cur-char #\'))
+		(setq default-package buf)
+		(setq buf (make-adjustable-string 0))
+		(if (not (advance-char)) (go bye))
+		(go id))
+	       ((or (alpha-char-p cur-char)
+		    (digitp cur-char)
+		    (member cur-char '(#\% #\' #\? #\!) :test #'char=))
+		(suffix (current-char) buf)
+		(if (not (advance-char)) (go bye))
+		(go id))))
+  bye (if (and (stringp default-package)
+	       (or (not (find-package default-package))	 ;; not a package name
+		   (every #'(lambda (x) (eql x #\')) buf))) ;;token ends with ''
+	  (setq buf (concatenate 'string default-package "'" buf)
+		default-package nil))
+      (setq buf (intern buf (or default-package "BOOT")))
+      (return (token-install
+		buf
+		(if (and (not escaped?)
+			 (member buf Keywords :test #'eq))
+		    'keyword 'identifier)
+		token
+		nonblank))))
+
+(defun get-gliph-token (token gliph-list)
+  (prog ((buf (make-adjustable-string 0)))
+	(suffix (current-char) buf)
+	(advance-char)
+   loop (setq gliph-list (assoc (intern (string (current-char))) gliph-list))
+	(if gliph-list
+	    (progn (suffix (current-char) buf)
+		   (pop gliph-list)
+		   (advance-char)
+		   (go loop))
+	    (let ((new-token (intern buf)))
+	      (return (token-install (or (get new-token 'renametok) new-token)
+				     'gliph token nonblank))))))
+
+(defun get-SPADSTRING-token (token)
+   "With TOK=\" and ABC\" on IN-STREAM, extracts and stacks string ABC"
+  (PROG ((BUF (make-adjustable-string 0)))
+	(if (char/= (current-char) #\") (RETURN NIL) (advance-char))
+	(loop
+	 (if (char= (current-char) #\") (return nil))
+	 (SUFFIX (if (char= (current-char) XCape)
+		     (advance-char)
+		   (current-char))
+		 BUF)
+	 (if (null  (advance-char)) ;;end of line
+	     (PROGN (|sayBrightly| "Close quote inserted") (RETURN nil)))
+	 )
+	(advance-char)
+	(return (token-install (copy-seq buf) ;should make a simple string
+			       'spadstring token))))
+
+; **** 4. BOOT token parsing actions
+
+; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
+
+(defun-parse-token SPADSTRING)
+(defun-parse-token KEYWORD)
+(defun-parse-token ARGUMENT-DESIGNATOR)
+
+(defun |boot-LEXPR| () (SETQ $NBOOT T) (New-LEXPR1))
+
+(defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X)
+
+(defun TRANSLABEL1 (X AL)
+ "Transforms X according to AL = ((<label> . Sexpr) ..)."
+  (COND ((REFVECP X)
+	 (do ((i 0 (1+ i))
+	      (k (maxindex x)))
+	     ((> i k))
+	   (if (LET ((Y (LASSOC (ELT X I) AL))) (SETELT X I Y))
+	       (TRANSLABEL1 (ELT X I) AL))))
+	((ATOM X) NIL)
+	((LET ((Y (LASSOC (FIRST X) AL)))
+	   (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL))))
+	((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL))))
+
+; **** 5. BOOT Error Handling
+
+(defun SPAD_SYNTAX_ERROR (&rest byebye)
+  "Print syntax error indication, underline character, scrub line."
+  (BUMPERRORCOUNT '|syntax|)
+  (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
+	 (SPAD_LONG_ERROR))
+	((SPAD_SHORT_ERROR)))
+  (IOClear)
+  (throw 'spad_reader nil))
+
+(defun SPAD_LONG_ERROR ()
+  (SPAD_ERROR_LOC SPADERRORSTREAM)
+  (iostat)
+  (unless (EQUAL OUT-STREAM SPADERRORSTREAM)
+    (SPAD_ERROR_LOC OUT-STREAM)
+    (TERPRI OUT-STREAM)))
+
+(defun SPAD_SHORT_ERROR () (current-line-show))
+
+(defun SPAD_ERROR_LOC (STR)
+  (format str "******** Boot Syntax Error detected ********"))
+
+(defun BUMPERRORCOUNT (KIND)
+  (unless |$InteractiveMode|
+	  (LET ((INDEX (case KIND
+			 (|syntax| 0)
+			 (|precompilation| 1)
+			 (|semantic| 2)
+			 (T (ERROR "BUMPERRORCOUNT")))))
+	    (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX))))))
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-con.boot.pamphlet b/src/interp/br-con.boot.pamphlet
new file mode 100644
index 00000000..7c7dec66
--- /dev/null
+++ b/src/interp/br-con.boot.pamphlet
@@ -0,0 +1,1407 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-con.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS b-con.boot <================================
+
+--=======================================================================
+--              Pages Initiated from HyperDoc Pages
+--=======================================================================
+--NOTE: This duplicate version was discovered 3/20/94 in br-search.boot
+--called from buttons via bcCon, bcAbb, bcConform, dbShowCons1, dbSelectCon
+--conPage(a,:b) ==
+--  --The next 4 lines allow e.g. MATRIX INT  ==> Matrix Integer (see kPage)
+--  $conArgstrings: local :=
+--    atom a => b
+--    a := conform2OutputForm a
+--    [mathform2HtString x for x in rest a]
+--  if not atom a then a := first a
+--  da := DOWNCASE a
+--  pageName := LASSQ(da,'((type . CategoryType)(union . DomainUnion)(record . DomainRecord)(mapping . DomainMapping))) =>
+--    downlink pageName              --special jump out for primitive domains
+--  line := conPageFastPath a        => kPage line  --lower case name of cons?
+--  line := conPageFastPath UPCASE a => kPage line  --upper case an abbr?
+--  ySearch a                        --slow search (include default packages)
+--
+
+--called from buttons via bcCon, bcAbb, bcConform, dbShowCons1, dbSelectCon
+conPage(a,:b) ==
+  --The next 4 lines allow e.g. MATRIX INT  ==> Matrix Integer (see kPage)
+  form :=
+    atom a => [a,:b]
+    a
+  $conArgstrings: local := [form2HtString x for x in KDR a]
+  if not atom a then a := first a
+  da := DOWNCASE a
+  pageName := LASSQ(da,'((type . CategoryType)(union . DomainUnion)(record . DomainRecord)(mapping . DomainMapping)(enumeration . DomainEnumeration))) =>
+    downlink pageName                --special jump out for primitive domains
+  line := conPageFastPath da  => kPage(line,form) --lower case name of cons?
+  line := conPageFastPath UPCASE a => kPage(line,form) --upper case an abbr?
+  ySearch a       --slow search (include default packages)
+
+conPageFastPath x == --called by conPage and constructorSearch
+--gets line quickly for constructor name or abbreviation
+  s := STRINGIMAGE x
+  charPosition(char '_*,s,0) < #s => nil     --quit if name has * in it
+  name := (STRINGP x => INTERN x; x)
+  entry := HGET($lowerCaseConTb,name) or return nil
+  lineNumber := LASSQ('dbLineNumber,CDDR entry) =>
+    --'dbLineNumbers property is set by function dbAugmentConstructorDataTable
+    dbRead lineNumber --read record for constructor from libdb.text
+  conPageConEntry first entry
+
+conPageConEntry entry ==
+  $conname: local := nil
+  $conform: local := nil
+  $exposed?:local := nil
+  $doc:     local := nil
+  $kind:    local := nil
+  buildLibdbConEntry entry
+
+--=======================================================================
+--                    Constructor Page
+--=======================================================================
+-- in br-saturn.boot now
+--% kPage(line,:options) == --any cat, dom, package, default package
+--% --constructors    Cname\#\E\sig \args   \abb \comments (C is C, D, P, X)
+--% ------------------> BRANCH OUT FOR SATURN
+--%   true => kPageSaturn(line,options)
+--%   parts := dbXParts(line,7,1)
+--%   [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts
+--%   form := IFCAR options
+--%   isFile := null kind
+--%   kind := kind or '"package"
+--%   RPLACA(parts,kind)
+--%   conform         := mkConform(kind,name,args)
+--%   conname         := opOf conform
+--%   capitalKind     := capitalize kind
+--%   signature       := ncParseFromString sig
+--%   sourceFileName  := dbSourceFile INTERN name
+--%   constrings      :=
+--%     KDR form => dbConformGenUnder form
+--%     [STRCONC(name,args)]
+--%   emString        := ['"{\sf ",:constrings,'"}"]
+--%   heading := [capitalKind,'" ",:emString]
+--%   if not isExposedConstructor conname then heading := ['"Unexposed ",:heading]
+--%   if name=abbrev then abbrev := asyAbbreviation(conname,nargs)
+--%   page := htInitPage(heading,nil)
+--%   htpSetProperty(page,'isFile,true)
+--%   htpSetProperty(page,'parts,parts)
+--%   htpSetProperty(page,'heading,heading)
+--%   htpSetProperty(page,'kind,kind)
+--%   if asharpConstructorName? conname then
+--%     htpSetProperty(page,'isAsharpConstructor,true)
+--%   htpSetProperty(page,'conform,conform)
+--%   htpSetProperty(page,'signature,signature)
+--%   kdPageInfo(name,abbrev,nargs,conform,signature,isFile)
+--%   htSayStandard  '"\newline"
+--%   htBeginMenu(3)
+--%   htSayStandard '"\item "
+--%   htMakePage [['bcLinks,['"\menuitemstyle{Description}",
+--%                 [['text,'"\tab{19}",'"General description"]],'kiPage,nil]]]
+--%   satBreak()
+--%   htMakePage [['bcLinks,['"\menuitemstyle{Operations}",
+--%                 [['text,'"\tab{19}All exported operations"]],'koPage,'"operation"]]]
+--%   if not asharpConstructorName? conname then
+--%     satBreak()
+--%     htMakePage [['bcLinks,['"\menuitemstyle{Attributes}",
+--%                 [['text,'"\tab{19}All exported attributes"]],'koPage,'"attribute"]]]
+--%   if kind ^= 'category and (pathname := dbHasExamplePage conname) then
+--%     satBreak()
+--%     htMakePage [['bcLinks,['"\menuitemstyle{Examples}",
+--%                 [['text,'"\tab{19}Examples illustrating use"]],'kxPage,pathname]]]
+--%   satBreak()
+--%   htMakePage [['bcLinks,['"\menuitemstyle{Exports}",
+--%     [['text,'"\tab{19}Explicit categories and operations"]],'kePage,nil]]]
+--%   satBreak()
+--%   htMakePage [['bcLinks,['"\menuitemstyle{Cross Reference}",
+--%                 [['text,'"\tab{19}Hierarchy and usage information"]],'kcPage,nil]]]
+--%   htEndMenu(3)
+--%   if kind ^= 'category and nargs > 0 then addParameterTemplates conform
+--%   htShowPage()
+--% 
+conform2String u ==
+  x := form2String u
+  atom x => STRINGIMAGE x
+  "STRCONC"/[STRINGIMAGE y for y in x]
+
+kxPage(htPage,name) == downlink name
+
+kdPageInfo(name,abbrev,nargs,conform,signature,file?) ==
+  htSay("{\sf ",name,'"}")
+  if abbrev ^= name then bcHt [" has abbreviation ",abbrev]
+  if file? then bcHt ['" is a source file."]
+  if nargs = 0 then (if abbrev ^= name then bcHt '".")
+    else
+      if abbrev ^= name then bcHt '" and"
+      bcHt
+        nargs = 1 => '" takes one argument:"
+        [" takes ",STRINGIMAGE nargs," arguments:"]
+  htSaturnBreak()
+  htSayStandard '"\indentrel{2}"
+  if nargs > 0 then kPageArgs(conform,signature)
+  htSayStandard '"\indentrel{-2}"
+  if name.(#name-1) = char "&" then name := SUBSEQ(name, 0, #name-1)
+--sourceFileName := dbSourceFile INTERN name
+  sourceFileName := GETDATABASE(INTERN name,'SOURCEFILE)
+  filename := extractFileNameFromPath sourceFileName
+  if filename ^= '"" then
+    htSayStandard '"\newline{}"
+    htSay('"The source code for the constructor is found in ")
+  htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ",
+              sourceFileName, '" ", name, '"}"]]
+  if nargs ^= 0 then htSay '"."
+  htSaturnBreak()
+
+kPageArgs([op,:args],[.,.,:source]) ==
+------------------> OBSELETE
+  firstTime := true
+  coSig := rest GETDATABASE(op,'COSIG)
+  for x in args for t in source for pred in coSig repeat
+    if not firstTime then htSay '", and"
+    htSay('"\newline ")
+    typeForm := (t is [":",.,t1] => t1; t)
+    if pred = true
+      then htMakePage [['bcLinks,[x,'"",'kArgPage,x]]]
+      else htSay('"{\em ",x,'"}")
+    htSay( '"\tab{",STRINGIMAGE( # PNAME x),'"}, ")
+    htSay
+      pred => '"a domain of category "
+      '"an element of the domain "
+    bcConform(typeForm,true)
+
+kArgPage(htPage,arg) ==
+  [op,:args] := conform := htpProperty(htPage,'conform)
+  domname := htpProperty(htPage,'domname)
+  heading := htpProperty(htPage,'heading)
+  source := CDDAR getConstructorModemap op
+  n := position(arg,args)
+  typeForm := sublisFormal(args,source . n)
+  domTypeForm := mkDomTypeForm(typeForm,conform,domname)
+  descendants := domainDescendantsOf(typeForm,domTypeForm)
+  htpSetProperty(htPage,'cAlist,descendants)
+  rank :=
+    n > 4 => nil
+    ('(First Second Third Fourth Fifth)).n
+  htpSetProperty(htPage,'rank,rank)
+  htpSetProperty(htPage,'thing,'"argument")
+--htpSetProperty(htPage,'specialMessage,['reportCategory,conform,typeForm,arg])
+  dbShowCons(htPage,'names)
+
+reportCategory(conform,typeForm,arg) ==
+  htSay('"Argument {\em ",arg,'"}")
+  [conlist,attrlist,:oplist] := categoryParts(conform,typeForm,true)
+  htSay '" must "
+  if conlist then
+    htSay '"belong to "
+    if conlist is [u] then
+       htSay('"category ")
+       bcConform first u
+       bcPred rest u
+    else
+       htSay('"categories:")
+       bcConPredTable(conlist,opOf conform)
+       htSay '"\newline "
+  if attrlist then
+    if conlist then htSay '" and "
+    reportAO('"attribute",attrlist)
+    htSay '"\newline "
+  if oplist then
+    if conlist or attrlist then htSay '" and "
+    reportAO('"operation",oplist)
+
+reportAO(kind,oplist) ==
+  htSay('"have ",kind,'":")
+  for [op,sig,:pred] in oplist repeat
+    htSay '"\newline "
+    if #oplist = 1 then htSay '"\centerline{"
+    if kind = '"attribute" then
+      attr := form2String [op,:sig]
+      satDownLink(attr,['"(|attrPage| '|",attr,'"|)"])
+    else
+      ops  := escapeSpecialChars STRINGIMAGE op
+      sigs := form2HtString ['Mapping,:sig]
+      satDownLink(ops,['"(|opPage| '|",ops,'"| |",sigs,'"|)"])
+      htSay '": "
+      bcConform ['Mapping,:sig]
+    if #oplist = 1 then htSay '"}"
+  htSay '"\newline "
+
+mkDomTypeForm(typeForm,conform,domname) == --called by kargPage
+  domname => SUBLISLIS(rest domname,rest conform,typeForm)
+  typeForm is ['Join,:r] => ['Join,:[mkDomTypeForm(t,conform,domname) for t in r]]
+  null hasIdent typeForm => typeForm
+  nil
+
+domainDescendantsOf(conform,domform) == main where --called by kargPage
+  main ==
+    conform is [op,:r] =>
+      op = 'Join => jfn(delete('(Type Object),r),delete('(Type Object),IFCDR domform))
+      op = 'CATEGORY => nil
+      domainsOf(conform,domform)
+    domainsOf(conform,domform)
+  jfn([y,:r],domlist) ==  --keep only those domains that appear in ALL parts of Join
+    alist := domainsOf(y,IFCAR domlist)
+    for x in r repeat
+      domlist := IFCDR domlist
+      x is ['CATEGORY,.,:r] => alist := catScreen(r,alist)
+      keepList := nil
+      for [item,:pred] in domainsOf(x,IFCAR domlist) repeat
+        u := ASSOC(item,alist) =>
+          keepList := [[item,:quickAnd(CDR u,pred)],:keepList]
+      alist := keepList
+    for pair in alist repeat RPLACD(pair,simpHasPred CDR pair)
+    listSort(function GLESSEQP, alist)
+  catScreen(r,alist) ==
+    for x in r repeat
+      x isnt [op1,:.] and MEMQ(op1,'(ATTRIBUTE SIGNATURE)) => systemError x
+      alist := [[item,:npred] for [item,:pred] in alist |
+        (pred1 := simpHasPred ['has,item,x]) and (npred := quickAnd(pred1,pred))]
+    alist
+
+--=======================================================================
+--                   Branches of Constructor Page
+--=======================================================================
+
+kiPage(htPage,junk) ==
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  conform         := mkConform(kind,name,args)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading := ['"Description of ", capitalize kind,'" {\sf ",name,args,'"}"]
+  page := htInitPage(heading,htCopyProplist htPage)
+  $conformsAreDomains := domname
+  dbShowConsDoc1(htPage,conform,nil)
+  htShowPage()
+
+kePage(htPage,junk) ==
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  constring       := STRCONC(name,args)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  htpSetProperty(htPage,'domname,domname)
+  $conformsAreDomains: local := domname
+  conform         := mkConform(kind,name,args)
+  conname         := opOf conform
+  heading := [capitalize kind,'" {\sf ",
+               (domname => form2HtString(domname,nil,true); constring),'"}"]
+  data := sublisFormal(IFCDR domname or rest conform,
+                       getConstructorExports((domname or conform),true))
+  [conlist,attrlist,:oplist] := data
+  if domname then
+    for x in conlist repeat  RPLAC(CDR x,simpHasPred CDR x)
+    for x in attrlist repeat RPLAC(CDDR x,simpHasPred CDDR x)
+    for x in oplist   repeat RPLAC(CDDR x,simpHasPred CDDR x)
+  prefix := pluralSay(#conlist + #attrlist + #oplist,'"Export",'"Exports")
+  page := htInitPage([:prefix,'" of ",:heading],htCopyProplist htPage)
+  htSayStandard '"\beginmenu "
+  htpSetProperty(page,'data,data)
+  if conlist then
+    htMakePage [['bcLinks,[menuButton(),'"",'dbShowCons1,conlist,'names]]]
+    htSayStandard '"\tab{2}"
+    htSay  '"All attributes and operations from:"
+    bcConPredTable(conlist,opOf conform,rest conform)
+  if attrlist then
+    if conlist then htBigSkip()
+    kePageDisplay(page,'"attribute",kePageOpAlist attrlist)
+  if oplist then
+    if conlist or attrlist then htBigSkip()
+    kePageDisplay(page,'"operation",kePageOpAlist oplist)
+  htSayStandard '" \endmenu "
+  htShowPage()
+
+kePageOpAlist oplist ==
+  opAlist := nil
+  for [op,sig,:pred] in oplist repeat
+    u := LASSOC(op,opAlist)
+--was 
+--    opAlist := insertAlist(op,[[sig,pred],:u],opAlist)
+    opAlist := insertAlist(zeroOneConvert op,[[sig,pred],:u],opAlist)
+  opAlist
+
+kePageDisplay(htPage,which,opAlist) ==
+  count := #opAlist
+  total := +/[#(rest entry) for entry in opAlist]
+  count = 0 => nil
+  if which = '"operation"
+    then htpSetProperty(htPage,'opAlist,opAlist)
+    else htpSetProperty(htPage,'attrAlist,opAlist)
+  expandProperty :=
+    which = '"operation" => 'expandOperations
+    'expandAttributes
+  htpSetProperty(htPage,expandProperty,'lists)  --mark as unexpanded
+  htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,'names]]]
+  htSayStandard '"\tab{2}"
+  if count ^= total then
+    if count = 1
+    then htSay('"1 name for ")
+    else htSay(STRINGIMAGE count,'" names for ")
+  if total > 1
+    then htSay(STRINGIMAGE total,'" ",pluralize which,'" are explicitly exported:")
+    else htSay('"1 ",which,'" is explicitly exported:")
+  htSaySaturn '"\\"
+  data := dbGatherData(htPage,opAlist,which,'names)
+  dbShowOpItems(which,data,false)
+
+ksPage(htPage,junk) ==
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  if domname then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  domain  := (kind = '"category" => nil; EVAL domname)
+  conform:= htpProperty(htPage,'conform)
+  page := htInitPageNoScroll(htCopyProplist htPage,
+                             ['"Search order for ",:heading])
+  htSay '"When an operation is not defined by the domain, the following domains are searched in order for a _"default definition"
+  htSayStandard '"\beginscroll "
+  u := dbSearchOrder(conform,domname,domain)
+  htpSetProperty(htPage,'cAlist,u)
+  htpSetProperty(htPage,'thing,'"constructor")
+  dbShowCons(htPage,'names)
+
+dbSearchOrder(conform,domname,$domain) ==  --domain = nil or set to live domain
+  conform := domname or conform
+  name:= opOf conform
+  $infovec: local := dbInfovec name or return nil  --exit for categories
+  u := $infovec.3
+  $predvec:=
+    $domain => $domain . 3
+    GETDATABASE(name,'PREDICATES)
+  catpredvec := CAR u
+  catinfo    := CADR u
+  catvec     := CADDR u
+  catforms := [[pakform,:pred] for i in 0..MAXINDEX catvec | test ] where
+    test ==
+      pred := simpCatPredicate
+        p:=SUBLISLIS(rest conform,$FormalMapVariableList,kTestPred catpredvec.i)
+        $domain => EVAL p
+        p
+      if domname and CONTAINED('$,pred) then pred := SUBST(domname,'$,pred)
+--    which = '"attribute" => pred    --all categories
+      (pak := catinfo . i) and pred   --only those with default packages
+    pakform ==
+      pak and not IDENTP pak => devaluate pak --in case it has been instantiated
+      catform := kFormatSlotDomain catvec . i
+--    which = '"attribute" => dbSubConform(rest conform,catform)
+      res := dbSubConform(rest conform,[pak,"$",:rest catform])
+      if domname then res := SUBST(domname,'$,res)
+      res
+  [:dbAddChain conform,:catforms]
+
+kcPage(htPage,junk) ==
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+--  domain          := (kind = '"category" => nil; EVAL domname)
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  page := htInitPage(['"Cross Reference for ",:heading],htCopyProplist htPage)
+  if domname then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  if kind = '"category" and dbpHasDefaultCategory? xpart then
+    htSay '"This category has default package "
+    bcCon(STRCONC(name,char '_&),'"")
+  htSayStandard '"\newline"
+  htBeginMenu(3)
+  htSayStandard '"\item "
+  message :=
+    kind = '"category" => ['"Categories it directly extends"]
+    ['"Categories the ",(kind = '"default package" => '"package"; kind),'" belongs to by assertion"]
+  htMakePage [['bcLinks,['"\menuitemstyle{Parents}",
+    [['text,'"\tab{12}",:message]],'kcpPage,nil]]]
+  satBreak()
+  message :=
+    kind = '"category" => ['"All categories it is an extension of"]
+    ['"All categories the ",kind,'" belongs to"]
+  htMakePage [['bcLinks,['"\menuitemstyle{Ancestors}",
+    [['text,'"\tab{12}",:message]],'kcaPage,nil]]]
+  if kind = '"category" then
+    satBreak()
+    htMakePage [['bcLinks,['"\menuitemstyle{Children}",[['text,'"\tab{12}",
+      '"Categories which directly extend this category"]],'kccPage,nil]]]
+
+    satBreak()
+    htMakePage [['bcLinks,['"\menuitemstyle{Descendants}",[['text,'"\tab{12}",
+      '"All categories which extend this category"]],'kcdPage,nil]]]
+  if not asharpConstructorName? conname then
+    satBreak()
+    message := '"Constructors mentioning this as an argument type"
+    htMakePage [['bcLinks,['"\menuitemstyle{Dependents}",
+      [['text,'"\tab{12}",message]],'kcdePage,nil]]]
+  if not asharpConstructorName? conname and kind ^= '"category" then
+    satBreak()
+    htMakePage [['bcLinks,['"\menuitemstyle{Lineage}",
+      '"\tab{12}Constructor hierarchy used for operation lookup",'ksPage,nil]]]
+  if not asharpConstructorName? conname then
+   if kind = '"category" then
+    satBreak()
+    htMakePage [['bcLinks,['"\menuitemstyle{Domains}",[['text,'"\tab{12}",
+      '"All domains which are of this category"]],'kcdoPage,nil]]]
+   if kind ^= '"category" then
+    satBreak()
+    htMakePage [['bcLinks,['"\menuitemstyle{Clients}",'"\tab{12}Constructors",'kcuPage,nil]]]
+    if HGET($defaultPackageNamesHT,conname)
+      then htSay('" which {\em may use} this default package")
+--  htMakePage [['bcLinks,['"files",'"",'kcuPage,true]]]
+      else htSay('" which {\em use} this ",kind)
+  if kind ^= '"category" or dbpHasDefaultCategory? xpart then
+    satBreak()
+    message :=
+      kind = '"category" => ['"Constructors {\em used by} its default package"]
+      ['"Constructors {\em used by} the ",kind]
+    htMakePage [['bcLinks,['"\menuitemstyle{Benefactors}",
+      [['text,'"\tab{12}",:message]],'kcnPage,nil]]]
+  --to remove "Capsule Information", comment out the next 5 lines
+  if not asharpConstructorName? conname and hasNewInfoAlist conname then
+    satBreak()
+    message := ['"Cross reference for capsule implementation"]
+    htMakePage [['bcLinks,['"\menuitemstyle{CapsuleInfo}",
+      [['text,'"\tab{12}",:message]],'kciPage,nil]]]
+  htEndMenu(3)
+  htShowPage()
+
+kcpPage(htPage,junk) ==
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  if domname then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+  page := htInitPage(['"Parents of ",:heading],htCopyProplist htPage)
+  parents := parentsOf conname --was listSort(function GLESSEQP, =this)
+  if domname then parents := SUBLISLIS(rest domname,rest conform,parents)
+  htpSetProperty(htPage,'cAlist,parents)
+  htpSetProperty(htPage,'thing,'"parent")
+  choice :=
+    domname => 'parameters
+    'names
+  dbShowCons(htPage,choice)
+
+reduceAlistForDomain(alist,domform,conform) == --called from kccPage
+  alist := SUBLISLIS(rest domform,rest conform,alist)
+  for pair in alist repeat RPLACD(pair,simpHasPred(CDR pair,domform))
+  [pair for (pair := [.,:pred]) in alist | pred]
+
+kcaPage(htPage,junk) ==
+  kcaPage1(htPage,'"category",'" an ",'"ancestor",function ancestorsOf, false)
+
+kcdPage(htPage,junk) ==
+  kcaPage1(htPage,'"category",'" a ",'"descendant",function descendantsOf,true)
+
+kcdoPage(htPage,junk)==
+  kcaPage1(htPage,'"domain",'" a ",'"descendant",function domainsOf, false)
+
+kcaPage1(htPage,kind,article,whichever,fn, isCatDescendants?) ==
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  if domname and not isCatDescendants? then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+  ancestors := FUNCALL(fn, conform, domname)
+  if whichever ^= '"ancestor" then
+    ancestors := augmentHasArgs(ancestors,conform)
+  ancestors := listSort(function GLESSEQP,ancestors)
+--if domname then ancestors := SUBST(domname,'$,ancestors)
+  htpSetProperty(htPage,'cAlist,ancestors)
+  htpSetProperty(htPage,'thing,whichever)
+  choice :=
+--  domname => 'parameters
+    'names
+  dbShowCons(htPage,choice)
+
+kccPage(htPage,junk) ==
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  if domname then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+  page := htInitPage(['"Children of ",:heading],htCopyProplist htPage)
+  children:= augmentHasArgs(childrenOf conform,conform)
+  if domname then children := reduceAlistForDomain(children,domname,conform)
+  htpSetProperty(htPage,'cAlist,children)
+  htpSetProperty(htPage,'thing,'"child")
+  dbShowCons(htPage,'names)
+
+augmentHasArgs(alist,conform) ==
+  conname := opOf conform
+  args    := KDR conform or return alist
+  n       := #args
+  [[name,:pred] for [name,:p] in alist] where pred ==
+     extractHasArgs p is [a,:b] => p
+     quickAnd(p,['hasArgs,:TAKE(n,KDR getConstructorForm opOf name)])
+
+kcdePage(htPage,junk) ==
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  conname         := INTERN name
+  constring       := STRCONC(name,args)
+  conform         :=
+    kind ^= '"default package" => ncParseFromString constring
+    [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)]  --because of &
+  pakname         :=
+--  kind = '"category" => INTERN STRCONC(name,char '_&)
+    opOf conform
+  domList := getDependentsOfConstructor pakname
+  cAlist := [[getConstructorForm x,:true] for x in domList]
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,'"dependent")
+  dbShowCons(htPage,'names)
+
+kcuPage(htPage,junk) ==
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  conname         := INTERN name
+  constring       := STRCONC(name,args)
+  conform         :=
+    kind ^= '"default package" => ncParseFromString constring
+    [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)]  --because of &
+  pakname         :=
+    kind = '"category" => INTERN STRCONC(name,char '_&)
+    opOf conform
+  domList := getUsersOfConstructor pakname
+  cAlist := [[getConstructorForm x,:true] for x in domList]
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,'"user")
+  dbShowCons(htPage,'names)
+
+kcnPage(htPage,junk) ==
+--if reached by a category, that category has a default package
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  domname         := kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  heading :=
+    null domname => htpProperty(htPage,'heading)
+    ['"{\sf ",form2HtString(domname,nil,true),'"}"]
+  if domname then
+    htpSetProperty(htPage,'domname,domname)
+    htpSetProperty(htPage,'heading,heading)
+  conform:= htpProperty(htPage,'conform)
+  pakname         :=
+    kind = '"category" => INTERN STRCONC(PNAME conname,char '_&)
+    opOf conform
+  domList := getImports pakname
+  if domname then
+    domList := SUBLISLIS([domname,:rest domname],['$,:rest conform],domList)
+  cAlist := [[x,:true] for x in domList]
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,'"benefactor")
+  dbShowCons(htPage,'names)
+
+koPageInputAreaUnchanged?(htPage, nargs) ==
+  [htpLabelInputString(htPage,INTERN STRCONC('"*",STRINGIMAGE i)) for i in 1..nargs]
+      = htpProperty(htPage,'inputAreaList)
+
+kDomainName(htPage,kind,name,nargs) ==
+  htpSetProperty(htPage,'domname,nil)
+  inputAreaList :=
+    [htpLabelInputString(htPage,var) for i in 1..nargs for var in $PatternVariableList]
+  htpSetProperty(htPage,'inputAreaList,inputAreaList)
+  conname := INTERN name
+  args := [kArgumentCheck(domain?,x) or nil for x in inputAreaList
+              for domain? in rest GETDATABASE(conname,'COSIG)]
+  or/[null x for x in args] =>
+    (n := +/[1 for x in args | x]) > 0 =>
+      ['error,nil,'"\centerline{You gave values for only {\em ",n,'" } of the {\em ",#args,'"}}",'"\centerline{parameters of {\sf ",name,'"}}\vspace{1}\centerline{Please enter either {\em all} or {\em none} of the type parameters}"]
+    nil
+  argString :=
+    null args => '"()"
+    argTailPart :=
+      "STRCONC"/["STRCONC"/ ['",",:x] for x in KDR args]
+    "STRCONC"/['"(",:first args,argTailPart,'")"]
+  typeForm := CATCH('SPAD__READER, unabbrev mkConform(kind,name,argString)) or
+    ['error,'invalidType,STRCONC(name,argString)]
+  null (evaluatedTypeForm := kisValidType typeForm) =>
+    ['error,'invalidType,STRCONC(name,argString)]
+  dbMkEvalable evaluatedTypeForm
+
+kArgumentCheck(domain?,s) ==
+  s = '"" => nil
+  domain? and (form := conSpecialString? s) =>
+    null KDR form => [STRINGIMAGE opOf form]
+    form2String form
+  [s]
+
+dbMkEvalable form ==
+--like mkEvalable except that it does NOT quote domains
+--does not do "loadIfNecessary"
+  [op,:.] := form
+  kind := GETDATABASE(op,'CONSTRUCTORKIND)
+  kind = 'category => form
+  mkEvalable form
+
+topLevelInterpEval x ==
+  $ProcessInteractiveValue: fluid := true
+  $noEvalTypeMsg: fluid := true
+  processInteractive(x,nil)
+
+kisValidType typeForm ==
+  $ProcessInteractiveValue: fluid := true
+  $noEvalTypeMsg: fluid := true
+  CATCH('SPAD__READER, processInteractive(typeForm,nil))
+    is [[h,:.],:t] and member(h,'(Domain SubDomain)) =>
+      kCheckArgumentNumbers t and t
+  false
+
+kCheckArgumentNumbers t ==
+  [conname,:args] := t
+  cosig := KDR GETDATABASE(conname,'COSIG)
+  #cosig ^= #args => false
+  and/[foo for domain? in cosig for x in args] where foo ==
+    domain? => kCheckArgumentNumbers x
+    true
+
+parseNoMacroFromString(s) ==
+   s := next(function ncloopParse,
+        next(function lineoftoks,incString s))
+   StreamNull s => nil
+   pf2Sex first rest first s
+ 
+
+
+mkConform(kind,name,argString) ==
+  kind ^= '"default package" =>
+    form := STRCONC(name,argString)
+    parse := parseNoMacroFromString form
+    null parse =>
+      sayBrightlyNT '"Won't parse: "
+      pp form
+      systemError '"Keywords in argument list?"
+    ATOM parse => [parse]
+    parse
+  [INTERN name,:rest ncParseFromString STRCONC(char 'd,argString)]  --& case
+
+--=======================================================================
+--           Operation Page for a Domain Form from Scratch
+--=======================================================================
+conOpPage(htPage,conform) ==
+  updown := dbCompositeWithMap htPage
+  updown = '"DOWN" =>
+    domname := htpProperty(htPage,'domname)
+    conOpPage1(dbExtractUnderlyingDomain domname,[['updomain,:domname]])
+  domname := htpProperty(htPage,'updomain)
+  conOpPage1(domname,nil)
+
+dbCompositeWithMap htPage ==
+  htpProperty(htPage,'updomain) => '"UP"
+  domain := htpProperty(htPage,'domname)
+  null domain => false
+  opAlist := htpProperty(htPage,'opAlist)
+--not LASSOC('map,opAlist) => false
+  dbExtractUnderlyingDomain htpProperty(htPage,'domname) => '"DOWN"
+  false
+
+dbExtractUnderlyingDomain domain == or/[x for x in KDR domain | isValidType x]
+
+--conform is atomic if no parameters, otherwise must be valid domain form
+conOpPage1(conform,:options) ==
+--constructors    Cname\#\E\sig \args   \abb \comments (C is C, D, P, X)
+  bindingsAlist := IFCAR options
+  conname       := opOf conform
+  MEMQ(conname,$Primitives) =>
+     dbSpecialOperations conname
+  domname         :=                        --> !!note!! <--
+    null atom conform => conform
+    nil
+  line := conPageFastPath conname
+  [kind,name,nargs,xflag,sig,args,abbrev,comments]:=parts:= dbXParts(line,7,1)
+  isFile := null kind
+  kind := kind or '"package"
+  RPLACA(parts,kind)
+  constring       := STRCONC(name,args)
+  conform         := mkConform(kind,name,args)
+  capitalKind     := capitalize kind
+  signature       := ncParseFromString sig
+  sourceFileName  := dbSourceFile INTERN name
+  emString        := ['"{\sf ",constring,'"}"]
+  heading := [capitalKind,'" ",:emString]
+  if not isExposedConstructor conname then heading := ['"Unexposed ",:heading]
+  page := htInitPage(heading,nil)
+  htpSetProperty(page,'isFile,true)
+  htpSetProperty(page,'fromConOpPage1,true)
+  htpSetProperty(page,'parts,parts)
+  htpSetProperty(page,'heading,heading)
+  htpSetProperty(page,'kind,kind)
+  htpSetProperty(page,'domname,domname)         --> !!note!! <--
+  htpSetProperty(page,'conform,conform)
+  htpSetProperty(page,'signature,signature)
+  if selectedOperation := LASSOC('selectedOperation,IFCDR options) then
+    htpSetProperty(page,'selectedOperation,selectedOperation)
+  for [a,:b] in bindingsAlist repeat htpSetProperty(page,a,b)
+  koPage(page,'"operation")
+
+--=======================================================================
+--           Operation Page from Main Page
+--=======================================================================
+koPage(htPage,which) ==
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
+  constring       := STRCONC(name,args)
+  conname         := INTERN name
+  domname         :=
+    (u := htpProperty(htPage,'domname)) is [=conname,:.]
+      and  (htpProperty(htPage,'fromConOpPage1) = true or
+             koPageInputAreaUnchanged?(htPage,nargs)) => u
+    kDomainName(htPage,kind,name,nargs)
+  domname is ['error,:.] => errorPage(htPage,domname)
+  htpSetProperty(htPage,'domname,domname)
+  headingString :=
+    domname => form2HtString(domname,nil,true)
+    constring
+  heading := [capitalize kind,'" {\sf ",headingString,'"}"]
+  htpSetProperty(htPage,'which,which)
+  htpSetProperty(htPage,'heading,heading)
+  koPageAux(htPage,which,domname,heading)
+
+koPageFromKKPage(htPage,ao) ==
+  koPageAux(htPage,ao,htpProperty(htPage,'domname),htpProperty(htPage,'heading))
+
+koPageAux(htPage,which,domname,heading) == --from koPage, koPageFromKKPage
+  htpSetProperty(htPage,'which,which)
+  domname := htpProperty(htPage,'domname)
+  conform := htpProperty(htPage,'conform)
+  heading := htpProperty(htPage,'heading)
+  opAlist          :=
+    which = '"attribute" => koAttrs(conform,domname)
+    which = '"general operation" => koOps(conform,domname,true)
+    koOps(conform,domname)
+  if selectedOperation := htpProperty(htPage,'selectedOperation) then
+    opAlist := [ASSOC(selectedOperation,opAlist) or systemError()]
+  dbShowOperationsFromConform(htPage,which,opAlist)
+
+koPageAux1(htPage,opAlist) ==
+  which   := htpProperty(htPage,'which)
+  dbShowOperationsFromConform(htPage,which,opAlist)
+
+koaPageFilterByName(htPage,functionToCall) ==
+  htpLabelInputString(htPage,'filter) = '"" =>
+    koaPageFilterByCategory(htPage,functionToCall)
+  filter := pmTransFilter(dbGetInputString htPage)
+--WARNING: this call should check for ['error,:.] returned
+  which   := htpProperty(htPage,'which)
+  opAlist :=
+      [x for x in htpProperty(htPage,'opAlist) | superMatch?(filter,DOWNCASE STRINGIMAGE first x)]
+  htpSetProperty(htPage,'opAlist,opAlist)
+  FUNCALL(functionToCall,htPage,nil)
+
+--=======================================================================
+--                  Get Constructor Documentation
+--=======================================================================
+
+dbConstructorDoc(conform,$op,$sig) == fn conform where
+  fn (conform := [conname,:$args]) ==
+    or/[gn y for y in GETDATABASE(conname,'DOCUMENTATION)]
+  gn([op,:alist]) ==
+    op = $op and or/[doc or '("") for [sig,:doc] in alist | hn sig]
+  hn sig ==
+    #$sig = #sig and $sig = SUBLISLIS($args,$FormalMapVariableList,sig)
+
+dbDocTable conform ==
+--assumes $docTableHash bound --see dbExpandOpAlistIfNecessary
+  table := HGET($docTableHash,conform) => table
+  $docTable : local := MAKE_-HASHTABLE 'ID
+  --process in reverse order so that closest cover up farthest
+  for x in originsInOrder conform repeat dbAddDocTable x
+  dbAddDocTable conform
+  HPUT($docTableHash,conform,$docTable)
+  $docTable
+
+originsInOrder conform ==  --domain = nil or set to live domain
+--from dcCats
+  [con,:argl] := conform
+  GETDATABASE(con,'CONSTRUCTORKIND) = 'category =>
+      ASSOCLEFT ancestorsOf(conform,nil)
+  acc := ASSOCLEFT parentsOf con
+  for x in acc repeat
+    for y in originsInOrder x repeat acc := insert(y,acc)
+  acc
+
+dbAddDocTable conform ==
+  conname := opOf conform
+  storedArgs := rest getConstructorForm conname
+  for [op,:alist] in SUBLISLIS(["$",:rest conform],
+    ["%",:storedArgs],GETDATABASE(opOf conform,'DOCUMENTATION))
+      repeat
+       op1 :=
+         op = '(Zero) => 0
+         op = '(One) => 1
+         op
+       for [sig,doc] in alist repeat
+         HPUT($docTable,op1,[[conform,:alist],:HGET($docTable,op1)])
+    --note opOf is needed!!! for some reason, One and Zero appear within prens
+
+dbGetDocTable(op,$sig,docTable,$which,aux) == main where
+--docTable is [[origin,entry1,...,:code] ...] where
+--  each entry is [sig,doc] and code is NIL or else a topic code for op
+  main ==
+    if null FIXP op and
+      DIGITP (s := STRINGIMAGE op).0 then op := string2Integer s
+    -- the above hack should be removed after 3/94 when 0 is not |0|
+    aux is [[packageName,:.],:pred] =>
+      doc := dbConstructorDoc(first aux,$op,$sig)
+      origin :=
+        pred => ['ifp,:aux]
+        first aux
+      [origin,:doc]
+    or/[gn x for x in HGET(docTable,op)]
+  gn u ==  --u is [origin,entry1,...,:code]
+    $conform := CAR u              --origin
+    if ATOM $conform then $conform := [$conform]
+    code     := LASTATOM u         --optional topic code
+    comments := or/[p for entry in CDR u | p := hn entry] or return nil
+    [$conform,first comments,:code]
+  hn [sig,:doc] ==
+    $which = '"attribute" => sig is ['attribute,: =$sig] and doc
+    pred := #$sig = #sig and
+      alteredSig := SUBLISLIS(KDR $conform,$FormalMapVariableList,sig)
+      alteredSig = $sig
+    pred =>
+      doc =>
+        doc is ['constant,:r] => r
+        doc
+      '("")
+    false
+
+kTestPred n ==
+  n = 0 => true
+  $domain => testBitVector($predvec,n)
+  simpHasPred $predvec.(n - 1)
+
+dbAddChainDomain conform ==
+  [name,:args] := conform
+  $infovec := dbInfovec name or return nil  --exit for categories
+  template := $infovec . 0
+  null (form := template . 5) => nil
+  dbSubConform(args,kFormatSlotDomain devaluate form)
+
+dbSubConform(args,u) ==
+  atom u =>
+    (n := position(u,$FormalMapVariableList)) >= 0 => args . n
+    u
+  u is ['local,y] => dbSubConform(args,y)
+  [dbSubConform(args,x) for x in u]
+
+dbAddChain conform ==
+  u := dbAddChainDomain conform =>
+    atom u => nil
+    [[u,:true],:dbAddChain u]
+  nil
+
+--=======================================================================
+--                Constructor Page Menu
+--=======================================================================
+---------> !OBSELETE! <-------------
+dbPresentCons(htPage,kind,:exclusions) ==  -- calist is ((catform . pred)...)
+  $saturn => dbPresentConsSaturn(htPage,kind,exclusions)
+  htSay('"{\em Views:}")
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  cAlist := htpProperty(htPage,'cAlist)
+  empty? := null cAlist
+  exposedUnexposedFlag := $includeUnexposed? --used to be star?       4/92
+  star?  := true     --always include information on exposed/unexposed   4/92
+  htSayStandard(if star? then '"\tab{13}" else '"\tab{9}")
+  if empty? or member('names,exclusions)
+    then htSay '"{\em names}"
+    else htMakePage [['bcLispLinks,['"names",'"",'dbShowCons,'names]]]
+  htSayStandard(if star? then '"\tab{21}" else '"\tab{17}")
+  if empty? or member('kinds,exclusions) or kind ^= 'constructor
+    then htSay '"{\em kinds}"
+    else htMakePage [['bcLispLinks,['"kinds",'"",'dbShowCons,'kinds]]]
+  htSayStandard(if star? then '"\tab{29}" else '"\tab{25}")
+  if empty? or member('parameters,exclusions) or not or/[CDAR x for x in cAlist]
+    then htSay '"{\em parameters}"
+    else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowCons,'parameters]]]
+  if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}")
+  if empty? or null CDR cAlist
+    then htSay '"{\em filter}"
+    else htMakePage [['bcLinks,['"filter",'"",'dbShowCons,'filter]]]
+  htMakePage [['bcStrings, [11,'"",'filter,'EM]]]
+  htSay('"\newline")
+  if exposedUnexposedFlag then
+    if $exposedOnlyIfTrue then
+      htMakePage [['bcLinks,['"exposed",'" {\em only}",'dbShowCons,'exposureOff]]]
+    else
+      htSay('"*{\em =}")
+      htMakePage [['bcLinks,['"unexposed",'"",'dbShowCons,'exposureOn]]]
+  htSayStandard(if star? then '"\tab{13}" else '"\tab{9}")
+  if empty? or member('abbrs,exclusions)
+    then htSay '"{\em abbrs}"
+    else htMakePage [['bcLispLinks,['"abbrs",'"",'dbShowCons,'abbrs]]]
+  htSayStandard(if star? then '"\tab{21}" else '"\tab{17}")
+  if empty? or member('files,exclusions)
+    then htSay '"{\em files}"
+    else htMakePage [['bcLispLinks,['"files",'"",'dbShowCons,'files]]]
+  htSayStandard(if star? then '"\tab{29}" else '"\tab{25}")
+  if empty? or member('conditions,exclusions) or and/[CDR x = true for x in cAlist]
+    then htSay '"{\em conditions}"
+    else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowCons,'conditions]]]
+  if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}")
+  if empty? or member('documentation,exclusions)
+    then htSay '"{\em descriptions}"
+    else htMakePage [['bcLispLinks,['"descriptions",'"",'dbShowCons,'documentation]]]
+
+dbShowCons(htPage,key,:options) ==
+  cAlist  := htpProperty(htPage,'cAlist)
+  key = 'filter =>
+    --if $saturn, IFCAR options is the filter string
+    filter := pmTransFilter(IFCAR options or dbGetInputString htPage)
+    filter is ['error,:.] => bcErrorPage filter
+    abbrev? := htpProperty(htPage,'exclusion) = 'abbrs
+    u := [x for x in cAlist | test] where test ==
+      conname := CAAR x
+      subject := (abbrev? => constructor? conname; conname)
+      superMatch?(filter,DOWNCASE STRINGIMAGE subject)
+    null u => emptySearchPage('"constructor",filter)
+    htPage := htInitPageNoScroll(htCopyProplist htPage)
+    htpSetProperty(htPage,'cAlist,u)
+    dbShowCons(htPage,htpProperty(htPage,'exclusion))
+  if MEMQ(key,'(exposureOn exposureOff)) then
+    $exposedOnlyIfTrue :=
+      key = 'exposureOn => 'T
+      NIL
+    key := htpProperty(htPage,'exclusion)
+  dbShowCons1(htPage,cAlist,key)
+
+conPageChoose conname ==
+  cAlist := [[getConstructorForm conname,:true]]
+  dbShowCons1(nil,cAlist,'names)
+
+dbShowCons1(htPage,cAlist,key) ==
+  conlist := REMDUP [item for x in cAlist | pred] where
+    pred ==
+      item := CAR x
+      $exposedOnlyIfTrue => isExposedConstructor opOf item
+      item
+--$searchFirstTime and (conlist is [.]) => conPage first conlist
+--$searchFirstTime := false
+  conlist is [.] => conPage
+    htPage and htpProperty(htPage,'domname) => first conlist
+    opOf first conlist
+  conlist := [opOf x for x in conlist]
+  kinds := "union"/[dbConstructorKind x for x in conlist]
+  kind :=
+    kinds is [a] => a
+    'constructor
+  proplist :=
+    htPage => htCopyProplist htPage
+    nil
+  page := htInitPageNoScroll(proplist,dbConsHeading(htPage,conlist,key,kind))
+  if u := htpProperty(page,'specialMessage) then APPLY(first u,rest u)
+  htSayStandard('"\beginscroll ")
+  htpSetProperty(page,'cAlist,cAlist)
+  $conformsAreDomains: local := htpProperty(page,'domname)
+  do
+  --key = 'catfilter => dbShowCatFilter(page,key)
+    key = 'names => bcNameConTable conlist
+    key = 'abbrs =>
+      bcAbbTable [getCDTEntry(con,true) for con in conlist]
+    key = 'files =>
+      flist :=
+        [y for con in conlist |
+          y := (fn := GETDATABASE(con,'SOURCEFILE))]
+      bcUnixTable(listSort(function GLESSEQP,REMDUP flist))
+    key = 'documentation   => dbShowConsDoc(page,conlist)
+    if $exposedOnlyIfTrue then
+      cAlist := [x for x in cAlist | isExposedConstructor opOf CAR x]
+    key = 'conditions =>     dbShowConditions(page,cAlist,kind)
+    key = 'parameters => bcConTable REMDUP ASSOCLEFT cAlist
+    key = 'kinds => dbShowConsKinds cAlist
+  dbConsExposureMessage()
+  htSayStandard("\endscroll ")
+  dbPresentCons(page,kind,key)
+  htShowPageNoScroll()
+
+
+dbConsExposureMessage() ==
+  $atLeastOneUnexposed =>
+      htSay '"\newline{}-------------\newline{}{\em *} = unexposed"
+
+-- DUPLICATE DEF - ALSO in br-saturn.boot
+-- dbShowConsKinds cAlist ==
+-- ---------> !OBSELETE! <-------------
+--  cats := doms := paks := defs := nil
+--  for x in cAlist repeat
+--    op := CAAR x
+--    kind := dbConstructorKind op
+--    kind  = 'category => cats := [x,:cats]
+--    kind = 'domain    => doms := [x,:doms]
+--    kind = 'package   => paks:= [x,:paks]
+--    defs := [x,:defs]
+--  lists := [NREVERSE cats,NREVERSE doms,NREVERSE paks,NREVERSE defs]
+--  htBeginMenu(2)
+--  htSayStandard '"\indent{1}"
+--  kinds := +/[1 for x in lists | #x > 0]
+--  for kind in '("category" "domain" "package" "default package") for x in lists | #x > 0 repeat
+--    htSay('"\item")
+--    if kinds = 1 then htSay menuButton() else
+--      htMakePage [['bcLinks,[menuButton(),'"",'dbShowConsKindsFilter,[kind,x]]]]
+--    htSayStandard '"\tab{1}"
+--    htSay  '"{\em "
+--    htSay (c := #x)
+--    htSay '" "
+--    htSay (c > 1 => pluralize kind; kind)
+--    htSay '":}"
+--    bcConTable REMDUP [CAAR y for y in x]
+--  htEndMenu(2)
+--  htSay '"\indent{0}"
+
+dbShowConsKindsFilter(htPage,[kind,cAlist]) ==
+  htpSetProperty(htPage,'cAlist,cAlist)
+  dbShowCons(htPage,htpProperty(htPage,'exclusion))
+
+dbShowConsDoc(htPage,conlist) ==
+  null rest conlist => dbShowConsDoc1(htPage,getConstructorForm opOf first conlist,nil)
+  cAlist := htpProperty(htPage,'cAlist)
+  --the following code is necessary to skip over duplicates on cAlist
+  index := 0
+  for x in REMDUP conlist repeat
+  -- for x in conlist repeat
+    dbShowConsDoc1(htPage,getConstructorForm x,i) where i ==
+      while CAAAR cAlist ^= x repeat
+        index := index + 1
+        cAlist := rest cAlist
+        null cAlist => systemError ()
+      index
+
+dbShowConsDoc1(htPage,conform,indexOrNil) ==
+  [conname,:conargs] := conform
+  MEMQ(conname,$Primitives) =>
+    conname := htpProperty(htPage,'conname)
+    [["constructor",["NIL",doc]],:.] := GETL(conname,'documentation)
+    sig := '((CATEGORY domain) (SetCategory) (SetCategory))
+    displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,nil,nil)
+  exposeFlag := isExposedConstructor conname
+  doc := [getConstructorDocumentation conname]
+  signature := getConstructorSignature conname
+  sig :=
+    GETDATABASE(conname,'CONSTRUCTORKIND) = 'category =>
+      SUBLISLIS(conargs,$TriangleVariableList,signature)
+    sublisFormal(conargs,signature)
+  htSaySaturn '"\begin{description}"
+  displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,null exposeFlag,nil)
+  htSaySaturn '"\end{description}"
+  --NOTE that we pass conform is as "origin"
+
+getConstructorDocumentation conname ==
+  LASSOC('constructor,GETDATABASE(conname,'DOCUMENTATION))
+    is [[nil,line,:.],:.] and line or '""
+
+dbSelectCon(htPage,which,index) ==
+  conPage opOf first htpProperty(htPage,'cAlist) . index
+
+dbShowConditions(htPage,cAlist,kind) ==
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+  article := htpProperty(htPage,'article)
+  whichever := htpProperty(htPage,'whichever)
+  [consNoPred,:consPred] := splitConTable cAlist
+  singular := [kind,'" is"]
+  plural   := [pluralize STRINGIMAGE kind,'" are"]
+  dbSayItems(#consNoPred,singular,plural,'" unconditional")
+  htSaySaturn '"\\"
+  bcConPredTable(consNoPred,conname)
+  htSayHrule()
+  dbSayItems(#consPred,singular,plural,'" conditional")
+  htSaySaturn '"\\"
+  bcConPredTable(consPred,conname)
+
+dbConsHeading(htPage,conlist,view,kind) ==
+  thing := htPage and htpProperty(htPage,'thing) or '"constructor"
+  place :=
+    htPage => htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+    nil
+  count := #(REMDUP conlist)
+  -- count := #conlist
+  thing = '"benefactor" =>
+    [STRINGIMAGE count,'" Constructors Used by ",form2HtString(place,nil,true)]
+  modifier :=
+    thing = '"argument" =>
+      rank := htPage and htpProperty(htPage,'rank)
+      ['" Possible ",rank,'" "]
+    kind = 'constructor => ['" "]
+    ['" ",capitalize STRINGIMAGE kind,'" "]
+--  count = 1 =>
+--    ['"Select name or a {\em view} at the bottom"]
+  exposureWord :=
+    $exposedOnlyIfTrue => '(" Exposed ")
+    nil
+  prefix :=
+    count = 1 => [STRINGIMAGE count,:modifier,capitalize thing]
+    firstWord := (count = 0 => '"No "; STRINGIMAGE count)
+    [firstWord,:exposureWord, :modifier,capitalize pluralize thing]
+  placepart :=
+    place => ['" of {\em ",form2HtString(place,nil,true),"}"]
+    nil
+  heading := [:prefix,:placepart]
+  connective :=
+    member(view,'(abbrs files kinds)) => '" as "
+    '" with "
+  if count ^= 0 and member(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"]
+  heading
+
+dbShowConstructorLines lines ==
+  cAlist := [[getConstructorForm intern dbName line,:true] for line in lines]
+  dbShowCons1(nil,listSort(function GLESSEQP,cAlist),'names)
+
+bcUnixTable(u) ==
+  htSay '"\newline"
+  htBeginTable()
+  firstTime := true
+  for x in u repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    ft :=
+      isAsharpFileName? x => '("AS")
+      '("SPAD")
+    filename := NAMESTRING $FINDFILE(STRINGIMAGE x, ft)
+    htMakePage [['text, '"\unixcommand{",PATHNAME_-NAME x, '"}{$AXIOM/lib/SPADEDIT ", filename, '"} "]]
+    htSay '"}"
+  htEndTable()
+
+isAsharpFileName? con == false
+
+--=======================================================================
+--             Special Code for Union, Mapping, and Record
+--=======================================================================
+
+dbSpecialDescription(conname) ==
+  conform := getConstructorForm conname
+  heading := ['"Description of Domain {\sf ",form2HtString conform,'"}"]
+  page := htInitPage(heading,nil)
+  htpSetProperty(page,'conname,conname)
+  $conformsAreDomains := nil
+  dbShowConsDoc1(page,conform,nil)
+  htShowPage()
+
+dbSpecialOperations(conname) ==
+  page := htInitPage(nil,nil)
+  conform := getConstructorForm conname
+  opAlist := dbSpecialExpandIfNecessary(conform,rest GETL(conname,'documentation))
+  fromHeading := ['" from domain {\sf ",form2HtString conform,'"}"]
+  htpSetProperty(page,'fromHeading,fromHeading)
+  htpSetProperty(page,'conform,conform)
+  htpSetProperty(page,'opAlist,opAlist)
+  htpSetProperty(page,'noUsage,true)
+  htpSetProperty(page,'condition?,'no)
+  dbShowOp1(page,opAlist,'"operation",'names)
+
+dbSpecialExports(conname) ==
+  conform := getConstructorForm conname
+  page := htInitPage(['"Exports of {\sf ",form2HtString conform,'"}"],nil)
+  opAlist := dbSpecialExpandIfNecessary(conform,rest GETL(conname,'documentation))
+  kePageDisplay(page,'"operation",opAlist)
+  htShowPage()
+
+dbSpecialExpandIfNecessary(conform,opAlist) ==
+  opAlist is [[op,[sig,:r],:.],:.] and rest r => opAlist
+  for [op,:u] in opAlist repeat
+    for pair in u repeat
+      [sig,comments] := pair
+      RPLACD(pair,['T,conform,'T,comments]) --[sig,pred,origin,exposeFg,doc]
+  opAlist
+
+X := '"{\sf Record(a:A,b:B)} is used to create the class of pairs of objects made up of a value of type {\em A} selected by the symbol {\em a} and a value of type {\em B} selected by the symbol {\em b}. "
+
+Y := '"In general, the {\sf Record} constructor can take any number of arguments and thus can be used to create aggregates of heterogeneous components of arbitrary size selectable by name. "
+
+Z := '"{\sf Record} is a primitive domain of \Language{} which cannot be defined in the \Language{} language."
+
+MESSAGE := STRCONC(X,Y,Z)
+
+PUT('Record,'documentation,SUBST(MESSAGE,'MESSAGE,'(
+  (constructor (NIL MESSAGE))
+ (_=  (((Boolean) _$ _$)
+   "\spad{r = s} tests for equality of two records \spad{r} and \spad{s}"))
+ (coerce (((OutputForm) _$)
+   "\spad{coerce(r)} returns an representation of \spad{r} as an output form")
+         ((_$ (List (Any)))
+   "\spad{coerce(u)}, where \spad{u} is the list \spad{[x,y]} for \spad{x} of type \spad{A} and \spad{y} of type \spad{B}, returns the record \spad{[a:x,b:y]}"))
+ (elt ((A $ "a")
+   "\spad{r . a} returns the value stored in record \spad{r} under selector \spad{a}.")
+      ((B $ "b")
+   "\spad{r . b} returns the value stored in record \spad{r} under selector \spad{b}."))
+ (setelt ((A $ "a" A)
+   "\spad{r . a := x} destructively replaces the value stored in record \spad{r} under selector \spad{a} by the value of \spad{x}. Error: if \spad{r} has not been previously assigned a value.")
+         ((B $ "b" B)
+   "\spad{r . b := y} destructively replaces the value stored in record \spad{r} under selector \spad{b} by the value of \spad{y}. Error: if \spad{r} has not been previously assigned a value."))
+   )))
+
+X := '"{\sf Union(A,B)} denotes the class of objects which are which are either members of domain {\em A} or of domain {\em B}. The {\sf Union} constructor can take any number of arguments. "
+
+Y := '"For an alternate form of {\sf Union} with _"tags_", see \downlink{Union(a:A,b:B)}{DomainUnion}. {\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language."
+
+MESSAGE := STRCONC(X,Y)
+
+PUT('UntaggedUnion,'documentation,SUBST(MESSAGE,'MESSAGE,'(
+  (constructor (NIL MESSAGE))
+  (_=  (((Boolean) $ $)
+    "\spad{u = v} tests if two objects of the union are equal, that is, u and v are hold objects of same branch which are equal."))
+  (case (((Boolean) $ "A")
+    "\spad{u case A} tests if \spad{u} is of the type \spad{A} branch of the union.")
+        (((Boolean) $ "B")
+    "\spad{u case B} tests if \spad{u} is of the \spad{B} branch of the union."))
+  (coerce ((A $)
+    "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of the \spad{A} branch of the union. Error: if \spad{u} is of the \spad{B} branch of the union.")
+          ((B $)
+    "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of the \spad{B} branch of the union. Error: if \spad{u} is of the \spad{A} branch of the union.")
+          (($ A)
+    "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.")
+          (($ B)
+    "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type."))
+  )))
+
+X := '"{\sf Union(a:A,b:B)} denotes the class of objects which are either members of domain {\em A} or of domain {\em B}. "
+
+Y := '"The symbols {\em a} and {\em b} are called _"tags_" and are used to identify the two _"branches_" of the union. "
+
+Z := '"The {\sf Union} constructor can take any number of arguments and has an alternate form without {\em tags} (see \downlink{Union(A,B)}{UntaggedUnion}). "
+
+W := '"This tagged {\sf Union} type is necessary, for example, to disambiguate two branches of a union where {\em A} and {\em B} denote the same type. "
+
+A := '"{\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language."
+
+MESSAGE := STRCONC(X,Y,Z,W,A)
+
+PUT('Union,'documentation,SUBST(MESSAGE,'MESSAGE,'(
+  (constructor (NIL MESSAGE))
+  (_=  (((Boolean) $ $)
+    "\spad{u = v} tests if two objects of the union are equal, that is, \spad{u} and \spad{v} are objects of same branch which are equal."))
+  (case (((Boolean) $ "A")
+    "\spad{u case a} tests if \spad{u} is of branch \spad{a} of the union.")
+	        (((Boolean) $ "B")
+    "\spad{u case b} tests if \spad{u} is of branch \spad{b} of the union."))
+  (coerce ((A $)
+    "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of branch \spad{a} of the union. Error: if \spad{u} is of branch \spad{b} of the union.")
+          ((B $)
+    "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of branch \spad{b} branch of the union. Error: if \spad{u} is of the \spad{a} branch of the union.")
+          (($ A)
+    "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.")
+          (($ B)
+    "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type."))
+  )))
+
+X := '"{\sf Mapping(T,S,...)} denotes the class of objects which are mappings from a source domain ({\em S,...}) into a target domain {\em T}. The {\sf Mapping} constructor can take any number of arguments."
+
+Y := '" All but the first argument is regarded as part of a source tuple for the mapping. For example, {\sf Mapping(T,A,B)} denotes the class of mappings from {\em (A,B)} into {\em T}. "
+
+Z := '"{\sf Mapping} is a primitive domain of \Language{} which cannot be defined in the \Language{} language."
+
+MESSAGE := STRCONC(X,Y,Z)
+
+PUT('Mapping,'documentation, SUBST(MESSAGE,'MESSAGE,'(
+  (constructor (NIL MESSAGE))
+  (_=  (((Boolean) $ $)
+    "\spad{u = v} tests if mapping objects are equal."))
+   )))
+
+X := '"{\em Enumeration(a1, a2 ,..., aN)} creates an object which is exactly one of the N symbols {\em a1}, {\em a2}, ..., or {\em aN}, N > 0. "
+
+Y := '" The {\em Enumeration} can constructor can take any number of symbols as arguments."
+
+MESSAGE := STRCONC(X, Y)
+
+PUT('Enumeration, 'documentation, SUBST(MESSAGE, 'MESSAGE, '(
+  (constructor (NIL MESSAGE))
+  (_= (((Boolean) _$ _$)
+    "\spad{e = f} tests for equality of two enumerations \spad{e} and \spad{f}"))
+  (_^_= (((Boolean) _$ _$)
+    "\spad{e ^= f} tests that two enumerations \spad{e} and \spad{f} are nont equal"))
+  (coerce (((OutputForm) _$)
+     "\spad{coerce(e)} returns a representation of enumeration \spad{r} as an output form")
+          ((_$ (Symbol))
+     "\spad{coerce(s)} converts a symbol \spad{s} into an enumeration which has \spad{s} as a member symbol"))
+  )))
+
+
+mkConArgSublis args ==
+  [[arg,:INTERN digits2Names PNAME arg] for arg in args
+     | (s := PNAME arg) and or/[DIGITP ELT(s,i) for i in 0..MAXINDEX s]]
+
+digits2Names s ==
+--This is necessary since arguments of conforms CANNOT have digits in TechExplorer
+  str := '""
+  for i in 0..MAXINDEX s repeat
+    c := s.i
+    segment :=
+      n := DIGIT_-CHAR_-P c =>
+        ('("Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine")).n
+      c
+    CONCAT(str, segment)
+  str
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-data.boot.pamphlet b/src/interp/br-data.boot.pamphlet
new file mode 100644
index 00000000..a5490ee7
--- /dev/null
+++ b/src/interp/br-data.boot.pamphlet
@@ -0,0 +1,809 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-data.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+lefts u ==
+   [x for x in HKEYS  _*HASCATEGORY_-HASH_* | CDR x = u]
+
+
+
+--====================> WAS b-data.boot <================================
+
+--============================================================================
+--              Build Library Database (libdb.text,...)
+--============================================================================
+--Formal for libdb.text:
+--  constructors    Cname\#\I\sig \args   \abb \comments (C is C, D, P, X)
+--  operations      Op  \#\E\sig \conname\pred\comments (E is one of U/E)
+--  attributes      Aname\#\E\args\conname\pred\comments
+--  I = <x if exposed><d if category with a default package>
+buildLibdb(:options) ==  --called by buildDatabase (database.boot)
+  domainList := IFCAR options  --build local libdb if list of domains is given
+  $OpLst: local := nil
+  $AttrLst: local := nil
+  $DomLst : local := nil
+  $CatLst : local := nil
+  $PakLst : local := nil
+  $DefLst : local := nil
+  deleteFile '"temp.text"
+  $outStream: local := MAKE_-OUTSTREAM '"temp.text"
+  if null domainList then
+    comments :=
+      '"\spad{Union(A,B,...,C)} is a primitive type in AXIOM used to represent objects of type \spad{A} or of type \spad{B} or...or of type \spad{C}."
+    writedb
+      buildLibdbString ['"dUnion",1,'"x",'"special",'"(A,B,...,C)",'union,comments]
+    comments :=
+      '"\spad{Record(a:A,b:B,...,c:C)} is a primitive type in AXIOM used to represent composite objects made up of objects of type \spad{A}, \spad{B},..., \spad{C} which are indexed by _"keys_" (identifiers) \spad{a},\spad{b},...,\spad{c}."
+    writedb
+      buildLibdbString ['"dRecord",1,'"x",'"special",'"(a:A,b:B,...,c:C)",'RECORD,comments]
+    comments :=
+      '"\spad{Mapping(T,S)} is a primitive type in AXIOM used to represent mappings from source type \spad{S} to target type \spad{T}. Similarly, \spad{Mapping(T,A,B)} denotes a mapping from source type \spad{(A,B)} to target type \spad{T}."
+    writedb
+      buildLibdbString ['"dMapping",1,'"x",'"special",'"(T,S)",'MAPPING,comments]
+    comments :=
+      '"\spad{Enumeration(a,b,...,c)} is a primitive type in AXIOM used to represent the object composed of the symbols \spad{a},\spad{b},..., and \spad{c}."
+    writedb
+      buildLibdbString ['"dEnumeration",1,'"x",'"special",'"(a,b,...,c)",'ENUM,comments]
+  $conname: local := nil
+  $conform: local := nil
+  $exposed?:local := nil
+  $doc:     local := nil
+  $kind:    local := nil
+  constructorList := domainList or allConstructors()
+  for con in constructorList repeat
+    writedb buildLibdbConEntry con
+    [attrlist,:oplist] := getConstructorExports $conform
+    buildLibOps oplist
+    buildLibAttrs attrlist
+  SHUT $outStream
+  domainList => 'done         --leave new database in temp.text
+  OBEY
+    $machineType = 'RIOS => '"sort -f -T /tmp -y200 _"temp.text_"  > _"libdb.text_""
+    $machineType = 'SPARC => '"sort -f  _"temp.text_"  > _"libdb.text_""
+    '"sort  _"temp.text_"  > _"libdb.text_""
+  --OBEY '"mv libdb.text olibdb.text"
+  RENAME_-FILE('"libdb.text", '"olibdb.text")
+  deleteFile '"temp.text"
+
+buildLibdbConEntry conname ==
+    NULL GETDATABASE(conname, 'CONSTRUCTORMODEMAP) => nil
+    abb:=GETDATABASE(conname,'ABBREVIATION)
+    $conname := conname
+    conform := GETDATABASE(conname,'CONSTRUCTORFORM) or [conname] --hack for Category,..
+    $conform := dbMkForm SUBST('T,"T$",conform)
+    null $conform => nil
+    $exposed? := (isExposedConstructor conname => '"x"; '"n")
+    $doc      := GETDATABASE(conname, 'DOCUMENTATION)
+    pname := PNAME conname
+    kind  := GETDATABASE(conname,'CONSTRUCTORKIND)
+    if kind = 'domain
+      and GETDATABASE(conname,'CONSTRUCTORMODEMAP) is [[.,t,:.],:.]
+       and t is ['CATEGORY,'package,:.] then kind := 'package
+    $kind :=
+      pname.(MAXINDEX pname) = char '_& => 'x
+      DOWNCASE (PNAME kind).0
+    argl := rest $conform
+    conComments :=
+      LASSOC('constructor,$doc) is [[=nil,:r]] => libdbTrim concatWithBlanks r
+      '""
+    argpart:= SUBSTRING(form2HtString ['f,:argl],1,nil)
+    sigpart:= libConstructorSig $conform
+    header := STRCONC($kind,PNAME conname)
+    buildLibdbString [header,#argl,$exposed?,sigpart,argpart,abb,conComments]
+
+dbMkForm x == atom x and [x] or x
+
+buildLibdbString [x,:u] ==
+  STRCONC(STRINGIMAGE x,"STRCONC"/[STRCONC('"`",STRINGIMAGE y) for y in u])
+
+libConstructorSig [conname,:argl] ==
+  [[.,:sig],:.] := GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+  formals := TAKE(#argl,$FormalMapVariableList)
+  sig := SUBLISLIS(formals,$TriangleVariableList,sig)
+  keys := [g(f,sig,i) for f in formals for i in 1..] where
+    g(x,u,i) ==  --does x appear in any but i-th element of u?
+      or/[CONTAINED(x,y) for y in u for j in 1.. | j ^= i]
+  sig := fn SUBLISLIS(argl,$FormalMapVariableList,sig) where
+    fn x ==
+      atom x => x
+      x is ['Join,a,:r] => ['Join,fn a,'etc]
+      x is ['CATEGORY,:.] => 'etc
+      [fn y for y in x]
+  sig := [first sig,:[(k => [":",a,s]; s)
+            for a in argl for s in rest sig for k in keys]]
+  sigpart:= form2LispString ['Mapping,:sig]
+  if null ncParseFromString sigpart then
+    sayBrightly ['"Won't parse: ",sigpart]
+  sigpart
+
+concatWithBlanks r ==
+  r is [head,:tail] =>
+    tail => STRCONC(head,'" ",concatWithBlanks tail)
+    head
+  '""
+
+writedb(u) ==
+  not STRINGP u => nil        --skip if not a string
+  PRINTEXP(addPatchesToLongLines(u,500),$outStream)
+  --positions for tick(1), dashes(2), and address(9), i.e. 12
+  TERPRI $outStream
+
+addPatchesToLongLines(s,n) ==
+  #s > n => STRCONC(SUBSTRING(s,0,n),
+              addPatchesToLongLines(STRCONC('"--",SUBSTRING(s,n,nil)),n))
+  s
+
+buildLibOps oplist == for [op,sig,:pred] in oplist repeat buildLibOp(op,sig,pred)
+
+buildLibOp(op,sig,pred) ==
+--operations      OKop  \#\sig \conname\pred\comments (K is U or C)
+  nsig := SUBLISLIS(rest $conform,$FormalMapVariableList,sig)
+  pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred)
+  nsig := SUBST('T,"T$",nsig)   --this ancient artifact causes troubles!
+  pred := SUBST('T,"T$",pred)
+  sigpart:= form2LispString ['Mapping,:nsig]
+  predString := (pred = 'T => '""; form2LispString pred)
+  sop :=
+    (s := STRINGIMAGE op) = '"One" => '"1"
+    s = '"Zero" => '"0"
+    s
+  header := STRCONC('"o",sop)
+  conform:= STRCONC($kind,form2LispString $conform)
+  comments:= libdbTrim concatWithBlanks LASSOC(sig,LASSOC(op,$doc))
+  checkCommentsForBraces('operation,sop,sigpart,comments)
+  writedb
+    buildLibdbString [header,# rest sig,$exposed?,sigpart,conform,predString,comments]
+
+libdbTrim s ==
+  k := MAXINDEX s
+  k < 0 => s
+  for i in 0..k repeat
+    s.i = $Newline => SETELT(s,i,char '_ )
+  trimString s
+
+checkCommentsForBraces(kind,sop,sigpart,comments) ==
+  count := 0
+  for i in 0..MAXINDEX comments repeat
+    c := comments.i
+    c = char '_{ => count := count + 1
+    c = char '_} =>
+      count := count - 1
+      count < 0 => missingLeft := true
+  if count < 0 or missingLeft then
+    tail :=
+      kind = 'attribute => [sop,'"(",sigpart,'")"]
+      [sop,'": ",sigpart]
+    sayBrightly ['"(",$conname,'" documentation) missing left brace--> ",:tail]
+  if count > 0 then
+    sayBrightly ['"(",$conname,'" documentation) missing right brace--> ",:tail]
+  if count ^= 0 or missingLeft then pp comments
+
+buildLibAttrs attrlist ==
+  for [name,argl,:pred] in attrlist repeat buildLibAttr(name,argl,pred)
+
+buildLibAttr(name,argl,pred) ==
+--attributes      AKname\#\args\conname\pred\comments (K is U or C)
+  header := STRCONC('"a",STRINGIMAGE name)
+  argPart:= SUBSTRING(form2LispString ['f,:argl],1,nil)
+  pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred)
+  predString := (pred = 'T => '""; form2LispString pred)
+  header := STRCONC('"a",STRINGIMAGE name)
+  conname := STRCONC($kind,form2LispString $conname)
+  comments:= concatWithBlanks LASSOC(['attribute,:argl],LASSOC(name,$doc))
+  checkCommentsForBraces('attribute,STRINGIMAGE name,argl,comments)
+  writedb
+    buildLibdbString [header,# argl,$exposed?,argPart,conname,predString,comments]
+
+dbAugmentConstructorDataTable() ==
+  instream := MAKE_-INSTREAM '"libdb.text"
+  while not EOFP instream repeat
+    fp   := FILE_-POSITION instream
+    line := READLINE instream
+    cname := INTERN dbName line
+    entry := getCDTEntry(cname,true) =>  --skip over Mapping, Union, Record
+       [name,abb,:.] := entry
+       RPLACD(CDR entry,PUTALIST(CDDR entry,'dbLineNumber,fp))
+--     if xname := constructorHasExamplePage entry then
+--       RPLACD(CDR entry,PUTALIST(CDDR entry,'dbExampleFile,xname))
+       args := IFCDR GETDATABASE(name,'CONSTRUCTORFORM)
+       if args then RPLACD(CDR entry,PUTALIST(CDDR entry,'constructorArgs,args))
+  'done
+
+dbHasExamplePage conname ==
+  sname    := STRINGIMAGE conname
+  abb      := constructor? conname
+  ucname   := UPCASE STRINGIMAGE abb
+  pathname :=STRCONC(getEnv '"AXIOM",'"/share/hypertex/pages/",ucname,'".ht")
+  isExistingFile pathname => INTERN STRCONC(sname,'"XmpPage")
+  nil
+
+dbRead(n) ==
+  instream := MAKE_-INSTREAM STRCONC(getEnv('"AXIOM"), '"/algebra/libdb.text")
+  FILE_-POSITION(instream,n)
+  line := READLINE instream
+  SHUT instream
+  line
+
+dbReadComments(n) ==
+  n = 0 => '""
+  instream := MAKE_-INSTREAM STRCONC(getEnv('"AXIOM"),'"/algebra/comdb.text")
+  FILE_-POSITION(instream,n)
+  line := READLINE instream
+  k := dbTickIndex(line,1,1)
+  line := SUBSTRING(line,k + 1,nil)
+  while not EOFP instream and (x := READLINE instream) and
+    (k := MAXINDEX x) and (j := dbTickIndex(x,1,1)) and (j < k) and
+      x.(j := j + 1) = char '_- and x.(j := j + 1) = char '_- repeat
+        xtralines := [SUBSTRING(x,j + 1,nil),:xtralines]
+  SHUT instream
+  STRCONC(line, "STRCONC"/NREVERSE xtralines)
+
+dbSplitLibdb() ==
+  instream := MAKE_-INSTREAM  '"olibdb.text"
+  outstream:= MAKE_-OUTSTREAM '"libdb.text"
+  comstream:= MAKE_-OUTSTREAM '"comdb.text"
+  PRINTEXP(0,    comstream)
+  PRINTEXP($tick,comstream)
+  PRINTEXP('"",  comstream)
+  TERPRI(comstream)
+  while not EOFP instream repeat
+    line := READLINE instream
+    outP := FILE_-POSITION outstream
+    comP := FILE_-POSITION comstream
+    [prefix,:comments] := dbSplit(line,6,1)
+    PRINTEXP(prefix,outstream)
+    PRINTEXP($tick ,outstream)
+    null comments =>
+      PRINTEXP(0,outstream)
+      TERPRI(outstream)
+    PRINTEXP(comP,outstream)
+    TERPRI(outstream)
+    PRINTEXP(outP  ,comstream)
+    PRINTEXP($tick ,comstream)
+    PRINTEXP(first comments,comstream)
+    TERPRI(comstream)
+    for c in rest comments repeat
+      PRINTEXP(outP  ,comstream)
+      PRINTEXP($tick ,comstream)
+      PRINTEXP(c, comstream)
+      TERPRI(comstream)
+  SHUT instream
+  SHUT outstream
+  SHUT comstream
+  OBEY '"rm olibdb.text"
+
+dbSplit(line,n,k) ==
+  k := charPosition($tick,line,k + 1)
+  n = 1 => [SUBSTRING(line,0,k),:dbSpreadComments(SUBSTRING(line,k + 1,nil),0)]
+  dbSplit(line,n - 1,k)
+
+dbSpreadComments(line,n) ==
+  line = '"" => nil
+  k := charPosition(char '_-,line,n + 2)
+  k >= MAXINDEX line => [SUBSTRING(line,n,nil)]
+  line.(k + 1) ^= char '_- =>
+    u := dbSpreadComments(line,k)
+    [STRCONC(SUBSTRING(line,n,k - n),first u),:rest u]
+  [SUBSTRING(line,n,k - n),:dbSpreadComments(SUBSTRING(line,k,nil),0)]
+
+--============================================================================
+--                  Build Glossary
+--============================================================================
+buildGloss() ==  --called by buildDatabase (database.boot)
+--starting with gloss.text, build glosskey.text and glossdef.text
+  $constructorName : local := nil
+  $exposeFlag : local := true
+  $outStream: local := MAKE_-OUTSTREAM '"temp.text"
+  $x : local := nil
+  $attribute? : local := true     --do not surround first word
+  pathname := STRCONC(getEnv '"AXIOM",'"/algebra/gloss.text")
+  instream := MAKE_-INSTREAM pathname
+  keypath  := '"glosskey.text"
+  OBEY STRCONC('"rm -f ",keypath)
+  outstream:= MAKE_-OUTSTREAM keypath
+  htpath   := '"gloss.ht"
+  OBEY STRCONC('"rm -f ",htpath)
+  htstream:= MAKE_-OUTSTREAM htpath
+  defpath  := '"glossdef.text"
+  defstream:= MAKE_-OUTSTREAM defpath
+  pairs := getGlossLines instream
+  PRINTEXP('"\begin{page}{GlossaryPage}{G l o s s a r y}\beginscroll\beginmenu",htstream)
+  for [name,:line] in pairs repeat
+    outP  := FILE_-POSITION outstream
+    defP  := FILE_-POSITION defstream
+    lines := spreadGlossText transformAndRecheckComments(name,[line])
+    PRINTEXP(name, outstream)
+    PRINTEXP($tick,outstream)
+    PRINTEXP(defP, outstream)
+    TERPRI(outstream)
+--  PRINTEXP('"\item\newline{\em \menuitemstyle{}}\tab{0}{\em ",htstream)
+    PRINTEXP('"\item\newline{\em \menuitemstyle{}}{\em ",htstream)
+    PRINTEXP(name,        htstream)
+    PRINTEXP('"}\space{}",htstream)
+    TERPRI(htstream)
+    for x in lines repeat
+      PRINTEXP(outP, defstream)
+      PRINTEXP($tick,defstream)
+      PRINTEXP(x,    defstream)
+      TERPRI defstream
+    PRINTEXP("STRCONC"/lines,htstream)
+    TERPRI htstream
+  PRINTEXP('"\endmenu\endscroll",htstream)
+  PRINTEXP('"\lispdownlink{Search}{(|htGloss| _"\stringvalue{pattern}_")} for glossary entry matching \inputstring{pattern}{24}{*}",htstream)
+  PRINTEXP('"\end{page}",htstream)
+  SHUT instream
+  SHUT outstream
+  SHUT defstream
+  SHUT htstream
+  SHUT $outStream
+
+spreadGlossText(line) ==
+--this function breaks up a line into chunks
+--eventually long line is put into gloss.text as several chunks as follows:
+----- key1`this is the first chunk
+----- XXX`and this is the second
+----- XXX`and this is the third
+----- key2`and this is the fourth
+--where XXX is the file position of key1
+--this is because grepping will only pick up the first 512 characters
+  line = '"" => nil
+  MAXINDEX line > 500 => [SUBSTRING(line,0,500),:spreadGlossText(SUBSTRING(line,500,nil))]
+  [line]
+
+getGlossLines instream ==
+--instream has text of the form:
+----- key1`this is the first line
+----- and this is the second
+----- key2'and this is the third
+--result is
+----- key1'this is the first line and this is the second
+----- key2'and this is the third
+  keys := nil
+  text := nil
+  lastLineHadTick := false
+  while not EOFP instream repeat
+    line := READLINE instream
+    #line = 0 => 'skip
+    n := charPosition($tick,line,0)
+    last := IFCAR text
+    n > MAXINDEX line =>  --this line is continuation of previous line; concat it
+      fill :=
+        #last = 0 =>
+          lastLineHadTick => '""
+          '"\blankline "
+        #last > 0 and last.(MAXINDEX last) ^= $charBlank => $charBlank
+        '""
+      lastLineHadTick := false
+      text := [STRCONC(last,fill,line),:rest text]
+    lastLineHadTick := true
+    keys := [SUBSTRING(line,0,n),:keys]
+    text := [SUBSTRING(line,n + 1,nil),:text]
+  ASSOCRIGHT listSort(function GLESSEQP,[[DOWNCASE key,key,:def] for key in keys for def in text])
+  --this complication sorts them after lower casing the keys
+
+--============================================================================
+--                  Build Users HashTable
+-- This database is written out as USERS.DATABASE (database.boot) and read using
+-- function getUsersOfConstructor. See functions whoUses and kcuPage in browser.
+--============================================================================
+mkUsersHashTable() ==  --called by buildDatabase (database.boot)
+  $usersTb := MAKE_-HASH_-TABLE()
+  for x in allConstructors() repeat
+    for conform in getImports x repeat
+      name := opOf conform
+      if not MEMQ(name,'(QUOTE)) then
+        HPUT($usersTb,name,insert(x,HGET($usersTb,name)))
+  for k in HKEYS $usersTb repeat
+    HPUT($usersTb,k,listSort(function GLESSEQP,HGET($usersTb,k)))
+  for x in allConstructors() | isDefaultPackageName x repeat
+    HPUT($usersTb,x,getDefaultPackageClients x)
+  $usersTb
+
+getDefaultPackageClients con ==  --called by mkUsersHashTable
+  catname := INTERN SUBSTRING(s := PNAME con,0,MAXINDEX s)
+  for [catAncestor,:.] in childrenOf([catname]) repeat
+    pakname := INTERN STRCONC(PNAME catAncestor,'"&")
+    if getCDTEntry(pakname,true) then acc := [pakname,:acc]
+    acc := union([CAAR x for x in domainsOf([catAncestor],nil)],acc)
+  listSort(function GLESSEQP,acc)
+
+--============================================================================
+--               Build Dependents Hashtable
+-- This hashtable is written out by database.boot as DEPENDENTS.DATABASE
+-- and read back in by getDependentsOfConstructor (see database.boot)
+-- This information is used by function kcdePage when a user asks for the
+-- dependents of a constructor.
+--============================================================================
+mkDependentsHashTable() == --called by buildDatabase (database.boot)
+  $depTb := MAKE_-HASH_-TABLE()
+  for nam in allConstructors() repeat
+    for con in getArgumentConstructors nam repeat
+      HPUT($depTb,con,[nam,:HGET($depTb,con)])
+  for k in HKEYS $depTb repeat
+    HPUT($depTb,k,listSort(function GLESSEQP,HGET($depTb,k)))
+  $depTb
+
+getArgumentConstructors con == --called by mkDependentsHashTable
+  argtypes := IFCDR IFCAR getConstructorModemap con or return nil
+  fn argtypes where
+    fn(u) == "union"/[gn x for x in u]
+    gn(x) ==
+      atom x => nil
+      x is ['Join,:r] => fn(r)
+      x is ['CATEGORY,:.] => nil
+      constructor? first x => [first x,:fn rest x]
+      fn rest x
+
+getImports conname == --called by mkUsersHashTable
+  conform := GETDATABASE(conname,'CONSTRUCTORFORM)
+  infovec := dbInfovec conname or return nil
+  template := infovec.0
+  u := [import(i,template)
+          for i in 5..(MAXINDEX template) | test]  where
+    test == template.i is [op,:.] and IDENTP op
+              and not MEMQ(op,'(Mapping Union Record Enumeration CONS QUOTE local))
+    import(x,template) ==
+      x is [op,:args] =>
+        op = 'QUOTE or op = 'NRTEVAL => CAR args
+        op = 'local => first args
+        op = 'Record =>
+          ['Record,:[[":",CADR y,import(CADDR y,template)] for y in args]]
+
+--TTT next three lines: handles some tagged/untagged Union case.
+        op = 'Union=>
+          args is [['_:,:x1],:x2] =>
+--          CAAR args = '_: => -- tagged!
+               ['Union,:[[":",CADR y,import(CADDR y,template)] for y in args]]
+          [op,:[import(y,template) for y in args]]
+
+        [op,:[import(y,template) for y in args]]
+      INTEGERP x => import(template.x,template)
+      x = '$ => '$
+      x = "$$" => "$$"
+      STRINGP x => x
+      systemError '"bad argument in template"
+  listSort(function GLESSEQP,SUBLISLIS(rest conform,$FormalMapVariableList,u))
+
+
+--============================================================================
+--                 Get Hierarchical Information
+--============================================================================
+getParentsFor(cname,formalParams,constructorCategory) ==
+--called by compDefineFunctor1
+  acc := nil
+  formals := TAKE(#formalParams,$TriangleVariableList)
+  constructorForm := GETDATABASE(cname, 'CONSTRUCTORFORM)
+  for x in folks constructorCategory repeat
+    x := SUBLISLIS(formalParams,formals,x)
+    x := SUBLISLIS(IFCDR constructorForm,formalParams,x)
+    x := SUBST('Type,'Object,x)
+    acc := [:explodeIfs x,:acc]
+  NREVERSE acc
+
+parentsOf con == --called by kcpPage, ancestorsRecur
+  if null BOUNDP '$parentsCache then SETQ($parentsCache,MAKE_-HASHTABLE 'ID)
+  HGET($parentsCache,con) or
+    parents := getParentsForDomain con
+    HPUT($parentsCache,con,parents)
+    parents
+
+parentsOfForm [op,:argl] ==
+  parents := parentsOf op
+  null argl or argl = (newArgl := rest GETDATABASE(op,'CONSTRUCTORFORM)) =>
+    parents
+  SUBLISLIS(argl, newArgl, parents)
+
+getParentsForDomain domname  == --called by parentsOf
+  acc := nil
+  for x in folks GETDATABASE(domname,'CONSTRUCTORCATEGORY) repeat
+    x :=
+      GETDATABASE(domname,'CONSTRUCTORKIND) = 'category =>
+        sublisFormal(IFCDR getConstructorForm domname,x,$TriangleVariableList)
+      sublisFormal(IFCDR getConstructorForm domname,x)
+    acc := [:explodeIfs x,:acc]
+  NREVERSE acc
+
+explodeIfs x == main where  --called by getParents, getParentsForDomain
+  main ==
+    x is ['IF,p,a,b] => fn(p,a,b)
+    [[x,:true]]
+  fn(p,a,b) ==
+    [:"append"/[gn(p,y) for y in a],:"append"/[gn(['NOT,p],y) for y in b]]
+  gn(p,a) ==
+    a is ['IF,q,b,:.] => fn(MKPF([p,q],'AND),b,nil)
+    [[a,:p]]
+
+folks u == --called by getParents and getParentsForDomain
+  atom u => nil
+  u is [op,:v] and MEMQ(op,'(Join PROGN))
+    or u is ['CATEGORY,a,:v] => "append"/[folks x for x in v]
+  u is ['SIGNATURE,:.] => nil
+  u is ['TYPE,:.] => nil
+  u is ['ATTRIBUTE,a] =>
+    PAIRP a and constructor? opOf a => folks a
+    nil
+  u is ['IF,p,q,r] =>
+    q1 := folks q
+    r1 := folks r
+    q1 or r1 => [['IF,p,q1,r1]]
+    nil
+  [u]
+
+descendantsOf(conform,domform) ==  --called by kcdPage
+  'category = GETDATABASE((conname := opOf conform),'CONSTRUCTORKIND) =>
+    cats := catsOf(conform,domform)
+    [op,:argl] := conform
+    null argl or argl = (newArgl := rest (GETDATABASE(op,'CONSTRUCTORFORM)))
+        => cats
+    SUBLISLIS(argl, newArgl, cats)
+  'notAvailable
+
+childrenOf conform ==
+  [pair for pair in descendantsOf(conform,nil) |
+    childAssoc(conform,parentsOfForm first pair)]
+
+childAssoc(form,alist) ==
+  null (argl := CDR form) => ASSOC(form,alist)
+  u := assocCar(opOf form, alist) => childArgCheck(argl,rest CAR u) and u
+  nil
+
+assocCar(x, al) == or/[pair for pair in al | x = CAAR pair]
+
+childArgCheck(argl, nargl) ==
+  and/[fn for x in argl for y in nargl for i in 0..] where
+    fn ==
+      x = y or constructor? opOf y => true
+      isSharpVar y => i = POSN1(y, $FormalMapVariableList)
+      false
+
+--computeDescendantsOf cat ==
+--dynamically generates descendants
+--  hash := MAKE_-HASHTABLE 'UEQUAL
+--  for [child,:pred] in childrenOf cat repeat
+--    childForm := getConstructorForm child
+--    HPUT(hash,childForm,pred)
+--    for [form,:pred] in descendantsOf(childForm,nil) repeat
+--      newPred :=
+--        oldPred := HGET(hash,form) => quickOr(oldPred,pred)
+--        pred
+--      HPUT(hash,form,newPred)
+--  mySort [[key,:HGET(hash,key)] for key in HKEYS hash]
+
+ancestorsOf(conform,domform) ==  --called by kcaPage, originsInOrder,...
+  'category = GETDATABASE((conname := opOf conform),'CONSTRUCTORKIND) =>
+       alist := GETDATABASE(conname,'ANCESTORS)
+       argl := IFCDR domform or IFCDR conform
+       [pair for [a,:b] in alist | pair] where pair ==
+         left :=  sublisFormal(argl,a)
+         right := sublisFormal(argl,b)
+         if domform then right := simpHasPred right
+         null right => false
+         [left,:right]
+  computeAncestorsOf(conform,domform)
+
+computeAncestorsOf(conform,domform) ==
+  $done: local := MAKE_-HASHTABLE 'UEQUAL
+  $if:   local := MAKE_-HASHTABLE 'ID
+  ancestorsRecur(conform,domform,true,true)
+  acc := nil
+  for op in listSort(function GLESSEQP,HKEYS $if) repeat
+    for pair in HGET($if,op) repeat acc := [pair,:acc]
+  NREVERSE acc
+
+ancestorsRecur(conform,domform,pred,firstTime?) == --called by ancestorsOf
+  op      := opOf conform
+  pred = HGET($done,conform) => nil   --skip if already processed
+  parents :=
+    firstTime? and ($insideCategoryIfTrue or $insideFunctorIfTrue) =>
+      $lisplibParents
+    parentsOf op
+  originalConform :=
+    firstTime? and ($insideCategoryIfTrue or $insideFunctorIfTrue) => $form
+    getConstructorForm op
+  if conform ^= originalConform then
+    parents := SUBLISLIS(IFCDR conform,IFCDR originalConform,parents)
+  for [newform,:p] in parents repeat
+    if domform and rest domform then
+      newdomform := SUBLISLIS(rest domform,rest conform,newform)
+      p          := SUBLISLIS(rest domform,rest conform,p)
+    newPred := quickAnd(pred,p)
+    ancestorsAdd(simpHasPred newPred,newdomform or newform)
+    ancestorsRecur(newform,newdomform,newPred,false)
+  HPUT($done,conform,pred)                  --mark as already processed
+
+ancestorsAdd(pred,form) == --called by ancestorsRecur
+  null pred => nil
+  op := IFCAR form or form
+  alist := HGET($if,op)
+  existingNode := ASSOC(form,alist) =>
+    RPLACD(existingNode,quickOr(CDR existingNode,pred))
+  HPUT($if,op,[[form,:pred],:alist])
+
+domainsOf(conform,domname,:options) ==
+  $hasArgList := IFCAR options
+  conname := opOf conform
+  u := [key for key in HKEYS _*HASCATEGORY_-HASH_*
+    | key is [anc,: =conname]]
+  --u is list of pairs (a . b) where b = conname
+  --we sort u then replace each b by the predicate for which this is true
+  s := listSort(function GLESSEQP,COPY u)
+  s := [[CAR pair,:GETDATABASE(pair,'HASCATEGORY)] for pair in s]
+  transKCatAlist(conform,domname,listSort(function GLESSEQP,s))
+
+catsOf(conform,domname,:options) ==
+  $hasArgList := IFCAR options
+  conname := opOf conform
+  alist := nil
+  for key in allConstructors() repeat
+    for item in GETDATABASE(key,'ANCESTORS) | conname = CAAR item repeat
+      [[op,:args],:pred] := item
+      newItem :=
+        args => [[args,:pred],:LASSOC(key,alist)]
+        pred
+      alist := insertShortAlist(key,newItem,alist)
+  transKCatAlist(conform,domname,listSort(function GLESSEQP,alist))
+
+transKCatAlist(conform,domname,s) == main where
+  main ==
+    domname => --accept only exact matches after substitution
+      domargs := rest domname
+      acc := nil
+      rest conform =>
+        for pair in s repeat --pair has form [con,[conargs,:pred],...]]
+          leftForm := getConstructorForm CAR pair
+          for (ap := [args,:pred]) in CDR pair repeat
+            match? :=
+              domargs = args => true
+              HAS__SHARP__VAR args => domargs = sublisFormal(KDR domname,args)
+              nil
+            null match? => 'skip
+            npred := sublisFormal(KDR leftForm,pred)
+            acc := [[leftForm,:npred],:acc]
+        NREVERSE acc
+      --conform has no arguments so each pair has form [con,:pred]
+      for pair in s repeat
+        leftForm := getConstructorForm CAR pair or systemError nil
+        RPLACA(pair,leftForm)
+        RPLACD(pair,sublisFormal(KDR leftForm,CDR pair))
+      s
+    --no domname, so look for special argument combinations
+    acc := nil
+    KDR conform =>
+      farglist := TAKE(#rest conform,$FormalMapVariableList)
+      for pair in s repeat --pair has form [con,[conargs,:pred],...]]
+        leftForm := getConstructorForm CAR pair
+        for (ap := [args,:pred]) in CDR pair repeat
+          hasArgsForm? := args ^= farglist
+          npred := sublisFormal(KDR leftForm,pred)
+          if hasArgsForm? then
+            subargs := sublisFormal(KDR leftForm,args)
+            hpred :=
+--            $hasArgsList => mkHasArgsPred subargs
+              ['hasArgs,:subargs]
+            npred := quickAnd(hpred,npred)
+          acc := [[leftForm,:npred],:acc]
+      NREVERSE acc
+    for pair in s repeat --pair has form [con,:pred]
+      leftForm := getConstructorForm CAR pair
+      RPLACA(pair,leftForm)
+      RPLACD(pair,sublisFormal(KDR leftForm,CDR pair))
+    s
+
+mkHasArgsPred subargs ==
+--$hasArgsList gives arguments of original constructor,e.g. LODO(A,M)
+--M is required to be Join(B,...); in looking for the domains of B
+--  we can find that if B has special value C, it can
+  systemError subargs
+
+sublisFormal(args,exp,:options) == main where
+  main ==  --use only on LIST structures; see also sublisFormalAlist
+    $formals: local := IFCAR options or $FormalMapVariableList
+    null args => exp
+    sublisFormal1(args,exp,#args - 1)
+  sublisFormal1(args,x,n) ==    --[sublisFormal1(args,y) for y in x]
+    x is [.,:.] =>
+      acc := nil
+      y := x
+      while null atom y repeat
+        acc := [sublisFormal1(args,QCAR y,n),:acc]
+        y := QCDR y
+      r := NREVERSE acc
+      if y then
+        nd := LASTNODE r
+        RPLACD(nd,sublisFormal1(args,y,n))
+      r
+    IDENTP x =>
+      j := or/[i for f in $formals for i in 0..n | EQ(f,x)] =>
+          args.j
+      x
+    x
+
+--=======================================================================
+--            Build Table of Lower Case Constructor Names
+--=======================================================================
+
+buildDefaultPackageNamesHT() ==
+  $defaultPackageNamesHT := MAKE_-HASH_-TABLE()
+  for nam in allConstructors() | isDefaultPackageName nam repeat
+    HPUT($defaultPackageNamesHT,nam,true)
+  $defaultPackageNamesHT
+
+$defaultPackageNamesHT := buildDefaultPackageNamesHT()
+
+--=======================================================================
+--            Code for Private Libdbs
+--=======================================================================
+-- $createLocalLibDb := false
+
+extendLocalLibdb conlist ==   --  called by astran
+  not $createLocalLibDb => nil
+  null conlist => nil
+  buildLibdb conlist          --> puts datafile into temp.text
+  $newConstructorList := union(conlist, $newConstructorList)
+  localLibdb := '"libdb.text"
+  not PROBE_-FILE '"libdb.text" =>
+    RENAME_-FILE('"temp.text",'"libdb.text")
+  oldlines := purgeNewConstructorLines(dbReadLines localLibdb, conlist)
+  newlines := dbReadLines '"temp.text"
+  dbWriteLines(MSORT union(oldlines,newlines), '"libdb.text")
+  deleteFile '"temp.text"
+
+purgeLocalLibdb() ==   --used for debugging purposes only
+  $newConstructorList := nil
+  obey '"rm libdb.text"
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-op1.boot.pamphlet b/src/interp/br-op1.boot.pamphlet
new file mode 100644
index 00000000..aea5b89b
--- /dev/null
+++ b/src/interp/br-op1.boot.pamphlet
@@ -0,0 +1,1161 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-op1.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS b-op1.boot <================================
+
+--=======================================================================
+--                   Operation Page Menu
+--=======================================================================
+--opAlist has form [[op,:alist],:.]  where each alist
+--        has form [sig,pred,origin,exposeFlag,comments]
+
+dbFromConstructor?(htPage) == htpProperty(htPage,'conform)
+
+dbPresentOps(htPage,which,:exclusions) ==
+  true => dbPresentOpsSaturn(htPage,which,exclusions)
+--Flags:
+--  fromConPage?:    came (originally) from a constructor page
+--  usage?:          display usage?
+--  star?:           display exposed/*=unexposed
+--  implementation?: display implementation?
+  htSay('"{\em Views:}")
+  asharp? := htpProperty(htPage,'isAsharpConstructor)
+  fromConPage? := (conname := opOf htpProperty(htPage,'conform))
+  usage? := $UserLevel = 'development and fromConPage? and which = '"operation"
+    and not (GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+      and not asharp?
+  star? := not fromConPage? or which = '"package operation"
+  implementation? := not asharp? and
+    $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
+  rightmost? := star? or (implementation? and not $includeUnexposed?)
+  tabs :=
+    which = '"attribute" => '("12" "12" "25" "40" 13)
+    star? => '("12" "19" "31" "43" 10)
+    implementation? => '("9" "16" "28" "44" 9)
+    '("9" "16" "28" "41" 12)
+  if INTEGERP first exclusions then exclusions := ['documentation]
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  empty? := null opAlist
+  htTab
+   which = '"attribute" => tabs.1
+   tabs.0
+  if empty? or member('names,exclusions) or null KDR opAlist
+    then htSay '"{\em names}"
+    else htMakePage [['bcLispLinks,['"names",'"",'dbShowOps,which,'names]]]
+  if which ^= '"attribute" then
+    htTab tabs.1
+    if empty? or member('signatures,exclusions)
+      then htSay '"{\em signatures}"
+      else htMakePage [['bcLispLinks,['"signatures",'"",'dbShowOps,which,'signatures]]]
+  htTab tabs.2
+  if empty? or member('parameters,exclusions) --also test for some parameter
+      or not dbDoesOneOpHaveParameters? opAlist
+    then htSay '"{\em parameters}"
+    else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowOps,which,'parameters]]]
+  htTab tabs.3
+  if not empty? and null IFCDR opAlist and not htpProperty(htPage,'noUsage)
+    then
+      if htpProperty(htPage,'conform)
+      then htMakePage
+             [['bcLinks,['"generalise",'"",'dbShowOps,which,'generalise]]]
+      else htMakePage
+             [['bcLinks,['"all domains",'"",'dbShowOps,which,'allDomains]]]
+    else
+      if empty? or MEMQ('usage,exclusions) or htpProperty(htPage,'noUsage) then htSay '"{\em filter}" else
+        htMakePage [['bcLinks,['"filter",'"",'dbShowOps,which,'filter]]]
+      htMakePage [['bcStrings, [tabs.4,'"",'filter,'EM]]]
+  htSay('"\newline ")
+  if star?
+  then
+    if $exposedOnlyIfTrue
+    then htMakePage
+           [['bcLinks,['"exposed",'" {\em only}",'dbShowOps,which,'exposureOff]]]
+    else
+      htSay('"*{\em =}")
+      htMakePage [['bcLinks,['"unexposed",'"",'dbShowOps,which,'exposureOn]]]
+--  else if (updown := dbCompositeWithMap htPage)
+--       then htMakePage [['bcLispLinks,[updown,'"",'dbShowUpDown,updown]]]
+  htTab tabs.0
+  if usage? then
+      if empty? or member('usage,exclusions) or GETDATABASE(conname,'CONSTRUCTORKIND) = 'category or HGET($defaultPackageNamesHT,conname) or htpProperty(htPage,'noUsage)
+      then htSay '"{\em usage}"
+      else htMakePage [['bcLispLinks,['"usage",'"",'whoUsesOperation,which,nil]]]
+  htTab tabs.1
+  if empty? or member('origins,exclusions)
+    then htSay '"{\em origins}"
+    else htMakePage [['bcLispLinks,['"origins",'"",'dbShowOps,which,'origins]]]
+  htTab tabs.2
+  if implementation? then
+    if member('implementation,exclusions) or which = '"attribute" or
+      ((conname := opOf htpProperty(htPage,'conform)) and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+    then htSay '"{\em implementation}"
+    else htMakePage [['bcLispLinks,['"implementation",'"",'dbShowOps,which,'implementation]]]
+  else if empty? or member('conditions,exclusions) or (htpProperty(htPage,'condition?) = 'no)
+      then htSay '"{\em conditions}"
+      else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowOps,which,'conditions]]]
+  htTab tabs.3
+  if empty? or member('documentation,exclusions)
+    then htSay '"{\em description}"
+    else htMakePage [['bcLispLinks,['"description",'"",'dbShowOps,which,'documentation]]]
+  htShowPageNoScroll()
+
+htTab s == htSay('"\tab{",s,'"}")
+
+dbDoesOneOpHaveParameters? opAlist ==
+  or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn ==
+    STRINGP x => dbPart(x,2,1) ^= '"0"
+    KAR x
+--============================================================================
+--               Master Switch Functions for Operation Views
+--============================================================================
+
+dbShowOps(htPage,which,key,:options) ==
+  --NEXT LINE SHOULD BE REMOVED if we are sure that which is a string
+  which := STRINGIMAGE which
+  if MEMQ(key,'(extended basic all)) then
+    $groupChoice := key
+    key := htpProperty(htPage,'key) or 'names
+  opAlist  :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+--      al := reduceByGroup(htPage,htpProperty(htPage,'principalOpAlist))
+--      htpSetProperty(htPage,'opAlist,al)
+--      al
+    htpProperty(htPage,'attrAlist)
+  key = 'generalise =>
+    arg  := STRINGIMAGE CAAR opAlist
+    which = '"attribute" => aPage arg
+    oPage arg
+  key = 'allDomains => dbShowOpAllDomains(htPage,opAlist,which)
+  key = 'filter =>
+    --if $saturn, IFCAR options contains filter string
+    filter := IFCAR options or pmTransFilter(dbGetInputString htPage)
+    filter is ['error,:.] => bcErrorPage filter
+    opAlist:= [x for x in opAlist | superMatch?(filter,DOWNCASE STRINGIMAGE opOf x)]
+    null opAlist => emptySearchPage(which,filter)
+    htPage := htInitPageNoScroll(htCopyProplist htPage)
+    if which = '"operation"
+      then htpSetProperty(htPage,'opAlist,opAlist)
+      else htpSetProperty(htPage,'attrAlist,opAlist)
+    if not htpProperty(htPage,'condition?) = 'no then
+      dbResetOpAlistCondition(htPage,which,opAlist)
+    dbShowOps(htPage,which,htpProperty(htPage,'exclusion))
+  htpSetProperty(htPage,'key,key)
+  if MEMQ(key,'(exposureOn exposureOff)) then
+    $exposedOnlyIfTrue :=
+       key = 'exposureOn => 'T
+       nil
+    key := htpProperty(htPage,'exclusion)
+  dbShowOp1(htPage,opAlist,which,key)
+
+reduceByGroup(htPage,opAlist) ==
+  not dbFromConstructor?(htPage) or null $groupChoice => opAlist
+  dbExpandOpAlistIfNecessary(htPage,opAlist,'"operation",true,false)
+  bitNumber := HGET($topicHash,$groupChoice)
+  res := [[op,:newItems] for [op,:items] in opAlist | newItems] where
+    newItems ==
+      null bitNumber => items
+      [x for x in items | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)]
+  res
+
+
+dbShowOp1(htPage,opAlist,which,key) ==
+  --set up for filtering below in dbGatherData
+  $which: local := which
+  if INTEGERP key then
+    opAlist := dbSelectData(htPage,opAlist,key)
+    ------> Jump out for constructor names in file <--------
+  INTEGERP key and opAlist is [[con,:.]] and htpProperty(htPage,'isFile)
+      and constructor? con => return conPageChoose con
+  if INTEGERP key then
+    htPage := htInitPageNoScroll(htCopyProplist htPage)
+    if which = '"operation"
+      then htpSetProperty(htPage,'opAlist,opAlist)
+      else htpSetProperty(htPage,'attrAlist,opAlist)
+    if not htpProperty(htPage,'condition?) = 'no then
+      dbResetOpAlistCondition(htPage,which,opAlist)
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+  --opAlist is expanded to form [[op,[sig,pred,origin,exposed,comments],...],...]
+    opAlist:=[item for [op,:items] in opAlist | item] where
+      item ==
+        acc := nil
+        for x in items | x.3 repeat acc:= [x,:acc]
+        null acc => nil
+        [op,:NREVERSE acc]
+  $conformsAreDomains : local := htpProperty(htPage,'domname)
+  opCount := opAlistCount(opAlist, which)
+  branch :=
+    INTEGERP key =>
+      opCount <= $opDescriptionThreshold => 'documentation
+      'names
+    key = 'names and null rest opAlist =>      --means a single op
+      opCount <= $opDescriptionThreshold => 'documentation
+      'names
+    key
+  [what,whats,fn] := LASSOC(branch,$OpViewTable)
+  data := dbGatherData(htPage,opAlist,which,branch)
+  dataCount := +/[1 for x in data | (what = '"Name" and $exposedOnlyIfTrue => atom x; true)]
+  namedPart :=
+    null rest opAlist =>
+      ops := escapeSpecialChars STRINGIMAGE CAAR opAlist
+      ['" {\em ",ops,'"}"]
+    nil
+  if what = '"Condition" and null KAR KAR data then dataCount := dataCount - 1
+  exposurePart :=
+    $exposedOnlyIfTrue => '(" Exposed ")
+    nil
+  firstPart :=
+    opCount = 0 => ['"No ",:exposurePart, pluralize capitalize which]
+    dataCount = 1 or dataCount = opCount =>
+      opCount = 1 => [:exposurePart, capitalize which,:namedPart]
+      [STRINGIMAGE opCount,'" ",:exposurePart,
+         pluralize capitalize which,:namedPart]
+    prefix := pluralSay(dataCount,what,whats)
+    [:prefix,'" for ",STRINGIMAGE opCount,'" ",pluralize capitalize which,:namedPart]
+  page := htInitPageNoScroll(htCopyProplist htPage)
+  ------------>above line used to call htInitPageHoHeading<----------
+  htAddHeading dbShowOpHeading([:firstPart,:fromHeading page], branch)
+  htpSetProperty(page,'data,data)
+  htpSetProperty(page,'branch,branch)
+  -- the only place where specialMessage property is set seems to be commented. out
+  if u := htpProperty(page,'specialMessage) then APPLY(first u,rest u)
+  htSayStandard('"\beginscroll ")
+  FUNCALL(fn,page,opAlist,which,data) --apply branch function
+  dbOpsExposureMessage()
+  htSayStandard("\endscroll ")
+  dbPresentOps(page,which,branch)
+  htShowPageNoScroll()
+
+opAlistCount(opAlist, which) == +/[foo for [op,:items] in opAlist] where foo ==
+  null $exposedOnlyIfTrue or which = '"attribute" => #items
+  --count if unexpanded---CDDR(w) = nil---or if w.3 = true
+  +/[1 for w in items | null (p := CDDR w) or p . 1]
+
+dbShowOpHeading(heading, branch) ==
+  suffix :=
+--  branch = 'signatures => '" viewed as signatures"
+    branch = 'parameters => '" viewed with parameters"
+    branch = 'origins    => '" organized by origins"
+    branch = 'conditions => '" organized by conditions"
+    '""
+  [:heading, suffix]
+
+dbOpsExposureMessage() ==
+  $atLeastOneUnexposed => htSay '"{\em *} = unexposed"
+
+fromHeading htPage ==
+  null htPage => '""
+  $pn := [htPage.0,'"}{"]
+  updomain := htpProperty(htPage,'updomain) =>
+    dnForm  := dbExtractUnderlyingDomain updomain
+    dnString:= form2StringList dnForm
+    dnFence := form2Fence  dnForm
+--  upString:= form2StringList updomain
+    upFence := form2Fence  updomain
+    upOp    := PNAME opOf  updomain
+    ['" {\em from} ",:dbConformGen dnForm,'" {\em under} \ops{",upOp,'"}{",:$pn,:upFence,'"}"]
+  domname  := htpProperty(htPage,'domname)
+  numberOfUnderlyingDomains := #[x for x in rest GETDATABASE(opOf domname,'COSIG) | x]
+--  numberOfUnderlyingDomains = 1 and
+--    KDR domname and (dn := dbExtractUnderlyingDomain domname) =>
+--      ['" {\em from} ",:pickitForm(domname,dn)]
+  KDR domname => ['" {\em from} ",:dbConformGen domname]
+  htpProperty(htPage,'fromHeading)
+
+pickitForm(form,uarg) ==
+  conform2StringList(form,FUNCTION dbConform,FUNCTION conformString,uarg)
+
+conformString(form) ==
+  KDR form =>
+    conform2StringList(form,FUNCTION conname2StringList,FUNCTION conformString,nil)
+  form2StringList form
+
+conform2StringList(form,opFn,argFn,exception) ==
+  exception := exception or '"%%%nothing%%%"
+  [op1,:args] := form
+  op := IFCAR HGET($lowerCaseConTb,op1) or op1
+  null args => APPLY(opFn,[op])
+  special := MEMQ(op,'(Union Record Mapping))
+  cosig :=
+    special => ['T for x in args]
+    rest GETDATABASE(op,'COSIG)
+  atypes :=
+    special => cosig
+    rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  sargl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    keyword :=
+      x is [":",y,t] =>
+        x := t
+        y
+      nil
+    res :=
+      x = exception => dbOpsForm exception
+      pred =>
+        STRINGP x => [x]
+        u := APPLY(argFn,[x])
+        atom u and [u] or u
+      typ := sublisFormal(args,atype)
+      if x is ['QUOTE,a] then x := a
+      u := mathform2HtString algCoerceInteractive(x,typ,'(OutputForm)) => [u]
+      NUMBERP x or STRINGP x => [x]
+      systemError()
+    keyword => [keyword,'": ",:res]
+    res
+  op = 'Mapping => dbMapping2StringList sargl
+  head :=
+    special => [op]
+    APPLY(opFn,[form])
+  [:head,'"(",:first sargl,:"append"/[[",",:y] for y in rest sargl],'")"]
+
+
+dbMapping2StringList [target,:sl] ==
+  null sl => target
+  restPart :=
+    null rest sl => nil
+    "append"/[[",",:y] for y in rest sl]
+  sourcePart :=
+    restPart => ['"(",:first sl,:restPart,'")"]
+    first sl
+  [:sourcePart,'" -> ",:target]
+
+dbOuttran form ==
+  if LISTP form then
+    [op,:args] := form
+  else
+    op := form
+    args := nil
+  cosig := rest GETDATABASE(op,'COSIG)
+  atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  argl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    pred => x
+    typ := sublisFormal(args,atype)
+    arg :=
+      x is ['QUOTE,a] => a
+      x
+    res := mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm))
+    NUMBERP res or STRINGP res => res
+    ['QUOTE,res]
+  [op,:argl]
+
+dbOpsForm form ==
+--one button for the operations of a type
+--1st arg: like "Matrix(Integer)" or "UP('x,Integer)" <---all highlighted
+--2nd arg: like (|Matrix| (|Integer|)) and (|U..P..| (QUOTE |x|) (|Integer|))
+  ["\ops{",:conform2StringList(form,FUNCTION conname2StringList,FUNCTION conformString,nil),'"}{",:$pn,:form2Fence form,'"}"]
+
+dbConform form ==
+--------------------> OBSELETE <--------------------------
+--one button for the main constructor page of a type
+--NOTE: Next line should be as follows---but form2Fence form will
+--      put, e.g. '((2 1 . 0) (0 1 . 0)) instead of x**2 + 1
+  $saturn => ["\conf{",:form2StringList opOf form,
+     '"}{\lispLink{\verb!{(|conForm| '",:form2Fence dbOuttran form,'")!}}}"]
+  ["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"]
+--["\conf{",:form2StringList opOf form,'"}{",:form2Fence opOf form,'"}"]
+
+
+dbConformGen form == dbConformGen1(form,true)
+--many buttons: one for the type and one for each inner type
+--NOTE: must only be called on types KNOWN to be correct
+
+dbConformGenUnder form == dbConformGen1(form,false)
+--same as above, except buttons only for the inner types
+
+dbConformGen1(form,opButton?) ==
+  opFunction :=
+    opButton? => FUNCTION dbConform
+    FUNCTION conname2StringList
+  originalOp := opOf form
+  op := unAbbreviateIfNecessary opOf form
+  args := IFCDR form
+  form :=
+    originalOp=op => form
+    [op, :args]
+  args => conform2StringList(form, opFunction,FUNCTION dbConformGen,nil)
+  APPLY(opFunction,[form])
+
+unAbbreviateIfNecessary op == IFCAR HGET($lowerCaseConTb, op) or op
+
+conname2StringList form == [PNAME unAbbreviateIfNecessary opOf form]
+
+--===========================================================================
+--               Data Gathering Code
+--============================================================================
+dbGatherData(htPage,opAlist,which,key) ==
+  key = 'implementation => dbGatherDataImplementation(htPage,opAlist)
+  dataFunction := LASSOC(key,table) where
+    table ==
+      $dbDataFunctionAlist or
+        ($dbDataFunctionAlist := [
+          ['signatures,:function dbMakeSignature],
+            ['parameters,:function dbContrivedForm],
+              ['origins,:function dbGetOrigin],
+                ['domains,:function dbGetOrigin],
+                  ['conditions,:function dbGetCondition]])
+  null dataFunction =>
+    --key= names or filter or documentation; do not expand
+    if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+      opAlist := --to get indexing correct
+         which = '"operation" => htpProperty(htPage,'opAlist)
+         htpProperty(htPage,'attrAlist)
+    acc := nil
+    initialExposure :=
+      htPage and htpProperty(htPage,'conform) and which ^= '"package operation"
+        => true
+      --never star ops from a constructor
+      nil
+    for [op,:alist] in opAlist repeat
+      exposureFlag := initialExposure
+      while alist repeat
+        item := first alist
+        isExposed? :=
+          STRINGP item => dbExposed?(item,char 'o)   --unexpanded case
+          null (r := rest rest item) => true      --assume true if unexpanded
+          r . 1                                   --expanded case
+        if isExposed? then return (exposureFlag := true)
+        alist := rest alist
+      node :=
+        exposureFlag => op
+        [op,nil]
+      acc := [node,:acc]
+    NREVERSE acc
+  data := nil
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,key in '(origins documentation),false)
+  --create data, a list of the form ((entry,exposeFlag,:entries)...)
+  for [op,:alist] in opAlist repeat
+    for item in alist repeat
+      entry := FUNCALL(dataFunction,op,item)--get key item
+      exposeFlag :=                         --is the current op-sig exposed?
+        null (r := rest rest item) => true  --not given, assume yes
+        r . 1                               --is  given, use value
+      tail :=
+        item is [.,'ASCONST,:.] => 'ASCONST
+        nil
+      newEntry :=
+        u := ASSOC(entry,data) =>           --key seen before? look on DATA
+          RPLACA(CDR u,CADR u or exposeFlag)--yes, expose if any 1 is exposed
+          u
+        data := [y := [entry,exposeFlag,:tail],:data]
+        y                                   --no, create new entry in DATA
+      if member(key,'(origins conditions)) then
+        r := CDDR newEntry
+        if atom r then r := nil             --clear out possible 'ASCONST
+        RPLACD(CDR newEntry,                --store op/sigs under key if needed
+          insert([dbMakeSignature(op,item),exposeFlag,:tail],r))
+  if member(key,'(origins conditions)) then
+    for entry in data repeat   --sort list of entries (after the 2nd)
+      tail := CDDR entry
+      tail :=
+        atom tail => tail
+        listSort(function LEXLESSEQP,tail)
+      RPLACD(CDR entry,tail)
+  data := listSort(function LEXLESSEQP,data)
+  data
+
+dbGatherDataImplementation(htPage,opAlist) ==
+--returns data, of form ((implementor exposed? entry entry...)...
+--  where entry has form ((op sig . implementor) . stuff)
+  conform := htpProperty(htPage,'conform)
+  domainForm  := htpProperty(htPage,'domname)
+  dom     := EVAL domainForm
+  which   := '"operation"
+  [nam,:$domainArgs] := domainForm
+  $predicateList: local := GETDATABASE(nam,'PREDICATES)
+  predVector := dom.3
+  u := getDomainOpTable(dom,true,ASSOCLEFT opAlist)
+  --u has form ((op,sig,:implementor)...)
+  --sort into 4 groups: domain exports, unexports, default exports, others
+
+  for (x := [.,.,:key]) in u for i in 0.. repeat
+    key = domainForm => domexports := [x,:domexports]
+    INTEGERP key => unexports := [x,:unexports]
+    isDefaultPackageForm? key => defexports := [x,:defexports]
+    key = 'nowhere => nowheres := [x,:nowheres]
+    key = 'constant =>constants := [x,:constants]
+    others := [x,:others]   --add chain domains go here
+  fn [nowheres,constants,domexports,SORTBY('CDDR,NREVERSE others),SORTBY('CDDR,
+               NREVERSE defexports),SORTBY('CDDR,NREVERSE unexports)] where
+    fn l ==
+      alist := nil
+      for u in l repeat
+        while u repeat
+          key := CDDAR u  --implementor
+          entries :=
+            [[CAR u,true],:[u and [CAR u,true] while key = CDDAR (u := rest u)]]
+          alist := [[key,gn key,:entries],:alist]
+      NREVERSE alist
+    gn key ==
+      atom key => true
+      isExposedConstructor CAR key
+
+dbSelectData(htPage,opAlist,key) ==
+  branch := htpProperty(htPage,'branch)
+  data   := htpProperty(htPage,'data)
+  MEMQ(branch,'(signatures parameters)) =>
+    dbReduceOpAlist(opAlist,data.key,branch)
+  MEMQ(branch,'(origins conditions implementation)) =>
+    key < 8192 => dbReduceOpAlist(opAlist,data.key,branch)
+    [newkey,binkey] := DIVIDE(key,8192)  --newkey is 1 too large
+    innerData := CDDR data.(newkey - 1)
+    dbReduceOpAlist(opAlist,innerData.binkey,'signatures)
+  [opAlist . key]
+
+dbReduceOpAlist(opAlist,data,branch) ==
+  branch = 'signatures => dbReduceBySignature(opAlist,CAAR data,CADAR data)
+  branch = 'origins => dbReduceBySelection(opAlist,CAR data,function CADDR)
+  branch = 'conditions => dbReduceBySelection(opAlist,CAR data,function CADR)
+  branch = 'implementation => dbReduceByOpSignature(opAlist,CDDR data)
+  branch = 'parameters => dbReduceByForm(opAlist,CAR data)
+  systemError ['"Unexpected branch: ",branch]
+
+dbReduceByOpSignature(opAlist,datalist) ==
+--reduces opAlist by implementation datalist, one of the form
+--    (((op,sig,:implementor),:stuff),...)
+  ops := [CAAR x for x in datalist] --x is [[op,sig,:implementor],:.]
+  acc := nil
+  for [op,:alist] in opAlist | MEMQ(op,ops) repeat
+    entryList := [entry for (entry := [sig,:.]) in alist | test] where test ==
+      or/[x for x in datalist | x is [[=op,=sig,:.],:.]]
+    entryList => acc := [[op,:NREVERSE entryList],:acc]
+  NREVERSE acc
+
+dbReduceBySignature(opAlist,op,sig) ==
+--reduces opAlist to one with a fixed op and sig
+  [[op,:[x for x in LASSOC(op,opAlist) | x is [=sig,:.]]]]
+
+dbReduceByForm(opAlist,form) ==
+  acc := nil
+  for [op,:alist] in opAlist repeat
+    items := [x for x in alist | dbContrivedForm(op,x) = form] =>
+      acc := [[op,:items],:acc]
+  NREVERSE acc
+
+dbReduceBySelection(opAlist,key,fn) ==
+  acc := nil
+  for [op,:alist] in opAlist repeat
+    items := [x for x in alist | FUNCALL(fn,x) = key] =>
+      acc := [[op,:items],:acc]
+  NREVERSE acc
+
+dbContrivedForm(op,[sig,:.]) ==
+  $which = '"attribute" => [op,sig]
+  dbMakeContrivedForm(op,sig)
+
+dbMakeSignature(op,[sig,:.]) == [op,sig]  --getDomainOpTable format
+
+dbGetOrigin(op,[.,.,origin,:.]) == origin
+
+dbGetCondition(op,[.,pred,:.]) == pred
+
+--dbInsertOpAlist(op,item,opAlist) ==
+--  insertAlist(op,[item,:LASSOC(op,opAlist)],opAlist)
+
+--dbSortOpAlist opAlist ==
+--  [[op,:listSort(function LEXLESSEQP,alist)]
+--    for [op,:alist] in listSort(function LEXLESSEQP,opAlist)]
+
+--============================================================================
+--               Branches of Views
+--============================================================================
+dbShowOpNames(htPage,opAlist,which,data) ==
+  single? := opAlist and null rest data
+  single? =>
+    ops := escapeSpecialChars STRINGIMAGE CAAR opAlist
+    htSayStandard('"Select a view below")
+    htSaySaturn '"Select a view with the right mouse button"
+  exposedOnly? := $exposedOnlyIfTrue and not dbFromConstructor?(htPage)
+  dbShowOpItems(which,data,exposedOnly?)
+
+dbShowOpItems(which,data,exposedOnly?) ==
+  htBeginTable()
+  firstTime := true
+  for i in 0.. for item in data repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    if atom item then
+      op := item
+      exposeFlag := true
+    else
+      [op,exposeFlag] := item
+    ops := escapeSpecialChars STRINGIMAGE op
+    exposeFlag or not exposedOnly? =>
+      htSay('"{")
+      bcStarSpaceOp(ops,exposeFlag)
+      htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,i]]]
+      htSay('"}")
+  htEndTable()
+
+dbShowOpAllDomains(htPage,opAlist,which) ==
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  catOriginAlist := nil --list of category origins
+  domOriginAlist := nil --list of domain origins
+  for [op,:items] in opAlist repeat
+    for [.,predicate,origin,:.] in items repeat
+      conname := CAR origin
+      GETDATABASE(conname,'CONSTRUCTORKIND) = 'category =>
+        pred := simpOrDumb(predicate,LASSQ(conname,catOriginAlist) or true)
+        catOriginAlist := insertAlist(conname,pred,catOriginAlist)
+      pred := simpOrDumb(predicate,LASSQ(conname,domOriginAlist) or true)
+      domOriginAlist := insertAlist(conname,pred,domOriginAlist)
+  --the following is similar to "domainsOf" but do not sort immediately
+  u := [COPY key for key in HKEYS _*HASCATEGORY_-HASH_*
+          | LASSQ(CDR key,catOriginAlist)]
+  for pair in u repeat
+    [dom,:cat] := pair
+    LASSQ(cat,catOriginAlist) = 'etc => RPLACD(pair,'etc)
+    RPLACD(pair,simpOrDumb(GETDATABASE(pair,'HASCATEGORY),true))
+  --now add all of the domains
+  for [dom,:pred] in domOriginAlist repeat
+    u := insertAlist(dom,simpOrDumb(pred,LASSQ(dom,u) or true),u)
+  cAlist := listSort(function GLESSEQP,u)
+  for pair in cAlist repeat RPLACA(pair,getConstructorForm first pair)
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,'"constructor")
+  htpSetProperty(htPage,'specialHeading,'"hoho")
+  dbShowCons(htPage,'names)
+
+simpOrDumb(new,old) ==
+  new = 'etc => 'etc
+  atom new => old
+  'etc
+
+dbShowOpOrigins(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,true,'"from",function bcStarConform)
+
+dbShowOpImplementations(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,true,'"by",function bcStarConform)
+
+dbShowOpConditions(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,nil,nil,function bcPred)
+
+dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
+-----------------> OBSELETE
+  single? := null rest data
+  htSay('"\beginmenu ")
+  bincount := 0
+  for [thing,exposeFlag,:items] in data repeat
+    htSay('"\item ")
+    if single? then htSay(menuButton())
+    else htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,bincount]]]
+    htSay '"{\em "
+    htSay
+      thing = 'nowhere => '"implemented nowhere"
+      thing = 'constant => '"constant"
+      thing = '_$ => '"by the domain"
+      INTEGERP thing => '"unexported"
+      constructorIfTrue =>
+        htSay word
+        atom thing => '" an unknown constructor"
+        '""
+      atom thing => '"unconditional"
+      '""
+    htSay '"}"
+    if null atom thing then
+      if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}")
+      htSay '" "
+      FUNCALL(fn,thing)
+    htSay('":\newline ")
+    dbShowOpSigList(which,items,(1 + bincount) * 8192)
+    bincount := bincount + 1
+  htSay '"\endmenu "
+
+dbShowKind conform ==
+  conname := CAR conform
+  kind := GETDATABASE(conname,'CONSTRUCTORKIND)
+  kind = 'domain =>
+    (s := PNAME conname).(MAXINDEX s) = '_& => '"default package"
+    '"domain"
+  PNAME kind
+
+dbShowOpSignatures(htPage,opAlist,which,data) == dbShowOpSigList(which,data,0)
+
+dbShowOpSigList(which,dataItems,count) ==
+--dataItems is (((op,sig,:.),exposureFlag,...)
+  single? := null rest dataItems
+  htBeginTable()
+  firstTime := true
+  for [[op,sig,:.],exposureFlag,:tail] in dataItems repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&";
+    ops := escapeSpecialChars STRINGIMAGE op
+    htSay '"{"
+--  if single? then htSay('"{\em ",ops,'"}") else.....
+    htSayExpose(ops,exposureFlag)
+    htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,count]]]
+    if which = '"attribute" then htSay args2HtString (sig and [sig]) else
+      htSay '": "
+      tail = 'ASCONST => bcConform first sig
+      bcConform ['Mapping,:sig]
+    htSay '"}"
+    count := count + 1
+  htEndTable()
+  count
+
+dbShowOpParameters(htPage,opAlist,which,data) ==
+  single? := null rest data
+  count := 0
+  htBeginTable()
+  firstTime := true
+  for item in data repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    [opform,exposeFlag,:tail] := item
+    op := intern IFCAR opform
+    args := IFCDR opform
+    ops := escapeSpecialChars STRINGIMAGE op
+    htSay '"{"
+    htSayExpose(ops,exposeFlag)
+    n := #opform
+    do
+      n = 2 and LASSOC('Nud,PROPLIST op) =>
+        dbShowOpParameterJump(ops,which,count,single?)
+        htSay('" {\em ",KAR args,'"}")
+      n = 3 and LASSOC('Led,PROPLIST op) =>
+        htSay('"{\em ",KAR args,'"} ")
+        dbShowOpParameterJump(ops,which,count,single?)
+        htSay('" {\em ",KAR KDR args,'"}")
+      dbShowOpParameterJump(ops,which,count,single?)
+      tail = 'ASCONST or member(op,'(0 1)) or which = '"attribute" and null IFCAR args => 'skip
+      htSay('"(")
+      if IFCAR args then htSay('"{\em ",IFCAR args,'"}")
+      for x in IFCDR args repeat
+        htSay('",{\em ",x,'"}")
+      htSay('")")
+    htSay '"}"
+    count := count + 1
+  htEndTable()
+
+dbShowOpParameterJump(ops,which,count,single?) ==
+  single? => htSay('"{\em ",ops,'"}")
+  htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,count]]]
+
+dbShowOpDocumentation(htPage,opAlist,which,data) ==
+  if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+    opAlist :=
+      which = '"operation" => htpProperty(htPage,'opAlist)
+      htpProperty(htPage,'attrAlist)
+    --NOTE: this line is necessary to get indexing right.
+    --The test below for $exposedOnlyIfTrue causes unexposed items
+    --to be skipped.
+  newWhich :=
+    conform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+    which = '"package operation" => '"operation"
+    which
+  expand := dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  if expand then
+    condata := dbGatherData(htPage,opAlist,which,'conditions)
+    htpSetProperty(htPage,'conditionData,condata)
+  base := -8192
+  exactlyOneOpSig := opAlist is [[.,.]] --checked by displayDomainOp
+  htSaySaturn '"\begin{description}"
+  for [op,:alist] in opAlist repeat
+    base := 8192 + base
+    for item in alist for j in 0.. repeat
+      [sig,predicate,origin,exposeFlag,comments] := item
+      exposeFlag or not $exposedOnlyIfTrue =>
+        if comments ^= '"" and STRINGP comments and (k := string2Integer comments) then
+          comments :=
+            MEMQ(k,'(0 1)) => '""
+            dbReadComments k
+          tail := CDDDDR item
+          RPLACA(tail,comments)
+        doc := (STRINGP comments and comments ^= '"" => comments; nil)
+        pred := predicate or true
+        index := (exactlyOneOpSig => nil; base + j)
+        if which = '"package operation" then
+          sig    := SUBST(conform,'_$,sig)
+          origin := SUBST(conform,'_$,origin)
+        displayDomainOp(htPage,newWhich,origin,op,sig,pred,doc,index,'dbChooseDomainOp,null exposeFlag,true)
+  htSaySaturn '"\end{description}"
+
+dbChooseDomainOp(htPage,which,index) ==
+  [opKey,entryKey] := DIVIDE(index,8192)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  [op,:entries] := opAlist . opKey
+  entry := entries . entryKey
+  htPage := htInitPageNoScroll(htCopyProplist htPage)
+  if which = '"operation"
+    then htpSetProperty(htPage,'opAlist,[[op,entry]])
+    else htpSetProperty(htPage,'attrAlist,[[op,entry]])
+  if not htpProperty(htPage,'condition?) = 'no then
+    dbResetOpAlistCondition(htPage,which,opAlist)
+  dbShowOps(htPage,which,'documentation)
+
+htSayExpose(op,flag) ==
+  $includeUnexposed? =>
+    flag => htBlank()
+    op.0 = char '_* => htSay '"{\em *} "
+    htSayUnexposed()
+  htSay '""
+--============================================================================
+--               Branch-in From Other Places
+--============================================================================
+dbShowOperationsFromConform(htPage,which,opAlist) ==  --branch in with lists
+  $groupChoice := nil
+  conform := htpProperty(htPage,'conform)
+  --prepare opAlist for possible filtering of groups
+  if null BOUNDP '$topicHash then
+    $topicHash := MAKE_-HASHTABLE 'ID
+    for [x,:c] in '((extended . 0) (basic . 1) (hidden . 2)) repeat
+      HPUT($topicHash,x,c)
+  if domform := htpProperty(htPage,'domname) then
+    $conformsAreDomains : local := true
+    reduceOpAlistForDomain(opAlist,domform,conform)
+  conform := domform or conform
+  kind := capitalize htpProperty(htPage,'kind)
+  exposePart :=
+    isExposedConstructor opOf conform => '""
+    '" Unexposed "
+  fromPart :=
+    domform => evalableConstructor2HtString domform
+    form2HtString conform
+  heading :=
+    ['" from ",exposePart,kind,'" {\em ",fromPart,'"}"]
+  expandProperty :=
+    which = '"operation" => 'expandOperations
+    'expandAttributes
+  htpSetProperty(htPage,expandProperty,'lists)
+  htpSetProperty(htPage,'fromHeading,heading)
+  reducedOpAlist :=
+    which = '"operation" =>  reduceByGroup(htPage,opAlist)
+    opAlist
+  if which = '"operation"
+    then
+      htpSetProperty(htPage,'principalOpAlist,opAlist)
+      htpSetProperty(htPage,'opAlist,reducedOpAlist)
+    else htpSetProperty(htPage,'attrAlist,opAlist)
+  if domform
+   then htpSetProperty(htPage,'condition?,'no)
+   else dbResetOpAlistCondition(htPage,which,opAlist)
+  dbShowOp1(htPage,reducedOpAlist,which,'names)
+
+reduceOpAlistForDomain(opAlist,domform,conform) ==
+--destructively simplify all predicates; filter out any that fail
+  form1 := [domform,:rest domform]
+  form2 := ['$,:rest conform]
+  for pair in opAlist repeat
+    RPLACD(pair,[test for item in rest pair | test]) where test ==
+      [head,:tail] := item
+      CAR tail = true => item
+      pred := simpHasPred SUBLISLIS(form1,form2,QCAR tail)
+      null pred => false
+      RPLACD(item,[pred])
+      item
+  opAlist
+
+dbShowOperationLines(which,linelist) ==  --branch in with lines
+  htPage := htInitPage(nil,nil)  --create empty page
+  opAlist := nil
+  lines := linelist
+  while lines repeat
+    name := dbName (x := first lines)
+    pile := [x]
+    while (lines := rest lines) and name = dbName (x := first lines) repeat
+      pile := [x,:pile]
+    opAlist := [[name,:NREVERSE pile],:opAlist]
+  opAlist := listSort(function LEXLESSEQP,NREVERSE opAlist)
+  if which = '"operation"
+    then htpSetProperty(htPage,'opAlist,opAlist)
+    else htpSetProperty(htPage,'attrAlist,opAlist)
+  expandProperty :=
+    which = '"operation" => 'expandOperations
+    'expandAttributes
+  htpSetProperty(htPage,expandProperty,'strings)
+  dbResetOpAlistCondition(htPage,which,opAlist)
+  if which = '"attribute" and BOUNDP '$attributeArgs and $attributeArgs then
+    --code needed to handle commutative("*"); called from aPage
+    --must completely expand the opAlist then check for those with
+    --arguments equal to $attributeArgs
+    --here: opAlist is [[op,:itemlist]]
+    dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,false)
+    opAlist := [[CAAR opAlist,:[item for item in CDAR opAlist | first item = $attributeArgs]]]
+  dbShowOp1(htPage,opAlist,which,'names)
+
+--============================================================================
+--                Code to Expand opAlist
+--============================================================================
+dbResetOpAlistCondition(htPage,which,opAlist) ==
+  value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true)
+  htpSetProperty(htPage,'condition?,(value => 'yes; 'no))
+  value
+
+dbSetOpAlistCondition(htPage,opAlist,which) ==
+--called whenever a new opAlist is needed
+--property can only be inherited if 'no (a subset says NO if whole says NO)
+  condition := htpProperty(htPage,'condition?)
+  MEMQ(condition,'(yes no)) => condition = 'yes
+  value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true)
+  htpSetProperty(htPage,'condition?,(value => 'yes; 'no))
+  value
+
+dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) ==
+--if condition? = true, stop when you find a non-trivial predicate
+--otherwise, expand in full
+--RETURNS:
+--  non-trivial predicate, if condition? = true and it finds one
+--  nil,                   otherwise
+--SIDE-EFFECT: this function references the "expand" property (set elsewhere):
+--  'strings, if not fully expanded and it contains strings
+--            i.e. opAlist is ((op . (string ...))...) if unexpanded
+--  'lists,   if not fully expanded and it contains lists
+--            i.e. opAlist is ((op . ((sig pred) ...))...) if unexpanded
+    condition? := condition? and not $exposedOnlyIfTrue
+    value      := nil  --return value
+    expandProperty :=
+      which = '"operation" => 'expandOperations
+      'expandAttributes
+    expandFlag := htpProperty(htPage,expandProperty)
+    expandFlag = 'fullyExpanded => nil
+    expandFlag = 'strings => --strings are partially expanded
+      for pair in opAlist repeat
+        [op,:lines] := pair
+        acc := nil
+        for line in lines repeat
+        --NOTE: we must expand all lines here for a given op
+        --      since below we will change opAlist
+        --Case 1: Already expanded; just cons it onto ACC
+          null STRINGP line => --already expanded
+            if condition? then --this could have been expanded at a lower level
+              if null atom (pred := CADR line) then value := pred
+            acc := [line,:acc] --this one is already expanded; record it anyway
+        --Case 2: unexpanded; expand it then cons it onto ACC
+          [name,nargs,xflag,sigs,conname,pred,comments] := dbParts(line,7,1)
+          predicate := ncParseFromString pred
+          if condition? and null atom predicate then value := predicate
+          sig := ncParseFromString sigs --is (Mapping,:.)
+          if which = '"operation" then
+            if sig isnt ['Mapping,:.]
+            then sayBrightly ['"Unexpected signature for ",name,'": ",sigs]
+            else sig := rest sig
+          conname := intern dbNewConname line
+          origin := [conname,:getConstructorArgs conname]
+          exposeFlag := dbExposed?(line,char 'o)
+          acc := [[sig,predicate,origin,exposeFlag,comments],:acc]
+        --always store the fruits of our labor:
+        RPLACD(pair,NREVERSE acc)             --at least partially expand it
+        condition? and value => return value  --early exit
+      value => value
+      condition? => nil
+      htpSetProperty(htPage,expandProperty,'fullyExpanded)
+    expandFlag = 'lists => --lists are partially expanded
+      -- entry is [sig, predicate, origin, exposeFlag, comments]
+      $value: local := nil
+      $docTableHash := MAKE_-HASHTABLE 'EQUAL
+      packageSymbol := false
+      domform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+      if isDefaultPackageName opOf domform then
+         catname := intern SUBSTRING(s := PNAME opOf domform,0,MAXINDEX s)
+         packageSymbol := first rest domform
+         domform := [catname,:rest rest domform]  --skip first argument ($)
+      docTable:= dbDocTable domform
+      for [op,:alist] in opAlist repeat
+        for [sig,:tail] in alist repeat
+          condition? => --the only purpose here is to find a non-trivial pred
+            null atom (pred := CAR tail) => return ($value := pred)
+            'skip
+          u :=
+            tail is [.,origin,:.] and origin =>
+--  must change any % into $ otherwise we will not pick up comments properly
+--  delete the SUBLISLIS when we fix on % or $ 
+              dbGetDocTable(op,SUBLISLIS(['$],['%],sig),dbDocTable origin,which,nil)
+            if packageSymbol then sig := SUBST('_$,packageSymbol,sig)
+            dbGetDocTable(op,sig,docTable,which,nil)
+          origin := IFCAR u or origin
+          docCode := IFCDR u   --> (doc . code)
+--        if null FIXP CDR docCode then harhar(op) -->
+          if null doc and which = '"attribute" then doc := getRegistry(op,sig)
+          RPLACD(tail,[origin,isExposedConstructor opOf origin,:docCode])
+        $value => return $value
+      $value => $value
+      condition? => nil
+      htpSetProperty(htPage,expandProperty,'fullyExpanded)
+    'done
+
+getRegistry(op,sig) ==
+  u := GETDATABASE('AttributeRegistry,'DOCUMENTATION)
+  v := LASSOC(op,u)
+  match := or/[y for y in v | y is [['attribute,: =sig],:.]] => CADR match
+  '""
+
+evalableConstructor2HtString domform ==
+  if VECP domform then domform := devaluate domform
+  conname := first domform
+  coSig   := rest GETDATABASE(conname,'COSIG)
+  --entries are T for arguments which are domains; NIL for computational objects
+  and/[x for x in coSig] => form2HtString(domform,nil,true)
+  arglist := [unquote x for x in rest domform] where
+    unquote arg  ==
+      arg is [f,:args] =>
+        f = 'QUOTE => first args
+        [f,:[unquote x for x in args]]
+      arg
+  fargtypes:=CDDAR GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+--argtypes:= sublisFormal(arglist,fargtypes)
+  form2HtString([conname,:[fn for arg in arglist for x in coSig
+                   for ftype in fargtypes]],nil,true) where
+    fn ==
+      x => arg
+      typ := sublisFormal(arglist,ftype)
+      mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm))
+
+mathform2HtString form == escapeString
+  $fortInts2Floats: local := false
+  form := niladicHack form
+  form is ['QUOTE,a] => STRCONC('"'","STRCONC"/fortexp0 a)
+  form is ['BRACKET,['AGGLST,:arg]] =>
+    if arg is ['construct,:r] then arg := r
+    arg :=
+      atom arg => [arg]
+      [y for x in arg | y := (x is ['QUOTE,a] => a; x)]
+    tailPart := "STRCONC"/[STRCONC('",",STRINGIMAGE x) for x in rest arg]
+    STRCONC('"[",STRINGIMAGE first arg,tailPart,'"]")
+  form is ['BRACKET,['AGGLST,'QUOTE,arg]] =>
+    if atom arg then arg := [arg]
+    tailPart := "STRCONC"/[STRCONC('",",x) for x in rest arg]
+    STRCONC('"[",first arg,tailPart,'"]")
+  atom form => form
+  "STRCONC"/fortexp0 form
+
+niladicHack form ==
+  atom form => form
+  form is [x] and GETL(x,'NILADIC) => x
+  [niladicHack x for x in form]
+
+--============================================================================
+--                Getting Operations from Domain
+--============================================================================
+
+getDomainOpTable(dom,fromIfTrue,:options) ==
+  ops := KAR options
+  $predEvalAlist : local := nil
+  $returnNowhereFromGoGet: local := true
+  domname := dom.0
+  conname := CAR domname
+  abb := getConstructorAbbreviation conname
+  opAlist := getOperationAlistFromLisplib conname
+  "append"/[REMDUP [[op1,:fn] for [sig,slot,pred,key,:.] in u
+              | key ^= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))]
+                 for [op,:u] in opAlist] where
+    memq(op,ops) ==   --dirty trick to get 0 and 1 instead of Zero and One
+      MEMQ(op,ops) => op
+      EQ(op,'One)  => MEMQ(1,ops) and 1
+      EQ(op,'Zero) => MEMQ(0,ops) and 0
+      false
+    fn ==
+      sig1 := sublisFormal(rest domname,sig)
+      predValue := evalDomainOpPred(dom,pred)
+      info :=
+        null predValue =>
+          1   -- signifies not exported
+        null fromIfTrue => nil
+        cell := compiledLookup(op,sig1,dom) =>
+          [f,:r] := cell
+          f = 'nowhere => 'nowhere           --see replaceGoGetSlot
+          f = 'makeSpadConstant => 'constant
+          f = function IDENTITY => 'constant
+          f = 'newGoGet => SUBST('_$,domname,devaluate CAR r)
+          null VECP r => systemError devaluateList r
+          SUBST('_$,domname,devaluate r)
+        'nowhere
+      [sig1,:info]
+
+evalDomainOpPred(dom,pred) == process(dom,pred) where
+  process(dom,pred) ==
+    u := convert(dom,pred)
+    u = 'T => true
+    evpred(dom,u)
+  convert(dom,pred) ==
+    pred is [op,:argl] =>
+      MEMQ(op,'(AND and)) => ['AND,:[convert(dom,x) for x in argl]]
+      MEMQ(op,'(OR or))   => ['OR,:[convert(dom,x) for x in argl]]
+      MEMQ(op,'(NOT not)) => ['NOT,convert(dom,first argl)]
+      op = 'has =>
+        [arg,p] := argl
+        p is ['ATTRIBUTE,a] => ['HasAttribute,arg,MKQ a]
+        ['HasCategory,arg,convertCatArg p]
+      systemError '"unknown predicate form"
+    pred = 'T => true
+    systemError nil
+  convertCatArg p ==
+    atom p or #p = 1 => MKQ p
+    ['LIST,MKQ first p,:[convertCatArg x for x in rest p]]
+  evpred(dom,pred) ==
+    k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1)
+    evpred1(dom,pred)
+  evpred1(dom,pred) ==
+    pred is [op,:argl] =>
+      MEMQ(op,'(AND and)) => "and"/[evpred1(dom,x) for x in argl]
+      MEMQ(op,'(OR or))   =>  "or"/[evpred1(dom,x) for x in argl]
+      op = 'NOT => not evpred1(dom,first argl)
+      k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1)
+      op = 'HasAttribute =>
+        [arg,[.,a]] := argl
+        attPredIndex := LASSOC(a,dom.2)
+        null attPredIndex  => nil
+        attPredIndex = 0 => true
+        testBitVector(dom.3,attPredIndex)
+      nil
+    pred = 'T => true
+    systemError '"unknown atomic predicate form"
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-op2.boot.pamphlet b/src/interp/br-op2.boot.pamphlet
new file mode 100644
index 00000000..3fca3f73
--- /dev/null
+++ b/src/interp/br-op2.boot.pamphlet
@@ -0,0 +1,790 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-op2.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS br-op2.boot <================================
+
+--=======================================================================
+--		     Operation Description
+--=======================================================================
+
+displayDomainOp(htPage,which,origin,op,sig,predicate,
+		doc,index,chooseFn,unexposed?,$generalSearch?) ==
+-----------------------> OBSELETE
+  $saturn =>
+    displayDomainOp1(htPage,which,origin,op,sig,predicate,
+		doc,index,chooseFn,unexposed?,$generalSearch?)
+  $chooseDownCaseOfType : local := true	  --see dbGetContrivedForm
+  $whereList  : local := nil
+  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
+  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
+  $FunctionList:local := '(f g h d e F G H)
+  $DomainList:	local := '(D R S E T A B C M N P Q U V W)
+  exactlyOneOpSig     := null index
+  conform   := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+		 or origin
+  if $generalSearch? then $DomainList := rest $DomainList
+  opform :=
+    which = '"attribute" =>
+      null sig => [op]
+      [op,sig]
+    which = '"constructor" => origin
+    dbGetDisplayFormForOp(op,sig,doc)
+  htSay('"\newline")
+  if exactlyOneOpSig then htSay('"\menuitemstyle{}")
+  else htMakePage [['bcLinks,['"\menuitemstyle{}",'"",chooseFn,which,index]]]
+  htSay('"\tab{2}")
+  op   := IFCAR opform
+  args := IFCDR opform
+  ops := escapeSpecialChars STRINGIMAGE op
+  n := #sig
+  do
+    n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
+    n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
+    if unexposed? and $includeUnexposed? then
+      htSayUnexposed()
+      htSaySaturn '"\unexposed{{\em "
+      htSaySaturn ops
+      htSaySaturn '"}"
+    htSayStandard(ops)
+    predicate='ASCONST or GETDATABASE(op,'NILADIC) or member(op,'(0 1)) => 'skip
+    which = '"attribute" and null args => 'skip
+    htSay('"(")
+    if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}")
+    for x in IFCDR args repeat
+      htSay('",{\em ",quickForm2HtString x,'"}")
+    htSay('")")
+  constring := form2HtString conform
+  conname   := first conform
+  $conkind   : local := htpProperty(htPage,'kind) -- a string e.g. "category"
+			  or STRINGIMAGE GETDATABASE(conname,'CONSTRUCTORKIND)
+  $conlength : local := #constring
+  $conform   : local := conform
+  $conargs   : local := rest conform
+  if which = '"operation" then
+    $signature : local :=
+      MEMQ(conname,$Primitives) => nil
+      CDAR getConstructorModemap conname
+    --RDJ: this next line is necessary until compiler bug is fixed
+    --that forgets to substitute #variables for t#variables;
+    --check the signature for SegmentExpansionCategory, e.g.
+    tvarlist := TAKE(# $conargs,$TriangleVariableList)
+    $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature)
+  $sig :=
+    which = '"attribute" or which = '"constructor" => sig
+    $conkind ^= '"package" => sig
+    symbolsUsed := [x for x in rest conform | IDENTP x]
+    $DomainList := SETDIFFERENCE($DomainList,symbolsUsed)
+    getSubstSigIfPossible sig
+  if member(which,'("operation" "constructor")) then
+    $displayReturnValue: local := nil
+    if args then
+      htSay('"\newline")
+      htSayStandard '"\tab{2}"
+      htSay '"{\em Arguments:}"
+      for a in args for t in rest $sig repeat
+	htSayIndentRel(15,true)
+	htSay('"{\em ",form2HtString(a),'"}, ")
+	htSayValue t
+	htSayIndentRel(-15,true)
+	htSay('"\newline ")
+    if first $sig then
+      $displayReturnValue := true
+      htSay('"\newline\tab{2}{\em Returns:}")
+      htSayIndentRel(15)
+      htSayValue first $sig
+      htSayIndentRel(-15)
+      htSay('"\newline ")
+  if origin and ($generalSearch? or origin ^= conform) and opOf(origin)^=op then
+    htSay('"\newline\tab{2}{\em Origin:}")
+    htSayIndentRel(15)
+    if not isExposedConstructor opOf origin and $includeUnexposed? then htSayUnexposed()
+    bcConform(origin,true)
+    htSayIndentRel(-15)
+  if not MEMQ(predicate,'(T ASCONST)) then
+    pred := sublisFormal(KDR conform,predicate)
+    count := #pred
+    htSay('"\newline\tab{2}{\em Conditions:}")
+    for p in displayBreakIntoAnds SUBST($conform,"$",pred) repeat
+      htSayIndentRel(15,count > 1)
+      bcPred(p,$conform,true)
+      htSayIndentRel(-15,count > 1)
+      htSay('"\newline ")
+  if $whereList then
+    count := #$whereList
+    htSay('"\newline\tab{2}{\em Where:}")
+    if ASSOC("$",$whereList) then
+      htSayIndentRel(15,true)
+      htSayStandard '"{\em \$} is "
+      htSaySaturn '"{\em \%} is "
+      htSay
+	$conkind = '"category" => '"of category "
+	'"the domain "
+      bcConform(conform,true,true)
+      htSayIndentRel(-15,true)
+    for [d,key,:t] in $whereList | d ^= "$" repeat
+      htSayIndentRel(15,count > 1)
+      htSay("{\em ",d,"} is ")
+      htSayConstructor(key,sublisFormal(KDR conform,t))
+      htSayIndentRel(-15,count > 1)
+  if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then
+    htSay('"\newline\tab{2}{\em Description:}")
+    htSayIndentRel(15)
+    if doc = $charFauxNewline then htSay $charNewline
+    else
+       ndoc:= 
+          -- we are confused whether doc is a string or a list of strings
+          CONSP doc =>  [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc]
+          SUBSTITUTE($charNewline, $charFauxNewline,doc)
+       htSay ndoc
+    htSayIndentRel(-15)
+  if exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then
+    displayInfoOp(htPage,infoAlist,op,sig)
+
+
+htSayIndentRel(n,:options) ==
+-----------------> OBSELETE
+  flag := IFCAR options
+  m := ABSVAL n
+  if flag then m := m + 2
+  htSay
+    n > 0 =>
+      flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"]
+      ['"\indent{",STRINGIMAGE m,'"}\tab{0}"]
+    n < 0 => ['"\indent{0}\newline "]
+
+htSayConstructor(key,u) ==
+  u is ['CATEGORY,kind,:r] =>
+    htSay('"a ",kind,'" ")
+    htSayExplicitExports(r)
+  key = 'is =>
+    htSay '"the domain "
+    bcConform(u,true)
+  htSay
+    key = 'is => '"the domain "
+    kind := GETDATABASE(opOf u,'CONSTRUCTORKIND)
+    kind = 'domain => '"an element of "
+    '"a domain of "
+  u is ['Join,:middle,r] =>
+    rest middle =>
+      htSay '"categories "
+      bcConform(first middle,true)
+      for x in rest middle repeat
+	htSay '", "
+	bcConform(x,true)
+      r is ['CATEGORY,.,:r] =>
+	htSay '" and "
+	htSayExplicitExports(r)
+      htSay '" and "
+      bcConform(r,true)
+    htSay '"category "
+    bcConform(first middle,true)
+    r is ['CATEGORY,.,:r] =>
+     htSay '" "
+     htSayExplicitExports(r)
+    htSay '" and "
+    bcConform(r,true)
+  htSay(kind,'" ")
+  bcConform(u,true)
+
+htSayExplicitExports r ==
+  htSay '"with explicit exports"
+  $displayReturnValue => nil
+  htSay '":"
+  for x in r repeat
+    htSay '"\newline "
+    x is ['SIGNATURE,op,sig] =>
+      ops := escapeSpecialChars STRINGIMAGE op
+      htMakePage [['bcLinks,[ops,'"",'oPage,ops]]]
+      htSay '": "
+      bcConform ['Mapping,:sig]
+    x is ['ATTRIBUTE,a] =>
+      s := form2HtString a
+      htMakePage [['bcLinks,[ops,'"",'aPage,s]]]
+    x is ['IF,:.] =>
+      htSay('"{\em if ...}")
+    systemError()
+
+displayBreakIntoAnds pred ==
+  pred is [op,:u] and member(op,'(and AND)) => u
+  [pred]
+
+htSayValue t ==
+  t is ['Mapping,target,:source] =>
+      htSay('"a function from ")
+      htSayTuple source
+      htSay '" to "
+      htSayArgument target
+  t = '(Category) => htSay('"a category")
+  t is [op,:.] and MEMQ(op,'(Join CATEGORY)) or constructor? opOf t =>
+    htSayConstructor(nil,t)
+  htSay('"an element of domain ")
+  htSayArgument t			     --continue for operations
+
+htSayArgument t == --called only for operations not for constructors
+  null $signature => htSay ['"{\em ",t,'"}"]
+  MEMQ(t, '(_$ _%)) =>
+    $conkind = '"category" and $conlength > 20 =>
+      $generalSearch? => htSay '"{\em D} of the origin category"
+      addWhereList("$",'is,nil)
+      htSayStandard '"{\em $}"
+      htSaySaturn '"{\em \%}"
+    htSayStandard '"{\em $}"
+    htSaySaturn '"{\em \%}"
+  not IDENTP t => bcConform(t,true)
+  k := position(t,$conargs)
+  if k > -1 then
+    typeOfArg := (rest $signature).k
+    addWhereList(t,'member,typeOfArg)
+  htSay('"{\em ",t,'"}")
+
+addWhereList(id,kind,typ) ==
+  $whereList := insert([id,kind,:typ],$whereList)
+
+htSayTuple t ==
+  null t => htSay '"()"
+  null rest t => htSayArgument first t
+  htSay '"("
+  htSayArgument first t
+  for d in rest t repeat
+    htSay '","
+    htSayArgument d
+  htSay '")"
+
+dbGetDisplayFormForOp(op,sig,doc) ==
+  dbGetFormFromDocumentation(op,sig,doc) or dbGetContrivedForm(op,sig)
+
+dbGetFormFromDocumentation(op,sig,x) ==
+  doc := (STRINGP x => x; first x)
+  STRINGP doc and
+     (stringPrefix?('"\spad{",doc) and (k := 6) or
+       stringPrefix?('"\s{",doc) and (k := 3)) =>
+    n := charPosition($charRbrace,doc,k)
+    s := SUBSTRING(doc,k,n - k)
+    parse := ncParseFromString s
+    parse is [=op,:.] and #parse = #sig => parse
+  nil
+
+dbMakeContrivedForm(op,sig,:options) ==
+  $chooseDownCaseOfType : local := IFCAR options
+  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
+  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
+  $FunctionList:local := '(f g h d e F G H)
+  $DomainList:	local := '(R S D E T A B C M N P Q U V W)
+  dbGetContrivedForm(op,sig)
+
+dbGetContrivedForm(op,sig) ==
+  op = '"0" => [0]
+  op = '"1" => [1]
+  [op,:[dbChooseOperandName s for s in rest sig]]
+
+dbChooseOperandName(typ) ==
+  typ is ['Mapping,:.] =>
+    x := first $FunctionList
+    $FunctionList := rest $FunctionList
+    x
+  name := opOf typ
+  kind :=
+    name = "$" => 'domain
+    GETDATABASE(name,'CONSTRUCTORKIND)
+  s := PNAME opOf typ
+  kind ^= 'category =>
+    anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) =>
+      x := first $NumberList
+      $NumberList := rest $NumberList
+      x
+    x :=
+      $chooseDownCaseOfType =>
+	y := DOWNCASE typ
+	x :=
+	  member(y,$ElementList) => y
+	  first $ElementList
+      first $ElementList
+    $ElementList := delete(x,$ElementList)
+    x
+  x := first $DomainList
+  $DomainList := rest $DomainList
+  x
+
+getSubstSigIfPossible sig ==
+  getSubstSignature sig or sig
+
+--
+--  while (u := getSubstSignature sig) repeat
+--     sig := u
+--  sig
+
+fullSubstitute(x,y,z) ==  --substitutes deeply: x for y in list z
+  z = y => x
+  atom z => z
+  [fullSubstitute(x,y,u) for u in z]
+
+getSubstCandidates sig ==
+  candidates := nil
+  for x in sig for i in 1.. | x is [.,.,:.] repeat
+    getSubstQualify(x,i,sig) => candidates := getSubstInsert(x,candidates)
+    y := or/[getSubstQualify(y,i,sig) for y in rest x | y is [.,.,:.]] =>
+      candidates := insert(y,candidates)
+  candidates
+
+getSubstSignature sig ==
+    candidates := getSubstCandidates sig
+    null candidates => nil
+    D := first $DomainList
+    $DomainList := rest $DomainList
+    winner := first candidates
+    newsig := fullSubstitute(D,winner,sig)
+    sig :=
+      null rest candidates => newsig
+      count := NUMOFNODES newsig
+      for x in rest candidates repeat
+	trial := fullSubstitute(D,x,sig)
+	trialCount := NUMOFNODES trial
+	trialCount < count =>
+	  newsig := trial
+	  count	 := trialCount
+	  winner := x
+      newsig
+    addWhereList(D,'is,winner)
+    newsig
+
+getSubstQualify(x,i,sig) ==
+    or/[CONTAINED(x,y) for y in sig for j in 1.. | j ^= i] => x
+    false
+
+getSubstInsert(x,candidates) ==
+    return insert(x,candidates)
+    null candidates => [x]
+    or/[CONTAINED(x,y) for y in candidates] => candidates
+    y := or/[CONTAINED(y,x) for y in candidates] => SUBST(x,y,candidates)
+    candidates
+
+
+--=======================================================================
+--			Who Uses
+--=======================================================================
+whoUsesOperation(htPage,which,key) ==  --see dbPresentOps
+  key = 'filter => koaPageFilterByName(htPage,'whoUsesOperation)
+  opAlist := htpProperty(htPage,'opAlist)
+  conform := htpProperty(htPage,'conform)
+  conargs := rest conform
+  opl := nil
+  for [op,:alist] in opAlist repeat
+    for [sig,:.] in alist repeat
+      opl := [[op,:SUBLISLIS($FormalMapVariableList,rest conform,sig)],:opl]
+  opl := NREVERSE opl
+  u := whoUses(opl,conform)
+  prefix := pluralSay(#u,'"constructor uses",'"constructors use")
+  suffix :=
+    opAlist is [[op1,.]] =>
+      ['" operation {\em ",escapeSpecialChars STRINGIMAGE op1,'":",form2HtString ['Mapping,:sig],'"}"]
+    ['" these operations"]
+  page := htInitPage([:prefix,:suffix],htCopyProplist htPage)
+  nopAlist := nil
+  for [name,:opsigList] in u repeat
+    for opsig in opsigList repeat
+      sofar    := LASSOC(opsig,nopAlist)
+      nopAlist := insertAlist(opsig,[name,:LASSOC(opsig,nopAlist)],nopAlist)
+  usedList := nil
+  for [(pair := [op,:sig]),:namelist] in nopAlist repeat
+    ops := escapeSpecialChars STRINGIMAGE op
+    usedList := [pair,:usedList]
+    htSay('"Users of {\em ",ops,'": ")
+    bcConform ['Mapping,:sublisFormal(conargs,sig)]
+    htSay('"}\newline")
+    bcConTable listSort(function GLESSEQP,REMDUP namelist)
+  noOneUses := SETDIFFERENCE(opl,usedList)
+  if #noOneUses > 0 then
+    htSay('"No constructor uses the ")
+    htSay
+      #noOneUses = 1 => '"operation: "
+      [#noOneUses,'" operations:"]
+    htSay '"\newline "
+    for [op,:sig] in noOneUses repeat
+      htSay('"\tab{2}{\em ",escapeSpecialChars STRINGIMAGE op,'": ")
+      bcConform ['Mapping,:sublisFormal(conargs,sig)]
+      htSay('"}\newline")
+  htSayStandard '"\endscroll "
+  dbPresentOps(page,which,'usage)
+  htShowPageNoScroll()
+
+whoUses(opSigList,conform) ==
+  opList := REMDUP ASSOCLEFT opSigList
+  numOfArgsList := REMDUP [-1 + #sig for [.,:sig] in opSigList]
+  acc  := nil
+  $conname : local := first conform
+  domList := getUsersOfConstructor $conname
+  hash := MAKE_-HASH_-TABLE()
+  for name in allConstructors() | MEMQ(name,domList) repeat
+    $infovec : local := dbInfovec name
+    null $infovec => 'skip	     --category
+    template := $infovec . 0
+    found := false
+    opacc := nil
+    for i in 7..MAXINDEX template repeat
+      item := template . i
+      item isnt [n,:op] or not MEMQ(op,opList) => 'skip
+      index := n
+      numvec := getCodeVector()
+      numOfArgs := numvec . index
+      null member(numOfArgs,numOfArgsList) => 'skip
+      whereNumber := numvec.(index := index + 1)
+      template . whereNumber isnt [= $conname,:.] => 'skip
+      signumList := dcSig(numvec,index + 1,numOfArgs)
+      opsig := or/[pair for (pair := [op1,:sig]) in opSigList | op1 = op and whoUsesMatch?(signumList,sig,nil)]
+	=> opacc := [opsig,:opacc]
+    if opacc then acc := [[name,:opacc],:acc]
+  acc
+
+whoUsesMatch?(signumList,sig,al) ==
+  #signumList = #sig and whoUsesMatch1?(signumList,sig,al)
+
+whoUsesMatch1?(signumList,sig,al) ==
+  signumList is [subject,:r] and sig is [pattern,:s] =>
+    x := LASSOC(pattern,al) =>
+      x = subject => whoUsesMatch1?(r,s,al)
+      false
+    pattern = '_$ =>
+      subject is [= $conname,:.] => whoUsesMatch1?(r,s,[['_$,:subject],:al])
+      false
+    whoUsesMatch1?(r,s,[[pattern,:subject],:al])
+  true
+
+--=======================================================================
+--		     Get Attribute/Operation Alist
+--=======================================================================
+
+koAttrs(conform,domname) ==
+  [conname,:args] := conform
+--asharpConstructorName? conname => nil  --assumed
+  'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
+      koCatAttrs(conform,domname)
+  $infovec: local := dbInfovec conname or return nil
+  $predvec: local :=
+    $domain => $domain . 3
+    GETDATABASE(conname,'PREDICATES)
+  u := [[a,:pred] for [a,:i] in $infovec . 2 | a ^= 'nil and (pred := sublisFormal(args,kTestPred i))]
+                                               ---------  CHECK for a = nil
+  listSort(function GLESSEQP,fn u) where fn u ==
+    alist := nil
+    for [a,:pred] in u repeat
+      op := opOf a
+      args := IFCDR a
+      alist := insertAlist(op,insertAlist(args,[pred],LASSOC(op,alist)),alist)
+    alist
+
+koOps(conform,domname,:options) == main where
+--returns alist of form ((op (sig . pred) ...) ...)
+  main ==
+    $packageItem: local := nil
+--  relatives? := IFCAR options
+    ours :=
+--    relatives? = 'onlyRelatives => nil
+      fn(conform,domname)
+--    if relatives? then
+--      relatives := relativesOf(conform,domname)
+--      if domname then relatives :=
+--	SUBLISLIS([domname,:rest domname],['_$,:rest conform],relatives)
+--      --kill all relatives that have a sharp variable remaining in them
+--      for x in relatives repeat
+--	or/[y for y in CDAR x | isSharpVar y] => 'skip
+--	acc := [x,:acc]
+--      relatives := NREVERSE acc
+--      for (pair := [pakform,:.]) in relatives repeat
+--	$packageItem := sublisFormal(rest conform,pair)
+--	ours := merge(fn(pakform,nil),ours)
+    listSort(function GLESSEQP,trim ours)
+  trim u == [pair for pair in u | IFCDR pair]
+  fn(conform,domname) ==
+    conform := domname or conform
+    [conname,:args] := conform
+    subargs: local := args
+    ----------> new <------------------
+    u := koCatOps(conform,domname) => u
+--    'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
+--	  koCatOps(conform,domname)
+    asharpConstructorName? opOf conform => nil
+    ----------> new <------------------
+    $infovec: local := dbInfovec conname--------> removed 94/10/24
+    exposureTail :=
+      null $packageItem => '(NIL NIL)
+      isExposedConstructor opOf conform => [conform,:'(T)]
+      [conform,:'(NIL)]
+    for [op,:u] in getOperationAlistFromLisplib conname repeat
+      op1 := zeroOneConvert op
+      acc :=
+       [[op1,:[[sig,npred,:exposureTail] for [sig,slot,pred,key,:.] in sublisFormal(subargs,u) |
+	 (key ^= 'Subsumed) and (npred := simpHasPred pred)]],:acc]
+    acc
+  merge(alist,alist1) == --alist1 takes precedence
+    for [op,:al] in alist1 repeat
+      u := LASSOC(op,alist) =>
+	for [sig,:item] in al | not LASSOC(sig,u) repeat
+	  u := insertAlist(sig,item,u)
+	alist := insertAlist(op,u,DELASC(op,alist)) --add the merge of two alists
+      alist := insertAlist(op,al,alist)	 --add the whole inner alist
+    alist
+
+zeroOneConvert x ==
+  x = 'Zero => 0
+  x = 'One  => 1
+  x
+
+kFormatSlotDomain x == fn formatSlotDomain x where fn x ==
+  atom x => x
+  (op := CAR x) = '_$ => '_$
+  op = 'local => CADR x
+  op = ":" => [":",CADR x,fn CADDR x]
+  MEMQ(op,$Primitives) or constructor? op =>
+    [fn y for y in x]
+  INTEGERP op => op
+  op = 'QUOTE and atom CADR x => CADR x
+  x
+
+koCatOps(conform,domname) ==
+  conname := opOf conform
+  oplist := REVERSE GETDATABASE(conname,'OPERATIONALIST)
+  oplist := sublisFormal(IFCDR domname or IFCDR conform ,oplist)
+  --check below for INTEGERP key to avoid subsumed signatures
+  [[zeroOneConvert op,:nalist] for [op,:alist] in oplist | nalist := koCatOps1(alist)]
+
+koCatOps1 alist == [x for item in alist | x := pair] where
+  pair ==
+    [sig,:r] := item
+    null r => [sig,true]
+    [key,:options] := r
+    null (pred := IFCAR options) =>
+      IFCAR IFCDR options = 'ASCONST => [sig,'ASCONST]
+      [sig,true]
+    npred := simpHasPred pred => [sig,npred]
+    false
+
+koCatAttrs(catform,domname) ==
+  $if: local := MAKE_-HASHTABLE 'ID
+  catname   := opOf catform
+  koCatAttrsAdd(domname or catform,true)
+  ancestors := ancestorsOf(catform,domname)
+  for [conform,:pred] in ancestors repeat koCatAttrsAdd(conform,pred)
+  hashTable2Alist $if
+
+hashTable2Alist tb ==
+  [[op,:HGET(tb,op)] for op in listSort(function GLESSEQP,HKEYS $if)]
+
+koCatAttrsAdd(catform,pred) ==
+  for [name,argl,:p] in CAR getConstructorExports catform repeat
+    npred  := quickAnd(pred,p)
+    exists := HGET($if,name)
+    if existingPred := LASSOC(argl,exists)_
+        then npred := quickOr(npred,existingPred)
+    if not MEMQ(name,'(nil nothing)) _
+        then HPUT($if,name,[[argl,simpHasPred npred],:exists])
+
+--=======================================================================
+--	      Filter by Category
+--=======================================================================
+
+koaPageFilterByCategory(htPage,calledFrom) ==
+  opAlist := htpProperty(htPage,'opAlist)
+  which	  := htpProperty(htPage,'which)
+  page := htInitPageNoScroll(htCopyProplist htPage,
+             dbHeading(opAlist,which,htpProperty(htPage,'heading)))
+  htSay('"Select a category ancestor below or ")
+  htMakePage [['bcLispLinks,['"filter",'"on:",calledFrom,'filter]]]
+  htMakePage [['bcStrings, [13,'"",'filter,'EM]]]
+  htSay('"\beginscroll ")
+  conform := htpProperty(htPage,'conform)
+  domname := htpProperty(htPage,'domname)
+  ancestors := ASSOCLEFT ancestorsOf(conform,domname)
+  htpSetProperty(page,'ancestors,listSort(function GLESSEQP,ancestors))
+  bcNameCountTable(ancestors,'form2HtString,'koaPageFilterByCategory1,true)
+  htShowPage()
+
+dbHeading(items,which,heading,:options) ==
+  names?   := IFCAR options
+  count :=
+    names? => #items
+    +/[#(rest x) for x in items]
+  capwhich := capitalize which
+  prefix :=
+    count < 2 =>
+      names? => pluralSay(count,STRCONC(capwhich," Name"),nil)
+      pluralSay(count,capwhich,nil)
+    names? => pluralSay(count,nil,STRCONC(capwhich," Names"))
+    pluralSay(count,nil,pluralize capwhich)
+  [:prefix,'" for ",:heading]
+
+koaPageFilterByCategory1(htPage,i) ==
+  ancestor := htpProperty(htPage,'ancestors) . i
+  ancestorList := [ancestor,:ASSOCLEFT ancestorsOf(ancestor,nil)]
+  newOpAlist := nil
+  which	   := htpProperty(htPage,'which)
+  opAlist  := htpProperty(htPage,'opAlist)
+  domname  := htpProperty(htPage,'domname)
+  conform  := htpProperty(htPage,'conform)
+  heading  := htpProperty(htPage,'heading)
+  docTable := dbDocTable(domname or conform)
+  for [op,:alist] in opAlist repeat
+    nalist := [[origin,:item] for item in alist | split]
+      where split ==
+	[sig,pred,:aux] := item
+	u := dbGetDocTable(op,sig,docTable,which,aux)
+	origin := IFCAR u
+	doc    := IFCDR u
+	true
+    for [origin,:item] in nalist | origin repeat
+      member(origin,ancestorList) =>
+	newEntry   := [item,:LASSOC(op,newOpAlist)]
+	newOpAlist := insertAlist(op,newEntry,newOpAlist)
+  falist := nil
+  for [op,:alist] in newOpAlist repeat
+    falist := [[op,:NREVERSE alist],:falist]
+  htpSetProperty(htPage,'fromcat,['" from category {\sf ",form2HtString ancestor,'"}"])
+  dbShowOperationsFromConform(htPage,which,falist)
+
+--=======================================================================
+--	     New code for search operation alist for exact matches
+--=======================================================================
+
+opPageFast opAlist == --called by oSearch
+  htPage := htInitPage(nil,nil)
+  htpSetProperty(htPage,'opAlist,opAlist)
+  htpSetProperty(htPage,'expandOperations,'lists)
+  which := '"operation"
+--dbResetOpAlistCondition(htPage,which,opAlist)
+  dbShowOp1(htPage,opAlist,which,'names)
+
+opPageFastPath opstring ==
+--return nil
+  x := STRINGIMAGE opstring
+  charPosition(char '_*,x,0) < #x => nil     --quit if name has * in it
+  op := (STRINGP x => INTERN x; x)
+  mmList := getAllModemapsFromDatabase(op,nil) or return nil
+  opAlist := [[op,:[item for mm in mmList]]] where item ==
+    [predList, origin, sig] := modemap2Sig(op, mm)
+    predicate := predList and MKPF(predList,'AND)
+    exposed? := isExposedConstructor opOf origin
+    [sig, predicate, origin, exposed?]
+  opAlist
+
+modemap2Sig(op,mm) ==
+  [dcSig, conds] := mm
+  [dc, :sig] := dcSig
+  partial? :=
+    conds is ['partial,:r] => conds := r
+    false
+  condlist := modemap2SigConds conds
+  [origin, vlist, flist] := getDcForm(dc, condlist) or return nil
+  subcondlist := SUBLISLIS(flist, vlist, condlist)
+  [predList,vlist, flist] := getSigSubst(subcondlist, nil, vlist, flist)
+  if partial? then
+    target := dcSig . 1
+    ntarget := ['Union, target, '"failed"]
+    dcSig := SUBST(ntarget, target, dcSig)
+  alist := findSubstitutionOrder? pairlis(vlist, flist) or systemError()
+  predList := substInOrder(alist, predList)
+  nsig := substInOrder(alist, sig)
+  if hasPatternVar nsig or hasPatternVar predList then
+    pp '"--------------"
+    pp op
+    pp predList
+    pp nsig
+    pp mm
+    $badStack := [[op, mm], :$badStack]
+--pause nsig
+  [predList, origin, SUBST("%", origin, nsig)]
+
+modemap2SigConds conds ==
+  conds is ['OR,:r] => modemap2SigConds first r
+  conds is ['AND,:r] => r
+  [conds]
+
+hasPatternVar x ==
+  IDENTP x and (x ^= "**") => isPatternVar x
+  atom x => false
+  or/[hasPatternVar y for y in x]
+
+getDcForm(dc, condlist) ==
+  [ofWord,id,cform] := or/[x for x in condlist | x is [k,=dc,:.]
+     and MEMQ(k, '(ofCategory isDomain))] or return nil
+  conform := getConstructorForm opOf cform
+  ofWord = 'ofCategory =>
+    [conform, ["*1", :rest cform], ["%", :rest conform]]
+  ofWord = 'isDomain =>
+    [conform, ["*1", :rest cform], ["%", :rest conform]]
+  systemError()
+
+getSigSubst(u, pl, vl, fl) ==
+  u is [item, :r] =>
+    item is ['AND,:s] =>
+       [pl, vl, fl] := getSigSubst(s, pl, vl, fl)
+       getSigSubst(r, pl, vl, fl)
+    [key, v, f] := item
+    key = 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl])
+    key = 'ofCategory => getSigSubst(r, pl, ['D, :vl], [f, :fl])
+    key = 'ofType    => getSigSubst(r, pl, vl, fl)
+    key = 'has => getSigSubst(r, [item, :pl], vl, fl)
+    key = 'not => getSigSubst(r, [item, :pl], vl, fl)
+    systemError()
+  [pl, vl, fl]
+
+
+pairlis(u,v) ==
+  null u or null v => nil
+  [[first u,:first v],:pairlis(rest u, rest v)]
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-prof.boot.pamphlet b/src/interp/br-prof.boot.pamphlet
new file mode 100644
index 00000000..cf1d0e58
--- /dev/null
+++ b/src/interp/br-prof.boot.pamphlet
@@ -0,0 +1,288 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp br-prof.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+<<*>>=
+<<license>>
+
+--====================> WAS b-prof.boot <================================
+
+--============================================================================
+--                Browser Code for Profiling
+--============================================================================
+kciPage(htPage,junk) ==
+  --info alist must have NEW format with [op,:sig] in its CAARs
+  which:= '"operation"
+  htpSetProperty(htPage,'which,which)
+  domname := htpProperty(htPage,'domname)
+  conform := htpProperty(htPage,'conform)
+  heading := ['"Capsule Cross Reference for ",:htpProperty(htPage,'heading)]
+  page := htInitPage(heading,htCopyProplist htPage)
+  conname := opOf conform
+  htpSetProperty(page,'infoAlist,infoAlist := getInfoAlist conname)
+  dbGetExpandedOpAlist page      --expand opAlist "in place"
+  opAlist := kciReduceOpAlist(htpProperty(page,'opAlist),infoAlist)
+  dbShowOperationsFromConform(page,which,opAlist)
+
+kciReduceOpAlist(opAlist,infoAlist) ==
+--count opAlist
+  res := [pair for [op,:items] in opAlist | pair] where pair ==
+    u := LASSOC(op,infoAlist) =>
+      y := [x for x in items
+            | x is [sig,:.] and or/[sig = sig1 for [sig1,:.] in u]] => [op,:y]
+      nil
+    nil
+  res
+
+displayInfoOp(htPage,infoAlist,op,sig) ==
+  (sigAlist := LASSOC(op,infoAlist)) and (itemlist := LASSOC(sig,sigAlist)) =>
+     dbShowInfoOp(htPage,op,sig,itemlist)
+  nil
+
+dbShowInfoOp(htPage,op,sig,alist) ==
+  heading := htpProperty(htPage,'heading)
+  domname := htpProperty(htPage,'domname)
+  conform := htpProperty(htPage,'conform)
+  opAlist := htpProperty(htPage,'opAlist)
+  conname := opOf conform
+  kind     := GETDATABASE(conname,'CONSTRUCTORKIND)
+  honestConform :=
+    kind = 'category =>
+      [INTERN STRCONC(PNAME conname,'"&"),"$",:CDR conform]
+    conform
+  faTypes  := CDDAR GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+
+  conArgTypes :=
+    SUBLISLIS(IFCDR conform,TAKE(#faTypes,$FormalMapVariableList),faTypes)
+  conform := htpProperty(htPage,'conform)
+  conname := opOf conform
+--argTypes := REVERSE ASSOCRIGHT LASSOC('arguments,alist)
+--sig := or/[sig for [sig,:.] in LASSOC(op,opAlist) | rest sig = argTypes]
+  ops := escapeSpecialChars STRINGIMAGE zeroOneConvert op
+  oppart := ['"{\em ", ops, '"}"]
+  head :=
+    sig => [:oppart,'": ",:dbConformGen dbInfoSig sig]
+    oppart
+  heading := [:head,'" from {\sf ",form2HtString conform,'"}"]
+  for u in alist repeat
+    [x,:y] := u
+    x = 'locals => locals := y
+    x = 'arguments => arguments := y
+    fromAlist := [[x,:zeroOneConvertAlist y], :fromAlist]
+  fromAlist :=
+    cons := args := nil
+    for (p := [x,:y]) in fromAlist repeat
+      x = $ => dollar := [[honestConform,:y]]
+      x = 'Rep => rep := [['Rep,:y]]
+      IDENTP x => args := [dbInfoFindCat(conform,conArgTypes,p), :args]
+      cons := [dbInfoTran(x,y), :cons]
+    [:mySort args, :dollar, :rep, :mySort cons]
+  sigAlist  := LASSOC(op,opAlist)
+  item := or/[x for x in sigAlist | x is [sig1,:.] and sig1 = sig] or
+    systemError '"cannot find signature"
+  --item is [sig,pred,origin,exposeFlag,comments]
+  [sig,pred,origin,exposeFlag,doc] := item
+  htpSetProperty(htPage,'fromAlist,fromAlist)
+  htSayHline()
+  htSay('"\center{Cross Reference for definition of {\em ",ops,'"}}\beginmenu ")
+--  if arguments then
+--    htSay '"\item\menuitemstyle{}{\em arguments:}\newline"
+--    dbShowInfoList(arguments,0,false)
+  if locals then
+    htSay '"\item\menuitemstyle{}{\em local variables:}\newline"
+    dbShowInfoList(locals,8192,false)
+  bincount := 2
+  for [con,:fns] in fromAlist repeat
+    htSay '"\item"
+    if IDENTP con then
+        htSay '"\menuitemstyle{} {\em calls to} "
+        if con ^= 'Rep then htSay '"{\em argument} "
+        htSay con
+        if and/[fn is ['origin,orig,.] and
+          (null origin and (origin := orig) or origin = orig) for fn in fns] then
+            htSay '" {\em of type} "
+            bcConform orig
+        buttonForOp := false
+    else
+      htMakePage [['bcLinks,['"\menuitemstyle{}",'"",'dbInfoChoose,bincount]]]
+      htSay '"{\em calls to} "
+      bcConform con
+      buttonForOp := true
+    htSay('":\newline ")
+    dbShowInfoList(fns, bincount * 8192,buttonForOp)
+    bincount := bincount + 1
+  htSay '"\endmenu "
+
+dbShowInfoList(dataItems,count,buttonForOp?) ==
+--dataItems are [op,:sig]
+  single? := null rest dataItems
+  htSay '"\table{"
+  for item in dataItems repeat
+    [op,:sig] :=
+       item is ['origin,.,s] =>
+         buttonForOp? := true
+         s
+       item
+    ops := escapeSpecialChars STRINGIMAGE op
+    htSay '"{"
+    if count < 16384 or not buttonForOp? then
+      htSay [ops,'": "]
+      atom sig => bcConform sig
+      bcConform dbInfoSig sig
+    else
+      htMakePage [['bcLinks,[ops,'"",'dbInfoChooseSingle,count]]]
+      htSay '": "
+      if atom sig then htSay sig else
+        bcConform dbInfoSig sig
+    htSay '"}"
+    count := count + 1
+  htSay '"} "
+  count
+
+dbInfoFindCat(conform,conArgTypes,u) ==
+  [argName,:opSigList] := u
+  n := POSITION(argName,IFCDR conform) or systemError()
+  t := conArgTypes . n
+  [argName,:[dbInfoWrapOrigin(x,t) for x in opSigList]]
+
+dbInfoWrapOrigin(x, t) ==
+  [op, :sig] := x
+  origin := dbInfoOrigin(op,sig,t) => ['origin, origin, x]
+  x
+
+dbInfoOrigin(op,sig,t) ==
+  t is ['Join, :r] => or/[dbInfoOrigin(op,sig,x) for x in r]
+  t is ['CATEGORY,:.] => false
+  [sig = sig1 for [sig1,:.] in LASSOC(op, koOps(t,nil))] => t
+  false
+
+dbInfoTran(con,opSigList) == [con,:SUBST("$",con,mySort opSigList)]
+
+zeroOneConvertAlist u == [[zeroOneConvert x,:y] for [x,:y] in u]
+
+dbInfoChoose(htPage,count) ==
+  fromAlist := htpProperty(htPage,'fromAlist)
+  index := count - 2
+  [con, :alist] := fromAlist.index
+  dbInfoChoose1(htPage,con,alist)
+
+dbInfoChooseSingle(htPage,count) ==
+  fromAlist := htpProperty(htPage,'fromAlist)
+  [index, binkey] := DIVIDE(count, 8192)
+  [con, :alist] := fromAlist.(index - 2)
+  item := alist . binkey
+  alist :=
+    item is ['origin,origin,s] =>
+      con := origin
+      [s]
+    [item]
+  dbInfoChoose1(htPage,con,alist)
+
+dbInfoChoose1(htPage,con,alist) ==
+  $conform: local := con
+  opAlist := [pair for x in koOps(con,nil) | pair:=dbInfoSigMatch(x,alist)]
+  page := htInitPage(nil,nil)
+  htpSetProperty(page,'conform,con)
+  htpSetProperty(page,'kind,PNAME GETDATABASE(opOf con,'CONSTRUCTORKIND))
+  dbShowOperationsFromConform(page,'"operation",opAlist)
+
+dbInfoSigMatch(x,alist) ==
+  [op,:sigAlist] := x
+  candidates := [sig for [op1,:sig] in alist | op1 = op] or return nil
+  sigs := [s for s in sigAlist | "or"/[first s = s1 for s1 in candidates] or
+    (s2 := SUBST($conform,"$",s)) and "or"/[first s2 = s1 for s1 in candidates]]
+  sigs and [op,:sigs]
+
+
+dbInfoSig sig ==
+  null rest sig => first sig
+  ['Mapping,:sig]
+
+--============================================================================
+--                Code to Expand opAlist
+--============================================================================
+dbGetExpandedOpAlist htPage ==
+  expand := htpProperty(htPage,'expandOperations)
+  if expand ^= 'fullyExpanded then
+    if null expand then htpSetProperty(htPage,'expandOperations,'lists)
+    opAlist := koOps(htpProperty(htPage,'conform),nil)
+    htpSetProperty(htPage,'opAlist,opAlist)
+    dbExpandOpAlistIfNecessary(htPage,opAlist,'"operation",false,false)
+  htpProperty(htPage,'opAlist)
+
+--============================================================================
+--                  Get Info File Alist
+--============================================================================
+hasNewInfoAlist conname ==
+  (u := getInfoAlist conname) and hasNewInfoText u
+
+hasNewInfoText u ==
+  and/[ATOM op and and/[item is [sig,:alist] and
+    null sig or null atom sig and null atom alist for item in items] for [op,:items] in u]
+
+getInfoAlist conname ==
+  cat? := GETDATABASE(conname,'CONSTRUCTORKIND) = 'category
+  if cat? then conname := INTERN STRCONC(STRINGIMAGE conname,'"&")
+  abb := constructor? conname or return '"not a constructor"
+  fs  := STRCONC(PNAME abb,'".NRLIB/info")
+  inStream :=
+    PROBE_-FILE fs => OPEN fs
+    filename := STRCONC('"/spad/int/algebra/",PNAME abb,'".NRLIB/info")
+    PROBE_-FILE filename => OPEN filename
+    return nil
+  alist := mySort READ inStream
+  if cat? then
+    [.,dollarName,:.] := GETDATABASE(conname,'CONSTRUCTORFORM)
+    alist := SUBST("$",dollarName,alist)
+  alist
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-saturn.boot.pamphlet b/src/interp/br-saturn.boot.pamphlet
new file mode 100644
index 00000000..46b53f9d
--- /dev/null
+++ b/src/interp/br-saturn.boot.pamphlet
@@ -0,0 +1,1916 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-saturn.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS b-saturn.boot <================================
+-- New file as of 6/95
+$aixTestSaturn := false
+--These will be set in patches.lisp:
+--$saturn := false  --true to write SATURN output to $browserOutputStream
+--$standard:= true  --true to write browser output on AIX
+$saturnAmpersand := '"\&\&"
+$saturnFileNumber --true to write DOS files for Thinkpad (testing only)
+   := false
+$kPageSaturnArguments := nil  --bound by $kPageSaturn
+$atLeastOneUnexposed := false
+$saturnContextMenuLines := nil
+$saturnContextMenuIndex := 0
+$saturnMacros := '(
+  "\def\unixcommand#1#2{{\em #1}}"_
+  "\def\lispFunctionLink#1#2{\lispLink[d]{#1}{{\bf #2}}}"_
+  "\def\lispTypeLink#1#2{\lispLink[d]{#1}{{\sf #2}}}"_
+  "\def\menuitemstyle{\menubutton}"_
+  "\def\browseTitle#1{\windowTitle{#1}\section{#1}}"_
+  "\def\ttrarrow{$\rightarrow$}"_
+  "\def\spadtype#1{\lispLink[d]{\verb!(|spadtype| '|#1|)!}{\sf #1}}"_
+  "\def\spad#1{{\em #1}}"_
+  "\def\spadfun#1{{\em #1}}"_
+)
+$FormalFunctionParameterList := '(_#_#1 _#_#2 _#_#3 _#_#4 _#_#5 _#_#6 _#_#7 _#_#8 _#_#9 _#_#10 _#_#11 _#_#12 _#_#13 _#_#14 _#_#15)
+
+on() ==
+  $saturn := true
+  $standard := false
+off()==
+  $saturn := false
+  $standard := true
+
+--=======================================================================
+--            Function for testing SATURN output
+--=======================================================================
+-- protectedEVAL x ==
+--  $saturn =>
+--    protectedEVAL0(x, true, false)
+--    if $aixTestSaturn then protectedEVAL0(x, false, true)
+--  protectedEVAL1 x
+--
+--protectedEVAL0(x, $saturn, $standard) ==
+--  protectedEVAL1 x
+--
+--protectedEVAL1 x ==
+--  error := true
+--  val := NIL
+--  UNWIND_-PROTECT((val := saturnEVAL x; error := NIL),
+--                   error => (resetStackLimits(); sendHTErrorSignal()))
+--  val
+--
+--saturnEVAL x ==
+--  fn :=
+--    $aixTestSaturn => '"/tmp/sat.text"
+--    '"/windows/temp/browser.text"
+--  $saturn =>
+--    saturnEvalToFile(x, fn)
+--    OBEY  '"cat /tmp/sat.text"
+--  EVAL x
+
+
+--=======================================================================
+--            Functions to write DOS files to disk
+--=======================================================================
+ts(command) ==
+  $saturn := true
+  $saturnFileNumber := false
+  $standard := false
+  saturnEvalToFile(command, '"/tmp/sat.text")
+
+ut() ==
+  $saturn := false
+  $standard := true
+  'done
+
+onDisk() ==
+  $saturnFileNumber := 1
+  obey '"dosdir"
+
+offDisk() ==
+  $saturnFileNumber := false
+
+page() ==
+  $standard => $curPage
+  $saturnPage
+--=======================================================================
+--            Functions that affect $saturnPage
+--=======================================================================
+
+--------------------> OLD DEFINITION (override in br-util.boot.pamphlet)
+htSay(x,:options) ==  --say for possibly both $saturn and standard code
+  htSayBind(x, options)
+
+htSayCold x ==
+  htSay '"\lispLink{}{"
+  htSay x
+  htSay '"}"
+
+htSayIfStandard(x, :options) ==  --do only for $standard
+  $standard => htSayBind(x,options)
+
+htSayStandard(x, :options) ==  --do AT MOST for $standard
+  $saturn: local := nil
+  htSayBind(x, options)
+
+htSaySaturn(x, :options) ==    --do AT MOST for $saturn
+  $standard: local := nil
+  htSayBind(x, options)
+
+htSayBind(x, options) ==
+  bcHt x
+  for y in options repeat bcHt y
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+bcHt line ==
+  $newPage =>  --this path affects both saturn and old lines
+    text :=
+      PAIRP line => [['text, :line]]
+      STRINGP line => line
+      [['text, line]]
+    if $saturn then htpAddToPageDescription($saturnPage, text)
+    if $standard then htpAddToPageDescription($curPage, text)
+  PAIRP line =>
+    $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList)
+  $htLineList := [basicStringize line, :$htLineList]
+
+--=======================================================================
+--                        New issueHT
+--=======================================================================
+
+--------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
+htShowPage() ==
+-- show the page which has been computed
+  htSayStandard '"\endscroll"
+  htShowPageNoScroll()
+
+------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
+htShowPageNoScroll() ==
+-- show the page which has been computed
+  htSayStandard '"\autobuttons"
+  if $standard then
+    htpSetPageDescription($curPage, nreverse htpPageDescription $curPage)
+  if $saturn then
+    htpSetPageDescription($saturnPage, nreverse htpPageDescription $saturnPage)
+  $newPage := false
+  ----------------------
+  if $standard then
+    $htLineList := nil
+    htMakePage htpPageDescription $curPage
+    if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList)
+    issueHTStandard line
+  ----------------------
+  if $saturn then
+    $htLineList := nil
+    htMakePage htpPageDescription $saturnPage
+    if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList)
+    issueHTSaturn line
+  ----------------------
+  endHTPage()
+
+--------------------> NEW DEFINITION <--------------------------
+issueHTSaturn line == --called by htMakePageNoScroll and htMakeErrorPage
+  if $saturn then
+     $marg      : local := 0
+     $linelength: local := 80
+     writeSaturn '"\inputonce{<AXIOM>/doc/browser/browmacs.tex}"
+     writeSaturnPrefix()
+     writeSaturn(line)
+     writeSaturnSuffix()
+     if $saturnFileNumber then
+       fn := STRCONC('"sat", STRINGIMAGE $saturnFileNumber, '".tex")
+       obey STRCONC('"doswrite -a saturn.tex ",fn, '".tex")
+       $saturnFileNumber := $saturnFileNumber + 1
+
+writeSaturnPrefix() ==
+  $saturnContextMenuLines =>
+    index :=
+      STRINGIMAGE ($saturnContextMenuIndex := $saturnContextMenuIndex + 1)
+    writeSaturnLines
+      ['"\newmenu{BCM", index,
+          '"}{",:nreverse $saturnContextMenuLines,
+            '"}\usemenu{BCM", index,'"}{\vbox{"]
+
+writeSaturnSuffix() ==
+  $saturnContextMenuLines => saturnPRINTEXP '"}}"
+
+issueHTStandard line == --called by htMakePageNoScroll and htMakeErrorPage
+  if $standard then
+  --unescapeStringsInForm line
+    sockSendInt($MenuServer, $SendLine)
+    sockSendString($MenuServer, line)
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htMakeErrorPage htPage ==
+  $newPage := false
+  $htLineList := nil
+  if $standard then $curPage := htPage
+  if $saturn then $saturnPage := htPage
+  htMakePage htpPageDescription htPage
+  line := APPLY(function CONCAT, nreverse $htLineList)
+  issueHT line
+  endHTPage()
+
+writeSaturnLines lines ==
+  for line in lines repeat
+   if line ^= '"" and line.0 = char '_\ then saturnTERPRI()
+   saturnPRINTEXP line
+
+writeSaturn(line) ==
+  k := 0
+  n := MAXINDEX line
+  while  --advance k if true
+      k > n => false
+      line.k ^= char '_\ => true
+      code := isBreakSegment?(line, k + 1,n) => false
+      true
+    repeat (k := k + 1)
+  k > n => writeSaturnPrint(line)
+  segment := SUBSTRING(line,0,k)
+  writeSaturnPrint(segment)
+  code = 1 =>
+    writeSaturnPrint('"\\")
+    writeSaturn SUBSTRING(line,k + 2, nil)
+  code = 2 =>
+    writeSaturnPrint('"  &")
+    writeSaturn SUBSTRING(line,k + 4, nil)
+  code = 3 =>
+    writeSaturnPrint('"\item")
+    writeSaturn SUBSTRING(line,k + 5,nil)
+  code = 4 =>
+    writeSaturnPrint('"\newline")
+    writeSaturn SUBSTRING(line,k + 8,nil)
+  code = 5 =>
+    writeSaturnPrint('"\table{")
+    $marg := $marg + 3
+    writeSaturnTable SUBSTRING(line,k + 7,nil)
+  code = 6 =>
+    i := charPosition(char '_},line,k + 4)
+    tabCode := SUBSTRING(line,k, i - k + 1)
+    writeSaturnPrint tabCode
+    line := SUBSTRING(line,i + 1, nil)
+    writeSaturn line
+  code = 7 =>
+    saturnTERPRI()
+    writeSaturn SUBSTRING(line, k + 2,nil)
+  code = 8 =>
+    i :=
+      substring?('"\beginmenu",  line,k) => k + 9
+      substring?('"\beginscroll",line,k) => k + 11
+      charPosition(char '_},line,k)
+    if char '_[ = line.(i + 1) then
+      i := charPosition(char '_], line, i + 2)
+    beginCode := SUBSTRING(line,k, i - k + 1)
+    writeSaturnPrint(beginCode)
+    line := SUBSTRING(line,i + 1,nil)
+    writeSaturn line
+  code = 9 =>
+    i :=
+      substring?('"\endmenu",line,k)   => k + 7
+      substring?('"\endscroll",line,k) => k + 9
+      charPosition(char '_},line,k)
+    endCode := SUBSTRING(line,k, i - k + 1)
+    writeSaturnPrint(endCode)
+    line := SUBSTRING(line,i + 1,nil)
+    $marg := $marg - 3
+    writeSaturn line
+  systemError code
+
+isBreakSegment?(line, k, n) ==
+  k > n => nil
+  char2 := line . k
+  char2 = (char '_\) => 1
+  char2 = (char '_&) =>
+    substring?('"&\&", line, k) => 2
+    nil
+  char2 = char 'i =>
+    substring?('"item",line,k) => 3
+    nil
+  char2 = char 'n =>
+    substring?('"newline",line,k) => 4
+    nil
+  char2 = char 't =>
+    (k := k + 2) > n => nil
+    line.(k - 1) = char 'a and line.k = char 'b =>
+      (k := k + 1) > n => nil
+      line.k = char "{" => 6
+      substring?('"table",line,k - 3) => 5
+      nil
+  char2 = (char '_!) => 7
+  char2 = char 'b =>
+    substring?('"begin",line,k) => 8
+    nil
+  char2 = (char 'e)  =>
+    substring?('"end",line,k) => 9
+    nil
+  nil
+
+writeSaturnPrint s ==
+  for i in 0..($marg - 1) repeat saturnPRINTEXP '" "
+  saturnPRINTEXP s
+  saturnTERPRI()
+
+saturnPRINTEXP s ==
+  $browserOutputStream => PRINTEXP(s,$browserOutputStream)
+  PRINTEXP s
+
+saturnTERPRI() ==
+  $browserOutputStream => TERPRI($browserOutputStream)
+  TERPRI()
+
+writeSaturnTable line ==
+  open := charPosition(char '"_{",line,0)
+  close:= charPosition(char '"_}",line,0)
+  open < close =>
+    close := findBalancingBrace(line,open + 1,MAXINDEX line,0) or error '"no balancing brace"
+    writeSaturnPrint SUBSTRING(line,0,close + 1)
+    writeSaturnTable SUBSTRING(line,close + 1,nil)
+  $marg := $marg - 3
+  writeSaturnPrint SUBSTRING(line,0,close + 1)
+  writeSaturn SUBSTRING(line, close + 1,nil)
+
+findBalancingBrace(s,k,n,level) ==
+  k > n => nil
+  c := s . k
+  c = char '_{ => findBalancingBrace(s, k + 1, n, level + 1)
+  c = char '_} =>
+    level = 0 => k
+    findBalancingBrace(s, k + 1, n, level - 1)
+  findBalancingBrace(s, k + 1, n, level)
+
+--=======================================================================
+--            htMakePage and friends
+--=======================================================================
+htMakePageStandard itemList ==
+  $saturn => nil
+  htMakePage itemList
+
+htMakePageSaturn itemList ==
+  $standard => nil
+  htMakePage itemList
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htMakePage itemList ==
+  if $newPage then
+    if $saturn then htpAddToPageDescription($saturnPage, saturnTran itemList)
+    if $standard then htpAddToPageDescription($curPage, itemList)
+  htMakePage1 itemList
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htMakePage1 itemList ==
+-- make a page given the description in itemList
+  for u in itemList repeat
+    itemType := 'text
+    items :=
+      STRINGP u => u
+      ATOM u => STRINGIMAGE u
+      STRINGP first u => u
+      u is ['text, :s] => s
+      itemType := first u
+      rest u
+    itemType = 'text              => iht items
+--      $saturn => bcHt items
+--      $standard => iht items
+    itemType = 'lispLinks         => htLispLinks items
+    itemType = 'lispmemoLinks     => htLispMemoLinks items
+    itemType = 'bcLinks           => htBcLinks items               --->
+    itemType = 'bcLinksNS         => htBcLinks(items,true)
+    itemType = 'bcLispLinks       => htBcLispLinks items           --->
+    itemType = 'radioButtons      => htRadioButtons items
+    itemType = 'bcRadioButtons    => htBcRadioButtons items
+    itemType = 'inputStrings      => htInputStrings items
+    itemType = 'domainConditions  => htProcessDomainConditions items
+    itemType = 'bcStrings         => htProcessBcStrings items
+    itemType = 'toggleButtons     => htProcessToggleButtons items
+    itemType = 'bcButtons         => htProcessBcButtons items
+    itemType = 'doneButton        => htProcessDoneButton items
+    itemType = 'doitButton        => htProcessDoitButton items
+    systemError '"unexpected branch"
+
+saturnTran x ==
+  x is [[kind, [s1, s2, :callTail]]] and MEMQ(kind,'(bcLinks bcLispLinks)) =>
+    text := saturnTranText s2
+    fs :=  getCallBackFn callTail
+    y := isMenuItemStyle? s1 =>  ----> y is text for button in 2nd column
+      t1 :=  mkDocLink(fs, mkMenuButton())
+      y = '"" =>
+        s2 = '"" => t1
+        mkTabularItem [t1, text]
+      t2 :=  mkDocLink(fs, y)
+      mkTabularItem [t1, t2, text]
+    t := mkDocLink(fs, s1)
+    [:t, :text]
+  x is [['text,:r],:.] => r
+  error nil
+
+mkBold s ==
+  secondPart :=
+    atom s => [s, '"}"]
+    [:s, '"}"]
+  ['"{\bf ", :secondPart]
+
+mkMenuButton() == [menuButton()]
+
+menuButton() == '"\menuitemstyle{}"
+-- Saturn must translate \menuitemstyle ==> {\menuButton}
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+--replaces htMakeButton
+getCallBackFn form ==
+  func := mkCurryFun(first form, rest form)
+  STRCONC('"(|htDoneButton| '|", func, '"| ",htpName page(), '")")
+
+mkDocLink(code,s) ==
+  if atom code then code := [code]
+  if atom s    then s    := [s]
+  ['"\lispLink[d]{\verb!", :code, '"!}{", :s, '"}"]
+
+saturnTranText x ==
+  STRINGP x         => [unTab x]
+  null x            => nil
+  r is [s,fn,:.] and s = '"\unixcommand{" => ['"{\it ",s,'".spad}"]
+  x is [['text, :s],:r] => unTab [:s, :saturnTranText r]
+  error nil
+
+isMenuItemStyle? s ==
+  15 = STRING_<('"\menuitemstyle{", s) => SUBSTRING(s,15,(MAXINDEX s) - 15)
+  nil
+
+getCallBack callTail ==
+  LASSOC(callTail, $callTailList) or
+    callTail is [fn] => callTail
+    error nil
+
+--=======================================================================
+--              Redefinitions from hypertex.boot
+--=======================================================================
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+endHTPage() ==
+  $standard => sockSendInt($MenuServer, $EndOfPage)
+  nil
+
+--=======================================================================
+--              Redefinitions from ht-util.boot
+--=======================================================================
+htSayHrule() == bcHt
+  $saturn => '"\hrule{}\newline{}"
+  '"\horizontalline{}\newline{}"
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htpAddInputAreaProp(htPage, label, prop) ==
+------------> Add STRINGIMAGE
+  SETELT(htPage, 5, [[label, nil, nil, nil, :prop], :ELT(htPage, 5)])
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htpSetLabelInputString(htPage, label, val) ==
+------------> Add STRINGIMAGE
+-- value user typed as input string on page
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => SETELT(props, 0, STRINGIMAGE val)
+  nil
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htDoneButton(func, htPage, :optionalArgs) ==
+------> Handle argument values passed from page if present
+  if optionalArgs then
+    htpSetInputAreaAlist(htPage,CAR optionalArgs)
+  typeCheckInputAreas htPage =>
+    htMakeErrorPage htPage
+  NULL FBOUNDP func =>
+    systemError ['"unknown function", func]
+  FUNCALL(SYMBOL_-FUNCTION func, htPage)
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htBcLinks(links,:options) ==
+  skipStateInfo? := IFCAR options
+  [links,options] := beforeAfter('options,links)
+  for [message, info, func, :value] in links repeat
+    link :=
+      $saturn => '"\lispLink[d]"
+      '"\lispdownlink"
+    htMakeButton(link,message,
+                   mkCurryFun(func, value),skipStateInfo?)
+    bcIssueHt info
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htBcLispLinks links ==
+  [links,options] := beforeAfter('options,links)
+  for [message, info, func, :value] in links repeat
+    link :=
+      $saturn => '"\lispLink[n]"
+      '"\lisplink"
+    htMakeButton(link ,message, mkCurryFun(func, value))
+    bcIssueHt info
+
+htMakeButton(htCommand, message, func,:options) ==
+  $saturn => htMakeButtonSaturn(htCommand, message, func, options)
+  skipStateInfo? := IFCAR options
+  iht [htCommand, '"{"]
+  bcIssueHt message
+  skipStateInfo? =>
+    iht ['"}{(|htDoneButton| '|", func, '"| ",htpName $curPage, '")}"]
+  iht ['"}{(|htDoneButton| '|", func, '"| (PROGN "]
+  for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat
+    iht ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "]
+    if type = 'string then
+      iht ['"_"\stringvalue{", id, '"}_""]
+    else
+      iht ['"_"\boxvalue{", id, '"}_""]
+    iht '") "
+  iht [htpName $curPage, '"))}"]
+
+htMakeButtonSaturn(htCommand, message, func,options) ==
+  skipStateInfo? := IFCAR options
+  iht htCommand
+  skipStateInfo? =>
+    iht ['"{\verb!(|htDoneButton| '|", func, '"| ",htpName page(), '")!}{"]
+    bcIssueHt message
+    iht '"}"
+  iht ['"{\verb!(|htDoneButton| '|", func, '"| "]
+  if $kPageSaturnArguments then
+    iht '"(PROGN "
+    for id in $kPageSaturnArguments for var in $PatternVariableList  repeat
+      iht ['"(|htpSetLabelInputString| ", htpName page(), '"'|", var, '"| "]
+      iht ["'|!\", id, '"\verb!|"]
+      iht '")"
+    iht htpName $saturnPage
+    iht '")"
+  else
+    iht htpName $saturnPage
+  iht '")!}{"
+  bcIssueHt message
+  iht '"}"
+
+htpAddToPageDescription(htPage, pageDescrip) ==
+  newDescript :=
+    STRINGP pageDescrip => [pageDescrip, :ELT(htPage, 7)]
+    nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7))
+  SETELT(htPage, 7, newDescript)
+
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htProcessBcStrings strings ==
+  for [numChars, default, stringName, spadType, :filter] in strings repeat
+    mess2 := '""
+    if NULL LASSOC(stringName, htpInputAreaAlist page()) then
+      setUpDefault(stringName, ['string, default, spadType, filter])
+    if htpLabelErrorMsg(page(), stringName) then
+      iht ['"\centerline{{\em ", htpLabelErrorMsg(page(), stringName), '"}}"]
+      mess2 := CONCAT(mess2, bcSadFaces())
+      htpSetLabelErrorMsg(page(), stringName, nil)
+    iht ['"\inputstring{", stringName, '"}{",
+         numChars, '"}{", htpLabelDefault(page(),stringName), '"} ", mess2]
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+setUpDefault(name, props) ==
+  htpAddInputAreaProp(page(), name, props)
+
+--------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+htInitPage(title, propList) ==
+-- start defining a hyperTeX page
+  htInitPageNoScroll(propList, title)
+  htSayStandard '"\beginscroll "
+  page()
+
+--------------------> NEW DEFINITION <--------------------------
+htInitPageNoScroll(propList, :options) ==
+--start defining a hyperTeX page
+  $atLeastOneUnexposed := nil     --reset every time a new page is initialized
+  $saturnContextMenuLines := nil
+  title := IFCAR options
+  $curPage :=
+    $standard => htpMakeEmptyPage(propList)
+    nil
+  if $saturn then $saturnPage := htpMakeEmptyPage(propList)
+  $newPage := true
+  $htLineList := nil
+  if title then
+    if $standard then htSayStandard ['"\begin{page}{", htpName $curPage, '"}{"]
+    htSaySaturn '"\browseTitle{"
+    htSay title
+    htSaySaturn '"}"
+    htSayStandard '"} "
+  page()
+--------------------> NEW DEFINITION <--------------------------
+htInitPageNoHeading(propList) ==
+--start defining a hyperTeX page
+  $curPage :=
+    $standard => htpMakeEmptyPage(propList)
+  if $saturn then $saturnPage := htpMakeEmptyPage(propList)
+  $newPage := true
+  $htLineList := nil
+  page()
+
+--------------------> NEW DEFINITION <--------------------------
+htpMakeEmptyPage(propList,:options) ==
+  name := IFCAR options or  GENTEMP()
+  if not $saturn then
+    $activePageList := [name, :$activePageList]
+  SET(name, val := VECTOR(name, nil, nil, nil, nil, nil, propList, nil))
+  val
+
+--=======================================================================
+--              Redefinitions from br-con.boot
+--=======================================================================
+kPage(line,:options) == --any cat, dom, package, default package
+--constructors    Cname\#\E\sig \args   \abb \comments (C is C, D, P, X)
+  parts := dbXParts(line,7,1)
+  [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts
+  form := IFCAR options
+  isFile := null kind
+  kind := kind or '"package"
+  RPLACA(parts,kind)
+  conform         := mkConform(kind,name,args)
+  $kPageSaturnArguments: local := rest conform
+  conname         := opOf conform
+  capitalKind     := capitalize kind
+  signature       := ncParseFromString sig
+  sourceFileName  := dbSourceFile INTERN name
+  constrings      :=
+    KDR form => dbConformGenUnder form
+    [STRCONC(name,args)]
+  emString        := ['"{\sf ",:constrings,'"}"]
+  heading := [capitalKind,'" ",:emString]
+  if not isExposedConstructor conname then heading := ['"Unexposed ",:heading]
+  if name=abbrev then abbrev := asyAbbreviation(conname,nargs)
+  page := htInitPageNoScroll nil
+  htAddHeading heading
+  htSayStandard("\beginscroll ")
+  htpSetProperty(page,'argSublis,mkConArgSublis rest conform)
+  htpSetProperty(page,'isFile,true)
+  htpSetProperty(page,'parts,parts)
+  htpSetProperty(page,'heading,heading)
+  htpSetProperty(page,'kind,kind)
+  if asharpConstructorName? conname then
+    htpSetProperty(page,'isAsharpConstructor,true)
+  htpSetProperty(page,'conform,conform)
+  htpSetProperty(page,'signature,signature)
+  ---what follows is stuff from kiPage with domain = nil
+  $conformsAreDomains := nil
+  dbShowConsDoc1(page,conform,nil)
+  if kind ^= 'category and nargs > 0 then addParameterTemplates(page,conform)
+  if $atLeastOneUnexposed then htSay '"\newline{}{\em *} = unexposed"
+  htSayStandard("\endscroll ")
+  kPageContextMenu page
+  htShowPageNoScroll()
+
+kPageContextMenu page ==
+  $saturn => kPageContextMenuSaturn page
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(page,'parts)
+  conform := htpProperty(page,'conform)
+  conname := opOf conform
+  htBeginTable()
+  htSay '"{"
+  htMakePage [['bcLinks,['Ancestors,'"",'kcaPage,nil]]]
+  htSay '"}{"
+  htMakePage [['bcLinks,['Attributes,'"",'koPage,'"attribute"]]]
+  if kind = '"category" then
+    htSay '"}{"
+    htMakePage [['bcLinks,['Children,'"",'kccPage,nil]]]
+  if not asharpConstructorName? conname then
+    htSay '"}{"
+    htMakePage [['bcLinks,['Dependents,'"",'kcdePage,nil]]]
+  if kind = '"category" then
+    htSay '"}{"
+    htMakePage [['bcLinks,['Descendents,'"",'kcdPage,nil]]]
+  if kind = '"category" then
+    htSay '"}{"
+    if not asharpConstructorName? conname then
+      htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]]
+    else htSay '"{\em Domains}"
+  htSay '"}{"
+  if kind ^= '"category" and (pathname := dbHasExamplePage conname)
+    then htMakePage [['bcLinks,['Examples,'"",'kxPage,pathname]]]
+    else htSay '"{\em Examples}"
+  htSay '"}{"
+  htMakePage [['bcLinks,['Exports,'"",'kePage,nil]]]
+  htSay '"}{"
+  htMakePage [['bcLinks,['Operations,'"",'koPage,'"operation"]]]
+  htSay '"}{"
+  htMakePage [['bcLinks,['Parents,'"",'kcpPage,'"operation"]]]
+  if kind ^= '"category" then
+    htSay '"}{"
+    if not asharpConstructorName? conname
+    then  htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]]
+    else htSay '"{\em Search Path}"
+  if kind ^= '"category" then
+    htSay '"}{"
+    htMakePage [['bcLinks,['Users,'"",'kcuPage,nil]]]
+    htSay '"}{"
+    htMakePage [['bcLinks,['Uses,'"",'kcnPage,nil]]]
+  htSay '"}"
+  if $standard then htEndTable()
+
+kPageContextMenuSaturn page ==
+  $newPage    : local := nil
+  [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(page,'parts)
+  $htLineList : local := nil
+  conform := htpProperty(page,'conform)
+  conname := opOf conform
+  htMakePage [['bcLinks,['"\&Ancestors",'"",'kcaPage,nil]]]
+  htMakePage [['bcLinks,['"Attri\&butes",'"",'koPage,'"attribute"]]]
+  if kind = '"category" then
+    htMakePage [['bcLinks,['"\&Children",'"",'kccPage,nil]]]
+  if not asharpConstructorName? conname then
+    htMakePage [['bcLinks,['"\&Dependents",'"",'kcdePage,nil]]]
+  if kind = '"category" then
+    htMakePage [['bcLinks,['"Desce\&ndents",'"",'kcdPage,nil]]]
+  if kind = '"category" then
+    if not asharpConstructorName? conname then
+      htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]]
+      else htSayCold '"Do\&mains"
+  if kind ^= '"category" and (name := saturnHasExamplePage conname)
+    then saturnExampleLink name
+    else htSayCold '"E\&xamples"
+  htMakePage [['bcLinks,['"\&Exports",'"",'kePage,nil]]]
+  htMakePage [['bcLinks,['"\&Operations",'"",'koPage,'"operation"]]]
+  htMakePage [['bcLinks,['"\&Parents",'"",'kcpPage,'"operation"]]]
+  if not asharpConstructorName? conname
+    then  htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]]
+    else htSayCold '"Search Order"
+  if kind ^= '"category" or dbpHasDefaultCategory? xpart
+    then
+       htMakePage [['bcLinks,['"\&Users",'"",'kcuPage,nil]]]
+       htMakePage [['bcLinks,['"U\&ses",'"",'kcnPage,nil]]]
+    else
+       htSayCold '"\&Users"
+       htSayCold '"U\&ses"
+  $saturnContextMenuLines := $htLineList
+
+saturnExampleLink lname ==
+  htSay '"\docLink{\csname "
+  htSay STRCONC(CAR(CDR(lname)), '"\endcsname}{E&xamples}")
+
+$exampleConstructors := nil
+
+saturnHasExamplePage conname ==
+  if not $exampleConstructors then
+     $exampleConstructors := getSaturnExampleList()
+  ASSQ(conname, $exampleConstructors)
+  
+getSaturnExampleList() == 
+  file := STRCONC( getEnv('"AXIOM"), "/doc/axug/examples.lsp")
+  not PROBE_-FILE file => nil
+  fp := MAKE_-INSTREAM file
+  lst := READ fp
+  SHUT fp
+  lst
+  
+--------------------> NEW DEFINITION (see br-con.boot.pamphlet)
+dbPresentCons(htPage,kind,:exclusions) ==
+  $saturn => dbPresentConsSaturn(htPage,kind,exclusions)
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  cAlist := htpProperty(htPage,'cAlist)
+  empty? := null cAlist
+  one?   := null CDR cAlist
+  one? := empty? or one?
+  exposedUnexposedFlag := $includeUnexposed? --used to be star?       4/92
+  star?  := true     --always include information on exposed/unexposed   4/92
+  if $standard then htBeginTable()
+  htSay '"{"
+  if one? or member('abbrs,exclusions)
+    then htSay '"{\em Abbreviations}"
+    else htMakePage [['bcLispLinks,['"Abbreviations",'"",'dbShowCons,'abbrs]]]
+  htSay '"}{"
+  if one? or member('conditions,exclusions) or and/[CDR x = true for x in cAlist]
+    then htSay '"{\em Conditions}"
+    else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowCons,'conditions]]]
+  htSay '"}{"
+  if empty? or member('documentation,exclusions)
+    then htSay '"{\em Descriptions}"
+    else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowCons,'documentation]]]
+  htSay '"}{"
+  if one? or null CDR cAlist
+    then htSay '"{\em Filter}"
+    else htMakePage
+      [['bcLinks,['"Filter",'"",'htFilterPage,['dbShowCons,'filter]]]]
+  htSay '"}{"
+  if one? or member('kinds,exclusions) or kind ^= 'constructor
+    then htSay '"{\em Kinds}"
+    else htMakePage [['bcLispLinks,['"Kinds",'"",'dbShowCons,'kinds]]]
+  htSay '"}{"
+  if one? or member('names,exclusions)
+    then htSay '"{\em Names}"
+    else htMakePage [['bcLispLinks,['"Names",'"",'dbShowCons,'names]]]
+  htSay '"}{"
+  if one? or member('parameters,exclusions) or not or/[CDAR x for x in cAlist]
+    then htSay '"{\em Parameters}"
+    else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowCons,'parameters]]]
+  htSay '"}{"
+  if $exposedOnlyIfTrue
+    then
+      if one?
+      then htSay '"{\em Unexposed Also}"
+      else htMakePage [['bcLinks,['"Unexposed Also",'"",'dbShowCons,'exposureOff]]]
+    else
+      if one?
+      then htSay '"{\em Exposed Only}"
+      else htMakePage [['bcLinks,['"Exposed Only",'"",'dbShowCons,'exposureOn]]]
+  htSay '"}"
+  if $standard then htEndTable()
+
+dbPresentConsSaturn(htPage,kind,exclusions) ==
+  $htLineList : local := nil
+  $newPage    : local := nil
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  cAlist := htpProperty(htPage,'cAlist)
+  empty? := null cAlist
+  one?   := null KDR cAlist
+  one? := empty? or one?
+  exposedUnexposedFlag := $includeUnexposed? --used to be star?       4/92
+  star?  := true     --always include information on exposed/unexposed   4/92
+  if $standard then htBeginTable()
+  if one? or member('abbrs,exclusions)
+    then htSayCold '"\&Abbreviations"
+    else htMakePage [['bcLispLinks,['"\&Abbreviations",'"",'dbShowCons,'abbrs]]]
+  if one? or member('conditions,exclusions) or and/[CDR x = true for x in cAlist]
+    then htSayCold '"\&Conditions"
+    else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowCons,'conditions]]]
+  if empty? or member('documentation,exclusions)
+    then htSayCold '"\&Descriptions"
+    else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowCons,'documentation]]]
+  if one? or null CDR cAlist
+    then htSayCold '"\&Filter"
+    else htMakeSaturnFilterPage ['dbShowCons, 'filter]
+  if one? or member('kinds,exclusions) or kind ^= 'constructor
+    then htSayCold '"\&Kinds"
+    else htMakePage [['bcLispLinks,['"\&Kinds",'"",'dbShowCons,'kinds]]]
+  if one? or member('names,exclusions)
+    then htSayCold '"\&Names"
+    else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowCons,'names]]]
+  if one? or member('parameters,exclusions) or not or/[CDAR x for x in cAlist]
+    then htSayCold '"\&Parameters"
+    else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowCons,'parameters]]]
+  htSaySaturn '"\hrule"
+  if $exposedOnlyIfTrue
+    then
+      if one? then htSayCold '"\&Unexposed Also"
+      else htMakePage [['bcLinks,['"\&Unexposed Also",'"",'dbShowCons,'exposureOff]]]
+    else
+      if one? then htSayCold '"\Exposed Only\&y"
+      else htMakePage [['bcLinks,['"Exposed Onl\&y",'"",'dbShowCons,'exposureOn]]]
+  if $standard then htEndTable()
+  $saturnContextMenuLines := $htLineList
+
+htFilterPage(htPage,args) ==
+  htInitPage("Filter String",htCopyProplist htPage)
+  htSay "\centerline{Enter filter string (use {\em *} for wild card):}"
+  htSay '"\centerline{"
+  htMakePage [['bcStrings, [50,'"",'filter,'EM]]]
+  htSay '"}\vspace{1}\centerline{"
+  htMakePage [['bcLispLinks,['"\fbox{Filter}",'"",:args]]]
+  htSay '"}"
+  htShowPage()
+
+htMakeSaturnFilterPage [fn2Call,:args] ==
+  htSay '"\inputboxLink[\lispLink[d]{\verb+(|"
+  htSay fn2Call
+  htSay '"| "
+  htSay htpName $saturnPage
+  for x in args repeat
+    htSay '" '|"
+    htSay x
+    htSay '"|"
+  htSay '" _"+_\FILTERSTRING\verb+_")+}{}]{\FILTERSTRING}{*}"
+  htSay '"{\centerline{Enter filter string (use {\em *} for wild card):}}"
+  htSay '"{Filter Page}{\&Filter}"
+
+dbShowConsKinds cAlist ==
+  cats := doms := paks := defs := nil
+  for x in cAlist repeat
+    op := CAAR x
+    kind := dbConstructorKind op
+    kind  = 'category => cats := [x,:cats]
+    kind = 'domain    => doms := [x,:doms]
+    kind = 'package   => paks := [x,:paks]
+    defs := [x,:defs]
+  lists := [NREVERSE cats,NREVERSE doms,NREVERSE paks,NREVERSE defs]
+  htBeginMenu 'description
+  htSayStandard '"\indent{1}"
+  kinds := +/[1 for x in lists | #x > 0]
+  firstTime := true
+  for kind in '("category" "domain" "package" "default package") for x in lists | #x > 0 repeat
+    if firstTime then firstTime := false
+                 else htSaySaturn '"\\"
+    htSaySaturn '"\item["
+    htSayStandard '"\item"
+    if kinds = 1
+       then htSay menuButton()
+       else htMakePage
+         [['bcLinks,[menuButton(),'"",'dbShowConsKindsFilter,[kind,x]]]]
+    htSaySaturn '"]"
+    htSayStandard '"\tab{1}"
+    htSay('"{\em ",c := #x,'" ")
+    htSay(c > 1 => pluralize kind; kind)
+    htSay '":}"
+    htSaySaturn '"\\"
+    bcConTable REMDUP [CAAR y for y in x]
+  htEndMenu 'description
+  htSayStandard '"\indent{0}"
+
+addParameterTemplates(page, conform) ==
+---------------> from kPage <-----------------------
+  parlist := [STRINGIMAGE par for par in rest conform]
+  manuelsCode? := "MAX"/[#s for s in parlist] > 10
+  w := (manuelsCode? => 55; 23)
+  htSaySaturn '"\colorbuttonbox{lightgray}{"
+  htSay '"Optional argument value"
+  htSay
+    CDR parlist => '"s:"
+    '":"
+  htSaySaturn '"}"
+  if CDR conform then htSaySaturn '"\newline{}"
+  htSaySaturn '"\begin{tabular}{p{.25in}l}"
+  firstTime := true
+  odd := false
+  argSublis := htpProperty(page,'argSublis)
+  for parname in $PatternVariableList for par in rest conform repeat
+    htSayStandard (odd or manuelsCode? => "\newline";"\tab{29}")
+    if firstTime then firstTime := false
+                 else htSaySaturn '"\\"
+    odd := not odd
+    argstring :=
+      $conArgstrings is [a,:r] => ($conArgstrings := r; a)
+      '""
+    htMakePageStandard [['text,'"{\em ",par,'"} = "],
+        ['bcStrings,[w - #STRINGIMAGE par,argstring,parname,'EM]]]
+    if $saturn then
+      setUpDefault(parname, ['string, '"", 'EM, nil])
+    htSaySaturn '"{\em "
+    htSaySaturn par
+    htSaySaturn '" = }"
+    htSaySaturnAmpersand()
+    htSaySaturn '"\colorbuttonbox{lightgray}{\inputbox[2.5in]{\"
+    htSaySaturn SUBLIS(argSublis,par)
+    htSaySaturn '"}{"
+    htSaySaturn argstring
+    htSaySaturn '"}}"
+  htEndTabular()
+
+--------------------> NEW DEFINITION (see br-con.boot.pamphlet)
+kPageArgs([op,:args],[.,.,:source]) ==
+  htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}"
+  firstTime := true
+  coSig := rest GETDATABASE(op,'COSIG)
+  for x in args for t in source for pred in coSig repeat
+    if firstTime then firstTime := false
+                 else
+                   htSaySaturn '"\\"
+                   htSayStandard '", and"
+    htSayStandard '"\newline "
+    htSaySaturnAmpersand()
+    typeForm := (t is [":",.,t1] => t1; t)
+    if pred = true
+      then htMakePage [['bcLinks,[x,'"",'kArgPage,x]]]
+      else htSay('"{\em ",x,'"}")
+    htSayStandard( '"\tab{",STRINGIMAGE( # PNAME x),'"}, ")
+    htSaySaturnAmpersand()
+    htSay
+      pred => '"a domain of category "
+      '"an element of the domain "
+    bcConform(typeForm,true)
+  htEndTabular()
+
+--=======================================================================
+--              Redefinitions from br-op1.boot
+--=======================================================================
+--------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
+dbConform form ==
+--one button for the main constructor page of a type
+  $saturn => ["\lispLink[d]{\verb!(|conPage| '",:form2Fence dbOuttran form,'")!}{",
+           :form2StringList opOf form,"}"]
+  ["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"]
+
+--------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
+htTab s == if $standard then htSayStandard ('"\tab{",s,'"}")
+
+--------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
+dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
+  single? := null rest data
+  htBeginMenu 'description
+  bincount := 0
+  for [thing,exposeFlag,:items] in data repeat
+    htSaySaturn '"\item["
+    htSayStandard ('"\item")
+    if single? then htSay(menuButton())
+    else
+      htMakePageStandard
+        [['bcLinks,[menuButton(),'"",'dbShowOps,which,bincount]]]
+      button := mkButtonBox (1 + bincount)
+      htMakePageSaturn [['bcLinks,[button,'"",'dbShowOps,which,bincount]]]
+    htSaySaturn '"]"
+    htSay '"{\em "
+    htSay
+      thing = 'nowhere => '"implemented nowhere"
+      thing = 'constant => '"constant"
+      thing = '_$ => '"by the domain"
+      INTEGERP thing => '"unexported"
+      constructorIfTrue =>
+        htSay word
+        atom thing => '" an unknown constructor"
+        '""
+      atom thing => '"unconditional"
+      '""
+    htSay '"}"
+    if null atom thing then
+      if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}")
+      htSay '" "
+      FUNCALL(fn,thing)
+    htSay('":\newline ")
+    dbShowOpSigList(which,items,(1 + bincount) * 8192)
+    bincount := bincount + 1
+  htEndMenu 'description
+
+--------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
+dbPresentOps(htPage,which,:exclusions) ==
+  $saturn => dbPresentOpsSaturn(htPage,which,exclusions)
+  asharp? := htpProperty(htPage,'isAsharpConstructor)
+  fromConPage? := (conname := opOf htpProperty(htPage,'conform))
+  usage? := nil
+  star? := not fromConPage? or which = '"package operation"
+  implementation? := not asharp? and
+    $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
+  rightmost? := star? or (implementation? and not $includeUnexposed?)
+  if INTEGERP first exclusions then exclusions := ['documentation]
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  empty? := null opAlist
+  one?   := opAlist is [entry] and 2 = #entry
+  one? := empty? or one?
+  htBeginTable()
+  htSay '"{"
+  if one? or member('conditions,exclusions)
+                 or (htpProperty(htPage,'condition?) = 'no)
+      then htSay '"{\em Conditions}"
+      else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowOps,which,'conditions]]]
+  htSay '"}{"
+  if empty? or member('documentation,exclusions)
+    then htSay '"{\em Descriptions}"
+    else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowOps,which,'documentation]]]
+  htSay '"}{"
+  if null IFCDR opAlist
+    then htSay '"{\em Filter}"
+    else htMakePage [['bcLinks,['"Filter ",'"",'htFilterPage,['dbShowOps,which,'filter]]]]
+  htSay '"}{"
+  if one? or member('names,exclusions) or null KDR opAlist
+    then htSay '"{\em Names}"
+    else htMakePage [['bcLispLinks,['"Names",'"",'dbShowOps,which,'names]]]
+  if not star? then
+    htSay '"}{"
+    if not implementation? or member('implementation,exclusions) or which = '"attribute" or
+      ((conname := opOf htpProperty(htPage,'conform))
+        and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+    then htSay '"{\em Implementations}"
+    else htMakePage
+      [['bcLispLinks,['"Implementations",'"",'dbShowOps,which,'implementation]]]
+  htSay '"}{"
+  if one? or member('origins,exclusions)
+    then htSay '"{\em Origins}"
+    else htMakePage [['bcLispLinks,['"Origins",'"",'dbShowOps,which,'origins]]]
+  htSay '"}{"
+  if one? or member('parameters,exclusions) --also test for some parameter
+      or not dbDoesOneOpHaveParameters? opAlist
+    then htSay '"{\em Parameters}"
+    else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowOps,which,'parameters]]]
+  htSay '"}{"
+  if which ^= '"attribute" then
+    if one? or member('signatures,exclusions)
+      then htSay '"{\em Signatures}"
+      else htMakePage [['bcLispLinks,['"Signatures",'"",'dbShowOps,which,'signatures]]]
+  htSay '"}"
+  if star? then
+    htSay '"{"
+    if $exposedOnlyIfTrue
+    then if one?
+         then htSay '"{\em Unexposed Also}"
+         else htMakePage [['bcLinks,['"Unexposed Also",'"",'dbShowOps,which,'exposureOff]]]
+    else if one?
+         then htSay '"{\em Exposed Only}"
+         else htMakePage [['bcLinks,['"Exposed Only",'"",'dbShowOps, which,'exposureOn]]]
+    htSay '"}"
+  htEndTable()
+
+dbPresentOpsSaturn(htPage,which,exclusions) ==
+  $htLineList : local := nil
+  $newPage    : local := nil
+  asharp? := htpProperty(htPage,'isAsharpConstructor)
+  fromConPage? := (conname := opOf htpProperty(htPage,'conform))
+  usage? := nil
+  star? := not fromConPage? or which = '"package operation"
+  implementation? := not asharp? and
+    $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
+  rightmost? := star? or (implementation? and not $includeUnexposed?)
+  if INTEGERP first exclusions then exclusions := ['documentation]
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  empty? := null opAlist
+  one?   := opAlist is [entry] and 2 = #entry
+  one? := empty? or one?
+  if one? or member('conditions,exclusions)
+                 or (htpProperty(htPage,'condition?) = 'no)
+      then htSayCold '"\&Conditions"
+      else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowOps,which,'conditions]]]
+  if empty? or member('documentation,exclusions)
+    then htSayCold '"\&Descriptions"
+    else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowOps,which,'documentation]]]
+  if null IFCDR opAlist
+    then htSayCold '"\&Filter"
+    else htMakeSaturnFilterPage ['dbShowOps, which, 'filter]
+  if not implementation? or member('implementation,exclusions) or which = '"attribute" or
+      ((conname := opOf htpProperty(htPage,'conform))
+        and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+    then htSayCold '"\&Implementations"
+    else htMakePage
+      [['bcLispLinks,['"\&Implementations",'"",'dbShowOps,which,'implementation]]]
+  if one? or member('names,exclusions) or null KDR opAlist
+    then htSayCold '"\&Names"
+    else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowOps,which,'names]]]
+  if one? or member('origins,exclusions)
+    then htSayCold '"\&Origins"
+    else htMakePage [['bcLispLinks,['"\&Origins",'"",'dbShowOps,which,'origins]]]
+  if one? or member('parameters,exclusions) --also test for some parameter
+      or not dbDoesOneOpHaveParameters? opAlist
+    then htSayCold '"\&Parameters"
+    else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowOps,which,'parameters]]]
+  if which ^= '"attribute" then
+    if one? or member('signatures,exclusions)
+      then htSayCold '"\&Signatures"
+      else htMakePage [['bcLispLinks,['"\&Signatures",'"",'dbShowOps,which,'signatures]]]
+  if star? then
+    htSay '"\hrule"
+    if $exposedOnlyIfTrue
+      then if one? then htSayCold '"\&Unexposed Also"
+      else htMakePage [['bcLinks,['"\&Unexposed Also",'"",'dbShowOps,which,'exposureOff]]]
+    else
+      if one? then htSayCold '"Exposed Onl\&y"
+      else htMakePage [['bcLinks,['"Exposed Onl\&y",'"",'dbShowOps,which,'exposureOn]]]
+  $saturnContextMenuLines := $htLineList
+
+--=======================================================================
+--              Redefinitions from br-search.boot
+--=======================================================================
+---------------------> OLD DEFINITION (override in br-search.boot.pamphlet)
+htShowPageStar() ==
+  $saturn => htShowPageStarSaturn()
+  htSayStandard '"\endscroll "
+  if $exposedOnlyIfTrue then
+    htMakePage [['bcLinks,['"Unexposed Also",'"",'repeatSearch,NIL]]]
+  else
+    htMakePage [['bcLinks,['"Exposed Only",'"",'repeatSearch,'T]]]
+  htShowPageNoScroll()
+
+htShowPageStarSaturn() ==
+  $newPage    : local := nil
+  $htLineList : local := nil
+  if $exposedOnlyIfTrue then
+    htMakePage [['bcLinks,['"Unexposed Also",'"",'repeatSearch,NIL]]]
+  else
+    htMakePage [['bcLinks,['"Exposed Only",'"",'repeatSearch,'T]]]
+  $saturnContextMenuLines := $htLineList
+  htShowPageNoScroll()
+
+--=======================================================================
+--              Redefinitions from br-op2.boot
+--=======================================================================
+
+--------------> NEW DEFINITION (see br-op2.boot.pamphlet)
+displayDomainOp(htPage,which,origin,op,sig,predicate,
+		doc,index,chooseFn,unexposed?,$generalSearch?) ==
+  $chooseDownCaseOfType : local := true	  --see dbGetContrivedForm
+  $whereList  : local := nil
+  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
+  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
+  $FunctionList:local := '(f g h d e F G H)
+  $DomainList:	local := '(D R S E T A B C M N P Q U V W)
+  exactlyOneOpSig     := null index
+  conform   := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+		 or origin
+  if $generalSearch? then $DomainList := rest $DomainList
+  opform :=
+    which = '"attribute" =>
+      null sig => [op]
+      [op,sig]
+    which = '"constructor" => origin
+    dbGetDisplayFormForOp(op,sig,doc)
+  htSayStandard('"\newline")
+  -----------------------------------------------------------
+  htSaySaturn '"\item["
+  if exactlyOneOpSig
+    then htSay menuButton()
+    else htMakePage
+      [['bcLinks,[menuButton(),'"",chooseFn,which,index]]]
+  htSaySaturn '"]"
+  htSayStandard '"\tab{2}"
+  op   := IFCAR opform
+  args := IFCDR opform
+  ops := escapeSpecialChars STRINGIMAGE op
+  n := #sig
+  do
+    n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
+    n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
+    if unexposed? and $includeUnexposed? then
+      htSayUnexposed()
+    htSay(ops)
+    predicate='ASCONST or GETDATABASE(op,'NILADIC) or member(op,'(0 1)) => 'skip
+    which = '"attribute" and null args => 'skip
+    htSay('"(")
+    if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}")
+    for x in IFCDR args repeat
+      htSay('",{\em ",quickForm2HtString x,'"}")
+    htSay('")")
+  -----------prepare to print description---------------------
+  constring := form2HtString conform
+  conname   := first conform
+  $conkind   : local := htpProperty(htPage,'kind) -- a string e.g. "category"
+			  or STRINGIMAGE GETDATABASE(conname,'CONSTRUCTORKIND)
+  $conlength : local := #constring
+  $conform   : local := conform
+  $conargs   : local := rest conform
+  if which = '"operation" then
+    $signature : local :=
+      MEMQ(conname,$Primitives) => nil
+      CDAR getConstructorModemap conname
+    --RDJ: this next line is necessary until compiler bug is fixed
+    --that forgets to substitute #variables for t#variables;
+    --check the signature for SegmentExpansionCategory, e.g.
+    tvarlist := TAKE(# $conargs,$TriangleVariableList)
+    $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature)
+  $sig :=
+    which = '"attribute" or which = '"constructor" => sig
+    $conkind ^= '"package" => sig
+    symbolsUsed := [x for x in rest conform | IDENTP x]
+    $DomainList := SETDIFFERENCE($DomainList,symbolsUsed)
+    getSubstSigIfPossible sig
+  -----------------------------------------------------------
+  htSaySaturn '"\begin{tabular}{lp{0in}}"
+  -----------------------------------------------------------
+  if member(which,'("operation" "constructor")) then
+    $displayReturnValue: local := nil
+    if args then
+      htSayStandard('"\newline\tab{2}{\em Arguments:}")
+      htSaySaturn '"{\em Arguments:}"
+      htSaySaturnAmpersand()
+      firstTime := true
+      coSig := KDR GETDATABASE(op,'COSIG)  --check if op is constructor
+      for a in args for t in rest $sig repeat
+            if not firstTime then
+              htSaySaturn '"\\ "
+              htSaySaturnAmpersand()
+            firstTime := false
+            htSayIndentRel(15, true)
+            position := KAR relatives
+            relatives := KDR relatives
+            if KAR coSig and t ^= '(Type)
+              then htMakePage [['bcLinks,[a,'"",'kArgPage,a]]]
+              else htSay('"{\em ",form2HtString(a),'"}")
+            htSay ", "
+            coSig := KDR coSig
+            htSayValue t
+            htSayIndentRel(-15,true)
+	    htSayStandard('"\newline ")
+      htSaySaturn '"\\"
+    if first $sig then
+      $displayReturnValue := true
+      htSayStandard('"\newline\tab{2}")
+      htSay '"{\em Returns:}"
+      htSaySaturnAmpersand()
+      htSayIndentRel(15, true)
+      htSayValue first $sig
+      htSayIndentRel(-15, true)
+      htSaySaturn '"\\"
+  -----------------------------------------------------------
+  if origin and ($generalSearch? or origin ^= conform) and op^=opOf origin then
+    htSaySaturn '"{\em Origin:}"
+    htSaySaturnAmpersand()
+    htSayStandard('"\newline\tab{2}{\em Origin:}")
+    htSayIndentRel(15)
+    if not isExposedConstructor opOf origin and $includeUnexposed?
+       then htSayUnexposed()
+    bcConform(origin,true)
+    htSayIndentRel(-15)
+    htSaySaturn '"\\"
+  -----------------------------------------------------------
+  if not MEMQ(predicate,'(T ASCONST)) then
+    pred := sublisFormal(KDR conform,predicate)
+    count := #pred
+    htSaySaturn '"{\em Conditions:}"
+    htSayStandard('"\newline\tab{2}{\em Conditions:}")
+    firstTime := true
+    for p in displayBreakIntoAnds SUBST($conform,"$",pred) repeat
+      if not firstTime then htSaySaturn '"\\"
+      htSayIndentRel(15,count > 1)
+      firstTime := false
+      htSaySaturnAmpersand()
+      bcPred(p,$conform,true)
+      htSayIndentRel(-15,count > 1)
+      htSayStandard('"\newline ")
+    htSaySaturn '"\\"
+  -----------------------------------------------------------
+  if $whereList then
+    count := #$whereList
+    htSaySaturn '"{\em Where:}"
+    htSayStandard('"\newline\tab{2}{\em Where:}")
+    firstTime := true
+    if ASSOC("$",$whereList) then
+      htSayIndentRel(15,true)
+      htSaySaturnAmpersand()
+      htSayStandard '"{\em \$} is "
+      htSaySaturn '"{\em \%} is "
+      htSay
+	$conkind = '"category" => '"of category "
+	'"the domain "
+      bcConform(conform,true,true)
+      firstTime := false
+      htSayIndentRel(-15,true)
+    for [d,key,:t] in $whereList | d ^= "$" repeat
+      htSayIndentRel(15,count > 1)
+      if not firstTime then htSaySaturn '"\\ "
+      htSaySaturnAmpersand()
+      firstTime := false
+      htSay("{\em ",d,"} is ")
+      htSayConstructor(key,sublisFormal(KDR conform,t))
+      htSayIndentRel(-15,count > 1)
+    htSaySaturn '"\\"
+  -----------------------------------------------------------
+  if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then
+    htSaySaturn '"{\em Description:}"
+    htSaySaturnAmpersand()
+    htSayStandard('"\newline\tab{2}{\em Description:}")
+    htSayIndentRel(15)
+    if doc = $charFauxNewline then htSay $charNewline
+    else
+       ndoc:= 
+          -- we are confused whether doc is a string or a list of strings
+          CONSP doc =>  [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc]
+          SUBSTITUTE($charNewline, $charFauxNewline,doc)
+       htSay ndoc 
+--  htSaySaturn '"\\"
+    htSayIndentRel(-15)
+  --------> print abbr and source file for constructors <---------
+  if which = '"constructor" then
+    if (abbr := GETDATABASE(conname,'ABBREVIATION)) then
+      htSaySaturn '"\\"
+      htSaySaturn '"{\em Abbreviation:}"
+      htSaySaturnAmpersand()
+      htSayStandard('"\tab{2}{\em Abbreviation:}")
+      htSayIndentRel(15)
+      htSay abbr
+      htSayIndentRel(-15)
+      htSayStandard('"\newline{}")
+    if ( $saturn and (link := saturnHasExamplePage conname)) then
+      htSaySaturn '"\\"
+      htSaySaturn '"{\em Examples:}"
+      htSaySaturnAmpersand()
+      htSayIndentRel(15)
+      htSay '"\spadref{"
+      htSay CAR(CDR(link))
+      htSay '"}"
+      htSayIndentRel(-15)
+      htSayStandard('"\newline{}")
+    htSaySaturn '"\\"
+    htSaySaturn '"{\em Source File:}"
+    htSaySaturnAmpersand()
+    htSayStandard('"\tab{2}{\em Source File:}")
+    htSayIndentRel(15)
+    htSaySourceFile conname
+    htSayIndentRel(-15)
+  ------------------> remove profile printouts for now <-------------------
+  if $standard and
+    exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then
+      displayInfoOp(htPage,infoAlist,op,sig)
+  -----------------------------------------------------------
+  htSaySaturn '"\end{tabular}"
+
+htSaySourceFile conname ==
+  sourceFileName := (GETDATABASE(conname,'SOURCEFILE) or '"none")
+  filename :=  extractFileNameFromPath sourceFileName
+  htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ",
+              sourceFileName, '" ", conname, '"}"]]
+
+--------------------> NEW DEFINITION (see br-op2.boot.pamphlet)
+htSayIndentRel(n,:options) ==
+  flag := IFCAR options
+  m := ABSVAL n
+  if flag then m := m + 2
+  if $standard then htSayStandard
+    n > 0 =>
+      flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"]
+      ['"\indent{",STRINGIMAGE m,'"}\tab{0}"]
+    n < 0 => ['"\indent{0}\newline "]
+
+htSayUnexposed() ==
+  htSay '"{\em *}"
+  $atLeastOneUnexposed := true
+--=======================================================================
+--                       Page Operations
+--=======================================================================
+
+htEndTabular() ==
+  htSaySaturn '"\end{tabular}"
+
+htPopSaturn s ==
+  pageDescription := ELT($saturnPage, 7)
+  pageDescription is [=s,:b] => SETELT($saturnPage, 7, CDR pageDescription)
+  nil
+
+htBeginTable() ==
+  htSaySaturn '"\begin{dirlist}[lv]"
+  htSayStandard '"\table{"
+
+htEndTable() ==
+  htSaySaturn '"\end{dirlist}"
+  htSayStandard '"}"
+
+htBeginMenu(kind,:options) ==
+  skip := IFCAR options
+  if $saturn then
+    kind = 'description => htSaySaturn '"\begin{description}"
+    htSaySaturn '"\begin{tabular}"
+    htSaySaturn
+      kind = 3 => '"{llp{0in}}"
+      kind = 2 => '"{lp{0in}}"
+      error nil
+  null skip => htSayStandard '"\beginmenu "
+  nil
+
+htEndMenu(kind) ==
+  if $saturn then
+    kind = 'description => htSaySaturn '"\end{description}"
+    htPopSaturn '"\\"
+    htSaySaturn '"\end{tabular}"
+  htSayStandard '"\endmenu "
+
+htSayConstructorName(nameShown, name) ==
+  if $saturn then
+    code := ['"(|conPage| '|", name, '"|)"]
+    htSaySaturn mkDocLink(code,nameShown)
+  if $standard then
+    htSayStandard ["\lispdownlink{",nameShown,'"}{(|conPage| '|",name,'"|)}"]
+
+--------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
+htAddHeading(title) ==
+  htNewPage title
+  page()
+
+------------> called by htAddHeading, htInitPageNoScroll <-----------
+htNewPage title ==
+  if $saturn then
+    htSaySaturn '"\browseTitle{"
+    htSaySaturn title
+    htSaySaturn '"}"
+  if $standard then htSayStandard('"\begin{page}{", htpName $curPage, '"}{")
+  htSayStandard title
+  htSayStandard '"}"
+
+--=======================================================================
+--                       Utilities
+--=======================================================================
+mkTabularItem u == [:first u,:fn rest u] where fn x ==
+  null x => nil
+  [$saturnAmpersand, x,:fn rest x]
+
+htSaySaturnAmpersand() == htSaySaturn $saturnAmpersand
+
+htBlank(:options) ==
+  options is [n] =>
+    htSaySaturn("STRCONC"/['"\phantom{*}" for i in 1..n])
+    htSayStandard STRCONC('"\space{",STRINGIMAGE n,'"}")
+  htSaySaturn '"\phantom{*}"
+  htSayStandard '"\space{1}"
+
+unTab s ==
+  STRINGP s => unTab1 s
+  atom s => s
+  [unTab1 first s, :rest s]
+
+unTab1 s ==
+  STRING_<('"\tab{", s) = 5 and (k := charPosition(char '_}, s, 4)) =>
+      SUBSTRING(s, k + 1, nil)
+  s
+
+satBreak() ==
+  htSaySaturn '"\\ "
+  htSayStandard '"\item "
+
+htBigSkip() ==
+  htSaySaturn '"\bigskip{}"
+  htSayStandard '"\vspace{1}\newline "
+
+htSaturnBreak() == htSaySaturn '"\!"
+
+satDownLink(s,code) ==
+  htSaySaturn '"\lispFunctionLink{\verb!"
+  htSaySaturn code
+  htSaySaturn '"!}{"
+  htSaySaturn s
+  htSaySaturn '"}"
+  ------------------
+  htSayStandard '"\lispdownlink{"
+  htSayStandard s
+  htSayStandard '"}{"
+  htSayStandard code
+  htSayStandard '"}"
+
+satTypeDownLink(s,code) ==
+  htSaySaturn '"\lispLink[d]{\verb!"
+  htSaySaturn code
+  htSaySaturn '"!}{"
+  htSaySaturn s
+  htSaySaturn '"}"
+  ------------------
+  htSayStandard '"\lispdownlink{"
+  htSayStandard s
+  htSayStandard '"}{"
+  htSayStandard code
+  htSayStandard '"}"
+
+mkButtonBox n == STRCONC('"\buttonbox{", STRINGIMAGE n, '"}")
+
+--=======================================================================
+--      Create separate databases for operations, constructors
+--=======================================================================
+-----------> use br-data.boot definition
+--dbSplitLibdb() ==
+--This function splits lidbd.text into files to make searching quicker.
+--  alibdb.text      attributes
+--  clibdb.text      categories
+--  dlibdb.text      domains
+--  plibdb.text      packages
+--  olibdb.text      operations
+--  xlibdb.text      default packages
+--These files have the same format as the single file libdb.text did in old
+--  version: e.g. <key><name>`<args>`<exposure>`<sig>`<args>`<abbrev>`<doc>
+--  for constructors where <key> is a single character, one of acdopx
+--  (identifying it as an attribute, category, domain, operator, package,
+--  or default package), its name, number of arguments, whether exposed or
+--  unexposed, its signature (sometimes abbreviated), its arguments as given
+--  in the original definition, its abbreviation, and documentation.
+--  For example, domain Matrix has line "dMatrix`1`x`<sig>`(R)`MATRIX`<com>"
+--  where <sig> is "(Ring)->Join(MatrixCategory(R,Vector(R),Vector(R)),etc)".
+--  The comment field <com> contains the character address of the comments
+--  for Matrix in file comdb.text.
+--There is thus ONE file comdb.text for documentation of all structures
+--  (to facilitate a general search through all documentation)
+--  into for comments. The format of entries in comdb.text are lines with
+--  two fields of the form d<nnnnn>`<ccccc>, where <nnnnn> is the character
+--  address of the line "dMatrix`.." in dlibdb.text (the first character
+--  "d" tells which lidbdb file it comes from, the <ccccc> is the
+--  documentation for Matrix.
+--NOTE: In each file, the first character, one of acdpox, is retained
+--  so that lines have the same format as the previous version of the browser
+--  (this minimized the number of lines of code that had to be changed from
+--  previous version of the browser).
+--  key := nil    --dummy first key
+--  instream  := MAKE_-INSTREAM  '"libdb.text"
+--  comstream := MAKE_-OUTSTREAM '"comdb.text"
+--  PRINTEXP(0,    comstream)
+--  PRINTEXP($tick,comstream)
+--  PRINTEXP('"",  comstream)
+--  TERPRI(comstream)
+--  while not EOFP instream repeat
+--    line := READLINE instream
+--    comP := FILE_-POSITION comstream
+--    if key ^= line.0 then
+--      if outstream then SHUT outstream
+--      key := line . 0
+--      outstream := MAKE_-OUTSTREAM STRCONC(STRINGIMAGE key,'"libdb.text")
+--    outP := FILE_-POSITION outstream
+--    [prefix,:comments] := dbSplit(line,6,1)
+--    PRINTEXP(prefix,outstream)
+--    PRINTEXP($tick ,outstream)
+--    null comments =>
+--      PRINTEXP(0,outstream)
+--      TERPRI(outstream)
+--    PRINTEXP(comP,outstream)
+--    TERPRI(outstream)
+--    PRINTEXP(key,   comstream)   --identifies file the backpointer is to
+--    PRINTEXP(outP  ,comstream)
+--    PRINTEXP($tick ,comstream)
+--    PRINTEXP(first comments,comstream)
+--    TERPRI(comstream)
+--    for c in rest comments repeat
+--      PRINTEXP(key,   comstream)   --identifies file the backpointer is to
+--      PRINTEXP(outP  ,comstream)
+--      PRINTEXP($tick ,comstream)
+--      PRINTEXP(c, comstream)
+--      TERPRI(comstream)
+--  SHUT instream
+--  SHUT outstream
+--  SHUT comstream
+--OBEY '"rm libdb.text"
+
+dbSort(x,y) ==
+  sin := STRINGIMAGE x
+  sout:= STRINGIMAGE y
+  OBEY STRCONC('"sort -f _"",sin,'".text_" > _"", sout, '".text_"")
+  OBEY STRCONC('"rm ", sin, '".text")
+
+
+--=======================================================================
+--         from define.boot
+--=======================================================================
+----------------------> (override in define.boot.pamphlet)
+compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
+  m,oldE,$prefix,$formalArgList) ==
+    [lineNumber,:specialCases] := specialCases
+    e := oldE
+    --1. bind global variables
+    $form: local
+    $op: local
+    $functionStats: local:= [0,0]
+    $argumentConditionList: local
+    $finalEnv: local
+             --used by ReplaceExitEtc to get a common environment
+    $initCapsuleErrorCount: local:= #$semanticErrorStack
+    $insideCapsuleFunctionIfTrue: local:= true
+    $CapsuleModemapFrame: local:= e
+    $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
+    $insideExpressionIfTrue: local:= true
+    $returnMode:= m
+    [$op,:argl]:= form
+    $form:= [$op,:argl]
+    argl:= stripOffArgumentConditions argl
+    $formalArgList:= [:argl,:$formalArgList]
+
+    --let target and local signatures help determine modes of arguments
+    argModeList:=
+      identSig:= hasSigInTargetCategory(argl,form,first signature,e) =>
+        (e:= checkAndDeclare(argl,form,identSig,e); rest identSig)
+      [getArgumentModeOrMoan(a,form,e) for a in argl]
+    argModeList:= stripOffSubdomainConditions(argModeList,argl)
+    signature':= [first signature,:argModeList]
+    if null identSig then  --make $op a local function
+      oldE := put($op,'mode,['Mapping,:signature'],oldE)
+
+    --obtain target type if not given
+    if null first signature' then signature':=
+      identSig => identSig
+      getSignature($op,rest signature',e) or return nil
+
+    --replace ##1,.. in signature by arguments
+--    pp signature'
+    signature':= SUBLISLIS(argl,$FormalFunctionParameterList,signature')
+--  pp '"------after----"
+--  pp signature'
+    e:= giveFormalParametersValues(argl,e)
+
+    $signatureOfForm:= signature' --this global is bound in compCapsuleItems
+    $functionLocations := [[[$op,$signatureOfForm],:lineNumber],
+      :$functionLocations]
+    e:= addDomain(first signature',e)
+    e:= compArgumentConditions e
+
+    if $profileCompiler then
+      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
+
+
+    --4. introduce needed domains into extendedEnv
+    for domain in signature' repeat e:= addDomain(domain,e)
+
+    --6. compile body in environment with extended environment
+    rettype:= resolve(signature'.target,$returnMode)
+
+    localOrExported :=
+      null member($op,$formalArgList) and
+        getmode($op,e) is ['Mapping,:.] => 'local
+      'exported
+
+    --6a skip if compiling only certain items but not this one
+    -- could be moved closer to the top
+    formattedSig := formatUnabbreviated ['Mapping,:signature']
+    $compileOnlyCertainItems and _
+      not member($op, $compileOnlyCertainItems) =>
+        sayBrightly ['"   skipping ", localOrExported,:bright $op]
+        [nil,['Mapping,:signature'],oldE]
+    sayBrightly ['"   compiling ",localOrExported,
+      :bright $op,'": ",:formattedSig]
+
+    if $newComp = true then
+      wholeBody := ['DEF, form, signature', specialCases, body]
+      T := CATCH('compCapsuleBody, newComp(wholeBody,$NoValueMode,e))
+           or ["",rettype,e]
+      T := [T.expr.2.2, rettype, T.env]
+      if $newCompCompare=true then
+         oldT := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
+              or ["",rettype,e]
+         SAY '"The old compiler generates:"
+         prTriple oldT
+         SAY '"The new compiler generates:"
+         prTriple T
+    else
+      T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
+           or ["",rettype,e]
+--+
+      NRTassignCapsuleFunctionSlot($op,signature')
+      if $newCompCompare=true then
+         SAY '"The old compiler generates:"
+         prTriple T
+--  A THROW to the above CATCH occurs if too many semantic errors occur
+--  see stackSemanticError
+    catchTag:= MKQ GENSYM()
+    fun:=
+      body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
+      body':= addArgumentConditions(body',$op)
+      finalBody:= ["CATCH",catchTag,body']
+      compileCases([$op,["LAM",[:argl,'_$],finalBody]],oldE)
+    $functorStats:= addStats($functorStats,$functionStats)
+
+
+--  7. give operator a 'value property
+    val:= [fun,signature',e]
+    [fun,['Mapping,:signature'],oldE] -- oldE:= put($op,'value,removeEnv val,e)
+
+--from postpar
+--------------------> NEW DEFINITION (override in postpar.boot.pamphlet)
+postSignature ['Signature,op,sig] ==
+  sig is ["->",:.] =>
+    sig1:= postType sig
+    op:= postAtom (STRINGP op => INTERN op; op)
+    ["SIGNATURE",op,:removeSuperfluousMapping killColons postDoubleSharp sig1]
+
+postDoubleSharp sig ==
+  sig is [['Mapping,target,:r]] =>
+    -- replace #1,... by ##1,...
+    [['Mapping, SUBLISLIS($FormalFunctionParameterList, $FormalMapVariableList, target),
+        :r]]
+  sig
+
+-- override in  br-util.boot.pamphlet
+bcConform1 form == main where
+  main ==
+    form is ['ifp,form1,:pred] =>
+      hd form1
+      bcPred pred
+    hd form
+  hd form ==
+    atom form =>
+      not MEMQ(form,$Primitives) and null constructor? form =>
+        s := STRINGIMAGE form
+        (s.0 = char '_#) =>
+           (n := POSN1(form, $FormalFunctionParameterList)) =>
+              htSay form2HtString ($FormalMapVariableList . n)
+           htSay '"\"
+           htSay form
+        htSay escapeSpecialChars STRINGIMAGE form
+      s := STRINGIMAGE form
+      $italicHead? => htSayItalics s
+      $bcMultipleNames =>
+        satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"])
+      satTypeDownLink(s, ["(|conPage| '|",s,'"|)"])
+    (head := QCAR form) = 'QUOTE =>
+      htSay('"'")
+      hd CADR form
+    head = 'SIGNATURE =>
+      htSay(CADR form,'": ")
+      mapping CADDR form
+    head = 'Mapping and rest form => rest form => mapping rest form
+    head = ":" =>
+      hd CADR form
+      htSay '": "
+      hd CADDR form
+    QCDR form and dbEvalableConstructor? form
+       => bcConstructor(form,head)
+    hd head
+    null (r := QCDR form) => nil
+    tl QCDR form
+  mapping [target,:source] ==
+    tuple source
+    bcHt
+      $saturn => '" {\ttrarrow} "
+      '" -> "
+    hd target
+  tuple u ==
+    null u => bcHt '"()"
+    null rest u => hd u
+    bcHt '"("
+    hd first u
+    for x in rest u repeat
+      bcHt '","
+      hd x
+    bcHt '")"
+  tl u ==
+    bcHt '"("
+    firstTime := true
+    for x in u repeat
+      if not firstTime then bcHt '","
+      firstTime := false
+      hd x
+    bcHt '")"
+  say x ==
+    if $italics? then bcHt '"{\em "
+    if x = 'etc then x := '"..."
+    bcHt escapeSpecialIds STRINGIMAGE x
+    if $italics? then bcHt '"}"
+
+--=======================================================================
+--            Code for Private Libdbs
+--=======================================================================
+--extendLocalLibdb conlist ==     --called by function "compiler"(see above)
+--  buildLibdb conlist          --> puts datafile into temp.text
+--  $newConstructorList := union(conlist, $newConstructorList)
+--  localLibdb := '"libdb.text"
+--  not isExistingFile '"libdb.text" => RENAME_-FILE('"temp.text",'"libdb.text")
+--  oldlines := purgeNewConstructorLines(dbReadLines localLibdb, conlist)
+--  newlines := dbReadLines '"temp.text"
+--  dbWriteLines(MSORT union(oldlines,newlines), '"libdb.text")
+--  deleteFile '"temp.text"
+
+purgeNewConstructorLines(lines, conlist) ==
+  [x for x in lines | not screenLocalLine(x, conlist)]
+
+-- Got rid of debugging statement and deleted screenLocalLine1, MCD 26/3/96
+--screenLocalLine(line,conlist) ==
+--  u := screenLocalLine1(line,conlist)
+--  if u then
+--    sayBrightly ['"Purging--->", line]
+--  u
+
+-- screenLocalLine1(line, conlist) ==
+screenLocalLine(line, conlist) ==
+  k := dbKind line
+  con := INTERN
+    k = char 'o or k = char 'a =>
+      s := dbPart(line,5,1)
+      k := charPosition(char '_(,s,1)
+      SUBSTRING(s,1,k - 1)
+    dbName line
+  MEMQ(con, conlist)
+
+--------------> NEW DEFINITION (see br-data.boot.pamphlet)
+purgeLocalLibdb() ==   --called by the user through a clear command?
+  $newConstructorList := nil
+  deleteFile '"libdb.text"
+
+--moveFile(before,after) ==
+--  $saturn => MOVE_-FILE(before, after)
+--  RENAME_-FILE(before, after)
+--  --obey STRCONC('"mv ", before, '" ", after)
+
+-- deleted JHD/MCD, since already one in pathname.boot
+--deleteFile fn ==
+--  $saturn => DELETE_-FILE fn
+--  obey STRCONC('"rm ",fn)
+
+--=======================================================================
+--            from DAASE.LISP
+--=======================================================================
+--library(args) ==
+--  $newConlist: local := nil
+--  LOCALDATABASE(args,$options)
+--  extendLocalLibdb $newConlist
+--  TERSYSCOMMAND()
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-search.boot.pamphlet b/src/interp/br-search.boot.pamphlet
new file mode 100644
index 00000000..f886a96a
--- /dev/null
+++ b/src/interp/br-search.boot.pamphlet
@@ -0,0 +1,1040 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-search.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS b-search.boot <================================
+
+--=======================================================================
+--              Grepping Database libdb.text
+-- Redone 12/95 for Saturn; previous function grep renamed as grepFile
+-- This function now either returns a filename or a list of strings
+--=======================================================================
+grepConstruct(s,key,:options) == --key = a o c d p x k (all) . (aok) w (doc)
+--Called from genSearch with key = "." and "w"
+--key = "." means a o c d p x
+--option1 = true means return the result as a file
+--All searches of the database call this function to get relevant lines
+--from libdb.text. Returns either a list of lines (usual case) or else
+--an alist of the form ((kind . <list of lines for that kind>) ...)
+  $localLibdb : local := fnameExists? '"libdb.text" and '"libdb.text"
+  lines := grepConstruct1(s,key)
+  IFCAR options => grepSplit(lines,key = 'w)    --leave now if a constructor
+  MEMQ(key,'(o a)) => dbScreenForDefaultFunctions lines --kill default lines if a/o
+  lines
+
+grepConstruct1(s,key) ==
+--returns the name of file (WITHOUT .text.$SPADNUM on the end)
+  $key     : local := key
+  if key = 'k and          --convert 'k to 'y if name contains an "&"
+    or/[s . i = char '_& for i in 0..MAXINDEX s] then key := 'y
+  filter := pmTransFilter STRINGIMAGE s  --parses and-or-not form
+  filter is ['error,:.] => filter        --exit on parser error
+  pattern := mkGrepPattern(filter,key)  --create string to pass to "grep"
+  grepConstructDo(pattern, key)  --do the "grep"---see b-saturn.boot
+
+grepConstructDo(x, key) ==
+  $orCount := 0
+--atom x => grepFile(x, key,'i)
+  $localLibdb =>
+    oldLines := purgeNewConstructorLines(grepf(x,key,false),$newConstructorList)
+    newLines := grepf(x,$localLibdb,false)
+    union(oldLines, newLines)
+  grepf(x,key,false)
+
+dbExposed?(line,kind) == -- does line come from an unexposed constructor?
+  conname := INTERN
+    kind = char 'a or kind = char 'o => dbNewConname line --get conname from middle
+    dbName line
+  isExposedConstructor conname
+
+dbScreenForDefaultFunctions lines == [x for x in lines | not isDefaultOpAtt x]
+
+isDefaultOpAtt x == x.(1 + dbTickIndex(x,4,0)) = char 'x
+
+grepForAbbrev(s,key) ==
+--checks that filter s is not * and is all uppercase; if so, look for abbrevs
+  u := HGET($lowerCaseConTb,s) => ['Abbreviations,u]    --try cheap test first
+  s := STRINGIMAGE s
+  someLowerCaseChar := false
+  someUpperCaseChar := false
+  for i in 0..MAXINDEX s repeat
+    c := s . i
+    LOWER_-CASE_-P c => return (someLowerCaseChar := true)
+    UPPER_-CASE_-P c => someUpperCaseChar := true
+  someLowerCaseChar or not someUpperCaseChar => false
+  pattern := DOWNCASE s
+  ['Abbreviations ,:[GETDATABASE(x,'CONSTRUCTORFORM)
+    for x in allConstructors() | test]] where test ==
+         not $includeUnexposed? and not isExposedConstructor x => false
+         a := GETDATABASE(x,'ABBREVIATION)
+         match?(pattern,PNAME a) and not HGET($defaultPackageNamesHT,x)
+
+applyGrep(x,filename) ==   --OBSELETE with $saturn--> see applyGrepSaturn
+  atom x => grepFile(x,filename,'i)
+  $localLibdb =>
+    a := purgeNewConstructorLines(grepf(x,filename,false),$newConstructorList)
+    b := grepf(x,$localLibdb,false)
+    grepCombine(a,b)
+  grepf(x,filename,false)
+
+grepCombine(a,b) == MSORT union(a,b)
+
+grepf(pattern,s,not?) ==  --s=sourceFile or list of strings
+  pattern is [op,:argl] =>
+    op = "and" =>
+      while argl is [arg,:argl] repeat
+        s := grepf(arg,s,not?)  -- filter by successive greps
+      s
+    op = "or" =>
+      targetStack := nil
+      "union"/[grepf(arg,s,not?) for arg in argl]
+    op = "not" =>
+      not? => grepf(first argl,s,false)
+      --could be the first time so have to get all of same $key
+      lines := grepf(mkGrepPattern('"*",$key),s,false)
+      grepf(first argl,lines,true)
+    systemError nil
+  option :=
+    not? => 'iv
+    'i
+  source :=
+    LISTP s => dbWriteLines s
+    s
+  grepFile(pattern,source,option)
+
+pmTransFilter s ==
+--result is either a string or (op ..) where op= and,or,not and arg are results
+  if $browseMixedCase = true then s := DOWNCASE s
+  or/[isFilterDelimiter? s.i or s.i = $charUnderscore for i in 0..MAXINDEX s]
+    => (parse := pmParseFromString s) and checkPmParse parse or
+        ['error,'"Illegal search string",'"\vspace{3}\center{{\em Your search string} ",escapeSpecialChars s,'" {\em has incorrect syntax}}"]
+  or/[s . i = char '_* and s.(i + 1) = char '_*
+      and (i=0 or s . (i - 1) ^= char $charUnderscore) for i in 0..(MAXINDEX s - 1)]
+       => ['error,'"Illegal search string",'"\vspace{3}\center{Consecutive {\em *}'s are not allowed in search patterns}"]
+  s
+
+checkPmParse parse ==
+  STRINGP parse => parse
+  fn parse => parse where fn(u) ==
+    u is [op,:args] =>
+      MEMQ(op,'(and or not)) and and/[checkPmParse x for x in args]
+    STRINGP u => true
+    false
+  nil
+
+dnForm x ==
+  STRINGP x => x
+  x is ['not,argl] =>
+    argl is ['or,:orargs]=>
+       ['and, :[dnForm negate u for u in orargs]] where negate s ==
+          s is ['not,argx] => argx
+          ['not,s]
+    argl is ['and,:andargs]=>
+       ['or,:[dnForm negate u for u in andargs]]
+    argl is ['not,notargl]=>
+       dnForm notargl
+    x
+  x is ['or,:argl1] => ['or,:[dnForm u for u in argl1]]
+  x is ['and,:argl2] => ['and,:[dnForm u for u in argl2]]
+  x
+
+pmParseFromString s ==
+  u := ncParseFromString pmPreparse s
+  dnForm flatten u where flatten s ==
+    s is [op,:argl] =>
+      STRINGP op => STRCONC(op,"STRCONC"/[STRCONC('" ",x) for x in argl])
+      [op,:[flatten x for x in argl]]
+    s
+
+pmPreparse s == hn fn(s,0,#s) where--stupid insertion of chars to get correct parse
+  hn x == SUBLISLIS('(and or not),'("and" "or" "not"),x)
+  fn(s,n,siz) ==  --main function: s is string, n is origin
+    n = siz => '""
+    i := firstNonDelim(s,n) or return SUBSTRING(s,n,nil)
+    j := firstDelim(s,i + 1) or siz
+    t := gn(s,i,j - 1)
+    middle :=
+      member(t,'("and" "or" "not")) => t
+      --the following 2 lines make commutative("*") parse correctly!!!!
+      t.0 = char '_" => t
+      j < siz - 1 and s.j = char '_( => t
+      STRCONC(char '_",t,char '_")
+    STRCONC(SUBSTRING(s,n,i - n),middle,fn(s,j,siz))
+  gn(s,i,j) ==    --replace each underscore by 4 underscores!
+    n := or/[k for k in i..j | s.k = $charUnderscore] =>
+      STRCONC(SUBSTRING(s,i,n - i + 1),$charUnderscore,gn(s,n + 1,j))
+    SUBSTRING(s,i,j - i + 1)
+
+firstNonDelim(s,n) ==  or/[k for k in n..MAXINDEX s | not isFilterDelimiter? s.k]
+firstDelim(s,n) ==  or/[k for k in n..MAXINDEX s | isFilterDelimiter? s.k]
+
+isFilterDelimiter? c == MEMQ(c,$pmFilterDelimiters)
+
+grepSplit(lines,doc?) ==
+  if doc? then
+    instream2 := OPEN STRCONC(getEnv '"AXIOM",'"/algebra/libdb.text")
+  cons := atts := doms := nil
+  while lines is [line, :lines] repeat
+    if doc? then
+        N:=PARSE_-INTEGER dbPart(line,1,-1)
+        if NUMBERP N then 
+           FILE_-POSITION(instream2,N)
+           line := READLINE instream2
+    kind := dbKind line
+    not $includeUnexposed? and not dbExposed?(line,kind) => 'skip
+    (kind = char 'a or kind = char 'o) and isDefaultOpAtt line => 'skip
+    PROGN
+      kind = char 'c => cats := insert(line,cats)
+      kind = char 'd => doms := insert(line,doms)
+      kind = char 'x => defs := insert(line,defs)
+      kind = char 'p => paks := insert(line,paks)
+      kind = char 'a => atts := insert(line,atts)
+      kind = char 'o => ops :=  insert(line,ops)
+      kind = char '_- => 'skip                --for now
+      systemError 'kind
+  if doc? then CLOSE instream2
+  [['"attribute",:NREVERSE atts],
+     ['"operation",:NREVERSE ops],
+       ['"category",:NREVERSE cats],
+         ['"domain",:NREVERSE doms],
+           ['"package",:NREVERSE paks]
+--           ['"default_ package",:NREVERSE defs]   -- drop defaults
+               ]
+
+mkUpDownPattern s == recurse(s,0,#s) where
+  recurse(s,i,n) ==
+    i = n => '""
+    STRCONC(fixchar(s.i),recurse(s,i + 1,n))
+  fixchar(c) ==
+    ALPHA_-CHAR_-P c =>
+      STRCONC(char '_[,CHAR_-UPCASE c,CHAR_-DOWNCASE c,char '_])
+    c
+
+mkGrepPattern(s,key) ==
+  --called by grepConstruct1 and grepf
+  atom s => mkGrepPattern1(s,key)
+  [first s,:[mkGrepPattern(x,key) for x in rest s]]
+
+mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?)
+  $options : local := options
+  s := STRINGIMAGE x
+--s := DOWNCASE STRINGIMAGE x
+  addOptions remUnderscores addWilds split(g s,char '_*) where
+    addWilds sl ==    --add wild cards (sl is list of parts between *'s)
+      IFCAR sl = '"" => h(IFCDR sl,[$wild1])
+      h(sl,nil)
+    g s  ==    --remove "*"s around pattern for text match
+      not MEMQ('w,$options) => s
+      if s.0 = char '_* then s := SUBSTRING(s,1,nil)
+      if s.(k := MAXINDEX s) = char '_* then s := SUBSTRING(s,0,k)
+      s
+    h(sl,res) == --helper for wild cards
+      sl is [s,:r] => h(r,[$wild1,s,:res])
+      res := rest res
+      if not MEMQ('w,$options) then
+        if first res ^= '"" then res := ['"`",:res]
+        else if res is [.,p,:r] and p = $wild1 then res := r
+      "STRCONC"/NREVERSE res
+    remUnderscores s ==
+      (k := charPosition(char $charUnderscore,s,0)) < MAXINDEX s =>
+        STRCONC(SUBSTRING(s,0,k),'"[",s.(k + 1),'"]",
+                remUnderscores(SUBSTRING(s,k + 2,nil)))
+      s
+    split(s,char) ==
+      max := MAXINDEX s + 1
+      f := -1
+      [SUBSTRING(s,i,f-i)
+        while ((i := f + 1) <= max) and (f := charPosition(char,s,i))]
+    charPosition(c,t,startpos) ==  --honors underscores
+      n := SIZE t
+      if startpos < 0 or startpos > n then error "index out of range"
+      k:= startpos
+      for i in startpos .. n-1 while c ^= ELT(t,i)
+        or i > startpos and ELT(t,i-1) = '__ repeat  (k := k+1)
+      k
+    addOptions s ==  --add front anchor
+      --options a o c d p x   denote standard items
+      --options w             means  comments
+      --option  t             means  text
+      --option  s             means  signature
+      --option  n             means  number of arguments
+      --option  i             means  predicate
+      --option  none          means  NO PREFIX
+      one := ($options is [x,:$options] and x => x; '"[^x]")
+      tick := '"[^`]*`"
+      one = 'w => s
+      one = 'none => (s = '"`" => '"^."; STRCONC('"^",s))
+      prefix :=
+        one = 't => STRCONC(tick,tick,tick,tick,tick,".*")
+        one = 'n => tick
+        one = 'i => STRCONC(tick,tick,tick,tick)
+        one = 's => STRCONC(tick,tick,tick)
+--      true => '""    ----> never put on following prefixes
+        one = 'k => '"[cdp]"
+        one = 'y => '"[cdpx]"
+        STRINGIMAGE one
+      s = $wild1 => STRCONC('"^",prefix)
+      STRCONC('"^",prefix,s)
+
+conform2OutputForm(form) ==
+  [op,:args] := form
+  null args => form
+  cosig := rest GETDATABASE(op,'COSIG)
+  atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  sargl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    pp [x,atype,pred]
+    pred => conform2OutputForm x
+    typ := sublisFormal(args,atype)
+    if x is ['QUOTE,a] then x := a
+    algCoerceInteractive(x,typ,'(OutputForm))
+  [op,:sargl]
+
+oPage(a,:b) == --called by \spadfun{opname}
+  oSearch (IFCAR b or a) --always take slow path
+
+oPageFrom(opname,conname) == --called by \spadfunFrom{opname}{conname}
+  htPage := htInitPage(nil,nil) --create empty page and fill in needed properties
+  htpSetProperty(htPage,'conform,conform := getConstructorForm conname)
+  htpSetProperty(htPage,'kind,STRINGIMAGE GETDATABASE(conname,'CONSTRUCTORKIND))
+  itemlist := ASSOC(opname,koOps(conform,nil)) --all operations name "opname"
+  null itemlist => systemError [conform,'" has no operation named ",opname]
+  opAlist := [itemlist]
+  dbShowOperationsFromConform(htPage,'"operation",opAlist)
+
+aPage(a,:b) ==  --called by \spadatt{a}
+  $attributeArgs : local := nil
+  arg := IFCAR b or a
+  s   := pmParseFromString STRINGIMAGE arg
+  searchOn :=
+    ATOM s => s
+    IFCAR s
+  $attributeArgs : local := IFCAR IFCDR s
+  aSearch searchOn
+--must recognize that not all attributes can be found in database
+--e.g. constant(deriv) is not but appears in a conditional in LODO
+
+spadType(x) ==  --called by \spadtype{x} from HyperDoc
+  s := PNAME x
+  form := ncParseFromString s or
+            systemError ['"Argument: ",s,'" to spadType won't parse"]
+  if atom form then form := [form]
+  op    := opOf form
+  looksLikeDomainForm form => APPLY(function conPage,form)
+  conPage(op)
+
+looksLikeDomainForm x ==
+  entry := getCDTEntry(opOf x,true) or return false
+  coSig := LASSOC('coSig,CDDR entry)
+  k := #coSig
+  atom x => k = 1
+  k ^= #x => false
+  and/[p for key in rest coSig for arg in rest x] where
+    p ==
+      key => looksLikeDomainForm arg
+      not IDENTP arg
+
+spadSys(x) ==   --called by \spadsyscom{x}
+  s := PNAME x
+  if s.0 = char '_) then s := SUBSTRING(s,1,nil)
+  form := ncParseFromString s or
+           systemError ['"Argument: ",s,'" to spadType won't parse"]
+  htSystemCommands PNAME opOf form
+
+--=======================================================================
+--                   Name and General Search
+--=======================================================================
+aokSearch filter ==  genSearch(filter,true)  --"General" from HD (see man0.ht)
+--General search for constructs but NOT documentation
+
+genSearch(filter,:options) == --"Complete" from HD (see man0.ht) and aokSearch
+--General + documentation search
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => htErrorStar()
+  includeDoc? := not IFCAR options
+--give summaries for how many a o c d p x match filter
+  regSearchAlist := grepConstruct(STRINGIMAGE filter,".",true)
+  regSearchAlist is ['error,:.] => bcErrorPage regSearchAlist
+  key := removeSurroundingStars filter
+  if includeDoc? then
+    docSearchAlist := grepConstruct(key,'w,true)
+    docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist
+    docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x]--drop defaults
+  genSearch1(filter,genSearchTran regSearchAlist,genSearchTran docSearchAlist)
+
+genSearchTran alist == [[x,y,:y] for [x,:y] in alist]
+
+
+genSearch1(filter,reg,doc) ==
+  regSearchAlist := searchDropUnexposedLines reg
+  docSearchAlist := searchDropUnexposedLines doc
+  key := removeSurroundingStars filter
+  regCount := searchCount regSearchAlist
+  docCount := searchCount docSearchAlist
+  count := regCount + docCount
+  count = 0 => emptySearchPage('"entry",filter,true)
+  count = 1 =>
+    alist := (regCount = 1 => regSearchAlist; docSearchAlist)
+    showNamedConstruct(or/[x for x in alist | CADR x])
+  summarize? :=
+    docSearchAlist => true
+    nonEmpties := [pair for pair in regSearchAlist | #(CADR pair) > 0]
+    not(nonEmpties is [pair])
+  not summarize? => showNamedConstruct pair
+  -----------generate a summary page---------------------------
+  plural :=
+    $exposedOnlyIfTrue => '"exposed entries match"
+    '"entries match"
+  prefix := pluralSay(count,'"", plural)
+  emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
+  header := [:prefix,'" ",:emfilter]
+  page := htInitPage(header,nil)
+  htpSetProperty(page,'regSearchAlist,regSearchAlist)
+  htpSetProperty(page,'docSearchAlist,docSearchAlist)
+  htpSetProperty(page,'filter,filter)
+  if docSearchAlist then
+      dbSayItems(['"{\bf Construct Summary:} ",regCount],'"name matches",'"names match")
+  for [kind,:pair] in regSearchAlist for i in 0.. | #(first pair) > 0 repeat
+    bcHt '"\newline{}"
+    htSayStandard '"\tab{2}"
+    genSearchSay(pair,summarize?,kind,i,'showConstruct)
+  if docSearchAlist then
+    htSaySaturn '"\bigskip{}"
+    dbSayItems(['"\newline{\bf Documentation Summary:} ",docCount],'"mention",'"mentions",'" of {\em ",key,'"}")
+    for [kind,:pair] in docSearchAlist for i in 0.. | #(first pair) > 0 repeat
+      bcHt "\newline{}"
+      htSayStandard '"\tab{2}"
+      genSearchSay(pair,true,kind,i,'showDoc)
+  htShowPageStar()
+searchDropUnexposedLines alist ==
+  [[op,[pred for line in lines | pred],:lines] for [op,.,:lines] in alist] where
+    pred ==
+      not $exposedOnlyIfTrue or dbExposed?(line,dbKind line) => line
+      nil
+
+htShowPageStar() ==
+------------> OBSELETE
+  htSayStandard '"\endscroll "
+  if $exposedOnlyIfTrue then
+    htMakePage [['bcLinks,['"Exposed",'" {\em only}",'repeatSearch,NIL]]]
+  else
+    htSay('"*{\em =}")
+    htMakePage [['bcLinks,['"unexposed",'"",'repeatSearch,'T]]]
+  htShowPageNoScroll()
+
+repeatSearch(htPage,newValue) ==
+  $exposedOnlyIfTrue := newValue
+  filter := htpProperty(htPage,'filter)
+  reg    := htpProperty(htPage,'regSearchAlist)
+  doc    := htpProperty(htPage,'docSearchAlist)
+  reg => genSearch1(filter,reg,doc)
+  docSearch1(filter,doc)
+
+searchCount u == +/[# y for [x,y,:.] in u]
+
+showDoc(htPage,count) ==
+  showIt(htPage,count,htpProperty(htPage,'docSearchAlist))
+
+showConstruct(htPage,count) ==
+  showIt(htPage,count,htpProperty(htPage,'regSearchAlist))
+
+showIt(htPage,index,searchAlist) ==
+  filter      := htpProperty(htPage,'filter)
+  [relativeIndex,n] := DIVIDE(index,8)
+  relativeIndex = 0 => showNamedConstruct(searchAlist.n)
+  [kind,items,:.] := searchAlist . n
+  for j in 1.. while j < relativeIndex repeat items := rest items
+  firstName := dbName first items --select name then gather all of same name
+  lines := [line for line in items while dbName line = firstName]
+  showNamedConstruct [kind,nil,:lines]
+
+showNamedConstruct([kind,.,:lines]) == dbSearch(lines,kind,'"")
+
+genSearchSay(pair,summarize,kind,who,fn) ==
+  [u,:fullLineList] := pair
+  count := #u
+  uniqueCount := genSearchUniqueCount u
+  short := summarize and uniqueCount >= $browseCountThreshold
+  htMakePage
+    [['bcLinks,[menuButton(),'"",'genSearchSayJump,[fullLineList,kind]]]]
+  if count = 0 then htSay('"{\em No ",kind,'"} ")
+  else if count = 1 then
+    htSay('"{\em 1 ",kind,'"} ")
+  else
+    htSay('"{\em ",count,'" ",pluralize kind,'"} ")
+  short => 'done	
+  if uniqueCount ^= 1 then
+    htSayStandard '"\indent{4}"
+    htSay '"\newline "
+    htBeginTable()
+  lastid := nil
+  groups := organizeByName u
+  i := 1
+  for group in groups repeat
+    id := dbGetName first group
+    if $includeUnexposed? then
+      exposed? := or/[dbExposed?(item,dbKind item) for item in group]
+    bcHt '"{"
+    if $includeUnexposed? then
+        exposed? => htBlank()
+        htSayUnexposed()
+    htMakePage [['bcLinks, [id,'"",fn,who + 8*i]]]
+    i := i + #group
+    bcHt '"}"
+  if uniqueCount ^= 1 then
+     htEndTable()
+     htSayStandard '"\indent{0}"
+
+organizeByName u ==
+  [[(u := rest u; x) while u and head = dbName (x := first u)]
+      while u and (head := dbName first u)]
+
+genSearchSayJump(htPage,[lines,kind]) ==
+  filter := htpProperty(htPage,'filter)
+  dbSearch(lines,kind,filter)
+
+genSearchUniqueCount(u) ==
+--count the unique number of items (if less than $browseCountThreshold)
+  count := 0
+  lastid := nil
+  for item in u while count < $browseCountThreshold repeat
+    id := dbGetName item
+    if id ^= lastid then
+      count := count + 1
+      lastid := id
+  count
+
+dbGetName line == SUBSTRING(line,1,charPosition($tick,line,1) - 1)
+
+pluralSay(count,singular,plural,:options) ==
+  item := (options is [x,:options] => x; '"")
+  colon := (IFCAR options => '":"; '"")
+  count = 0 => concat('"No ",singular,item)
+  count = 1 => concat('"1 ",singular,item,colon)
+  concat(count,'" ",plural,item,colon)
+
+
+--=======================================================================
+--                   Documentation Search
+--=======================================================================
+docSearch filter ==  --"Documentation" from HD (see man0.ht)
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => htErrorStar()
+  key := removeSurroundingStars filter
+  docSearchAlist := grepConstruct(filter,'w,true)
+  docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist
+  docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x] --drop defaults
+  docSearch1(filter,genSearchTran docSearchAlist)
+
+docSearch1(filter,doc) ==
+  docSearchAlist := searchDropUnexposedLines doc
+  count := searchCount docSearchAlist
+  count = 0 => emptySearchPage('"entry",filter,true)
+  count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x],1)
+  prefix := pluralSay(count,'"entry matches",'"entries match")
+  emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
+  header := [:prefix,'" ",:emfilter]
+  page := htInitPage(header,nil)
+  htpSetProperty(page,'docSearchAlist,docSearchAlist)
+  htpSetProperty(page,'regSearchAlist,nil)
+  htpSetProperty(page,'filter,filter)
+  dbSayItems(['"\newline Documentation Summary: ",count],'"mention",'"mentions",'" of {\em ",filter,'"}")
+  for [kind,:pair] in docSearchAlist for i in 0.. | #(first pair) > 0 repeat
+    bcHt '"\newline{}"
+    htSayStandard '"\tab{2}"
+    genSearchSay(pair,true,kind,i,'showDoc)
+  htShowPageStar()
+
+removeSurroundingStars filter ==
+  key := STRINGIMAGE filter
+  if key.0 = char '_* then key := SUBSTRING(key,1,nil)
+  if key.(max := MAXINDEX key) = char '_* then key := SUBSTRING(key,0,max)
+  key
+
+showNamedDoc([kind,:lines],index) ==
+  dbGather(kind,lines,index - 1,true)
+
+sayDocMessage message ==
+  htSay('"{\em ")
+  if message is [leftEnd,left,middle,right,rightEnd] then
+    htSay(leftEnd,left,'"}")
+    if left ^= '"" and left.(MAXINDEX left) = $blank then htBlank()
+    htSay middle
+    if right ^= '"" and right.0 = $blank then htBlank()
+    htSay('"{\em ",right,rightEnd)
+  else
+    htSay message
+  htSay ('"}")
+
+stripOffSegments(s,n) ==
+  progress := true
+  while n > 0 and progress = true repeat
+    n := n - 1
+    k := charPosition(char '_`,s,0)
+    new := SUBSTRING(s,k + 1,nil)
+    #new < #s => s := new
+    progress := false
+  n = 0 => s
+  nil
+
+replaceTicksBySpaces s ==
+  n := -1
+  max := MAXINDEX s
+  while (n := charPosition(char '_`,s,n + 1)) <= max repeat SETELT(s,n,char '_ )
+  s
+
+checkFilter filter ==
+  filter := STRINGIMAGE filter
+  filter = '"" => '"*"
+  trimString filter
+
+aSearch filter ==  --called from HD (man0.ht): general attribute search
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  dbSearch(grepConstruct(filter,'a),'"attribute",filter)
+
+oSearch filter == -- called from HD (man0.ht): operation search
+  opAlist := opPageFastPath filter => opPageFast opAlist
+  key := 'o
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => grepSearchQuery('"operation",[filter,key,'"operation",'oSearchGrep])
+  oSearchGrep(filter,key,'"operation")
+
+oSearchGrep(filter,key,kind) == --called from grepSearchQuery/oSearch
+  dbSearch(grepConstruct(filter,'o),kind,filter)
+
+grepSearchQuery(kind,items) ==
+  page := htInitPage('"Query Page",nil)
+  htpSetProperty(page,'items,items)
+  htQuery(['"{\em Do you want a list of {\em all} ",pluralize kind,'"?\vspace{1}}"],'grepSearchJump,true)
+  htShowPage()
+
+cSearch filter ==  --called from HD (man0.ht): category search
+   constructorSearch(checkFilter filter,'c,'"category")
+
+dSearch filter ==  --called from HD (man0.ht): domain search
+   constructorSearch(checkFilter filter,'d,'"domain")
+
+pSearch filter ==  --called from HD (man0.ht): package search
+   constructorSearch(checkFilter filter,'p,'"package")
+
+xSearch filter ==  --called from HD (man0.ht): default package search
+   constructorSearch(checkFilter filter,'x,'"default package")
+
+kSearch filter ==  --called from HD (man0.ht): constructor search (no defaults)
+   constructorSearch(checkFilter filter,'k,'"constructor")
+
+ySearch filter == --called from conPage: like kSearch but defaults included
+  constructorSearch(checkFilter filter,'y,'"constructor")
+
+constructorSearch(filter,key,kind) ==
+  null filter => nil      --in case of filter error
+  (parse := conSpecialString? filter) => conPage parse
+  pageName := LASSOC(DOWNCASE filter,'(("union" . DomainUnion)("record" . DomainRecord)("mapping" . DomainMapping) ("enumeration" . DomainEnumeration))) =>
+    downlink pageName
+  name := (STRINGP filter => INTERN filter; filter)
+  if u := HGET($lowerCaseConTb,name) then filter := STRINGIMAGE first u
+  line := conPageFastPath DOWNCASE filter =>
+    code := dbKind line
+    newkind :=
+      code = char 'p => '"package"
+      code = char 'd => '"domain"
+      code = char 'c => '"category"
+      nil
+    kind = '"constructor" or kind = newkind => kPage line
+    page := htInitPage('"Query Page",nil)
+    htpSetProperty(page,'line,line)
+    message :=
+      ['"{\em ",dbName line,'"} is not a {\em ",kind,'"} but a {\em ",
+        newkind,'"}. Would you like to view it?\vspace{1}"]
+    htQuery(message, 'grepConstructorSearch,true)
+    htShowPage()
+  filter = '"*" => grepSearchQuery(kind,[filter,key,kind,'constructorSearchGrep])
+  constructorSearchGrep(filter,key,kind)
+
+grepConstructorSearch(htPage,yes) == kPage htpProperty(htPage,'line)
+
+conSpecialString?(filter,:options) ==
+  secondTime := IFCAR options
+  parse :=
+    words := string2Words filter is [s] => ncParseFromString s
+    and/[not member(x,'("and" "or" "not")) for x in words] => ncParseFromString filter
+    false
+  null parse => nil
+  form := conLowerCaseConTran parse
+  MEMQ(KAR form,'(and or not)) or CONTAINED("*",form) => nil
+  filter = '"Mapping" =>nil
+  u := kisValidType form => u
+  secondTime => false
+  u := "STRCONC"/[string2Constructor x for x in dbString2Words filter]
+  conSpecialString?(u, true)
+
+dbString2Words l ==
+  i := 0
+  [w while dbWordFrom(l,i) is [w,i]]
+
+$dbDelimiters := [char " " , char "(", char ")"]
+
+dbWordFrom(l,i) ==
+  maxIndex := MAXINDEX l
+  while maxIndex >= i and l.i = char " " repeat i := i + 1
+  if maxIndex >= i and member(l.i, $dbDelimiters) then return [l.i, i + 1]
+  k := or/[j for j in i..maxIndex | not member(l.j, $dbDelimiters)] or return nil
+  buf := '""
+  while k <= maxIndex and not member(c := l.k, $dbDelimiters) repeat
+    ch :=
+      c = char '__   => l.(k := 1+k)  --this may exceed bounds
+      c
+    buf := STRCONC(buf,ch)
+    k := k + 1
+  [buf,k]
+
+conLowerCaseConTran x ==
+  IDENTP x => IFCAR HGET($lowerCaseConTb, x) or x
+  atom x   => x
+  [conLowerCaseConTran y for y in x]
+
+string2Constructor x ==
+  not STRINGP x => x
+  IFCAR HGET($lowerCaseConTb, INTERN DOWNCASE x) or x
+
+conLowerCaseConTranTryHarder x ==
+  IDENTP x => IFCAR HGET($lowerCaseConTb,DOWNCASE x) or x
+  atom x   => x
+  [conLowerCaseConTranTryHarder y for y in x]
+
+constructorSearchGrep(filter,key,kind) ==
+  dbSearch(grepConstruct(filter,key),kind,filter)
+
+grepSearchJump(htPage,yes) ==
+  [filter,key,kind,fn] := htpProperty(htPage,'items)
+  FUNCALL(fn,filter,key,kind)
+
+--=======================================================================
+--            Branch Functions After Database Search
+--=======================================================================
+dbSearch(lines,kind,filter) == --called by attribute, operation, constructor search
+  lines is ['error,:.] => bcErrorPage lines
+  null filter => nil      --means filter error
+  lines is ['Abbreviations,:r] => dbSearchAbbrev(lines,kind,filter)
+  if member(kind,'("attribute" "operation")) then --should not be necessary!!
+    lines := dbScreenForDefaultFunctions lines
+  count := #lines
+  count = 0 => emptySearchPage(kind,filter)
+  member(kind,'("attribute" "operation")) => dbShowOperationLines(kind,lines)
+  dbShowConstructorLines lines
+
+dbSearchAbbrev([.,:conlist],kind,filter) ==
+  null conlist => emptySearchPage('"abbreviation",filter)
+  kind := intern kind
+  if kind ^= 'constructor then
+    conlist := [x for x in conlist | LASSOC('kind,IFCDR IFCDR x) = kind]
+  conlist is [[nam,:.]] => conPage DOWNCASE nam
+  cAlist := [[con,:true] for con in conlist]
+  htPage := htInitPage('"",nil)
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,nil)
+  return dbShowCons(htPage,'names)
+  page := htInitPage([#conlist,
+    '" Abbreviations Match {\em ",STRINGIMAGE filter,'"}"],nil)
+  for [nam,abbr,:r] in conlist repeat
+    kind := LASSOC('kind,r)
+    htSay('"\newline{\em ",s := STRINGIMAGE abbr)
+    htSayStandard '"\tab{10}"
+    htSay '"}"
+    htSay kind
+    htSayStandard '"\tab{19}"
+    bcCon nam
+  htShowPage()
+
+--=======================================================================
+--                   Selectable Search
+--=======================================================================
+detailedSearch(filter) ==
+  page := htInitPage('"Detailed Search with Options",nil)
+  filter   := escapeSpecialChars PNAME filter
+  bcHt '"Select what you want to search for, then click on {\em Search} below"
+  bcHt '"\newline{\it Note:} Logical searches using {\em and}, {\em or}, and {\em not} are not permitted here."
+  htSayHrule()
+  htMakePage '(
+    (text . "\newline")
+    (bcRadioButtons which
+      (  "\tab{3}{\em Operations}"
+         ((text . "\newline\space{3}")
+          (text . "name")       (bcStrings (14 "*" opname EM))
+          (text . " \#args")    (bcStrings (1  "*" opnargs EM))
+          (text . " signature") (bcStrings (14 "*" opsig EM))
+          (text . "\vspace{1}\newline "))
+         ops)
+      (  "\tab{3}{\em Attributes}"
+         ((text . "\newline\space{3}")
+          (text . "name")       (bcStrings (14 "*" attrname EM))
+          (text . " \#args ")   (bcStrings (1  "*" attrnargs EM))
+          (text . " arguments ")(bcStrings (14 "*" attrargs EM))
+          (text . "\vspace{1}\newline "))
+         attrs)
+      (  "\tab{3}{\em Constructors}"
+         ((text . "\tab{17}")
+          (bcButtons (1 cats)) (text . " {\em categories} ")
+          (bcButtons (1 doms)) (text . " {\em domains} ")
+          (bcButtons (1 paks)) (text . " {\em packages} ")
+          (bcButtons (1 defs)) (text . " {\em defaults} ")
+          (text . "\newline\tab{3}")
+          (text . "name")   (bcStrings (14 "*" conname EM))
+          (text . " \#args") (bcStrings (1  "*" connargs EM))
+          (text . "signature") (bcStrings (14 "*" consig EM))
+          (text . "\vspace{1}\newline "))
+          cons)
+--      (   "\tab{3}{\em Documentation}"
+--          ((text . "\tab{26}key")
+--           (bcStrings (28 "*" docfilter EM)))
+--          doc)
+                )
+    (text . "\vspace{1}\newline\center{ ")
+    (bcLinks ("\box{Search}" "" generalSearchDo NIL))
+    (text . "}"))
+  htShowPage()
+
+generalSearchDo(htPage,flag) ==
+--$exposedOnlyIfTrue := (flag => 'T; nil)
+  $htPage := htPage
+  alist := htpInputAreaAlist htPage
+  which := htpButtonValue(htPage,'which)
+  selectors :=
+    which = 'cons => '(conname connargs consig)
+    which = 'ops  => '(opname  opnargs  opsig)
+    '(attrname attrnargs attrargs)
+  name := generalSearchString(htPage,selectors.0)
+  nargs:= generalSearchString(htPage,selectors.1)
+  npat := standardizeSignature generalSearchString(htPage,selectors.2)
+  kindCode :=
+    which = 'ops => char 'o
+    which = 'attrs => char 'a
+    acc := '""
+    if htButtonOn?(htPage,'cats) then acc := STRCONC(char 'c,acc)
+    if htButtonOn?(htPage,'doms) then acc := STRCONC(char 'd,acc)
+    if htButtonOn?(htPage,'paks) then acc := STRCONC(char 'p,acc)
+    if htButtonOn?(htPage,'defs) then acc := STRCONC(char 'x,acc)
+    n := #acc
+    n = 0 or n = 4 => '"[cdpx]"
+    n = 1 => acc
+    STRCONC(char '_[,acc,char '_])
+  form := mkDetailedGrepPattern(kindCode,name,nargs,npat)
+  lines := applyGrep(form,'libdb)
+--lines := dbReadLines resultFile
+  if MEMQ(which,'(ops attrs)) then lines := dbScreenForDefaultFunctions lines
+  kind :=
+    which = 'cons =>
+      n = 1 =>
+        htButtonOn?(htPage,'cats) => '"category"
+        htButtonOn?(htPage,'doms) => '"domain"
+        htButtonOn?(htPage,'paks) => '"package"
+        '"default package"
+      '"constructor"
+    which = 'ops  => '"operation"
+    '"attribute"
+  null lines => emptySearchPage(kind,nil)
+  dbSearch(lines,kind,'"filter")
+
+generalSearchString(htPage,sel) ==
+  string := htpLabelInputString(htPage,sel)
+  string = '"" => '"*"
+  string
+
+htButtonOn?(htPage,key) ==
+  LASSOC(key,htpInputAreaAlist htPage) is [a,:.] and a = '" t"
+
+mkDetailedGrepPattern(kind,name,nargs,argOrSig) == main where
+  main ==
+    nottick := '"[^`]"
+    name := replaceGrepStar name
+    firstPart :=
+      $saturn => STRCONC(char '_^,name)
+      STRCONC(char '_^,kind,name)
+    nargsPart := replaceGrepStar nargs
+    exposedPart := char '_.   --always get exposed/unexposed
+    patPart := replaceGrepStar argOrSig
+    simp STRCONC(conc(firstPart,conc(nargsPart,conc(exposedPart, patPart))),$tick)
+  conc(a,b) ==
+    b = '"[^`]*" or b = char '_. => a
+    STRCONC(a,$tick,b)
+  simp a ==
+    m := MAXINDEX a
+    m > 6 and a.(m-5) = char '_[ and a.(m-4) = char '_^
+      and     a.(m-3) = $tick    and a.(m-2) = char '_]
+          and a.(m-1) = char '_* and a.m = $tick
+            => simp SUBSTRING(a,0,m-5)
+    a
+
+replaceGrepStar s ==
+  s = "" => s
+  final := MAXINDEX s
+  i := charPosition(char '_*,s,0)
+  i > final => s
+  STRCONC(SUBSTRING(s,0,i),'"[^`]*",replaceGrepStar SUBSTRING(s,i + 1,nil))
+
+standardizeSignature(s) == underscoreDollars
+  s.0 = char '_( => s
+  k := STRPOS('"->",s,0,nil) or return s --will fail except perhaps on constants
+  s.(k - 1) = char '_) => STRCONC(char '_(,s)
+  STRCONC(char '_(,SUBSTRING(s,0,k),char '_),SUBSTRING(s,k,nil))
+
+underscoreDollars(s) == fn(s,0,MAXINDEX s) where
+  fn(s,i,n) ==
+    i > n => '""
+    (m := charPosition(char '_$,s,i)) > n => SUBSTRING(s,i,nil)
+    STRCONC(SUBSTRING(s,i,m - i),'"___$",fn(s,m + 1,n))
+
+--=======================================================================
+--                     Code dependent on $saturn
+--=======================================================================
+
+obey x ==
+  $saturn and not $aixTestSaturn => nil
+  OBEY x
+
+--=======================================================================
+--                         I/O Code
+--=======================================================================
+
+getTempPath kind ==
+  pathname := mkGrepFile kind
+  obey STRCONC('"rm -f ", pathname)
+  pathname
+
+dbWriteLines(s, :options) ==
+  pathname := IFCAR options or getTempPath 'source
+  $outStream: local := MAKE_-OUTSTREAM pathname
+  for x in s repeat writedb x
+  SHUT $outStream
+  pathname
+
+dbReadLines target == --AIX only--called by grepFile
+  instream := OPEN target
+  lines := [READLINE instream while not EOFP instream]
+  CLOSE instream
+  lines
+
+dbGetCommentOrigin line ==
+--Given a comment line in comdb, returns line in libdb pointing to it
+--Comment lines have format  [dcpxoa]xxxxxx`ccccc... where
+--x's give pointer into libdb, c's are comments
+  firstPart := dbPart(line,1,-1)
+  key := INTERN SUBSTRING(firstPart,0,1)    --extract this and throw away
+  address := SUBSTRING(firstPart, 1, nil)   --address in libdb
+  instream := OPEN grepSource key           --this always returns libdb now
+  FILE_-POSITION(instream,PARSE_-INTEGER address)
+  line := READLINE instream
+  CLOSE instream
+  line
+
+grepSource key ==
+  key = 'libdb   => STRCONC($SPADROOT,'"/algebra/libdb.text")
+  key = 'gloss   => STRCONC($SPADROOT,'"/algebra/glosskey.text")
+  key = $localLibdb => $localLibdb
+  mkGrepTextfile
+    MEMQ(key, '(_. a c d k o p x)) => 'libdb
+    'comdb
+
+mkGrepTextfile s == STRCONC($SPADROOT,"/algebra/", STRINGIMAGE s, '".text")
+
+mkGrepFile s ==  --called to generate a path name for a temporary grep file
+  prefix :=
+    $standard or $aixTestSaturn => '"/tmp/"
+    STRCONC($SPADROOT,'"/algebra/")
+  suffix := getEnv '"SPADNUM"
+  STRCONC(prefix, PNAME s,'".txt.", suffix)
+
+--=======================================================================
+--                     Grepping Code
+--=======================================================================
+
+grepFile(pattern,:options) ==
+  key := (x := IFCAR options => (options := rest options; x); nil)
+  source := grepSource key
+  lines :=
+    not PROBE_-FILE source => NIL
+    $standard or $aixTestSaturn =>
+    -----AIX Version----------
+      target := getTempPath 'target
+      casepart :=
+        MEMQ('iv,options)=> '"-vi"
+        '"-i"
+      command := STRCONC('"grep ",casepart,'" _'",pattern,'"_' ",source)
+      obey
+        member(key,'(a o c d p x)) =>
+          STRCONC(command, '" | sed 's/~/", STRINGIMAGE key, '"/' > ", target)
+        STRCONC(command, '" > ",target)
+      dbReadLines target
+    ----Windows Version------
+    invert? := MEMQ('iv, options)
+    GREP(source, pattern, false, not invert?)
+  dbUnpatchLines lines
+
+dbUnpatchLines lines ==  --concatenate long lines together, skip blank lines
+  dash := char '_-
+  acc := nil
+  while lines is [line, :lines] repeat
+    #line = 0 => 'skip     --skip blank lines
+    acc :=
+      line.0 = dash and line.1 = dash =>
+        [STRCONC(first acc,SUBSTRING(line,2,nil)),:rest acc]
+      [line,:acc]
+  -- following call to NREVERSE needed to keep lines properly sorted
+  NREVERSE acc  ------> added by BMT 12/95
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/br-util.boot.pamphlet b/src/interp/br-util.boot.pamphlet
new file mode 100644
index 00000000..d157054d
--- /dev/null
+++ b/src/interp/br-util.boot.pamphlet
@@ -0,0 +1,738 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-util.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--====================> WAS b-util.boot <================================
+
+--=======================================================================
+--		       AXIOM Browser
+-- Initial entry is from man0.ht page to one of these functions:
+--   kSearch (cSearch, dSearch, or pSearch), for constructors
+--   oSearch, for operations
+--   aSearch, for attributes
+--   aokSearch, for general search
+--   docSearch, for documentation search
+--   genSearch, for complete search
+--=======================================================================
+
+browserAutoloadOnceTrigger() == nil
+
+----------------------> Global Variables <-----------------------
+$includeUnexposed? := true   --default setting
+$tick := char '_`	     --field separator for database files
+$charUnderscore := ('__)     --needed because of parser bug
+$wild1 := '"[^`]*"           --phrase used to convert keys to grep strings
+$browseCountThreshold := 10  --the maximum number of names that will display
+			     --on a general search
+$opDescriptionThreshold := 4 --if <= 4 operations with unique name, give desc
+                             --otherwise, give signatures
+$browseMixedCase := true     --distinquish case in the browser?
+$docTable := nil	     --cache for documentation table
+$conArgstrings := nil	     --bound by conPage so that kPage
+			     --will display arguments if given
+$conformsAreDomains  := false	  --are all arguments of a constructor given?
+$returnNowhereFromGoGet := false  --special branch out for goget for browser
+$dbDataFunctionAlist := nil	  --set by dbGatherData
+$domain	  := nil	     --bound in koOps
+$infovec  := nil	     --bound in koOps
+$predvec  := nil	     --bound in koOps
+$exposedOnlyIfTrue := nil    --see repeatSearch, dbShowOps, dbShowCon
+$bcMultipleNames := nil	     --see bcNameConTable
+$bcConformBincount := nil    --see bcConform1
+$docTableHash := MAKE_-HASHTABLE 'EQUAL	 --see dbExpandOpAlistIfNecessary
+$groupChoice := nil  --see dbShowOperationsFromConform
+
+------------------> Initial Settings <---------------------
+$pmFilterDelimiters := [char '_(,char '_),char '_ ]
+$dbKindAlist :=
+  [[char 'a,:'"attribute"],[char 'o,:'"operation"],
+    [char 'd,:'"domain"],[char 'p,:'"package"],
+      [char 'c,:'"category"],[char 'x,:'"default_ package"]]
+$OpViewTable := '(
+  (names	   "Name"      "Names"           dbShowOpNames)
+  (documentation   "Name"      "Names"           dbShowOpDocumentation)
+  (domains	   "Domain"    "Domains"         dbShowOpDomains)
+  (signatures	   "Signature" "Signatures"      dbShowOpSignatures)
+  (parameters	   "Form"      "Forms"           dbShowOpParameters)
+  (origins	   "Origin"    "Origins"         dbShowOpOrigins)
+  (implementation  nil	       "Implementation Domains" dbShowOpImplementations)
+  (conditions	   "Condition" "Conditions"      dbShowOpConditions))
+
+bcBlankLine() == bcHt '"\vspace{1}\newline "
+
+pluralize k ==
+  k = '"child" => '"children"
+  k = '"category" => '"categories"
+  k = '"entry" => '"entries"
+  STRCONC(k,'"s")
+
+capitalize s ==
+  LASSOC(s,'(
+      ("domain"   . "Domain")
+      ("category" . "Category")
+      ("package"  . "Package")
+      ("default package" . "Default Package"))) or
+    res := COPY_-SEQ s
+    SETELT(res,0,UPCASE res.0)
+    res
+
+escapeSpecialIds u ==	--very expensive function
+  x := LASSOC(u,$htCharAlist) => [x]
+  #u = 1 =>
+    member(u, $htSpecialChars) => [CONCAT('"_\", u)]
+    [u]
+  c := char u.0
+  or/[c = char y for y in $htSpecialChars] =>
+    [CONCAT('"_\",u)]
+  [u]
+
+escapeString com ==   --this makes changes on single comment lines
+-- was htexCom
+  look := 0
+  while look repeat
+    look >= SIZE com => look := []
+
+
+    look := STRPOSL ('"${}#%", com, look, [])
+    if look then
+      com := RPLACSTR (com,look,0,'"\")  --note RPLACSTR copies!!!
+      look := look + 2
+  com
+
+htPred2English(x,:options) ==
+  $emList :local := IFCAR options   --list of identifiers to be emphasised
+  $precList: local := '((OR 10 . "or") (AND 9 . "and")
+     (_< 5) (_<_= 5) (_> 5) (_>_= 5) (_= 5) (_^_= 5) (or 10) (and 9))
+  fn(x,100) where
+    fn(x,prec) ==
+      x is [op,:l] =>
+	LASSOC(op,$precList) is [iprec,:rename] =>
+	  if iprec > prec then htSay '"("
+	  fn(first l,iprec)
+	  for y in rest l repeat
+	    htSay('" ",rename or op,'" ")
+	    fn(y,iprec)
+	  if iprec > prec then htSay '")"
+	if prec < 5 then htSay '"("
+	gn(x,op,l,prec)
+	if prec < 5 then htSay '")"
+      x = 'etc => htSay '"..."
+      IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds PNAME x
+      htSay form2HtString(x,$emList)
+    gn(x,op,l,prec) ==
+      MEMQ(op,'(NOT not)) =>
+	htSay('"not ")
+	fn(first l,0)
+      op = 'HasCategory =>
+	bcConform(first l,$emList)
+	htSay('" has ")
+	bcConform(CADADR l,$emList)
+      op = 'HasAttribute =>
+	bcConform(first l,$emList)
+	htSay('" has ")
+	fnAttr CADADR l
+      MEMQ(op,'(has ofCategory)) =>
+	bcConform(first l,$emList)
+	htSay('" has ")
+	[a,b] := l
+	b is ['ATTRIBUTE,c] and not constructor? c => fnAttr c
+	bcConform(b, $emList)
+      bcConform(x,$emList)
+    fnAttr c ==
+      s := form2HtString c
+      member(s,$emList) => htSay('"{\em ",s,'"}")
+      satDownLink(s, ['"(|aPage| '|",s,'"|)"])
+
+unMkEvalable u ==
+ u is ['QUOTE,a] => a
+ u is ['LIST,:r] => [unMkEvalable x for x in r]
+ u
+
+lisp2HT u == ['"_'",:fn u] where fn u ==
+  IDENTP u => escapeSpecialIds PNAME u
+  STRINGP u => escapeString u
+  ATOM u => systemError()
+  ['"_(",:"append"/[fn x for x in u],'")"]
+
+args2HtString(x,:options) ==
+  null x => '""
+  emList := IFCAR options
+  SUBSTRING(form2HtString(['f,:x],emList),1,nil)
+
+quickForm2HtString(x) ==
+  atom x => STRINGIMAGE x
+  form2HtString x
+
+form2HtString(x,:options) ==
+  $emList:local := IFCAR options   --list of atoms to be emphasized
+  $brief: local := IFCAR IFCDR options --see dbShowOperationsFromConform (lib11)
+  fn(x) where
+    fn x ==
+      atom x =>
+	MEMQ(x,$FormalMapVariableList) => STRCONC('"\",STRINGIMAGE x)
+	u := escapeSpecialChars STRINGIMAGE x
+	MEMQ(x,$emList) => STRCONC('"{\em ",u,'"}")
+	STRINGP x => STRCONC('"_"",u,'"_"")
+	u
+      first x = 'QUOTE => STRCONC('"'",sexpr2HtString first rest x)
+      first x = ":" => STRCONC(fn first rest x,'": ",fn first rest rest x)
+      first x = 'Mapping =>
+        STRCONC(fnTail(rest rest x,'"()"),'"->",fn first rest x)
+      first x = 'construct => fnTail(rest x,'"[]")
+      tail := fnTail(rest x,'"()")
+      head := fn first x
+--    $brief and #head + #tail > 35 => STRCONC(head,'"(...)")
+      STRCONC(head,tail)
+    fnTail(x,str) ==
+      null x => '""
+      STRCONC(str . 0,fn first x,fnTailTail rest x,str . 1)
+    fnTailTail x ==
+      null x => '""
+      STRCONC('",",fn first x,fnTailTail rest x)
+
+sexpr2HtString x ==
+  atom x => form2HtString x
+  STRCONC('"(",fn x,'")") where fn x ==
+    r := rest x
+    suffix :=
+      null r => '""
+      atom r => STRCONC('" . ",form2HtString rest x)
+      STRCONC('" ",fn r)
+    STRCONC(sexpr2HtString first x,suffix)
+
+form2LispString(x) ==
+  atom x =>
+    x = '_$ => '"__$"
+    MEMQ(x,$FormalMapVariableList) => STRCONC(STRINGIMAGE '__, STRINGIMAGE x)
+    STRINGP x => STRCONC('"_"",STRINGIMAGE x,'"_"")
+    STRINGIMAGE x
+  x is ['QUOTE,a] => STRCONC('"'",sexpr2LispString a)
+  x is [":",a,b] => STRCONC(form2LispString a,'":",form2LispString b)
+  first x = 'Mapping =>
+    null rest (r := rest x) => STRCONC('"()->",form2LispString first r)
+    STRCONC(args2LispString rest r,'"->",form2LispString first r)
+  STRCONC(form2LispString first x,args2LispString rest x)
+
+sexpr2LispString x ==
+  atom x => form2LispString x
+  STRCONC('"(",fn x,'")") where fn x ==
+    r := rest x
+    suffix :=
+      null r => '""
+      atom r => STRCONC('" . ",form2LispString rest x)
+      STRCONC('" ",fn r)
+    STRCONC(sexpr2HtString first x,suffix)
+
+args2LispString x ==
+  null x => '""
+  STRCONC('"(",form2LispString first x,fnTailTail rest x,'")") where
+    fnTailTail x ==
+      null x => '""
+      STRCONC('",",form2LispString first x,fnTailTail rest x)
+
+dbConstructorKind x ==
+  target := CADAR GETDATABASE(x,'CONSTRUCTORMODEMAP)
+  target = '(Category) => 'category
+  target is ['CATEGORY,'package,:.] => 'package
+  HGET($defaultPackageNamesHT,x) => 'default_ package
+  'domain
+
+getConstructorForm name ==
+  name = 'Union	  => '(Union  (_: a A) (_: b B))
+  name = 'UntaggedUnion => '(Union A B)
+  name = 'Record  => '(Record (_: a A) (_: b B))
+  name = 'Mapping => '(Mapping T S)
+  name = 'Enumeration => '(Enumeration a b)
+  GETDATABASE(name,'CONSTRUCTORFORM)
+
+getConstructorArgs conname == CDR getConstructorForm conname
+
+htSay(x,:options) ==
+--if x = $charEscape then x := $charNewline else
+--if x = $stringEscape then x := $stringNewline
+  bcHt x
+  for y in options repeat bcHt y
+
+bcComments(comments,:options) ==
+  italics? := not IFCAR options
+  STRINGP comments =>
+    comments = '"" => nil
+    htSay('"\newline ")
+    if italics? then htSay '"{\em "
+    htSay comments
+    if italics? then htSay '"}"
+  null comments => nil
+  htSay('"\newline ")
+  if italics? then htSay "{\em "
+  htSay first comments
+  for x in rest comments repeat htSay('" ",x)
+  if italics? then htSay '"}"
+
+bcConform(form,:options) ==
+  $italics?    : local := IFCAR options
+  $italicHead? : local := IFCAR IFCDR options
+  bcConform1 form
+
+bcConform1 form == main where
+-----------------> OBSELETE
+  main ==
+    form is ['ifp,form1,:pred] =>
+      hd form1
+      bcPred pred
+    hd form
+  hd form ==
+    atom form =>
+      not MEMQ(form,'(Mapping Union Record)) and null constructor? form =>
+        s := STRINGIMAGE form
+        (s.0 = char '_#) and (n := POSN1(form, $FormalFunctionParameterList)) =>
+           htSay form2HtString ($FormalMapVariableList . n)
+        htSay form
+      s := STRINGIMAGE form
+      $italicHead? => htSayItalics s
+      $bcMultipleNames =>
+        satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"])
+      satTypeDownLink(s, ["(|conPage| '|",s,'"|)"])
+    (head := QCAR form) = 'QUOTE =>
+      htSay('"'")
+      hd CADR form
+    head = 'SIGNATURE =>
+      htSay(CADR form,'": ")
+      mapping CADDR form
+    head = 'Mapping and rest form => rest form => mapping rest form
+    head = ":" =>
+      hd CADR form
+      htSay '": "
+      hd CADDR form
+    QCDR form and dbEvalableConstructor? form
+       => bcConstructor(form,head)
+    hd head
+    null (r := QCDR form) => nil
+    tl QCDR form
+  mapping [target,:source] ==
+    tuple source
+    bcHt
+      $saturn => '" {\ttrarrow} "
+      '" -> "
+    hd target
+  tuple u ==
+    null u => bcHt '"()"
+    null rest u => hd u
+    bcHt '"("
+    hd first u
+    for x in rest u repeat
+      bcHt '","
+      hd x
+    bcHt '")"
+  tl u ==
+    bcHt '"("
+    firstTime := true
+    for x in u repeat
+      if not firstTime then bcHt '","
+      firstTime := false
+      hd x
+    bcHt '")"
+  say x ==
+    if $italics? then bcHt '"{\em "
+    if x = 'etc then x := '"..."
+    bcHt escapeSpecialIds STRINGIMAGE x
+    if $italics? then bcHt '"}"
+
+bcConstructor(form is [op,:arglist],cname) ==  --called only when $conformsAreDomains
+  htSayList dbConformGen form
+
+htSayList u ==
+  for x in u repeat htSay x
+
+conform2HtString form ==
+  for u in form2String form repeat
+    htSay u
+
+dbEvalableConstructor? form ==
+--form is constructor form; either
+--(a) all arguments are specified or (b) none are specified
+  form is [op,:argl] =>
+    null argl => true
+    op = 'QUOTE => 'T     --is a domain valued object
+    and/[dbEvalableConstructor? x for x in argl]
+  INTEGERP form => true
+  false
+
+htSayItalics s == htSay('"{\em ",s,'"}")
+
+bcCon(name,:options) ==
+  argString := IFCAR options or '""
+  s := STRINGIMAGE name
+  bcStar name
+  htSayConstructorName(s,s)
+  htSay argString
+
+bcAbb(name,abb) ==
+  s := STRINGIMAGE name
+  a := STRINGIMAGE abb
+  bcStar name
+  htSayConstructorName(a,s)
+
+bcStar name ==
+  if $includeUnexposed? and not isExposedConstructor name then htSayUnexposed()
+
+bcStarSpace name ==
+  null $includeUnexposed? => nil
+  not isExposedConstructor name => htSayUnexposed()
+  htBlank()
+
+bcStarSpaceOp(op,exposed?) ==
+  null $includeUnexposed? => nil
+  not exposed? =>
+    htSayUnexposed()
+    if op.0 = char '_* then htSay '" "
+  htBlank()
+
+bcStarConform form ==
+  bcStar opOf form
+  bcConform form
+
+dbSourceFile name ==
+  u:= GETDATABASE(name,'SOURCEFILE)
+  null u => '""
+  n := PATHNAME_-NAME u
+  t := PATHNAME_-TYPE u
+  STRCONC(n,'".",t)
+
+asharpConstructorName? name ==
+  u:= GETDATABASE(name,'SOURCEFILE)
+  u and PATHNAME_-TYPE u = '"as"
+
+asharpConstructors() ==
+  [x for x in allConstructors() | not asharpConstructorName? x]
+
+extractFileNameFromPath s == fn(s,0,#s) where
+  fn(s,i,m) ==
+    k := charPosition(char '_/,s,i)
+    k = m => SUBSTRING(s,i,nil)
+    fn(s,k + 1,m)
+
+bcOpTable(u,fn) ==
+  htBeginTable()
+  firstTime := true
+  for op in u for i in 0.. repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    htMakePage [['bcLinks,[escapeSpecialChars STRINGIMAGE opOf op,'"",fn,i]]]
+    htSay '"}"
+  htEndTable()
+
+bcNameConTable u ==
+  $bcMultipleNames: local := (#u ^= 1)
+  bcConTable REMDUP u
+  -- bcConTable u
+
+bcConTable u ==
+  htBeginTable()
+  firstTime := true
+  for con in u repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    bcStarSpace opOf con
+    bcConform con
+    htSay '"}"
+  htEndTable()
+
+bcAbbTable u ==
+  htBeginTable()
+  firstTime := true
+  for x in REMDUP u repeat	  --allow x to be NIL meaning "no abbreviation"
+  -- for x in u repeat	  --allow x to be NIL meaning "no abbreviation"
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    if x is [con,abb,:.] then
+      htSay '"{"
+      bcAbb(con,abb)
+      htSay '"}"
+  htEndTable()
+
+bcConPredTable(u,conname,:options) ==
+  italicList := IFCAR options
+  htBeginTable()
+  firstTime := true
+  for [conform,:pred] in u repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    bcStarSpace opOf conform
+    form :=
+      atom conform => getConstructorForm conform
+      conform
+    bcConform(form,italicList)
+    if extractHasArgs pred is [arglist,:pred] then
+      htSay('" {\em of} ")
+      bcConform([conname,:arglist],italicList,true)
+    if pred ^= 'etc then bcPred(pred,italicList)
+    htSay '"}"
+  htEndTable()
+
+bcPred(pred,:options) ==
+  pred = '"" or pred = true or null pred => 'skip
+  italicList := IFCAR options
+  if not IFCAR IFCDR options then htSay '" {\em if} "
+  htPred2English(pred,italicList)
+
+extractHasArgs pred ==
+  x := find pred or return nil where find x ==
+    x is [op,:argl] =>
+      op = 'hasArgs => x
+      MEMQ(op,'(AND OR NOT)) => or/[find y for y in argl]
+      nil
+    nil
+  [rest x,:simpBool SUBST('T,x,pred)]
+
+splitConTable cons ==
+  uncond := cond := nil
+  for (pair := [con,:pred]) in cons repeat
+    null pred => 'skip
+    pred = 'T or pred is ['hasArgs,:.]	=> uncond := [pair,:uncond]
+    cond := [pair,:cond]
+  [NREVERSE uncond,:NREVERSE cond]
+
+bcNameTable(u,fn,:option) ==   --option if * prefix
+  htSay '"\newline"
+  htBeginTable()
+  firstTime := true
+  for x in u repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    if IFCAR option then bcStar x
+    htMakePage [['bcLinks,[s := escapeSpecialChars STRINGIMAGE x,'"",fn,s]]]
+    htSay '"}"
+  htEndTable()
+
+bcNameCountTable(u,fn,gn,:options) ==
+  linkFunction :=
+    IFCAR options => 'bcLispLinks
+    'bcLinks
+  htSay '"\newline"
+  htBeginTable()
+  firstTime := true
+  for i in 0.. for x in u repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    htSay '"{"
+    htMakePage [[linkFunction,[FUNCALL(fn,x),'"",gn,i]]]
+    htSay '"}"
+  htEndTable()
+
+dbSayItemsItalics(:u) ==
+  htSay '"{\em "
+  APPLY(function dbSayItems,u)
+  htSay '"}"
+
+dbSayItems(countOrPrefix,singular,plural,:options) ==
+  bcHt '"\newline "
+  count :=
+   countOrPrefix is [:prefix,c] =>
+     htSay prefix
+     c
+   countOrPrefix
+  if count = 0 then htSay('"No ",singular)
+  else if count = 1 then htSay('"1 ",singular)
+  else htSay(count,'" ",plural)
+  for x in options repeat bcHt x
+  if count ^= 0 then bcHt '":"
+
+dbBasicConstructor? conname == member(dbSourceFile conname,'("catdef" "coerce"))
+
+nothingFoundPage(:options) ==
+  htInitPage('"Sorry, no match found",nil)
+  htShowPage()
+
+htCopyProplist htPage == [[x,:y] for [x,:y] in htpPropertyList htPage]
+
+dbInfovec name ==
+  'category = GETDATABASE(name,'CONSTRUCTORKIND) => nil
+  GETDATABASE(name, 'ASHARP?) => nil
+  loadLibIfNotLoaded(name)
+  u := GETL(name,'infovec) => u
+
+emptySearchPage(kind,filter,:options) ==
+  skipNamePart := IFCAR options
+  heading := ['"No ",capitalize kind,'" Found"]
+  htInitPage(heading,nil)
+  exposePart :=
+    null $includeUnexposed? => '"{\em exposed} "
+    '""
+  htSay('"\vspace{1}\newline\centerline{There is no ",exposePart,kind,'" matching pattern}\newline\centerline{{\em ")
+  if filter then htPred2English filter
+  htSay '"}}"
+  htShowPage()
+
+isLoaded? conform == GETL(constructor? opOf conform,'LOADED)
+
+string2Integer s ==
+  and/[DIGIT_-CHAR_-P (s.i) for i in 0..MAXINDEX s] => PARSE_-INTEGER s
+  nil
+
+dbGetInputString htPage ==
+  s := htpLabelInputString(htPage,'filter)
+  null s or s = '"" => '"*"
+  s
+
+
+
+--=======================================================================
+--		     Error Pages
+--=======================================================================
+bcErrorPage u ==
+  u is ['error,:r] =>
+    htInitPage(first r,nil)
+    bcBlankLine()
+    for x in rest r repeat htSay x
+    htShowPage()
+  systemError '"Unexpected error message"
+
+errorPage(htPage,[heading,kind,:info]) ==
+  kind = 'invalidType => kInvalidTypePage first info
+  if heading = 'error then htInitPage('"Error",nil) else
+			   htInitPage(heading,nil)
+  bcBlankLine()
+  for x in info repeat htSay x
+  htShowPage()
+
+htErrorStar() ==
+  errorPage(nil,['"{\em *} not a valid search string",nil,'"\vspace{3}\centerline{{\em *} is not a valid search string for a general search}\centerline{\em {it would match everything!}}"])
+
+htQueryPage(htPage,heading,message,query,fn) ==
+  htInitPage(heading,nil)
+  htSay message
+  htQuery(query,fn)
+  htShowPage()
+
+htQuery(question,fn,:options) ==
+  upLink? := IFCAR options
+  if question then
+    htSay('"\vspace{1}\centerline{")
+    htSay question
+    htSay('"}")
+  htSay('"\centerline{")
+  htMakePage [['bcLispLinks,['"\fbox{Yes}",'"",fn,'yes]]]
+  htBlank 4
+  if upLink?
+    then htSay('"\downlink{\fbox{No}}{UpPage}")
+    else htMakePage [['bcLispLinks,['"\fbox{No}",'"",fn,'no]]]
+  htSay('"}")
+
+kInvalidTypePage form ==
+  htInitPage('"Error",nil)
+  bcBlankLine()
+  htSay('"\centerline{You gave an invalid type:}\newline\centerline{{\sf ")
+  htSay(form2HtString form,'"}}")
+  htShowPage()
+
+dbNotAvailablePage(:options) ==
+  htInitPage('"Missing Page",nil)
+  bcBlankLine()
+  htSay(IFCAR options or '"\centerline{This page is not available yet}")
+  htShowPage()
+
+--=======================================================================
+--	 Utility Functions for Manipulating Browse Datalines
+--=======================================================================
+dbpHasDefaultCategory? s ==  #s > 1 and s.1 = char 'x  --s is part 3 of line
+
+dbKind line == line.0
+
+dbKindString kind == LASSOC(kind,$dbKindAlist)
+
+dbName line == escapeString SUBSTRING(line,1,charPosition($tick,line,1) - 1)
+
+dbAttr line == STRCONC(dbName line,escapeString dbPart(line,4,0))
+
+dbPart(line,n,k) ==  --returns part n of line (n=1,..) beginning in column k
+  n = 1 => SUBSTRING(line,k + 1,charPosition($tick,line,k + 1) - k - 1)
+  dbPart(line,n - 1,charPosition($tick,line,k + 1))
+
+dbXParts(line,n,m) ==
+  [.,nargs,:r] := dbParts(line,n,m)
+  [dbKindString line.0,dbName line,PARSE_-INTEGER nargs,:r]
+
+dbParts(line,n,m) ==  --split line into n parts beginning in column m
+  n = 0 => nil
+  [SUBSTRING(line,m,-m + (k := charPosition($tick,line,m))),
+    :dbParts(line,n - 1,k + 1)]
+
+dbConname(line) == dbPart(line,5,1)
+
+dbComments line ==  dbReadComments(string2Integer dbPart(line,7,1))
+
+dbNewConname(line) == --dbName line unless kind is 'a or 'o => name in 5th pos.
+  (kind := line.0) = char 'a or kind = char 'o =>
+    conform := dbPart(line,5,1)
+    k := charPosition(char '_(,conform,1)
+    SUBSTRING(conform,1,k - 1)
+  dbName line
+
+dbTickIndex(line,n,k) == --returns index of nth tick in line starting at k
+  n = 1 => charPosition($tick,line,k)
+  dbTickIndex(line,n - 1,1 + charPosition($tick,line,k))
+
+mySort u == listSort(function GLESSEQP,u)
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/buildom.boot.pamphlet b/src/interp/buildom.boot.pamphlet
new file mode 100644
index 00000000..15196a74
--- /dev/null
+++ b/src/interp/buildom.boot.pamphlet
@@ -0,0 +1,384 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp buildom.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- This file contains the constructors for the domains that cannot
+-- be written in ScratchpadII yet.  They are not cached because they
+-- are very cheap to instantiate.
+-- SMW and SCM July 86
+
+SETANDFILEQ($noCategoryDomains, '(Domain Mode SubDomain))
+SETANDFILEQ($nonLisplibDomains,
+  APPEND($Primitives,$noCategoryDomains))
+
+--% Record
+--  Want to eventually have the elts and setelts.
+--  Record is a macro in BUILDOM LISP. It takes out the colons.
+
+isRecord type == type is ['Record,:.]
+
+RecordInner args ==
+  -- this is old and should be removed wherever it occurs
+  if $evalDomain then
+    sayBrightly '"-->> Whoops! RecordInner called from this code."
+  Record0 VEC2LIST args
+
+Record0 args ==
+    dom := GETREFV 10
+    -- JHD added an extra slot to cache EQUAL methods
+    dom.0 := ['Record, :[['_:, CAR a, devaluate CDR a] for a in args]]
+    dom.1 :=
+	   [function lookupInTable,dom,
+	       [['_=,[[['Boolean],'_$,'_$],:12]],
+		 ['coerce,[[$Expression,'_$],:14]]]]
+    dom.2 := NIL
+    dom.3 := ['RecordCategory,:QCDR dom.0]
+    dom.4 :=
+	  [[ '(SetCategory) ],[ '(SetCategory) ]]
+    dom.5 := [CDR a for a in args]
+    dom.6 := [function RecordEqual, :dom]
+    dom.7 := [function RecordPrint, :dom]
+    dom.8 := [function Undef, :dom]
+  -- following is cache for equality functions
+    dom.9 := if (n:= LENGTH args) <= 2
+	      then [NIL,:NIL]
+	      else GETREFV n
+    dom
+
+RecordEqual(x,y,dom) ==
+  PAIRP x =>
+    b:=
+       SPADCALL(CAR x, CAR y, CAR(dom.9) or
+			   CAR RPLACA(dom.9,findEqualFun(dom.5.0)))
+    NULL rest(dom.5) => b
+    b and
+       SPADCALL(CDR x, CDR y, CDR (dom.9) or
+			   CDR RPLACD(dom.9,findEqualFun(dom.5.1)))
+  VECP x =>
+    equalfuns := dom.9
+    and/[SPADCALL(x.i,y.i,equalfuns.i or (equalfuns.i:=findEqualFun(fdom)))
+	 for i in 0.. for fdom in dom.5]
+  error '"Bug: Silly record representation"
+
+RecordPrint(x,dom) == coerceRe2E(x,dom.3)
+
+coerceVal2E(x,m) ==
+   objValUnwrap coerceByFunction(objNewWrap(x,m),$Expression)
+
+findEqualFun(dom) ==
+  compiledLookup('_=,[$Boolean,'$,'$],dom)
+
+coerceRe2E(x,source) ==
+  n := # CDR source
+  n = 1 =>
+    ['construct,
+     ['_=, source.1.1, coerceVal2E(CAR x,source.1.2)] ]
+  n = 2 =>
+    ['construct,
+     ['_=, source.1.1, coerceVal2E(CAR x,source.1.2)], _
+     ['_=, source.2.1, coerceVal2E(CDR x,source.2.2)] ]
+  VECP x =>
+    ['construct,
+     :[['_=,tag,coerceVal2E(x.i, fdom)]
+       for i in 0.. for [.,tag,fdom] in rest source]]
+  error '"Bug: ridiculous record representation"
+
+
+--% Union
+--  Want to eventually have the coerce to and from branch types.
+
+Union(:args) ==
+    dom := GETREFV 9
+    dom.0 := ['Union, :[(if a is ['_:,tag,domval] then ['_:,tag,devaluate domval]
+			  else devaluate a) for a in args]]
+    dom.1 :=
+	    [function lookupInTable,dom,
+	       [['_=,[[['Boolean],'_$,'_$],:12]],
+		 ['coerce,[[$Expression,'_$],:14]]]]
+    dom.2 := NIL
+    dom.3 :=
+      '(SetCategory)
+    dom.4 :=
+	  [[ '(SetCategory) ],[ '(SetCategory) ]]
+    dom.5 := args
+    dom.6 := [function UnionEqual, :dom]
+    dom.7 := [function UnionPrint, :dom]
+    dom.8 := [function Undef, :dom]
+    dom
+
+UnionEqual(x, y, dom) ==
+  ['Union,:branches] := dom.0
+  branches := orderUnionEntries branches
+  predlist := mkPredList branches
+  same := false
+  for b in stripUnionTags branches for p in predlist while not same repeat
+    typeFun := ['LAMBDA, '(_#1), p]
+    FUNCALL(typeFun,x) and FUNCALL(typeFun,y) =>
+      STRINGP b => same := (x = y)
+      if p is ['EQCAR, :.] then (x := rest x; y := rest y)
+      same := SPADCALL(x, y, findEqualFun(evalDomain b))
+  same
+
+UnionPrint(x, dom) == coerceUn2E(x, dom.0)
+
+coerceUn2E(x,source) ==
+  ['Union,:branches] := source
+  branches := orderUnionEntries branches
+  predlist := mkPredList branches
+  byGeorge := byJane := GENSYM()
+  for b in stripUnionTags branches for p in predlist  repeat
+    typeFun := ['LAMBDA, '(_#1), p]
+    if FUNCALL(typeFun,x) then return
+      if p is ['EQCAR, :.] then x := rest x
+--    STRINGP b => return x  -- to catch "failed" etc.
+      STRINGP b => byGeorge := x  -- to catch "failed" etc.
+      byGeorge := coerceVal2E(x,b)
+  byGeorge = byJane =>
+    error '"Union bug: Cannot find appropriate branch for coerce to E"
+  byGeorge
+
+--% Mapping
+--  Want to eventually have elt: ($, args) -> target
+
+Mapping(:args) ==
+    dom := GETREFV 9
+    dom.0 := ['Mapping, :[devaluate a for a in args]]
+    dom.1 :=
+	    [function lookupInTable,dom,
+	       [['_=,[[['Boolean],'_$,'_$],:12]],
+		 ['coerce,[[$Expression,'_$],:14]]]]
+    dom.2 := NIL
+    dom.3 :=
+      '(SetCategory)
+    dom.4 :=
+	  [[ '(SetCategory) ],[ '(SetCategory) ]]
+    dom.5 := args
+    dom.6 := [function MappingEqual, :dom]
+    dom.7 := [function MappingPrint, :dom]
+    dom.8 := [function Undef, :dom]
+    dom
+
+MappingEqual(x, y, dom) == EQ(x,y)
+MappingPrint(x, dom) == coerceMap2E(x)
+
+coerceMap2E(x) ==
+  -- nrlib domain
+  ARRAYP CDR x => ['theMap, BPINAME CAR x,
+    if $testingSystem then 0 else REMAINDER(HASHEQ CDR x, 1000)]
+  -- aldor 
+  ['theMap, BPINAME CAR x  ]
+
+--% Enumeration
+
+Enumeration(:"args") ==
+    dom := GETREFV 9
+    -- JHD added an extra slot to cache EQUAL methods
+    dom.0 := ['Enumeration, :args]
+    dom.1 :=
+	   [function lookupInTable,dom,
+	       [['_=,[[['Boolean],'_$,'_$],:12]],
+		 ['coerce,[[$Expression,'_$],:14], [['_$, $Symbol], :16]]
+                         ]]
+    dom.2 := NIL
+    dom.3 := ['EnumerationCategory,:QCDR dom.0]
+    dom.4 :=
+	  [[ '(SetCategory) ],[ '(SetCategory) ]]
+    dom.5 := args
+    dom.6 := [function EnumEqual, :dom]
+    dom.7 := [function EnumPrint, :dom]
+    dom.8 := [function createEnum, :dom]
+    dom
+
+EnumEqual(e1,e2,dom) == e1=e2
+EnumPrint(enum, dom) == dom.5.enum
+createEnum(sym, dom) ==
+  args := dom.5
+  val := -1
+  for v in args for i in 0.. repeat
+     sym=v => return(val:=i)
+  val<0 => error ["Cannot coerce",sym,"to",["Enumeration",:args]]
+  val
+
+--% INSTANTIATORS
+
+RecordCategory(:"x") == constructorCategory ['Record,:x]
+
+EnumerationCategory(:"x") == constructorCategory ["Enumeration",:x]
+
+UnionCategory(:"x") == constructorCategory ["Union",:x]
+
+--ListCategory(:"x") == constructorCategory ("List",:x)
+
+--VectorCategory(:"x") == constructorCategory ("Vector",:x)
+	  --above two now defined in SPAD code.
+
+constructorCategory (title is [op,:.]) ==
+  constructorFunction:= GETL(op,"makeFunctionList") or
+	      systemErrorHere '"constructorCategory"
+  [funlist,.]:= FUNCALL(constructorFunction,"$",title,$CategoryFrame)
+  oplist:= [[[a,b],true,c] for [a,b,c] in funlist]
+  cat:=
+    JoinInner([SetCategory(),mkCategory('domain,oplist,nil,nil,nil)],
+      $EmptyEnvironment)
+  cat.(0):= title
+  cat
+
+--mkMappingFunList(nam,mapForm,e) == [[],e]
+mkMappingFunList(nam,mapForm,e) ==
+  dc := GENSYM()
+  sigFunAlist:=
+    [['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+       ['coerce,[$Expression,nam],['ELT,dc,7]]]
+  [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
+
+mkRecordFunList(nam,['Record,:Alist],e) ==
+  len:= #Alist
+
+--  for (.,a,.) in Alist do
+--    if getmode(a,e) then MOAN("Symbol: ",a,
+--	  " must not be both a variable and literal")
+--    e:= put(a,"isLiteral","true",e)
+  dc := GENSYM()
+  sigFunAlist:=
+     --:((a,(A,nam),('XLAM,("$1","$2"),('RECORDELT,"$1",i,len)))
+     --	      for i in 0..,(.,a,A) in Alist),
+
+    [['construct,[nam,:[A for [.,a,A] in Alist]],'mkRecord],
+      ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+       ['coerce,[$Expression,nam],['ELT,dc,7]],:
+	[['elt,[A,nam,PNAME a],['XLAM,["$1","$2"],['RECORDELT,"$1",i,len]]]
+	    for i in 0.. for [.,a,A] in Alist],:
+	  [['setelt,[A,nam,PNAME a,A],['XLAM,["$1","$2","$3"],
+	    ['SETRECORDELT,"$1",i, len,"$3"]]]
+	      for i in 0.. for [.,a,A] in Alist],:
+		[['copy,[nam,nam],['XLAM,["$1"],['RECORDCOPY,
+		  "$1",len]]]]]
+  [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
+
+mkNewUnionFunList(name,form is ['Union,:listOfEntries],e) ==
+  dc := name
+  if name = 'Rep then name := '$
+  --2. create coercions from subtypes to subUnion
+  cList:=
+    [['_=,[['Boolean],name ,name],['ELT,dc,6]],
+     ['coerce,[$Expression,name],['ELT,dc,7]],:
+       ("append"/
+	[[['construct,[name,type],['XLAM,["#1"],['CONS,i,"#1"]]],
+	  ['elt,[type,name,tag],cdownFun],
+	    ['case,['(Boolean),name,tag],
+	       ['XLAM,["#1"],['QEQCAR,"#1",i]]]]
+		 for [.,tag,type] in listOfEntries for i in 0..])] where
+		   cdownFun() ==
+		    gg:=GENSYM()
+		    $InteractiveMode =>
+		      ['XLAM,["#1"],['PROG1,['QCDR,"#1"],
+			['check_-union,['QEQCAR,"#1",i],type,"#1"]]]
+		    ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],['QCDR,gg],
+		      ['check_-union,['QEQCAR,gg,i],type,gg]]]
+  [cList,e]
+
+mkEnumerationFunList(nam,['Enumeration,:SL],e) ==
+  len:= #SL
+  dc := nam
+  cList :=
+    [nil,
+      ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+        ['_^_=,[['Boolean],nam ,nam],['ELT,dc,7]],
+          ['coerce,[nam, ['Symbol]], ['ELT, dc, 8]],
+            ['coerce,[['OutputForm],nam],['ELT,dc, 9]]]
+  [substitute(nam, dc, cList),e]
+
+mkUnionFunList(op,form is ['Union,:listOfEntries],e) ==
+  first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e)
+     -- following call to order is a bug, but needs massive recomp to fix
+  listOfEntries:= orderUnionEntries listOfEntries
+  --1. create representations of subtypes
+  predList:= mkPredList listOfEntries
+  g:=GENSYM()
+  --2. create coercions from subtypes to subUnion
+  cList:=
+   [['_=,[['Boolean],g ,g],['ELT,op,6]],
+    ['coerce,[$Expression,g],['ELT,op,7]],:
+     ("append"/
+      [[['autoCoerce,[g,t],upFun],
+	['coerce,[t,g],cdownFun],
+	['autoCoerce,[t,g],downFun], --this should be removed eventually
+	['case,['(Boolean),g,t],typeFun]]
+	  for p in predList for t in listOfEntries])] where
+	     upFun() ==
+	       p is ['EQCAR,x,n] => ['XLAM,["#1"],['CONS,n,"#1"]]
+	       ['XLAM,["#1"],"#1"]
+	     cdownFun() ==
+	       gg:=GENSYM()
+	       if p is ['EQCAR,x,n] then
+		  ref:=['QCDR,gg]
+		  q:= ['QEQCAR, gg, n]
+	       else
+		  ref:=gg
+		  q:= substitute(gg,"#1",p)
+	       ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],ref,
+		    ['check_-union,q,t,gg]]]
+	     downFun() ==
+		p is ['EQCAR,x,.] =>
+		  ['XLAM,["#1"],['QCDR,"#1"]]
+		['XLAM,["#1"],"#1"]
+	     typeFun() ==
+		p is ['EQCAR,x,n] =>
+		  ['XLAM,["#1"],['QEQCAR,x,n]]
+		['XLAM,["#1"],p]
+  op:=
+    op='Rep => '$
+    op
+  cList:= substitute(op,g,cList)
+  [cList,e]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/c-doc.boot.pamphlet b/src/interp/c-doc.boot.pamphlet
new file mode 100644
index 00000000..d1d0949c
--- /dev/null
+++ b/src/interp/c-doc.boot.pamphlet
@@ -0,0 +1,1298 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/c-doc.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+batchExecute() ==
+  _/RF_-1 '(GENCON INPUT)
+
+getDoc(conName,op,modemap) ==
+  [dc,target,sl,pred,D] := simplifyModemap modemap
+  sig := [target,:sl]
+  null atom dc =>
+    sig := SUBST('$,dc,sig)
+    sig := SUBLISLIS($FormalMapVariableList,rest dc,sig)
+    getDocForDomain(conName,op,sig)
+  if argList := IFCDR getOfCategoryArgument pred then
+     SUBLISLIS($FormalMapArgumentList,argList,sig)
+  sig := SUBST('$,dc,sig)
+  getDocForCategory(conName,op,sig)
+
+getOfCategoryArgument pred ==
+  pred is [fn,:.] and MEMQ(fn,'(AND OR NOT)) =>
+    or/[getOfCategoryArgument x for x in rest pred]
+  pred is ['ofCategory,'_*1,form] => form
+  nil
+
+getDocForCategory(name,op,sig) ==
+  getOpDoc(constructor? name,op,sig) or
+    or/[getOpDoc(constructor? x,op,sig) for x in whatCatCategories name]
+
+getDocForDomain(name,op,sig) ==
+  getOpDoc(constructor? name,op,sig) or
+    or/[getOpDoc(constructor? x,op,sig) for x in whatCatExtDom name]
+
+getOpDoc(abb,op,:sigPart) ==
+  u := LASSOC(op,GETDATABASE(abb,'DOCUMENTATION))
+  $argList : local := $FormalMapVariableList
+  _$: local := '_$
+  sigPart is [sig] => or/[d for [s,:d] in u | sig = s]
+  u
+
+readForDoc fn ==
+  $bootStrapMode: local:= true
+  _/RQ_-LIB_-1 [fn,'SPAD]
+
+recordSignatureDocumentation(opSig,lineno) ==
+  recordDocumentation(rest postTransform opSig,lineno)
+
+recordAttributeDocumentation(['Attribute,att],lineno) ==
+  name := opOf att
+  UPPER_-CASE_-P (PNAME name).0 => nil
+  recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno)
+
+recordDocumentation(key,lineno) ==
+  recordHeaderDocumentation lineno
+  u:= collectComBlock lineno
+  --record NIL to mean "there was no documentation"
+  $maxSignatureLineNumber := lineno
+  $docList := [[key,:u],:$docList]
+  -- leave CAR of $docList alone as required by collectAndDeleteAssoc
+
+recordHeaderDocumentation lineno ==
+  if $maxSignatureLineNumber = 0 then
+    al := [p for (p := [n,:u]) in $COMBLOCKLIST
+               | NULL n or NULL lineno or n < lineno]
+    $COMBLOCKLIST := SETDIFFERENCE($COMBLOCKLIST,al)
+    $headerDocumentation := ASSOCRIGHT al
+    if $headerDocumentation then $maxSignatureLineNumber := 1 --see postDef
+    $headerDocumentation
+
+collectComBlock x ==
+  $COMBLOCKLIST is [[=x,:val],:.] =>
+    u := [:val,:collectAndDeleteAssoc x]
+    $COMBLOCKLIST := rest $COMBLOCKLIST
+    u
+  collectAndDeleteAssoc x
+
+collectAndDeleteAssoc x ==
+--u is (.. (x . a) .. (x . b) .. )  ==> (a b ..) deleting entries from u
+--assumes that the first element is useless
+  for y in tails $COMBLOCKLIST | (s := rest y) repeat
+    while s and first s is [=x,:r] repeat
+      res := [:res,:r]
+      s := rest s
+      RPLACD(y,s)
+  res
+
+finalizeDocumentation() ==
+  unusedCommentLineNumbers := [x for (x := [n,:r]) in $COMBLOCKLIST | r]
+  docList := SUBST("$","%",transDocList($op,$docList))
+  if u := [sig for [sig,:doc] in docList | null doc] then
+    for y in u repeat
+      y = 'constructor => noHeading := true
+      y is [x,b] and b is [='attribute,:r] =>
+        attributes := [[x,:r],:attributes]
+      signatures := [y,:signatures]
+    name := CAR $lisplibForm
+    if noHeading or signatures or attributes or unusedCommentLineNumbers then
+      sayKeyedMsg("S2CD0001",NIL)
+      bigcnt := 1
+      if noHeading or signatures or attributes then
+        sayKeyedMsg("S2CD0002",[STRCONC(STRINGIMAGE bigcnt,'"."),name])
+        bigcnt := bigcnt + 1
+        litcnt := 1
+        if noHeading then
+          sayKeyedMsg("S2CD0003",
+            [STRCONC('"(",STRINGIMAGE litcnt,'")"),name])
+          litcnt := litcnt + 1
+        if signatures then
+          sayKeyedMsg("S2CD0004",
+            [STRCONC('"(",STRINGIMAGE litcnt,'")")])
+          litcnt := litcnt + 1
+          for [op,sig] in signatures repeat
+            s := formatOpSignature(op,sig)
+            sayMSG
+              atom s => ['%x9,s]
+              ['%x9,:s]
+        if attributes then
+          sayKeyedMsg("S2CD0005",
+            [STRCONC('"(",STRINGIMAGE litcnt,'")")])
+          litcnt := litcnt + 1
+          for x in attributes repeat
+            a := form2String x
+            sayMSG
+              atom a => ['%x9,a]
+              ['%x9,:a]
+      if unusedCommentLineNumbers then
+        sayKeyedMsg("S2CD0006",[STRCONC(STRINGIMAGE bigcnt,'"."),name])
+        for [n,r] in unusedCommentLineNumbers repeat
+          sayMSG ['"   ",:bright n,'"   ",r]
+  hn [[:fn(sig,$e),:doc] for [sig,:doc] in docList] where
+    fn(x,e) ==
+      atom x => [x,nil]
+      if #x > 2 then x := TAKE(2,x)
+      SUBLISLIS($FormalMapVariableList,rest $lisplibForm,
+        macroExpand(x,e))
+    hn u ==
+     -- ((op,sig,doc), ...)  --> ((op ((sig doc) ...)) ...)
+      opList := REMDUP ASSOCLEFT u
+      [[op,:[[sig,doc] for [op1,sig,doc] in u | op = op1]] for op in opList]
+
+--=======================================================================
+--             Transformation of ++ comments
+--=======================================================================
+transDocList($constructorName,doclist) == --returns ((key line)...)
+--called ONLY by finalizeDocumentation
+--if $exposeFlag then messages go to file $outStream; flag=nil by default
+  sayBrightly ['"   Processing ",$constructorName,'" for Browser database:"]
+  commentList := transDoc($constructorName,doclist)
+  acc := nil
+  for entry in commentList repeat
+    entry is ['constructor,x] =>
+      conEntry => checkDocError ['"Spurious comments: ",x]
+      conEntry := entry
+    acc := [entry,:acc]
+  conEntry => [conEntry,:acc]
+  checkDocError1 ['"Missing Description"]
+  acc
+
+transDoc(conname,doclist) ==
+--$exposeFlag and not isExposedConstructor conname => nil
+--skip over unexposed constructors when checking system files
+  $x: local
+  rlist := REVERSE doclist
+  for [$x,:lines] in rlist repeat
+    $attribute? : local := $x is [.,[key]] and key = 'attribute
+    null lines =>
+      $attribute? => nil
+      checkDocError1 ['"Not documented!!!!"]
+    u := checkTrim($x,(STRINGP lines => [lines]; $x = 'constructor => first lines; lines))
+    $argl : local := nil    --set by checkGetArgs
+-- tpd: related domain information doesn't exist
+--    if v := checkExtract('"Related Domains:",u) then
+--      $lisplibRelatedDomains:=[w for x in gn(v) | w := fn(x)] where
+--        gn(v) ==  --note: unabbrev checks for correct number of arguments
+--          s := checkExtractItemList v
+--          parse := ncParseFromString s  --is a single conform or a tuple
+--          null parse => nil
+--          parse is ['Tuple,:r] => r
+--          [parse]
+--        fn(x) ==
+--          expectedNumOfArgs := checkNumOfArgs x
+--          null expectedNumOfArgs =>
+--            checkDocError ['"Unknown constructor name?: ",opOf x]
+--            x
+--          expectedNumOfArgs ^= (n := #(IFCDR x)) =>
+--            n = 0 => checkDocError1
+--              ['"You must give arguments to the _"Related Domain_": ",x]
+--            checkDocError
+--              ['"_"Related Domain_" has wrong number of arguments: ",x]
+--            nil
+--          n=0 and atom x => [x]
+--          x
+    longline :=
+      $x = 'constructor =>
+        v :=checkExtract('"Description:",u) or u and
+              checkExtract('"Description:",
+                [STRCONC('"Description: ",first u),:rest u])
+        transformAndRecheckComments('constructor,v or u)
+      transformAndRecheckComments($x,u)
+    acc := [[$x,longline],:acc]  --processor assumes a list of lines
+  NREVERSE acc
+
+checkExtractItemList l ==  --items are separated by commas or end of line
+  acc := nil               --l is list of remaining lines
+  while l repeat           --stop when you get to a line with a colon
+    m := MAXINDEX first l
+    k := charPosition(char '_:,first l,0)
+    k <= m => return nil
+    acc := [first l,:acc]
+    l := rest l
+  "STRCONC"/[x for x in NREVERSE acc]
+
+--NREVERSE("append"/[fn string for string in acc]) where
+--  fn(string) ==
+--    m := MAXINDEX string
+--    acc := nil
+--    i := 0
+--    while i < m and (k := charPosition(char '_,,string,i)) < m repeat
+--      if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc]
+--      i := k + 1
+--    if i < m then
+--      if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc]
+--    acc
+
+transformAndRecheckComments(name,lines) ==
+  $checkingXmptex? := false
+  $x            : local := name
+  $name         : local := 'GlossaryPage
+  $origin       : local := 'gloss
+  $recheckingFlag : local := false
+  $exposeFlagHeading : local := ['"--------",name,'"---------"]
+  if null $exposeFlag then sayBrightly $exposeFlagHeading
+  u := checkComments(name,lines)
+  $recheckingFlag := true
+  checkRewrite(name,[u])
+  $recheckingFlag := false
+  u
+
+checkRewrite(name,lines) == main where   --similar to checkComments from c-doc
+  main ==
+    $checkErrorFlag: local := true
+    margin := 0
+    lines := checkRemoveComments lines
+    u := lines
+    if $checkingXmptex? then
+      u := [checkAddIndented(x,margin) for x in u]
+    $argl := checkGetArgs first u      --set $argl
+    u2 := nil
+    verbatim := nil
+    for x in u repeat
+        w := newString2Words x
+        verbatim =>
+          w and first w = '"\end{verbatim}" =>
+            verbatim := false
+            u2 := append(u2, w)
+          u2 := append(u2, [x])
+        w and first w = '"\begin{verbatim}" =>
+            verbatim := true
+            u2 := append(u2, w)
+        u2 := append(u2, w)
+    u := u2
+    u := checkAddSpaces u
+    u := checkSplit2Words u
+    u := checkAddMacros u
+    u := checkTexht u
+--  checkBalance u
+    okBefore := null $checkErrorFlag
+    checkArguments u
+    if $checkErrorFlag then u := checkFixCommonProblem u
+    checkRecordHash u
+--  u := checkTranVerbatim u
+    checkDecorateForHt u
+
+checkTexht u ==
+  count := 0
+  acc   := nil
+  while u repeat
+    x := first u
+    if x = '"\texht" and (u := IFCDR u) then
+        if not (IFCAR u = $charLbrace) then
+           checkDocError '"First left brace after \texht missing"
+        count := 1  -- drop first argument including braces of \texht
+        while ((y := IFCAR (u := rest u))^= $charRbrace or count > 1) repeat
+          if y = $charLbrace then count := count + 1
+          if y = $charRbrace then count := count - 1
+        x :=  IFCAR (u := rest u)  -- drop first right brace of 1st arg
+    if x = '"\httex" and (u := IFCDR u) and (IFCAR u = $charLbrace) then
+        acc := [IFCAR u,:acc]      --left  brace: add it
+        while (y := IFCAR (u := rest u)) ^= $charRbrace repeat (acc := [y,:acc])
+        acc := [IFCAR u,:acc]      --right brace: add it
+        x :=  IFCAR (u := rest u)  --left brace:  forget it
+        while IFCAR (u := rest u) ^= $charRbrace repeat 'skip
+        x :=  IFCAR (u := rest u)  --forget right brace: move to next char
+    acc := [x,:acc]
+    u := rest u
+  NREVERSE acc
+
+checkRecordHash u ==
+  while u repeat
+    x := first u
+    if STRINGP x and x.0 = $charBack then
+      if member(x,$HTlinks) and (u := checkLookForLeftBrace IFCDR u)
+           and (u := checkLookForRightBrace IFCDR u)
+             and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
+        htname := intern IFCAR u
+        entry := HGET($htHash,htname) or [nil]
+        HPUT($htHash,htname,[first entry,:[[$name,:$origin],:rest entry]])
+      else if member(x,$HTlisplinks) and (u := checkLookForLeftBrace IFCDR u)
+            and (u := checkLookForRightBrace IFCDR u)
+              and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
+        htname := intern checkGetLispFunctionName checkGetStringBeforeRightBrace u
+        entry := HGET($lispHash,htname) or [nil]
+        HPUT($lispHash,htname,[first entry,:[[$name,:$origin],:rest entry]])
+      else if ((p := member(x,'("\gloss" "\spadglos")))
+                 or (q := member(x,'("\glossSee" "\spadglosSee"))))
+                    and (u := checkLookForLeftBrace IFCDR u)
+                      and (u := IFCDR u) then
+          if q then
+             u := checkLookForRightBrace u
+             u := checkLookForLeftBrace IFCDR u
+             u := IFCDR u
+          htname := intern checkGetStringBeforeRightBrace u
+          entry := HGET($glossHash,htname) or [nil]
+          HPUT($glossHash,htname,[first entry,:[[$name,:$origin],:rest entry]])
+      else if x = '"\spadsys" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
+          s := checkGetStringBeforeRightBrace u
+          if s.0 = char '_) then s := SUBSTRING(s,1,nil)
+          parse := checkGetParse s
+          null parse => checkDocError ['"Unparseable \spadtype: ",s]
+          not member(opOf parse,$currentSysList) =>
+            checkDocError ['"Bad system command: ",s]
+          atom parse or not (parse is ['set,arg]) => 'ok  ---assume ok
+          not spadSysChoose($setOptions,arg) =>
+            checkDocError ['"Incorrect \spadsys: ",s]
+            entry := HGET($sysHash,htname) or [nil]
+            HPUT($sysHash,htname,[first entry,:[[$name,:$origin],:rest entry]])
+      else if x = '"\spadtype" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
+          s := checkGetStringBeforeRightBrace u
+          parse := checkGetParse s
+          null parse => checkDocError ['"Unparseable \spadtype: ",s]
+          n := checkNumOfArgs parse
+          null n => checkDocError ['"Unknown \spadtype: ", s]
+          atom parse and n > 0 => 'skip
+          null (key := checkIsValidType parse) =>
+            checkDocError ['"Unknown \spadtype: ", s]
+          atom key => 'ok
+          checkDocError ['"Wrong number of arguments: ",form2HtString key]
+      else if member(x,'("\spadop" "\keyword")) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
+          x := intern checkGetStringBeforeRightBrace u
+          not (GET(x,'Led) or GET(x,'Nud)) =>
+            checkDocError ['"Unknown \spadop: ",x]
+    u := rest u
+  'done
+
+checkGetParse s == ncParseFromString removeBackslashes s
+
+removeBackslashes s ==
+    s = '"" => '""
+    (k := charPosition($charBack,s,0)) < #s =>
+      k = 0 => removeBackslashes SUBSTRING(s,1,nil)
+      STRCONC(SUBSTRING(s,0,k),removeBackslashes SUBSTRING(s,k + 1,nil))
+    s
+
+checkNumOfArgs conform ==
+  conname := opOf conform
+  constructor? conname or (conname := abbreviation? conname) =>
+    #GETDATABASE(conname,'CONSTRUCTORARGS)
+  nil  --signals error
+
+checkIsValidType form == main where
+--returns ok if correct, form is wrong number of arguments, nil if unknown
+  main ==
+    atom form => 'ok
+    [op,:args] := form
+    conname := (constructor? op => op; abbreviation? op)
+    null conname => nil
+    fn(form,GETDATABASE(conname,'COSIG))
+  fn(form,coSig) ==
+    #form ^= #coSig => form
+    or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag]
+      => nil
+    'ok
+
+checkGetLispFunctionName s ==
+  n := #s
+  (k := charPosition(char '_|,s,1)) and k < n and
+    (j := charPosition(char '_|,s,k + 1)) and j < n => SUBSTRING(s,k + 1,j-k-1)
+  checkDocError ['"Ill-formed lisp expression : ",s]
+  'illformed
+
+checkGetStringBeforeRightBrace u ==
+  acc := nil
+  while u repeat
+    x := first u
+    x = $charRbrace => return "STRCONC"/(NREVERSE acc)
+    acc := [x,:acc]
+    u := rest u
+
+--  checkTranVerbatim u ==
+--    acc := nil
+--    while u repeat
+--      x := first u
+--      x = '"\begin" and checkTranVerbatimMiddle u is [middle,:r] =>
+--        acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc]
+--        u := r
+--      if x = '"\spadcommand" then x := '"\spadpaste"
+--      acc := [x,:acc]
+--      u := rest u
+--    NREVERSE acc
+--
+--  checkTranVerbatimMiddle u ==
+--      (y := IFCAR (v := IFCDR u)) = $charLbrace and
+--        (y := IFCAR (v := IFCDR v)) = '"verbatim" and
+--          (y := IFCAR (v := IFCDR v)) = $charRbrace =>
+--             w := IFCDR v
+--             middle := nil
+--             while w and (z := first w) ^= '"\end" repeat
+--               middle := [z,:middle]
+--               w := rest w
+--             if (y := IFCAR (w := IFCDR w)) = $charLbrace and
+--               (y := IFCAR (w := IFCDR w))  = '"verbatim" and
+--                 (y := IFCAR (w := IFCDR w)) = $charRbrace then
+--                    u := IFCDR w
+--             else
+--                checkDocError '"Missing \end{verbatim}"
+--                u := w
+--             [middle,:u]
+--
+--  checkTranVerbatim1 u ==
+--    acc := nil
+--    while u repeat
+--      x := first u
+--      x = '"\begin" and (y := IFCAR (v := IFCDR u)) = $charLbrace and
+--        (y := IFCAR (v := IFCDR v)) = '"verbatim" and
+--          (y := IFCAR (v := IFCDR v)) = $charRbrace =>
+--             w := IFCDR v
+--             middle := nil
+--             while w and (z := first w) ^= '"\end" repeat
+--               middle := [z,:middle]
+--               w := rest w
+--             if (y := IFCAR (w := IFCDR w)) = $charLbrace and
+--               (y := IFCAR (w := IFCDR w))  = '"verbatim" and
+--                 (y := IFCAR (w := IFCDR w)) = $charRbrace then
+--                    u := IFCDR w
+--             acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc]
+--      if x = '"\spadcommand" then x := '"\spadpaste"
+--      acc := [x,:acc]
+--      u := rest u
+--    NREVERSE acc
+
+appendOver [head,:tail] ==
+ acc := LASTNODE head
+ for x in tail repeat
+   end := LASTNODE x
+   RPLACD(acc,x)
+   acc := end
+ head
+
+checkRemoveComments lines ==
+  while lines repeat
+    do
+      line := checkTrimCommented first lines
+      if firstNonBlankPosition line >= 0 then acc := [line,:acc]
+    lines := rest lines
+  NREVERSE acc
+
+checkTrimCommented line ==
+  n := #line
+  k := htcharPosition(char '_%,line,0)
+  --line beginning with % is a comment
+  k = 0 => '""
+  --remarks beginning with %% are comments
+  k >= n - 1 or line.(k + 1) ^= char '_% => line
+  k < #line => SUBSTRING(line,0,k)
+  line
+
+htcharPosition(char,line,i) ==
+  m := #line
+  k := charPosition(char,line,i)
+  k = m => k
+  k > 0 =>
+    line.(k - 1) ^= $charBack => k
+    htcharPosition(char,line,k + 1)
+  0
+
+checkAddMacros u ==
+  acc := nil
+  verbatim := false
+  while u repeat
+    x := first u
+    acc :=
+      x = '"\end{verbatim}" =>
+        verbatim := false
+        [x, :acc]
+      verbatim => [x, :acc]
+      x = '"\begin{verbatim}" =>
+        verbatim := true
+        [x, :acc]
+      y := LASSOC(x,$HTmacs) => [:y,:acc]
+      [x,:acc]
+    u := rest u
+  NREVERSE acc
+
+checkComments(nameSig,lines) == main where
+  main ==
+    $checkErrorFlag: local := false
+    margin := checkGetMargin lines
+    if (null BOUNDP '$attribute? or null $attribute?)
+      and nameSig ^= 'constructor then lines :=
+        [checkTransformFirsts(first nameSig,first lines,margin),:rest lines]
+    u := checkIndentedLines(lines, margin)
+    $argl := checkGetArgs first u      --set $argl
+    u2 := nil
+    verbatim := nil
+    for x in u repeat
+        w := newString2Words x
+        verbatim =>
+          w and first w = '"\end{verbatim}" =>
+            verbatim := false
+            u2 := append(u2, w)
+          u2 := append(u2, [x])
+        w and first w = '"\begin{verbatim}" =>
+            verbatim := true
+            u2 := append(u2, w)
+        u2 := append(u2, w)
+    u := u2
+    u := checkAddSpaces u
+    u := checkIeEg u
+    u := checkSplit2Words u
+    checkBalance u
+    okBefore := null $checkErrorFlag
+    checkArguments u
+    if $checkErrorFlag then u := checkFixCommonProblem u
+    v := checkDecorate u
+    res := "STRCONC"/[y for y in v]
+    res := checkAddPeriod res
+    if $checkErrorFlag then pp res
+    res
+
+checkIndentedLines(u, margin) ==
+  verbatim := false
+  u2 := nil
+  for x in u repeat
+    k := firstNonBlankPosition x
+    k = -1 =>
+        verbatim => u2 := [:u2, $charFauxNewline]
+        u2 := [:u2, '"\blankline "]
+    s := SUBSTRING(x, k, nil)
+    s = '"\begin{verbatim}" =>
+        verbatim := true
+        u2 := [:u2, s]
+    s = '"\end{verbatim}" =>
+        verbatim := false
+        u2 := [:u2, s]
+    verbatim => u2 := [:u2, SUBSTRING(x, margin, nil)]
+    margin = k => u2 := [:u2, s]
+    u2 := [:u2, STRCONC('"\indented{",STRINGIMAGE(k-margin),'"}{",checkAddSpaceSegments(s,0),'"}")]
+  u2
+
+newString2Words l ==
+  not STRINGP l => [l]
+  m := MAXINDEX l
+  m = -1 => NIL
+  i := 0
+  [w while newWordFrom(l,i,m) is [w,i]]
+
+newWordFrom(l,i,m) ==
+  while i <= m and l.i = " " repeat i := i + 1
+  i > m => NIL
+  buf := '""
+  ch := l.i
+  ch = $charFauxNewline => [$stringFauxNewline, i+ 1]
+  done := false
+  while i <= m and not done repeat
+    ch := l.i
+    ch = $charBlank or ch = $charFauxNewline => done := true
+    buf := STRCONC(buf,ch)
+    i := i + 1
+  [buf,i]
+
+checkAddPeriod s ==  --No, just leave blank at the end (rdj: 10/18/91)
+  m := MAXINDEX s
+  lastChar := s . m
+  lastChar = char '_! or lastChar = char '_? or lastChar = char '_. => s
+  lastChar = char '_, or lastChar = char '_; =>
+    s . m := (char '_.)
+    s
+  s
+
+checkGetArgs u ==
+  NOT STRINGP u => nil
+  m := MAXINDEX u
+  k := firstNonBlankPosition(u)
+  k > 0 => checkGetArgs SUBSTRING(u,k,nil)
+  stringPrefix?('"\spad{",u) =>
+    k := getMatchingRightPren(u,6,char '_{,char '_}) or m
+    checkGetArgs SUBSTRING(u,6,k-6)
+  (i := charPosition(char '_(,u,0)) > m => nil
+  (u . m) ^= char '_) => nil
+  while (k := charPosition($charComma,u,i + 1)) < m repeat
+    acc := [trimString SUBSTRING(u,i + 1,k - i - 1),:acc]
+    i := k
+  NREVERSE [SUBSTRING(u,i + 1,m - i - 1),:acc]
+
+checkGetMargin lines ==
+  while lines repeat
+    do
+      x := first lines
+      k := firstNonBlankPosition x
+      k = -1 => nil
+      margin := (margin => MIN(margin,k); k)
+    lines := rest lines
+  margin or 0
+
+firstNonBlankPosition(x,:options) ==
+  start := IFCAR options or 0
+  k := -1
+  for i in start..MAXINDEX x repeat
+    if x.i ^= $charBlank then return (k := i)
+  k
+
+checkAddIndented(x,margin) ==
+  k := firstNonBlankPosition x
+  k = -1 => '"\blankline "
+  margin = k => x
+  STRCONC('"\indented{",STRINGIMAGE(k-margin),'"}{",checkAddSpaceSegments(SUBSTRING(x,k,nil),0),'"}")
+
+checkAddSpaceSegments(u,k) ==
+  m := MAXINDEX u
+  i := charPosition($charBlank,u,k)
+  m < i => u
+  j := i
+  while (j := j + 1) < m and u.j = (char '_  ) repeat 'continue
+  n := j - i   --number of blanks
+  n > 1 => STRCONC(SUBSTRING(u,0,i),'"\space{",
+             STRINGIMAGE n,'"}",checkAddSpaceSegments(SUBSTRING(u,i + n,nil),0))
+  checkAddSpaceSegments(u,j)
+
+checkTrim($x,lines) == main where
+  main ==
+    s := [wherePP first lines]
+    for x in rest lines repeat
+      j := wherePP x
+      if not MEMQ(j,s) then
+        checkDocError [$x,'" has varying indentation levels"]
+        s := [j,:s]
+    [trim y for y in lines]
+  wherePP(u) ==
+    k := charPosition($charPlus,u,0)
+    k = #u or charPosition($charPlus,u,k + 1) ^= k + 1 =>
+      systemError '" Improper comment found"
+    k
+  trim(s) ==
+    k := wherePP(s)
+    return SUBSTRING(s,k + 2,nil)
+    m := MAXINDEX s
+    n := k + 2
+    for j in (k + 2)..m while s.j = $charBlank repeat (n := n + 1)
+    SUBSTRING(s,n,nil)
+
+checkExtract(header,lines) ==
+  while lines repeat
+    line := first lines
+    k := firstNonBlankPosition line           --k gives margin of Description:
+    substring?(header,line,k) => return nil
+    lines := rest lines
+  null lines => nil
+  u := first lines
+  j := charPosition(char '_:,u,k)
+  margin := k
+  firstLines :=
+    (k := firstNonBlankPosition(u,j + 1)) ^= -1 =>
+      [SUBSTRING(u,j + 1,nil),:rest lines]
+    rest lines
+  --now look for another header; if found skip all rest of these lines
+  acc := nil
+  for line in firstLines repeat
+    do
+      m := #line
+      (k := firstNonBlankPosition line) = -1     => 'skip  --include if blank
+      k > margin                                 => 'skip  --include if idented
+      not UPPER_-CASE_-P line.k                  => 'skip  --also if not upcased
+      (j := charPosition(char '_:,line,k)) = m   => 'skip  --or if not colon, or
+      (i := charPosition(char '_ ,line,k+1)) < j => 'skip  --blank before colon
+      return nil
+    acc := [line,:acc]
+  NREVERSE acc
+
+checkFixCommonProblem u ==
+  acc := nil
+  while u repeat
+    x := first u
+    x = $charLbrace and member(next := IFCAR rest u,$HTspadmacros) and
+                       (IFCAR IFCDR rest u ^= $charLbrace) =>
+      checkDocError ['"Reversing ",next,'" and left brace"]
+      acc := [$charLbrace,next,:acc]  --reverse order of brace and command
+      u := rest rest u
+    acc := [x,:acc]
+    u := rest u
+  NREVERSE acc
+
+checkDecorate u ==
+  count := 0
+  spadflag := false    --means OK to wrap single letter words with \s{}
+  mathSymbolsOk := false
+  acc := nil
+  verbatim := false
+  while u repeat
+    x := first u
+
+    if not verbatim then
+      if x = '"\em" then
+        if count > 0 then
+          mathSymbolsOk := count - 1
+          spadflag := count - 1
+        else checkDocError ['"\em must be enclosed in braces"]
+      if member(x,'("\spadpaste" "\spad" "\spadop")) then mathSymbolsOk := count
+      if member(x,'("\s" "\spadtype" "\spadsys" "\example" "\andexample" "\spadop" "\spad" "\spadignore" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count
+      else if x = $charLbrace then
+        count := count + 1
+      else if x = $charRbrace then
+        count := count - 1
+        if mathSymbolsOk = count then mathSymbolsOk := false
+        if spadflag = count then spadflag := false
+      else if not mathSymbolsOk and member(x,'("+" "*" "=" "==" "->")) then
+        if $checkingXmptex? then
+          checkDocError ["Symbol ",x,'" appearing outside \spad{}"]
+
+    acc :=
+      x = '"\end{verbatim}" =>
+        verbatim := false
+        [x, :acc]
+      verbatim => [x, :acc]
+      x = '"\begin{verbatim}" =>
+        verbatim := true
+        [x, :acc]
+
+      x = '"\begin" and first (v := IFCDR u) = $charLbrace and
+        first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace
+          =>
+            u := v
+            ['"\blankline ",:acc]
+      x = '"\end" and first (v := IFCDR u) = $charLbrace and
+        first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace
+          =>
+            u := v
+            acc
+      x = char '_$ or x = '"$"  => ['"\$",:acc]
+      x = char '_% or x = '"%"  => ['"\%",:acc]
+      x = char '_, or x = '","  => ['",{}",:acc]
+      x = '"\spad" => ['"\spad",:acc]
+      STRINGP x and DIGITP x.0 => [x,:acc]
+      null spadflag and
+        (CHARP x and ALPHA_-CHAR_-P x and not MEMQ(x,$charExclusions) or
+          member(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc]
+      null spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or member(x,'("true" "false"))) =>
+        [$charRbrace,x,$charLbrace,'"\spad",:acc]  --wrap x1, alpha3, etc
+      xcount := #x
+      xcount = 3 and x.1 = char 't and x.2 = char 'h =>
+        ['"th",$charRbrace,x.0,$charLbrace,'"\spad",:acc]
+      xcount = 4 and x.1 = char '_- and x.2 = char 't and x.3 = char 'h =>
+        ['"-th",$charRbrace,x.0,$charLbrace,'"\spad",:acc]
+      xcount = 2 and x.1 = char 'i or              --wrap ei, xi, hi
+        null spadflag and xcount > 0 and xcount < 4 and not member(x,'("th" "rd" "st")) and
+          hasNoVowels x =>                         --wrap words with no vowels
+            [$charRbrace,x,$charLbrace,'"\spad",:acc]
+      [checkAddBackSlashes x,:acc]
+    u := rest u
+  NREVERSE acc
+
+hasNoVowels x ==
+  max := MAXINDEX x
+  x.max = char 'y => false
+  and/[not isVowel(x.i) for i in 0..max]
+
+isVowel c ==
+  EQ(c,char 'a) or EQ(c,char 'e) or EQ(c,char 'i) or EQ(c,char 'o) or EQ(c,char 'u) or
+    EQ(c,char 'A) or EQ(c,char 'E) or EQ(c,char 'I) or EQ(c,char 'O) or EQ(c,char 'U)
+
+
+checkAddBackSlashes s ==
+  (CHARP s and (c := s)) or (#s = 1 and (c := s.0)) =>
+    MEMQ(s,$charEscapeList) => STRCONC($charBack,c)
+    s
+  k := 0
+  m := MAXINDEX s
+  insertIndex := nil
+  while k <= m repeat
+    do
+      char := s.k
+      char = $charBack => k := k + 2
+      MEMQ(char,$charEscapeList) => return (insertIndex := k)
+    k := k + 1
+  insertIndex => checkAddBackSlashes STRCONC(SUBSTRING(s,0,insertIndex),$charBack,s.k,SUBSTRING(s,insertIndex + 1,nil))
+  s
+
+checkAddSpaces u ==
+  null u => nil
+  null rest u => u
+  space := $charBlank
+  u2 := nil
+  for i in 1.. for f in u repeat
+    -- want newlines before and after begin/end verbatim and between lines
+    -- since this might be written to a file, we can't really use
+    -- newline characters. The Browser and HD will do the translation
+    -- later.
+    if f = '"\begin{verbatim}" then
+        space := $charFauxNewline
+        if null u2 then u2 := [space]
+
+    if i > 1 then u2 := [:u2, space, f]
+    else u2 := [:u2, f]
+
+    if f = '"\end{verbatim}" then
+        u2 := [:u2, space]
+        space := $charBlank
+  u2
+
+checkIeEg u ==
+  acc := nil
+  verbatim := false
+  while u repeat
+    x := first u
+    acc :=
+      x = '"\end{verbatim}" =>
+        verbatim := false
+        [x, :acc]
+      verbatim => [x, :acc]
+      x = '"\begin{verbatim}" =>
+        verbatim := true
+        [x, :acc]
+      z := checkIeEgfun x => [:NREVERSE z,:acc]
+      [x,:acc]
+    u := rest u
+  NREVERSE acc
+
+checkIeEgfun x ==
+  CHARP x => nil
+  x = '"" => nil
+  m := MAXINDEX x
+  for k in 0..(m - 3) repeat
+    x.(k + 1) = $charPeriod and x.(k + 3) = $charPeriod and
+     (x.k = char 'i and x.(k + 2) = char 'e and (key := '"that is")
+       or x.k = char 'e and x.(k + 2) = char 'g and (key := '"for example")) =>
+          firstPart := (k > 0 => [SUBSTRING(x,0,k)]; nil)
+          result := [:firstPart,'"\spadignore{",SUBSTRING(x,k,4),'"}",
+                     :checkIeEgfun SUBSTRING(x,k+4,nil)]
+  result
+
+checkSplit2Words u ==
+  acc := nil
+  while u repeat
+    x := first u
+    acc :=
+      x = '"\end{verbatim}" =>
+        verbatim := false
+        [x, :acc]
+      verbatim => [x, :acc]
+      x = '"\begin{verbatim}" =>
+        verbatim := true
+        [x, :acc]
+      z := checkSplitBrace x => [:NREVERSE z,:acc]
+      [x,:acc]
+    u := rest u
+  NREVERSE acc
+
+checkSplitBrace x ==
+  CHARP x => [x]
+  #x = 1 => [x.0]
+  (u := checkSplitBackslash x)
+     and rest u  => "append"/[checkSplitBrace y for y in u]
+  m := MAXINDEX x
+  (u := checkSplitOn x)
+     and rest u  => "append"/[checkSplitBrace y for y in u]
+  (u := checkSplitPunctuation x)
+     and rest u  => "append"/[checkSplitBrace y for y in u]
+  [x]
+
+checkSplitBackslash x ==
+  not STRINGP x => [x]
+  m := MAXINDEX x
+  (k := charPosition($charBack,x,0)) < m =>
+    m = 1 or ALPHA_-CHAR_-P(x . (k + 1)) =>     --starts with a backslash so..
+      (k := charPosition($charBack,x,1)) < m => --..see if there is another
+         [SUBSTRING(x,0,k),:checkSplitBackslash SUBSTRING(x,k,nil)]  -- yup
+      [x]                                       --no, just return line
+    k = 0 => --starts with backspace but x.1 is not a letter; break it up
+      [SUBSTRING(x,0,2),:checkSplitBackslash SUBSTRING(x,2,nil)]
+    u := SUBSTRING(x,0,k)
+    v := SUBSTRING(x,k,2)
+    k + 1 = m => [u,v]
+    [u,v,:checkSplitBackslash SUBSTRING(x,k + 2,nil)]
+  [x]
+
+checkSplitPunctuation x ==
+  CHARP x => [x]
+  m := MAXINDEX x
+  m < 1 => [x]
+  lastchar := x.m
+  lastchar = $charPeriod and x.(m - 1) = $charPeriod =>
+    m = 1 => [x]
+    m > 3 and x.(m-2) = $charPeriod =>
+      [:checkSplitPunctuation SUBSTRING(x,0,m-2),'"..."]
+    [:checkSplitPunctuation SUBSTRING(x,0,m-1),'".."]
+  lastchar = $charPeriod or lastchar = $charSemiColon or lastchar = $charComma
+    => [SUBSTRING(x,0,m),lastchar]
+  m > 1 and x.(m - 1) = $charQuote => [SUBSTRING(x,0,m - 1),SUBSTRING(x,m-1,nil)]
+  (k := charPosition($charBack,x,0)) < m =>
+    k = 0 =>
+      m = 1 or HGET($htMacroTable,x) or ALPHA_-CHAR_-P x.1 => [x]
+      v := SUBSTRING(x,2,nil)
+      [SUBSTRING(x,0,2),:checkSplitPunctuation v]
+    u := SUBSTRING(x,0,k)
+    v := SUBSTRING(x,k,nil)
+    [:checkSplitPunctuation u,:checkSplitPunctuation v]
+  (k := charPosition($charDash,x,1)) < m =>
+    u := SUBSTRING(x,k + 1,nil)
+    [SUBSTRING(x,0,k),$charDash,:checkSplitPunctuation u]
+  [x]
+
+checkSplitOn(x) ==
+  CHARP x => [x]
+  l := $charSplitList
+  m := MAXINDEX x
+  while l repeat
+    char := first l
+    do
+      m = 0 and x.0 = char => return (k := -1)  --special exit
+      k := charPosition(char,x,0)
+      k > 0 and x.(k - 1) = $charBack => [x]
+      k <= m => return k
+    l := rest l
+  null l => [x]
+  k = -1 => [char]
+  k = 0 => [char,SUBSTRING(x,1,nil)]
+  k = MAXINDEX x => [SUBSTRING(x,0,k),char]
+  [SUBSTRING(x,0,k),char,:checkSplitOn SUBSTRING(x,k + 1,nil)]
+
+
+checkBalance u ==
+  checkBeginEnd u
+  stack := nil
+  while u repeat
+    do
+      x := first u
+      openClose := ASSOC(x,$checkPrenAlist)  --is it an open bracket?
+        => stack := [CAR openClose,:stack]   --yes, push the open bracket
+      open  := rassoc(x,$checkPrenAlist) =>  --it is a close bracket!
+        stack is [top,:restStack] => --does corresponding open bracket match?
+          if open ^= top then          --yes: just pop the stack
+            checkDocError
+              ['"Mismatch: left ",checkSayBracket top,'" matches right ",checkSayBracket open]
+          stack := restStack
+        checkDocError ['"Missing left ",checkSayBracket open]
+    u := rest u
+  if stack then
+    for x in NREVERSE stack repeat
+      checkDocError ['"Missing right ",checkSayBracket x]
+  u
+
+checkSayBracket x ==
+  x = char '_( or x = char '_) => '"pren"
+  x = char '_{ or x = char '_} => '"brace"
+  '"bracket"
+
+checkBeginEnd u ==
+  beginEndStack := nil
+  while u repeat
+    IDENTITY
+      x := first u
+      STRINGP x and x.0 = $charBack and #x > 2 and not HGET($htMacroTable,x)
+        and not (x = '"\spadignore") and IFCAR IFCDR u = $charLbrace
+          and not
+            (substring?('"\radiobox",x,0) or substring?('"\inputbox",x,0))=>
+             --allow 0 argument guys to pass through
+              checkDocError ["Unexpected HT command: ",x]
+      x = '"\beginitems" =>
+        beginEndStack := ["items",:beginEndStack]
+      x = '"\begin" =>
+        u is [.,=$charLbrace,y,:r] and CAR r = $charRbrace =>
+          if not member(y,$beginEndList) then
+            checkDocError ['"Unknown begin type: \begin{",y,'"}"]
+          beginEndStack := [y,:beginEndStack]
+          u := r
+        checkDocError ['"Improper \begin command"]
+      x = '"\item" =>
+        member(IFCAR beginEndStack,'("items" "menu")) => nil
+        null beginEndStack =>
+          checkDocError ['"\item appears outside a \begin-\end"]
+        checkDocError ['"\item appears within a \begin{",IFCAR beginEndStack,'"}.."]
+      x = '"\end" =>
+        u is [.,=$charLbrace,y,:r] and CAR r = $charRbrace =>
+          y = IFCAR beginEndStack =>
+            beginEndStack := rest beginEndStack
+            u := r
+          checkDocError ['"Trying to match \begin{",IFCAR beginEndStack,'"} with \end{",y,"}"]
+        checkDocError ['"Improper \end command"]
+    u := rest u
+  beginEndStack => checkDocError ['"Missing \end{",first beginEndStack,'"}"]
+  'ok
+
+checkArguments u ==
+  while u repeat
+    do
+      x := first u
+      null (k := HGET($htMacroTable,x)) => 'skip
+      k = 0 => 'skip
+      k > 0 => checkHTargs(x,rest u,k,nil)
+      checkHTargs(x,rest u,-k,true)
+    u := rest u
+  u
+
+checkHTargs(keyword,u,nargs,integerValue?) ==
+--u should start with an open brace ...
+   nargs = 0 => 'ok
+   if not (u := checkLookForLeftBrace u) then
+     return checkDocError ['"Missing argument for ",keyword]
+   if not (u := checkLookForRightBrace IFCDR u) then
+     return checkDocError ['"Missing right brace for ",keyword]
+   checkHTargs(keyword,rest u,nargs - 1,integerValue?)
+
+checkLookForLeftBrace(u) ==   --return line beginning with left brace
+  while u repeat
+    x := first u
+    if x = $charLbrace then return u
+    x ^= $charBlank => return nil
+    u := rest u
+  u
+
+checkLookForRightBrace(u) ==  --return line beginning with right brace
+  count := 0
+  while u repeat
+    x := first u
+    do
+      x = $charRbrace =>
+        count = 0 => return (found := u)
+        count := count - 1
+      x = $charLbrace => count := count + 1
+    u := rest u
+  found
+
+checkInteger s ==
+  CHARP s => false
+  s = '"" => false
+  and/[DIGIT_-CHAR_-P s.i for i in 0..MAXINDEX s]
+
+checkTransformFirsts(opname,u,margin) ==
+--case 1: \spad{...
+--case 2: form(args)
+--case 3: form arg
+--case 4: op arg
+--case 5: arg op arg
+  namestring := PNAME opname
+  if namestring = '"Zero" then namestring := '"0"
+  else if namestring = '"One" then namestring := '"1"
+  margin > 0 =>
+    s := leftTrim u
+    STRCONC(fillerSpaces margin,checkTransformFirsts(opname,s,0))
+  m := MAXINDEX u
+  m < 2 => u
+  u.0 = $charBack => u
+  ALPHA_-CHAR_-P u.0 =>
+    i := checkSkipToken(u,0,m) or return u
+    j := checkSkipBlanks(u,i,m) or return u
+    open := u.j
+    open = char '_[ and (close := char '_]) or
+          open = char '_(  and (close := char '_)) =>
+      k := getMatchingRightPren(u,j + 1,open,close)
+      namestring ^= (firstWord := SUBSTRING(u,0,i)) =>
+        checkDocError ['"Improper first word in comments: ",firstWord]
+        u
+      null k =>
+         if open = char '_[
+           then checkDocError ['"Missing close bracket on first line: ", u]
+           else checkDocError ['"Missing close parenthesis on first line: ", u]
+         u
+      STRCONC('"\spad{",SUBSTRING(u,0,k + 1),'"}",SUBSTRING(u,k + 1,nil))
+    k := checkSkipToken(u,j,m) or return u
+    infixOp := INTERN SUBSTRING(u,j,k - j)
+    not GET(infixOp,'Led) =>                                     --case 3
+      namestring ^= (firstWord := SUBSTRING(u,0,i)) =>
+        checkDocError ['"Improper first word in comments: ",firstWord]
+        u
+      #(p := PNAME infixOp) = 1 and (open := p.0) and
+        (close := LASSOC(open,$checkPrenAlist)) =>  --have an open bracket
+          l := getMatchingRightPren(u,k + 1,open,close)
+          if l > MAXINDEX u then l := k - 1
+          STRCONC('"\spad{",SUBSTRING(u,0,l + 1),'"}",SUBSTRING(u,l + 1,nil))
+      STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil))
+    l := checkSkipBlanks(u,k,m) or return u
+    n := checkSkipToken(u,l,m) or return u
+    namestring ^= PNAME infixOp =>
+      checkDocError ['"Improper initial operator in comments: ",infixOp]
+      u
+    STRCONC('"\spad{",SUBSTRING(u,0,n),'"}",SUBSTRING(u,n,nil))   --case 5
+  true =>          -- not ALPHA_-CHAR_-P u.0 =>
+    i := checkSkipToken(u,0,m) or return u
+    namestring ^= (firstWord := SUBSTRING(u,0,i)) =>
+      checkDocError ['"Improper first word in comments: ",firstWord]
+      u
+    prefixOp := INTERN SUBSTRING(u,0,i)
+    not GET(prefixOp,'Nud) =>
+      u ---what could this be?
+    j := checkSkipBlanks(u,i,m) or return u
+    u.j = char '_( =>                                            --case 4
+      j := getMatchingRightPren(u,j + 1,char '_(,char '_))
+      j > m => u
+      STRCONC('"\spad{",SUBSTRING(u,0,j + 1),'"}",SUBSTRING(u,j + 1,nil))
+    k := checkSkipToken(u,j,m) or return u
+    namestring ^= (firstWord := SUBSTRING(u,0,i)) =>
+      checkDocError ['"Improper first word in comments: ",firstWord]
+      u
+    STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil))
+
+getMatchingRightPren(u,j,open,close) ==
+  count := 0
+  m := MAXINDEX u
+  for i in j..m repeat
+    c := u . i
+    do
+      c = close =>
+        count = 0 => return (found := i)
+        count := count - 1
+      c = open => count := count + 1
+  found
+
+checkSkipBlanks(u,i,m) ==
+  while i < m and u.i = $charBlank repeat i := i + 1
+  i = m => nil
+  i
+
+checkSkipToken(u,i,m) ==
+  ALPHA_-CHAR_-P(u.i) => checkSkipIdentifierToken(u,i,m)
+  checkSkipOpToken(u,i,m)
+
+checkSkipOpToken(u,i,m) ==
+  while i < m and
+    (not(checkAlphabetic(u.i)) and not(member(u.i,$charDelimiters))) repeat
+      i := i + 1
+  i = m => nil
+  i
+
+checkSkipIdentifierToken(u,i,m) ==
+  while i < m and checkAlphabetic u.i repeat i := i + 1
+  i = m => nil
+  i
+
+checkAlphabetic c ==
+  ALPHA_-CHAR_-P c or DIGITP c or MEMQ(c,$charIdentifierEndings)
+
+--=======================================================================
+--        Code for creating a personalized report for ++ comments
+--=======================================================================
+docreport(nam) ==
+--creates a report for person "nam" using file "whofiles"
+  OBEY '"rm docreport.input"
+  OBEY STRCONC('"echo _")bo setOutStream('",STRINGIMAGE nam,'")_" > temp.input")
+  OBEY '"cat docreport.header temp.input > docreport.input"
+  OBEY STRCONC('"awk '/",STRINGIMAGE nam,'"/ {printf(_")co %s.spad\n_",$2)}' whofiles > temp.input")
+  OBEY '"cat docreport.input temp.input > temp1.input"
+  OBEY '"cat temp1.input docreport.trailer > docreport.input"
+  OBEY '"rm temp.input"
+  OBEY '"rm temp1.input"
+  SETQ(_/EDITFILE,'"docreport.input")
+  _/RQ()
+
+setOutStream nam ==
+  filename := STRCONC('"/tmp/",STRINGIMAGE nam,".docreport")
+  $outStream := MAKE_-OUTSTREAM filename
+
+whoOwns(con) ==
+  null $exposeFlag => nil
+--con=constructor name (id beginning with a capital), returns owner as a string
+  filename := GETDATABASE(con,'SOURCEFILE)
+  quoteChar := char '_"
+  OBEY STRCONC('"awk '$2 == ",quoteChar,filename,quoteChar,'" {print $1}' whofiles > /tmp/temp")
+  instream := MAKE_-INSTREAM '"/tmp/temp"
+  value :=
+    EOFP instream => nil
+    READLINE instream
+  SHUT instream
+  value
+
+--=======================================================================
+--             Report Documentation Error
+--=======================================================================
+checkDocError1 u ==
+--when compiling for documentation, ignore certain errors
+  BOUNDP '$compileDocumentation and $compileDocumentation => nil
+  checkDocError u
+
+checkDocError u ==
+  $checkErrorFlag := true
+  msg :=
+    $recheckingFlag =>
+      $constructorName => checkDocMessage u
+      concat('"> ",u)
+    $constructorName => checkDocMessage u
+    u
+  if $exposeFlag and $exposeFlagHeading then
+    SAYBRIGHTLY1($exposeFlagHeading,$outStream)
+    sayBrightly $exposeFlagHeading
+    $exposeFlagHeading := nil
+  sayBrightly msg
+  if $exposeFlag then SAYBRIGHTLY1(msg,$outStream)
+  --if called by checkDocFile (see file checkdoc.boot)
+
+checkDocMessage u ==
+  sourcefile := GETDATABASE($constructorName,'SOURCEFILE)
+  person := whoOwns $constructorName or '"---"
+  middle :=
+    BOUNDP '$x => ['"(",$x,'"): "]
+    ['": "]
+  concat(person,'">",sourcefile,'"-->",$constructorName,middle,u)
+
+checkDecorateForHt u ==
+  count := 0
+  spadflag := false    --means OK to wrap single letter words with \s{}
+  while u repeat
+    x := first u
+    do
+      if x = '"\em" then
+        if count > 0 then spadflag := count - 1
+        else checkDocError ['"\em must be enclosed in braces"]
+      if member(x,'("\s" "\spadop" "\spadtype" "\spad" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count
+      else if x = $charLbrace then count := count + 1
+      else if x = $charRbrace then
+        count := count - 1
+        if spadflag = count then spadflag := false
+      else if not spadflag and member(x,'("+" "*" "=" "==" "->")) then
+        if $checkingXmptex? then
+          checkDocError ["Symbol ",x,'" appearing outside \spad{}"]
+      x = '"$" or x = '"%" => checkDocError ['"Unescaped ",x]
+--      null spadflag and STRINGP x and (member(x,$argl) or #x = 1
+--        and ALPHA_-CHAR_-P x.0) and not member(x,'("a" "A")) =>
+--          checkDocError1 ['"Naked ",x]
+--      null spadflag and STRINGP x and (not x.0 = $charBack and not DIGITP(x.0) and DIGITP(x.(MAXINDEX x))or member(x,'("true" "false")))
+--        => checkDocError1 ["Naked ",x]
+    u := rest u
+  u
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/c-util.boot.pamphlet b/src/interp/c-util.boot.pamphlet
new file mode 100644
index 00000000..3803a39a
--- /dev/null
+++ b/src/interp/c-util.boot.pamphlet
@@ -0,0 +1,2088 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/c-util.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+This file contains both the {\bf boot} code and the {\bf Lisp}
+code that is the result of the {\bf boot to lisp} translation.
+We need to keep the translated code around so we can bootstrap
+the system. In other words, we need this boot code translated
+so we can build the boot translator. 
+
+{\bf NOTE WELL: IF YOU CHANGE THIS BOOT CODE YOU MUST TRANSLATE
+THIS CODE TO LISP AND STORE THE RESULTING LISP CODE BACK INTO
+THIS FILE.}
+
+See the {\bf c-util.clisp} section below.
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Debugging Functions
+ 
+CONTINUE() == continue()
+continue() == FIN comp($x,$m,$f)
+ 
+LEVEL(:l) == APPLY('level,l)
+level(:l) ==
+  null l => same()
+  l is [n] and INTEGERP n => displayComp ($level:= n)
+  SAY '"Correct format: (level n) where n is the level you want to go to"
+ 
+UP() == up()
+up() == displayComp ($level:= $level-1)
+ 
+SAME() == same()
+same() == displayComp $level
+ 
+DOWN() == down()
+down() == displayComp ($level:= $level+1)
+ 
+displaySemanticErrors() ==
+  n:= #($semanticErrorStack:= REMDUP $semanticErrorStack)
+  n=0 => nil
+  l:= NREVERSE $semanticErrorStack
+  $semanticErrorStack:= nil
+  sayBrightly bright '"  Semantic Errors:"
+  displaySemanticError(l,CUROUTSTREAM)
+  sayBrightly '" "
+  displayWarnings()
+ 
+displaySemanticError(l,stream) ==
+  for x in l for i in 1.. repeat
+    sayBrightly(['"      [",i,'"] ",:first x],stream)
+ 
+displayWarnings() ==
+  n:= #($warningStack:= REMDUP $warningStack)
+  n=0 => nil
+  sayBrightly bright '"  Warnings:"
+  l := NREVERSE $warningStack
+  displayWarning(l,CUROUTSTREAM)
+  $warningStack:= nil
+  sayBrightly '" "
+ 
+displayWarning(l,stream) ==
+  for x in l for i in 1.. repeat
+    sayBrightly(['"      [",i,'"] ",:x],stream)
+ 
+displayComp level ==
+  $tripleCache:= nil
+  $bright:= " << "
+  $dim:= " >> "
+  if $insideCapsuleFunctionIfTrue=true then
+    sayBrightly ['"error in function",'%b,$op,'%d,'%l]
+  --mathprint removeZeroOne mkErrorExpr level
+  pp removeZeroOne mkErrorExpr level
+  sayBrightly ['"****** level",'%b,level,'%d,'" ******"]
+  [$x,$m,$f,$exitModeStack]:= ELEM($s,level)
+  ($X:=$x;$M:=$m;$F:=$f)
+  SAY("$x:= ",$x)
+  SAY("$m:= ",$m)
+  SAY "$f:="
+  F_,PRINT_-ONE $f
+  nil
+ 
+mkErrorExpr level ==
+  bracket ASSOCLEFT DROP(level-#$s,$s) where
+    bracket l ==
+      #l<2 => l
+      l is [a,b] =>
+        highlight(b,a) where
+          highlight(b,a) ==
+            atom b =>
+              substitute(var,b,a) where
+                var:= INTERN STRCONC(STRINGIMAGE $bright,STRINGIMAGE b,STRINGIMAGE $dim)
+            highlight1(b,a) where
+              highlight1(b,a) ==
+                atom a => a
+                a is [ =b,:c] => [$bright,b,$dim,:c]
+                [highlight1(b,first a),:highlight1(b,rest a)]
+      substitute(bracket rest l,first rest l,first l)
+ 
+compAndTrace [x,m,e] ==
+  SAY("tracing comp, compFormWithModemap of: ",x)
+  TRACE_,1(["comp","compFormWithModemap"],nil)
+  T:= comp(x,m,e)
+  UNTRACE_,1 "comp"
+  UNTRACE_,1 "compFormWithModemap"
+  T
+ 
+errorRef s == stackWarning ['%b,s,'%d,'"has no value"]
+ 
+unErrorRef s == unStackWarning ['%b,s,'%d,'"has no value"]
+ 
+--% ENVIRONMENT FUNCTIONS
+ 
+consProplistOf(var,proplist,prop,val) ==
+  semchkProplist(var,proplist,prop,val)
+  $InteractiveMode and (u:= ASSOC(prop,proplist)) =>
+    RPLACD(u,val)
+    proplist
+  [[prop,:val],:proplist]
+ 
+warnLiteral x ==
+  stackSemanticError(['%b,x,'%d,
+    '"is BOTH a variable and a literal"],nil)
+ 
+intersectionEnvironment(e,e') ==
+  ce:= makeCommonEnvironment(e,e')
+  ic:= intersectionContour(deltaContour(e,ce),deltaContour(e',ce))
+  e'':= (ic => addContour(ic,ce); ce)
+  --$ie:= e''   this line is for debugging purposes only
+ 
+deltaContour([[c,:cl],:el],[[c',:cl'],:el']) ==
+  ^el=el' => systemError '"deltaContour" --a cop out for now
+  eliminateDuplicatePropertyLists contourDifference(c,c') where
+    contourDifference(c,c') == [first x for x in tails c while (x^=c')]
+    eliminateDuplicatePropertyLists contour ==
+      contour is [[x,:.],:contour'] =>
+        LASSOC(x,contour') =>
+                               --save some CONSing if possible
+          [first contour,:DELLASOS(x,eliminateDuplicatePropertyLists contour')]
+        [first contour,:eliminateDuplicatePropertyLists contour']
+      nil
+ 
+intersectionContour(c,c') ==
+  $var: local
+  computeIntersection(c,c') where
+    computeIntersection(c,c') ==
+      varlist:= REMDUP ASSOCLEFT c
+      varlist':= REMDUP ASSOCLEFT c'
+      interVars:= setIntersection(varlist,varlist')
+      unionVars:= setUnion(varlist,varlist')
+      diffVars:= setDifference(unionVars,interVars)
+      modeAssoc:= buildModeAssoc(diffVars,c,c')
+      [:modeAssoc,:
+        [[x,:proplist]
+          for [x,:y] in c | member(x,interVars) and
+            (proplist:= interProplist(y,LASSOC($var:= x,c')))]]
+    interProplist(p,p') ==
+                            --p is new proplist; p' is old one
+      [:modeCompare(p,p'),:[pair' for pair in p | (pair':= compare(pair,p'))]]
+    buildModeAssoc(varlist,c,c') ==
+      [[x,:mp] for x in varlist | (mp:= modeCompare(LASSOC(x,c),LASSOC(x,c')))]
+    compare(pair is [prop,:val],p') ==
+      --1. if the property-value pair are identical, accept it immediately
+      pair=(pair':= ASSOC(prop,p')) => pair
+      --2. if property="value" and modes are unifiable, give intersection
+      --       property="value" but value=genSomeVariable)()
+      (val':= KDR pair') and prop="value" and
+        (m:= unifiable(val.mode,val'.mode)) => ["value",genSomeVariable(),m,nil]
+            --this tells us that an undeclared variable received
+            --two different values but with identical modes
+      --3. property="mode" is covered by modeCompare
+      prop="mode" => nil
+    modeCompare(p,p') ==
+      pair:= ASSOC("mode",p) =>
+        pair':= ASSOC("mode",p') =>
+          m'':= unifiable(rest pair,rest pair') => LIST ["mode",:m'']
+          stackSemanticError(['%b,$var,'%d,"has two modes: "],nil)
+       --stackWarning ("mode for",'%b,$var,'%d,"introduced conditionally")
+        LIST ["conditionalmode",:rest pair]
+        --LIST pair
+       --stackWarning ("mode for",'%b,$var,'%d,"introduced conditionally")
+      pair':= ASSOC("mode",p') => LIST ["conditionalmode",:rest pair']
+        --LIST pair'
+    unifiable(m1,m2) ==
+      m1=m2 => m1
+        --we may need to add code to coerce up to tagged unions
+        --but this can not be done here, but should be done by compIf
+      m:=
+        m1 is ["Union",:.] =>
+          m2 is ["Union",:.] => ["Union",:S_+(rest m1,rest m2)]
+          ["Union",:S_+(rest m1,[m2])]
+        m2 is ["Union",:.] => ["Union",:S_+(rest m2,[m1])]
+        ["Union",m1,m2]
+      for u in getDomainsInScope $e repeat
+        if u is ["Union",:u'] and (and/[member(v,u') for v in rest m]) then
+          return m
+        --this loop will return NIL if not satisfied
+ 
+addContour(c,E is [cur,:tail]) ==
+  [NCONC(fn(c,E),cur),:tail] where
+    fn(c,e) ==
+        for [x,:proplist] in c repeat
+           fn1(x,proplist,getProplist(x,e)) where
+              fn1(x,p,ee) ==
+                for pv in p repeat fn3(x,pv,ee) where
+                 fn3(x,pv,e) ==
+                   [p,:v]:=pv;
+                   if member(x,$getPutTrace) then
+                     pp([x,"has",pv]);
+                   if p="conditionalmode" then
+                     RPLACA(pv,"mode");
+                     --check for conflicts with earlier mode
+                     if vv:=LASSOC("mode",e) then
+                        if v ^=vv then
+                          stackWarning ["The conditional modes ",
+                                     v," and ",vv," conflict"]
+        LIST c
+ 
+makeCommonEnvironment(e,e') ==
+  interE makeSameLength(e,e') where  --$ie:=
+    interE [e,e'] ==
+      rest e=rest e' => [interLocalE makeSameLength(first e,first e'),:rest e]
+      interE [rest e,rest e']
+    interLocalE [le,le'] ==
+      rest le=rest le' =>
+        [interC makeSameLength(first le,first le'),:rest le]
+      interLocalE [rest le,rest le']
+    interC [c,c'] ==
+      c=c' => c
+      interC [rest c,rest c']
+    makeSameLength(x,y) ==
+      fn(x,y,#x,#y) where
+        fn(x,y,nx,ny) ==
+          nx>ny => fn(rest x,y,nx-1,ny)
+          nx<ny => fn(x,rest y,nx,ny-1)
+          [x,y]
+ 
+printEnv E ==
+  for x in E for i in 1.. repeat
+    for y in x for j in 1.. repeat
+      SAY('"******CONTOUR ",j,'", LEVEL ",i,'":******")
+      for z in y repeat
+        TERPRI()
+        SAY("Properties Of: ",first z)
+        for u in rest z repeat
+          PRIN0 first u
+          printString ": "
+          PRETTYPRINT tran(rest u,first u) where
+            tran(val,prop) ==
+              prop="value" => DROP(-1,val)
+              val
+ 
+prEnv E ==
+  for x in E for i in 1.. repeat
+    for y in x for j in 1.. repeat
+      SAY('"******CONTOUR ",j,'", LEVEL ",i,'":******")
+      for z in y | not LASSOC("modemap",rest z) repeat
+        TERPRI()
+        SAY("Properties Of: ",first z)
+        for u in rest z repeat
+          PRIN0 first u
+          printString ": "
+          PRETTYPRINT tran(rest u,first u) where
+            tran(val,prop) ==
+              prop="value" => DROP(-1,val)
+              val
+ 
+prModemaps E ==
+  listOfOperatorsSeenSoFar:= nil
+  for x in E for i in 1.. repeat
+    for y in x for j in 1.. repeat
+      for z in y | null member(first z,listOfOperatorsSeenSoFar) and
+        (modemap:= LASSOC("modemap",rest z)) repeat
+          listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar]
+          TERPRI()
+          PRIN0 first z
+          printString ": "
+          PRETTYPRINT modemap
+ 
+prTriple T ==
+   SAY '"Code:"
+   pp T.0
+   SAY '"Mode:"
+   pp T.1
+ 
+TrimCF() ==
+  new:= nil
+  old:= CAAR $CategoryFrame
+  for u in old repeat
+    if not ASSQ(first u,new) then
+      uold:= rest u
+      unew:= nil
+      for v in uold repeat if not ASSQ(first v,unew) then unew:= [v,:unew]
+      new:= [[first u,:NREVERSE unew],:new]
+  $CategoryFrame:= [[NREVERSE new]]
+  nil
+ 
+ 
+--% PREDICATES
+ 
+ 
+isConstantId(name,e) ==
+  IDENTP name =>
+    pl:= getProplist(name,e) =>
+      (LASSOC("value",pl) or LASSOC("mode",pl) => false; true)
+    true
+  false
+ 
+isFalse() == nil
+ 
+isFluid s == atom s and "$"=(PNAME s).(0)
+ 
+isFunction(x,e) ==
+  get(x,"modemap",e) or GETL(x,"SPECIAL") or x="case" or getmode(x,e) is [
+    "Mapping",:.]
+ 
+isLiteral(x,e) == get(x,"isLiteral",e)
+ 
+makeLiteral(x,e) == put(x,"isLiteral","true",e)
+ 
+isSomeDomainVariable s ==
+  IDENTP s and #(x:= PNAME s)>2 and x.(0)="#" and x.(1)="#"
+ 
+isSubset(x,y,e) ==
+  x="$" and y="Rep" or x=y or
+    LASSOC(opOf x,get(opOf y,"Subsets",e) or GETL(opOf y,"Subsets")) or
+      LASSOC(opOf x,get(opOf y,"SubDomain",e)) or
+        opOf(y)='Type or opOf(y)='Object
+ 
+isDomainInScope(domain,e) ==
+  domainList:= getDomainsInScope e
+  atom domain =>
+    MEMQ(domain,domainList) => true
+    not IDENTP domain or isSomeDomainVariable domain => true
+    false
+  (name:= first domain)="Category" => true
+  ASSQ(name,domainList) => true
+--   null CDR domain or domainMember(domain,domainList) => true
+--   false
+  isFunctor name => false
+  true --is not a functor
+ 
+isSymbol x == IDENTP x or x=nil
+ 
+isSimple x ==
+  atom x or $InteractiveMode => true
+  x is [op,:argl] and
+    isSideEffectFree op and (and/[isSimple y for y in argl])
+ 
+isSideEffectFree op ==
+  member(op,$SideEffectFreeFunctionList) or op is ["elt",.,op'] and
+    isSideEffectFree op'
+ 
+isAlmostSimple x ==
+  --returns (<new predicate> . <list of assignments>) or nil
+  $assignmentList: local --$assigmentList is only used in this function
+  transform:=
+    fn x where
+      fn x ==
+        atom x or null rest x => x
+        [op,y,:l]:= x
+        op="has" => x
+        op="is" => x
+        op="LET" =>
+          IDENTP y => (setAssignment LIST x; y)
+          true => (setAssignment [["LET",g:= genVariable(),:l],["LET",y,g]]; g)
+        isSideEffectFree op => [op,:mapInto(rest x,"fn")]
+        true => $assignmentList:= "failed"
+      setAssignment x ==
+        $assignmentList="failed" => nil
+        $assignmentList:= [:$assignmentList,:x]
+  $assignmentList="failed" => nil
+  wrapSEQExit [:$assignmentList,transform]
+ 
+incExitLevel u ==
+  adjExitLevel(u,1,1)
+  u
+ 
+decExitLevel u ==
+  (adjExitLevel(u,1,-1); removeExit0 u) where
+    removeExit0 x ==
+      atom x => x
+      x is ["exit",0,u] => removeExit0 u
+      [removeExit0 first x,:removeExit0 rest x]
+ 
+adjExitLevel(x,seqnum,inc) ==
+  atom x => x
+  x is [op,:l] and MEMQ(op,'(SEQ REPEAT COLLECT)) =>
+    for u in l repeat adjExitLevel(u,seqnum+1,inc)
+  x is ["exit",n,u] =>
+    (adjExitLevel(u,seqnum,inc); seqnum>n => x; rplac(CADR x,n+inc))
+  x is [op,:l] => for u in l repeat adjExitLevel(u,seqnum,inc)
+ 
+wrapSEQExit l ==
+  null rest l => first l
+  [:c,x]:= [incExitLevel u for u in l]
+  ["SEQ",:c,["exit",1,x]]
+ 
+ 
+--% UTILITY FUNCTIONS
+ 
+--appendOver x == "append"/x
+ 
+removeEnv t == [t.expr,t.mode,$EmptyEnvironment]  -- t is a triple
+ 
+-- This function seems no longer used
+--ordinsert(x,l) ==
+--  null l => [x]
+--  x=first l => l
+--  _?ORDER(x,first l) => [x,:l]
+--  [first l,:ordinsert(x,rest l)]
+ 
+makeNonAtomic x ==
+  atom x => [x]
+  x
+ 
+flatten(l,key) ==
+  null l => nil
+  first l is [k,:r] and k=key => [:r,:flatten(rest l,key)]
+  [first l,:flatten(rest l,key)]
+ 
+genDomainVar() ==
+  $Index:= $Index+1
+  INTERNL STRCONC("#D",STRINGIMAGE $Index)
+ 
+genVariable() ==
+  INTERNL STRCONC("#G",STRINGIMAGE ($genSDVar:= $genSDVar+1))
+ 
+genSomeVariable() ==
+  INTERNL STRCONC("##",STRINGIMAGE ($genSDVar:= $genSDVar+1))
+ 
+listOfIdentifiersIn x ==
+  IDENTP x => [x]
+  x is [op,:l] => REMDUP ("append"/[listOfIdentifiersIn y for y in l])
+  nil
+ 
+mapInto(x,fn) == [FUNCALL(fn,y) for y in x]
+ 
+numOfOccurencesOf(x,y) ==
+  fn(x,y,0) where
+    fn(x,y,n) ==
+      null y => 0
+      x=y => n+1
+      atom y => n
+      fn(x,first y,n)+fn(x,rest y,n)
+ 
+compilerMessage x ==
+  $PrintCompilerMessageIfTrue => APPLX("SAY",x)
+ 
+printDashedLine() ==
+  SAY
+   '"--------------------------------------------------------------------------"
+ 
+stackSemanticError(msg,expr) ==
+  BUMPERRORCOUNT "semantic"
+  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+  if atom msg then msg:= LIST msg
+  entry:= [msg,expr]
+  if not member(entry,$semanticErrorStack) then $semanticErrorStack:=
+    [entry,:$semanticErrorStack]
+  $scanIfTrue and $insideCapsuleFunctionIfTrue=true and #$semanticErrorStack-
+    $initCapsuleErrorCount>3 => THROW("compCapsuleBody",nil)
+  nil
+ 
+stackWarning msg ==
+  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+  if not member(msg,$warningStack) then $warningStack:= [msg,:$warningStack]
+  nil
+ 
+unStackWarning msg ==
+  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+  $warningStack:= EFFACE(msg,$warningStack)
+  nil
+ 
+stackMessage msg ==
+  $compErrorMessageStack:= [msg,:$compErrorMessageStack]
+  nil
+ 
+stackMessageIfNone msg ==
+  --used in situations such as compForm where the earliest message is wanted
+  if null $compErrorMessageStack then $compErrorMessageStack:=
+    [msg,:$compErrorMessageStack]
+  nil
+ 
+stackAndThrow msg ==
+  $compErrorMessageStack:= [msg,:$compErrorMessageStack]
+  THROW("compOrCroak",nil)
+ 
+printString x == PRINTEXP (STRINGP x => x; PNAME x)
+ 
+printAny x == if atom x then printString x else PRIN0 x
+ 
+printSignature(before,op,[target,:argSigList]) ==
+  printString before
+  printString op
+  printString ": _("
+  if argSigList then
+    printAny first argSigList
+    for m in rest argSigList repeat (printString ","; printAny m)
+  printString "_) -> "
+  printAny target
+  TERPRI()
+ 
+pmatch(s,p) == pmatchWithSl(s,p,"ok")
+ 
+pmatchWithSl(s,p,al) ==
+  s=$EmptyMode => nil
+  s=p => al
+  v:= ASSOC(p,al) => s=rest v or al
+  MEMQ(p,$PatternVariableList) => [[p,:s],:al]
+  null atom p and null atom s and (al':= pmatchWithSl(first s,first p,al)) and
+    pmatchWithSl(rest s,rest p,al')
+ 
+elapsedTime() ==
+  currentTime:= TEMPUS_-FUGIT()
+  elapsedSeconds:= (currentTime-$previousTime)*1.0/$timerTicksPerSecond
+  $previousTime:= currentTime
+  elapsedSeconds
+ 
+addStats([a,b],[c,d]) == [a+c,b+d]
+ 
+printStats [byteCount,elapsedSeconds] ==
+  timeString := normalizeStatAndStringify elapsedSeconds
+  if byteCount = 0 then SAY('"Time: ",timeString,'" SEC.") else
+    SAY('"Size: ",byteCount,'" BYTES     Time: ",timeString,'" SEC.")
+  TERPRI()
+  nil
+ 
+extendsCategoryForm(domain,form,form') ==
+  --is domain of category form also of category form'?
+  --domain is only used for SubsetCategory resolution.
+  --and ensuring that X being a Ring means that it
+  --satisfies (Algebra X)
+  form=form' => true
+  form=$Category => nil
+  form' is ["Join",:l] => and/[extendsCategoryForm(domain,form,x) for x in l]
+  form' is ["CATEGORY",.,:l] =>
+    and/[extendsCategoryForm(domain,form,x) for x in l]
+  form' is ["SubsetCategory",cat,dom] =>
+    extendsCategoryForm(domain,form,cat) and isSubset(domain,dom,$e)
+  form is ["Join",:l] => or/[extendsCategoryForm(domain,x,form') for x in l]
+  form is ["CATEGORY",.,:l] =>
+    member(form',l) or
+      stackWarning ["not known that ",form'," is of mode ",form] or true
+  isCategoryForm(form,$EmptyEnvironment) =>
+          --Constructs the associated vector
+    formVec:=(compMakeCategoryObject(form,$e)).expr
+            --Must be $e to pick up locally bound domains
+    form' is ["SIGNATURE",op,args,:.] =>
+        ASSOC([op,args],formVec.(1)) or
+            ASSOC(SUBSTQ(domain,"$",[op,args]),
+                  SUBSTQ(domain,"$",formVec.(1)))
+    form' is ["ATTRIBUTE",at] =>
+         ASSOC(at,formVec.2) or
+            ASSOC(SUBSTQ(domain,"$",at),SUBSTQ(domain,"$",formVec.2))
+    form' is ["IF",:.] => true --temporary hack so comp won't fail
+    -- Are we dealing with an Aldor category?  If so use the "has" function ...
+    # formVec = 1 => newHasTest(form,form')
+    catvlist:= formVec.4
+    member(form',first catvlist) or
+     member(form',SUBSTQ(domain,"$",first catvlist)) or
+      (or/
+        [extendsCategoryForm(domain,SUBSTQ(domain,"$",cat),form')
+          for [cat,:.] in CADR catvlist])
+  nil
+ 
+getmode(x,e) ==
+  prop:=getProplist(x,e)
+  u:= LASSQ("value",prop) => u.mode
+  LASSQ("mode",prop)
+ 
+getmodeOrMapping(x,e) ==
+  u:= getmode(x,e) => u
+  (u:= get(x,"modemap",e)) is [[[.,:map],.],:.] => ["Mapping",:map]
+  nil
+ 
+outerProduct l ==
+                --of a list of lists
+  null l => LIST nil
+  "append"/[[[x,:y] for y in outerProduct rest l] for x in first l]
+ 
+sublisR(al,u) ==
+  atom u => u
+  y:= rassoc(t:= [sublisR(al,x) for x in u],al) => y
+  true => t
+ 
+substituteOp(op',op,x) ==
+  atom x => x
+  [(op=(f:= first x) => op'; f),:[substituteOp(op',op,y) for y in rest x]]
+ 
+--substituteForFormalArguments(argl,expr) ==
+--  SUBLIS([[v,:a] for a in argl for v in $FormalMapVariableList],expr)
+ 
+ -- following is only intended for substituting in domains slots 1 and 4
+ -- signatures and categories
+sublisV(p,e) ==
+  (atom p => e; suba(p,e)) where
+    suba(p,e) ==
+      STRINGP e => e
+      -- no need to descend vectors unless they are categories
+      --REFVECP e => LIST2REFVEC [suba(p,e.i) for i in 0..MAXINDEX e]
+      isCategory e => LIST2REFVEC [suba(p,e.i) for i in 0..MAXINDEX e]
+      atom e => (y:= ASSQ(e,p) => rest y; e)
+      u:= suba(p,QCAR e)
+      v:= suba(p,QCDR e)
+      EQ(QCAR e,u) and EQ(QCDR e,v) => e
+      [u,:v]
+ 
+--% DEBUGGING PRINT ROUTINES used in breaks
+ 
+_?MODEMAPS x == _?modemaps x
+_?modemaps x ==
+  env:=
+    $insideCapsuleFunctionIfTrue=true => $CapsuleModemapFrame
+    $f
+  x="all" => displayModemaps env
+  -- displayOpModemaps(x,old2NewModemaps get(x,"modemap",env))
+  displayOpModemaps(x,get(x,"modemap",env))
+
+
+old2NewModemaps x ==
+--  [[dcSig,pred] for [dcSig,[pred,:.],:.] in x]
+  x is [dcSig,[pred,:.],:.]  =>  [dcSig,pred]
+  x
+
+traceUp() ==
+  atom $x => sayBrightly "$x is an atom"
+  for y in rest $x repeat
+    u:= comp(y,$EmptyMode,$f) =>
+      sayBrightly [y,'" ==> mode",'%b,u.mode,'%d]
+    sayBrightly [y,'" does not compile"]
+ 
+_?M x == _?m x
+_?m x ==
+  u:= comp(x,$EmptyMode,$f) => u.mode
+  nil
+ 
+traceDown() ==
+  mmList:= getFormModemaps($x,$f) =>
+    for mm in mmList repeat if u:= qModemap mm then return u
+  sayBrightly "no modemaps for $x"
+ 
+qModemap mm ==
+  sayBrightly ['%b,"modemap",'%d,:formatModemap mm]
+  [[dc,target,:sl],[pred,:.]]:= mm
+  and/[qArg(a,m) for a in rest $x for m in sl] => target
+  sayBrightly ['%b,"fails",'%d,'%l]
+ 
+qArg(a,m) ==
+  yesOrNo:=
+    u:= comp(a,m,$f) => "yes"
+    "no"
+  sayBrightly [a," --> ",m,'%b,yesOrNo,'%d]
+  yesOrNo="yes"
+ 
+_?COMP x == _?comp x
+_?comp x ==
+  msg:=
+    u:= comp(x,$EmptyMode,$f) =>
+      [MAKESTRING "compiles to mode",'%b,u.mode,'%d]
+    nil
+  sayBrightly msg
+ 
+_?domains() == pp getDomainsInScope $f
+_?DOMAINS() == ?domains()
+ 
+_?mode x == displayProplist(x,[["mode",:getmode(x,$f)]])
+_?MODE x == _?mode x
+ 
+_?properties x == displayProplist(x,getProplist(x,$f))
+_?PROPERTIES x == _?properties x
+ 
+_?value x == displayProplist(x,[["value",:get(x,"value",$f)]])
+_?VALUE x == _?value x
+ 
+displayProplist(x,alist) ==
+  sayBrightly ["properties of",'%b,x,'%d,":"]
+  fn alist where
+    fn alist ==
+      alist is [[prop,:val],:l] =>
+        if prop="value" then val:= [val.expr,val.mode,'"..."]
+        sayBrightly ["   ",'%b,prop,'%d,": ",val]
+        fn deleteAssoc(prop,l)
+ 
+displayModemaps E ==
+  listOfOperatorsSeenSoFar:= nil
+  for x in E for i in 1.. repeat
+    for y in x for j in 1.. repeat
+      for z in y | null member(first z,listOfOperatorsSeenSoFar) and
+        (modemaps:= LASSOC("modemap",rest z)) repeat
+          listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar]
+          displayOpModemaps(first z,modemaps)
+ 
+--% General object traversal functions
+ 
+GEQSUBSTLIST(old, new, body) ==
+    GEQNSUBSTLIST(old, new, GCOPY body)
+ 
+GEQNSUBSTLIST(old, new, body) ==
+    or/[:[EQ(o,n) for o in old] for n in new] =>
+        mid := [GENSYM() for o in old]
+        GEQNSUBSTLIST(old, mid, body)
+        GEQNSUBSTLIST(mid, new, body)
+    alist := [[o,:n] for o in old for n in new]
+    traverse(function GSUBSTinner, alist, body) where
+        GSUBSTinner(alist, ob) ==
+            (pr := ASSQ(ob, alist)) => CDR pr
+            ob
+ 
+GCOPY ob == COPY ob  -- for now
+ 
+traverse(fn, arg, ob) ==
+    $seen:    local := MAKE_-HASHTABLE 'EQ
+    $notseen: local := GENSYM()
+ 
+    traverseInner(ob, fn, arg) where
+        traverseInner(ob, fn, arg) ==
+            e := HGET($seen, ob, $notseen)
+            not EQ(e, $notseen) => e
+ 
+            nob := FUNCALL(fn, arg, ob)
+            HPUT($seen, ob, nob)
+            not EQ(nob, ob) => nob
+            PAIRP ob =>
+                ne:=traverseInner(QCAR ob, fn, arg)
+                if not EQ(ne,QCAR ob) then QRPLACA(ob, ne)
+                ne:=traverseInner(QCDR ob, fn, arg)
+                if not EQ(ne,QCDR ob) then QRPLACD(ob, ne)
+                ob
+            VECP ob =>
+                n := QVMAXINDEX ob
+                for i in 0..n repeat
+                    e:=QVELT(ob,i)
+                    ne:=traverseInner(e, fn, arg)
+                    if not EQ(ne,e) then QSETVELT(ob,i,ne)
+                ob
+            HASHTABLEP ob =>
+                keys := HKEYS ob
+                for k in keys repeat
+                    e  := HGET(ob, k)
+                    nk := traverseInner(k, fn, arg)
+                    ne := traverseInner(e, fn, arg)
+                    if not EQ(k,nk) or not EQ(e,ne) then
+                        HREM(ob, k)
+                        HPUT(ob, nk, ne)
+                ob
+            PAPPP ob =>
+                for i in 1..PA_-SPEC_-COUNT ob repeat
+                    s := PA_-SPEC(ob, i)
+                    not PAIRP s =>
+                        ns := traverseInner(s,fn,arg)
+                        if not EQ(s,ns) then
+                            SET_-PA_-SPEC(ob,i,ns)
+                    ns := traverseInner(QCDR s, fn, arg)
+                    if not EQ(ns,QCDR s) then
+                       apply(SET_-PA_-SPEC, [ob,i,QCAR s,:ns])
+                ob
+            ob
+@
+\section{c-util.clisp}
+<<c-util.clisp>>=
+
+(IN-PACKAGE "BOOT" )
+
+;
+;--% Debugging Functions
+;
+;CONTINUE() == continue()
+
+;;;     ***       CONTINUE REDEFINED
+
+(DEFUN CONTINUE NIL (|continue|)) 
+;continue() == FIN comp($x,$m,$f)
+
+;;;     ***       |continue| REDEFINED
+
+(DEFUN |continue| NIL (FIN (|comp| |$x| |$m| |$f|))) 
+;
+;LEVEL(:l) == APPLY('level,l)
+
+;;;     ***       LEVEL REDEFINED
+
+(DEFUN LEVEL (&REST #0=#:G2489 &AUX |l|) (DSETQ |l| #0#) (APPLY (QUOTE |level|) |l|)) 
+;level(:l) ==
+;  null l => same()
+;  l is [n] and INTEGERP n => displayComp ($level:= n)
+;  SAY '"Correct format: (level n) where n is the level you want to go to"
+
+;;;     ***       |level| REDEFINED
+
+(DEFUN |level| (&REST #0=#:G2496 &AUX |l|) (DSETQ |l| #0#) (PROG (|n|) (RETURN (COND ((NULL |l|) (|same|)) ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) (PROGN (SPADLET |n| (QCAR |l|)) (QUOTE T)) (INTEGERP |n|)) (|displayComp| (SPADLET |$level| |n|))) ((QUOTE T) (SAY (MAKESTRING "Correct format: (level n) where n is the level you want to go to"))))))) 
+;
+;UP() == up()
+
+;;;     ***       UP REDEFINED
+
+(DEFUN UP NIL (|up|)) 
+;up() == displayComp ($level:= $level-1)
+
+;;;     ***       |up| REDEFINED
+
+(DEFUN |up| NIL (|displayComp| (SPADLET |$level| (SPADDIFFERENCE |$level| 1)))) 
+;
+;SAME() == same()
+
+;;;     ***       SAME REDEFINED
+
+(DEFUN SAME NIL (|same|)) 
+;same() == displayComp $level
+
+;;;     ***       |same| REDEFINED
+
+(DEFUN |same| NIL (|displayComp| |$level|)) 
+;
+;DOWN() == down()
+
+;;;     ***       DOWN REDEFINED
+
+(DEFUN DOWN NIL (|down|)) 
+;down() == displayComp ($level:= $level+1)
+
+;;;     ***       |down| REDEFINED
+
+(DEFUN |down| NIL (|displayComp| (SPADLET |$level| (PLUS |$level| 1)))) 
+;
+;displaySemanticErrors() ==
+;  n:= #($semanticErrorStack:= REMDUP $semanticErrorStack)
+;  n=0 => nil
+;  l:= NREVERSE $semanticErrorStack
+;  $semanticErrorStack:= nil
+;  sayBrightly bright '"  Semantic Errors:"
+;  displaySemanticError(l,CUROUTSTREAM)
+;  sayBrightly '" "
+;  displayWarnings()
+
+;;;     ***       |displaySemanticErrors| REDEFINED
+
+(DEFUN |displaySemanticErrors| NIL (PROG (|n| |l|) (RETURN (PROGN (SPADLET |n| (|#| (SPADLET |$semanticErrorStack| (REMDUP |$semanticErrorStack|)))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |l| (NREVERSE |$semanticErrorStack|)) (SPADLET |$semanticErrorStack| NIL) (|sayBrightly| (|bright| (MAKESTRING "  Semantic Errors:"))) (|displaySemanticError| |l| CUROUTSTREAM) (|sayBrightly| (MAKESTRING " ")) (|displayWarnings|))))))) 
+;
+;displaySemanticError(l,stream) ==
+;  for x in l for i in 1.. repeat
+;    sayBrightly(['"      [",i,'"] ",:first x],stream)
+
+;;;     ***       |displaySemanticError| REDEFINED
+
+(DEFUN |displaySemanticError| (|l| |stream|) (SEQ (DO ((#0=#:G2529 |l| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayBrightly| (CONS (MAKESTRING "      [") (CONS |i| (CONS (MAKESTRING "] ") (CAR |x|)))) |stream|)))))) 
+;
+;displayWarnings() ==
+;  n:= #($warningStack:= REMDUP $warningStack)
+;  n=0 => nil
+;  sayBrightly bright '"  Warnings:"
+;  l := NREVERSE $warningStack
+;  displayWarning(l,CUROUTSTREAM)
+;  $warningStack:= nil
+;  sayBrightly '" "
+
+;;;     ***       |displayWarnings| REDEFINED
+
+(DEFUN |displayWarnings| NIL (PROG (|n| |l|) (RETURN (PROGN (SPADLET |n| (|#| (SPADLET |$warningStack| (REMDUP |$warningStack|)))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (|sayBrightly| (|bright| (MAKESTRING "  Warnings:"))) (SPADLET |l| (NREVERSE |$warningStack|)) (|displayWarning| |l| CUROUTSTREAM) (SPADLET |$warningStack| NIL) (|sayBrightly| (MAKESTRING " ")))))))) 
+;
+;displayWarning(l,stream) ==
+;  for x in l for i in 1.. repeat
+;    sayBrightly(['"      [",i,'"] ",:x],stream)
+
+;;;     ***       |displayWarning| REDEFINED
+
+(DEFUN |displayWarning| (|l| |stream|) (SEQ (DO ((#0=#:G2550 |l| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayBrightly| (CONS (MAKESTRING "      [") (CONS |i| (CONS (MAKESTRING "] ") |x|))) |stream|)))))) 
+;
+;displayComp level ==
+;  $tripleCache:= nil
+;  $bright:= " << "
+;  $dim:= " >> "
+;  if $insideCapsuleFunctionIfTrue=true then
+;    sayBrightly ['"error in function",'%b,$op,'%d,'%l]
+;  --mathprint removeZeroOne mkErrorExpr level
+;  pp removeZeroOne mkErrorExpr level
+;  sayBrightly ['"****** level",'%b,level,'%d,'" ******"]
+;  [$x,$m,$f,$exitModeStack]:= ELEM($s,level)
+;  ($X:=$x;$M:=$m;$F:=$f)
+;  SAY("$x:= ",$x)
+;  SAY("$m:= ",$m)
+;  SAY "$f:="
+;  F_,PRINT_-ONE $f
+;  nil
+
+;;;     ***       |displayComp| REDEFINED
+
+(DEFUN |displayComp| (|level|) (PROG (|LETTMP#1|) (RETURN (PROGN (SPADLET |$tripleCache| NIL) (SPADLET |$bright| (QUOTE | << |)) 
+(SPADLET |$dim| (QUOTE | >> |)) (COND ((BOOT-EQUAL |$insideCapsuleFunctionIfTrue| (QUOTE T)) (|sayBrightly| (CONS (MAKESTRING "error in function") (CONS (QUOTE |%b|) (CONS |$op| (CONS (QUOTE |%d|) (CONS (QUOTE |%l|) NIL)))))))) (|pp| (|removeZeroOne| (|mkErrorExpr| |level|))) (|sayBrightly| (CONS (MAKESTRING "****** level") (CONS (QUOTE |%b|) (CONS |level| (CONS (QUOTE |%d|) (CONS (MAKESTRING " ******") NIL)))))) (SPADLET |LETTMP#1| (ELEM |$s| |level|)) (SPADLET |$x| (CAR |LETTMP#1|)) (SPADLET |$m| (CADR |LETTMP#1|)) (SPADLET |$f| (CADDR |LETTMP#1|)) (SPADLET |$exitModeStack| (CADDDR |LETTMP#1|)) (SPADLET $X |$x|) (SPADLET $M |$m|) (SPADLET $F |$f|) (SAY (MAKESTRING "$x:= ") |$x|) (SAY (MAKESTRING "$m:= ") |$m|) (SAY (MAKESTRING "$f:=")) (|F,PRINT-ONE| |$f|) NIL)))) 
+;
+;mkErrorExpr level ==
+;  bracket ASSOCLEFT DROP(level-#$s,$s) where
+;    bracket l ==
+;      #l<2 => l
+;      l is [a,b] =>
+;        highlight(b,a) where
+;          highlight(b,a) ==
+;            atom b =>
+;              substitute(var,b,a) where
+;                var:= INTERN STRCONC(STRINGIMAGE $bright,STRINGIMAGE b,STRINGIMAGE $dim)
+;            highlight1(b,a) where
+;              highlight1(b,a) ==
+;                atom a => a
+;                a is [ =b,:c] => [$bright,b,$dim,:c]
+;                [highlight1(b,first a),:highlight1(b,rest a)]
+;      substitute(bracket rest l,first rest l,first l)
+
+;;;     ***       |mkErrorExpr,highlight1| REDEFINED
+
+(DEFUN |mkErrorExpr,highlight1| (|b| |a|) (PROG (|c|) (RETURN (SEQ (IF (ATOM |a|) (EXIT |a|)) (IF (AND (PAIRP |a|) (EQUAL (QCAR |a|) |b|) (PROGN (SPADLET |c| (QCDR |a|)) (QUOTE T))) (EXIT (CONS |$bright| (CONS |b| (CONS |$dim| |c|))))) (EXIT (CONS (|mkErrorExpr,highlight1| |b| (CAR |a|)) (|mkErrorExpr,highlight1| |b| (CDR |a|)))))))) 
+
+;;;     ***       |mkErrorExpr,highlight| REDEFINED
+
+(DEFUN |mkErrorExpr,highlight| (|b| |a|) (PROG (|var|) (RETURN (SEQ (IF (ATOM |b|) (EXIT (PROGN (SPADLET |var| (INTERN (STRCONC (STRINGIMAGE |$bright|) (STRINGIMAGE |b|) (STRINGIMAGE |$dim|)))) (MSUBST |var| |b| |a|)))) (EXIT (|mkErrorExpr,highlight1| |b| |a|)))))) 
+
+;;;     ***       |mkErrorExpr,bracket| REDEFINED
+
+(DEFUN |mkErrorExpr,bracket| (|l|) (PROG (|a| |ISTMP#1| |b|) (RETURN (SEQ (IF (QSLESSP (|#| |l|) 2) (EXIT |l|)) (IF (AND (PAIRP |l|) (PROGN (SPADLET |a| (QCAR |l|)) (SPADLET |ISTMP#1| (QCDR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (|mkErrorExpr,highlight| |b| |a|))) (EXIT (MSUBST (|mkErrorExpr,bracket| (CDR |l|)) (CAR (CDR |l|)) (CAR |l|))))))) 
+
+;;;     ***       |mkErrorExpr| REDEFINED
+
+(DEFUN |mkErrorExpr| (|level|) (|mkErrorExpr,bracket| (ASSOCLEFT (DROP (SPADDIFFERENCE |level| (|#| |$s|)) |$s|)))) 
+;
+;compAndTrace [x,m,e] ==
+;  SAY("tracing comp, compFormWithModemap of: ",x)
+;  TRACE_,1(["comp","compFormWithModemap"],nil)
+;  T:= comp(x,m,e)
+;  UNTRACE_,1 "comp"
+;  UNTRACE_,1 "compFormWithModemap"
+;  T
+
+;;;     ***       |compAndTrace| REDEFINED
+
+(DEFUN |compAndTrace| (#0=#:G2621) (PROG (|x| |m| |e| T$) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |m| (CADR #0#)) (SPADLET |e| (CADDR #0#)) (SAY (MAKESTRING "tracing comp, compFormWithModemap of: ") |x|) (|TRACE,1| (CONS (QUOTE |comp|) (CONS (QUOTE |compFormWithModemap|) NIL)) NIL) (SPADLET T$ (|comp| |x| |m| |e|)) (|UNTRACE,1| (QUOTE |comp|)) (|UNTRACE,1| (QUOTE |compFormWithModemap|)) T$)))) 
+;
+;errorRef s == stackWarning ['%b,s,'%d,'"has no value"]
+
+;;;     ***       |errorRef| REDEFINED
+
+(DEFUN |errorRef| (|s|) (|stackWarning| (CONS (QUOTE |%b|) (CONS |s| (CONS (QUOTE |%d|) (CONS (MAKESTRING "has no value") NIL)))))) 
+;
+;unErrorRef s == unStackWarning ['%b,s,'%d,'"has no value"]
+
+;;;     ***       |unErrorRef| REDEFINED
+
+(DEFUN |unErrorRef| (|s|) (|unStackWarning| (CONS (QUOTE |%b|) (CONS |s| (CONS (QUOTE |%d|) (CONS (MAKESTRING "has no value") NIL)))))) 
+;
+;--% ENVIRONMENT FUNCTIONS
+;
+;consProplistOf(var,proplist,prop,val) ==
+;  semchkProplist(var,proplist,prop,val)
+;  $InteractiveMode and (u:= ASSOC(prop,proplist)) =>
+;    RPLACD(u,val)
+;    proplist
+;  [[prop,:val],:proplist]
+
+;;;     ***       |consProplistOf| REDEFINED
+
+(DEFUN |consProplistOf| (|var| |proplist| |prop| |val|) (PROG (|u|) (RETURN (PROGN (|semchkProplist| |var| |proplist| |prop| |val|) (COND ((AND |$InteractiveMode| (SPADLET |u| (|assoc| |prop| |proplist|))) (RPLACD |u| |val|) |proplist|) ((QUOTE T) (CONS (CONS |prop| |val|) |proplist|))))))) 
+;
+;warnLiteral x ==
+;  stackSemanticError(['%b,x,'%d,
+;    '"is BOTH a variable and a literal"],nil)
+
+;;;     ***       |warnLiteral| REDEFINED
+
+(DEFUN |warnLiteral| (|x|) (|stackSemanticError| (CONS (QUOTE |%b|) (CONS |x| (CONS (QUOTE |%d|) (CONS (MAKESTRING "is BOTH a variable and a literal") NIL)))) NIL)) 
+;
+;intersectionEnvironment(e,e') ==
+;  ce:= makeCommonEnvironment(e,e')
+;  ic:= intersectionContour(deltaContour(e,ce),deltaContour(e',ce))
+;  e'':= (ic => addContour(ic,ce); ce)
+
+;;;     ***       |intersectionEnvironment| REDEFINED
+
+(DEFUN |intersectionEnvironment| (|e| |e'|) (PROG (|ce| |ic| |e''|) (RETURN (PROGN (SPADLET |ce| (|makeCommonEnvironment| |e| |e'|)) (SPADLET |ic| (|intersectionContour| (|deltaContour| |e| |ce|) (|deltaContour| |e'| |ce|))) (SPADLET |e''| (COND (|ic| (|addContour| |ic| |ce|)) ((QUOTE T) |ce|))))))) 
+;  --$ie:= e''   this line is for debugging purposes only
+;
+;deltaContour([[c,:cl],:el],[[c',:cl'],:el']) ==
+;  ^el=el' => systemError '"deltaContour" --a cop out for now
+;  eliminateDuplicatePropertyLists contourDifference(c,c') where
+;    contourDifference(c,c') == [first x for x in tails c while (x^=c')]
+;    eliminateDuplicatePropertyLists contour ==
+;      contour is [[x,:.],:contour'] =>
+;        LASSOC(x,contour') =>
+;                               --save some CONSing if possible
+;          [first contour,:DELLASOS(x,eliminateDuplicatePropertyLists contour')]
+;        [first contour,:eliminateDuplicatePropertyLists contour']
+;      nil
+
+;;;     ***       |deltaContour,eliminateDuplicatePropertyLists| REDEFINED
+
+(DEFUN |deltaContour,eliminateDuplicatePropertyLists| (|contour|) (PROG (|ISTMP#1| |x| |contour'|) (RETURN (SEQ (IF (AND (PAIRP |contour|) (PROGN (SPADLET |ISTMP#1| (QCAR |contour|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (QUOTE T)))) (PROGN (SPADLET |contour'| (QCDR |contour|)) (QUOTE T))) (EXIT (SEQ (IF (LASSOC |x| |contour'|) (EXIT (CONS (CAR |contour|) (DELLASOS |x| (|deltaContour,eliminateDuplicatePropertyLists| |contour'|))))) (EXIT (CONS (CAR |contour|) (|deltaContour,eliminateDuplicatePropertyLists| |contour'|)))))) (EXIT NIL))))) 
+
+;;;     ***       |deltaContour,contourDifference| REDEFINED
+
+(DEFUN |deltaContour,contourDifference| (|c| |c'|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G2679) (SPADLET #0# NIL) (RETURN (DO ((|x| |c| (CDR |x|))) ((OR (ATOM |x|) (NULL (NEQUAL |x| |c'|))) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (CAR |x|) #0#))))))))))) 
+
+;;;     ***       |deltaContour| REDEFINED
+
+(DEFUN |deltaContour| (#0=#:G2695 #1=#:G2706) (PROG (|c'| |cl'| |el'| |c| |cl| |el|) (RETURN (PROGN (SPADLET |c'| (CAAR #1#)) (SPADLET |cl'| (CDAR #1#)) (SPADLET |el'| (CDR #1#)) (SPADLET |c| (CAAR #0#)) (SPADLET |cl| (CDAR #0#)) (SPADLET |el| (CDR #0#)) (COND ((NULL (BOOT-EQUAL |el| |el'|)) (|systemError| (MAKESTRING "deltaContour"))) ((QUOTE T) (|deltaContour,eliminateDuplicatePropertyLists| (|deltaContour,contourDifference| |c| |c'|)))))))) 
+;
+;intersectionContour(c,c') ==
+;  $var: local
+;  computeIntersection(c,c') where
+;    computeIntersection(c,c') ==
+;      varlist:= REMDUP ASSOCLEFT c
+;      varlist':= REMDUP ASSOCLEFT c'
+;      interVars:= setIntersection(varlist,varlist')
+;      unionVars:= setUnion(varlist,varlist')
+;      diffVars:= setDifference(unionVars,interVars)
+;      modeAssoc:= buildModeAssoc(diffVars,c,c')
+;      [:modeAssoc,:
+;        [[x,:proplist]
+;          for [x,:y] in c | MEMBER(x,interVars) and
+;            (proplist:= interProplist(y,LASSOC($var:= x,c')))]]
+;    interProplist(p,p') ==
+;                            --p is new proplist; p' is old one
+;      [:modeCompare(p,p'),:[pair' for pair in p | (pair':= compare(pair,p'))]]
+;    buildModeAssoc(varlist,c,c') ==
+;      [[x,:mp] for x in varlist | (mp:= modeCompare(LASSOC(x,c),LASSOC(x,c')))]
+;    compare(pair is [prop,:val],p') ==
+;      --1. if the property-value pair are identical, accept it immediately
+;      pair=(pair':= ASSOC(prop,p')) => pair
+;      --2. if property="value" and modes are unifiable, give intersection
+;      --       property="value" but value=genSomeVariable)()
+;      (val':= KDR pair') and prop="value" and
+;        (m:= unifiable(val.mode,val'.mode)) => ["value",genSomeVariable(),m,nil]
+;            --this tells us that an undeclared variable received
+;            --two different values but with identical modes
+;      --3. property="mode" is covered by modeCompare
+;      prop="mode" => nil
+;    modeCompare(p,p') ==
+;      pair:= ASSOC("mode",p) =>
+;        pair':= ASSOC("mode",p') =>
+;          m'':= unifiable(rest pair,rest pair') => LIST ["mode",:m'']
+;          stackSemanticError(['%b,$var,'%d,"has two modes: "],nil)
+;       --stackWarning ("mode for",'%b,$var,'%d,"introduced conditionally")
+;        LIST ["conditionalmode",:rest pair]
+;        --LIST pair
+;       --stackWarning ("mode for",'%b,$var,'%d,"introduced conditionally")
+;      pair':= ASSOC("mode",p') => LIST ["conditionalmode",:rest pair']
+;        --LIST pair'
+;    unifiable(m1,m2) ==
+;      m1=m2 => m1
+;        --we may need to add code to coerce up to tagged unions
+;        --but this can not be done here, but should be done by compIf
+;      m:=
+;        m1 is ["Union",:.] =>
+;          m2 is ["Union",:.] => ["Union",:S_+(rest m1,rest m2)]
+;          ["Union",:S_+(rest m1,[m2])]
+;        m2 is ["Union",:.] => ["Union",:S_+(rest m2,[m1])]
+;        ["Union",m1,m2]
+;      for u in getDomainsInScope $e repeat
+;        if u is ["Union",:u'] and (and/[MEMBER(v,u') for v in rest m]) then
+;          return m
+
+;;;     ***       |intersectionContour,unifiable| REDEFINED
+
+(DEFUN |intersectionContour,unifiable| (|m1| |m2|) (PROG (|m| |u'|) (RETURN (SEQ (IF (BOOT-EQUAL |m1| |m2|) (EXIT |m1|)) (SPADLET |m| (SEQ (IF (AND (PAIRP |m1|) (EQ (QCAR |m1|) (QUOTE |Union|))) (EXIT (SEQ (IF (AND (PAIRP |m2|) (EQ (QCAR |m2|) (QUOTE |Union|))) (EXIT (CONS (QUOTE |Union|) (S+ (CDR |m1|) (CDR |m2|))))) (EXIT (CONS (QUOTE |Union|) (S+ (CDR |m1|) (CONS |m2| NIL))))))) (IF (AND (PAIRP |m2|) (EQ (QCAR |m2|) (QUOTE |Union|))) (EXIT (CONS (QUOTE |Union|) (S+ (CDR |m2|) (CONS |m1| NIL))))) (EXIT (CONS (QUOTE |Union|) (CONS |m1| (CONS |m2| NIL)))))) (EXIT (DO ((#0=#:G2748 (|getDomainsInScope| |$e|) (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (IF (AND (AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Union|)) (PROGN (SPADLET |u'| (QCDR |u|)) (QUOTE T))) (PROG (#1=#:G2754) (SPADLET #1# (QUOTE T)) (RETURN (DO ((#2=#:G2760 NIL (NULL #1#)) (#3=#:G2761 (CDR |m|) (CDR #3#)) (|v| NIL)) ((OR #2# (ATOM #3#) (PROGN (SETQ |v| (CAR #3#)) NIL)) #1#) (SEQ (EXIT (SETQ #1# (AND #1# (|member| |v| |u'|))))))))) (RETURN |m|) NIL))))))))) 
+
+;;;     ***       |intersectionContour,modeCompare| REDEFINED
+
+(DEFUN |intersectionContour,modeCompare| (|p| |p'|) (PROG (|pair| |m''| |pair'|) (RETURN (SEQ (IF (SPADLET |pair| (|assoc| (QUOTE |mode|) |p|)) (EXIT (SEQ (IF (SPADLET |pair'| (|assoc| (QUOTE |mode|) |p'|)) (EXIT (SEQ (IF (SPADLET |m''| (|intersectionContour,unifiable| (CDR |pair|) (CDR |pair'|))) (EXIT (LIST (CONS (QUOTE |mode|) |m''|)))) (EXIT (|stackSemanticError| (CONS (QUOTE |%b|) (CONS |$var| (CONS (QUOTE |%d|) (CONS (QUOTE |has two modes: |) NIL)))) NIL))))) (EXIT (LIST (CONS (QUOTE |conditionalmode|) (CDR |pair|))))))) (EXIT (IF (SPADLET |pair'| (|assoc| (QUOTE |mode|) |p'|)) (EXIT (LIST (CONS (QUOTE |conditionalmode|) (CDR |pair'|)))))))))) 
+
+;;;     ***       |intersectionContour,compare| REDEFINED
+
+(DEFUN |intersectionContour,compare| (|pair| |p'|) (PROG (|prop| |val| |pair'| |val'| |m|) (RETURN (SEQ (PROGN (SPADLET |prop| (CAR |pair|)) (SPADLET |val| (CDR |pair|)) |pair| (SEQ (IF (BOOT-EQUAL |pair| (SPADLET |pair'| (|assoc| |prop| |p'|))) (EXIT |pair|)) (IF (AND (AND (SPADLET |val'| (KDR |pair'|)) (BOOT-EQUAL |prop| (QUOTE |value|))) (SPADLET |m| (|intersectionContour,unifiable| (CADR |val|) (CADR |val'|)))) (EXIT (CONS (QUOTE |value|) (CONS (|genSomeVariable|) (CONS |m| (CONS NIL NIL)))))) (EXIT (IF (BOOT-EQUAL |prop| (QUOTE |mode|)) (EXIT NIL))))))))) 
+
+;;;     ***       |intersectionContour,buildModeAssoc| REDEFINED
+
+(DEFUN |intersectionContour,buildModeAssoc| (|varlist| |c| |c'|) (PROG (|mp|) (RETURN (SEQ (PROG (#0=#:G2802) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2808 |varlist| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (COND ((SPADLET |mp| (|intersectionContour,modeCompare| (LASSOC |x| |c|) (LASSOC |x| |c'|))) (SETQ #0# (CONS (CONS |x| |mp|) #0#))))))))))))) 
+
+;;;     ***       |intersectionContour,interProplist| REDEFINED
+
+(DEFUN |intersectionContour,interProplist| (|p| |p'|) (PROG (|pair'|) (RETURN (SEQ (APPEND (|intersectionContour,modeCompare| |p| |p'|) (PROG (#0=#:G2824) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2830 |p| (CDR #1#)) (|pair| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |pair| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (COND ((SPADLET |pair'| (|intersectionContour,compare| |pair| |p'|)) (SETQ #0# (CONS |pair'| #0#)))))))))))))) 
+
+;;;     ***       |intersectionContour,computeIntersection| REDEFINED
+
+(DEFUN |intersectionContour,computeIntersection| (|c| |c'|) (PROG (|varlist| |varlist'| |interVars| |unionVars| |diffVars| |modeAssoc| |x| |y| |proplist|) (RETURN (SEQ (SPADLET |varlist| (REMDUP (ASSOCLEFT |c|))) (SPADLET |varlist'| (REMDUP (ASSOCLEFT |c'|))) (SPADLET |interVars| (|intersection| |varlist| |varlist'|)) (SPADLET |unionVars| (|union| |varlist| |varlist'|)) (SPADLET |diffVars| (SETDIFFERENCE |unionVars| |interVars|)) (SPADLET |modeAssoc| (|intersectionContour,buildModeAssoc| |diffVars| |c| |c'|)) (EXIT (APPEND |modeAssoc| (PROG (#0=#:G2847) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2854 |c| (CDR #1#)) (#2=#:G2731 NIL)) ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL) (PROGN (PROGN (SPADLET |x| (CAR #2#)) (SPADLET |y| (CDR #2#)) #2#) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (COND ((AND (|member| |x| |interVars|) (SPADLET |proplist| (|intersectionContour,interProplist| |y| (LASSOC (SPADLET |$var| |x|) |c'|)))) (SETQ #0# (CONS (CONS |x| |proplist|) #0#))))))))))))))) 
+
+;;;     ***       |intersectionContour| REDEFINED
+
+(DEFUN |intersectionContour| (|c| |c'|) (PROG (|$var|) (DECLARE (SPECIAL |$var|)) (RETURN (PROGN (SPADLET |$var| NIL) (|intersectionContour,computeIntersection| |c| |c'|))))) 
+;        --this loop will return NIL if not satisfied
+;
+;addContour(c,E is [cur,:tail]) ==
+;  [NCONC(fn(c,E),cur),:tail] where
+;    fn(c,e) ==
+;        for [x,:proplist] in c repeat
+;           fn1(x,proplist,getProplist(x,e)) where
+;              fn1(x,p,ee) ==
+;                for pv in p repeat fn3(x,pv,ee) where
+;                 fn3(x,pv,e) ==
+;                   [p,:v]:=pv;
+;                   if MEMBER(x,$getPutTrace) then
+;                     pp([x,"has",pv]);
+;                   if p="conditionalmode" then
+;                     RPLACA(pv,"mode");
+;                     --check for conflicts with earlier mode
+;                     if vv:=LASSOC("mode",e) then
+;                        if v ^=vv then
+;                          stackWarning ["The conditional modes ",
+;                                     v," and ",vv," conflict"]
+;        LIST c
+
+;;;     ***       |addContour,fn3| REDEFINED
+
+(DEFUN |addContour,fn3| (|x| |pv| |e|) (PROG (|p| |v| |vv|) (RETURN (SEQ (PROGN (SPADLET |p| (CAR |pv|)) (SPADLET |v| (CDR |pv|)) |pv|) (IF (|member| |x| |$getPutTrace|) (|pp| (CONS |x| (CONS (QUOTE |has|) (CONS |pv| NIL)))) NIL) (EXIT (IF (BOOT-EQUAL |p| (QUOTE |conditionalmode|)) (SEQ (RPLACA |pv| (QUOTE |mode|)) (EXIT (IF (SPADLET |vv| (LASSOC (QUOTE |mode|) |e|)) (IF (NEQUAL |v| |vv|) (|stackWarning| (CONS (QUOTE |The conditional modes |) (CONS |v| (CONS (QUOTE | and |) (CONS |vv| (CONS (QUOTE | conflict|) NIL)))))) NIL) NIL))) NIL)))))) 
+
+;;;     ***       |addContour,fn1| REDEFINED
+
+(DEFUN |addContour,fn1| (|x| |p| |ee|) (SEQ (DO ((#0=#:G2898 |p| (CDR #0#)) (|pv| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |pv| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|addContour,fn3| |x| |pv| |ee|)))))) 
+
+;;;     ***       |addContour,fn| REDEFINED
+
+(DEFUN |addContour,fn| (|c| |e|) (PROG (|x| |proplist|) (RETURN (SEQ (DO ((#0=#:G2917 |c| (CDR #0#)) (#1=#:G2908 NIL)) ((OR (ATOM #0#) (PROGN (SETQ #1# (CAR #0#)) NIL) (PROGN (PROGN (SPADLET |x| (CAR #1#)) (SPADLET |proplist| (CDR #1#)) #1#) NIL)) NIL) (SEQ (EXIT (|addContour,fn1| |x| |proplist| (|getProplist| |x| |e|))))) (EXIT (LIST |c|)))))) 
+
+;;;     ***       |addContour| REDEFINED
+
+(DEFUN |addContour| (|c| E) (PROG (|cur| |tail|) (RETURN (PROGN (SPADLET |cur| (CAR E)) (SPADLET |tail| (CDR E)) (CONS (NCONC (|addContour,fn| |c| E) |cur|) |tail|))))) 
+;
+;makeCommonEnvironment(e,e') ==
+;  interE makeSameLength(e,e') where  --$ie:=
+;    interE [e,e'] ==
+;      rest e=rest e' => [interLocalE makeSameLength(first e,first e'),:rest e]
+;      interE [rest e,rest e']
+;    interLocalE [le,le'] ==
+;      rest le=rest le' =>
+;        [interC makeSameLength(first le,first le'),:rest le]
+;      interLocalE [rest le,rest le']
+;    interC [c,c'] ==
+;      c=c' => c
+;      interC [rest c,rest c']
+;    makeSameLength(x,y) ==
+;      fn(x,y,#x,#y) where
+;        fn(x,y,nx,ny) ==
+;          nx>ny => fn(rest x,y,nx-1,ny)
+;          nx<ny => fn(x,rest y,nx,ny-1)
+;          [x,y]
+
+;;;     ***       |makeCommonEnvironment,fn| REDEFINED
+
+(DEFUN |makeCommonEnvironment,fn| (|x| |y| |nx| |ny|) (SEQ (IF (> |nx| |ny|) (EXIT (|makeCommonEnvironment,fn| (CDR |x|) |y| (SPADDIFFERENCE |nx| 1) |ny|))) (IF (> |ny| |nx|) (EXIT (|makeCommonEnvironment,fn| |x| (CDR |y|) |nx| (SPADDIFFERENCE |ny| 1)))) (EXIT (CONS |x| (CONS |y| NIL))))) 
+
+;;;     ***       |makeCommonEnvironment,makeSameLength| REDEFINED
+
+(DEFUN |makeCommonEnvironment,makeSameLength| (|x| |y|) (|makeCommonEnvironment,fn| |x| |y| (|#| |x|) (|#| |y|))) 
+
+;;;     ***       |makeCommonEnvironment,interC| REDEFINED
+
+(DEFUN |makeCommonEnvironment,interC| (#0=#:G2954) (PROG (|c| |c'|) (RETURN (SEQ (PROGN (SPADLET |c| (CAR #0#)) (SPADLET |c'| (CADR #0#)) #0# (SEQ (IF (BOOT-EQUAL |c| |c'|) (EXIT |c|)) (EXIT (|makeCommonEnvironment,interC| (CONS (CDR |c|) (CONS (CDR |c'|) NIL)))))))))) 
+
+;;;     ***       |makeCommonEnvironment,interLocalE| REDEFINED
+
+(DEFUN |makeCommonEnvironment,interLocalE| (#0=#:G2968) (PROG (|le| |le'|) (RETURN (SEQ (PROGN (SPADLET |le| (CAR #0#)) (SPADLET |le'| (CADR #0#)) #0# (SEQ (IF (BOOT-EQUAL (CDR |le|) (CDR |le'|)) (EXIT (CONS (|makeCommonEnvironment,interC| (|makeCommonEnvironment,makeSameLength| (CAR |le|) (CAR |le'|))) (CDR |le|)))) (EXIT (|makeCommonEnvironment,interLocalE| (CONS (CDR |le|) (CONS (CDR |le'|) NIL)))))))))) 
+
+;;;     ***       |makeCommonEnvironment,interE| REDEFINED
+
+(DEFUN |makeCommonEnvironment,interE| (#0=#:G2982) (PROG (|e| |e'|) (RETURN (SEQ (PROGN (SPADLET |e| (CAR #0#)) (SPADLET |e'| (CADR #0#)) #0# (SEQ (IF (BOOT-EQUAL (CDR |e|) (CDR |e'|)) (EXIT (CONS (|makeCommonEnvironment,interLocalE| (|makeCommonEnvironment,makeSameLength| (CAR |e|) (CAR |e'|))) (CDR |e|)))) (EXIT (|makeCommonEnvironment,interE| (CONS (CDR |e|) (CONS (CDR |e'|) NIL)))))))))) 
+
+;;;     ***       |makeCommonEnvironment| REDEFINED
+
+(DEFUN |makeCommonEnvironment| (|e| |e'|) (|makeCommonEnvironment,interE| (|makeCommonEnvironment,makeSameLength| |e| |e'|))) 
+;
+;printEnv E ==
+;  for x in E for i in 1.. repeat
+;    for y in x for j in 1.. repeat
+;      SAY('"******CONTOUR ",j,'", LEVEL ",i,'":******")
+;      for z in y repeat
+;        TERPRI()
+;        SAY("Properties Of: ",first z)
+;        for u in rest z repeat
+;          PRIN0 first u
+;          printString ": "
+;          PRETTYPRINT tran(rest u,first u) where
+;            tran(val,prop) ==
+;              prop="value" => DROP(-1,val)
+;              val
+
+;;;     ***       |printEnv,tran| REDEFINED
+
+(DEFUN |printEnv,tran| (|val| |prop|) (SEQ (IF (BOOT-EQUAL |prop| (QUOTE |value|)) (EXIT (DROP (SPADDIFFERENCE 1) |val|))) (EXIT |val|))) 
+
+;;;     ***       |printEnv| REDEFINED
+
+(DEFUN |printEnv| (E) (SEQ (DO ((#0=#:G3020 E (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (DO ((#1=#:G3038 |x| (CDR #1#)) (|y| NIL) (|j| 1 (QSADD1 |j|))) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (PROGN (SAY (MAKESTRING "******CONTOUR ") |j| (MAKESTRING ", LEVEL ") |i| (MAKESTRING ":******")) (DO ((#2=#:G3053 |y| (CDR #2#)) (|z| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |z| (CAR #2#)) NIL)) NIL) (SEQ (EXIT (PROGN (TERPRI) (SAY (MAKESTRING "Properties Of: ") (CAR |z|)) (DO ((#3=#:G3065 (CDR |z|) (CDR #3#)) (|u| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |u| (CAR #3#)) NIL)) NIL) (SEQ (EXIT (PROGN (PRIN0 (CAR |u|)) (|printString| (QUOTE |: |)) (PRETTYPRINT (|printEnv,tran| (CDR |u|) (CAR |u|)))))))))))))))))))) 
+;
+;prEnv E ==
+;  for x in E for i in 1.. repeat
+;    for y in x for j in 1.. repeat
+;      SAY('"******CONTOUR ",j,'", LEVEL ",i,'":******")
+;      for z in y | not LASSOC("modemap",rest z) repeat
+;        TERPRI()
+;        SAY("Properties Of: ",first z)
+;        for u in rest z repeat
+;          PRIN0 first u
+;          printString ": "
+;          PRETTYPRINT tran(rest u,first u) where
+;            tran(val,prop) ==
+;              prop="value" => DROP(-1,val)
+;              val
+
+;;;     ***       |prEnv,tran| REDEFINED
+
+(DEFUN |prEnv,tran| (|val| |prop|) (SEQ (IF (BOOT-EQUAL |prop| (QUOTE |value|)) (EXIT (DROP (SPADDIFFERENCE 1) |val|))) (EXIT |val|))) 
+
+;;;     ***       |prEnv| REDEFINED
+
+(DEFUN |prEnv| (E) (SEQ (DO ((#0=#:G3094 E (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (DO ((#1=#:G3112 |x| (CDR #1#)) (|y| NIL) (|j| 1 (QSADD1 |j|))) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (PROGN (SAY (MAKESTRING "******CONTOUR ") |j| (MAKESTRING ", LEVEL ") |i| (MAKESTRING ":******")) (DO ((#2=#:G3128 |y| (CDR #2#)) (|z| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |z| (CAR #2#)) NIL)) NIL) (SEQ (EXIT (COND ((NULL (LASSOC (QUOTE |modemap|) (CDR |z|))) (PROGN (TERPRI) (SAY (MAKESTRING "Properties Of: ") (CAR |z|)) (DO ((#3=#:G3140 (CDR |z|) (CDR #3#)) (|u| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |u| (CAR #3#)) NIL)) NIL) (SEQ (EXIT (PROGN (PRIN0 (CAR |u|)) (|printString| (QUOTE |: |)) (PRETTYPRINT (|prEnv,tran| (CDR |u|) (CAR |u|)))))))))))))))))))))) 
+;
+;prModemaps E ==
+;  listOfOperatorsSeenSoFar:= nil
+;  for x in E for i in 1.. repeat
+;    for y in x for j in 1.. repeat
+;      for z in y | null MEMBER(first z,listOfOperatorsSeenSoFar) and
+;        (modemap:= LASSOC("modemap",rest z)) repeat
+;          listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar]
+;          TERPRI()
+;          PRIN0 first z
+;          printString ": "
+;          PRETTYPRINT modemap
+
+;;;     ***       |prModemaps| REDEFINED
+
+(DEFUN |prModemaps| (E) (PROG (|modemap| |listOfOperatorsSeenSoFar|) (RETURN (SEQ (PROGN (SPADLET |listOfOperatorsSeenSoFar| NIL) (DO ((#0=#:G3160 E (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (DO ((#1=#:G3175 |x| (CDR #1#)) (|y| NIL) (|j| 1 (QSADD1 |j|))) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (DO ((#2=#:G3190 |y| (CDR #2#)) (|z| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |z| (CAR #2#)) NIL)) NIL) (SEQ (EXIT (COND ((AND (NULL (|member| (CAR |z|) |listOfOperatorsSeenSoFar|)) (SPADLET |modemap| (LASSOC (QUOTE |modemap|) (CDR |z|)))) (PROGN (SPADLET |listOfOperatorsSeenSoFar| (CONS (CAR |z|) |listOfOperatorsSeenSoFar|)) (TERPRI) (PRIN0 (CAR |z|)) (|printString| (QUOTE |: |)) (PRETTYPRINT |modemap|)))))))))))))))))) 
+;
+;prTriple T ==
+;   SAY '"Code:"
+;   pp T.0
+;   SAY '"Mode:"
+;   pp T.1
+
+;;;     ***       |prTriple| REDEFINED
+
+(DEFUN |prTriple| (T$) (PROGN (SAY (MAKESTRING "Code:")) (|pp| (ELT T$ 0)) (SAY (MAKESTRING "Mode:")) (|pp| (ELT T$ 1)))) 
+;
+;TrimCF() ==
+;  new:= nil
+;  old:= CAAR $CategoryFrame
+;  for u in old repeat
+;    if not ASSQ(first u,new) then
+;      uold:= rest u
+;      unew:= nil
+;      for v in uold repeat if not ASSQ(first v,unew) then unew:= [v,:unew]
+;      new:= [[first u,:NREVERSE unew],:new]
+;  $CategoryFrame:= [[NREVERSE new]]
+;  nil
+
+;;;     ***       |TrimCF| REDEFINED
+
+(DEFUN |TrimCF| NIL (PROG (|old| |uold| |unew| |new|) (RETURN (SEQ (PROGN (SPADLET |new| NIL) (SPADLET |old| (CAAR |$CategoryFrame|)) (DO ((#0=#:G3211 |old| (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (COND ((NULL (ASSQ (CAR |u|) |new|)) (SPADLET |uold| (CDR |u|)) (SPADLET |unew| NIL) (DO ((#1=#:G3220 |uold| (CDR #1#)) (|v| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |v| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (COND ((NULL (ASSQ (CAR |v|) |unew|)) (SPADLET |unew| (CONS |v| |unew|))) ((QUOTE T) NIL))))) (SPADLET |new| (CONS (CONS (CAR |u|) (NREVERSE |unew|)) |new|))) ((QUOTE T) NIL))))) (SPADLET |$CategoryFrame| (CONS (CONS (NREVERSE |new|) NIL) NIL)) NIL))))) 
+;
+;
+;--% PREDICATES
+;
+;
+;isConstantId(name,e) ==
+;  IDENTP name =>
+;    pl:= getProplist(name,e) =>
+;      (LASSOC("value",pl) or LASSOC("mode",pl) => false; true)
+;    true
+;  false
+
+;;;     ***       |isConstantId| REDEFINED
+
+(DEFUN |isConstantId| (|name| |e|) (PROG (|pl|) (RETURN (COND ((IDENTP |name|) (COND ((SPADLET |pl| (|getProplist| |name| |e|)) (COND ((OR (LASSOC (QUOTE |value|) |pl|) (LASSOC (QUOTE |mode|) |pl|)) NIL) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE T)))) ((QUOTE T) NIL))))) 
+;
+;isFalse() == nil
+
+;;;     ***       |isFalse| REDEFINED
+
+(DEFUN |isFalse| NIL NIL) 
+;
+;isFluid s == atom s and "$"=(PNAME s).(0)
+
+;;;     ***       |isFluid| REDEFINED
+
+(DEFUN |isFluid| (|s|) (AND (ATOM |s|) (BOOT-EQUAL (QUOTE $) (ELT (PNAME |s|) 0)))) 
+;
+;isFunction(x,e) ==
+;  get(x,"modemap",e) or GET(x,"SPECIAL") or x="case" or getmode(x,e) is [
+;    "Mapping",:.]
+
+;;;     ***       |isFunction| REDEFINED
+
+(DEFUN |isFunction| (|x| |e|) (PROG (|ISTMP#1|) (RETURN (OR (|get| |x| (QUOTE |modemap|) |e|) (GETL |x| (QUOTE SPECIAL)) (BOOT-EQUAL |x| (QUOTE |case|)) (PROGN (SPADLET |ISTMP#1| (|getmode| |x| |e|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Mapping|)))))))) 
+;
+;isLiteral(x,e) == get(x,"isLiteral",e)
+
+;;;     ***       |isLiteral| REDEFINED
+
+(DEFUN |isLiteral| (|x| |e|) (|get| |x| (QUOTE |isLiteral|) |e|)) 
+;
+;makeLiteral(x,e) == put(x,"isLiteral","true",e)
+
+;;;     ***       |makeLiteral| REDEFINED
+
+(DEFUN |makeLiteral| (|x| |e|) (|put| |x| (QUOTE |isLiteral|) (QUOTE |true|) |e|)) 
+;
+;isSomeDomainVariable s ==
+;  IDENTP s and #(x:= PNAME s)>2 and x.(0)="#" and x.(1)="#"
+
+;;;     ***       |isSomeDomainVariable| REDEFINED
+
+(DEFUN |isSomeDomainVariable| (|s|) (PROG (|x|) (RETURN (AND (IDENTP |s|) (> (|#| (SPADLET |x| (PNAME |s|))) 2) (BOOT-EQUAL (ELT |x| 0) (QUOTE |#|)) (BOOT-EQUAL (ELT |x| 1) (QUOTE |#|)))))) 
+;
+;isSubset(x,y,e) ==
+;  x="$" and y="Rep" or x=y or
+;    LASSOC(opOf x,get(opOf y,"Subsets",e) or GET(opOf y,"Subsets")) or
+;      LASSOC(opOf x,get(opOf y,"SubDomain",e)) or
+;        opOf(y)='Type or opOf(y)='Object
+
+;;;     ***       |isSubset| REDEFINED
+
+(DEFUN |isSubset| (|x| |y| |e|) (OR (AND (BOOT-EQUAL |x| (QUOTE $)) (BOOT-EQUAL |y| (QUOTE |Rep|))) (BOOT-EQUAL |x| |y|) (LASSOC (|opOf| |x|) (OR (|get| (|opOf| |y|) (QUOTE |Subsets|) |e|) (GETL (|opOf| |y|) (QUOTE |Subsets|)))) (LASSOC (|opOf| |x|) (|get| (|opOf| |y|) (QUOTE |SubDomain|) |e|)) (BOOT-EQUAL (|opOf| |y|) (QUOTE |Type|)) (BOOT-EQUAL (|opOf| |y|) (QUOTE |Object|)))) 
+;
+;isDomainInScope(domain,e) ==
+;  domainList:= getDomainsInScope e
+;  atom domain =>
+;    MEMQ(domain,domainList) => true
+;    not IDENTP domain or isSomeDomainVariable domain => true
+;    false
+;  (name:= first domain)="Category" => true
+;  ASSQ(name,domainList) => true
+;--   null CDR domain or domainMember(domain,domainList) => true
+;--   false
+;  isFunctor name => false
+;  true --is not a functor
+
+;;;     ***       |isDomainInScope| REDEFINED
+
+(DEFUN |isDomainInScope| (|domain| |e|) (PROG (|domainList| |name|) (RETURN (PROGN (SPADLET |domainList| (|getDomainsInScope| |e|)) (COND ((ATOM |domain|) (COND ((MEMQ |domain| |domainList|) (QUOTE T)) ((OR (NULL (IDENTP |domain|)) (|isSomeDomainVariable| |domain|)) (QUOTE T)) ((QUOTE T) NIL))) ((BOOT-EQUAL (SPADLET |name| (CAR |domain|)) (QUOTE |Category|)) (QUOTE T)) ((ASSQ |name| |domainList|) (QUOTE T)) ((|isFunctor| |name|) NIL) ((QUOTE T) (QUOTE T))))))) 
+;
+;isSymbol x == IDENTP x or x=nil
+
+;;;     ***       |isSymbol| REDEFINED
+
+(DEFUN |isSymbol| (|x|) (OR (IDENTP |x|) (NULL |x|))) 
+;
+;isSimple x ==
+;  atom x or $InteractiveMode => true
+;  x is [op,:argl] and
+;    isSideEffectFree op and (and/[isSimple y for y in argl])
+
+;;;     ***       |isSimple| REDEFINED
+
+(DEFUN |isSimple| (|x|) (PROG (|op| |argl|) (RETURN (SEQ (COND ((OR (ATOM |x|) |$InteractiveMode|) (QUOTE T)) ((QUOTE T) (AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (SPADLET |argl| (QCDR |x|)) (QUOTE T)) (|isSideEffectFree| |op|) (PROG (#0=#:G3282) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G3288 NIL (NULL #0#)) (#2=#:G3289 |argl| (CDR #2#)) (|y| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |y| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (|isSimple| |y|))))))))))))))) 
+;
+;isSideEffectFree op ==
+;  MEMBER(op,$SideEffectFreeFunctionList) or op is ["elt",.,op'] and
+;    isSideEffectFree op'
+
+;;;     ***       |isSideEffectFree| REDEFINED
+
+(DEFUN |isSideEffectFree| (|op|) (PROG (|ISTMP#1| |ISTMP#2| |op'|) (RETURN (OR (|member| |op| |$SideEffectFreeFunctionList|) (AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |op'| (QCAR |ISTMP#2|)) (QUOTE T)))))) (|isSideEffectFree| |op'|)))))) 
+;
+;isAlmostSimple x ==
+;  --returns (<new predicate> . <list of assignments>) or nil
+;  $assignmentList: local --$assigmentList is only used in this function
+;  transform:=
+;    fn x where
+;      fn x ==
+;        atom x or null rest x => x
+;        [op,y,:l]:= x
+;        op="has" => x
+;        op="is" => x
+;        op="LET" =>
+;          IDENTP y => (setAssignment LIST x; y)
+;          true => (setAssignment [["LET",g:= genVariable(),:l],["LET",y,g]]; g)
+;        isSideEffectFree op => [op,:mapInto(rest x,"fn")]
+;        true => $assignmentList:= "failed"
+;      setAssignment x ==
+;        $assignmentList="failed" => nil
+;        $assignmentList:= [:$assignmentList,:x]
+;  $assignmentList="failed" => nil
+;  wrapSEQExit [:$assignmentList,transform]
+
+;;;     ***       |isAlmostSimple,setAssignment| REDEFINED
+
+(DEFUN |isAlmostSimple,setAssignment| (|x|) (SEQ (IF (BOOT-EQUAL |$assignmentList| (QUOTE |failed|)) (EXIT NIL)) (EXIT (SPADLET |$assignmentList| (APPEND |$assignmentList| |x|))))) 
+
+;;;     ***       |isAlmostSimple,fn| REDEFINED
+
+(DEFUN |isAlmostSimple,fn| (|x|) (PROG (|op| |y| |l| |g|) (RETURN (SEQ (IF (OR (ATOM |x|) (NULL (CDR |x|))) (EXIT |x|)) (PROGN (SPADLET |op| (CAR |x|)) (SPADLET |y| (CADR |x|)) (SPADLET |l| (CDDR |x|)) |x|) (IF (BOOT-EQUAL |op| (QUOTE |has|)) (EXIT |x|)) (IF (BOOT-EQUAL |op| (QUOTE |is|)) (EXIT |x|)) (IF (BOOT-EQUAL |op| (QUOTE LET)) (EXIT (SEQ (IF (IDENTP |y|) (EXIT (SEQ (|isAlmostSimple,setAssignment| (LIST |x|)) (EXIT |y|)))) (EXIT (IF (QUOTE T) (EXIT (SEQ (|isAlmostSimple,setAssignment| (CONS (CONS (QUOTE LET) (CONS (SPADLET |g| (|genVariable|)) |l|)) (CONS (CONS (QUOTE LET) (CONS |y| (CONS |g| NIL))) NIL))) (EXIT |g|)))))))) (IF (|isSideEffectFree| |op|) (EXIT (CONS |op| (|mapInto| (CDR |x|) (QUOTE |isAlmostSimple,fn|))))) (EXIT (IF (QUOTE T) (EXIT (SPADLET |$assignmentList| (QUOTE |failed|))))))))) 
+
+;;;     ***       |isAlmostSimple| REDEFINED
+
+(DEFUN |isAlmostSimple| (|x|) (PROG (|$assignmentList| |transform|) (DECLARE (SPECIAL |$assignmentList|)) (RETURN (PROGN (SPADLET |$assignmentList| NIL) (SPADLET |transform| (|isAlmostSimple,fn| |x|)) (COND ((BOOT-EQUAL |$assignmentList| (QUOTE |failed|)) NIL) ((QUOTE T) (|wrapSEQExit| (APPEND |$assignmentList| (CONS |transform| NIL))))))))) 
+;
+;incExitLevel u ==
+;  adjExitLevel(u,1,1)
+;  u
+
+;;;     ***       |incExitLevel| REDEFINED
+
+(DEFUN |incExitLevel| (|u|) (PROGN (|adjExitLevel| |u| 1 1) |u|)) 
+;
+;decExitLevel u ==
+;  (adjExitLevel(u,1,-1); removeExit0 u) where
+;    removeExit0 x ==
+;      atom x => x
+;      x is ["exit",0,u] => removeExit0 u
+;      [removeExit0 first x,:removeExit0 rest x]
+
+;;;     ***       |decExitLevel,removeExit0| REDEFINED
+
+(DEFUN |decExitLevel,removeExit0| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |u|) (RETURN (SEQ (IF (ATOM |x|) (EXIT |x|)) (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) 0) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#2|)) (QUOTE T))))))) (EXIT (|decExitLevel,removeExit0| |u|))) (EXIT (CONS (|decExitLevel,removeExit0| (CAR |x|)) (|decExitLevel,removeExit0| (CDR |x|)))))))) 
+
+;;;     ***       |decExitLevel| REDEFINED
+
+(DEFUN |decExitLevel| (|u|) (PROGN (|adjExitLevel| |u| 1 (SPADDIFFERENCE 1)) (|decExitLevel,removeExit0| |u|))) 
+;
+;adjExitLevel(x,seqnum,inc) ==
+;  atom x => x
+;  x is [op,:l] and MEMQ(op,'(SEQ REPEAT COLLECT)) =>
+;    for u in l repeat adjExitLevel(u,seqnum+1,inc)
+;  x is ["exit",n,u] =>
+;    (adjExitLevel(u,seqnum,inc); seqnum>n => x; rplac(CADR x,n+inc))
+;  x is [op,:l] => for u in l repeat adjExitLevel(u,seqnum,inc)
+
+;;;     ***       |adjExitLevel| REDEFINED
+
+(DEFUN |adjExitLevel| (|x| |seqnum| |inc|) (PROG (|ISTMP#1| |n| |ISTMP#2| |u| |op| |l|) (RETURN (SEQ (COND ((ATOM |x|) |x|) ((AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T)) (MEMQ |op| (QUOTE (SEQ REPEAT COLLECT)))) (DO ((#0=#:G3401 |l| (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|adjExitLevel| |u| (PLUS |seqnum| 1) |inc|))))) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |n| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|adjExitLevel| |u| |seqnum| |inc|) (COND ((> |seqnum| |n|) |x|) ((QUOTE T) (|rplac| (CADR |x|) (PLUS |n| |inc|))))) ((AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T))) (DO ((#1=#:G3410 |l| (CDR #1#)) (|u| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |u| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (|adjExitLevel| |u| |seqnum| |inc|)))))))))) 
+;
+;wrapSEQExit l ==
+;  null rest l => first l
+;  [:c,x]:= [incExitLevel u for u in l]
+;  ["SEQ",:c,["exit",1,x]]
+
+;;;     ***       |wrapSEQExit| REDEFINED
+
+(DEFUN |wrapSEQExit| (|l|) (PROG (|LETTMP#1| |LETTMP#2| |x| |c|) (RETURN (SEQ (COND ((NULL (CDR |l|)) (CAR |l|)) ((QUOTE T) (SPADLET |LETTMP#1| (PROG (#0=#:G3441) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3446 |l| (CDR #1#)) (|u| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |u| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|incExitLevel| |u|) #0#)))))))) (SPADLET |LETTMP#2| (REVERSE |LETTMP#1|)) (SPADLET |x| (CAR |LETTMP#2|)) (SPADLET |c| (NREVERSE (CDR |LETTMP#2|))) (CONS (QUOTE SEQ) (APPEND |c| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS |x| NIL))) NIL))))))))) 
+;
+;
+;--% UTILITY FUNCTIONS
+;
+;--appendOver x == "append"/x
+;
+;removeEnv t == [t.expr,t.mode,$EmptyEnvironment]  -- t is a triple
+
+;;;     ***       |removeEnv| REDEFINED
+
+(DEFUN |removeEnv| (|t|) (CONS (CAR |t|) (CONS (CADR |t|) (CONS |$EmptyEnvironment| NIL)))) 
+;
+;-- This function seems no longer used
+;--ordinsert(x,l) ==
+;--  null l => [x]
+;--  x=first l => l
+;--  _?ORDER(x,first l) => [x,:l]
+;--  [first l,:ordinsert(x,rest l)]
+;
+;makeNonAtomic x ==
+;  atom x => [x]
+;  x
+
+;;;     ***       |makeNonAtomic| REDEFINED
+
+(DEFUN |makeNonAtomic| (|x|) (COND ((ATOM |x|) (CONS |x| NIL)) ((QUOTE T) |x|))) 
+;
+;flatten(l,key) ==
+;  null l => nil
+;  first l is [k,:r] and k=key => [:r,:flatten(rest l,key)]
+;  [first l,:flatten(rest l,key)]
+
+;;;     ***       |flatten| REDEFINED
+
+(DEFUN |flatten| (|l| |key|) (PROG (|ISTMP#1| |k| |r|) (RETURN (COND ((NULL |l|) NIL) ((AND (PROGN (SPADLET |ISTMP#1| (CAR |l|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |k| (QCAR |ISTMP#1|)) (SPADLET |r| (QCDR |ISTMP#1|)) (QUOTE T)))) (BOOT-EQUAL |k| |key|)) (APPEND |r| (|flatten| (CDR |l|) |key|))) ((QUOTE T) (CONS (CAR |l|) (|flatten| (CDR |l|) |key|))))))) 
+;
+;genDomainVar() ==
+;  $Index:= $Index+1
+;  INTERNL STRCONC("#D",STRINGIMAGE $Index)
+
+;;;     ***       |genDomainVar| REDEFINED
+
+(DEFUN |genDomainVar| NIL (PROGN (SPADLET |$Index| (PLUS |$Index| 1)) (INTERNL (STRCONC (QUOTE |#D|) (STRINGIMAGE |$Index|))))) 
+;
+;genVariable() ==
+;  INTERNL STRCONC("#G",STRINGIMAGE ($genSDVar:= $genSDVar+1))
+
+;;;     ***       |genVariable| REDEFINED
+
+(DEFUN |genVariable| NIL (INTERNL (STRCONC (QUOTE |#G|) (STRINGIMAGE (SPADLET |$genSDVar| (PLUS |$genSDVar| 1)))))) 
+;
+;genSomeVariable() ==
+;  INTERNL STRCONC("##",STRINGIMAGE ($genSDVar:= $genSDVar+1))
+
+;;;     ***       |genSomeVariable| REDEFINED
+
+(DEFUN |genSomeVariable| NIL (INTERNL (STRCONC (QUOTE |##|) (STRINGIMAGE (SPADLET |$genSDVar| (PLUS |$genSDVar| 1)))))) 
+;
+;listOfIdentifiersIn x ==
+;  IDENTP x => [x]
+;  x is [op,:l] => REMDUP ("append"/[listOfIdentifiersIn y for y in l])
+;  nil
+
+;;;     ***       |listOfIdentifiersIn| REDEFINED
+
+(DEFUN |listOfIdentifiersIn| (|x|) (PROG (|op| |l|) (RETURN (SEQ (COND ((IDENTP |x|) (CONS |x| NIL)) ((AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T))) (REMDUP (PROG (#0=#:G3499) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3504 |l| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|listOfIdentifiersIn| |y|)))))))))) ((QUOTE T) NIL)))))) 
+;
+;mapInto(x,fn) == [FUNCALL(fn,y) for y in x]
+
+;;;     ***       |mapInto| REDEFINED
+
+(DEFUN |mapInto| (|x| |fn|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G3520) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3525 |x| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (FUNCALL |fn| |y|) #0#))))))))))) 
+;
+;numOfOccurencesOf(x,y) ==
+;  fn(x,y,0) where
+;    fn(x,y,n) ==
+;      null y => 0
+;      x=y => n+1
+;      atom y => n
+;      fn(x,first y,n)+fn(x,rest y,n)
+
+;;;     ***       |numOfOccurencesOf,fn| REDEFINED
+
+(DEFUN |numOfOccurencesOf,fn| (|x| |y| |n|) (SEQ (IF (NULL |y|) (EXIT 0)) (IF (BOOT-EQUAL |x| |y|) (EXIT (PLUS |n| 1))) (IF (ATOM |y|) (EXIT |n|)) (EXIT (PLUS (|numOfOccurencesOf,fn| |x| (CAR |y|) |n|) (|numOfOccurencesOf,fn| |x| (CDR |y|) |n|))))) 
+
+;;;     ***       |numOfOccurencesOf| REDEFINED
+
+(DEFUN |numOfOccurencesOf| (|x| |y|) (|numOfOccurencesOf,fn| |x| |y| 0)) 
+;
+;compilerMessage x ==
+;  $PrintCompilerMessageIfTrue => APPLX("SAY",x)
+
+;;;     ***       |compilerMessage| REDEFINED
+
+(DEFUN |compilerMessage| (|x|) (SEQ (COND (|$PrintCompilerMessageIfTrue| (EXIT (APPLX (QUOTE SAY) |x|)))))) 
+;
+;printDashedLine() ==
+;  SAY
+;   '"--------------------------------------------------------------------------"
+
+;;;     ***       |printDashedLine| REDEFINED
+
+(DEFUN |printDashedLine| NIL (SAY (MAKESTRING "--------------------------------------------------------------------------"))) 
+;
+;stackSemanticError(msg,expr) ==
+;  BUMPERRORCOUNT "semantic"
+;  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+;  if atom msg then msg:= LIST msg
+;  entry:= [msg,expr]
+;  if not MEMBER(entry,$semanticErrorStack) then $semanticErrorStack:=
+;    [entry,:$semanticErrorStack]
+;  $scanIfTrue and $insideCapsuleFunctionIfTrue=true and #$semanticErrorStack-
+;    $initCapsuleErrorCount>3 => THROW("compCapsuleBody",nil)
+;  nil
+
+;;;     ***       |stackSemanticError| REDEFINED
+
+(DEFUN |stackSemanticError| (|msg| |expr|) (PROG (|entry|) (RETURN (PROGN (BUMPERRORCOUNT (QUOTE |semantic|)) (COND (|$insideCapsuleFunctionIfTrue| (SPADLET |msg| (CONS |$op| (CONS (QUOTE |: |) |msg|))))) (COND ((ATOM |msg|) (SPADLET |msg| (LIST |msg|)))) (SPADLET |entry| (CONS |msg| (CONS |expr| NIL))) (COND ((NULL (|member| |entry| |$semanticErrorStack|)) (SPADLET |$semanticErrorStack| (CONS |entry| |$semanticErrorStack|)))) (COND ((AND |$scanIfTrue| (BOOT-EQUAL |$insideCapsuleFunctionIfTrue| (QUOTE T)) (> (SPADDIFFERENCE (|#| |$semanticErrorStack|) |$initCapsuleErrorCount|) 3)) (THROW (QUOTE |compCapsuleBody|) NIL)) ((QUOTE T) NIL)))))) 
+;
+;stackWarning msg ==
+;  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+;  if not MEMBER(msg,$warningStack) then $warningStack:= [msg,:$warningStack]
+;  nil
+
+;;;     ***       |stackWarning| REDEFINED
+
+(DEFUN |stackWarning| (|msg|) (PROGN (COND (|$insideCapsuleFunctionIfTrue| (SPADLET |msg| (CONS |$op| (CONS (QUOTE |: |) |msg|))))) (COND ((NULL (|member| |msg| |$warningStack|)) (SPADLET |$warningStack| (CONS |msg| |$warningStack|)))) NIL)) 
+;
+;unStackWarning msg ==
+;  if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg]
+;  $warningStack:= EFFACE(msg,$warningStack)
+;  nil
+
+;;;     ***       |unStackWarning| REDEFINED
+
+(DEFUN |unStackWarning| (|msg|) (PROGN (COND (|$insideCapsuleFunctionIfTrue| (SPADLET |msg| (CONS |$op| (CONS (QUOTE |: |) |msg|))))) (SPADLET |$warningStack| (EFFACE |msg| |$warningStack|)) NIL)) 
+;
+;stackMessage msg ==
+;  $compErrorMessageStack:= [msg,:$compErrorMessageStack]
+;  nil
+
+;;;     ***       |stackMessage| REDEFINED
+
+(DEFUN |stackMessage| (|msg|) (PROGN (SPADLET |$compErrorMessageStack| (CONS |msg| |$compErrorMessageStack|)) NIL)) 
+;
+;stackMessageIfNone msg ==
+;  --used in situations such as compForm where the earliest message is wanted
+;  if null $compErrorMessageStack then $compErrorMessageStack:=
+;    [msg,:$compErrorMessageStack]
+;  nil
+
+;;;     ***       |stackMessageIfNone| REDEFINED
+
+(DEFUN |stackMessageIfNone| (|msg|) (PROGN (COND ((NULL |$compErrorMessageStack|) (SPADLET |$compErrorMessageStack| (CONS |msg| |$compErrorMessageStack|)))) NIL)) 
+;
+;stackAndThrow msg ==
+;  $compErrorMessageStack:= [msg,:$compErrorMessageStack]
+;  THROW("compOrCroak",nil)
+
+;;;     ***       |stackAndThrow| REDEFINED
+
+(DEFUN |stackAndThrow| (|msg|) (PROGN (SPADLET |$compErrorMessageStack| (CONS |msg| |$compErrorMessageStack|)) (THROW (QUOTE |compOrCroak|) NIL))) 
+;
+;printString x == PRINTEXP (STRINGP x => x; PNAME x)
+
+;;;     ***       |printString| REDEFINED
+
+(DEFUN |printString| (|x|) (PRINTEXP (COND ((STRINGP |x|) |x|) ((QUOTE T) (PNAME |x|))))) 
+;
+;printAny x == if atom x then printString x else PRIN0 x
+
+;;;     ***       |printAny| REDEFINED
+
+(DEFUN |printAny| (|x|) (COND ((ATOM |x|) (|printString| |x|)) ((QUOTE T) (PRIN0 |x|)))) 
+;
+;printSignature(before,op,[target,:argSigList]) ==
+;  printString before
+;  printString op
+;  printString ": _("
+;  if argSigList then
+;    printAny first argSigList
+;    for m in rest argSigList repeat (printString ","; printAny m)
+;  printString "_) -> "
+;  printAny target
+;  TERPRI()
+
+;;;     ***       |printSignature| REDEFINED
+
+(DEFUN |printSignature| (|before| |op| #0=#:G3594) (PROG (|target| |argSigList|) (RETURN (SEQ (PROGN (SPADLET |target| (CAR #0#)) (SPADLET |argSigList| (CDR #0#)) (|printString| |before|) (|printString| |op|) (|printString| (QUOTE |: (|)) (COND (|argSigList| (|printAny| (CAR |argSigList|)) (DO ((#1=#:G3608 (CDR |argSigList|) (CDR #1#)) (|m| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |m| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (PROGN (|printString| (QUOTE |,|)) (|printAny| |m|))))))) (|printString| (QUOTE |) -> |)) (|printAny| |target|) (TERPRI)))))) 
+;
+;pmatch(s,p) == pmatchWithSl(s,p,"ok")
+
+;;;     ***       |pmatch| REDEFINED
+
+(DEFUN |pmatch| (|s| |p|) (|pmatchWithSl| |s| |p| (QUOTE |ok|))) 
+;
+;pmatchWithSl(s,p,al) ==
+;  s=$EmptyMode => nil
+;  s=p => al
+;  v:= ASSOC(p,al) => s=rest v or al
+;  MEMQ(p,$PatternVariableList) => [[p,:s],:al]
+;  null atom p and null atom s and (al':= pmatchWithSl(first s,first p,al)) and
+;    pmatchWithSl(rest s,rest p,al')
+
+;;;     ***       |pmatchWithSl| REDEFINED
+
+(DEFUN |pmatchWithSl| (|s| |p| |al|) (PROG (|v| |al'|) (RETURN (COND ((BOOT-EQUAL |s| |$EmptyMode|) NIL) ((BOOT-EQUAL |s| |p|) |al|) ((SPADLET |v| (|assoc| |p| |al|)) (OR (BOOT-EQUAL |s| (CDR |v|)) |al|)) ((MEMQ |p| |$PatternVariableList|) (CONS (CONS |p| |s|) |al|)) ((QUOTE T) (AND (NULL (ATOM |p|)) (NULL (ATOM |s|)) (SPADLET |al'| (|pmatchWithSl| (CAR |s|) (CAR |p|) |al|)) (|pmatchWithSl| (CDR |s|) (CDR |p|) |al'|))))))) 
+;
+;elapsedTime() ==
+;  currentTime:= TEMPUS_-FUGIT()
+;  elapsedSeconds:= (currentTime-$previousTime)*1.0/$timerTicksPerSecond
+;  $previousTime:= currentTime
+;  elapsedSeconds
+
+;;;     ***       |elapsedTime| REDEFINED
+
+(DEFUN |elapsedTime| NIL (PROG (|currentTime| |elapsedSeconds|) (RETURN (PROGN (SPADLET |currentTime| (TEMPUS-FUGIT)) (SPADLET |elapsedSeconds| (QUOTIENT (TIMES (SPADDIFFERENCE |currentTime| |$previousTime|) 1.0) |$timerTicksPerSecond|)) (SPADLET |$previousTime| |currentTime|) |elapsedSeconds|)))) 
+;
+;addStats([a,b],[c,d]) == [a+c,b+d]
+
+;;;     ***       |addStats| REDEFINED
+
+(DEFUN |addStats| (#0=#:G3635 #1=#:G3644) (PROG (|c| |d| |a| |b|) (RETURN (PROGN (SPADLET |c| (CAR #1#)) (SPADLET |d| (CADR #1#)) (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (CONS (PLUS |a| |c|) (CONS (PLUS |b| |d|) NIL)))))) 
+;
+;printStats [byteCount,elapsedSeconds] ==
+;  timeString := normalizeStatAndStringify elapsedSeconds
+;  if byteCount = 0 then SAY('"Time: ",timeString,'" SEC.") else
+;    SAY('"Size: ",byteCount,'" BYTES     Time: ",timeString,'" SEC.")
+;  TERPRI()
+;  nil
+
+;;;     ***       |printStats| REDEFINED
+
+(DEFUN |printStats| (#0=#:G3665) (PROG (|byteCount| |elapsedSeconds| |timeString|) (RETURN (PROGN (SPADLET |byteCount| (CAR #0#)) (SPADLET |elapsedSeconds| (CADR #0#)) (SPADLET |timeString| (|normalizeStatAndStringify| |elapsedSeconds|)) (COND ((EQL |byteCount| 0) (SAY (MAKESTRING "Time: ") |timeString| (MAKESTRING " SEC."))) ((QUOTE T) (SAY (MAKESTRING "Size: ") |byteCount| (MAKESTRING " BYTES     Time: ") |timeString| (MAKESTRING " SEC.")))) (TERPRI) NIL)))) 
+;
+;extendsCategoryForm(domain,form,form') ==
+;  --is domain of category form also of category form'?
+;  --domain is only used for SubsetCategory resolution.
+;  --and ensuring that X being a Ring means that it
+;  --satisfies (Algebra X)
+;  form=form' => true
+;  form=$Category => nil
+;  form' is ["Join",:l] => and/[extendsCategoryForm(domain,form,x) for x in l]
+;  form' is ["CATEGORY",.,:l] =>
+;    and/[extendsCategoryForm(domain,form,x) for x in l]
+;  form' is ["SubsetCategory",cat,dom] =>
+;    extendsCategoryForm(domain,form,cat) and isSubset(domain,dom,$e)
+;  form is ["Join",:l] => or/[extendsCategoryForm(domain,x,form') for x in l]
+;  form is ["CATEGORY",.,:l] =>
+;    MEMBER(form',l) or
+;      stackWarning ["not known that ",form'," is of mode ",form] or true
+;  isCategoryForm(form,$EmptyEnvironment) =>
+;          --Constructs the associated vector
+;    formVec:=(compMakeCategoryObject(form,$e)).expr
+;            --Must be $e to pick up locally bound domains
+;    form' is ["SIGNATURE",op,args,:.] =>
+;        ASSOC([op,args],formVec.(1)) or
+;            ASSOC(SUBSTQ(domain,"$",[op,args]),
+;                  SUBSTQ(domain,"$",formVec.(1)))
+;    form' is ["ATTRIBUTE",at] =>
+;         ASSOC(at,formVec.2) or
+;            ASSOC(SUBSTQ(domain,"$",at),SUBSTQ(domain,"$",formVec.2))
+;    form' is ["IF",:.] => true --temporary hack so comp won't fail
+;    -- Are we dealing with an Aldor category?  If so use the "has" function ...
+;    # formVec = 1 => newHasTest(form,form')
+;    catvlist:= formVec.4
+;    MEMBER(form',first catvlist) or
+;     MEMBER(form',SUBSTQ(domain,"$",first catvlist)) or
+;      (or/
+;        [extendsCategoryForm(domain,SUBSTQ(domain,"$",cat),form')
+;          for [cat,:.] in CADR catvlist])
+;  nil
+
+;;;     ***       |extendsCategoryForm| REDEFINED
+
+(DEFUN |extendsCategoryForm| (|domain| |form| |form'|) (PROG (|dom| |l| |formVec| |op| |ISTMP#2| |args| |ISTMP#1| |at| |catvlist| |cat|) (RETURN (SEQ (COND ((BOOT-EQUAL |form| |form'|) (QUOTE T)) ((BOOT-EQUAL |form| |$Category|) NIL) ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE |Join|)) (PROGN (SPADLET |l| (QCDR |form'|)) (QUOTE T))) (PROG (#0=#:G3729) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G3735 NIL (NULL #0#)) (#2=#:G3736 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (|extendsCategoryForm| |domain| |form| |x|))))))))) ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE CATEGORY)) (PROGN (SPADLET |ISTMP#1| (QCDR |form'|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (PROG (#3=#:G3743) (SPADLET #3# (QUOTE T)) (RETURN (DO ((#4=#:G3749 NIL (NULL #3#)) (#5=#:G3750 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (AND #3# (|extendsCategoryForm| |domain| |form| |x|))))))))) ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE |SubsetCategory|)) (PROGN (SPADLET |ISTMP#1| (QCDR |form'|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |cat| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |dom| (QCAR |ISTMP#2|)) (QUOTE T))))))) (AND (|extendsCategoryForm| |domain| |form| |cat|) (|isSubset| |domain| |dom| |$e|))) ((AND (PAIRP |form|) (EQ (QCAR |form|) (QUOTE |Join|)) (PROGN (SPADLET |l| (QCDR |form|)) (QUOTE T))) (PROG (#6=#:G3757) (SPADLET #6# NIL) (RETURN (DO ((#7=#:G3763 NIL #6#) (#8=#:G3764 |l| (CDR #8#)) (|x| NIL)) ((OR #7# (ATOM #8#) (PROGN (SETQ |x| (CAR #8#)) NIL)) #6#) (SEQ (EXIT (SETQ #6# (OR #6# (|extendsCategoryForm| |domain| |x| |form'|))))))))) ((AND (PAIRP |form|) (EQ (QCAR |form|) (QUOTE CATEGORY)) (PROGN (SPADLET |ISTMP#1| (QCDR |form|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (OR (|member| |form'| |l|) (|stackWarning| (CONS (QUOTE |not known that |) (CONS |form'| (CONS (QUOTE | is of mode |) (CONS |form| NIL))))) (QUOTE T))) ((|isCategoryForm| |form| |$EmptyEnvironment|) (SPADLET |formVec| (CAR (|compMakeCategoryObject| |form| |$e|))) (COND ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE SIGNATURE)) (PROGN (SPADLET |ISTMP#1| (QCDR |form'|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |args| (QCAR |ISTMP#2|)) (QUOTE T))))))) (OR (|assoc| (CONS |op| (CONS |args| NIL)) (ELT |formVec| 1)) (|assoc| (SUBSTQ |domain| (QUOTE $) (CONS |op| (CONS |args| NIL))) (SUBSTQ |domain| (QUOTE $) (ELT |formVec| 1))))) ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE ATTRIBUTE)) (PROGN (SPADLET |ISTMP#1| (QCDR |form'|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |at| (QCAR |ISTMP#1|)) (QUOTE T))))) (OR (|assoc| |at| (ELT |formVec| 2)) (|assoc| (SUBSTQ |domain| (QUOTE $) |at|) (SUBSTQ |domain| (QUOTE $) (ELT |formVec| 2))))) ((AND (PAIRP |form'|) (EQ (QCAR |form'|) (QUOTE IF))) (QUOTE T)) ((EQL (|#| |formVec|) 1) (|newHasTest| |form| |form'|)) ((QUOTE T) (SPADLET |catvlist| (ELT |formVec| 4)) (OR (|member| |form'| (CAR |catvlist|)) (|member| |form'| (SUBSTQ |domain| (QUOTE $) (CAR |catvlist|))) (PROG (#9=#:G3771) (SPADLET #9# NIL) (RETURN (DO ((#10=#:G3778 NIL #9#) (#11=#:G3779 (CADR |catvlist|) (CDR #11#)) (#12=#:G3724 NIL)) ((OR #10# (ATOM #11#) (PROGN (SETQ #12# (CAR #11#)) NIL) (PROGN (PROGN (SPADLET |cat| (CAR #12#)) #12#) NIL)) #9#) (SEQ (EXIT (SETQ #9# (OR #9# (|extendsCategoryForm| |domain| (SUBSTQ |domain| (QUOTE $) |cat|) |form'|)))))))))))) ((QUOTE T) NIL)))))) 
+;
+;getmode(x,e) ==
+;  prop:=getProplist(x,e)
+;  u:= LASSQ("value",prop) => u.mode
+;  LASSQ("mode",prop)
+
+;;;     ***       |getmode| REDEFINED
+
+(DEFUN |getmode| (|x| |e|) (PROG (|prop| |u|) (RETURN (PROGN (SPADLET |prop| (|getProplist| |x| |e|)) (COND ((SPADLET |u| (LASSQ (QUOTE |value|) |prop|)) (CADR |u|)) ((QUOTE T) (LASSQ (QUOTE |mode|) |prop|))))))) 
+;
+;getmodeOrMapping(x,e) ==
+;  u:= getmode(x,e) => u
+;  (u:= get(x,"modemap",e)) is [[[.,:map],.],:.] => ["Mapping",:map]
+;  nil
+
+;;;     ***       |getmodeOrMapping| REDEFINED
+
+(DEFUN |getmodeOrMapping| (|x| |e|) (PROG (|u| |ISTMP#1| |ISTMP#2| |ISTMP#3| |map| |ISTMP#4|) (RETURN (COND ((SPADLET |u| (|getmode| |x| |e|)) |u|) ((PROGN (SPADLET |ISTMP#1| (SPADLET |u| (|get| |x| (QUOTE |modemap|) |e|))) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |map| (QCDR |ISTMP#3|)) (QUOTE T)))) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#4|) (EQ (QCDR |ISTMP#4|) NIL))))))) (CONS (QUOTE |Mapping|) |map|)) ((QUOTE T) NIL))))) 
+;
+;outerProduct l ==
+;                --of a list of lists
+;  null l => LIST nil
+;  "append"/[[[x,:y] for y in outerProduct rest l] for x in first l]
+
+;;;     ***       |outerProduct| REDEFINED
+
+(DEFUN |outerProduct| (|l|) (PROG NIL (RETURN (SEQ (COND ((NULL |l|) (LIST NIL)) ((QUOTE T) (PROG (#0=#:G3855) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3860 (CAR |l|) (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (PROG (#2=#:G3870) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G3875 (|outerProduct| (CDR |l|)) (CDR #3#)) (|y| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (CONS |x| |y|) #2#)))))))))))))))))))) 
+;
+;sublisR(al,u) ==
+;  atom u => u
+;  y:= RASSOC(t:= [sublisR(al,x) for x in u],al) => y
+;  true => t
+
+;;;     ***       |sublisR| REDEFINED
+
+(DEFUN |sublisR| (|al| |u|) (PROG (|t| |y|) (RETURN (SEQ (COND ((ATOM |u|) |u|) ((SPADLET |y| (|rassoc| (SPADLET |t| (PROG (#0=#:G3891) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3896 |u| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|sublisR| |al| |x|) #0#)))))))) |al|)) |y|) ((QUOTE T) |t|)))))) 
+;
+;substituteOp(op',op,x) ==
+;  atom x => x
+;  [(op=(f:= first x) => op'; f),:[substituteOp(op',op,y) for y in rest x]]
+
+;;;     ***       |substituteOp| REDEFINED
+
+(DEFUN |substituteOp| (|op'| |op| |x|) (PROG (|f|) (RETURN (SEQ (COND ((ATOM |x|) |x|) ((QUOTE T) (CONS (COND ((BOOT-EQUAL |op| (SPADLET |f| (CAR |x|))) |op'|) ((QUOTE T) |f|)) (PROG (#0=#:G3914) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3919 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|substituteOp| |op'| |op| |y|) #0#)))))))))))))) 
+;
+;--substituteForFormalArguments(argl,expr) ==
+;--  SUBLIS([[v,:a] for a in argl for v in $FormalMapVariableList],expr)
+;
+; -- following is only intended for substituting in domains slots 1 and 4
+; -- signatures and categories
+;sublisV(p,e) ==
+;  (atom p => e; suba(p,e)) where
+;    suba(p,e) ==
+;      STRINGP e => e
+;      -- no need to descend vectors unless they are categories
+;      --REFVECP e => LIST2REFVEC [suba(p,e.i) for i in 0..MAXINDEX e]
+;      isCategory e => LIST2REFVEC [suba(p,e.i) for i in 0..MAXINDEX e]
+;      atom e => (y:= ASSQ(e,p) => rest y; e)
+;      u:= suba(p,QCAR e)
+;      v:= suba(p,QCDR e)
+;      EQ(QCAR e,u) and EQ(QCDR e,v) => e
+;      [u,:v]
+
+;;;     ***       |sublisV,suba| REDEFINED
+
+(DEFUN |sublisV,suba| (|p| |e|) (PROG (|y| |u| |v|) (RETURN (SEQ (IF (STRINGP |e|) (EXIT |e|)) (IF (|isCategory| |e|) (EXIT (LIST2REFVEC (PROG (#0=#:G3936) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3941 (MAXINDEX |e|)) (|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|sublisV,suba| |p| (ELT |e| |i|)) #0#)))))))))) (IF (ATOM |e|) (EXIT (SEQ (IF (SPADLET |y| (ASSQ |e| |p|)) (EXIT (CDR |y|))) (EXIT |e|)))) (SPADLET |u| (|sublisV,suba| |p| (QCAR |e|))) (SPADLET |v| (|sublisV,suba| |p| (QCDR |e|))) (IF (AND (EQ (QCAR |e|) |u|) (EQ (QCDR |e|) |v|)) (EXIT |e|)) (EXIT (CONS |u| |v|)))))) 
+
+;;;     ***       |sublisV| REDEFINED
+
+(DEFUN |sublisV| (|p| |e|) (COND ((ATOM |p|) |e|) ((QUOTE T) (|sublisV,suba| |p| |e|)))) 
+;
+;--% DEBUGGING PRINT ROUTINES used in breaks
+;
+;_?MODEMAPS x == _?modemaps x
+
+;;;     ***       ?MODEMAPS REDEFINED
+
+(DEFUN ?MODEMAPS (|x|) (|?modemaps| |x|)) 
+;_?modemaps x ==
+;  env:=
+;    $insideCapsuleFunctionIfTrue=true => $CapsuleModemapFrame
+;    $f
+;  x="all" => displayModemaps env
+;  displayOpModemaps(x,old2NewModemaps get(x,"modemap",env))
+
+;;;     ***       |?modemaps| REDEFINED
+
+(DEFUN |?modemaps| (|x|) (PROG (|env|) (RETURN (PROGN (SPADLET |env| (COND ((BOOT-EQUAL |$insideCapsuleFunctionIfTrue| (QUOTE T)) |$CapsuleModemapFrame|) ((QUOTE T) |$f|))) (COND ((BOOT-EQUAL |x| (QUOTE |all|)) (|displayModemaps| |env|)) ((QUOTE T) (|displayOpModemaps| |x| (|old2NewModemaps| (|get| |x| (QUOTE |modemap|) |env|))))))))) 
+;old2NewModemaps x ==
+;  [[dcSig,pred] for [dcSig,[pred,:.],:.] in x]
+
+;;;     ***       |old2NewModemaps| REDEFINED
+
+(DEFUN |old2NewModemaps| (|x|) (PROG (|dcSig| |pred|) (RETURN (SEQ (PROG (#0=#:G3975) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3981 |x| (CDR #1#)) (#2=#:G3966 NIL)) ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL) (PROGN (PROGN (SPADLET |dcSig| (CAR #2#)) (SPADLET |pred| (CAADR #2#)) #2#) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (CONS |dcSig| (CONS |pred| NIL)) #0#))))))))))) 
+;
+;traceUp() ==
+;  atom $x => sayBrightly "$x is an atom"
+;  for y in rest $x repeat
+;    u:= comp(y,$EmptyMode,$f) =>
+;      sayBrightly [y,'" ==> mode",'%b,u.mode,'%d]
+;    sayBrightly [y,'" does not compile"]
+
+;;;     ***       |traceUp| REDEFINED
+
+(DEFUN |traceUp| NIL (PROG (|u|) (RETURN (SEQ (COND ((ATOM |$x|) (|sayBrightly| (MAKESTRING "$x is an atom"))) ((QUOTE T) (DO ((#0=#:G3999 (CDR |$x|) (CDR #0#)) (|y| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |y| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (COND ((SPADLET |u| (|comp| |y| |$EmptyMode| |$f|)) (|sayBrightly| (CONS |y| (CONS (MAKESTRING " ==> mode") (CONS (QUOTE |%b|) (CONS (CADR |u|) (CONS (QUOTE |%d|) NIL))))))) ((QUOTE T) (|sayBrightly| (CONS |y| (CONS (MAKESTRING " does not compile") NIL)))))))))))))) 
+;
+;_?M x == _?m x
+
+;;;     ***       ?M REDEFINED
+
+(DEFUN ?M (|x|) (|?m| |x|)) 
+;_?m x ==
+;  u:= comp(x,$EmptyMode,$f) => u.mode
+;  nil
+
+;;;     ***       |?m| REDEFINED
+
+(DEFUN |?m| (|x|) (PROG (|u|) (RETURN (COND ((SPADLET |u| (|comp| |x| |$EmptyMode| |$f|)) (CADR |u|)) ((QUOTE T) NIL))))) 
+;
+;traceDown() ==
+;  mmList:= getFormModemaps($x,$f) =>
+;    for mm in mmList repeat if u:= qModemap mm then return u
+;  sayBrightly "no modemaps for $x"
+
+;;;     ***       |traceDown| REDEFINED
+
+(DEFUN |traceDown| NIL (PROG (|mmList| |u|) (RETURN (SEQ (COND ((SPADLET |mmList| (|getFormModemaps| |$x| |$f|)) (DO ((#0=#:G4021 |mmList| (CDR #0#)) (|mm| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |mm| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (COND ((SPADLET |u| (|qModemap| |mm|)) (RETURN |u|)) ((QUOTE T) NIL)))))) ((QUOTE T) (|sayBrightly| (MAKESTRING "no modemaps for $x")))))))) 
+;
+;qModemap mm ==
+;  sayBrightly ['%b,"modemap",'%d,:formatModemap mm]
+;  [[dc,target,:sl],[pred,:.]]:= mm
+;  and/[qArg(a,m) for a in rest $x for m in sl] => target
+;  sayBrightly ['%b,"fails",'%d,'%l]
+
+;;;     ***       |qModemap| REDEFINED
+
+(DEFUN |qModemap| (|mm|) (PROG (|dc| |target| |sl| |pred|) (RETURN (SEQ (PROGN (|sayBrightly| (CONS (QUOTE |%b|) (CONS (MAKESTRING "modemap") (CONS (QUOTE |%d|) (|formatModemap| |mm|))))) (SPADLET |dc| (CAAR |mm|)) (SPADLET |target| (CADAR |mm|)) (SPADLET |sl| (CDDAR |mm|)) (SPADLET |pred| (CAADR |mm|)) (COND ((PROG (#0=#:G4038) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G4045 NIL (NULL #0#)) (#2=#:G4046 (CDR |$x|) (CDR #2#)) (|a| NIL) (#3=#:G4047 |sl| (CDR #3#)) (|m| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |a| (CAR #2#)) NIL) (ATOM #3#) (PROGN (SETQ |m| (CAR #3#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (|qArg| |a| |m|)))))))) |target|) ((QUOTE T) (|sayBrightly| (CONS (QUOTE |%b|) (CONS (MAKESTRING "fails") (CONS (QUOTE |%d|) (CONS (QUOTE |%l|) NIL)))))))))))) 
+;
+;qArg(a,m) ==
+;  yesOrNo:=
+;    u:= comp(a,m,$f) => "yes"
+;    "no"
+;  sayBrightly [a," --> ",m,'%b,yesOrNo,'%d]
+;  yesOrNo="yes"
+
+;;;     ***       |qArg| REDEFINED
+
+(DEFUN |qArg| (|a| |m|) (PROG (|u| |yesOrNo|) (RETURN (PROGN (SPADLET |yesOrNo| (COND ((SPADLET |u| (|comp| |a| |m| |$f|)) (QUOTE |yes|)) ((QUOTE T) (QUOTE |no|)))) (|sayBrightly| (CONS |a| (CONS (MAKESTRING " --> ") (CONS |m| (CONS (QUOTE |%b|) (CONS |yesOrNo| (CONS (QUOTE |%d|) NIL))))))) (BOOT-EQUAL |yesOrNo| (QUOTE |yes|)))))) 
+;
+;_?COMP x == _?comp x
+
+;;;     ***       ?COMP REDEFINED
+
+(DEFUN ?COMP (|x|) (|?comp| |x|)) 
+;_?comp x ==
+;  msg:=
+;    u:= comp(x,$EmptyMode,$f) =>
+;      [MAKESTRING "compiles to mode",'%b,u.mode,'%d]
+;    nil
+;  sayBrightly msg
+
+;;;     ***       |?comp| REDEFINED
+
+(DEFUN |?comp| (|x|) (PROG (|u| |msg|) (RETURN (PROGN (SPADLET |msg| (COND ((SPADLET |u| (|comp| |x| |$EmptyMode| |$f|)) (CONS (MAKESTRING "compiles to mode") (CONS (QUOTE |%b|) (CONS (CADR |u|) (CONS (QUOTE |%d|) NIL))))) ((QUOTE T) NIL))) (|sayBrightly| |msg|))))) 
+;
+;_?domains() == pp getDomainsInScope $f
+
+;;;     ***       |?domains| REDEFINED
+
+(DEFUN |?domains| NIL (|pp| (|getDomainsInScope| |$f|))) 
+;_?DOMAINS() == ?domains()
+
+;;;     ***       ?DOMAINS REDEFINED
+
+(DEFUN ?DOMAINS NIL (|?domains|)) 
+;
+;_?mode x == displayProplist(x,[["mode",:getmode(x,$f)]])
+
+;;;     ***       |?mode| REDEFINED
+
+(DEFUN |?mode| (|x|) (|displayProplist| |x| (CONS (CONS (QUOTE |mode|) (|getmode| |x| |$f|)) NIL))) 
+;_?MODE x == _?mode x
+
+;;;     ***       ?MODE REDEFINED
+
+(DEFUN ?MODE (|x|) (|?mode| |x|)) 
+;
+;_?properties x == displayProplist(x,getProplist(x,$f))
+
+;;;     ***       |?properties| REDEFINED
+
+(DEFUN |?properties| (|x|) (|displayProplist| |x| (|getProplist| |x| |$f|))) 
+;_?PROPERTIES x == _?properties x
+
+;;;     ***       ?PROPERTIES REDEFINED
+
+(DEFUN ?PROPERTIES (|x|) (|?properties| |x|)) 
+;
+;_?value x == displayProplist(x,[["value",:get(x,"value",$f)]])
+
+;;;     ***       |?value| REDEFINED
+
+(DEFUN |?value| (|x|) (|displayProplist| |x| (CONS (CONS (QUOTE |value|) (|get| |x| (QUOTE |value|) |$f|)) NIL))) 
+;_?VALUE x == _?value x
+
+;;;     ***       ?VALUE REDEFINED
+
+(DEFUN ?VALUE (|x|) (|?value| |x|)) 
+;
+;displayProplist(x,alist) ==
+;  sayBrightly ["properties of",'%b,x,'%d,":"]
+;  fn alist where
+;    fn alist ==
+;      alist is [[prop,:val],:l] =>
+;        if prop="value" then val:= [val.expr,val.mode,'"..."]
+;        sayBrightly ["   ",'%b,prop,'%d,": ",val]
+;        fn deleteAssoc(prop,l)
+
+;;;     ***       |displayProplist,fn| REDEFINED
+
+(DEFUN |displayProplist,fn| (|alist|) (PROG (|ISTMP#1| |prop| |l| |val|) (RETURN (SEQ (IF (AND (PAIRP |alist|) (PROGN (SPADLET |ISTMP#1| (QCAR |alist|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |prop| (QCAR |ISTMP#1|)) (SPADLET |val| (QCDR |ISTMP#1|)) (QUOTE T)))) (PROGN (SPADLET |l| (QCDR |alist|)) (QUOTE T))) (EXIT (SEQ (IF (BOOT-EQUAL |prop| (QUOTE |value|)) (SPADLET |val| (CONS (CAR |val|) (CONS (CADR |val|) (CONS (MAKESTRING "...") NIL)))) NIL) (|sayBrightly| (CONS (MAKESTRING "   ") (CONS (QUOTE |%b|) (CONS |prop| (CONS (QUOTE |%d|) (CONS (MAKESTRING ": ") (CONS |val| NIL))))))) (EXIT (|displayProplist,fn| (|deleteAssoc| |prop| |l|)))))))))) 
+
+;;;     ***       |displayProplist| REDEFINED
+
+(DEFUN |displayProplist| (|x| |alist|) (PROGN (|sayBrightly| (CONS (MAKESTRING "properties of") (CONS (QUOTE |%b|) (CONS |x| (CONS (QUOTE |%d|) (CONS (MAKESTRING ":") NIL)))))) (|displayProplist,fn| |alist|))) 
+;
+;displayModemaps E ==
+;  listOfOperatorsSeenSoFar:= nil
+;  for x in E for i in 1.. repeat
+;    for y in x for j in 1.. repeat
+;      for z in y | null MEMBER(first z,listOfOperatorsSeenSoFar) and
+;        (modemaps:= LASSOC("modemap",rest z)) repeat
+;          listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar]
+;          displayOpModemaps(first z,modemaps)
+
+;;;     ***       |displayModemaps| REDEFINED
+
+(DEFUN |displayModemaps| (E) (PROG (|modemaps| |listOfOperatorsSeenSoFar|) (RETURN (SEQ (PROGN (SPADLET |listOfOperatorsSeenSoFar| NIL) (DO ((#0=#:G4136 E (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (DO ((#1=#:G4148 |x| (CDR #1#)) (|y| NIL) (|j| 1 (QSADD1 |j|))) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) NIL) (SEQ (EXIT (DO ((#2=#:G4160 |y| (CDR #2#)) (|z| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |z| (CAR #2#)) NIL)) NIL) (SEQ (EXIT (COND ((AND (NULL (|member| (CAR |z|) |listOfOperatorsSeenSoFar|)) (SPADLET |modemaps| (LASSOC (QUOTE |modemap|) (CDR |z|)))) (PROGN (SPADLET |listOfOperatorsSeenSoFar| (CONS (CAR |z|) |listOfOperatorsSeenSoFar|)) (|displayOpModemaps| (CAR |z|) |modemaps|)))))))))))))))))) 
+;
+;--% General object traversal functions
+;
+;GEQSUBSTLIST(old, new, body) ==
+;    GEQNSUBSTLIST(old, new, GCOPY body)
+
+;;;     ***       GEQSUBSTLIST REDEFINED
+
+(DEFUN GEQSUBSTLIST (|old| |new| |body|) (GEQNSUBSTLIST |old| |new| (GCOPY |body|))) 
+;
+;GEQNSUBSTLIST(old, new, body) ==
+;    or/[:[EQ(o,n) for o in old] for n in new] =>
+;        mid := [GENSYM() for o in old]
+;        GEQNSUBSTLIST(old, mid, body)
+;        GEQNSUBSTLIST(mid, new, body)
+;    alist := [[o,:n] for o in old for n in new]
+;    traverse(function GSUBSTinner, alist, body) where
+;        GSUBSTinner(alist, ob) ==
+;            (pr := ASSQ(ob, alist)) => CDR pr
+;            ob
+
+;;;     ***       |GEQNSUBSTLIST,GSUBSTinner| REDEFINED
+
+(DEFUN |GEQNSUBSTLIST,GSUBSTinner| (|alist| |ob|) (PROG (|pr|) (RETURN (SEQ (IF (SPADLET |pr| (ASSQ |ob| |alist|)) (EXIT (CDR |pr|))) (EXIT |ob|))))) 
+
+;;;     ***       GEQNSUBSTLIST REDEFINED
+
+(DEFUN GEQNSUBSTLIST (|old| |new| |body|) (PROG (|mid| |alist|) (RETURN (SEQ (COND ((REDUCE-N (QUOTE OR2) NIL (PROG (#0=#:G4183) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G4188 |new| (CDR #1#)) (|n| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |n| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (PROG (#2=#:G4198) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G4203 |old| (CDR #3#)) (|o| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |o| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (EQ |o| |n|) #2#)))))))))))))) NIL) (SPADLET |mid| (PROG (#4=#:G4213) (SPADLET #4# NIL) (RETURN (DO ((#5=#:G4218 |old| (CDR #5#)) (|o| NIL)) ((OR (ATOM #5#) (PROGN (SETQ |o| (CAR #5#)) NIL)) (NREVERSE0 #4#)) (SEQ (EXIT (SETQ #4# (CONS (GENSYM) #4#)))))))) (GEQNSUBSTLIST |old| |mid| |body|) (GEQNSUBSTLIST |mid| |new| |body|)) ((QUOTE T) (SPADLET |alist| (PROG (#6=#:G4229) (SPADLET #6# NIL) (RETURN (DO ((#7=#:G4235 |old| (CDR #7#)) (|o| NIL) (#8=#:G4236 |new| (CDR #8#)) (|n| NIL)) ((OR (ATOM #7#) (PROGN (SETQ |o| (CAR #7#)) NIL) (ATOM #8#) (PROGN (SETQ |n| (CAR #8#)) NIL)) (NREVERSE0 #6#)) (SEQ (EXIT (SETQ #6# (CONS (CONS |o| |n|) #6#)))))))) (|traverse| (|function| |GEQNSUBSTLIST,GSUBSTinner|) |alist| |body|))))))) 
+;
+;GCOPY ob == COPY ob  -- for now
+
+;;;     ***       GCOPY REDEFINED
+
+(DEFUN GCOPY (|ob|) (COPY |ob|)) 
+;
+;traverse(fn, arg, ob) ==
+;    $seen:    local := MAKE_-HASHTABLE 'EQ
+;    $notseen: local := GENSYM()
+;
+;    traverseInner(ob, fn, arg) where
+;        traverseInner(ob, fn, arg) ==
+;            e := HGET($seen, ob, $notseen)
+;            not EQ(e, $notseen) => e
+;
+;            nob := FUNCALL(fn, arg, ob)
+;            HPUT($seen, ob, nob)
+;            not EQ(nob, ob) => nob
+;            PAIRP ob =>
+;                ne:=traverseInner(QCAR ob, fn, arg)
+;                if not EQ(ne,QCAR ob) then QRPLACA(ob, ne)
+;                ne:=traverseInner(QCDR ob, fn, arg)
+;                if not EQ(ne,QCDR ob) then QRPLACD(ob, ne)
+;                ob
+;            VECP ob =>
+;                n := QVMAXINDEX ob
+;                for i in 0..n repeat
+;                    e:=QVELT(ob,i)
+;                    ne:=traverseInner(e, fn, arg)
+;                    if not EQ(ne,e) then QSETVELT(ob,i,ne)
+;                ob
+;            HASHTABLEP ob =>
+;                keys := HKEYS ob
+;                for k in keys repeat
+;                    e  := HGET(ob, k)
+;                    nk := traverseInner(k, fn, arg)
+;                    ne := traverseInner(e, fn, arg)
+;                    if not EQ(k,nk) or not EQ(e,ne) then
+;                        HREM(ob, k)
+;                        HPUT(ob, nk, ne)
+;                ob
+;            PAPPP ob =>
+;                for i in 1..PA_-SPEC_-COUNT ob repeat
+;                    s := PA_-SPEC(ob, i)
+;                    not PAIRP s =>
+;                        ns := traverseInner(s,fn,arg)
+;                        if not EQ(s,ns) then
+;                            SET_-PA_-SPEC(ob,i,ns)
+;                    ns := traverseInner(QCDR s, fn, arg)
+;                    if not EQ(ns,QCDR s) then
+;                       apply(SET_-PA_-SPEC, [ob,i,QCAR s,:ns])
+;                ob
+;            ob
+
+;;;     ***       |traverse,traverseInner| REDEFINED
+
+(DEFUN |traverse,traverseInner| (|ob| |fn| |arg|) (PROG (|nob| |n| |keys| |e| |nk| |ne| |s| |ns|) (RETURN (SEQ (SPADLET |e| (HGET |$seen| |ob| |$notseen|)) (IF (NULL (EQ |e| |$notseen|)) (EXIT |e|)) (SPADLET |nob| (FUNCALL |fn| |arg| |ob|)) (HPUT |$seen| |ob| |nob|) (IF (NULL (EQ |nob| |ob|)) (EXIT |nob|)) (IF (PAIRP |ob|) (EXIT (SEQ (SPADLET |ne| (|traverse,traverseInner| (QCAR |ob|) |fn| |arg|)) (IF (NULL (EQ |ne| (QCAR |ob|))) (QRPLACA |ob| |ne|) NIL) (SPADLET |ne| (|traverse,traverseInner| (QCDR |ob|) |fn| |arg|)) (IF (NULL (EQ |ne| (QCDR |ob|))) (QRPLACD |ob| |ne|) NIL) (EXIT |ob|)))) (IF (VECP |ob|) (EXIT (SEQ (SPADLET |n| (QVMAXINDEX |ob|)) (DO ((|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) (SEQ (SPADLET |e| (QVELT |ob| |i|)) (SPADLET |ne| (|traverse,traverseInner| |e| |fn| |arg|)) (EXIT (IF (NULL (EQ |ne| |e|)) (QSETVELT |ob| |i| |ne|) NIL)))) (EXIT |ob|)))) (IF (HASHTABLEP |ob|) (EXIT (SEQ (SPADLET |keys| (HKEYS |ob|)) (DO ((#0=#:G4276 |keys| (CDR #0#)) (|k| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |k| (CAR #0#)) NIL)) NIL) (SEQ (SPADLET |e| (HGET |ob| |k|)) (SPADLET |nk| (|traverse,traverseInner| |k| |fn| |arg|)) (SPADLET |ne| (|traverse,traverseInner| |e| |fn| |arg|)) (EXIT (IF (OR (NULL (EQ |k| |nk|)) (NULL (EQ |e| |ne|))) (SEQ (HREM |ob| |k|) (EXIT (HPUT |ob| |nk| |ne|))) NIL)))) (EXIT |ob|)))) (IF (PAPPP |ob|) (EXIT (SEQ (DO ((#1=#:G4285 (PA-SPEC-COUNT |ob|)) (|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| #1#) NIL) (SEQ (SPADLET |s| (PA-SPEC |ob| |i|)) (IF (NULL (PAIRP |s|)) (EXIT (SEQ (SPADLET |ns| (|traverse,traverseInner| |s| |fn| |arg|)) (EXIT (IF (NULL (EQ |s| |ns|)) (SET-PA-SPEC |ob| |i| |ns|) NIL))))) (SPADLET |ns| (|traverse,traverseInner| (QCDR |s|) |fn| |arg|)) (EXIT (IF (NULL (EQ |ns| (QCDR |s|))) (APPLY SET-PA-SPEC (CONS |ob| (CONS |i| (CONS (QCAR |s|) |ns|)))) NIL)))) (EXIT |ob|)))) (EXIT |ob|))))) 
+
+;;;     ***       |traverse| REDEFINED
+
+(DEFUN |traverse| (|fn| |arg| |ob|) (PROG (|$seen| |$notseen|) (DECLARE (SPECIAL |$seen| |$notseen|)) (RETURN (PROGN (SPADLET |$seen| (MAKE-HASHTABLE (QUOTE EQ))) (SPADLET |$notseen| (GENSYM)) (|traverse,traverseInner| |ob| |fn| |arg|))))) 
+;;;Boot translation finished for c-util.boot
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/category.boot.pamphlet b/src/interp/category.boot.pamphlet
new file mode 100644
index 00000000..88c1c635
--- /dev/null
+++ b/src/interp/category.boot.pamphlet
@@ -0,0 +1,624 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp category.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{mkCategory}
+
+This code defines the structure of a category. 
+<<mkCategory>>=
+mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
+  NSigList:= nil
+  if PrincipalAncestor=nil then count:= 6 else count:= SIZE PrincipalAncestor
+  sigList:=
+    [if s is [sig,pred]
+       then
+         or/[x is [[ =sig,.,:impl],:num] for x in NSigList] => [sig,pred,:impl]
+                 --only needed for multiple copies of sig
+         num:= if domainOrPackage="domain" then count else count-5
+         nsig:= mkOperatorEntry("domain",sig,pred,num)
+         NSigList:= [[nsig,:count],:NSigList]
+         count:= count+1
+         nsig
+     else s for s in sigList]
+  NewLocals:= nil
+  for s in sigList repeat
+    ((NewLocals:= union(NewLocals,Prepare CADAR s)) where
+      Prepare u == "union"/[Prepare2 v for v in u]) where
+        Prepare2 v ==
+          v is "$" => nil
+          STRINGP v => nil
+          atom v => [v]
+          MEMQ(first v,$PrimitiveDomainNames) => nil
+            --This variable is set in INIT LISP
+            --It is a list of all the domains that we need not cache
+          v is ["Union",:w] =>
+            "union"/[Prepare2 x for x in stripUnionTags w]
+          v is ["Mapping",:w] => "union"/[Prepare2 x for x in w]
+          v is ["List",w] => Prepare2 w
+          v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w]
+          [v]
+  OldLocals:= nil
+  if PrincipalAncestor then for u in (OldLocals:= CADDR PrincipalAncestor.4)
+     repeat NewLocals:= delete(first u,NewLocals)
+  for u in NewLocals repeat
+    (OldLocals:= [[u,:count],:OldLocals]; count:= count+1)
+  v:= GETREFV count
+  v.(0):= nil
+  v.(1):= sigList
+  v.2:= attList
+  v.3:= ["Category"]
+  if not PrincipalAncestor=nil
+     then
+      for x in 6..SIZE PrincipalAncestor-1 repeat v.x:= PrincipalAncestor.x
+      v.4:= [first PrincipalAncestor.4,CADR PrincipalAncestor.4,OldLocals]
+   else v.4:= [nil,nil,OldLocals] --associated categories and domains
+  v.5:= domList
+  for [nsig,:sequence] in NSigList repeat v.sequence:= nsig
+  v
+
+@
+\section{hasCategoryBug}
+The hasCategoryBug (bug000001)\cite{2} manifests itself by causing a
+value stack overflow when compiling algebra code that uses conditions
+that read ``if R has ...'' when using GCL (but not CCL). Essentially
+the [[|Ring|]] category keeps getting added to the list each time
+[[|Ring|]] is processed. Camm Maguire's mail explains it thus:
+
+The bottom line is that [[(|Ring|)]] is totally correct until
+[[|Algebra|]] is executed, at which point the fourth element returned
+by [[(|Ring|)]] is overwritten by the result returned in the fourth
+element of the vector returned by [[|Algebra|]].  The point of this
+overwrite is at the following form of [[|JoinInner|]] from
+[[(int/interp/category.clisp)]]
+
+\begin{verbatim}
+ (SETELT |$NewCatVec| 4 (CONS |c| (CONS |FundamentalAncestors| (CONS
+ (CADDR (ELT |$NewCatVec| 4)) NIL))))
+\end{verbatim}
+
+called from [[|Algebra;|]] [[(int/algebra/ALGEBRA.NRLIB/code.lsp)]] through 
+
+\begin{verbatim}
+(|Join| (|Ring|) (|Module| (QUOTE |t#1|)) (|mkCategory| (QUOTE
+|domain|) (QUOTE (((|coerce| ($ |t#1|)) T))) NIL (QUOTE NIL) NIL))
+\end{verbatim}
+
+I haven't parsed [[|JoinInner|]] yet, but my guess is that there is a
+copy-seq in there which is not getting executed in the assignment of
+[[|$NewCatVec|]] before the setelt.
+
+The original code failed to copy the NewCatVec before updating
+it. This code from macros.lisp\cite{1} checks whether the array is
+adjustable.
+
+\begin{verbatim}
+(defun lengthenvec (v n)
+  (if (adjustable-array-p v) (adjust-array v n)
+    (replace (make-array n) v)))
+\end{verbatim}
+At least in GCL, the code for lengthenvec need not copy the vec to a
+new location. In this case the FundamentalAncesters array is adjustable
+and in GCL the adjust-array need not, and in this case, does not do a 
+copy.
+<<hasCategoryBug>>=
+      if reallynew then
+        n:= SIZE $NewCatVec
+        FundamentalAncestors:= [[b.(0),condition,n],:FundamentalAncestors]
+        $NewCatVec:= LENGTHENVEC($NewCatVec,n+1)
+-- We need to copy the vector otherwise the FundamentalAncestors
+-- list will get stepped on while compiling "If R has ... " code
+-- Camm Maguire July 26, 2003
+--        copied:= true
+        copied:= false
+        originalvector:= false
+        $NewCatVec.n:= b.(0)
+  if not copied then $NewCatVec:= COPY_-SEQ $NewCatVec
+    -- It is important to copy the vector now,
+    -- in case SigListUnion alters it while
+    -- performing Operator Subsumption
+@ 
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+ 
+-- Functions for building categories
+ 
+Category() == nil --sorry to say, this hack is needed by isCategoryType
+ 
+CategoryPrint(D,$e) ==
+  SAY "--------------------------------------"
+  SAY "Name (and arguments) of category:"
+  PRETTYPRINT D.(0)
+  SAY "operations:"
+  PRETTYPRINT D.(1)
+  SAY "attributes:"
+  PRETTYPRINT D.2
+  SAY "This is a sub-category of"
+  PRETTYPRINT first D.4
+  for u in CADR D.4 repeat
+    SAY("This has an alternate view: slot ",rest u," corresponds to ",first u)
+  for u in CADDR D.4 repeat
+    SAY("This has a local domain: slot ",rest u," corresponds to ",first u)
+  for j in 6..MAXINDEX D repeat
+    u:= D.j
+    null u => SAY "another domain"
+    atom first u => SAY("Alternate View corresponding to: ",u)
+    PRETTYPRINT u
+ 
+<<mkCategory>>
+isCategory a == REFVECP a and #a>5 and a.3=["Category"]
+ 
+--% Subsumption code (for operators)
+ 
+DropImplementations (a is [sig,pred,:implem]) ==
+  if implem is [[q,:.]] and (q="ELT" or q="CONST")
+     then if (q="ELT")  then [sig,pred]
+                        else [[:sig,:'(constant)],pred]
+     else a
+ 
+SigListUnion(extra,original) ==
+  --augments original %with everything in extra that is not in original
+  for (o:=[[ofn,osig,:.],opred,:.]) in original repeat
+    -- The purpose of this loop is to detect cases when the
+    -- original list contains, e.g. ** with NonNegativeIntegers, and
+    -- the extra list would like to add ** with PositiveIntegers.
+    -- The PI map is therefore gives an implementation of "Subsumed"
+    for x in SigListOpSubsume(o,extra) repeat
+      [[xfn,xsig,:.],xpred,:.]:=x
+      xfn=ofn and xsig=osig =>
+              --checking name and signature, but not a 'constant' marker
+        xpred=opred => extra:= delete(x,extra)
+             --same signature and same predicate
+        opred = true => extra:= delete(x,extra)
+   -- PRETTYPRINT ("we ought to subsume",x,o)
+      not MachineLevelSubsume(QCAR o,QCAR x) =>
+         '"Source level subsumption not implemented"
+      extra:= delete(x,extra)
+  for e in extra repeat
+    [esig,epred,:.]:= e
+    eimplem:=[]
+    for x in SigListOpSubsume(e,original) repeat
+        --PRETTYPRINT(LIST("SigListOpSubsume",e,x))
+      not MachineLevelSubsume(QCAR e,QCAR x) =>
+        --systemError '"Source level subsumption not implemented"
+        original:= [e,:original]
+        return() -- this exits from the innermost for loop
+      original:= delete(x,original)
+      [xsig,xpred,:ximplem]:= x
+--      if xsig ^= esig then   -- not quite strong enough
+      if CAR xsig ^= CAR esig or CADR xsig ^= CADR esig then
+-- the new version won't get confused by "constant"markers
+         if ximplem is [["Subsumed",:.],:.] then
+            original := [x,:original]
+          else
+            original:= [[xsig,xpred,["Subsumed",:esig]],:original]
+       else epred:=mkOr(epred,xpred)
+-- this used always to be done, as noted below, but that's not safe
+      if not(ximplem is [["Subsumed",:.],:.]) then eimplem:= ximplem
+      if eimplem then esig:=[CAR esig,CADR esig] 
+           -- in case there's a constant marker
+      e:= [esig,epred,:eimplem]
+--    e:= [esig,mkOr(xpred,epred),:ximplem]
+-- Original version -gets it wrong if the new operator is only
+-- present under certain conditions
+        -- We must pick up the previous implementation, if any
+--+
+      if ximplem is [[q,.,index]] and INTEGERP index and (q="ELT" or q="CONST")
+        then $NewCatVec. index:= e
+    original:= [e,:original]
+  original
+ 
+mkOr(a,b) ==
+  a=true => true
+  b=true => true
+  b=a => a
+--PRETTYPRINT ("Condition merging",a,b)
+  l:=
+    a is ["OR",:a'] =>
+      (b is ["OR",:b'] => union(a',b'); mkOr2(b,a') )
+    b is ["OR",:b'] => mkOr2(a,b')
+    (a is ["has",avar,acat]) and (b is ["has",=avar,bcat]) =>
+      DescendantP(acat,bcat) => LIST b
+      DescendantP(bcat,acat) => LIST a
+      [a,b]
+    a is ['AND,:a'] and member(b,a') => LIST b
+    b is ['AND,:b'] and member(a,b') => LIST a
+    a is ["and",:a'] and member(b,a') => LIST b
+    b is ["and",:b'] and member(a,b') => LIST a
+    [a,b]
+  LENGTH l = 1 => CAR l
+  ["OR",:l]
+ 
+mkOr2(a,b) ==
+  --a is a condition, "b" a list of them
+  member(a,b) => b
+  a is ["has",avar,acat] =>
+    aRedundant:=false
+    for c in b | c is ["has",=avar,ccat] repeat
+      DescendantP(acat,ccat) =>
+        return (aRedundant:=true)
+      if DescendantP(ccat,acat) then b := delete(c,b)
+    aRedundant => b
+    [a,:b]
+  [a,:b]
+ 
+mkAnd(a,b) ==
+  a=true => b
+  b=true => a
+  b=a => a
+  --PRETTYPRINT ("Condition merging",a,b)
+  l:=
+    a is ["AND",:a'] =>
+      (b is ["AND",:b'] => union(a',b'); mkAnd2(b,a') )
+    b is ["AND",:b'] => mkAnd2(a,b')
+    (a is ["has",avar,acat]) and (b is ["has",=avar,bcat]) =>
+      DescendantP(acat,bcat) => LIST a
+      DescendantP(bcat,acat) => LIST b
+      [a,b]
+    [a,b]
+  LENGTH l = 1 => CAR l
+  ["AND",:l]
+ 
+mkAnd2(a,b) ==
+  --a is a condition, "b" a list of them
+  member(a,b) => b
+  a is ["has",avar,acat] =>
+    aRedundant:=false
+    for c in b | c is ["has",=avar,ccat] repeat
+      DescendantP(ccat,acat) =>
+        return (aRedundant:=true)
+      if DescendantP(acat,ccat) then b := delete(c,b)
+    aRedundant => b
+    [a,:b]
+  [a,:b]
+ 
+SigListMember(m,list) ==
+  list=nil => false
+  SigEqual(m,first list) => true
+  SigListMember(m,rest list)
+ 
+SigEqual([sig1,pred1,:.],[sig2,pred2,:.]) ==
+  -- Notice asymmetry: checks that arg1 is a consequence of arg2
+  sig1=sig2 and PredImplies(pred2,pred1)
+ 
+PredImplies(a,b) ==
+    --true if a => b in the sense of logical implication
+--a = "true" => true
+  a=true => true
+  a=b => true
+  false         -- added by RDJ: 12/21/82
+--error()       -- for the time being
+ 
+SigListOpSubsume([[name1,sig1,:.],:.],list) ==
+  --does m subsume another operator in the list?
+        --see "operator subsumption" in SYSTEM SCRIPT
+        --if it does, returns the subsumed member
+  lsig1:=LENGTH sig1
+  ans:=[]
+  for (n:=[[name2,sig2,:.],:.]) in list repeat
+    name1=name2 and EQ(lsig1,LENGTH sig2) and SourceLevelSubsume(sig1,sig2) =>
+      ans:=[n,:ans]
+  return ans
+ 
+SigOpsubsume([[name1,sig1,:flag1],pred1,:.],[[name2,sig2,:flag2],pred2,:.]) ==
+                    --flag1 = flag2 and :this really should be checked
+  name1=name2 and LENGTH sig1=LENGTH sig2 and SourceLevelSubsume(sig1,sig2)
+ 
+SourceLevelSubsume([out1,:in1],[out2,:in2]) ==
+  -- Checks for source-level subsumption in the sense of SYSTEM SCRIPT
+  --   true if the first signature subsumes the second
+  SourceLevelSubset(out1,out2) and
+    (and/[SourceLevelSubset(inarg2,inarg1) for inarg1 in in1 for inarg2 in in2])
+ 
+SourceLevelSubset(a,b) ==
+  --true if a is a source-level subset of b
+  a=b => true
+  $noSubsumption=true => false
+  b is ["Union",:blist] and member(a,blist) => true
+  BOUNDP '$noSubsets and $noSubsets => false
+  atom b and ASSOC(a,GETL(b,"Subsets")) => true
+  a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true
+  nil
+ 
+MachineLevelSubsume([name1,[out1,:in1],:flag1],[name2,[out2,:in2],:flag2]) ==
+  -- Checks for machine-level subsumption in the sense of SYSTEM SCRIPT
+  --  true if the first signature subsumes the second
+  --  flag1 = flag2 and: this really should be checked, but
+  name1=name2 and MachineLevelSubset(out1,out2) and
+    (and/[MachineLevelSubset(inarg2,inarg1) for inarg1 in in1 for inarg2 in in2]
+      )
+ 
+MachineLevelSubset(a,b) ==
+  --true if a is a machine-level subset of b
+  a=b => true
+  b is ["Union",:blist] and member(a,blist) and
+    (and/[STRINGP x for x in blist | x^=a]) => true
+           --all other branches must be distinct objects
+  atom b and ASSOC(a,GETL(b,"Subsets")) => true
+  a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true
+             --we assume all subsets are true at the machine level
+  nil
+ 
+--% Ancestor chasing code
+ 
+FindFundAncs l ==
+  --l is a list of categories and associated conditions (a list of 2-lists
+  --returns a list of them and all their fundamental ancestors
+  --also as two-lists with the appropriate conditions
+  l=nil => nil
+  f1:= CatEval CAAR l
+  f1.(0)=nil => FindFundAncs rest l
+  ans:= FindFundAncs rest l
+  for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,CADR x)]
+   for x in CADR f1.4] repeat
+    x:= ASSQ(first u,ans) =>
+      ans:= [[first u,mkOr(CADR x,CADR u)],:delete(x,ans)]
+    ans:= [u,:ans]
+        --testing to see if CAR l is already there
+  x:= ASSQ(CAAR l,ans) => [[CAAR l,mkOr(CADAR l,CADR x)],:delete(x,ans)]
+  CADAR l=true =>
+    for x in first f1.4 repeat if y:= ASSQ(CatEval x,ans) then ans:= delete(y,ans)
+    [first l,:ans]
+  for x in first f1.4 repeat
+    if y:= ASSQ(CatEval x,ans) then ans:=
+      [[first y,mkOr(CADAR l,CADR y)],:delete(y,ans)]
+  [first l,:ans]
+  -- Our new thing may have, as an alternate view, a principal
+  -- descendant of something previously added which is therefore
+  -- subsumed
+ 
+CatEval x ==
+  REFVECP x => x
+  $InteractiveMode => CAR compMakeCategoryObject(x,$CategoryFrame)
+  CAR compMakeCategoryObject(x,$e)
+ 
+--RemovePrinAncs(l,leaves) ==
+--  l=nil => nil
+--  leaves:= [first y for y in leaves]
+--               --remove the slot pointers
+--  [x for x in l | not AncestorP(x.(0),leaves)]
+ 
+AncestorP(xname,leaves) ==
+  -- checks for being a principal ancestor of one of the leaves
+  member(xname,leaves) => xname
+  for y in leaves repeat
+    member(xname,first (CatEval y).4) => return y
+ 
+CondAncestorP(xname,leaves,condition) ==
+  -- checks for being a principal ancestor of one of the leaves
+  for u in leaves repeat
+    u':=first u
+    ucond:=
+      null rest u => true
+      first rest u
+    xname = u' or member(xname,first (CatEval u').4) =>
+      PredImplies(ucond,condition) => return u'
+ 
+DescendantP(a,b) ==
+  -- checks to see if a is any kind of Descendant of b
+  a=b => true
+  a is ["ATTRIBUTE",:.] => nil
+  a is ["SIGNATURE",:.] => nil
+  a:= CatEval a
+  b is ["ATTRIBUTE",b'] =>
+    (l:=ASSOC(b',a.2)) => TruthP CADR l
+  member(b,first a.4) => true
+  AncestorP(b,[first u for u in CADR a.4]) => true
+  nil
+ 
+--% The implementation of Join
+ 
+JoinInner(l,$e) ==
+  $NewCatVec: local
+  CondList:= nil
+  for u in l repeat
+    for at in u.2 repeat
+      at2:= first at
+      if atom at2 then at2:=[at2]
+        -- the variable $Attributes is built globally, so that true
+        -- attributes can be detected without calling isCategoryForm
+      QMEMQ(QCAR at2,$Attributes) => nil
+      null isCategoryForm(at2,$e) =>
+        $Attributes:=[QCAR at2,:$Attributes]
+        nil
+      pred:= first rest at
+        -- The predicate under which this category is conditional
+      member(pred,get("$Information","special",$e)) => l:= [:l,CatEval at2]
+          --It's true, so we add this as unconditional
+      not (pred is ["and",:.]) => CondList:= [[CatEval at2,pred],:CondList]
+      pred':=
+        [u
+          for u in rest pred | not member(u,get("$Information","special",$e))
+            and not (u=true)]
+      null pred' => l:= [:l,CatEval at2]
+      LENGTH pred'=1 => CondList:= [[CatEval at2,pred'],:CondList]
+      CondList:= [[CatEval at2,["and",:pred']],:CondList]
+  [$NewCatVec,:l]:= l
+  l':= [:CondList,:[[u,true] for u in l]]
+    -- This is a list of all the categories that this extends
+    -- conditionally or unconditionally
+  sigl:= $NewCatVec.(1)
+  attl:= $NewCatVec.2
+  globalDomains:= $NewCatVec.5
+  FundamentalAncestors:= CADR $NewCatVec.4
+  if $NewCatVec.(0) then FundamentalAncestors:=
+    [[$NewCatVec.(0)],:FundamentalAncestors]
+                    --principal ancestor . all those already included
+  copied:= nil
+  originalVector:= true
+  -- we can not decide to extend the vector in multiple ways
+  -- this flag helps us detect this case
+  originalVector := false
+    -- this skips buggy code which discards needed categories
+  for [b,condition] in FindFundAncs l' repeat
+      --This loop implements Category Subsumption
+          --as described in SYSTEM SCRIPT
+    if not (b.(0)=nil) then
+                   --It's a named category
+      bname:= b.(0)
+      CondAncestorP(bname,FundamentalAncestors,condition) => nil
+      (f:=AncestorP(bname,[first u for u in FundamentalAncestors])) =>
+        [.,.,index]:=ASSOC(f,FundamentalAncestors)
+        FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors]
+      PrinAncb:= first (CatEval bname).(4)
+               --Principal Ancestors of b
+      reallynew:= true
+      for anc in FundamentalAncestors repeat
+        if member(first anc,PrinAncb) then
+                  --This is the check for "Category Subsumption"
+          if rest anc
+             then (anccond:= CADR anc; ancindex:= CADDR anc)
+             else (anccond:= true; ancindex:= nil)
+          if PredImplies(condition,anccond)
+             then FundamentalAncestors:=
+ 
+               -- the new 'b' is more often true than the old one 'anc'
+              [[bname,condition,ancindex],:delete(anc,FundamentalAncestors)]
+           else
+            if ancindex and (PredImplies(anccond,condition); true)
+-- I have no idea who effectively commented out the predImplies
+-- JHD 25/8/86
+               then
+                     --the new 'b' is less often true
+                newentry:=[bname,condition,ancindex]
+                if not member(newentry,FundamentalAncestors) then
+                  FundamentalAncestors:= [newentry,:FundamentalAncestors]
+             else ancindex:= nil
+          if not copied then
+            $NewCatVec:= COPY_-SEQ $NewCatVec
+            copied:= true
+          if ancindex
+             then ($NewCatVec.ancindex:= bname; reallynew:= nil)
+             else
+               -- check for $NRTflag until massive algebra recompilation
+              if originalVector and (condition=true) then
+                $NewCatVec:= CatEval bname
+                copied:= nil
+                FundamentalAncestors:= [[bname],:CADR $NewCatVec.4]
+                         --bname is Principal, so comes first
+                reallynew:= nil
+                MEMQ(b,l) =>
+                       --MEMQ since category vectors are guaranteed unique
+                  (sigl:= $NewCatVec.(1); attl:= $NewCatVec.2; l:= delete(b,l))
+             --     SAY("domain ",bname," subsumes")
+             --     SAY("adding a conditional domain ",
+             --         bname,
+             --         " replacing",
+             --         CAR anc)
+                bCond:= ASSQ(b,CondList)
+                CondList:= delete(bCond,CondList)
+             -- value of bCond not used and could be NIL
+             -- bCond:= CADR bCond
+                globalDomains:= $NewCatVec.5
+                for u in $NewCatVec.(1) repeat
+                  if not member(u,sigl) then
+                    [s,c,i]:= u
+                    if c=true
+                       then sigl:= [[s,condition,i],:sigl]
+                       else sigl:= [[s,["and",condition,c],i],:sigl]
+                for u in $NewCatVec.2 repeat
+                  if not member(u,attl) then
+                    [a,c]:= u
+                    if c=true
+                       then attl:= [[a,condition],:attl]
+                       else attl:= [[a,["and",condition,c]],:attl]
+<<hasCategoryBug>>
+  for b in l repeat
+    sigl:= SigListUnion([DropImplementations u for u in b.(1)],sigl)
+    attl:=
+-- next two lines are merely performance improvements
+      MEMQ(attl,b.2) => b.2
+      MEMQ(b.2,attl) => attl
+      S_+(b.2,attl)
+    globalDomains:= [:globalDomains,:S_-(b.5,globalDomains)]
+  for b in CondList repeat
+    newpred:= first rest b
+    for u in (first b).2 repeat
+      v:= ASSOC(first u,attl)
+      null v =>
+        attl:=
+          CADR u=true => [[first u,newpred],:attl]
+          [[first u,["and",newpred,CADR u]],:attl]
+      CADR v=true => nil
+      attl:= delete(v,attl)
+      attl:=
+        CADR u=true => [[first u,mkOr(CADR v,newpred)],:attl]
+        [[first u,mkOr(CADR v,mkAnd(newpred,CADR u))],:attl]
+    sigl:=
+      SigListUnion(
+        [AddPredicate(DropImplementations u,newpred) for u in (first b).(1)],sigl) where
+          AddPredicate(op is [sig,oldpred,:implem],newpred) ==
+            newpred=true => op
+            oldpred=true => [sig,newpred,:implem]
+            [sig,mkpf([oldpred,newpred],"and"),:implem]
+  FundamentalAncestors:= [x for x in FundamentalAncestors | rest x]
+               --strip out the pointer to Principal Ancestor
+  c:= first $NewCatVec.4
+  pName:= $NewCatVec.(0)
+  if pName and not member(pName,c) then c:= [pName,:c]
+  $NewCatVec.4:= [c,FundamentalAncestors,CADDR $NewCatVec.4]
+  mkCategory("domain",sigl,attl,globalDomains,$NewCatVec)
+ 
+--ProduceDomainAlist(u,e) ==
+--  -- Gives a complete Alist for all the functions in the Domain
+--  not (sig:= get(u,"modemap",e)) => nil
+--  sig:= CADAAR sig
+--                       --an incantation
+--  [c,.,.]:= compMakeCategoryObject(sig,e)
+--  -- We assume that the environment need not be kept
+--  c.(1)
+ 
+isCategoryForm(x,e) ==
+  x is [name,:.] => categoryForm? name
+  atom x => u:= get(x,"macro",e) => isCategoryForm(u,e)
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} [[pamphlet:src/interp/macros.lisp.pamphlet]]
+\bibitem{2} [[pamphlet:KNOWN.BUGS.pamphlet]]
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/cattable.boot.pamphlet b/src/interp/cattable.boot.pamphlet
new file mode 100644
index 00000000..d25eaf80
--- /dev/null
+++ b/src/interp/cattable.boot.pamphlet
@@ -0,0 +1,527 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp cattable.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+hasCat(domainOrCatName,catName) ==
+  catName='Object or catName='Type  -- every domain is a Type (Object)
+   or GETDATABASE([domainOrCatName,:catName],'HASCATEGORY)
+
+showCategoryTable con ==
+  [[b,:val] for (key :=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_*
+     | a = con and (val := HGET(_*HASCATEGORY_-HASH_*,key))]
+
+displayCategoryTable(:options) ==
+  conList := IFCAR options
+  SETQ($ct,MAKE_-HASHTABLE 'ID)
+  for (key:=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* repeat
+    HPUT($ct,a,[[b,:HGET(_*HASCATEGORY_-HASH_*,key)],:HGET($ct,a)])
+  for id in HKEYS $ct | null conList or MEMQ(id,conList) repeat
+    sayMSG [:bright id,'"extends:"]
+    PRINT HGET($ct,id)
+
+genCategoryTable() ==
+  SETQ(_*ANCESTORS_-HASH_*,  MAKE_-HASHTABLE 'ID)
+  SETQ(_*HASCATEGORY_-HASH_*,MAKE_-HASHTABLE 'UEQUAL)
+  genTempCategoryTable()
+  domainList:=
+    [con for con in allConstructors()
+      | GETDATABASE(con,'CONSTRUCTORKIND) = 'domain]
+  domainTable:= [addDomainToTable(con,getConstrCat catl) for con
+    in domainList | catl := GETDATABASE(con,'CONSTRUCTORCATEGORY)]
+  -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT
+  specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains)
+  domainTable:= [:[addDomainToTable(id, getConstrCat (eval [id]).3)
+    for id in specialDs], :domainTable]
+  for [id,:entry] in domainTable repeat
+    for [a,:b] in encodeCategoryAlist(id,entry) repeat
+      HPUT(_*HASCATEGORY_-HASH_*,[id,:a],b)
+  simpTempCategoryTable()
+  compressHashTable _*ANCESTORS_-HASH_*
+  simpCategoryTable()
+  compressHashTable _*HASCATEGORY_-HASH_*
+
+simpTempCategoryTable() ==
+  for id in HKEYS _*ANCESTORS_-HASH_* repeat
+    for (u:=[a,:b]) in GETDATABASE(id,'ANCESTORS) repeat
+      RPLACA(u,SUBST('Type,'Object,a))
+      RPLACD(u,simpHasPred b)
+
+simpCategoryTable() == main where
+  main ==
+    for key in HKEYS _*HASCATEGORY_-HASH_* repeat
+      entry := HGET(_*HASCATEGORY_-HASH_*,key)
+      null entry => HREM(_*HASCATEGORY_-HASH_*,key)
+      change :=
+        atom opOf entry => simpHasPred entry
+        [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred]
+      HPUT(_*HASCATEGORY_-HASH_*,key,change)
+
+simpHasPred(pred,:options) == main where
+  main ==
+    $hasArgs: local := IFCDR IFCAR options
+    simp pred
+  simp pred ==
+    pred is [op,:r] =>
+      op = 'has => simpHas(pred,first r,first rest r)
+      op = 'HasCategory => simp ['has,CAR r,simpDevaluate CADR r]
+      op = 'HasSignature =>
+         [op,sig] := simpDevaluate CADR r
+         ['has,CAR r,['SIGNATURE,op,sig]]
+      op = 'HasAttribute =>
+        form := ['has,a := CAR r,['ATTRIBUTE,b := simpDevaluate CADR r]]
+        simpHasAttribute(form,a,b)
+      MEMQ(op,'(AND OR NOT)) =>
+        null (u := MKPF([simp p for p in r],op)) => nil
+        u is '(QUOTE T) => true
+        simpBool u
+      op = 'hasArgs => ($hasArgs => $hasArgs = r; pred)
+      null r and opOf op = 'has => simp first pred
+      pred is '(QUOTE T) => true
+      op1 := LASSOC(op,'((and . AND)(or . OR)(not . NOT))) => simp [op1,:r]
+      simp first pred   --REMOVE THIS HACK !!!!
+    pred in '(T etc) => pred
+    null pred => nil
+    pred
+  simpDevaluate a == EVAL SUBST('QUOTE,'devaluate,a)
+  simpHas(pred,a,b) ==
+    b is ['ATTRIBUTE,attr] => simpHasAttribute(pred,a,attr)
+    b is ['SIGNATURE,op,sig] => simpHasSignature(pred,a,op,sig)
+    IDENTP a or hasIdent b => pred
+    npred := eval pred
+    IDENTP npred or null hasIdent npred => npred
+    pred
+  eval (pred := ['has,d,cat]) ==
+    x := hasCat(CAR d,CAR cat)
+    y := CDR cat =>
+      npred := or/[p for [args,:p] in x | y = args] => simp npred
+      false  --if not there, it is false
+    x
+
+simpHasSignature(pred,conform,op,sig) == --eval w/o loading
+  IDENTP conform => pred
+  [conname,:args] := conform
+  n := #sig
+  u := LASSOC(op,GETDATABASE(conname,'OPERATIONALIST))
+  candidates := [x for (x := [sig1,:.]) in u | #sig1 = #sig]  or return false
+  match := or/[x for (x := [sig1,:.]) in candidates
+                | sig = sublisFormal(args,sig1)] or return false
+  simpHasPred(match is [sig,.,:p] and sublisFormal(args,p) or true)
+
+simpHasAttribute(pred,conform,attr) ==  --eval w/o loading
+  IDENTP conform => pred
+  conname := opOf conform
+  GETDATABASE(conname,'CONSTRUCTORKIND) = 'category =>
+      simpCatHasAttribute(conform,attr)
+  asharpConstructorName? conname =>
+    p := LASSOC(attr,GETDATABASE(conname,'attributes)) =>
+      simpHasPred sublisFormal(rest conform,p)
+  infovec := dbInfovec conname
+  k := LASSOC(attr,infovec.2) or return nil --if not listed then false
+  k = 0 => true
+  $domain => kTestPred k    --from koOps
+  predvec := $predvec or sublisFormal(rest conform,
+      GETDATABASE(conname,'PREDICATES))
+  simpHasPred predvec.(k - 1)
+
+simpCatHasAttribute(domform,attr) ==
+  conform := getConstructorForm opOf domform
+  catval :=  EVAL mkEvalable conform
+  if atom KDR attr then attr := IFCAR attr
+  pred :=
+    u := LASSOC(attr,catval . 2) => first u
+    return false                            --exit: not there
+  pred = true => true
+  EVAL SUBLISLIS(rest domform,rest conform,pred)
+
+hasIdent pred ==
+  pred is [op,:r] =>
+    op = 'QUOTE => false
+    or/[hasIdent x for x in r]
+  pred = '_$ => false
+  IDENTP pred => true
+  false
+
+addDomainToTable(id,catl) ==
+  alist:= nil
+  for cat in catl repeat
+    cat is ['CATEGORY,:.] => nil
+    cat is ['IF,pred,cat1,:.] =>
+      newAlist:=
+        [[a,:quickAnd(pred,b)] for [a,:b] in getCategoryExtensionAlist0 cat1]
+      alist:= [:alist,:newAlist]
+    alist:= [:alist,:getCategoryExtensionAlist0 cat]
+  [id,:alist]
+
+domainHput(table,key:=[id,:a],b) ==
+  HPUT(table,key,b)
+
+genTempCategoryTable() ==
+  --generates hashtable with key=categoryName and value of the form
+  --     ((form . pred) ..) meaning that
+  --           "IF pred THEN ofCategory(key,form)"
+  --  where form can involve #1, #2, ... the parameters of key
+  for con in allConstructors()  repeat
+    GETDATABASE(con,'CONSTRUCTORKIND) = 'category =>
+      addToCategoryTable con
+  for id in HKEYS _*ANCESTORS_-HASH_* repeat
+    item := HGET(_*ANCESTORS_-HASH_*, id) 
+    for (u:=[.,:b]) in item repeat
+      RPLACD(u,simpCatPredicate simpBool b)
+    HPUT(_*ANCESTORS_-HASH_*,id,listSort(function GLESSEQP,item))
+
+addToCategoryTable con ==
+  -- adds an entry to $tempCategoryTable with key=con and alist entries
+  u := CAAR GETDATABASE(con,'CONSTRUCTORMODEMAP) --domain
+  alist := getCategoryExtensionAlist u
+  HPUT(_*ANCESTORS_-HASH_*,first u,alist)
+  alist
+
+encodeCategoryAlist(id,alist) ==
+  newAl:= nil
+  for [a,:b] in alist repeat
+    [key,:argl] := a
+    newEntry:=
+      argl => [[argl,:b]]
+      b
+    u:= ASSOC(key,newAl) =>
+      argl => RPLACD(u,encodeUnion(id,first newEntry,rest u))
+      if newEntry ^= rest u then
+        p:= moreGeneralCategoryPredicate(id,newEntry,rest u) => RPLACD(u,p)
+        sayMSG '"Duplicate entries:"
+        PRINT [newEntry,rest u]
+    newAl:= [[key,:newEntry],:newAl]
+  newAl
+
+encodeUnion(id,new:=[a,:b],alist) ==
+  u := ASSOC(a,alist) =>
+    RPLACD(u,moreGeneralCategoryPredicate(id,b,rest u))
+    alist
+  [new,:alist]
+
+moreGeneralCategoryPredicate(id,new,old) ==
+  old = 'T or new = 'T => 'T
+  old is ['has,a,b] and new is ['has,=a,c] =>
+    tempExtendsCat(b,c) => new
+    tempExtendsCat(c,b) => old
+    ['OR,old,new]
+  mkCategoryOr(new,old)
+
+mkCategoryOr(new,old) ==
+  old is ['OR,:l] => simpCategoryOr(new,l)
+  ['OR,old,new]
+
+simpCategoryOr(new,l) ==
+  newExtendsAnOld:= false
+  anOldExtendsNew:= false
+  ['has,a,b] := new
+  newList:= nil
+  for pred in l repeat
+    pred is ['has,=a,c] =>
+      tempExtendsCat(c,b) => anOldExtendsNew:= true
+      if tempExtendsCat(b,c) then newExtendsAnOld:= true
+      newList:= [pred,:newList]
+    newList:= [pred,:newList]
+  if not newExtendsAnOld then newList:= [new,:newList]
+  newList is [.] => first newList
+  ['OR,:newList]
+
+tempExtendsCat(b,c) ==
+  or/[first c = a for [[a,:.],:.] in GETDATABASE(first b,'ANCESTORS)]
+
+getCategoryExtensionAlist0 cform ==
+  [[cform,:'T],:getCategoryExtensionAlist cform]
+
+getCategoryExtensionAlist cform ==
+  --avoids substitution as much as possible
+  u:= GETDATABASE(first cform,'ANCESTORS) => formalSubstitute(cform,u)
+  mkCategoryExtensionAlist cform
+
+formalSubstitute(form:=[.,:argl],u) ==
+  isFormalArgumentList argl => u
+  EQSUBSTLIST(argl,$FormalMapVariableList,u)
+
+isFormalArgumentList argl ==
+  and/[x=fa for x in argl for fa in $FormalMapVariableList]
+
+mkCategoryExtensionAlist cform ==
+  not CONSP cform => nil
+  cop := first cform
+  MEMQ(cop, $CategoryNames) => mkCategoryExtensionAlistBasic cform
+  catlist := formalSubstitute(cform, first getConstructorExports(cform, true))
+  extendsList:= nil
+  for [cat,:pred] in catlist repeat
+    newList := getCategoryExtensionAlist0 cat
+    finalList :=
+      pred = 'T => newList
+      [[a,:quickAnd(b,pred)] for [a,:b] in newList]
+    extendsList:= catPairUnion(extendsList,finalList,cop,cat)
+  extendsList
+
+-- following code to handle Unions Records Mapping etc.
+mkCategoryExtensionAlistBasic cform ==
+  cop := first cform
+--category:= eval cform
+  category :=      -- changed by RSS on 7/29/87
+    macrop cop => eval cform
+    APPLY(cop, rest cform)
+  extendsList:= [[x,:'T] for x in category.4.0]
+  for [cat,pred,:.] in category.4.1 repeat
+    newList := getCategoryExtensionAlist0 cat
+    finalList :=
+      pred = 'T => newList
+      [[a,:quickAnd(b,pred)] for [a,:b] in newList]
+    extendsList:= catPairUnion(extendsList,finalList,cop,cat)
+  extendsList
+
+catPairUnion(oldList,newList,op,cat) ==
+  for pair in newList repeat
+    u:= ASSOC(first pair,oldList) =>
+      rest u = rest pair => nil
+      RPLACD(u,addConflict(rest pair,rest u)) where addConflict(new,old) ==
+        quickOr(new,old)
+    oldList:= [pair,:oldList]
+  oldList
+
+simpCatPredicate p ==
+  p is ['OR,:l] =>
+    (u:= simpOrUnion l) is [p] => p
+    ['OR,:u]
+  p
+
+simpOrUnion l ==
+  if l then simpOrUnion1(first l,simpOrUnion rest l)
+  else l
+
+simpOrUnion1(x,l) ==
+  null l => [x]
+  p:= mergeOr(x,first l) => [p,:rest l]
+  [first l,:simpOrUnion1(x,rest l)]
+
+mergeOr(x,y) ==
+  x is ['has,a,b] and y is ['has,=a,c] =>
+    testExtend(b,c) => y
+    testExtend(c,b) => x
+    nil
+  nil
+
+testExtend(a:=[op,:argl],b) ==
+  (u:= GETDATABASE(op,'ANCESTORS)) and (val:= LASSOC(b,u)) =>
+    formalSubstitute(a,val)
+  nil
+
+getConstrCat(x) ==
+-- gets a different representation of the constructorCategory from the
+-- lisplib, which is a list of named categories or conditions
+  x:= if x is ['Join,:y] then y else [x]
+  cats:= NIL
+  for y in x repeat
+    y is ['CATEGORY,.,:z] =>
+      for zz in z repeat cats := makeCatPred(zz, cats, true)
+    cats:= CONS(y,cats)
+  cats:= nreverse cats
+  cats
+
+
+makeCatPred(zz, cats, thePred) ==
+  if zz is ['IF,curPred := ['has,z1,z2],ats,.] then
+    ats := if ats is ['PROGN,:atl] then atl else [ats]
+    for at in ats repeat
+      if at is ['ATTRIBUTE,z3] and not atom z3 and
+        constructor? CAR z3 then
+          cats:= CONS(['IF,quickAnd(['has,z1,z2], thePred),z3,'noBranch],cats)
+      at is ['IF, pred, :.] =>
+        cats := makeCatPred(at, cats, curPred)
+  cats
+
+getConstructorExports(conform,:options) == categoryParts(conform,
+  GETDATABASE(opOf conform,'CONSTRUCTORCATEGORY),IFCAR options)
+
+categoryParts(conform,category,:options) == main where
+  main ==
+    cons? := IFCAR options  --means to include constructors as well
+    $attrlist: local := nil
+    $oplist  : local := nil
+    $conslist: local := nil
+    conname := opOf conform
+    for x in exportsOf(category) repeat build(x,true)
+    $attrlist := listSort(function GLESSEQP,$attrlist)
+    $oplist   := listSort(function GLESSEQP,$oplist)
+    res := [$attrlist,:$oplist]
+    if cons? then res := [listSort(function GLESSEQP,$conslist),:res]
+    if GETDATABASE(conname,'CONSTRUCTORKIND) = 'category then
+      tvl := TAKE(#rest conform,$TriangleVariableList)
+      res := SUBLISLIS($FormalMapVariableList,tvl,res)
+    res
+  build(item,pred) ==
+    item is ['SIGNATURE,op,sig,:.] => $oplist   := [[opOf op,sig,:pred],:$oplist]
+    --note: opOf is needed!!! Bug in compiler puts in (One) and (Zero)
+    item is ['ATTRIBUTE,attr] =>
+      constructor? opOf attr =>
+        $conslist := [[attr,:pred],:$conslist]
+        nil
+      opOf attr = 'nothing => 'skip
+      $attrlist := [[opOf attr,IFCDR attr,:pred],:$attrlist]
+    item is ['TYPE,op,type] =>
+        $oplist := [[op,[type],:pred],:$oplist]
+    item is ['IF,pred1,s1,s2] =>
+      build(s1,quickAnd(pred,pred1))
+      s2 => build(s2,quickAnd(pred,['NOT,pred1]))
+    item is ['PROGN,:r] => for x in r repeat build(x,pred)
+    item in '(noBranch) => 'ok
+    null item => 'ok
+    systemError '"build error"
+  exportsOf(target) ==
+    target is ['CATEGORY,.,:r] => r
+    target is ['Join,:r,f] =>
+      for x in r repeat $conslist := [[x,:true],:$conslist]
+      exportsOf f
+    $conslist := [[target,:true],:$conslist]
+    nil
+
+--------------------> NEW DEFINITION (override in patches.lisp.pamphlet)
+compressHashTable ht ==
+-- compresses hash table ht, to give maximal sharing of cells
+  sayBrightlyNT '"compressing hash table..."
+  $found: local := MAKE_-HASHTABLE 'UEQUAL
+  for x in HKEYS ht repeat compressSexpr(HGET(ht,x),nil,nil)
+  sayBrightly   "done"
+  ht
+
+compressSexpr(x,left,right) ==
+-- recursive version of compressHashTable
+  atom x => nil
+  u:= HGET($found,x) =>
+    left => RPLACA(left,u)
+    right => RPLACD(right,u)
+    nil
+  compressSexpr(first x,x,nil)
+  compressSexpr(rest x,nil,x)
+  HPUT($found,x,x)
+
+squeezeList(l) ==
+-- changes the list l, so that is has maximal sharing of cells
+  $found:local:= NIL
+  squeeze1 l
+
+squeeze1(l) ==
+-- recursive version of squeezeList
+  x:= CAR l
+  y:=
+    atom x => x
+    z:= member(x,$found) => CAR z
+    $found:= CONS(x,$found)
+    squeeze1 x
+  RPLACA(l,y)
+  x:= CDR l
+  y:=
+    atom x => x
+    z:= member(x,$found) => CAR z
+    $found:= CONS(x,$found)
+    squeeze1 x
+  RPLACD(l,y)
+
+updateCategoryTable(cname,kind) ==
+  $newcompMode = true => nil
+  $updateCatTableIfTrue =>
+    kind = 'package => nil
+    kind = 'category => updateCategoryTableForCategory(cname)
+    updateCategoryTableForDomain(cname,getConstrCat(
+      GETDATABASE(cname,'CONSTRUCTORCATEGORY)))
+--+
+  kind = 'domain and $NRTflag = true =>
+    updateCategoryTableForDomain(cname,getConstrCat(
+      GETDATABASE(cname,'CONSTRUCTORCATEGORY)))
+
+updateCategoryTableForCategory(cname) ==
+  clearTempCategoryTable([[cname,'category]])
+  addToCategoryTable(cname)
+  for id in HKEYS _*ANCESTORS_-HASH_* repeat
+      for (u:=[.,:b]) in GETDATABASE(id,'ANCESTORS) repeat
+        RPLACD(u,simpCatPredicate simpBool b)
+
+updateCategoryTableForDomain(cname,category) ==
+  clearCategoryTable(cname)
+  [cname,:domainEntry]:= addDomainToTable(cname,category)
+  for [a,:b] in encodeCategoryAlist(cname,domainEntry) repeat
+    HPUT(_*HASCATEGORY_-HASH_*,[cname,:a],b)
+  $doNotCompressHashTableIfTrue = true => _*HASCATEGORY_-HASH_*
+  compressHashTable _*HASCATEGORY_-HASH_*
+
+clearCategoryTable($cname) ==
+  MAPHASH('clearCategoryTable1,_*HASCATEGORY_-HASH_*)
+
+clearCategoryTable1(key,val) ==
+  (CAR key=$cname)=> HREM(_*HASCATEGORY_-HASH_*,key)
+  nil
+
+clearTempCategoryTable(catNames) ==
+  for key in HKEYS(_*ANCESTORS_-HASH_*) repeat
+    MEMQ(key,catNames) => nil
+    extensions:= nil
+    for (extension:= [catForm,:.]) in GETDATABASE(key,'ANCESTORS)
+      repeat
+        MEMQ(CAR catForm,catNames) => nil
+        extensions:= [extension,:extensions]
+    HPUT(_*ANCESTORS_-HASH_*,key,extensions)
+
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ccl-depsys.lsp.pamphlet b/src/interp/ccl-depsys.lsp.pamphlet
new file mode 100644
index 00000000..e6a94f81
--- /dev/null
+++ b/src/interp/ccl-depsys.lsp.pamphlet
@@ -0,0 +1,89 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/boot/ccl-depsys.lsp}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+<<*>>=
+;;
+;; This builds "depsys" on top of CCL.
+;;
+
+(push :oldboot *features*)
+
+(load "try1.lsp") ;; Fix-ups for the Lisp package
+
+(in-package "LISP")
+(setq *echo nil)
+(setq *read-default-float-format* 'double-float)
+
+(load "sys-pkg.lisp")
+
+(in-package "VMLISP")
+;; new divide of divide in ccl yields a dotted pair
+(defun divide (x y) (multiple-value-list (truncate x y)))
+(defvar boot::|$SessionManager| 'boot-session-manager)
+(defvar boot::|$EndOfOutput| 'boot-end-of-output)
+
+(load "parsing_macros.lsp") ;; For macro defs used by util.
+(load "util.lisp")
+
+;; start of OBJS
+(load "vmlisp.lisp")
+(load "hash.lisp")
+(load "bootfuns.lisp")
+(load "macros.lisp")
+(load "spad.lisp")
+(load "spaderror.lisp")
+(load "unlisp.lisp")
+(load "setq.lisp")
+(load "bits.lisp")
+(load "cfuns.lisp")
+(load "comp.lisp")
+(load "debug.lisp")
+(load "fname.lisp")
+(load "ggreater.lisp")
+(load "nci.lisp")
+(load "newaux.lisp")
+(load "nlib.lisp")
+(load "property.lisp")
+(load "sfsfun-l.lisp")
+(load "sockio.lisp")
+(load "union.lisp")
+;; end of OBJS
+
+;; Objects from autoload metaparser sector
+(load "parsing.lisp")
+(load "bootlex.lisp")
+(load "def.lisp")
+(load "fnewmeta.lisp")
+(load "metalex.lisp")
+(load "metameta.lisp")
+(load "postprop.lisp")
+(load "preparse.lisp")
+
+; end
+; THE CLISP FILES we need
+(load "postpar.clisp")
+(load "g-boot.clisp")
+(load "g-util.clisp")
+(load "clam.clisp")
+(load "slam.clisp")
+
+
+(copy-module 'ccomp)
+
+(preserve)
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/cformat.boot.pamphlet b/src/interp/cformat.boot.pamphlet
new file mode 100644
index 00000000..a5fb233d
--- /dev/null
+++ b/src/interp/cformat.boot.pamphlet
@@ -0,0 +1,108 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp cformat.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Formatting functions for various compiler data objects.
+--  These are used as [%origin o, %id n] for %1f %2f... style arguments
+--  in a keyed message.
+--  SMW, SG June 88
+ 
+%id a     == [IDENTITY, a]
+ 
+-- Union(FileName,"strings","console")
+%origin x ==
+    [function porigin, x]
+porigin x ==
+    (STRINGP x => x; pfname x)
+ 
+%fname x ==
+    [function pfname, x]
+pfname x ==
+    PathnameString x
+ 
+
+%pos p == [function ppos, p]
+ppos p ==
+    pfNoPosition? p => ['"no position"]
+    pfImmediate? p  => ['"console"]
+    cpos := pfCharPosn p
+    lpos := pfLinePosn p
+    org  := porigin pfFileName p
+    [org,'" ",'"line",'" ",lpos]
+ 
+%key keyStuff == [function pkey, keyStuff]
+--keyStuff ::= keynumber | [ one or more keySeqs ]
+--keySeq   ::= keynumber optargList optdbn
+--optARgL  ::= [ 0 or more arguments ] | nothing at all
+--optDbn   ::= ['dbN , databaseName ] | nothing at all
+----------- (override in format.boot.pamphlet)
+pkey keyStuff ==
+    if not PAIRP keyStuff then keyStuff := [keyStuff]
+    allMsgs := []
+    while not null keyStuff repeat
+        dbN := NIL
+        argL := NIL
+        key := first keyStuff
+        keyStuff := IFCDR keyStuff
+        next := IFCAR keyStuff
+        while PAIRP next repeat
+            if CAR next = 'dbN then dbN := CADR next
+            else argL := next
+            keyStuff  := IFCDR keyStuff
+            next      := IFCAR keyStuff
+        oneMsg  := returnStLFromKey(key,argL,dbN)
+        allMsgs := NCONC (oneMsg,allMsgs)
+    allMsgs
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/cfuns.lisp.pamphlet b/src/interp/cfuns.lisp.pamphlet
new file mode 100644
index 00000000..d9bf72d5
--- /dev/null
+++ b/src/interp/cfuns.lisp.pamphlet
@@ -0,0 +1,123 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp cfuns.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+#+(and :Lucid (not :ibm/370))
+(progn
+;  (system:define-foreign-function :c '|findString| :fixnum)
+  (system:define-foreign-function :c '|addtopath|  :fixnum)
+  (system:define-foreign-function :c '|chdir|      :fixnum)
+  (system:define-foreign-function :c '|writeablep| :fixnum)
+  (system:define-foreign-function :c '|directoryp| :fixnum)
+  (system:define-foreign-function :c '|copyEnvValue| :fixnum)
+  )
+
+#+KCL
+(progn
+  (defentry |directoryp| (string)        (int "directoryp"))
+  (defentry |writeablep| (string)        (int "writeablep"))
+;  (defentry |findString| (string string) (int "findString"))
+  )
+
+#+:CCL
+(defun |directoryp| (fn)
+  (cond ((not (probe-file fn)) -1)
+        ((directoryp fn) 1)
+        (t 0)))
+
+
+
+; (defun |findStringInFile| (str p) 
+;     (|findString| (namestring p) str) )
+
+
+(defun |getEnv| (var-name)  (system::getenv var-name))
+
+;;stolen from AXIOM-XL src/strops.c
+#+(AND KCL (NOT ELF))
+(Clines 
+"MYHASH(s)"
+"char *s;"
+"{"
+" register unsigned int   h = 0;"
+" register int    c;"
+""
+" while ((c = *s++) != 0) {"
+"  h ^= (h << 8);"
+"  h += ((c) + 200041);"
+"  h &= 0x3FFFFFFF;"
+" }"
+" return h;"
+"}"
+)
+#+(AND KCL (NOT ELF))
+(defentry |hashString| (string) (int "MYHASH"))
+#+(AND KCL ELF)
+(defun |hashString| (string) (system:|hashString| string))
+
+#+(AND KCL (NOT ELF))
+(Clines
+"int MYCOMBINE(i,j)"
+"int i,j;"
+"{"
+"return ( (((((unsigned int)j) & 16777215) << 6)+((unsigned int)i)) % 1073741789);"
+"}"
+)
+#+(AND KCL (NOT ELF))
+(defentry |hashCombine| (int int) (int "MYCOMBINE"))
+#+(AND KCL  ELF)
+(defun |hashCombine| (x y) (system:|hashCombine| x y))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/clam.boot.pamphlet b/src/interp/clam.boot.pamphlet
new file mode 100644
index 00000000..d811c00a
--- /dev/null
+++ b/src/interp/clam.boot.pamphlet
@@ -0,0 +1,729 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{/src/interp/clam.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Cache Lambda Facility
+-- for remembering previous values to functions
+ 
+--to CLAM a function f, there must be an entry on $clamList as follows:
+--    (functionName  --the name of the function to be CLAMed (e.g. f)
+--     kind          --"hash" or number of values to be stored in
+--                     circular list
+--     eqEtc         --the equal function to be used
+--                     (EQ, EQUAL, UEQUAL,..)
+--     "shift"       --(opt) for circular lists, shift most recently
+--                      used to front
+--     "count")      --(opt) use reference counts (see below)
+--
+-- Notes:
+--   Functions with "hash" as kind must give EQ, CVEC, or UEQUAL
+--   Functions with some other <identifier> as kind hashed as property
+--   lists with eqEtc used to compare entries
+--   Functions which have 0 arguments may only be CLAMmed when kind is
+--   identifier other than hash (circular/private hashtable for no args
+--   makes no sense)
+--
+--   Functions which have more than 1 argument must never be CLAMed with EQ
+--     since arguments are cached as lists
+--   For circular lists, "count" will do "shift"ing; entries with lowest
+--     use count are replaced
+--   For cache option without "count", all entries are cleared on garbage
+--     collection; For cache option with "count",
+--     entries have their use count set
+--     to 0 on garbage collection; those with 0 use count at garbage collection
+--     are cleared
+-- see definition of COMP,2 in COMP LISP which calls clamComp below
+ 
+-- see SETQ LISP for initial def of $hashNode
+ 
+compClam(op,argl,body,$clamList) ==
+  --similar to reportFunctionCompilation in SLAM BOOT
+  if $InteractiveMode then startTimingProcess 'compilation
+  if (u:= LASSQ(op,$clamList)) isnt [kind,eqEtc,:options]
+    then keyedSystemError("S2GE0004",[op])
+  $clamList:= nil            --clear to avoid looping
+  if u:= S_-(options,'(shift count)) then
+    keyedSystemError("S2GE0006",[op,:u])
+  shiftFl := MEMQ('shift,options)
+  countFl := MEMQ('count,options)
+  if #argl > 1 and eqEtc= 'EQ then
+    keyedSystemError("S2GE0007",[op])
+  (not IDENTP kind) and (not INTEGERP kind or kind < 1) =>
+    keyedSystemError("S2GE0005",[op])
+  IDENTP kind =>
+    shiftFl => keyedSystemError("S2GE0008",[op])
+    compHash(op,argl,body,(kind='hash => nil; kind),eqEtc,countFl)
+  cacheCount:= kind
+  if null argl then keyedSystemError("S2GE0009",[op])
+  phrase:=
+    cacheCount=1 => ['"computed value only"]
+    [:bright cacheCount,'"computed values"]
+  sayBrightly [:bright op,'"will save last",:phrase]
+  auxfn:= INTERNL(op,'";")
+  g1:= GENSYM()  --argument or argument list
+  [arg,computeValue] :=
+    argl is [.] => [[g1],[auxfn,g1]]  --g1 is a parameter
+    [g1,['APPLX,['function,auxfn],g1]]          --g1 is a parameter list
+  cacheName:= INTERNL(op,'";AL")
+  if $reportCounts=true then
+    hitCounter:= INTERNL(op,'";hit")
+    callCounter:= INTERNL(op,'";calls")
+    SET(hitCounter,0)
+    SET(callCounter,0)
+    callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]]
+    hitCountCode:=  [['SETQ,hitCounter,['QSADD1,hitCounter]]]
+  g2:= GENSYM()  --length of cache or arg-value pair
+  g3:= GENSYM()  --value computed by calling function
+  lookUpFunction:=
+    shiftFl =>
+      countFl => 'assocCacheShiftCount
+      'assocCacheShift
+    countFl => 'assocCacheCount
+    'assocCache
+  returnFoundValue:=
+    countFl => ['CDDR,g3]
+    ['CDR,g3]
+  namePart:=
+    countFl => cacheName
+    MKQ cacheName
+  secondPredPair:=
+--   null argl => [cacheName]
+    [['SETQ,g3,[lookUpFunction,g1,namePart,eqEtc]],
+      :hitCountCode,
+        returnFoundValue]
+  resetCacheEntry:=
+    countFl => ['CONS,1,g2]
+    g2
+  thirdPredPair:=
+--   null argl => ['(QUOTE T),['SETQ,cacheName,computeValue]]
+    ['(QUOTE T),
+      ['SETQ,g2,computeValue],
+        ['SETQ,g3,['CAR,cacheName]],
+          ['RPLACA,g3,g1],
+            ['RPLACD,g3,resetCacheEntry],
+              g2]
+  codeBody:= ['PROG,[g2,g3],
+                :callCountCode,
+                  ['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  lamex:= ['LAM,arg,codeBody]
+  mainFunction:= [op,lamex]
+  computeFunction:= [auxfn,['LAMBDA,argl,:body]]
+ 
+  -- compile generated function stub
+  compileInteractive mainFunction
+ 
+  -- compile main body: this has already been compTran'ed
+  if $reportCompilation then
+    sayBrightlyI bright '"Generated LISP code for function:"
+    pp computeFunction
+  compileQuietly [computeFunction]
+ 
+  cacheType:= 'function
+  cacheResetCode:= ['SETQ,cacheName,['initCache,cacheCount]]
+  cacheCountCode:= ['countCircularAlist,cacheName,cacheCount]
+  cacheVector:= mkCacheVec(op,cacheName,cacheType,
+    cacheResetCode,cacheCountCode)
+  LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector]
+  LAM_,EVALANDFILEACTQ cacheResetCode
+  if $InteractiveMode then stopTimingProcess 'compilation
+  op
+ 
+compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
+  --Note: when cacheNameOrNil^=nil, it names a global hashtable
+ 
+-- cacheNameOrNil => compHashGlobal(op,argl,body,cacheNameOrNil,eqEtc,countFl)
+--   This branch to compHashGlobal is now omitted; as a result,
+--   entries will be stored on the global hashtable in a uniform way:
+--        (<argument list>, <reference count>,:<value>)
+--   where the reference count is optional
+ 
+  if cacheNameOrNil and cacheNameOrNil^='_$ConstructorCache then
+    keyedSystemError("S2GE0010",[op])
+    --restriction due to omission of call to hputNewValue (see *** lines below)
+ 
+  if null argl then
+    null cacheNameOrNil => keyedSystemError("S2GE0011",[op])
+    nil
+  (not cacheNameOrNil) and (not MEMQ(eqEtc,'(EQ CVEC UEQUAL))) =>
+    keyedSystemError("S2GE0012",[op])
+--withWithout := (countFl => "with"; "without")
+--middle:=
+--  cacheNameOrNil => ["on","%b",cacheNameOrNil,"%d"]
+--  '"privately "
+--sayBrightly
+--  ["%b",op,"%d","hashes ",:middle,withWithout," reference counts"]
+  auxfn:= INTERNL(op,'";")
+  g1:= GENSYM()  --argument or argument list
+  [arg,cacheArgKey,computeValue] :=
+  --    arg: to be used as formal argument of lambda construction;
+  --    cacheArgKey: the form used to look up the value in the cache
+  --    computeValue: the form used to compute the value from arg
+    null argl => [nil,nil,[auxfn]]
+    argl is [.] =>
+      key:= (cacheNameOrNil => ['devaluate,g1]; g1)
+      [[g1],['LIST,key],[auxfn,g1]]  --g1 is a parameter
+    key:= (cacheNameOrNil => ['devaluateList,g1] ; g1)
+    [g1,key,['APPLY,['function,auxfn],g1]]   --g1 is a parameter list
+  cacheName:= cacheNameOrNil or INTERNL(op,'";AL")
+  if $reportCounts=true then
+    hitCounter:= INTERNL(op,'";hit")
+    callCounter:= INTERNL(op,'";calls")
+    SET(hitCounter,0)
+    SET(callCounter,0)
+    callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]]
+    hitCountCode:=  [['SETQ,hitCounter,['QSADD1,hitCounter]]]
+  g2:= GENSYM()  --value computed by calling function
+  returnFoundValue:=
+    null argl =>
+    --  if we have a global hastable, functions with no arguments are
+    --  stored in the same format as those with several arguments, e.g.
+    --  to cache the value <val> given by f(), the structure
+    --  ((nil <count> <val>)) is stored in the cache
+      countFl => ['CDRwithIncrement,['CDAR,g2]]
+      ['CDAR,g2]
+    countFl => ['CDRwithIncrement,g2]
+    g2
+  getCode:=
+    null argl => ['HGET,cacheName,MKQ op]
+    cacheNameOrNil =>
+      eqEtc^='EQUAL =>
+        ['lassocShiftWithFunction,cacheArgKey,
+          ['HGET,cacheNameOrNil,MKQ op],MKQ eqEtc]
+      ['lassocShift,cacheArgKey,['HGET,cacheNameOrNil,MKQ op]]
+    ['HGET,cacheName,g1]
+  secondPredPair:= [['SETQ,g2,getCode],:hitCountCode,returnFoundValue]
+  putCode:=
+    null argl =>
+      cacheNameOrNil =>
+        countFl => ['CDDAR,['HPUT,cacheNameOrNil,MKQ op,
+                      ['LIST,['CONS,nil,['CONS,1,computeValue]]]]]
+        ['HPUT,cacheNameOrNil,MKQ op,['LIST,['CONS,nil,computeValue]]]
+      systemError '"unexpected"
+    cacheNameOrNil => computeValue
+    --countFl => ['CDR,['hputNewProp,cacheNameOrNil,MKQ op,cacheArgKey, --***
+    --             ['CONS,1,computeValue]]]                             --***
+    --['hputNewProp,cacheNameOrNil,MKQ op,cacheArgKey,computeValue]    --***
+    countFl => ['CDR,['HPUT,cacheName,g1,['CONS,1,computeValue]]]
+    ['HPUT,cacheName,g1,computeValue]
+  if cacheNameOrNil then putCode :=
+     ['UNWIND_-PROTECT,['PROG1,putCode,['SETQ,g2,'T]],
+                  ['COND,[['NOT,g2],['HREM,cacheName,MKQ op]]]]
+  thirdPredPair:= ['(QUOTE T),putCode]
+  codeBody:= ['PROG,[g2],
+               :callCountCode,['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  lamex:= ['LAM,arg,codeBody]
+  mainFunction:= [op,lamex]
+  computeFunction:= [auxfn,['LAMBDA,argl,:body]]
+ 
+  -- compile generated function stub
+  compileInteractive mainFunction
+ 
+  -- compile main body: this has already been compTran'ed
+  if $reportCompilation then
+    sayBrightlyI bright '"Generated LISP code for function:"
+    pp computeFunction
+  compileQuietly [computeFunction]
+ 
+  if null cacheNameOrNil then
+    cacheType:=
+      countFl => 'hash_-tableWithCounts
+      'hash_-table
+    weakStrong:= (countFl => 'STRONG; 'WEAK)
+      --note: WEAK means that key/value pairs disappear at garbage collection
+    cacheResetCode:=
+      ['SETQ,cacheName,['MAKE_-HASHTABLE,MKQ eqEtc]]
+    cacheCountCode:= ['hashCount,cacheName]
+    cacheVector:=
+      mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
+    LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector]
+    LAM_,EVALANDFILEACTQ cacheResetCode
+  op
+ 
+compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) ==
+  --Note: when cacheNameOrNil^=nil, it names a global hashtable
+ 
+  if (not MEMQ(eqEtc,'(UEQUAL))) then
+    sayBrightly "for hash option, only EQ, CVEC, and UEQUAL are allowed"
+  auxfn:= INTERNL(op,'";")
+  g1:= GENSYM()  --argument or argument list
+  [arg,cacheArgKey,computeValue] :=
+  --    arg: to be used as formal argument of lambda construction;
+  --    cacheArgKey: the form used to look up the value in the cache
+  --    computeValue: the form used to compute the value from arg
+    application:=
+      null argl => [auxfn]
+      argl is [.] => [auxfn,g1]  --g1 is a parameter
+      ['APPLX,['function,auxfn],g1]          --g1 is a parameter list
+    [g1,['consForHashLookup,MKQ op,g1],application]
+  g2:= GENSYM()  --value computed by calling function
+  returnFoundValue:=
+    countFl => ['CDRwithIncrement,g2]
+    g2
+  getCode:= ['HGET,cacheName,cacheArgKey]
+  secondPredPair:= [['SETQ,g2,getCode],returnFoundValue]
+  putForm:= ['CONS,MKQ op,g1]
+  putCode:=
+    countFl => ['HPUT,cacheName,putForm,['CONS,1,computeValue]]
+    ['HPUT,cacheName,putForm,computeValue]
+  thirdPredPair:= ['(QUOTE T),putCode]
+  codeBody:= ['PROG,[g2], ['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  lamex:= ['LAM,arg,codeBody]
+  mainFunction:= [op,lamex]
+  computeFunction:= [auxfn,['LAMBDA,argl,:body]]
+  compileInteractive mainFunction
+  compileInteractive computeFunction
+  op
+ 
+consForHashLookup(a,b) ==
+  RPLACA($hashNode,a)
+  RPLACD($hashNode,b)
+  $hashNode
+ 
+CDRwithIncrement x ==
+  RPLACA(x,QSADD1 CAR x)
+  CDR x
+ 
+HGETandCount(hashTable,prop) ==
+  u:= HGET(hashTable,prop) or return nil
+  RPLACA(u,QSADD1 CAR u)
+  u
+ 
+clearClams() ==
+  for [fn,kind,:.] in $clamList | kind = 'hash or INTEGERP kind repeat
+    clearClam fn
+ 
+clearClam fn ==
+  infovec:= GETL(fn,'cacheInfo) or keyedSystemError("S2GE0003",[fn])
+  eval infovec.cacheReset
+ 
+reportAndClearClams() ==
+  cacheStats()
+  clearClams()
+ 
+clearConstructorCaches() ==
+  clearCategoryCaches()
+  CLRHASH $ConstructorCache
+ 
+clearConstructorCache(cname) ==
+  (kind := GETDATABASE(cname,'CONSTRUCTORKIND)) =>
+    kind = 'category => clearCategoryCache cname
+    HREM($ConstructorCache,cname)
+ 
+clearConstructorAndLisplibCaches() ==
+  clearClams()
+  clearConstructorCaches()
+ 
+clearCategoryCaches() ==
+  for name in allConstructors() repeat
+    if GETDATABASE(name,'CONSTRUCTORKIND) = 'category then
+      if BOUNDP(cacheName:= INTERNL STRCONC(PNAME name,'";AL"))
+            then SET(cacheName,nil)
+    if BOUNDP(cacheName:= INTERNL STRCONC(PNAME name,'";CAT"))
+          then SET(cacheName,nil)
+ 
+clearCategoryCache catName ==
+  cacheName:= INTERNL STRCONC(PNAME catName,'";AL")
+  SET(cacheName,nil)
+ 
+displayHashtable x ==
+  l:= NREVERSE SORTBY('CAR,[[opOf HGET(x,key),key] for key in HKEYS x])
+  for [a,b] in l repeat
+    sayBrightlyNT ['%b,a,'%d]
+    pp b
+ 
+cacheStats() ==
+  for [fn,kind,:u] in $clamList repeat
+    not MEMQ('count,u) =>
+      sayBrightly ["%b",fn,"%d","does not keep reference counts"]
+    INTEGERP kind => reportCircularCacheStats(fn,kind)
+    kind = 'hash => reportHashCacheStats fn
+    sayBrightly ["Unknown cache type for","%b",fn,"%d"]
+ 
+reportCircularCacheStats(fn,n) ==
+  infovec:= GETL(fn,'cacheInfo)
+  circList:= eval infovec.cacheName
+  numberUsed :=
+    +/[1 for i in 1..n for x in circList while x isnt [='_$failed,:.]]
+  sayBrightly ["%b",fn,"%d","has","%b",numberUsed,"%d","/ ",n," values cached"]
+  displayCacheFrequency mkCircularCountAlist(circList,n)
+  TERPRI()
+ 
+displayCacheFrequency al ==
+  al := NREVERSE SORTBY('CAR,al)
+  sayBrightlyNT "    #hits/#occurrences: "
+  for [a,:b] in al repeat sayBrightlyNT [a,"/",b,"  "]
+  TERPRI()
+ 
+mkCircularCountAlist(cl,len) ==
+  for [x,count,:.] in cl for i in 1..len while x ^= '_$failed repeat
+    u:= ASSOC(count,al) => RPLACD(u,1 + CDR u)
+    if INTEGERP $reportFavoritesIfNumber and count >= $reportFavoritesIfNumber then
+      sayBrightlyNT ["   ",count,"  "]
+      pp x
+    al:= [[count,:1],:al]
+  al
+ 
+reportHashCacheStats fn ==
+  infovec:= GETL(fn,'cacheInfo)
+  hashTable:= eval infovec.cacheName
+  hashValues:= [HGET(hashTable,key) for key in HKEYS hashTable]
+  sayBrightly [:bright fn,'"has",:bright(# hashValues),'"values cached."]
+  displayCacheFrequency mkHashCountAlist hashValues
+  TERPRI()
+ 
+mkHashCountAlist vl ==
+  for [count,:.] in vl repeat
+    u:= ASSOC(count,al) => RPLACD(u,1 + CDR u)
+    al:= [[count,:1],:al]
+  al
+ 
+clearHashReferenceCounts() ==
+  --free all cells with 0 reference counts; clear other counts to 0
+  for x in $clamList repeat
+    x.cacheType='hash_-tableWithCounts =>
+      remHashEntriesWith0Count eval x.cacheName
+    x.cacheType='hash_-table => CLRHASH eval x.cacheName
+ 
+remHashEntriesWith0Count $hashTable ==
+  MAPHASH(fn,$hashTable) where fn(key,obj) ==
+    CAR obj = 0 => HREM($hashTable,key)  --free store
+    nil
+ 
+initCache n ==
+  tail:= '(0 . $failed)
+  l:= [[$failed,:tail] for i in 1..n]
+  RPLACD(LASTNODE l,l)
+ 
+assocCache(x,cacheName,fn) ==
+  --fn=equality function; do not SHIFT or COUNT
+  al:= eval cacheName
+  forwardPointer:= al
+  val:= nil
+  until EQ(forwardPointer,al) repeat
+    FUNCALL(fn,CAAR forwardPointer,x) => return (val:= CAR forwardPointer)
+    backPointer:= forwardPointer
+    forwardPointer:= CDR forwardPointer
+  val => val
+  SET(cacheName,backPointer)
+  nil
+ 
+assocCacheShift(x,cacheName,fn) ==  --like ASSOC except that al is circular
+  --fn=equality function; SHIFT but do not COUNT
+  al:= eval cacheName
+  forwardPointer:= al
+  val:= nil
+  until EQ(forwardPointer,al) repeat
+    FUNCALL(fn, CAR (y:=CAR forwardPointer),x) =>
+      if not EQ(forwardPointer,al) then   --shift referenced entry to front
+        RPLACA(forwardPointer,CAR al)
+        RPLACA(al,y)
+      return (val:= y)
+    backPointer := forwardPointer      --CAR is slot replaced on failure
+    forwardPointer:= CDR forwardPointer
+  val => val
+  SET(cacheName,backPointer)
+  nil
+ 
+assocCacheShiftCount(x,al,fn) ==
+  -- if x is found, entry containing x becomes first element of list; if
+  -- x is not found, entry with smallest use count is shifted to front so
+  -- as to be replaced
+  --fn=equality function; COUNT and SHIFT
+  forwardPointer:= al
+  val:= nil
+  minCount:= 10000 --preset minCount but not newFrontPointer here
+  until EQ(forwardPointer,al) repeat
+    FUNCALL(fn, CAR (y:=CAR forwardPointer),x) =>
+      newFrontPointer := forwardPointer
+      RPLAC(CADR y,QSADD1 CADR y)         --increment use count
+      return (val:= y)
+    if QSLESSP(c := CADR y,minCount) then --initial c is 1 so is true 1st time
+      minCount := c
+      newFrontPointer := forwardPointer   --CAR is slot replaced on failure
+    forwardPointer:= CDR forwardPointer
+  if not EQ(newFrontPointer,al) then       --shift referenced entry to front
+    temp:= CAR newFrontPointer             --or entry with smallest count
+    RPLACA(newFrontPointer,CAR al)
+    RPLACA(al,temp)
+  val
+ 
+clamStats() ==
+  for [op,kind,:.] in $clamList repeat
+    cacheVec:= GETL(op,'cacheInfo) or systemErrorHere "clamStats"
+    prefix:=
+      $reportCounts^= true => nil
+      hitCounter:= INTERNL(op,'";hit")
+      callCounter:= INTERNL(op,'";calls")
+      res:= ["%b",eval hitCounter,"/",eval callCounter,"%d","calls to "]
+      SET(hitCounter,0)
+      SET(callCounter,0)
+      res
+    postString:=
+      cacheValue:= eval cacheVec.cacheName
+      kind = 'hash => [" (","%b",HASH_-TABLE_-COUNT cacheValue,"%d","entries)"]
+      empties:= numberOfEmptySlots eval cacheVec.cacheName
+      empties = 0 => nil
+      [" (","%b",kind-empties,"/",kind,"%d","slots used)"]
+    sayBrightly
+      [:prefix,op,:postString]
+ 
+numberOfEmptySlots cache==
+  count:= (CAAR cache ='$failed => 1; 0)
+  for x in tails rest cache while NE(x,cache) repeat
+    if CAAR x='$failed then count:= count+1
+  count
+ 
+addToSlam([name,:argnames],shell) ==
+  $mutableDomain => return nil
+  null argnames => addToConstructorCache(name,nil,shell)
+  args:= ['LIST,:[mkDevaluate a for a in argnames]]
+  addToConstructorCache(name,args,shell)
+ 
+addToConstructorCache(op,args,value) ==
+  ['haddProp,'$ConstructorCache,MKQ op,args,['CONS,1,value]]
+ 
+haddProp(ht,op,prop,val) ==
+  --called inside functors (except for union and record types ??)
+  --presently, ht always = $ConstructorCache
+  statRecordInstantiationEvent()
+  if $reportInstantiations = true or $reportEachInstantiation = true then
+    startTimingProcess 'debug
+    recordInstantiation(op,prop,false)
+    stopTimingProcess 'debug
+  u:= HGET(ht,op) =>     --hope that one exists most of the time
+    ASSOC(prop,u) => val     --value is already there--must = val; exit now
+    RPLACD(u,[CAR u,:CDR u])
+    RPLACA(u,[prop,:val])
+    $op: local := op
+    listTruncate(u,20)        --save at most 20 instantiations
+    val
+  HPUT(ht,op,[[prop,:val]])
+  val
+ 
+recordInstantiation(op,prop,dropIfTrue) ==
+  startTimingProcess 'debug
+  recordInstantiation1(op,prop,dropIfTrue)
+  stopTimingProcess 'debug
+ 
+recordInstantiation1(op,prop,dropIfTrue) ==
+  op in '(CategoryDefaults RepeatedSquaring) => nil--ignore defaults for now
+  if $reportEachInstantiation = true then
+    trailer:= (dropIfTrue => '"  dropped"; '"  instantiated")
+    if $insideCoerceInteractive= true then
+      $instantCoerceCount:= 1+$instantCoerceCount
+    if $insideCanCoerceFrom is [m1,m2] and null dropIfTrue then
+      $instantCanCoerceCount:= 1+$instantCanCoerceCount
+      xtra:=
+        ['" for ",outputDomainConstructor m1,'"-->",outputDomainConstructor m2]
+    if $insideEvalMmCondIfTrue = true and null dropIfTrue then
+      $instantMmCondCount:= $instantMmCondCount + 1
+    typeTimePrin ["CONCAT",outputDomainConstructor [op,:prop],trailer,:xtra]
+  null $reportInstantiations => nil
+  u:= HGET($instantRecord,op) =>     --hope that one exists most of the time
+    v := LASSOC(prop,u) =>
+      dropIfTrue => RPLAC(CDR v,1+CDR v)
+      RPLAC(CAR v,1+CAR v)
+    RPLACD(u,[CAR u,:CDR u])
+    val :=
+      dropIfTrue => [0,:1]
+      [1,:0]
+    RPLACA(u,[prop,:val])
+  val :=
+    dropIfTrue => [0,:1]
+    [1,:0]
+  HPUT($instantRecord,op,[[prop,:val]])
+ 
+reportInstantiations() ==
+  --assumed to be a hashtable with reference counts
+    conList:=
+      [:[[n,m,[key,:argList]] for [argList,n,:m] in HGET($instantRecord,key)]
+        for key in HKEYS $instantRecord]
+    sayBrightly ['"# instantiated/# dropped/domain name",
+      "%l",'"------------------------------------"]
+    nTotal:= mTotal:= rTotal := nForms:= 0
+    for [n,m,form] in NREVERSE SORTBY('CADDR,conList) repeat
+      nTotal:= nTotal+n; mTotal:= mTotal+m
+      if n > 1 then rTotal:= rTotal + n-1
+      nForms:= nForms + 1
+      typeTimePrin ['CONCATB,n,m,outputDomainConstructor form]
+    sayBrightly ["%b",'"Totals:","%d",nTotal,'" instantiated","%l",
+      '"         ",$instantCoerceCount,'" inside coerceInteractive","%l",
+       '"         ",$instantCanCoerceCount,'" inside canCoerceFrom","%l",
+        '"         ",$instantMmCondCount,'" inside evalMmCond","%l",
+         '"         ",rTotal,'" reinstantiated","%l",
+          '"         ",mTotal,'" dropped","%l",
+           '"         ",nForms,'" distinct domains instantiated/dropped"]
+ 
+hputNewProp(ht,op,argList,val) ==
+  --NOTE: obselete if lines *** are commented out
+  -- Warning!!!  This function should only be called for
+  -- $ConstructorCache slamming --- since it maps devaluate onto prop, an
+  -- argument list
+  --
+  -- This function may be called when property is already there; for
+  -- example, Polynomial applied to '(Integer), not finding it in the
+  -- cache will invoke Polynomial to compute it; inside of Polynomial is
+  -- a call to this function which will hputNewProp the property onto the
+  -- cache so that when this function is called by the outer Polynomial,
+  -- the value will always be there
+ 
+  prop:= [devaluate x for x in argList]
+  haddProp(ht,op,prop,val)
+ 
+listTruncate(l,n) ==
+  u:= l
+  n:= QSSUB1 n
+  while NEQ(n,0) and null atom u repeat
+    n:= QSSUB1 n
+    u:= QCDR u
+  if null atom u then
+    if null atom rest u and $reportInstantiations = true then
+      recordInstantiation($op,CAADR u,true)
+    RPLACD(u,nil)
+  l
+ 
+lassocShift(x,l) ==
+  y:= l
+  while not atom y repeat
+    EQUAL(x,CAR QCAR y) => return (result := QCAR y)
+    y:= QCDR y
+  result =>
+    if NEQ(y,l) then
+      QRPLACA(y,CAR l)
+      QRPLACA(l,result)
+    QCDR result
+  nil
+ 
+lassocShiftWithFunction(x,l,fn) ==
+  y:= l
+  while not atom y repeat
+    FUNCALL(fn,x,CAR QCAR y) => return (result := QCAR y)
+    y:= QCDR y
+  result =>
+    if NEQ(y,l) then
+      QRPLACA(y,CAR l)
+      QRPLACA(l,result)
+    QCDR result
+  nil
+ 
+lassocShiftQ(x,l) ==
+  y:= l
+  while not atom y repeat
+    EQ(x,CAR CAR y) => return (result := CAR y)
+    y:= CDR y
+  result =>
+    if NEQ(y,l) then
+      RPLACA(y,CAR l)
+      RPLACA(l,result)
+    CDR result
+  nil
+ 
+-- rassocShiftQ(x,l) ==
+--   y:= l
+--   while not atom y repeat
+--     EQ(x,CDR CAR y) => return (result := CAR y)
+--     y:= CDR y
+--   result =>
+--     if NEQ(y,l) then
+--       RPLACA(y,CAR l)
+--       RPLACA(l,result)
+--     CAR result
+--   nil
+ 
+globalHashtableStats(x,sortFn) ==
+  --assumed to be a hashtable with reference counts
+  keys:= HKEYS x
+  for key in keys repeat
+    u:= HGET(x,key)
+    for [argList,n,:.] in u repeat
+      not INTEGERP n =>   keyedSystemError("S2GE0013",[x])
+      argList1:= [constructor2ConstructorForm x for x in argList]
+      reportList:= [[n,key,argList1],:reportList]
+  sayBrightly ["%b","  USE  NAME ARGS","%d"]
+  for [n,fn,args] in NREVERSE SORTBY(sortFn,reportList) repeat
+    sayBrightlyNT [:rightJustifyString(n,6),"  ",fn,": "]
+    pp args
+ 
+constructor2ConstructorForm x ==
+  VECP x => x.0
+  x
+ 
+rightJustifyString(x,maxWidth) ==
+  size:= entryWidth x
+  size > maxWidth => keyedSystemError("S2GE0014",[x])
+  [fillerSpaces(maxWidth-size," "),x]
+ 
+domainEqualList(argl1,argl2) ==
+  --function used to match argument lists of constructors
+  while argl1 and argl2 repeat
+    item1:= devaluate CAR argl1
+    item2:= CAR argl2
+    partsMatch:=
+      item1 = item2 => true
+      false
+    null partsMatch => return nil
+    argl1:= rest argl1; argl2 := rest argl2
+  argl1 or argl2 => nil
+  true
+ 
+removeAllClams() ==
+  for [fun,:.] in $clamList repeat
+    sayBrightly ['"Un-clamming function",'%b,fun,'%d]
+    SET(fun,eval INTERN STRCONC(STRINGIMAGE fun,'";"))
+@
+
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/clammed.boot.pamphlet b/src/interp/clammed.boot.pamphlet
new file mode 100644
index 00000000..d0689739
--- /dev/null
+++ b/src/interp/clammed.boot.pamphlet
@@ -0,0 +1,229 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp clammed.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Functions on $clamList
+
+-- These files are read in by the system so that they can be cached
+-- properly.  Otherwise, must read in compiled versions and then
+-- recompile these, resulting in wasted BPI space.
+
+canCoerceFrom(mr,m) ==
+  -- bind flag for recording/reporting instantiations
+  -- (see recordInstantiation)
+  $insideCanCoerceFrom: local := [mr,m]
+  canCoerceFrom0(mr,m)
+
+canCoerce(t1, t2) ==
+  val := canCoerce1(t1, t2) => val
+  t1 is ['Variable, :.] =>
+    newMode := getMinimalVarMode(t1, nil)
+    canCoerce1(t1, newMode) and canCoerce1(newMode, t2)
+  nil
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+coerceConvertMmSelection(funName,m1,m2) ==
+  -- calls selectMms with $Coerce=NIL and tests for required
+  -- target type. funName is either 'coerce or 'convert.
+  $declaredMode : local:= NIL
+  $reportBottomUpFlag : local:= NIL
+  l := selectMms1(funName,m2,[m1],[m1],NIL)
+  mmS := [x for x in l | x is [sig,:.] and hasCorrectTarget(m2,sig) and
+    isEqualOrSubDomain(m1, first rest rest sig)]
+  mmS and CAR mmS
+
+hasFileProperty(p,id,abbrev) == hasFilePropertyNoCache(p,id,abbrev)
+
+isValidType form ==
+  -- returns true IFF form is a type whose arguments satisfy the
+  --  predicate of the type constructor
+  -- Note that some forms are said to be invalid because they would
+  -- cause problems with the interpreter. Thus things like P P I
+  -- are not valid.
+  STRINGP form => true
+  IDENTP  form => false
+  form in '((Mode) (Domain) (SubDomain (Domain))) => true
+  form is ['Record,:selectors] =>
+    and/[isValidType type for [:.,type] in selectors]
+  form is ['Enumeration,:args] =>
+    null (and/[IDENTP x for x in args]) => false
+    ((# args) = (# REMDUP args)) => true
+    false
+  form is ['Mapping,:mapargs] =>
+    null mapargs => NIL
+    and/[isValidType type for type in mapargs]
+  form is ['Union,:args] =>
+    -- check for a tagged union
+    args and first args is [":",:.] =>
+      and/[isValidType type for [:.,type] in args]
+    null (and/[isValidType arg for arg in args]) => NIL
+    ((# args) = (# REMDUP args)) => true
+    sayKeyedMsg("S2IR0005",[form])
+    NIL
+
+  badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression))
+  form is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => NIL
+
+  form is [=$QuotientField,D] and not isPartialMode(D) and
+    ofCategory(D,'(Field)) => NIL
+  form is ['UnivariatePolynomial, x, ['UnivariatePolynomial, y, .]] and x=y =>
+    NIL
+  form = '(Complex (AlgebraicNumber)) => NIL
+  form is ['Expression, ['Kernel, . ]] => NIL
+  form is [op,:argl] =>
+    null constructor? op => nil
+    cosig := GETDATABASE(op, 'COSIG)
+    cosig and null rest cosig => -- niladic constructor
+        null argl => true
+        false
+    null (sig := getConstructorSignature form) => nil
+    [.,:cl] := sig
+    -- following line is needed to deal with mutable domains
+    if # cl ^= # argl and GENSYMP last argl then argl:= DROP(-1,argl)
+    # cl ^= # argl => nil
+    cl:= replaceSharps(cl,form)
+    and/[isValid for x in argl for c in cl] where isValid ==
+      categoryForm?(c) =>
+        evalCategory(x,MSUBSTQ(x,'_$,c)) and isValidType x
+      not GETDATABASE(opOf x,'CONSTRUCTORKIND) = 'domain
+
+selectMms1(op,tar,args1,args2,$Coerce) ==
+    -- for new compiler/old world compatibility, sometimes have to look
+    -- for operations given two names.
+
+    -- NEW COMPILER COMPATIBILITY ON
+
+    op = "^" or op = "**" =>
+        APPEND(selectMms2("**",tar,args1,args2,$Coerce),
+               selectMms2("^",tar,args1,args2,$Coerce))
+
+    -- NEW COMPILER COMPATIBILITY OFF
+
+    selectMms2(op,tar,args1,args2,$Coerce)
+
+
+resolveTT(t1,t2) ==
+  -- resolves two types
+  -- this symmetric resolve looks for a type t to which both t1 and t2
+  -- can be coerced
+  -- if resolveTT fails, the result will be NIL
+  startTimingProcess 'resolve
+  t1 := eqType t1
+  t2 := eqType t2
+  null (t := resolveTT1(t1,t2)) =>
+    stopTimingProcess 'resolve
+    nil
+  isValidType (t := eqType t) =>
+    stopTimingProcess 'resolve
+    t
+  stopTimingProcess 'resolve
+  nil
+
+isLegitimateMode(t,hasPolyMode,polyVarList) ==
+  -- returns true IFF t is a valid type.  i.e. if t has no repeated
+  --  variables, or two levels of Polynomial
+  null t        => true    -- a terminating condition with underDomainOf
+  t = $EmptyMode => true
+  STRINGP t     => true
+  ATOM t => false
+
+  badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression))
+  t is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => NIL
+
+  t is [=$QuotientField,D] and not isPartialMode(D) and
+    ofCategory(D,'(Field)) => NIL
+  t = '(Complex (AlgebraicNumber)) => NIL
+
+  t := equiType t
+  vl := isPolynomialMode t =>
+    if vl^='all then
+      var:= or/[(x in polyVarList => x;nil) for x in vl] => return false
+      listOfDuplicates vl => return false
+      polyVarList:= union(vl,polyVarList)
+    hasPolyMode => false
+    con := CAR t
+    poly? := (con = 'Polynomial or con = 'Expression)
+    isLegitimateMode(underDomainOf t,poly?,polyVarList)
+
+  constructor? first t =>
+    isLegitimateMode(underDomainOf t,hasPolyMode,polyVarList) => t
+  t is ['Mapping,:ml] =>
+    null ml => NIL
+    -- first arg is target, which can be Void
+    null isLegitimateMode(first ml,nil,nil) => NIL
+    for m in rest ml repeat
+      m = $Void =>
+        return NIL
+      null isLegitimateMode(m,nil,nil) => return NIL
+    true
+  t is ['Union,:ml] =>
+    -- check for tagged union
+    ml and first ml is [":",:.] => isLegitimateRecordOrTaggedUnion ml
+    null (and/[isLegitimateMode(m,nil,nil) for m in ml]) => NIL
+    ((# ml) = (# REMDUP ml)) => true
+    NIL
+  t is ['Record,:r] => isLegitimateRecordOrTaggedUnion r
+  t is ['Enumeration,:r] =>
+    null (and/[IDENTP x for x in r]) => false
+    ((# r) = (# REMDUP r)) => true
+    false
+  false
+
+underDomainOf t ==
+  t = $RationalNumber => $Integer
+  not PAIRP t => NIL
+  d := deconstructT t
+  1 = #d => NIL
+  u := getUnderModeOf(t) => u
+  last d
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/comp.lisp.pamphlet b/src/interp/comp.lisp.pamphlet
new file mode 100644
index 00000000..d140c62e
--- /dev/null
+++ b/src/interp/comp.lisp.pamphlet
@@ -0,0 +1,437 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/comp.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; NAME:    Compiler Utilities Package
+
+; PURPOSE: Comp is a modified version of Compile which is a preprocessor for
+;          calls to Lisp Compile.  It searches for variable assignments that use
+;          (SPADLET a b). It allows you to create local variables without
+;          declaring them local by moving them into a PROG variable list.
+;          This is not an ordinary SPADLET.  It looks and is used like a SETQ.
+;          This preprocessor then collects the uses and creates the PROG.
+;
+;          SPADLET is defined in Macro.Lisp.
+;
+;          Comp recognizes as new lambda types the forms ILAM, SPADSLAM, SLAM,
+;          and entries on $clamList.  These cache results.  ("Saving LAMbda".)
+;          If the function is called with EQUAL arguments, returns the previous
+;          result computed.
+;
+;          The package also causes traced things which are recompiled to
+;          become untraced.
+
+(in-package "BOOT")
+
+(export '(Comp FluidVars LocVars OptionList SLAM SPADSLAM ILAM FLUID))
+
+;;; Common Block section
+
+(defparameter FluidVars nil)
+(defparameter LocVars nil)
+; (defparameter OptionList nil) defined in nlib.lisp
+(defparameter SpecialVars nil)
+
+(defun |compAndDefine| (L)
+  (let ((*comp370-apply* (function print-and-eval-defun)))
+    (declare (special *comp370-apply*))
+    (COMP L)))
+
+(defun COMP (L) (MAPCAR #'COMP-2 (MAPCAN #'COMP-1 L)))
+
+;;(defun |compQuietly| (L)
+;;  (let (U CUROUTSTREAM)
+;;    (declare (special CUROUTSTREAM))
+;;    (ADDOPTIONS 'LISTING NULLOUTSTREAM)                     
+;;    (SETQ CUROUTSTREAM NULLOUTSTREAM)                       
+;;    (setq U (COMP L))
+;;    (setq OPTIONLIST (CDDR OPTIONLIST))
+;;    U))
+
+(defun |compQuietly| (fn)
+  (let ((*comp370-apply*
+	 (if |$InteractiveMode|
+	     (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun)
+	   #'print-defun))
+     ;; following creates a null outputstream if $InteractiveMode
+	(*standard-output*
+	 (if |$InteractiveMode| (make-broadcast-stream)
+	   *standard-output*)))
+    (COMP fn)))
+
+#-:CCL
+(defun |compileFileQuietly| (fn) 
+  (let (
+     ;; following creates a null outputstream if $InteractiveMode
+	(*standard-output*
+	 (if |$InteractiveMode| (make-broadcast-stream)
+	   *standard-output*)))
+    (COMPILE-FILE fn)))
+
+#+:CCL
+(defun |compileFileQuietly| (fn)
+  (let (
+     ;; following creates a null outputstream if $InteractiveMode
+     (*standard-output*
+       (if |$InteractiveMode| (make-broadcast-stream) *standard-output*)))
+     ;; The output-library is not opened before use unless set explicitly
+     (if (null output-library)
+         (|openOutputLibrary| 
+           (setq |$outputLibraryName|
+            (if (null |$outputLibraryName|)
+                (make-pathname :directory (get-current-directory)
+                               :name "user.lib")
+                (if (filep |$outputLibraryName|) (truename |$outputLibraryName|)
+                                                 |$outputLibraryName|)))))
+     (compile-lib-file fn)))
+
+;; The following are used mainly in setvars.boot
+(defun notEqualLibs (u v)
+  (if (string= u (library-name v)) (seq (close-library v) t) nil))
+
+(defun |dropInputLibrary| (lib) 
+  ;; Close any existing copies of this library on the input path
+ (setq input-libraries
+  (delete lib input-libraries :test #'notEqualLibs )))
+
+(defun |openOutputLibrary| (lib)
+  (|dropInputLibrary| lib)
+  (setq output-library (open-library lib 't))
+  (setq input-libraries (cons output-library input-libraries)) )
+
+(defun |addInputLibrary| (lib)
+  (|dropInputLibrary| lib)
+   (setq input-libraries (cons (open-library lib) input-libraries)) )
+
+
+
+;;(defun |compileQuietly| (L) (PROG (U CUROUTSTREAM)
+;;  ;; calls lisp system COMPILE or DEFINE                  
+;;  (ADDOPTIONS 'QUIET 'T)                                  
+;;  (ADDOPTIONS 'LISTING NULLOUTSTREAM)                     
+;;  (SETQ CUROUTSTREAM NULLOUTSTREAM)                       
+;;  (SETQ U (COND                                           
+;;    (|$compileDontDefineFunctions| (COMPILE L))           
+;;    ('T (DEFINE L))))                                     
+;;  (SETQ OPTIONLIST (CDDR OPTIONLIST))                     
+;;  (RETURN U)   ))                                       
+
+(defun |compileQuietly| (fn)
+  (let ((*comp370-apply*
+	 (if |$InteractiveMode|
+	     (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun)
+	   #'print-defun))
+     ;; following creates a null outputstream if $InteractiveMode
+	(*standard-output*
+	 (if |$InteractiveMode| (make-broadcast-stream)
+	   *standard-output*)))
+    (COMP370 fn)))
+
+(defun COMP-1 (X)
+  (let* ((FNAME (car X))
+	 ($FUNNAME FNAME)
+         ($FUNNAME_TAIL (LIST FNAME))
+	 (LAMEX (second X))
+	 ($closedfns nil))
+    (declare (special $FUNNAME $FUNNAME_TAIL $CLOSEDFNS))
+    (setq LAMEX (COMP-TRAN LAMEX))
+    (COMP-NEWNAM LAMEX)
+    (if (fboundp FNAME)
+	(format t "~&~%;;;     ***       ~S REDEFINED~%" FNAME))
+    (CONS (LIST FNAME LAMEX) $CLOSEDFNS)))
+
+(defun Comp-2 (args &aux name type argl bodyl junk)
+    (dsetq (NAME (TYPE ARGL . BODYL) . JUNK) args)
+    (cond (JUNK (MOAN (format nil "******pren error in (~S (~S ...) ...)" NAME TYPE)))
+          ((eq TYPE 'SLAM) (COMP-SLAM NAME ARGL BODYL))
+          ((LASSQ NAME |$clamList|) (|compClam| NAME ARGL BODYL |$clamList|))
+          ((eq TYPE 'SPADSLAM) (COMP-SPADSLAM NAME ARGL BODYL))
+          ((eq TYPE 'ILAM) (COMP-ILAM NAME ARGL BODYL))
+          ((setq BODYL (LIST NAME (CONS TYPE (CONS ARGL BODYL))))
+           (if |$PrettyPrint| (pprint bodyl))
+           (if (null $COMPILE) (SAY "No Compilation")
+               (COMP370 (LIST BODYL)))
+           NAME)))
+
+;; used to be called POSN - but that interfered with a CCL function
+(DEFUN POSN1 (X L) (position x l :test #'equal))
+
+(DEFUN COMP-ILAM (NAME ARGL BODYL)
+  (let* ((FARGL (NLIST (LENGTH ARGL) '(GENSYM)))
+         (BODYLP (SUBLISLIS FARGL ARGL BODYL)))
+        (MAKEPROP NAME 'ILAM T)
+        (SET NAME (CONS 'LAMBDA (CONS FARGL BODYLP)))
+        NAME))
+
+(DEFUN COMP-SPADSLAM (NAME ARGL BODYL)
+  (let* ((AL (INTERNL NAME ";AL"))
+         (AUXFN (INTERNL NAME ";"))
+         (G1 (GENSYM))
+         (G2 (GENSYM))
+         (U (COND ((NOT ARGL) (LIST NIL NIL (LIST AUXFN)))
+                  ((NOT (CDR ARGL))
+                   (LIST (LIST G1) (LIST '|devaluate| G1) (LIST AUXFN G1)))
+                  ((LIST G1
+                         (LIST '|devaluateList| G1)
+                         (LIST 'APPLY (LIST 'FUNCTION AUXFN) G1)))))
+         (ARG (first U))
+         (ARGTRAN (second U))
+         (APP (third U))
+         (LAMEX  `(lam ,ARG
+                       (let (,g2)
+                         (cond ,(COND (ARGL `((setq ,g2 (|assoc| ,argtran ,al))
+                                              (cdr ,g2)))
+                                      ((LIST AL)))
+                               ,(COND (ARGL
+                                       `(t(setq ,al(|cons5|(cons ,argtran
+                                                                 (setq ,g2 ,app))
+                                                           ,al))
+                                          ,g2))
+                                      (`(t (setq ,al ,app)))))))))
+    (setandfile AL NIL)
+    (setq U (LIST NAME LAMEX))
+    (if |$PrettyPrint| (PRETTYPRINT U))
+    (COMP370 (LIST U))
+    (setq U (LIST AUXFN (CONS 'LAMBDA (CONS ARGL BODYL))))
+    (COND (|$PrettyPrint| (PRETTYPRINT U)))
+    (COMP370 (LIST U))
+    NAME))
+
+(DEFUN COMP-SLAM (NAME ARGL BODYL)
+  (let* ((AL (INTERNL NAME ";AL"))
+         (AUXFN (INTERNL NAME ";"))
+         (G1 (GENSYM))
+         (G2 (GENSYM))
+         (U (COND ((NOT ARGL) `(nil (,auxfn)))
+                  ((NOT (CDR ARGL)) `((,g1)(,auxfn ,g1)))
+                  (`(,g1 (applx (function ,auxfn) ,g1)))))
+         (ARG (CAR U))
+         (APP (CADR U))
+         (LAMEX
+           (LIST 'LAM ARG
+                 (LIST 'PROG (LIST G2)
+                       (LIST 'RETURN
+                             (LIST 'COND
+                                   (COND (ARGL
+                                          `((setq ,G2 (|assoc| ,G1 ,AL))
+                                            (CDR ,G2)))
+                                         ((LIST AL)))
+                                   (COND (ARGL (LIST ''T `(setq ,G2 ,APP)
+                                                     (LIST 'SETQ AL
+                                                           `(CONS
+                                                              (CONS ,G1 ,G2) ,AL))
+                                                     G2))
+                                         ((LIST ''T `(setq ,AL ,APP))))))))))
+    (set AL NIL)
+    (setq U (LIST NAME LAMEX))
+    (if |$PrettyPrint| (PRETTYPRINT U))
+    (COMP370 (LIST U))
+    (setq U (LIST AUXFN (CONS 'LAMBDA (CONS ARGL BODYL))))
+    (if |$PrettyPrint| (PRETTYPRINT U))
+    (COMP370 (LIST U))
+    NAME))
+
+(DEFUN COMP-NEWNAM (X)
+  (let (y u)
+    (cond ((ATOM X) NIL)
+          ((ATOM (setq Y (CAR X)))
+          ;; (AND (IDENTP Y) (setq U (GET Y 'NEWNAM)) (RPLACA X U))
+           (AND (NOT (eq Y 'QUOTE)) (COMP-NEWNAM (CDR X)))
+	   (WHEN (and (EQ Y 'CLOSEDFN) (boundp '$closedfns))
+		 (SETQ U (MAKE-CLOSEDFN-NAME))
+		 (PUSH (list U (CADR X)) $closedfns)
+		 (rplaca x 'FUNCTION)
+		 (rplaca (cdr x) u)))
+          (t (COMP-NEWNAM (CAR X)) (COMP-NEWNAM (CDR X))))))
+
+(defun make-closedfn-name ()
+  (internl $FUNNAME "!" (STRINGIMAGE (LENGTH $CLOSEDFNS))))
+
+(DEFUN COMP-TRAN (X)
+  "SEXPR<FN. BODY> -> SEXPR"
+  (let ((X (COMP-EXPAND X)) FluidVars LocVars SpecialVars)
+    (COMP-TRAN-1 (CDDR X))
+    (setq X (list (first x) (second x)
+                  (if (and (null (cdddr x))
+                           (or (atom (third x))
+                               (eq (car (third x)) 'SEQ)
+			       (not (contained 'EXIT (third x)))))
+                      (caddr x)
+                      (cons 'SEQ (cddr x))))) ;catch naked EXITs
+    (let* ((FluidVars (REMDUP (NREVERSE FLUIDVARS)))
+           (LOCVARS (S- (S- (REMDUP (NREVERSE LOCVARS)) FLUIDVARS)
+                        (LISTOFATOMS (CADR X))))
+           (LVARS (append fluidvars LOCVARS)))
+      (let ((fluids (S+ fluidvars SpecialVars)))
+        (setq x
+              (if fluids
+                  `(,(first x) ,(second x)
+                    (prog ,lvars (declare (special . ,fluids))
+                      (return ,(third x))))
+                  (list (first x) (second x)
+		     (if (or lvars (contained 'RETURN (third x)))
+			 `(prog ,lvars (return ,(third x)))
+		         (third x)) )))))
+    (let ((fluids (S+ (comp-fluidize (second x)) SpecialVars)))
+      (if fluids
+          `(,(first x) ,(second x) (declare (special . ,fluids)) . ,(cddr x))
+          `(,(first x) ,(second x) . ,(cddr x))))))
+
+; Fluidize: Returns a list of fluid variables in X
+
+(DEFUN COMP-FLUIDIZE (X)
+  (COND ((AND (symbolp X)
+              (NE X '$)
+	      (NE X '$$)
+              (char= #\$ (ELT (PNAME X) 0))
+              (NOT (DIGITP (ELT (PNAME X) 1))))
+         x)
+        ((atom x) nil)
+        ((eq (first X) 'FLUID) (second X))
+        ((let ((a (comp-fluidize (first x)))
+               (b (comp-fluidize (rest x))))
+           (if a (cons a b) b)))))
+
+(DEFUN COMP\,FLUIDIZE  (X) (COND
+  ((AND (IDENTP X)
+        (NE X '$)
+        (NE X '$$)
+        (char= #\$ (ELT (PNAME X) 0)) (NULL (DIGITP (ELT (PNAME X) 1))))
+    (LIST 'FLUID X))
+  ((ATOM X) X)
+  ((EQ (QCAR X) 'FLUID) X)
+  ('T (PROG (A B)
+      (SETQ A (COMP\,FLUIDIZE (QCAR X)))
+      (SETQ B (COMP\,FLUIDIZE (QCDR X)))
+      (COND ((AND (EQ A (QCAR X)) (EQ B (QCDR X)))
+              (RETURN X))
+            ('T (RETURN (CONS A B)) )) )    )))
+
+; NOTE: It is potentially dangerous to assume every occurrence of element of
+; $COMP-MACROLIST is actually a macro call
+
+(defparameter $COMP-MACROLIST
+  '(COLLECT REPEAT SUCHTHATCLAUSE THETA COLLECTV COLLECTVEC
+	    THETA1 SPADREDUCE SPADDO)
+  "???")
+
+(DEFUN COMP-EXPAND (X)
+  (COND ((atom x) x)
+        ((eq (CAR X) 'QUOTE) X)
+        ((memq (CAR X) $COMP-MACROLIST)
+         (comp-expand (macroexpand-1 x)))
+        ((let ((a (comp-expand (car x)))
+               (b (comp-expand (cdr x))))
+           (if (AND (eq A (CAR X)) (eq B (CDR X)))
+               x
+               (CONS A B))))))
+
+(DEFUN COMP-TRAN-1 (X)
+  (let (u)
+    (cond ((ATOM X) NIL)
+          ((eq (setq U (CAR X)) 'QUOTE) NIL)
+          ((AND (eq U 'MAKEPROP) $TRACELETFLAG (RPLAC (CAR X) 'MAKEPROP-SAY) NIL)
+           NIL)
+           ; temporarily make TRACELET cause MAKEPROPs to be reported
+          ((MEMQ U '(DCQ RELET PRELET SPADLET SETQ LET) )
+           (COND ((NOT (eq U 'DCQ))
+                  (COND ((OR (AND (eq $NEWSPAD T) (NOT $BOOT))
+                             (MEMQ $FUNNAME |$traceletFunctions|))
+                         (NCONC X $FUNNAME_TAIL)
+                         (RPLACA X 'LETT))
+                        ; this devious trick (due to RDJ) is needed since the compile
+                        ; looks only at global variables in top-level environment;
+                        ; thus SPADLET cannot itself test for such flags (7/83).
+                        ($TRACELETFLAG (RPLACA X '/TRACE-LET))
+                        ((eq U 'LET) (RPLACA X 'SPADLET)))))
+           (COMP-TRAN-1 (CDDR X))
+           (AND (NOT (MEMQ U '(setq RELET)))
+                (COND ((IDENTP (CADR X)) (PUSHLOCVAR (CADR X)))
+                      ((EQCAR (CADR X) 'FLUID)
+                       (PUSH (CADADR X) FLUIDVARS)
+                       (RPLAC (CADR X) (CADADR X)))
+                      ((mapc #'pushlocvar (listofatoms (cadr x))) nil))))
+          ((and (symbolp u) (GET U 'ILAM))
+           (RPLACA X (EVAL U)) (COMP-TRAN-1 X))
+          ((MEMQ U '(PROG LAMBDA))
+           (PROG (NEWBINDINGS RES)
+                 (setq NEWBINDINGS NIL)
+                 (mapcar #'(lambda (Y)
+                             (COND ((NOT (MEMQ Y LOCVARS))
+                                    (setq LOCVARS (CONS Y LOCVARS))
+                                    (setq NEWBINDINGS (CONS Y NEWBINDINGS)))))
+                         (second x))
+                 (setq RES (COMP-TRAN-1 (CDDR X)))
+                 (setq locvars (remove-if #'(lambda (y) (memq y newbindings))
+                                          locvars))
+                 (RETURN (CONS U (CONS (CADR X) RES)) )) )
+          ((PROGN (COMP-TRAN-1 U) (COMP-TRAN-1 (CDR X)))))))
+
+(DEFUN PUSHLOCVAR (X)
+  (let (p)
+    (cond ((AND (NE X '$)
+                (char= #\$ (ELT (setq P (PNAME X)) 0))
+                (NOT (char= #\, (ELT P 1)))
+                (NOT (DIGITP (ELT P 1)))) NIL)
+          ((PUSH X LOCVARS)))))
+
+(defmacro PRELET (L) `(spadlet . ,L))
+(defmacro RELET (L) `(spadlet . ,L))
+(defmacro PRESET (L) `(spadlet . ,L))
+(defmacro RESET (L) `(spadlet . ,L))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/compat.boot.pamphlet b/src/interp/compat.boot.pamphlet
new file mode 100644
index 00000000..26e11810
--- /dev/null
+++ b/src/interp/compat.boot.pamphlet
@@ -0,0 +1,111 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp compat.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{readline}
+Reads a line, defaulting stream to *standard-input*
+
+This was commented out in the NAG version, probably due to the
+use of the saturn GUI interface but the real reason is uncertain.
+<<readline>>=
+READLINE(:s) ==
+  s => read_-line(first s)
+  read_-line(_*STANDARD_-INPUT_*)
+
+@
+\section{compat.boot}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- some functions that may need to be changed on different lisp
+-- systems.
+ 
+-- tests if x is an identifier beginning with #
+ 
+isSharpVar x ==
+  IDENTP x and SCHAR(SYMBOL_-NAME x,0) = char "#"
+ 
+isSharpVarWithNum x ==
+  null isSharpVar x => nil
+  (n := QCSIZE(p := PNAME x)) < 2 => nil
+  ok := true
+  c := 0
+  for i in 1..(n-1) while ok repeat
+    d := ELT(p,i)
+    ok := DIGITP d => c := 10*c + DIG2FIX d
+  if ok then c else nil
+ 
+-- RREAD which takes erroval to return if key is missing
+rread(key,rstream,errorval) ==
+  if IDENTP key then key := PNAME key
+  RREAD(key,rstream,errorval)	
+
+rwrite(key,val,stream) ==
+  if IDENTP key then key := PNAME key
+  RWRITE(key,val,stream) 
+
+-- issuing commands to the operating system
+ 
+system() ==
+  -- VM version of system command
+  string := getSystemCommandLine()
+  if string = '"" then string := '"sh"
+  sayMessage ["   Return Code = ", OBEY string]
+  terminateSystemCommand()
+
+editFile file ==
+  MEMQ(INTERN('"WIN32",FIND_-PACKAGE("KEYWORD")),_*FEATURES_*) => 
+    OBEY STRCONC('"notepad ", namestring pathname file)
+  OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring pathname file)
+
+makeBigFloat(mantissa,expon) ==
+  [$BFtag,mantissa,:expon]
+
+<<readline>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/compiler.boot.pamphlet b/src/interp/compiler.boot.pamphlet
new file mode 100644
index 00000000..a443a2af
--- /dev/null
+++ b/src/interp/compiler.boot.pamphlet
@@ -0,0 +1,1461 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/compiler.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{Bug fixes}
+
+The compMacro function does macro expansion during spad file compiles.
+If a macro occurs twice in the same file the macro expands infinitely
+causing a stack overflow. The reason for the infinite recursion is that
+the left hand side of the macro definition is expanded. Thus defining
+a macro:
+\begin{verbatim}
+name ==> 1
+\end{verbatim}
+will expand properly the first time. The second time it turns into:
+\begin{verbatim}
+1 ==> 1
+\end{verbatim}
+The original code read:
+\begin{verbatim}
+compMacro(form,m,e) ==
+  $macroIfTrue: local:= true
+  ["MDEF",lhs,signature,specialCases,rhs]:= form
+  rhs :=
+    rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
+    rhs is ['Join,:.]     => ['"-- the constructor category"]
+    rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
+    rhs is ['add,:.]      => ['"-- the constructor capsule"]
+    formatUnabbreviated rhs
+  sayBrightly ['"   processing macro definition",'%b,
+    :formatUnabbreviated lhs,'" ==> ",:rhs,'%d]
+  ["MDEF",lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
+  m=$EmptyMode or m=$NoValueMode =>
+    ["/throwAway",$NoValueMode,put(first lhs,"macro",rhs,e)]
+
+\end{verbatim}
+Juergen Weiss proposed the following fixed code. This does not expand
+the left hand side of the macro.
+<<compMacro>>=
+compMacro(form,m,e) ==
+  $macroIfTrue: local:= true
+  ["MDEF",lhs,signature,specialCases,rhs]:= form
+  prhs :=
+    rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
+    rhs is ['Join,:.]     => ['"-- the constructor category"]
+    rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
+    rhs is ['add,:.]      => ['"-- the constructor capsule"]
+    formatUnabbreviated rhs
+  sayBrightly ['"   processing macro definition",'%b,
+    :formatUnabbreviated lhs,'" ==> ",:prhs,'%d]
+  m=$EmptyMode or m=$NoValueMode =>
+    ["/throwAway",$NoValueMode,put(first lhs,"macro",macroExpand(rhs,e),e)]
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+compTopLevel(x,m,e) ==
+--+ signals that target is derived from lhs-- see NRTmakeSlot1Info
+  $NRTderivedTargetIfTrue: local := false
+  $killOptimizeIfTrue: local:= false
+  $forceAdd: local:= false
+  $compTimeSum: local := 0
+  $resolveTimeSum: local := 0
+  $packagesUsed: local := []
+  -- The next line allows the new compiler to be tested interactively.
+  compFun := if $newCompAtTopLevel=true then 'newComp else 'compOrCroak
+  x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
+    ([val,mode,.]:= FUNCALL(compFun,x,m,e); [val,mode,e])
+        --keep old environment after top level function defs
+  FUNCALL(compFun,x,m,e)
+
+compUniquely(x,m,e) ==
+  $compUniquelyIfTrue: local:= true
+  CATCH("compUniquely",comp(x,m,e))
+
+compOrCroak(x,m,e) == compOrCroak1(x,m,e,'comp)
+
+compOrCroak1(x,m,e,compFn) ==
+  fn(x,m,e,nil,nil,compFn) where
+    fn(x,m,e,$compStack,$compErrorMessageStack,compFn) ==
+      T:= CATCH("compOrCroak",FUNCALL(compFn,x,m,e)) => T
+      --stackAndThrow here and moan in UT LISP K does the appropriate THROW
+      $compStack:= [[x,m,e,$exitModeStack],:$compStack]
+      $s:=
+        compactify $compStack where
+          compactify al ==
+            null al => nil
+            LASSOC(first first al,rest al) => compactify rest al
+            [first al,:compactify rest al]
+      $level:= #$s
+      errorMessage:=
+        if $compErrorMessageStack
+           then first $compErrorMessageStack
+           else "unspecified error"
+      $scanIfTrue =>
+        stackSemanticError(errorMessage,mkErrorExpr $level)
+        ["failedCompilation",m,e]
+      displaySemanticErrors()
+      SAY("****** comp fails at level ",$level," with expression: ******")
+      displayComp $level
+      userError errorMessage
+
+tc() ==
+  $tripleCache:= nil
+  comp($x,$m,$f)
+
+
+comp(x,m,e) ==
+  T:= compNoStacking(x,m,e) => ($compStack:= nil; T)
+  $compStack:= [[x,m,e,$exitModeStack],:$compStack]
+  nil
+
+compNoStacking(x,m,e) ==
+  T:= comp2(x,m,e) =>
+    (m=$EmptyMode and T.mode=$Representation => [T.expr,"$",T.env]; T)
+         --$Representation is bound in compDefineFunctor, set by doIt
+         --this hack says that when something is undeclared, $ is
+         --preferred to the underlying representation -- RDJ 9/12/83
+  compNoStacking1(x,m,e,$compStack)
+
+compNoStacking1(x,m,e,$compStack) ==
+  u:= get(if m="$" then "Rep" else m,"value",e) =>
+    (T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil)
+  nil
+
+comp2(x,m,e) ==
+  [y,m',e]:= comp3(x,m,e) or return nil
+  if $LISPLIB and isDomainForm(x,e) then
+      if isFunctor x then
+         $packagesUsed:= insert([opOf x],$packagesUsed)
+  --if null atom y and isDomainForm(y,e) then e := addDomain(x,e)
+        --line commented out to prevent adding derived domain forms
+  m^=m' and ($bootStrapMode or isDomainForm(m',e))=>[y,m',addDomain(m',e)]
+        --isDomainForm test needed to prevent error while compiling Ring
+        --$bootStrapMode-test necessary for compiling Ring in $bootStrapMode
+  [y,m',e]
+
+comp3(x,m,$e) ==
+  --returns a Triple or %else nil to signalcan't do'
+  $e:= addDomain(m,$e)
+  e:= $e --for debugging purposes
+  m is ["Mapping",:.] => compWithMappingMode(x,m,e)
+  m is ["QUOTE",a] => (x=a => [x,m,$e]; nil)
+  STRINGP m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil)
+  ^x or atom x => compAtom(x,m,e)
+  op:= first x
+  getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
+  op is ["KAPPA",sig,varlist,body] => compApply(sig,varlist,body,rest x,m,e)
+  op=":" => compColon(x,m,e)
+  op="::" => compCoerce(x,m,e)
+  not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
+    compTypeOf(x,m,e)
+  t:= compExpression(x,m,e)
+  t is [x',m',e'] and not member(m',getDomainsInScope e') =>
+    [x',m',addDomain(m',e')]
+  t
+
+compTypeOf(x:=[op,:argl],m,e) ==
+  $insideCompTypeOf: local := true
+  newModemap:= EQSUBSTLIST(argl,$FormalMapVariableList,get(op,'modemap,e))
+  e:= put(op,'modemap,newModemap,e)
+  comp3(x,m,e)
+
+hasFormalMapVariable(x, vl) ==
+  $formalMapVariables: local := vl
+  null vl => false
+  ScanOrPairVec('hasone?,x) where
+     hasone? x == MEMQ(x,$formalMapVariables)
+
+compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
+  $killOptimizeIfTrue: local:= true
+  e:= oldE
+  isFunctor x =>
+    if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and
+      (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl]
+        ) and extendsCategoryForm("$",target,m') then return [x,m,e]
+  if STRINGP x then x:= INTERN x
+  for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
+    [.,.,e]:= compMakeDeclaration([":",v,m],$EmptyMode,e)
+  not null vl and not hasFormalMapVariable(x, vl) => return
+    [u,.,.] := comp([x,:vl],m',e) or return nil
+    extractCodeAndConstructTriple(u, m, oldE)
+  null vl and (t := comp([x], m', e)) => return
+    [u,.,.] := t
+    extractCodeAndConstructTriple(u, m, oldE)
+  [u,.,.]:= comp(x,m',e) or return nil
+  uu:=optimizeFunctionDef [nil,['LAMBDA,vl,u]]
+  --  At this point, we have a function that we would like to pass.
+  --  Unfortunately, it makes various free variable references outside
+  --  itself.  So we build a mini-vector that contains them all, and
+  --  pass this as the environment to our inner function.
+  $FUNNAME :local := nil
+  $FUNNAME__TAIL :local := [nil]
+  expandedFunction:=COMP_-TRAN CADR uu
+  frees:=FreeList(expandedFunction,vl,nil)
+    where FreeList(u,bound,free) ==
+      atom u =>
+        not IDENTP u => free
+        MEMQ(u,bound) => free
+        v:=ASSQ(u,free) =>
+          RPLACD(v,1+CDR v)
+          free
+        [[u,:1],:free]
+      op:=CAR u
+      MEMQ(op, '(QUOTE GO function)) => free
+      EQ(op,'LAMBDA) =>
+        bound:=UNIONQ(bound,CADR u)
+        for v in CDDR u repeat
+          free:=FreeList(v,bound,free)
+        free
+      EQ(op,'PROG) =>
+        bound:=UNIONQ(bound,CADR u)
+        for v in CDDR u | NOT ATOM v repeat
+          free:=FreeList(v,bound,free)
+        free
+      EQ(op,'SEQ) =>
+        for v in CDR u | NOT ATOM v repeat
+          free:=FreeList(v,bound,free)
+        free
+      EQ(op,'COND) =>
+        for v in CDR u repeat
+          for vv in v repeat
+            free:=FreeList(vv,bound,free)
+        free
+      if ATOM op then u:=CDR u  --Atomic functions aren't descended
+      for v in u repeat
+        free:=FreeList(v,bound,free)
+      free
+  expandedFunction :=
+            --One free can go by itself, more than one needs a vector
+         --An A-list name . number of times used
+    #frees = 0 => ['LAMBDA,[:vl,"$$"], :CDDR expandedFunction]
+    #frees = 1 =>
+      vec:=first first frees
+      ['LAMBDA,[:vl,vec], :CDDR expandedFunction]
+    scode:=nil
+    vec:=nil
+    slist:=nil
+    locals:=nil
+    i:=-1
+    for v in frees repeat
+      i:=i+1
+      vec:=[first v,:vec]
+      rest v = 1 =>
+                --Only used once
+        slist:=[[first v,($QuickCode => 'QREFELT;'ELT),"$$",i],:slist]
+      scode:=[['SETQ,first v,[($QuickCode => 'QREFELT;'ELT),"$$",i]],:scode]
+      locals:=[first v,:locals]
+    body:=
+      slist => SUBLISNQ(slist,CDDR expandedFunction)
+      CDDR expandedFunction
+    if locals then
+      if body is [['DECLARE,:.],:.] then
+        body:=[CAR body,['PROG,locals,:scode,['RETURN,['PROGN,:CDR body]]]]
+      else body:=[['PROG,locals,:scode,['RETURN,['PROGN,:body]]]]
+    vec:=['VECTOR,:NREVERSE vec]
+    ['LAMBDA,[:vl,"$$"],:body]
+  fname:=['CLOSEDFN,expandedFunction]
+         --Like QUOTE, but gets compiled
+  uu:=
+    frees => ['CONS,fname,vec]
+    ['LIST,fname]
+  [uu,m,oldE]
+
+extractCodeAndConstructTriple(u, m, oldE) ==
+  u is ["call",fn,:.] =>
+    if fn is ["applyFun",a] then fn := a
+    [fn,m,oldE]
+  [op,:.,env] := u
+  [["CONS",["function",op],env],m,oldE]
+
+compExpression(x,m,e) ==
+  $insideExpressionIfTrue: local:= true
+  atom first x and (fn:= GETL(first x,"SPECIAL")) =>
+    FUNCALL(fn,x,m,e)
+  compForm(x,m,e)
+
+compAtom(x,m,e) ==
+  T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
+  x="nil" =>
+    T:=
+      modeIsAggregateOf('List,m,e) is [.,R]=> compList(x,['List,R],e)
+      modeIsAggregateOf('Vector,m,e) is [.,R]=> compVector(x,['Vector,R],e)
+    T => convert(T,m)
+  t:=
+    isSymbol x =>
+      compSymbol(x,m,e) or return nil
+    m = $Expression and primitiveType x => [x,m,e]
+    STRINGP x => [x,x,e]
+    [x,primitiveType x or return nil,e]
+  convert(t,m)
+
+primitiveType x ==
+  x is nil => $EmptyMode
+  STRINGP x => $String
+  INTEGERP x =>
+    x=0 => $NonNegativeInteger
+    x>0 => $PositiveInteger
+    true => $NegativeInteger
+  FLOATP x => $DoubleFloat
+  nil
+
+compSymbol(s,m,e) ==
+  s="$NoValue" => ["$NoValue",$NoValueMode,e]
+  isFluid s => [s,getmode(s,e) or return nil,e]
+  s="true" => ['(QUOTE T),$Boolean,e]
+  s="false" => [false,$Boolean,e]
+  s=m or get(s,"isLiteral",e) => [["QUOTE",s],s,e]
+  v:= get(s,"value",e) =>
+--+
+    MEMQ(s,$functorLocalParameters) =>
+        NRTgetLocalIndex s
+        [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
+    [s,v.mode,e] --s has been SETQd
+  m':= getmode(s,e) =>
+    if not member(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
+      not isFunction(s,e) and null ($compForModeIfTrue=true) then errorRef s
+    [s,m',e] --s is a declared argument
+  MEMQ(s,$FormalMapVariableList) => stackMessage ["no mode found for",s]
+  m = $Expression or m = $Symbol => [['QUOTE,s],m,e]
+  not isFunction(s,e) => errorRef s
+
+convertOrCroak(T,m) ==
+  u:= convert(T,m) => u
+  userError ["CANNOT CONVERT: ",T.expr,"%l"," OF MODE: ",T.mode,"%l",
+    " TO MODE: ",m,"%l"]
+
+convert(T,m) ==
+  coerce(T,resolve(T.mode,m) or return nil)
+
+mkUnion(a,b) ==
+  b="$" and $Rep is ["Union",:l] => b
+  a is ["Union",:l] =>
+    b is ["Union",:l'] => ["Union",:setUnion(l,l')]
+    ["Union",:setUnion([b],l)]
+  b is ["Union",:l] => ["Union",:setUnion([a],l)]
+  ["Union",a,b]
+
+maxSuperType(m,e) ==
+  typ:= get(m,"SuperDomain",e) => maxSuperType(typ,e)
+  m
+
+hasType(x,e) ==
+  fn get(x,"condition",e) where
+    fn x ==
+      null x => nil
+      x is [["case",.,y],:.] => y
+      fn rest x
+
+compForm(form,m,e) ==
+  T:=
+    compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return
+      stackMessageIfNone ["cannot compile","%b",form,"%d"]
+  T
+
+compArgumentsAndTryAgain(form is [.,:argl],m,e) ==
+  -- used in case: f(g(x)) where f is in domain introduced by
+  -- comping g, e.g. for (ELT (ELT x a) b), environment can have no
+  -- modemap with selector b
+  form is ["elt",a,.] =>
+    ([.,.,e]:= comp(a,$EmptyMode,e) or return nil; compForm1(form,m,e))
+  u:= for x in argl repeat [.,.,e]:= comp(x,$EmptyMode,e) or return "failed"
+  u="failed" => nil
+  compForm1(form,m,e)
+
+outputComp(x,e) ==
+  u:=comp(['_:_:,x,$Expression],$Expression,e) => u
+  x is ['construct,:argl] =>
+    [['LIST,:[([.,.,e]:=outputComp(x,e)).expr for x in argl]],$Expression,e]
+  (v:= get(x,"value",e)) and (v.mode is ['Union,:l]) =>
+    [['coerceUn2E,x,v.mode],$Expression,e]
+  [x,$Expression,e]
+
+compForm1(form is [op,:argl],m,e) ==
+  $NumberOfArgsIfInteger: local:= #argl --see compElt
+  op="error" =>
+    [[op,:[([.,.,e]:=outputComp(x,e)).expr
+      for x in argl]],m,e]
+  op is ["elt",domain,op'] =>
+    domain="Lisp" =>
+      --op'='QUOTE and null rest argl => [first argl,m,e]
+      [[op',:[([.,.,e]:= compOrCroak(x,$EmptyMode,e)).expr for x in argl]],m,e]
+    domain=$Expression and op'="construct" => compExpressionList(argl,m,e)
+    (op'="COLLECT") and coerceable(domain,m,e) =>
+      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
+    -- Next clause added JHD 8/Feb/94: the clause after doesn't work
+    -- since addDomain refuses to add modemaps from Mapping
+    (domain is ['Mapping,:.]) and
+      (ans := compForm2([op',:argl],m,e:= augModemapsFromDomain1(domain,domain,e),
+        [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]]))             => ans
+
+    ans := compForm2([op',:argl],m,e:= addDomain(domain,e),
+      [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]])             => ans
+    (op'="construct") and coerceable(domain,m,e) =>
+      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
+    nil
+
+  e:= addDomain(m,e) --???unneccessary because of comp2's call???
+  (mmList:= getFormModemaps(form,e)) and (T:= compForm2(form,m,e,mmList)) => T
+  compToApply(op,argl,m,e)
+
+compExpressionList(argl,m,e) ==
+  Tl:= [[.,.,e]:= comp(x,$Expression,e) or return "failed" for x in argl]
+  Tl="failed" => nil
+  convert([["LIST",:[y.expr for y in Tl]],$Expression,e],m)
+
+compForm2(form is [op,:argl],m,e,modemapList) ==
+  sargl:= TAKE(# argl, $TriangleVariableList)
+  aList:= [[sa,:a] for a in argl for sa in sargl]
+  modemapList:= SUBLIS(aList,modemapList)
+  deleteList:=[]
+  newList := []
+  -- now delete any modemaps that are subsumed by something else, provided the conditions
+  -- are right (i.e. subsumer true whenever subsumee true)
+  for u in modemapList repeat
+    if u is [[dc,:.],[cond,["Subsumed",.,nsig]]] and
+       (v:=assoc([dc,:nsig],modemapList)) and v is [.,[ncond,:.]] then
+           deleteList:=[u,:deleteList]
+           if not PredImplies(ncond,cond) then
+             newList := [[CAR u,[cond,['ELT,dc,nil]]],:newList]
+  if deleteList then modemapList:=[u for u in modemapList | not MEMQ(u,deleteList)]
+  -- We can use MEMQ since deleteList was built out of members of modemapList
+  -- its important that subsumed ops (newList) be considered last
+  if newList then modemapList := append(modemapList,newList)
+  Tl:=
+    [[.,.,e]:= T
+      for x in argl while (isSimple x and (T:= compUniquely(x,$EmptyMode,e)))]
+  or/[x for x in Tl] =>
+    partialModeList:= [(x => x.mode; nil) for x in Tl]
+    compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) or
+      compForm3(form,m,e,modemapList)
+  compForm3(form,m,e,modemapList)
+
+compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) ==
+  mmList:= [mm for mm in modemapList | compFormMatch(mm,partialModeList)] =>
+    compForm3(form,m,e,mmList)
+
+compFormMatch(mm,partialModeList) ==
+  mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) where
+    match(a,b) ==
+      null b => true
+      null first b => match(rest a,rest b)
+      first a=first b and match(rest a,rest b)
+
+compForm3(form is [op,:argl],m,e,modemapList) ==
+  T:=
+    or/
+      [compFormWithModemap(form,m,e,first (mml:= ml))
+        for ml in tails modemapList]
+  $compUniquelyIfTrue =>
+    or/[compFormWithModemap(form,m,e,mm) for mm in rest mml] =>
+      THROW("compUniquely",nil)
+    T
+  T
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+getFormModemaps(form is [op,:argl],e) ==
+  op is ["elt",domain,op1] =>
+    [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]]
+  null atom op => nil
+  modemapList:= get(op,"modemap",e)
+  if op="elt"
+     then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil
+     else
+      if op="setelt" then modemapList:=
+        seteltModemapFilter(CADR argl,modemapList,e) or return nil
+  nargs:= #argl
+  finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList | #sig=nargs]
+  modemapList and null finalModemapList =>
+    stackMessage ["no modemap for","%b",op,"%d","with ",nargs," arguments"]
+  finalModemapList
+
+getConstructorFormOfMode(m,e) ==
+  isConstructorForm m => m
+  if m="$" then m:= "Rep"
+  atom m and get(m,"value",e) is [v,:.] =>
+    isConstructorForm v => v
+
+getConstructorMode(x,e) ==
+  atom x => (u:= getmode(x,e) or return nil; getConstructorFormOfMode(u,e))
+  x is ["elt",y,a] =>
+    u:= getConstructorMode(y,e)
+    u is ["Vector",R] or u is ["List",R] =>
+      isConstructorForm R => R
+    u is ["Record",:l] =>
+      (or/[p is [., =a,R] for p in l]) and isConstructorForm R => R
+
+isConstructorForm u == u is [name,:.] and member(name,'(Record Vector List))
+
+eltModemapFilter(name,mmList,e) ==
+  isConstantId(name,e) =>
+    l:= [mm for mm in mmList | mm is [[.,.,.,sel,:.],:.] and sel=name] => l
+            --there are elts with extra parameters
+    stackMessage ["selector variable: ",name," is undeclared and unbound"]
+    nil
+  mmList
+
+seteltModemapFilter(name,mmList,e) ==
+  isConstantId(name,e) =>
+    l:= [mm for (mm:= [[.,.,.,sel,:.],:.]) in mmList | sel=name] => l
+            --there are setelts with extra parameters
+    stackMessage ["selector variable: ",name," is undeclared and unbound"]
+    nil
+  mmList
+
+substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) ==
+  #dc^=#sig =>
+    keyedSystemError("S2GE0016",['"substituteIntoFunctorModemap",
+      '"Incompatible maps"])
+  #argl=#rest sig =>
+                        --here, we actually have a functor form
+    sig:= EQSUBSTLIST(argl,rest dc,sig)
+      --make new modemap, subst. actual for formal parametersinto modemap
+    Tl:= [[.,.,e]:= compOrCroak(a,m,e) for a in argl for m in rest sig]
+    substitutionList:= [[x,:T.expr] for x in rest dc for T in Tl]
+    [SUBLIS(substitutionList,modemap),e]
+  nil
+
+--% SPECIAL EVALUATION FUNCTIONS
+
+compConstructorCategory(x,m,e) == [x,resolve($Category,m),e]
+
+compString(x,m,e) == [x,resolve($StringCategory,m),e]
+
+--% SUBSET CATEGORY
+
+compSubsetCategory(["SubsetCategory",cat,R],m,e) ==
+  --1. put "Subsets" property on R to allow directly coercion to subset;
+  --   allow automatic coercion from subset to R but not vice versa
+  e:= put(R,"Subsets",[[$lhsOfColon,"isFalse"]],e)
+  --2. give the subset domain modemaps of cat plus 3 new functions
+  comp(["Join",cat,C'],m,e) where
+    C'() ==
+      substitute($lhsOfColon,"$",C'') where
+        C''() ==
+          ["CATEGORY","domain",["SIGNATURE","coerce",[R,"$"]],["SIGNATURE",
+            "lift",[R,"$"]],["SIGNATURE","reduce",["$",R]]]
+
+--% CONS
+
+compCons(form,m,e) == compCons1(form,m,e) or compForm(form,m,e)
+
+compCons1(["CONS",x,y],m,e) ==
+  [x,mx,e]:= comp(x,$EmptyMode,e) or return nil
+  null y => convert([["LIST",x],["List",mx],e],m)
+  yt:= [y,my,e]:= comp(y,$EmptyMode,e) or return nil
+  T:=
+    my is ["List",m',:.] =>
+      mr:= ["List",resolve(m',mx) or return nil]
+      yt':= convert(yt,mr) or return nil
+      [x,.,e]:= convert([x,mx,yt'.env],CADR mr) or return nil
+      yt'.expr is ["LIST",:.] => [["LIST",x,:rest yt'.expr],mr,e]
+      [["CONS",x,yt'.expr],mr,e]
+    [["CONS",x,y],["Pair",mx,my],e]
+  convert(T,m)
+
+--% SETQ
+
+compSetq(["LET",form,val],m,E) == compSetq1(form,val,m,E)
+
+compSetq1(form,val,m,E) ==
+  IDENTP form => setqSingle(form,val,m,E)
+  form is [":",x,y] =>
+    [.,.,E']:= compMakeDeclaration(form,$EmptyMode,E)
+    compSetq(["LET",x,val],m,E')
+  form is [op,:l] =>
+    op="CONS"  => setqMultiple(uncons form,val,m,E)
+    op="Tuple" => setqMultiple(l,val,m,E)
+    setqSetelt(form,val,m,E)
+
+compMakeDeclaration(x,m,e) ==
+  $insideExpressionIfTrue: local
+  compColon(x,m,e)
+
+setqSetelt([v,:s],val,m,E) ==
+  comp(["setelt",v,:s,val],m,E)
+
+setqSingle(id,val,m,E) ==
+  $insideSetqSingleIfTrue: local:= true
+    --used for comping domain forms within functions
+  currentProplist:= getProplist(id,E)
+  m'':=
+    get(id,'mode,E) or getmode(id,E) or
+       (if m=$NoValueMode then $EmptyMode else m)
+-- m'':= LASSOC("mode",currentProplist) or $EmptyMode
+       --for above line to work, line 3 of compNoStackingis required
+  T:=
+    eval or return nil where
+      eval() ==
+        T:= comp(val,m'',E) => T
+        not get(id,"mode",E) and m'' ^= (maxm'':=maxSuperType(m'',E)) and
+           (T:=comp(val,maxm'',E)) => T
+        (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) =>
+          assignError(val,T.mode,id,m'')
+  T':= [x,m',e']:= convert(T,m) or return nil
+  if $profileCompiler = true then
+    null IDENTP id => nil
+    key :=
+      MEMQ(id,rest $form) => 'arguments
+      'locals
+    profileRecord(key,id,T.mode)
+  newProplist:= consProplistOf(id,currentProplist,"value",removeEnv [val,:rest T])
+  e':= (PAIRP id => e'; addBinding(id,newProplist,e'))
+  if isDomainForm(val,e') then
+    if isDomainInScope(id,e') then
+      stackWarning ["domain valued variable","%b",id,"%d",
+        "has been reassigned within its scope"]
+    e':= augModemapsFromDomain1(id,val,e')
+      --all we do now is to allocate a slot number for lhs
+      --e.g. the LET form below will be changed by putInLocalDomainReferences
+--+
+  if (k:=NRTassocIndex(id))
+     then form:=['SETELT,"$",k,x]
+     else form:=
+         $QuickLet => ["LET",id,x]
+         ["LET",id,x,
+            (isDomainForm(x,e') => ['ELT,id,0];CAR outputComp(id,e'))]
+  [form,m',e']
+
+assignError(val,m',form,m) ==
+  message:=
+    val =>
+      ["CANNOT ASSIGN: ",val,"%l","   OF MODE: ",m',"%l","   TO: ",form,"%l",
+        "   OF MODE: ",m]
+    ["CANNOT ASSIGN: ",val,"%l","   TO: ",form,"%l","   OF MODE: ",m]
+  stackMessage message
+
+setqMultiple(nameList,val,m,e) ==
+  val is ["CONS",:.] and m=$NoValueMode =>
+    setqMultipleExplicit(nameList,uncons val,m,e)
+  val is ["Tuple",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
+  1 --create a gensym, %add to local environment, compile and assign rhs
+  g:= genVariable()
+  e:= addBinding(g,nil,e)
+  T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil
+  e:= put(g,"mode",m1,e)
+  [x,m',e]:= convert(T,m) or return nil
+  1.1 --exit if result is a list
+  m1 is ["List",D] =>
+    for y in nameList repeat e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
+    convert([["PROGN",x,["LET",nameList,g],g],m',e],m)
+  2 --verify that the #nameList = number of parts of right-hand-side
+  selectorModePairs:=
+                                                --list of modes
+    decompose(m1,#nameList,e) or return nil where
+      decompose(t,length,e) ==
+        t is ["Record",:l] => [[name,:mode] for [":",name,mode] in l]
+        comp(t,$EmptyMode,e) is [.,["RecordCategory",:l],.] =>
+          [[name,:mode] for [":",name,mode] in l]
+        stackMessage ["no multiple assigns to mode: ",t]
+  #nameList^=#selectorModePairs =>
+    stackMessage [val," must decompose into ",#nameList," components"]
+  3 --generate code; return
+  assignList:=
+    [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
+      for x in nameList for [y,:z] in selectorModePairs]
+  if assignList="failed" then NIL
+  else [MKPROGN [x,:assignList,g],m',e]
+
+setqMultipleExplicit(nameList,valList,m,e) ==
+  #nameList^=#valList =>
+    stackMessage ["Multiple assignment error; # of items in: ",nameList,
+      "must = # in: ",valList]
+  gensymList:= [genVariable() for name in nameList]
+  assignList:=
+             --should be fixed to declare genVar when possible
+    [[.,.,e]:= compSetq1(g,val,$EmptyMode,e) or return "failed"
+      for g in gensymList for val in valList]
+  assignList="failed" => nil
+  reAssignList:=
+    [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
+      for g in gensymList for name in nameList]
+  reAssignList="failed" => nil
+  [["PROGN",:[T.expr for T in assignList],:[T.expr for T in reAssignList]],
+    $NoValueMode, (LAST reAssignList).env]
+
+--% WHERE
+compWhere([.,form,:exprList],m,eInit) ==
+  $insideExpressionIfTrue: local:= false
+  $insideWhereIfTrue: local:= true
+  e:= eInit
+  u:=
+    for item in exprList repeat
+      [.,.,e]:= comp(item,$EmptyMode,e) or return "failed"
+  u="failed" => return nil
+  $insideWhereIfTrue:= false
+  [x,m,eAfter]:= comp(macroExpand(form,eBefore:= e),m,e) or return nil
+  eFinal:=
+    del:= deltaContour(eAfter,eBefore) => addContour(del,eInit)
+    eInit
+  [x,m,eFinal]
+
+compConstruct(form is ["construct",:l],m,e) ==
+  y:= modeIsAggregateOf("List",m,e) =>
+    T:= compList(l,["List",CADR y],e) => convert(T,m)
+    compForm(form,m,e)
+  y:= modeIsAggregateOf("Vector",m,e) =>
+    T:= compVector(l,["Vector",CADR y],e) => convert(T,m)
+    compForm(form,m,e)
+  T:= compForm(form,m,e) => T
+  for D in getDomainsInScope e repeat
+    (y:=modeIsAggregateOf("List",D,e)) and
+      (T:= compList(l,["List",CADR y],e)) and (T':= convert(T,m)) =>
+         return T'
+    (y:=modeIsAggregateOf("Vector",D,e)) and
+      (T:= compVector(l,["Vector",CADR y],e)) and (T':= convert(T,m)) =>
+         return T'
+
+compQuote(expr,m,e) == [expr,m,e]
+
+compList(l,m is ["List",mUnder],e) ==
+  null l => [NIL,m,e]
+  Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
+  Tl="failed" => nil
+  T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e]
+
+compVector(l,m is ["Vector",mUnder],e) ==
+  null l => [$EmptyVector,m,e]
+  Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
+  Tl="failed" => nil
+  [["VECTOR",:[T.expr for T in Tl]],m,e]
+
+--% MACROS
+<<compMacro>>
+--% SEQ
+
+compSeq(["SEQ",:l],m,e) == compSeq1(l,[m,:$exitModeStack],e)
+
+compSeq1(l,$exitModeStack,e) ==
+  $insideExpressionIfTrue: local
+  $finalEnv: local
+           --used in replaceExitEtc.
+  c:=
+    [([.,.,e]:=
+
+
+      --this used to be compOrCroak-- but changed so we can back out
+
+        ($insideExpressionIfTrue:= NIL; compSeqItem(x,$NoValueMode,e) or return
+          "failed")).expr for x in l]
+  if c="failed" then return nil
+  catchTag:= MKQ GENSYM()
+  form:= ["SEQ",:replaceExitEtc(c,catchTag,"TAGGEDexit",$exitModeStack.(0))]
+  [["CATCH",catchTag,form],$exitModeStack.(0),$finalEnv]
+
+compSeqItem(x,m,e) == comp(macroExpand(x,e),m,e)
+
+replaceExitEtc(x,tag,opFlag,opMode) ==
+  (fn(x,tag,opFlag,opMode); x) where
+    fn(x,tag,opFlag,opMode) ==
+      atom x => nil
+      x is ["QUOTE",:.] => nil
+      x is [ =opFlag,n,t] =>
+        rplac(CAADDR x,replaceExitEtc(CAADDR x,tag,opFlag,opMode))
+        n=0 =>
+          $finalEnv:=
+                  --bound in compSeq1 and compDefineCapsuleFunction
+            $finalEnv => intersectionEnvironment($finalEnv,t.env)
+            t.env
+          rplac(first x,"THROW")
+          rplac(CADR x,tag)
+          rplac(CADDR x,(convertOrCroak(t,opMode)).expr)
+        true => rplac(CADR x,CADR x-1)
+      x is [key,n,t] and MEMQ(key,'(TAGGEDreturn TAGGEDexit)) =>
+        rplac(first t,replaceExitEtc(first t,tag,opFlag,opMode))
+      replaceExitEtc(first x,tag,opFlag,opMode)
+      replaceExitEtc(rest x,tag,opFlag,opMode)
+
+--% SUCHTHAT
+compSuchthat([.,x,p],m,e) ==
+  [x',m',e]:= comp(x,m,e) or return nil
+  [p',.,e]:= comp(p,$Boolean,e) or return nil
+  e:= put(x',"condition",p',e)
+  [x',m',e]
+
+--% exit
+
+compExit(["exit",level,x],m,e) ==
+  index:= level-1
+  $exitModeStack = [] => comp(x,m,e)
+  m1:= $exitModeStack.index
+  [x',m',e']:=
+    u:=
+      comp(x,m1,e) or return
+        stackMessageIfNone ["cannot compile exit expression",x,"in mode",m1]
+  modifyModeStack(m',index)
+  [["TAGGEDexit",index,u],m,e]
+
+modifyModeStack(m,index) ==
+  $reportExitModeStack =>
+    SAY("exitModeStack: ",COPY $exitModeStack," ====> ",
+      ($exitModeStack.index:= resolve(m,$exitModeStack.index); $exitModeStack))
+  $exitModeStack.index:= resolve(m,$exitModeStack.index)
+
+compLeave(["leave",level,x],m,e) ==
+  index:= #$exitModeStack-1-$leaveLevelStack.(level-1)
+  [x',m',e']:= u:= comp(x,$exitModeStack.index,e) or return nil
+  modifyModeStack(m',index)
+  [["TAGGEDexit",index,u],m,e]
+
+--% return
+
+compReturn(["return",level,x],m,e) ==
+  null $exitModeStack =>
+    stackSemanticError(["the return before","%b",x,"%d","is unneccessary"],nil)
+    nil
+  level^=1 => userError '"multi-level returns not supported"
+  index:= MAX(0,#$exitModeStack-1)
+  if index>=0 then $returnMode:= resolve($exitModeStack.index,$returnMode)
+  [x',m',e']:= u:= comp(x,$returnMode,e) or return nil
+  if index>=0 then
+    $returnMode:= resolve(m',$returnMode)
+    modifyModeStack(m',index)
+  [["TAGGEDreturn",0,u],m,e']
+
+--% ELT
+
+compElt(form,m,E) ==
+  form isnt ["elt",aDomain,anOp] => compForm(form,m,E)
+  aDomain="Lisp" =>
+    [anOp',m,E] where anOp'() == (anOp=$Zero => 0; anOp=$One => 1; anOp)
+  isDomainForm(aDomain,E) =>
+    E:= addDomain(aDomain,E)
+    mmList:= getModemapListFromDomain(anOp,0,aDomain,E)
+    modemap:=
+      n:=#mmList
+      1=n => mmList.(0)
+      0=n =>
+        return
+          stackMessage ['"Operation ","%b",anOp,"%d",
+                         '"missing from domain: ", aDomain]
+      stackWarning ['"more than 1 modemap for: ",anOp,
+                  '" with dc=",aDomain,'" ===>"
+        ,mmList]
+      mmList.(0)
+    [sig,[pred,val]]:= modemap
+    #sig^=2 and ^val is ["elt",:.] => nil --what does the second clause do ????
+--+
+    val := genDeltaEntry [opOf anOp,:modemap]
+    convert([["call",val],first rest sig,E], m) --implies fn calls used to access constants
+  compForm(form,m,E)
+
+--% HAS
+
+compHas(pred is ["has",a,b],m,$e) ==
+  --b is (":",:.) => (.,.,E):= comp(b,$EmptyMode,E)
+  $e:= chaseInferences(pred,$e)
+  --pred':= ("has",a',b') := formatHas(pred)
+  predCode:= compHasFormat pred
+  coerce([predCode,$Boolean,$e],m)
+
+      --used in various other places to make the discrimination
+
+compHasFormat (pred is ["has",olda,b]) ==
+  argl := rest $form
+  formals := TAKE(#argl,$FormalMapVariableList)
+  a := SUBLISLIS(argl,formals,olda)
+  [a,:.] := comp(a,$EmptyMode,$e) or return nil
+  a := SUBLISLIS(formals,argl,a)
+  b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]]
+  b is ["SIGNATURE",op,sig] =>
+     ["HasSignature",a,
+       mkList [MKQ op,mkList [mkDomainConstructor type for type in sig]]]
+  isDomainForm(b,$EmptyEnvironment) => ["EQUAL",a,b]
+  ["HasCategory",a,mkDomainConstructor b]
+
+--% IF
+
+compIf(["IF",a,b,c],m,E) ==
+  [xa,ma,Ea,Einv]:= compBoolean(a,$Boolean,E) or return nil
+  [xb,mb,Eb]:= Tb:= compFromIf(b,m,Ea) or return nil
+  [xc,mc,Ec]:= Tc:= compFromIf(c,resolve(mb,m),Einv) or return nil
+  xb':= coerce(Tb,mc) or return nil
+  x:= ["IF",xa,quotify xb'.expr,quotify xc]
+  (returnEnv:= Env(xb'.env,Ec,xb'.expr,xc,E)) where
+    Env(bEnv,cEnv,b,c,E) ==
+      canReturn(b,0,0,true) =>
+        (canReturn(c,0,0,true) => intersectionEnvironment(bEnv,cEnv); bEnv)
+      canReturn(c,0,0,true) => cEnv
+      E
+  [x,mc,returnEnv]
+
+canReturn(expr,level,exitCount,ValueFlag) ==  --SPAD: exit and friends
+  atom expr => ValueFlag and level=exitCount
+  (op:= first expr)="QUOTE" => ValueFlag and level=exitCount
+  op="TAGGEDexit" =>
+    expr is [.,count,data] => canReturn(data.expr,level,count,count=level)
+  level=exitCount and not ValueFlag => nil
+  op="SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr]
+  op="TAGGEDreturn" => nil
+  op="CATCH" =>
+    [.,gs,data]:= expr
+    (findThrow(gs,data,level,exitCount,ValueFlag) => true) where
+      findThrow(gs,expr,level,exitCount,ValueFlag) ==
+        atom expr => nil
+        expr is ["THROW", =gs,data] => true
+            --this is pessimistic, but I know of no more accurate idea
+        expr is ["SEQ",:l] =>
+          or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
+        or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
+    canReturn(data,level,exitCount,ValueFlag)
+  op = "COND" =>
+    level = exitCount =>
+      or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
+    or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
+                for v in rest expr]
+  op="IF" =>
+    expr is [.,a,b,c]
+    if not canReturn(a,0,0,true) then
+      SAY "IF statement can not cause consequents to be executed"
+      pp expr
+    canReturn(a,level,exitCount,nil) or canReturn(b,level,exitCount,ValueFlag)
+      or canReturn(c,level,exitCount,ValueFlag)
+  --now we have an ordinary form
+  atom op => and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
+  op is ["XLAM",args,bods] =>
+    and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
+  systemErrorHere '"canReturn" --for the time being
+
+compBoolean(p,m,E) ==
+  [p',m,E]:= comp(p,m,E) or return nil
+  [p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
+
+getSuccessEnvironment(a,e) ==
+
+  -- the next four lines try to ensure that explicit special-case tests
+  --  prevent implicit ones from being generated
+  a is ["has",x,m] =>
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
+    e
+  a is ["is",id,m] =>
+    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
+         e:=put(id,"specialCase",m,e)
+         currentProplist:= getProplist(id,e)
+         [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
+         newProplist:= consProplistOf(id,currentProplist,"value",[m,:rest removeEnv T])
+         addBinding(id,newProplist,e)
+    e
+  a is ["case",x,m] and IDENTP x =>
+    put(x,"condition",[a,:get(x,"condition",e)],e)
+  e
+
+getInverseEnvironment(a,E) ==
+  atom a => E
+  [op,:argl]:= a
+-- the next five lines try to ensure that explicit special-case tests
+-- prevent implicit ones from being generated
+  op="has" =>
+    [x,m]:= argl
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
+    E
+  a is ["case",x,m] and IDENTP x =>
+           --the next two lines are necessary to get 3-branched Unions to work
+           -- old-style unions, that is
+    (get(x,"condition",E) is [["OR",:oldpred]]) and member(a,oldpred) =>
+      put(x,"condition",LIST MKPF(delete(a,oldpred),"OR"),E)
+    getUnionMode(x,E) is ["Union",:l]
+    l':= delete(m,l)
+    for u in l' repeat
+       if u is ['_:,=m,:.] then l':= delete(u,l')
+    newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
+    put(x,"condition",[newpred,:get(x,"condition",E)],E)
+  E
+
+getUnionMode(x,e) ==
+  m:=
+    atom x => getmode(x,e)
+    return nil
+  isUnionMode(m,e)
+
+isUnionMode(m,e) ==
+  m is ["Union",:.] => m
+  (m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => CADR m'
+  v:= get(if m="$" then "Rep" else m,"value",e) =>
+    (v.expr is ["Union",:.] => v.expr; nil)
+  nil
+
+compFromIf(a,m,E) ==
+  a="noBranch" => ["noBranch",m,E]
+  true => comp(a,m,E)
+
+quotify x == x
+
+compImport(["import",:doms],m,e) ==
+  for dom in doms repeat e:=addDomain(dom,e)
+  ["/throwAway",$NoValueMode,e]
+
+--Will the jerk who commented out these two functions please NOT do so
+--again.  These functions ARE needed, and case can NOT be done by
+--modemap alone.  The reason is that A case B requires to take A
+--evaluated, but B unevaluated.  Therefore a special function is
+--required.  You may have thought that you had tested this on "failed"
+--etc., but "failed" evaluates to it's own mode.  Try it on x case $
+--next time.
+--                An angry JHD - August 15th., 1984
+
+compCase(["case",x,m'],m,e) ==
+  e:= addDomain(m',e)
+  T:= compCase1(x,m',e) => coerce(T,m)
+  nil
+
+compCase1(x,m,e) ==
+  [x',m',e']:= comp(x,$EmptyMode,e) or return nil
+  u:=
+    [cexpr
+      for (modemap:= [map,cexpr]) in getModemapList("case",2,e') | map is [.,.,s,
+        t] and modeEqual(t,m) and modeEqual(s,m')] or return nil
+  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+  [["call",fn,x'],$Boolean,e']
+
+compColon([":",f,t],m,e) ==
+  $insideExpressionIfTrue=true => compColonInside(f,m,e,t)
+    --if inside an expression, ":" means to convert to m "on faith"
+  $lhsOfColon: local:= f
+  t:=
+    atom t and (t':= ASSOC(t,getDomainsInScope e)) => t'
+    isDomainForm(t,e) and not $insideCategoryIfTrue =>
+      (if not member(t,getDomainsInScope e) then e:= addDomain(t,e); t)
+    isDomainForm(t,e) or isCategoryForm(t,e) => t
+    t is ["Mapping",m',:r] => t
+    unknownTypeError t
+    t
+  f is ["LISTOF",:l] =>
+    (for x in l repeat T:= [.,.,e]:= compColon([":",x,t],m,e); T)
+  e:=
+    f is [op,:argl] and not (t is ["Mapping",:.]) =>
+      --for MPOLY--replace parameters by formal arguments: RDJ 3/83
+      newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList),
+        [(x is [":",a,m] => a; x) for x in argl],t)
+      signature:=
+        ["Mapping",newTarget,:
+          [(x is [":",a,m] => m;
+              getmode(x,e) or systemErrorHere '"compColonOld") for x in argl]]
+      put(op,"mode",signature,e)
+    put(f,"mode",t,e)
+  if not $bootStrapMode and $insideFunctorIfTrue and
+    makeCategoryForm(t,e) is [catform,e] then
+        e:= put(f,"value",[genSomeVariable(),t,$noEnv],e)
+  ["/throwAway",getmode(f,e),e]
+
+unknownTypeError name ==
+  name:=
+    name is [op,:.] => op
+    name
+  stackSemanticError(["%b",name,"%d","is not a known type"],nil)
+
+compPretend(["pretend",x,t],m,e) ==
+  e:= addDomain(t,e)
+  T:= comp(x,t,e) or comp(x,$EmptyMode,e) or return nil
+  if T.mode=t then warningMessage:= ["pretend",t," -- should replace by @"]
+  $newCompilerUnionFlag and opOf(T.mode) = 'Union and opOf(m) ^= 'Union =>
+     stackSemanticError(["cannot pretend ",x," of mode ",T.mode," to mode ",m],nil)
+  T:= [T.expr,t,T.env]
+  T':= coerce(T,m) => (if warningMessage then stackWarning warningMessage; T')
+
+compColonInside(x,m,e,m') ==
+  e:= addDomain(m',e)
+  T:= comp(x,$EmptyMode,e) or return nil
+  if (m'':=T.mode)=m' then warningMessage:= [":",m'," -- should replace by @"]
+  T:= [T.expr,m',T.env]
+  T':= coerce(T,m) =>
+    if warningMessage
+       then stackWarning warningMessage
+       else
+         $newCompilerUnionFlag and opOf(m'') = 'Union =>
+           return
+             stackSemanticError(["cannot pretend ",x," of mode ",m''," to mode ",m'],nil)
+
+         stackWarning [":",m'," -- should replace by pretend"]
+    T'
+
+compIs(["is",a,b],m,e) ==
+  [aval,am,e] := comp(a,$EmptyMode,e) or return nil
+  [bval,bm,e] := comp(b,$EmptyMode,e) or return nil
+  T:= [["domainEqual",aval,bval],$Boolean,e]
+  coerce(T,m)
+
+--%  Functions for coercion by the compiler
+
+--  The function coerce is used by the old compiler for coercions.
+--  The function coerceInteractive is used by the interpreter.
+--  One should always call the correct function, since the represent-
+--  ation of basic objects may not be the same.
+
+coerce(T,m) ==
+  $InteractiveMode =>
+    keyedSystemError("S2GE0016",['"coerce",
+      '"function coerce called from the interpreter."])
+  rplac(CADR T,substitute("$",$Rep,CADR T))
+  T':= coerceEasy(T,m) => T'
+  T':= coerceSubset(T,m) => T'
+  T':= coerceHard(T,m) => T'
+  T.expr = "$fromCoerceable$" or isSomeDomainVariable m => nil
+  stackMessage fn(T.expr,T.mode,m) where
+      -- if from from coerceable, this coerce was just a trial coercion
+      -- from compFormWithModemap to filter through the modemaps
+    fn(x,m1,m2) ==
+      ["Cannot coerce","%b",x,"%d","%l","      of mode","%b",m1,"%d","%l",
+        "      to mode","%b",m2,"%d"]
+
+coerceEasy(T,m) ==
+  m=$EmptyMode => T
+  m=$NoValueMode or m=$Void => [T.expr,m,T.env]
+  T.mode =m => T
+  T.mode =$NoValueMode => T
+  T.mode =$Exit =>
+      [["PROGN", T.expr, ["userError", '"Did not really exit."]],
+        m,T.env]
+  T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) =>
+    [T.expr,m,T.env]
+
+coerceSubset([x,m,e],m') ==
+  isSubset(m,m',e) or m="Rep" and m'="$" => [x,m',e]
+  m is ['SubDomain,=m',:.] => [x,m',e]
+  (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and
+     -- obviously this is temporary
+    eval substitute(x,"#1",pred) => [x,m',e]
+  (pred:= isSubset(m',maxSuperType(m,e),e)) and INTEGERP x -- again temporary
+    and eval substitute(x,"*",pred) =>
+      [x,m',e]
+  nil
+
+coerceHard(T,m) ==
+  $e: local:= T.env
+  m':= T.mode
+  STRINGP m' and modeEqual(m,$String) => [T.expr,m,$e]
+  modeEqual(m',m) or
+    (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and
+      modeEqual(m'',m) or
+        (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and
+          modeEqual(m'',m') => [T.expr,m,T.env]
+  STRINGP T.expr and T.expr=m => [T.expr,m,$e]
+  isCategoryForm(m,$e) =>
+      $bootStrapMode = true => [T.expr,m,$e]
+      extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e]
+      coerceExtraHard(T,m)
+  coerceExtraHard(T,m)
+
+coerceExtraHard(T is [x,m',e],m) ==
+  T':= autoCoerceByModemap(T,m) => T'
+  isUnionMode(m',e) is ["Union",:l] and (t:= hasType(x,e)) and
+    member(t,l) and (T':= autoCoerceByModemap(T,t)) and
+      (T'':= coerce(T',m)) => T''
+  m' is ['Record,:.] and m = $Expression =>
+      [['coerceRe2E,x,['ELT,COPY m',0]],m,e]
+  nil
+
+coerceable(m,m',e) ==
+  m=m' => m
+  -- must find any free parameters in m
+  sl:= pmatch(m',m) => SUBLIS(sl,m')
+  coerce(["$fromCoerceable$",m,e],m') => m'
+  nil
+
+coerceExit([x,m,e],m') ==
+  m':= resolve(m,m')
+  x':= replaceExitEtc(x,catchTag:= MKQ GENSYM(),"TAGGEDexit",$exitMode)
+  coerce([["CATCH",catchTag,x'],m,e],m')
+
+compAtSign(["@",x,m'],m,e) ==
+  e:= addDomain(m',e)
+  T:= comp(x,m',e) or return nil
+  coerce(T,m)
+
+compCoerce(["::",x,m'],m,e) ==
+  e:= addDomain(m',e)
+  T:= compCoerce1(x,m',e) => coerce(T,m)
+  getmode(m',e) is ["Mapping",["UnionCategory",:l]] =>
+    T:= (or/[compCoerce1(x,m1,e) for m1 in l]) or return nil
+    coerce([T.expr,m',T.env],m)
+
+compCoerce1(x,m',e) ==
+  T:= comp(x,m',e) or comp(x,$EmptyMode,e) or return nil
+  m1:=
+    STRINGP T.mode => $String
+    T.mode
+  m':=resolve(m1,m')
+  T:=[T.expr,m1,T.env]
+  T':= coerce(T,m') => T'
+  T':= coerceByModemap(T,m') => T'
+  pred:=isSubset(m',T.mode,e) =>
+    gg:=GENSYM()
+    pred:= substitute(gg,"*",pred)
+    code:= ['PROG1,['LET,gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
+    [code,m',T.env]
+
+coerceByModemap([x,m,e],m') ==
+--+ modified 6/27 for new runtime system
+  u:=
+    [modemap
+      for (modemap:= [map,cexpr]) in getModemapList("coerce",1,e) | map is [.,t,
+        s] and (modeEqual(t,m') or isSubset(t,m',e))
+           and (modeEqual(s,m) or isSubset(m,s,e))] or return nil
+
+  --mm:= (or/[mm for (mm:=[.,[cond,.]]) in u | cond=true]) or return nil
+  mm:=first u  -- patch for non-trival conditons
+  fn :=
+    genDeltaEntry ['coerce,:mm]
+  [["call",fn,x],m',e]
+
+autoCoerceByModemap([x,source,e],target) ==
+  u:=
+    [cexpr
+      for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e) | map is [
+        .,t,s] and modeEqual(t,target) and modeEqual(s,source)] or return nil
+  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+  source is ["Union",:l] and member(target,l) =>
+    (y:= get(x,"condition",e)) and (or/[u is ["case",., =target] for u in y])
+       => [["call",fn,x],target,e]
+    x="$fromCoerceable$" => nil
+    stackMessage ["cannot coerce: ",x,"%l","      of mode: ",source,"%l",
+      "      to: ",target," without a case statement"]
+  [["call",fn,x],target,e]
+
+--% Very old resolve
+-- should only be used in the old (preWATT) compiler
+
+resolve(din,dout) ==
+  din=$NoValueMode or dout=$NoValueMode => $NoValueMode
+  dout=$EmptyMode => din
+  din^=dout and (STRINGP din or STRINGP dout) =>
+    modeEqual(dout,$String) => dout
+    modeEqual(din,$String) => nil
+    mkUnion(din,dout)
+  dout
+
+modeEqual(x,y) ==
+  -- this is the late modeEqual
+  -- orders Unions
+  atom x or atom y => x=y
+  #x ^=#y => nil
+  x is ['Union,:xl] and y is ['Union,:yl] =>
+    for x1 in xl repeat
+      for y1 in yl repeat
+        modeEqual(x1,y1) =>
+          xl := delete(x1,xl)
+          yl := delete(y1,yl)
+          return nil
+    xl or yl => nil
+    true
+  (and/[modeEqual(u,v) for u in x for v in y])
+
+modeEqualSubst(m1,m,e) ==
+  modeEqual(m1, m) => true
+  atom m1 => get(m1,"value",e) is [m',:.] and modeEqual(m',m)
+  m1 is [op,:l1] and m is [=op,:l2]  and # l1 = # l2 =>
+-- Above length test inserted JHD 4:47 on 15/8/86
+-- Otherwise Records can get fouled up - consider expressIdealElt
+-- in the DEFAULTS package
+        and/[modeEqualSubst(xm1,xm2,e) for xm1 in l1 for xm2 in l2]
+  nil
+
+--% Things to support )compile
+
+compileSpad2Cmd args ==
+    -- This is the old compiler
+    -- Assume we entered from the "compiler" function, so args ^= nil
+    -- and is a file with file extension .spad.
+
+    path := pathname args
+    pathnameType path ^= '"spad" => throwKeyedMsg("S2IZ0082", nil)
+    ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+
+    SETQ(_/EDITFILE, path)
+    updateSourceFiles path
+    sayKeyedMsg("S2IZ0038",[namestring args])
+
+    optList :=  '( _
+      break _
+      constructor _
+      functions _
+      library _
+      lisp _
+      new _
+      old _
+      nobreak _
+      nolibrary _
+      noquiet _
+      vartrace _
+      quiet _
+      translate _
+        )
+
+    -- next three are for the OLD NEW compiler
+    -- should be unhooked
+
+    $newcompMode             : local := nil
+    $ncConverse              : local := nil
+    $newComp                 : local := nil
+
+    translateOldToNew        := nil
+
+    $scanIfTrue              : local := nil
+    $compileOnlyCertainItems : local := nil
+    $f                       : local := nil  -- compiler
+    $m                       : local := nil  --   variables
+
+    -- following are for )quick option for code generation
+    $QuickLet   : local := true
+    $QuickCode  : local := true
+
+    fun         := ['rq, 'lib]
+    constructor := nil
+    $sourceFileTypes : local := '("SPAD")
+
+    for opt in $options repeat
+        [optname,:optargs] := opt
+        fullopt := selectOptionLC(optname,optList,nil)
+
+        fullopt = 'new         => error "Internal error: compileSpad2Cmd got )new"
+        fullopt = 'old         => NIL     -- no opt
+        fullopt = 'translate   => translateOldToNew := true
+
+        fullopt = 'library     => fun.1 := 'lib
+        fullopt = 'nolibrary   => fun.1 := 'nolib
+
+        -- Ignore quiet/nonquiet if "constructor" is given.
+        fullopt = 'quiet       => if fun.0 ^= 'c then fun.0 := 'rq
+        fullopt = 'noquiet     => if fun.0 ^= 'c then fun.0 := 'rf
+        fullopt = 'nobreak     => $scanIfTrue := true
+        fullopt = 'break       => $scanIfTrue := nil
+        fullopt = 'vartrace      =>
+          $QuickLet  := false
+        fullopt = 'lisp        =>
+          throwKeyedMsg("S2IZ0036",['")lisp"])
+        fullopt = 'functions   =>
+            null optargs =>
+              throwKeyedMsg("S2IZ0037",['")functions"])
+            $compileOnlyCertainItems := optargs
+        fullopt = 'constructor =>
+            null optargs =>
+              throwKeyedMsg("S2IZ0037",['")constructor"])
+            fun.0       := 'c
+            constructor := [unabbrev o for o in optargs]
+        throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+
+    $InteractiveMode : local := nil
+    if translateOldToNew then
+	oldParserAutoloadOnceTrigger()
+        browserAutoloadOnceTrigger()
+        spad2AsTranslatorAutoloadOnceTrigger()
+        sayKeyedMsg("S2IZ0085", nil)
+        convertSpadToAsFile path
+    else if $compileOnlyCertainItems then
+        null constructor => sayKeyedMsg("S2IZ0040",NIL)
+        compilerDoitWithScreenedLisplib(constructor, fun)
+    else
+        compilerDoit(constructor, fun)
+    extendLocalLibdb $newConlist
+    terminateSystemCommand()
+    spadPrompt()
+
+convertSpadToAsFile path ==
+    -- can assume path has type = .spad
+    $globalMacroStack : local := nil       -- for spad -> as translator
+    $abbreviationStack: local := nil       -- for spad -> as translator
+    $macrosAlreadyPrinted: local := nil    -- for spad -> as translator
+    SETQ($badStack, nil)                   --ditto  TEMP to check for bad code
+    $newPaths: local := true               --ditto  TEMP
+    $abbreviationsAlreadyPrinted: local := nil    -- for spad -> as translator
+    $convertingSpadFile : local := true
+    $options: local := '((nolib))      -- translator shouldn't create nrlibs
+    SETQ(HT,MAKE_-HASHTABLE 'UEQUAL)
+
+    newName := fnameMake(pathnameDirectory path, pathnameName path, '"as")
+    canDoIt := true
+    if not fnameWritable? newName then
+        sayKeyedMsg("S2IZ0086", [NAMESTRING newName])
+        newName := fnameMake('".", pathnameName path, '"as")
+        if not fnameWritable? newName then
+            sayKeyedMsg("S2IZ0087", [NAMESTRING newName])
+            canDoIt := false
+    not canDoIt => 'failure
+
+    sayKeyedMsg("S2IZ0088", [NAMESTRING newName])
+
+    $outStream :local := MAKE_-OUTSTREAM newName
+    markSay('"#include _"axiom.as_"")
+    markTerpri()
+    CATCH("SPAD__READER",compiler [path])
+    SHUT $outStream
+    mkCheck()
+    'done
+
+compilerDoit(constructor, fun) ==
+    $byConstructors : local := []
+    $constructorsSeen : local := []
+    fun = ['rf, 'lib]   => _/RQ_,LIB()    -- Ignore "noquiet".
+    fun = ['rf, 'nolib] => _/RF()
+    fun = ['rq, 'lib]   => _/RQ_,LIB()
+    fun = ['rq, 'nolib] => _/RQ()
+    fun = ['c,  'lib]   =>
+      $byConstructors := [opOf x for x in constructor]
+      _/RQ_,LIB()
+      for ii in $byConstructors repeat
+        null member(ii,$constructorsSeen) =>
+          sayBrightly ['">>> Warning ",'%b,ii,'%d,'" was not found"]
+
+compilerDoitWithScreenedLisplib(constructor, fun) ==
+    EMBED('RWRITE,
+          '(LAMBDA (KEY VALUE STREAM)
+                   (COND ((AND (EQ STREAM $libFile)
+                               (NOT (MEMBER KEY $saveableItems)))
+                          VALUE)
+                         ((NOT NIL)
+                          (RWRITE KEY VALUE STREAM)))) )
+    UNWIND_-PROTECT(compilerDoit(constructor,fun),
+                   SEQ(UNEMBED 'RWRITE))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/compress.boot.pamphlet b/src/interp/compress.boot.pamphlet
new file mode 100644
index 00000000..ddf74136
--- /dev/null
+++ b/src/interp/compress.boot.pamphlet
@@ -0,0 +1,89 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp compress.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- This one is not currently in general use, but can be applied
+-- to various situations are required
+ 
+minimalise x ==
+  $hash:local:=MAKE_-HASHTABLE 'UEQUAL
+  min x where
+    min x ==
+      y:=HGET($hash,x)
+      y => y
+      PAIRP x =>
+        x = '(QUOTE T) => '(QUOTE T)
+        -- copes with a particular Lucid-ism, God knows why
+        -- This circular way of doing things is an attempt to deal with Lucid
+        -- Who may place quoted cells in read-only memory
+        z:=min CAR x
+        if not EQ(z,CAR x) then RPLACA(x,z)
+        z:=min CDR x
+        if not EQ(z,CDR x) then RPLACD(x,z)
+        HashCheck x
+      REFVECP x =>
+        for i in 0..MAXINDEX x repeat
+          x.i:=min (x.i)
+        HashCheck x
+      STRINGP x => HashCheck x
+      x
+    HashCheck x ==
+      y:=HGET($hash,x)
+      y => y
+      HPUT($hash,x,x)
+      x
+  x
+ 
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/construc.lisp.pamphlet b/src/interp/construc.lisp.pamphlet
new file mode 100644
index 00000000..51ebf1c6
--- /dev/null
+++ b/src/interp/construc.lisp.pamphlet
@@ -0,0 +1,861 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp construc.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+ the old compiler splits source files on a domain by domain basis
+
+ the new compiler compiles all of the domains in a file together into a
+ single output file
+
+ in order to converge these two approaches nrlibs are being combined on
+ a file basis rather than split on a domain basis. this change should be
+ transparent to all code that properly accesses the files.
+
+ INTERP.EXPOSED will be enhanced to contain the source file name of
+ the domain. thus, instead of:
+    INT                             Integer
+ it will be:
+    INT   integer                   Integer
+
+ which would mean that the library that contains INT would be integer.NRLIB
+ by using this mechanism we can continue to use the old libraries 
+ since each entry would now contain:
+    INT   INT                       Integer
+ which would mean that the library that contains the domain INT is INT.NRLIB
+
+ old file formats for nrlibs:
+
+ first sexpr is integer specifying the byte position of the index of the file
+ next n sexprs are information in the nrlib
+ last sexpr is an alist (pointed at by the first number in the file) which
+ contains triples. e.g. (("slot1info" 0 2550)...)
+ each triple consists of a string, a zero, and an byte offset into the file
+ of the information requested e.g. slot1info starts at byte 2550
+
+ new file formats for libs:
+
+ first sexpr is either an integer (in which case this is exactly an old nrlib
+       --- or ---
+ first sexpr is an alist of the form:
+ ((abbreviation . index) ...)
+ where each abbreviation is the abbreviation of the domain name and each
+ index is a pointer to the triples alist
+
+ so, for example, integer.spad contains 5 domains:
+  INTSLPE, INT, NNI, PI and ROMAN
+ previously INT.NRLIB/index.KAF contained:
+ 2550  
+ (sexpr1...) 
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45))
+ and the individual index.KAF files were similar for the other 4 domains.
+
+ under the new scheme integer.nrlib/index.KAF would contain:
+ ((INTSLPE . 2000) (INT . 4000) (NNI . 6000) (PI . 8000) (ROMAN . 10000))
+ (sexpr1...)       --- info for INTSLPE
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45))
+ (sexpr1...)       --- info for INT
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 2800) ("sexpr2" 0 2900) ("sexpr3 0 3000))
+ (sexpr1...)       --- info for NNI
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 4100) ("sexpr2" 0 4200) ("sexpr3 0 4300))
+ (sexpr1...)       --- info for PI
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 6100) ("sexpr2" 0 6200) ("sexpr3 0 6300))
+ (sexpr1...)       --- info for ROMAN
+ (sexpr2....) 
+ (sexpr3...) 
+ (("sexpr1" 0 8100) ("sexpr2" 0 8200) ("sexpr3 0 8300))
+
+ when an NRLIB is opened currently the position information is first
+ read into the libstream-indextable slot, then this information is
+ overwritten by the index table itself.
+
+ we need the name of the NRLIB passed down to the low level functions
+ so they can open the new NRLIB format and perform the correct file
+ position operation. once the NRLIB is open it is only referenced
+ within one constructor so we can lose the master index table. 
+\end{verbatim}
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+; this is a function that expects to be called with a list of old .NRLIB
+; names and a string of the new .NRLIB name. e.g.
+; (mergelib '(INT NNI PI ROMAN INTSLPE) "integer")
+
+(defun mergelibs (innames outname)
+ "each .NRLIB in the inname list is merged into outname.NRLIB"
+ (labels (
+  (libname (name) (concatenate 'string (string name) ".NRLIB"))
+  (indexname (name) (concatenate 'string (string name) ".NRLIB/index.KAF"))
+  (lspname (name) (concatenate 'string (string name) ".NRLIB/code.lsp"))
+  (fullname (name)
+    (concatenate 'string
+     $spadroot "/../../int/algebra/" (string name) ".NRLIB/index.KAF"))
+  (fullcode (name)
+   (concatenate 'string $spadroot "/../../int/algebra/" (string name) ".NRLIB/code.lsp")))
+ (let (masterindex blanks index newindex (space (* 22 (length innames))))
+ (setq newindex space)
+ (system::system (concatenate 'string "rm -r " (libname outname)))
+ (system::system (concatenate 'string "mkdir " (libname outname)))
+ (with-open-file (out (indexname outname) :direction :output)
+  (setq blanks (make-string space :initial-element #\ ))
+  (write  blanks :stream out)       ; reserve space for the masterindex
+  (finish-output out)
+  (dolist (inname innames)
+   (when (probe-file (fullname inname))
+   (with-open-file (in (fullname inname))
+    (let (alist pos)
+     (setq index (read in))
+     (file-position in index)
+     (setq alist (read in))
+     (dolist (ptr alist)
+      (when (setq pos (third ptr))
+       (file-position in pos)
+       (setf (third ptr) (file-position out))
+       (print (read in) out)
+       (finish-output out)))
+     (finish-output out)
+     (push (cons inname (file-position out)) masterindex)
+     (write alist :stream out :level nil :length nil :escape t)))))
+  (file-position out 0)
+  (print masterindex out))
+  (dolist (inname innames)
+   (format t "cat ~a >>~a~%" (fullcode inname) (lspname outname))
+   (system::system 
+    (format nil "cat ~a >>~a" (fullcode inname) (lspname outname)))))))
+
+
+(defun |pathname| (p)
+ (cond
+  ((null p) p) 
+  ((pathnamep p) p) 
+  ((null (pairp p)) (pathname p)) 
+  ('else 
+   (when (> (length p) 2) 
+      (setq p (list (mergelib (first p)) (second p))))
+   (apply (function make-filename) p))))
+
+(defun mergelib (x) 
+ (declare (special $mergelib))
+ (let (result)
+  (setq result (assoc x $mergelib))
+  (if result
+   (cdr result)
+   x)))
+
+
+; from lisplib.boot
+(defun |readLib1| (fn ft fm)
+  (|readLibPathFast| (|pathname| (list fn ft fm)) fn))
+
+(defun |readLibPathFast| (p &optional fn)
+ (rdefiostream (list (cons 'file p) '(mode . input)) nil fn))
+
+
+(in-package "VMLISP")
+
+; from nlib.lisp
+(defun vmlisp::get-index-table-from-stream (stream &optional abbrev)
+ (let (pos)
+  (file-position stream 0)
+  (setq pos (read stream))
+  (cond 
+   ((numberp pos)
+     (file-position stream pos)
+     (read stream))
+   ((consp pos)
+     (setq pos (cdr (assoc abbrev pos)))
+     (file-position stream pos)
+     (read stream))
+   ('else pos))))
+
+(defun vmlisp::loadvol (&rest filearg)
+  (cond ((typep (car filearg) 'libstream)
+	 (load (concat (libstream-dirname (car filearg)) "/code")))
+	(t 
+          (setq filearg (make-input-filename (boot::mergelib filearg) 'LISPLIB))
+	  (if (vmlisp::library-file filearg)
+	      (load (concat filearg "/code"))
+	    (load filearg)))))
+
+; from nlib.lisp
+;; (RDEFIOSTREAM ((MODE . IO) (FILE fn ft dir))) IO is I,O,INPUT,OUTPUT
+(defun vmlisp::rdefiostream
+              (options &optional (missing-file-error-flag t) abbrev)
+  (let ((mode (cdr (assoc 'mode options)))
+	(file (assoc 'file options))
+	(stream nil)
+	(fullname nil)
+	(indextable nil))
+        (cond ((equal (elt (string mode) 0) #\I)
+	       (setq fullname (make-input-filename (cdr file) 'LISPLIB))
+	       (setq stream (vmlisp::get-input-index-stream fullname))
+               (if (null stream)
+		   (if missing-file-error-flag
+		       (ERROR (format nil "Library ~s doesn't exist"
+			      (make-filename (cdr file) 'LISPLIB)))
+		     NIL)
+               (make-libstream :mode 'input  :dirname fullname
+                   :indextable (vmlisp::get-index-table-from-stream stream abbrev)
+                   :indexstream stream)))
+              ((equal (elt (string mode) 0) #\O)
+	       (setq fullname (make-full-namestring (cdr file) 'LISPLIB))
+	       (case (directory? fullname)
+		     (-1 (makedir fullname))
+		     (0 (error (format nil "~s is an existing file, not a library" fullname)))
+		     (otherwise))
+	       (multiple-value-setq (stream indextable) (get-io-index-stream fullname))
+	       (make-libstream :mode 'output  :dirname fullname
+			       :indextable indextable
+			       :indexstream stream ))
+              ('t  (ERROR "Unknown MODE")))))
+
+(in-package "BOOT")
+
+; from lisplib.boot
+(defun |readLibPathFast| (p &optional abbrev)
+  (rdefiostream (list (list 'file p) '(mode . input)) nil abbrev))
+
+ 
+; from lisplib.boot
+(defun |hasFilePropertyNoCache| (p id &optional abbrev)
+ (let (fnstream result)
+  (when (eq id '|constructorModemap|)(format t "~a (~a) has ~a~%" p abbrev id))
+  (setq fnstream (|readLibPathFast| p abbrev))
+  (when fnstream
+   (setq result (|rread| id fnstream nil))
+   (rshut fnstream)
+   result)))
+
+
+
+(defun |loadLibNoUpdate| (cname libName)
+ (let (fullLibName libDir kind)
+    (setq fullLibName (make-input-filename (mergelib libName) |$spadLibFT|))
+    (setq libDir (directory-namestring fullLibName)) 
+    (setq kind (GETDATABASE cname 'CONSTRUCTORKIND)) 
+    (when |$printLoadMsgs| 
+     (|sayKeyedMsg| 'S2IL0002 (list (|namestring| fullLibName) kind cname)))
+    (load (concatenate 'string libDir (mergelib libName)))
+    (|clearConstructorCache| cname) 
+    (when (get cname 'loaded)
+      (|unInstantiate| 
+       (cons cname
+         (mapcar '|getConstructorUnabbreviation| 
+          (|dependentClosure| (list cname))))))
+    (|installConstructor| cname kind) 
+    (makeprop libName 'loaded fullLibName) 
+    (when |$InteractiveMode| (setq |$CategoryFrame| (list (list nil))))
+    (|stopTimingProcess| '|load|)
+    t))
+
+
+; this is a program which, given the path to the source file INTERP.EXPOSED and
+; a path to the old style index.KAF files, will create a new interp.exposed
+; in the current directory such that each library line has the source file
+; name appended to the line. this is a useful one-time function for 
+; converting from old style INTERP.EXPOSED to new style interp.exposed
+
+(defun make-interp (src int)
+ (labels (
+  (FINDSRC (libname)
+   "return a string name of the source file given the library file
+    name (eg PI) as a string"
+   (let (kaffile index alist result)
+    (setq kaffile 
+     (concatenate 'string int "/" libname ".NRLIB/index.KAF"))
+    (if (probe-file kaffile)
+     (with-open-file (kaf kaffile)
+      (setq index (read kaf))
+      (file-position kaf index)
+      (setq alist (read kaf))
+     (setq index (third (assoc "sourceFile" alist :test #'string=)))
+      (file-position kaf index)
+     (setq result (pathname-name (pathname (read kaf index)))))
+     (format t "~a does not exist~%" kaffile))
+    result)))
+ (let (expr)
+  (with-open-file (out "interp.exposed" :direction :output)
+  (with-open-file (in (concatenate 'string src "/INTERP.EXPOSED"))
+   (catch 'eof
+    (loop
+     (setq expr (read-line in nil 'eof))
+     (when (eq expr 'eof) (throw 'eof nil))
+     (if
+      (and
+       (> (length expr) 58)
+       (char= (schar expr 0) #\space) 
+       (not (char= (schar expr 8) #\space)))
+      (format out "~66a ~a~%" expr 
+         (findsrc (string-right-trim '(#\space) (subseq expr 58)))) 
+      (format out "~a~%" expr)))))))))   
+
+
+; mergeall is a utility that will scan all of the .spad files and copy
+; all of the resulting old .NRLIBs into the correct new .NRLIBs.
+; one complication is that category constructors may not have old .NRLIBs
+(defun mergeall (src)
+ (labels (
+  (SRCSCAN ()
+   (let (spads)
+    (system:chdir src)
+    (setq spads (directory "*.spad"))
+    (dolist (spad spads) (srcabbrevs spad))
+    nil))
+  (SRCABBREVS (sourcefile)
+   (let (expr names abbrev point mark newmark)
+    (catch 'done
+     (with-open-file (in sourcefile)
+      (loop
+       (setq expr (read-line in nil 'done))
+       (when (eq expr 'done) (throw 'done nil))
+       (when (and (> (length expr) 4)
+             (string= ")abb" (subseq expr 0 4)))
+        (setq point (position #\space expr :from-end t :test #'char=))
+        (setq mark
+         (position #\space 
+          (string-right-trim '(#\space)
+           (subseq expr 0 (1- point))) :from-end t))
+        (setq abbrev (string-trim '(#\space) (subseq expr mark point)))
+        (push abbrev names)
+        (setq newmark
+         (position #\space 
+          (string-right-trim '(#\space)
+           (subseq expr 0 (1- mark))) :from-end t))
+        (when (string= "CAT"
+              (string-upcase 
+                (string-trim '(#\space) (subseq expr newmark (+ newmark 4)))))
+          (push (concatenate 'string abbrev "-") names))))))
+    (format t "(mergelibs '~a ~s)~%" names (string (pathname-name sourcefile)))
+    names)))
+ (srcscan)))
+
+
+; rescan will search new style NRLIBs and construct a new $MERGELIB list
+; this should be run after merging the libraries
+(defun rescan ()
+ (labels (
+  (indexname (name) (concatenate 'string (namestring name) "/index.KAF")))
+ (let (result)
+  (mapcar #'(lambda (f) 
+   (dolist (i (car f)) (push (cons (car i) (cdr f)) result)))
+   (mapcar #'(lambda (f)
+    (with-open-file (in (indexname f)) (cons (read in) (pathname-name f))))
+    (directory "*.NRLIB")))
+  result)))
+   
+
+(defvar $mergelib nil) ;; use old scheme for now
+
+;;(defvar $mergelib '(
+;; (INT . "integer") (NNI . "integer") (PI . "integer") 
+;; (ROMAN . "integer") (INTSLPE . "integer")))
+
+
+;((YSTREAM . "ystream") (WEIER . "weier") (RESLATC . "void") 
+;(EXIT . "void") (VOID . "void") (VIEW . "viewpack") 
+;(VIEWDEF . "viewDef") (VIEW3D . "view3D") (VIEW2D . "view2D") 
+;(GRIMAGE . "view2D") (DIRPROD2 . "vector") (DIRPROD . "vector") 
+;(DIRPCAT- . "vector") (DIRPCAT . "vector") (VECTOR2 . "vector") 
+;(VECTOR . "vector") (IVECTOR . "vector") (VECTCAT- . "vector") 
+;(VECTCAT . "vector") (ANON . "variable") (FUNCTION . "variable") 
+;(RULECOLD . "variable") (VARIABLE . "variable") (OVAR . "variable") 
+;(UTSODE . "utsode") (UNIFACT . "unifact") (TWOFACT . "twofact") 
+;(NUMTUBE . "tube") (EXPRTUBE . "tube") (TUBETOOL . "tube") 
+;(TUBE . "tube") (SPFCAT . "trigcat") (CFCAT . "trigcat") 
+;(LFCAT . "trigcat") (PRIMCAT . "trigcat") (TRIGCAT- . "trigcat") 
+;(TRIGCAT . "trigcat") (TRANFUN- . "trigcat") (TRANFUN . "trigcat") 
+;(HYPCAT- . "trigcat") (HYPCAT . "trigcat") (ATRIG- . "trigcat") 
+;(ATRIG . "trigcat") (AHYP . "trigcat") (ELEMFUN- . "trigcat") 
+;(ELEMFUN . "trigcat") (PENDTREE . "tree") (BBTREE . "tree") 
+;(BTOURN . "tree") (BSTREE . "tree") (BTREE . "tree") 
+;(BTCAT- . "tree") (BTCAT . "tree") (TREE . "tree") 
+;(SOLVESER . "transsolve") (SOLVETRA . "transsolve") (TEX1 . "tex") 
+;(TEX . "tex") (UTS2 . "taylor") (UTS . "taylor") 
+;(ITAYLOR . "taylor") (TABLBUMP . "tableau") (TABLEAU . "tableau") 
+;(STBL . "table") (GSTBL . "table") (STRTBL . "table") 
+;(EQTBL . "table") (TABLE . "table") (INTABL . "table") 
+;(HASHTBL . "table") (MSYSCMD . "system") (SYSSOLP . "syssolp") 
+;(SYMBOL . "symbol") (SUTS . "suts") (SUMRF . "sum") 
+;(GOSPER . "sum") (ISUMP . "sum") (SUCH . "suchthat") 
+;(STTF . "sttf") (STTAYLOR . "sttaylor") (STRICAT . "string") 
+;(STRING . "string") (ISTRING . "string") (CCLASS . "string") 
+;(CHAR . "string") (STREAM3 . "stream") (STREAM2 . "stream") 
+;(STREAM1 . "stream") (STREAM . "stream") (CSTTOOLS . "stream") 
+;(LZSTAGG- . "stream") (LZSTAGG . "stream") (NTPOLFN . "special") 
+;(ORTHPOL . "special") (SFSFUN . "special") (TOPSP . "space") 
+;(SPACE3 . "space") (SPACEC . "space") (SORTPAK . "sortpak") 
+;(SORTPAK . "sort") (SOLVERAD . "solverad") (LSPP . "solvelin") 
+;(LSMP . "solvelin") (SOLVEFOR . "solvefor") (DIOSP . "solvedio") 
+;(SMITH . "smith") (LIMITRF . "sign") (SIGNRF . "sign") 
+;(INPSIGN . "sign") (TOOLSIGN . "sign") (SI . "si") 
+;(INS- . "si") (INS . "si") (SGCF . "sgcf") 
+;(SF . "sf") (FPS- . "sf") (FPS . "sf") 
+;(RNS- . "sf") (RNS . "sf") (RADCAT- . "sf") 
+;(RADCAT . "sf") (SEX . "sex") (SEXOF . "sex") 
+;(SEXCAT . "sex") (SET . "sets") (UDVO . "setorder") 
+;(UDPO . "setorder") (INCRMAPS . "seg") (UNISEG2 . "seg") 
+;(UNISEG . "seg") (SEGBIND2 . "seg") (SEGBIND . "seg") 
+;(SEG2 . "seg") (SEG . "seg") (SEGXCAT . "seg") 
+;(SEGCAT . "seg") (RULESET . "rule") (APPRULE . "rule") 
+;(RULE . "rule") (ODERTRIC . "riccati") (ODEPRRIC . "riccati") 
+;(MKODRING . "riccati") (RF . "rf") (POLYCATQ . "rf") 
+;(RATRET . "retract") (INTRET . "retract") (FRETRCT- . "retract") 
+;(FRETRCT . "retract") (RESRING . "resring") (REP2 . "rep2") 
+;(REP1 . "rep1") (REAL0 . "realzero") (REAL0Q . "real0q") 
+;(RDEEFS . "rdesys") (RDETRS . "rdesys") (RDETR . "rderf") 
+;(RDEEF . "rdeef") (INTTOOLS . "rdeef") (RATFACT . "ratfact") 
+;(RFDIST . "random") (RIDIST . "random") (INTBIT . "random") 
+;(RDIST . "random") (RANDSRC . "random") (RADUTIL . "radix") 
+;(HEXADEC . "radix") (DECIMAL . "radix") (BINARY . "radix") 
+;(RADIX . "radix") (REP . "radeigen") (QUATCT2 . "quat") 
+;(QUAT . "quat") (QUATCAT- . "quat") (QUATCAT . "quat") 
+;(QALGSET2 . "qalgset") (QALGSET . "qalgset") (UPXS2 . "puiseux") 
+;(UPXS . "puiseux") (UPXSCONS . "puiseux") (UPXSCCA- . "puiseux") 
+;(UPXSCCA . "puiseux") (PTRANFN . "ptranfn") (MTSCAT . "pscat") 
+;(UPXSCAT . "pscat") (ULSCAT . "pscat") (UTSCAT- . "pscat") 
+;(UTSCAT . "pscat") (UPSCAT- . "pscat") (UPSCAT . "pscat") 
+;(PSCAT- . "pscat") (PSCAT . "pscat") (SYMPOLY . "prtition") 
+;(PRTITION . "prtition") (PRODUCT . "product") (PRINT . "print") 
+;(FSPRMELT . "primelt") (PRIMELT . "primelt") (COMMUPC . "polycat") 
+;(UPOLYC2 . "polycat") (UPOLYC- . "polycat") (UPOLYC . "polycat") 
+;(POLYLIFT . "polycat") (POLYCAT- . "polycat") (POLYCAT . "polycat") 
+;(FAMR- . "polycat") (FAMR . "polycat") (AMR- . "polycat") 
+;(AMR . "polycat") (PSQFR . "poly") (UPSQFREE . "poly") 
+;(POLY2UP . "poly") (UP2 . "poly") (UP . "poly") 
+;(SUP2 . "poly") (SUP . "poly") (PR . "poly") 
+;(FM . "poly") (POLTOPOL . "poltopol") (MPC3 . "poltopol") 
+;(MPC2 . "poltopol") (PLOTTOOL . "plottool") (PLOT3D . "plot3d") 
+;(PLOT1 . "plot") (PLOT . "plot") (PLEQN . "pleqn") 
+;(PINTERP . "pinterp") (PINTERPA . "pinterp") (PGROEB . "pgrobner") 
+;(PGCD . "pgcd") (PFRPAC . "pfr") (PFR . "pfr") 
+;(PFO . "pfo") (FSRED . "pfo") (PFOQ . "pfo") 
+;(PFOTOOLS . "pfo") (RDIV . "pfo") (FORDER . "pfo") 
+;(PFBR . "pfbr") (PFBRU . "pfbr") (PF . "pf") 
+;(IPF . "pf") (PGE . "permgrps") (PERMGRP . "permgrps") 
+;(PERMAN . "perman") (GRAY . "perman") (PERM . "perm") 
+;(PERMCAT . "perm") (PSCURVE . "pcurve") (PPCURVE . "pcurve") 
+;(PATAB . "pattern") (PATTERN2 . "pattern") (PATTERN1 . "pattern") 
+;(PATTERN . "pattern") (PATMATCH . "patmatch") (PMLSAGG . "patmatch") 
+;(PMFS . "patmatch") (PMPLCAT . "patmatch") (PMTOOLS . "patmatch") 
+;(PMQFCAT . "patmatch") (PMDOWN . "patmatch") (PMINS . "patmatch") 
+;(PMKERNEL . "patmatch") (PMSYM . "patmatch") (FPATMAB . "patmatch") 
+;(PATMAB . "patmatch") (PATLRES . "patmatch") (PATRES2 . "patmatch") 
+;(PATRES . "patmatch") (PARTPERM . "partperm") (PARSU2 . "paramete") 
+;(PARSURF . "paramete") (PARSC2 . "paramete") (PARSCURV . "paramete") 
+;(PARPC2 . "paramete") (PARPCURV . "paramete") (BPADICRT . "padic") 
+;(PADICRAT . "padic") (PADICRC . "padic") (BPADIC . "padic") 
+;(PADIC . "padic") (IPADIC . "padic") (PADICCT . "padic") 
+;(PADE . "pade") (PADEPAC . "pade") (OUTFORM . "outform") 
+;(NUMFMT . "outform") (DISPLAY . "out") (SPECOUT . "out") 
+;(OUT . "out") (OP . "opalg") (COMMONOP . "op") 
+;(BOP1 . "op") (BOP . "op") (ODECONST . "oderf") 
+;(ODEINT . "oderf") (ODETOOLS . "oderf") (ODERAT . "oderf") 
+;(RTODETLS . "oderf") (SCFRAC . "oderf") (ODEPRIM . "oderf") 
+;(BOUNDZRO . "oderf") (BALFACT . "oderf") (ODEEF . "odeef") 
+;(REDORDER . "odeef") (ODEPAL . "odealg") (ODERED . "odealg") 
+;(ODESYS . "odealg") (OCTCT2 . "oct") (OCT . "oct") 
+;(OC- . "oct") (OC . "oct") (PNTHEORY . "numtheor") 
+;(INTHEORY . "numtheor") (FLOATCP . "numsolve") (FLOATRP . "numsolve") 
+;(INFSP . "numsolve") (NUMQUAD . "numquad") (NUMODE . "numode") 
+;(DRAWHACK . "numeric") (NUMERIC . "numeric") (NCEP . "numeigen") 
+;(NREP . "numeigen") (INEP . "numeigen") (NPCOEF . "npcoef") 
+;(NODE1 . "nlode") (NLINSOL . "nlinsol") (RETSOL . "nlinsol") 
+;(PTFUNC2 . "newpoint") (PTPACK . "newpoint") (SUBSPACE . "newpoint") 
+;(COMPPROP . "newpoint") (POINT . "newpoint") (PTCAT . "newpoint") 
+;(FRNAALG- . "naalgc") (FRNAALG . "naalgc") (FINAALG- . "naalgc") 
+;(FINAALG . "naalgc") (NAALG- . "naalgc") (NAALG . "naalgc") 
+;(NASRING- . "naalgc") (NASRING . "naalgc") (NARNG- . "naalgc") 
+;(NARNG . "naalgc") (MONADWU- . "naalgc") (MONADWU . "naalgc") 
+;(MONAD- . "naalgc") (MONAD . "naalgc") (FRNAAF2 . "naalg") 
+;(ALGPKG . "naalg") (SCPKG . "naalg") (ALGSC . "naalg") 
+;(MULTSQFR . "multsqfr") (INDE . "multpoly") (SMP . "multpoly") 
+;(MPOLY . "multpoly") (POLY2 . "multpoly") (POLY . "multpoly") 
+;(ALGMFACT . "multfact") (MULTFACT . "multfact") (INNMFACT . "multfact") 
+;(TS . "mts") (SMTS . "mts") (MSET . "mset") 
+;(MRF2 . "mring") (MRING . "mring") (MOEBIUS . "moebius") 
+;(MODFIELD . "modring") (EMR . "modring") (MODRING . "modring") 
+;(MODMON . "modmon") (INMODGCD . "modgcd") (MDDFACT . "moddfact") 
+;(MLIFT . "mlift") (MKRECORD . "mkrecord") (MKFLCFN . "mkfunc") 
+;(MKBCFUNC . "mkfunc") (MKUCFUNC . "mkfunc") (MKFUNC . "mkfunc") 
+;(INFORM1 . "mkfunc") (INFORM . "mkfunc") (SAOS . "misc") 
+;(MFINFACT . "mfinfact") (MESH . "mesh") (MATSTOR . "matstor") 
+;(SQMATRIX . "matrix") (RMATRIX . "matrix") (MATRIX . "matrix") 
+;(IMATRIX . "matrix") (MATLIN . "matfuns") (IMATQF . "matfuns") 
+;(RMCAT2 . "matfuns") (MATCAT2 . "matfuns") (IMATLIN . "matfuns") 
+;(SMATCAT- . "matcat") (SMATCAT . "matcat") (RMATCAT- . "matcat") 
+;(RMATCAT . "matcat") (MATCAT- . "matcat") (MATCAT . "matcat") 
+;(MAPPKG3 . "mappkg") (MAPPKG2 . "mappkg") (MAPPKG1 . "mappkg") 
+;(MAPHACK3 . "mappkg") (MAPHACK2 . "mappkg") (MAPHACK1 . "mappkg") 
+;(TRMANIP . "manip") (ALGMANIP . "manip") (POLYROOT . "manip") 
+;(FACTFUNC . "manip") (LODOF . "lodof") (DPMM . "lodo") 
+;(DPMO . "lodo") (ODR . "lodo") (LODO . "lodo") 
+;(NCODIV . "lodo") (OMLO . "lodo") (MLO . "lodo") 
+;(LMDICT . "lmdict") (HEUGCD . "listgcd") (ALIST . "list") 
+;(LIST2MAP . "list") (LIST3 . "list") (LIST2 . "list") 
+;(LIST . "list") (ILIST . "list") (LF . "liouv") 
+;(LGROBP . "lingrob") (ZLINDEP . "lindep") (LINDEP . "lindep") 
+;(SIGNEF . "limitps") (LIMITPS . "limitps") (LSQM . "lie") 
+;(JORDAN . "lie") (LIE . "lie") (LEADCDET . "leadcdet") 
+;(ULS2 . "laurent") (ULS . "laurent") (ULSCONS . "laurent") 
+;(ULSCCAT- . "laurent") (ULSCCAT . "laurent") (INVLAPLA . "laplace") 
+;(LAPLACE . "laplace") (KOVACIC . "kovacic") (KERNEL2 . "kl") 
+;(KERNEL . "kl") (MKCHSET . "kl") (SCACHE . "kl") 
+;(CACHSET . "kl") (ITFUN3 . "ituple") (ITFUN2 . "ituple") 
+;(ITUPLE . "ituple") (IRSN . "irsn") (IRRF2F . "irexpand") 
+;(IR2F . "irexpand") (INTRF . "intrf") (INTRAT . "intrf") 
+;(INTTR . "intrf") (INTHERTR . "intrf") (MONOTOOL . "intrf") 
+;(SUBRESP . "intrf") (INTPM . "intpm") (INTFACT . "intfact") 
+;(IROOT . "intfact") (PRIMES . "intfact") (FSINT . "integrat") 
+;(FSCINT . "integrat") (ROMAN . "integer") (PI . "integer") 
+;(NNI . "integer") (INT . "integer") (INTSLPE . "integer") 
+;(INTEF . "intef") (NFINTBAS . "intclos") (WFFINTBS . "intclos") 
+;(FFINTBAS . "intclos") (IBATOOL . "intclos") (TRIMAT . "intclos") 
+;(IR2 . "intaux") (IR . "intaux") (INTALG . "intalg") 
+;(INTHERAL . "intalg") (DBLRESP . "intalg") (INTAF . "intaf") 
+;(INTPAF . "intaf") (INTG0 . "intaf") (INPRODFF . "infprod") 
+;(INPRODPF . "infprod") (INFPROD0 . "infprod") (STINPROD . "infprod") 
+;(IDPAG . "indexedp") (IDPOAMS . "indexedp") (IDPOAM . "indexedp") 
+;(IDPAM . "indexedp") (IDPO . "indexedp") (IDPC . "indexedp") 
+;(IDECOMP . "idecomp") (IDEAL . "ideal") (GROEBSOL . "groebsol") 
+;(GBF . "groebf") (GRDEF . "grdef") (LAUPOL . "gpol") 
+;(GENPGCD . "gpgcd") (GHENSEL . "ghensel") (GENUPS . "genups") 
+;(GENUFACT . "genufact") (CVMP . "generic") (GCNAALG . "generic") 
+;(GENEEZ . "geneez") (HDMP . "gdpoly") (DMP . "gdpoly") 
+;(GDMP . "gdpoly") (HDP . "gdirprod") (ODP . "gdirprod") 
+;(ORDFUNS . "gdirprod") (GBINTERN . "gbintern") (GBEUCLID . "gbeuclid") 
+;(GB . "gb") (CINTSLPE . "gaussian") (COMPFACT . "gaussian") 
+;(COMPLEX2 . "gaussian") (COMPLEX . "gaussian") (COMPCAT- . "gaussian") 
+;(COMPCAT . "gaussian") (GAUSSFAC . "gaussfac") (FSUPFACT . "funcpkgs") 
+;(FS2 . "fspace") (FS- . "fspace") (FS . "fspace") 
+;(ES2 . "fspace") (ES1 . "fspace") (ES- . "fspace") 
+;(ES . "fspace") (FS2UPS . "fs2ups") (FS2EXPXP . "fs2expxp") 
+;(FAGROUP . "free") (FAMONOID . "free") (IFAMON . "free") 
+;(FAMONC . "free") (FGROUP . "free") (FMONOID . "free") 
+;(LMOPS . "free") (FRAC2 . "fraction") (LPEFRAC . "fraction") 
+;(FRAC . "fraction") (QFCAT2 . "fraction") (QFCAT- . "fraction") 
+;(QFCAT . "fraction") (LA . "fraction") (LO . "fraction") 
+;(FR2 . "fr") (FRUTIL . "fr") (FR . "fr") 
+;(FORMULA1 . "formula") (FORMULA . "formula") (FNLA . "fnla") 
+;(HB . "fnla") (COMM . "fnla") (OSI . "fnla") 
+;(FNAME . "fname") (FNCAT . "fname") (ZMOD . "fmod") 
+;(FLOAT . "float") (LIB . "files") (KAFILE . "files") 
+;(TEXTFILE . "files") (FILE . "files") (FILECAT . "files") 
+;(IRREDFFX . "ffx") (FFPOLY2 . "ffpoly2") (FFPOLY . "ffpoly") 
+;(FF . "ffp") (IFF . "ffp") (FFX . "ffp") 
+;(FFP . "ffp") (FFNB . "ffnb") (FFNBX . "ffnb") 
+;(FFNBP . "ffnb") (INBFF . "ffnb") (FFHOM . "ffhom") 
+;(FFF . "fff") (FFCG . "ffcg") (FFCGX . "ffcg") 
+;(FFCGP . "ffcg") (FFSLPE . "ffcat") (FFIELDC- . "ffcat") 
+;(FFIELDC . "ffcat") (DLP . "ffcat") (FAXF- . "ffcat") 
+;(FAXF . "ffcat") (XF- . "ffcat") (XF . "ffcat") 
+;(FPC- . "ffcat") (FPC . "ffcat") (PUSHVAR . "facutil") 
+;(FACUTIL . "facutil") (EXPRODE . "exprode") (EXPR2UPS . "expr2ups") 
+;(PICOERCE . "expr") (HACKPI . "expr") (PMASS . "expr") 
+;(PMPRED . "expr") (PMASSFS . "expr") (PMPREDFS . "expr") 
+;(EXPR2 . "expr") (PAN2EXPR . "expr") (EXPR . "expr") 
+;(EXPEXPAN . "expexpan") (UPXSSING . "expexpan") (EXPUPXS . "expexpan") 
+;(ERROR . "error") (FEVALAB- . "equation") (FEVALAB . "equation") 
+;(EVALAB- . "equation") (EVALAB . "equation") (IEVALAB- . "equation") 
+;(IEVALAB . "equation") (EQ2 . "equation") (EQ . "equation") 
+;(ELFUTS . "elfuts") (EF . "elemntry") (CHARPOL . "eigen") 
+;(EP . "eigen") (EFUPXS . "efupxs") (EFULS . "efuls") 
+;(TRIGMNIP . "efstruc") (ITRIGMNP . "efstruc") (EFSTRUC . "efstruc") 
+;(TANEXP . "efstruc") (SYMFUNC . "efstruc") (DRAWCX . "drawpak") 
+;(DROPT0 . "drawopt") (DROPT1 . "drawopt") (DROPT . "drawopt") 
+;(DRAWCURV . "draw") (DRAW . "draw") (DRAWCFUN . "draw") 
+;(SDPOL . "dpolcat") (ODPOL . "dpolcat") (DSMP . "dpolcat") 
+;(DPOLCAT- . "dpolcat") (DPOLCAT . "dpolcat") (SDVAR . "dpolcat") 
+;(ODVAR . "dpolcat") (DVARCAT- . "dpolcat") (DVARCAT . "dpolcat") 
+;(FDIV2 . "divisor") (FDIV . "divisor") (FRMOD . "divisor") 
+;(MHROWRED . "divisor") (FRIDEAL2 . "divisor") (FRIDEAL . "divisor") 
+;(DHMATRIX . "dhmatrix") (DERHAM . "derham") (ANTISYM . "derham") 
+;(EAB . "derham") (LALG- . "derham") (LALG . "derham") 
+;(DEGRED . "degred") (DEFINTRF . "defintrf") (DFINTTLS . "defintrf") 
+;(DEFINTEF . "defintef") (FLASORT . "defaults") (REPDB . "defaults") 
+;(REPSQ . "defaults") (DDFACT . "ddfact") (CYCLOTOM . "cyclotom") 
+;(EVALCYC . "cycles") (CYCLES . "cycles") (ALGFF . "curve") 
+;(RADFF . "curve") (CHVAR . "curve") (FFCAT2 . "curve") 
+;(MMAP . "curve") (FFCAT- . "curve") (FFCAT . "curve") 
+;(CRFP . "crfp") (CRAPACK . "cra") (COORDSYS . "coordsys") 
+;(NCNTFRAC . "contfrac") (CONTFRAC . "contfrac") (AN . "constant") 
+;(INFINITY . "complet") (ONECOMP2 . "complet") (ONECOMP . "complet") 
+;(ORDCOMP2 . "complet") (ORDCOMP . "complet") (COMBINAT . "combinat") 
+;(SUMFS . "combfunc") (FSPECF . "combfunc") (COMBF . "combfunc") 
+;(COMBOPC . "combfunc") (PALETTE . "color") (COLOR . "color") 
+;(RETRACT- . "coerce") (RETRACT . "coerce") (KONVERT . "coerce") 
+;(KOERCE . "coerce") (OBJECT . "coerce") (TYPE . "coerce") 
+;(CMPLXRT . "cmplxrt") (CLIP . "clip") (CLIF . "clifford") 
+;(QFORM . "clifford") (MCDEN . "cden") (UPCDEN . "cden") 
+;(CDEN . "cden") (ICDEN . "cden") (VSPACE . "catdef") 
+;(UFD- . "catdef") (UFD . "catdef") (STEP . "catdef") 
+;(SGROUP- . "catdef") (SGROUP . "catdef") (SETCAT- . "catdef") 
+;(SETCAT . "catdef") (RNG . "catdef") (RMODULE . "catdef") 
+;(RING- . "catdef") (RING . "catdef") (REAL . "catdef") 
+;(PID . "catdef") (PFECAT- . "catdef") (PFECAT . "catdef") 
+;(PDRING- . "catdef") (PDRING . "catdef") (ORDSET- . "catdef") 
+;(ORDSET . "catdef") (ORDRING- . "catdef") (ORDRING . "catdef") 
+;(ORDMON . "catdef") (ORDFIN . "catdef") (OASGP . "catdef") 
+;(OAMONS . "catdef") (OCAMON . "catdef") (OAMON . "catdef") 
+;(OAGROUP . "catdef") (MONOID- . "catdef") (MONOID . "catdef") 
+;(MODULE- . "catdef") (MODULE . "catdef") (LMODULE . "catdef") 
+;(LINEXP . "catdef") (INTDOM- . "catdef") (INTDOM . "catdef") 
+;(GROUP- . "catdef") (GROUP . "catdef") (GCDDOM- . "catdef") 
+;(GCDDOM . "catdef") (FRAMALG- . "catdef") (FRAMALG . "catdef") 
+;(FLINEXP- . "catdef") (FLINEXP . "catdef") (FINITE . "catdef") 
+;(FIELD- . "catdef") (FIELD . "catdef") (EUCDOM- . "catdef") 
+;(EUCDOM . "catdef") (ENTIRER . "catdef") (DIVRING- . "catdef") 
+;(DIVRING . "catdef") (DIFEXT- . "catdef") (DIFEXT . "catdef") 
+;(DIFRING- . "catdef") (DIFRING . "catdef") (COMRING . "catdef") 
+;(CHARNZ . "catdef") (CHARZ . "catdef") (CABMON . "catdef") 
+;(BMODULE . "catdef") (ALGEBRA- . "catdef") (ALGEBRA . "catdef") 
+;(ABELSG- . "catdef") (ABELSG . "catdef") (ABELMON- . "catdef") 
+;(ABELMON . "catdef") (ABELGRP- . "catdef") (ABELGRP . "catdef") 
+;(CARTEN2 . "carten") (CARTEN . "carten") (GRALG- . "carten") 
+;(GRALG . "carten") (GRMOD- . "carten") (GRMOD . "carten") 
+;(CARD . "card") (BITS . "boolean") (IBITS . "boolean") 
+;(BOOLEAN . "boolean") (REF . "boolean") (BEZOUT . "bezout") 
+;(HEAP . "bags") (HEAP . "bags") (DEQUEUE . "bags") 
+;(QUEUE . "bags") (ASTACK . "bags") (STACK . "bags") 
+;(ATTREG . "attreg") (ARRAY2 . "array2") (IARRAY2 . "array2") 
+;(IIARRAY2 . "array2") (ARR2CAT- . "array2") (ARR2CAT . "array2") 
+;(ARRAY12 . "array1") (ARRAY1 . "array1") (IARRAY1 . "array1") 
+;(FARRAY . "array1") (IFARRAY . "array1") (TUPLE . "array1") 
+;(PRIMARR2 . "array1") (PRIMARR . "array1") (OPQUERY . "aql") 
+;(MTHING . "aql") (QEQUAT . "aql") (DBASE . "aql") 
+;(ICARD . "aql") (DLIST . "aql") (ANY1 . "any") 
+;(ANY . "any") (NONE1 . "any") (NONE . "any") 
+;(OPQUERY . "alql") (MTHING . "alql") (QEQUAT . "alql") 
+;(DBASE . "alql") (ICARD . "alql") (DLIST . "alql") 
+;(RFFACTOR . "allfact") (GENMFACT . "allfact") (MPCPF . "allfact") 
+;(MPRFF . "allfact") (MRATFAC . "allfact") (AF . "algfunc") 
+;(ACFS- . "algfunc") (ACFS . "algfunc") (ACF- . "algfunc") 
+;(ACF . "algfunc") (ALGFACT . "algfact") (SAERFFC . "algfact") 
+;(RFFACT . "algfact") (SAEFACT . "algfact") (IALGFACT . "algfact") 
+;(SAE . "algext") (MONOGEN- . "algcat") (MONOGEN . "algcat") 
+;(FRAMALG- . "algcat") (FRAMALG . "algcat") (FINRALG- . "algcat") 
+;(FINRALG . "algcat") (FSAGG2 . "aggcat2") (FLAGG2 . "aggcat2") 
+;(BTAGG- . "aggcat") (BTAGG . "aggcat") (SRAGG- . "aggcat") 
+;(SRAGG . "aggcat") (ALAGG . "aggcat") (LSAGG- . "aggcat") 
+;(LSAGG . "aggcat") (ELAGG- . "aggcat") (ELAGG . "aggcat") 
+;(A1AGG- . "aggcat") (A1AGG . "aggcat") (FLAGG- . "aggcat") 
+;(FLAGG . "aggcat") (LNAGG- . "aggcat") (LNAGG . "aggcat") 
+;(STAGG- . "aggcat") (STAGG . "aggcat") (URAGG- . "aggcat") 
+;(URAGG . "aggcat") (DLAGG . "aggcat") (BRAGG- . "aggcat") 
+;(BRAGG . "aggcat") (RCAGG- . "aggcat") (RCAGG . "aggcat") 
+;(TBAGG- . "aggcat") (TBAGG . "aggcat") (IXAGG- . "aggcat") 
+;(IXAGG . "aggcat") (ELTAGG- . "aggcat") (ELTAGG . "aggcat") 
+;(ELTAB . "aggcat") (KDAGG- . "aggcat") (KDAGG . "aggcat") 
+;(OMSAGG . "aggcat") (MSETAGG . "aggcat") (FSAGG- . "aggcat") 
+;(FSAGG . "aggcat") (SETAGG- . "aggcat") (SETAGG . "aggcat") 
+;(MDAGG . "aggcat") (DIAGG- . "aggcat") (DIAGG . "aggcat") 
+;(DIOPS- . "aggcat") (DIOPS . "aggcat") (PRQAGG . "aggcat") 
+;(DQAGG . "aggcat") (QUAGG . "aggcat") (SKAGG . "aggcat") 
+;(BGAGG- . "aggcat") (BGAGG . "aggcat") (CLAGG- . "aggcat") 
+;(CLAGG . "aggcat") (HOAGG- . "aggcat") (HOAGG . "aggcat") 
+;(AGG- . "aggcat") (AGG . "aggcat") (ACPLOT . "acplot") 
+;(REALSOLV . "acplot")))
+
+; in the old system each constructor (e.g. LIST) had one library directory
+; (e.g. LIST.NRLIB). this directory contained a random access file called
+; the index.KAF file. the interpreter needed this KAF file at runtime for
+; two entries, the operationAlist and the ConstructorModemap.
+; during the redesign for the new compiler we decided to merge all of
+; these .NRLIB/index.KAF files into one database, CONSTRUCT.DAASE.
+; requests to get information from this database are intended to be
+; cached so that multiple references do not cause additional disk i/o.
+; this database is left open at all times as it is used frequently by
+; the interpreter. one minor complication is that newly compiled files
+; need to override information that exists in this database. 
+;   the design calls for constructing a random read (KAF format) file
+; that is accessed by functions that cache their results. when the
+; database is opened the list of constructor-index pairs is hashed
+; by constructor name. a request for information about a constructor
+; causes the information to replace the index in the hash table. since
+; the index is a number and the data is a non-numeric sexpr there is
+; no source of confusion about when the data needs to be read.
+;
+; the format of this new database is as follows:
+;
+;first entry:
+; an integer giving the byte offset to the constructor alist
+; at the bottom of the file
+;second and subsequent entries (one per constructor)
+; (operationAlist)
+; (constructorModemap)
+; (("operationAlist" 0 index) ("constructorModemap" 0 index))
+;last entry: (pointed at by the first entry)
+; an alist of (constructor . index) e.g.
+;   ((PI . index) (NNI . index) ....) ...)
+; this list is read at open time and hashed by the car of each item.
+
+
+; this is a hashtable which is indexed by constructor name (eg PI) and
+; returns the constructorModemap or the index into the construct.daase
+; file that contains the constructorModemap for PI
+(defvar *modemap-hash* nil "a hash table for caching constructorModemap data")
+
+; this is a hashtable which is indexed by constructor name (eg PI) and
+; returns the operationAlist or the index into the construct.daase
+; file that contains the operationAlist for PI
+(defvar *opalist-hash* nil "a hash table for caching operationAlist data")
+
+; this a a stream for the construct.daase database. it is always open.
+(defvar *construct-stream* nil "an open stream to the construct database")
+
+; this is an initialization function for the constructor database
+; it sets up 2 hash tables, opens the database and hashes the index values
+
+(defun constructOpen ()
+ (declare (special $spadroot))
+ "open the constructor database and hash the keys"
+ (let (constructors pos)
+  (setq *opalist-hash* (make-hash-table))
+  (setq *modemap-hash* (make-hash-table))
+  (setq *construct-stream*
+   (open (concatenate 'string $spadroot "/algebra/construct.daase")))
+  (setq pos (read *construct-stream*))
+  (file-position *construct-stream* pos)
+  (setq constructors (read *construct-stream*))
+  (dolist (item constructors)
+   (setf (gethash (car item) *opalist-hash*) (cdr item))
+   (setf (gethash (car item) *modemap-hash*) (cdr item)))))
+
+; this is the function to call if you want to get the operationAlist
+; property out of an NRLIB. this will read the property the first time
+; and cache the result in a hash table
+
+(defun getopalist (constructor)
+ (let (data alist)
+  (setq data (gethash constructor *opalist-hash*))
+  (when (numberp data)
+   (file-position *construct-stream* data)
+   (setq alist (read *construct-stream*))
+   (file-position *construct-stream*
+     (third (assoc "operationAlist" alist :test #'string=)))
+   (setq data (read *construct-stream*))
+   (setf (gethash constructor *opalist-hash*) data))
+  data))
+
+; this is the function to call if you want to get the constructorModemap
+; property out of an NRLIB. this will read the property the first time
+; and cache the result in a hash table
+
+(defun getmodemap (constructor)
+ (let (data alist)
+  (setq data (gethash constructor *modemap-hash*))
+  (when (numberp data)
+   (file-position *construct-stream* data)
+   (setq alist (read *construct-stream*))
+   (file-position *construct-stream* 
+    (third (assoc "constructorModemap" alist :test #'string=)))
+   (setq data (read *construct-stream*))
+   (setf (gethash constructor *modemap-hash*) data))
+  data))
+
+; this is a utility function that walks over all of the libs given in
+; the list (it should be a list of *SYMBOLS*, not strings, like
+; '(pi nni ....) and constructs the contstruct.daase database
+(defun constructdb (libs)
+ (declare (special $spadroot))
+ (let (alist opalist modemap opalistpos modemappos index master masterpos pos)
+ (labels (
+  (name (x)
+   (concatenate 'string $spadroot "/algebra/" (string x) ".NRLIB/index.KAF")))
+ (with-open-file (out "construct.daase" :direction :output)
+  (print "                " out)
+  (finish-output out)
+  (dolist (lib libs)
+   (print lib)
+   (with-open-file (in (name lib))
+    (file-position in (read in))
+    (setq alist (read in))
+    (setq pos (third (assoc "operationAlist" alist :test #'string=)))
+    (if pos
+     (progn
+      (file-position in pos)
+      (setq opalist (read in)))
+     (setq opalist nil))
+    (setq pos (third (assoc "constructorModemap" alist :test #'string=)))
+    (if pos
+     (progn
+      (file-position in pos)
+      (setq modemap (read in)))
+     (setq modemap nil))
+    (finish-output out)
+    (setq opalistpos (file-position out))
+    (print opalist out)
+    (finish-output out)
+    (setq modemappos (file-position out))
+    (print modemap out)
+    (finish-output out)
+    (setq index (file-position out))
+    (print (list (list "operationAlist" 0 opalistpos) 
+                 (list "constructorModemap" 0 modemappos)) out)
+    (finish-output out)
+    (push (cons lib index) master)))
+  (finish-output out)
+  (setq masterpos (file-position out))
+  (print master out)
+  (finish-output out)
+  (file-position out 0)
+  (print masterpos out)
+  (finish-output out)))))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/cparse.boot.pamphlet b/src/interp/cparse.boot.pamphlet
new file mode 100644
index 00000000..7e9aeaa0
--- /dev/null
+++ b/src/interp/cparse.boot.pamphlet
@@ -0,0 +1,941 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/cparse.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- npTerm introduced between npRemainder and npSum
+-- rhs of assignment changed from npStatement to npGives
+
+npParse stream ==
+    $inputStream:local := stream
+    $stack:local       :=nil
+    $stok:local:=nil
+    $ttok:local:=nil
+    npFirstTok()
+    found:=CATCH("TRAPPOINT",npItem())
+    if found="TRAPPED"
+    then
+      ncSoftError(tokPosn $stok,'S2CY0006, [])
+      pfWrong(pfDocument  '"top level syntax error" ,pfListOf nil)
+    else if not null $inputStream
+         then
+          ncSoftError(tokPosn $stok,'S2CY0002,[])
+          pfWrong(pfDocument ['"input stream not exhausted"],pfListOf [])
+         else if null $stack
+              then
+                 ncSoftError(tokPosn $stok,'S2CY0009, [])
+                 pfWrong(pfDocument ['"stack empty"],pfListOf [])
+              else
+                 CAR $stack
+
+npItem()==
+     npQualDef() =>
+            npEqKey "SEMICOLON" =>
+                      [a,b]:=npItem1 npPop1 ()
+                      c:=pfEnSequence b
+                      a => npPush c
+                      npPush pfNovalue c
+            npPush pfEnSequence npPop1 ()
+     false
+
+npItem1 c==
+     npQualDef() =>
+            npEqKey "SEMICOLON" =>
+                      [a,b]:=npItem1 npPop1 ()
+                      [a,append(c,b)]
+            [true,append (c,npPop1())]
+     [false,c]
+
+npFirstTok()==
+      $stok:=
+          if null $inputStream
+          then tokConstruct("ERROR","NOMORE",tokPosn $stok)
+          else CAR $inputStream
+      $ttok:=tokPart $stok
+
+npNext() ==
+     $inputStream := CDR($inputStream)
+     npFirstTok()
+
+npState()==cons($inputStream,$stack)
+
+npRestore(x)==
+      $inputStream:=CAR x
+      npFirstTok()
+      $stack:=CDR x
+      true
+
+npPush x==$stack:=CONS(x,$stack)
+
+npPushId()==
+   a:=GETL($ttok,'INFGENERIC)
+   $ttok:= if a then a else $ttok
+   $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack)
+   npNext()
+
+npPop1()==
+       a:=CAR $stack
+       $stack:=CDR $stack
+       a
+
+npPop2()==
+       a:=CADR $stack
+       RPLACD($stack,CDDR $stack)
+       a
+
+npPop3()==
+       a:=CADDR $stack
+       RPLACD(CDR $stack,CDDDR $stack)
+       a
+
+npParenthesized f==
+   npParenthesize("(",")",f)   or
+   npParenthesize("(|","|)",f)
+
+npParenthesize (open,close,f)==
+    a:=$stok
+    npEqKey open =>
+         APPLY(f,nil) and (npEqKey close or npMissingMate(close,a))=> true
+         npEqKey close  =>  npPush  []
+         npMissingMate(close,a)
+    false
+
+npEnclosed(open,close,fn,f)==
+    a:=$stok
+    npEqKey open =>
+        npEqKey close  => npPush FUNCALL(fn,a,pfTuple pfListOf [])
+        APPLY(f,nil) and (npEqKey close or npMissingMate(close,a))=>
+                   npPush FUNCALL (fn,a,pfEnSequence npPop1())
+        false
+    false
+
+npParened f ==
+    npEnclosed("(",")",function pfParen,f) or
+    npEnclosed("(|","|)",function pfParen,f)
+
+npBracked f ==
+    npEnclosed("[","]",function pfBracket,f) or
+    npEnclosed("[|","|]",function pfBracketBar,f)
+
+npBraced f ==
+    npEnclosed("{","}",function pfBrace,f) or
+    npEnclosed("{|","|}",function pfBraceBar,f)
+
+npAngleBared f ==
+    npEnclosed("<|","|>",function pfHide,f)
+
+npBracketed f==
+  npParened f or npBracked f or npBraced f or npAngleBared f
+
+npPileBracketed f==
+ if npEqKey "SETTAB"
+ then if npEqKey "BACKTAB"
+      then npPush pfNothing()     -- never happens
+      else if APPLY(f,nil) and (npEqKey "BACKTAB" or npMissing "backtab")
+           then npPush pfPile npPop1()
+           else false
+ else false
+
+npListofFun(f,h,g)==
+    if APPLY(f,nil)
+    then
+        if APPLY(h,nil) and (APPLY(f,nil) or npTrap())
+        then
+          a:=$stack
+          $stack:=nil
+          while APPLY(h,nil) and (APPLY(f,nil) or npTrap()) repeat 0
+          $stack:=cons(NREVERSE $stack,a)
+          npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()])
+        else
+          true
+    else false
+
+npList(f,str1,g)== -- always produces a list, g is applied to it
+    if APPLY(f,nil)
+    then
+        if npEqKey str1 and (npEqKey "BACKSET" or true)
+                       and (APPLY(f,nil) or npTrap())
+        then
+          a:=$stack
+          $stack:=nil
+          while npEqKey str1 and (npEqKey "BACKSET" or true) and
+                             (APPLY(f,nil) or npTrap()) repeat 0
+          $stack:=cons(NREVERSE $stack,a)
+          npPush FUNCALL(g,  [npPop3(),npPop2(),:npPop1()])
+        else
+          npPush FUNCALL(g, [npPop1()])
+    else npPush FUNCALL(g, [])
+
+
+++ rewrite flets, using global scoping
+$npPParg := nil
+
+npPPff() ==
+  FUNCALL $npPParg and npPush [npPop1()]
+
+npPPf() ==
+  npSemiListing function npPPff
+
+npPPg() ==
+  npListAndRecover function npPPf
+    and npPush pfAppend npPop1()
+
+npPP(f) ==
+  $npPParg := f
+  npParened function npPPf
+    or npPileBracketed function npPPg and
+      npPush pfEnSequence npPop1()
+        or FUNCALL f
+
+++ rewrite flets, using global scoping
+$npPCff := nil
+
+npPCff() ==
+  FUNCALL $npPCff and npPush [npPop1()]
+
+npPCg() ==
+  npListAndRecover function npPCff
+    and npPush pfAppend npPop1()
+
+npPC(f) ==
+  $npPCff := f
+  npPileBracketed function npPCg and
+    npPush pfEnSequence npPop1()
+      or FUNCALL f
+
+
+-- s must transform the head of the stack
+
+npAnyNo s==
+     while APPLY(s,nil) repeat 0
+     true
+
+npAndOr(keyword,p,f)==
+   npEqKey keyword and (APPLY(p,nil) or npTrap())
+             and npPush FUNCALL(f, npPop1())
+
+npRightAssoc(o,p)==
+    a:=npState()
+    if APPLY(p,nil)
+    then
+       while  npInfGeneric o and (npRightAssoc(o,p)
+               or (npPush pfApplication(npPop2(),npPop1());false)) repeat
+             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
+       true
+    else
+       npRestore a
+       false
+
+-- p o p o p o p = (((p o p) o p) o p)
+-- p o p o = (p o p) o
+
+npLeftAssoc(operations,parser)==
+    if APPLY(parser,nil)
+    then
+       while npInfGeneric(operations)
+         and (APPLY(parser,nil) or
+              (npPush pfApplication(npPop2(),npPop1());false))
+           repeat
+             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
+       true
+    else false
+
+npInfixOp()==
+  EQ(CAAR $stok,"key") and
+    GETL($ttok,"INFGENERIC") and npPushId()
+
+npInfixOperator()== npInfixOp() or
+        a:=npState()
+        b:=$stok
+        npEqKey "'" and npInfixOp() =>
+                npPush pfSymb (npPop1 (),tokPosn b)
+        npRestore a
+        npEqKey "BACKQUOTE" and  npInfixOp() =>
+                a:=npPop1()
+                npPush tokConstruct("idsy",tokPart a,tokPosn a)
+        npRestore a
+        false
+
+npInfKey s==  EQ(CAAR $stok,"key") and  MEMQ($ttok,s) and npPushId()
+
+npDDInfKey s==
+    npInfKey s or
+        a:=npState()
+        b:=$stok
+        npEqKey "'" and npInfKey s =>
+                 npPush pfSymb (npPop1 () ,tokPosn b)
+        npRestore a
+        npEqKey "BACKQUOTE" and  npInfKey s =>
+                a:=npPop1()
+                npPush tokConstruct("idsy",tokPart a,tokPosn a)
+        npRestore a
+        false
+
+npInfGeneric s== npDDInfKey s  and
+                   (npEqKey "BACKSET" or true)
+
+npConditional f==
+  if  npEqKey "IF" and (npLogical() or npTrap()) and
+                   (npEqKey "BACKSET" or true)
+  then
+           if npEqKey "SETTAB"
+           then if npEqKey "THEN"
+                then  (APPLY(f,nil) or npTrap()) and npElse(f)
+                        and npEqKey "BACKTAB"
+                else  npMissing "then"
+           else if npEqKey "THEN"
+                then (APPLY(f,nil) or npTrap()) and npElse(f)
+                else npMissing "then"
+  else false
+
+npElse(f)==
+           a:=npState()
+           if npBacksetElse()
+           then  (APPLY(f,nil) or npTrap()) and
+                 npPush pfIf(npPop3(),npPop2(),npPop1())
+           else
+              npRestore a
+              npPush pfIfThenOnly(npPop2(),npPop1())
+
+npBacksetElse()==
+    if npEqKey "BACKSET"
+    then npEqKey "ELSE"
+    else npEqKey "ELSE"
+
+npWConditional f==
+    if npConditional f
+    then npPush pfTweakIf npPop1()
+    else false
+
+-- Parsing functions
+
+-- peek for keyword s, no advance of token stream
+
+npEqPeek s ==  EQ(CAAR $stok,"key") and EQ(s,$ttok)
+
+-- test for keyword s, if found advance token stream
+
+npEqKey s ==
+    EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext()
+
+$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"]
+
+npId() ==
+        EQ(CAAR $stok,"id") =>
+               npPush $stok
+               npNext()
+        EQ(CAAR $stok,"key") and MEMQ($ttok,$npTokToNames)=>
+               npPush tokConstruct("id",$ttok,tokPosn $stok)
+               npNext()
+        false
+
+npSymbolVariable()==
+     a:=npState()
+     npEqKey "BACKQUOTE" and  npId()  =>
+          a:=npPop1()
+          npPush tokConstruct("idsy",tokPart a,tokPosn a)
+     npRestore a
+     false
+
+npName()==npId() or npSymbolVariable()
+
+npConstTok() ==
+     MEMQ(tokType $stok, '(integer string char float command)) =>
+          npPush $stok
+          npNext()
+     npEqPeek "'" =>
+          a:=$stok
+          b:=npState()
+          npNext()
+          if
+              npPrimary1() and npPush pfSymb(npPop1(),tokPosn a)
+          then true
+          else
+            npRestore b
+            false
+     false
+
+
+npPrimary1() ==
+   npEncAp function npAtom1 or
+   npLet() or
+   npFix() or
+   npMacro() or
+   npBPileDefinition() or npDefn() or
+   npRule()
+
+npPrimary2()== npEncAp function npAtom2 -- or  npBPileDefinition()
+               or npAdd(pfNothing()) or npWith(pfNothing())
+
+
+npAtom1()== npPDefinition() or ((npName() or npConstTok() or
+       npDollar() or npBDefinition()) and npFromdom())
+
+npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon())
+                           and npFromdom()
+
+npDollar()== npEqPeek "$" and
+   npPush tokConstruct("id","$",tokPosn $stok)
+   npNext()
+
+npPrefixColon()== npEqPeek "COLON" and
+   npPush tokConstruct("id",":",tokPosn $stok)
+   npNext()
+
+-- silly
+
+npEncAp(f)== APPLY(f,nil) and npAnyNo function npEncl
+                   and npFromdom()
+
+
+npEncl()==  npBDefinition() and npPush pfApplication(npPop2(),npPop1())
+
+npFromdom()==
+  npEqKey "$" and (npApplication() or npTrap())
+      and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),npPop1())
+         or true
+
+npFromdom1 c==
+  npEqKey "$" and (npApplication() or npTrap())
+    and npFromdom1 npPop1()  and npPush pfFromDom(npPop1(),c)
+        or npPush c
+
+
+npPrimary()==   npPrimary1() or npPrimary2()
+
+npDotted f== APPLY(f,nil) and npAnyNo function npSelector
+
+npSelector()==
+            npEqKey "DOT" and (npPrimary() or npTrap()) and
+              npPush(pfApplication(npPop2(),npPop1()))
+
+npApplication()==
+   npDotted function npPrimary and
+      (npApplication2() and
+            npPush(pfApplication(npPop2(),npPop1())) or true)
+
+
+npApplication2()==
+   npDotted function npPrimary1 and
+      (npApplication2() and
+            npPush(pfApplication(npPop2(),npPop1())) or true)
+
+npTypedForm1(sy,fn) ==
+     npEqKey sy  and (npType() or npTrap()) and
+        npPush FUNCALL(fn,npPop2(),npPop1())
+
+npTypedForm(sy,fn) ==
+     npEqKey sy  and (npApplication() or npTrap()) and
+        npPush FUNCALL(fn,npPop2(),npPop1())
+
+npRestrict() == npTypedForm("AT",function pfRestrict)
+
+npCoerceTo() == npTypedForm("COERCE",function pfCoerceto)
+
+npColonQuery() == npTypedForm("ATAT",function pfRetractTo)
+
+npPretend() == npTypedForm("PRETEND",function pfPretend)
+
+npTypeStyle()==
+ npCoerceTo() or npRestrict() or npPretend() or npColonQuery()
+
+npTypified ()==npApplication() and npAnyNo function npTypeStyle
+
+npTagged() == npTypedForm1("COLON",function pfTagged)
+
+npColon () == npTypified() and npAnyNo function npTagged
+
+npPower() == npRightAssoc('(POWER CARAT),function npColon)
+
+npProduct()==
+    npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH
+       BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH )
+                       ,function npPower)
+
+npRemainder()==
+    npLeftAssoc('(REM QUO )  ,function npProduct)
+
+npTerm()==
+   npInfGeneric '(MINUS PLUS) and (npRemainder()
+        and npPush(pfApplication(npPop2(),npPop1())) or true)
+             or npRemainder()
+
+
+npSum()==npLeftAssoc('(PLUS MINUS),function npTerm)
+
+npArith()==npLeftAssoc('(MOD),function npSum)
+
+npSegment()==  npEqPeek "SEG"  and npPushId() and npFromdom()
+
+npInterval()==
+  npArith() and
+   (npSegment() and ((npEqPeek "BAR"
+      and npPush(pfApplication(npPop1(),npPop1()))) or
+     (npArith() and npPush(pfInfApplication(npPop2(),npPop2(),npPop1())))
+            or npPush(pfApplication(npPop1(),npPop1()))) or true)
+
+npBy()== npLeftAssoc ('(BY),function npInterval)
+
+npAmpersand()==  npEqKey "AMPERSAND" and (npName() or npTrap())
+npAmpersandFrom()== npAmpersand()  and npFromdom()
+
+npSynthetic()==
+    if npBy()
+    then
+       while npAmpersandFrom()  and (npBy() or
+          (npPush pfApplication(npPop2(),npPop1());false)) repeat
+             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
+       true
+    else false
+
+npRelation()==
+   npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE),
+            function npSynthetic)
+
+npQuiver()  ==    npRightAssoc('(ARROW LARROW),function npRelation)
+npDiscrim() ==    npLeftAssoc ('(CASE HAS), function npQuiver)
+
+npDisjand() ==    npLeftAssoc('(AND ),function npDiscrim)
+
+npLogical()   ==  npLeftAssoc('(OR ),function npDisjand)
+npSuch() == npLeftAssoc( '(BAR),function npLogical)
+npMatch()   ==    npLeftAssoc ('(IS ISNT ), function npSuch)
+
+npType()    ==  npMatch()  and
+                a:=npPop1()
+                npWith(a) or npPush a
+
+npADD()    ==   npType() and
+                a:=npPop1()
+                npAdd(a) or npPush a
+
+npConditionalStatement()==npConditional function npQualifiedDefinition
+
+npExpress1()==npConditionalStatement() or  npADD()
+
+npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true)
+
+npExpress()==
+     npExpress1() and
+        (npIterators() and
+             npPush pfCollect (npPop2(),pfListOf npPop1()) or true)
+
+npZeroOrMore f==
+       APPLY(f,nil)=>
+         a:=$stack
+         $stack:=nil
+         while APPLY(f,nil) repeat 0
+         $stack:=cons(NREVERSE $stack,a)
+         npPush cons(npPop2(),npPop1())
+       npPush nil
+       true
+
+npIterators()==
+         npForIn() and npZeroOrMore function npIterator
+             and npPush cons(npPop2(),npPop1())  or
+              npWhile() and (npIterators() and
+                    npPush cons(npPop2(),npPop1()) or npPush [npPop1()])
+
+npIterator()==   npForIn() or npSuchThat() or npWhile()
+
+npStatement()==
+        npExpress() or
+        npLoop() or
+        npIterate() or
+        npReturn() or
+        npBreak() or
+        npFree() or
+        npImport() or
+        npInline() or
+        npLocal() or
+        npExport() or
+        npTyping() or
+        npVoid()
+
+npBackTrack(p1,p2,p3)==
+     a:=npState()
+     APPLY(p1,nil) =>
+         npEqPeek p2   =>
+            npRestore a
+            APPLY(p3,nil) or npTrap()
+         true
+     false
+
+npMDEF()== npBackTrack(function npStatement,"MDEF",function npMDEFinition)
+
+npMDEFinition() == npPP function npMdef
+
+npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment)
+
+npAssignment()==
+    npAssignVariable() and
+      (npEqKey "BECOMES" or npTrap()) and
+        (npGives() or npTrap()) and
+           npPush pfAssign (npPop2(),npPop1())
+
+npAssignVariableName()==npApplication() and
+      a:=npPop1()
+      if pfId? a
+      then
+         (npPush a and npDecl() or npPush pfTyped(npPop1(),pfNothing()))
+      else npPush a
+
+npAssignVariable()== npColon() and npPush pfListOf [npPop1()]
+
+npAssignVariablelist()== npListing function npAssignVariableName
+
+npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit)
+
+npPileExit()==
+     npAssign() and (npEqKey "EXIT" or npTrap()) and
+         (npStatement() or npTrap())
+           and npPush pfExit (npPop2(),npPop1())
+
+npGives()== npBackTrack(function npExit,"GIVES",function npLambda)
+
+npDefinitionOrStatement()==
+            npBackTrack(function npGives,"DEF",function npDef)
+
+npVoid()== npAndOr("DO",function npStatement,function pfNovalue)
+
+npReturn()==
+         npEqKey "RETURN" and
+          (npExpress() or npPush pfNothing()) and
+           (npEqKey "FROM" and (npName() or npTrap()) and
+              npPush pfReturn (npPop2(),npPop1()) or
+                npPush pfReturnNoName npPop1())
+npLoop()==
+     npIterators() and
+      (npCompMissing "REPEAT" and
+         (npAssign() or npTrap()) and
+            npPush pfLp(npPop2(),npPop1()))
+                or
+                  npEqKey "REPEAT" and (npAssign() or npTrap()) and
+                       npPush pfLoop1 npPop1 ()
+
+npSuchThat()==npAndOr("BAR",function npLogical,function pfSuchthat)
+
+npWhile()==npAndOr ("WHILE",function npLogical,function pfWhile)
+
+npForIn()==
+  npEqKey "FOR" and (npVariable() or npTrap()) and (npCompMissing "IN")
+      and ((npBy()  or npTrap()) and
+         npPush pfForin(npPop2(),npPop1()))
+
+npBreak()==
+     npEqKey "BREAK" and  npPush pfBreak pfNothing ()
+
+npIterate()==
+     npEqKey "ITERATE" and  npPush pfIterate pfNothing ()
+
+npQualType()==
+     npType() and
+            npPush pfQualType(npPop1(),pfNothing())
+
+npSQualTypelist()== npListing function npQualType
+                and npPush pfParts npPop1 ()
+
+npQualTypelist()== npPC function npSQualTypelist
+                             and npPush pfUnSequence npPop1 ()
+
+npImport()==npAndOr("IMPORT",function npQualTypelist,function pfImport)
+
+npInline()==npAndOr("INLINE",function npQualTypelist,function pfInline)
+
+npLocalDecl()== npEqKey "COLON" and (npType() or npTrap()) and
+             npPush pfSpread (pfParts npPop2(),npPop1()) or
+              npPush pfSpread (pfParts npPop1(),pfNothing())
+
+npLocalItem()==npTypeVariable() and  npLocalDecl()
+
+npLocalItemlist()== npPC function npSLocalItem
+                             and npPush pfUnSequence npPop1 ()
+
+npSLocalItem()== npListing function npLocalItem
+        and npPush  pfAppend pfParts npPop1()
+
+npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap())
+     and npPush pfFree npPop1()
+
+npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap())
+     and npPush pfLocal npPop1()
+npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap())
+     and npPush pfExport npPop1()
+
+npLet()== npLetQualified function npDefinitionOrStatement
+
+npDefn()== npEqKey "DEFN" and  npPP function npDef
+
+npFix()== npEqKey "FIX" and  npPP function npDef
+               and npPush pfFix npPop1 ()
+
+npMacro()== npEqKey "MACRO" and  npPP function npMdef
+
+npRule()== npEqKey "RULE" and  npPP function npSingleRule
+
+npAdd(extra)==
+     npEqKey "ADD" and
+       a:=npState()
+       npDefinitionOrStatement() or npTrap()
+       npEqPeek "IN" =>
+               npRestore a
+               (npVariable() or npTrap()) and
+                     npCompMissing "IN"  and
+                         (npDefinitionOrStatement() or npTrap()) and
+                            npPush pfAdd(npPop2(),npPop1(),extra)
+       npPush pfAdd(pfNothing(),npPop1(),extra)
+
+npDefaultValue()==
+      npEqKey "DEFAULT" and
+             (npDefinitionOrStatement() or npTrap())
+         and  npPush [pfAdd(pfNothing(),npPop1(),pfNothing())]
+
+npWith(extra)==
+     npEqKey "WITH" and
+       a:=npState()
+       npCategoryL() or npTrap()
+       npEqPeek "IN" =>
+               npRestore a
+               (npVariable() or npTrap()) and
+                     npCompMissing "IN"  and
+                          (npCategoryL() or npTrap()) and
+                              npPush pfWith(npPop2(),npPop1(),extra)
+       npPush pfWith(pfNothing(),npPop1(),extra)
+
+npCategoryL()== npCategory() and npPush pfUnSequence npPop1 ()
+
+pfUnSequence x==
+        pfSequence? x =>   pfListOf pfAppend pf0SequenceArgs  x
+        pfListOf x
+
+npCategory()== npPP function npSCategory
+
+npSCategory()==
+  if npWConditional function npCategoryL
+  then  npPush [npPop1()]
+  else
+    if npDefaultValue()
+    then true
+    else
+      a:=npState()
+      if npPrimary()
+      then if npEqPeek "COLON"
+           then
+              npRestore a
+              npSignature()
+           else
+              npRestore a
+              npApplication() and npPush [pfAttribute (npPop1())]
+                           or npTrap()
+
+      else false
+
+
+npSignatureDefinee()==
+   npName() or npInfixOperator() or npPrefixColon()
+
+
+npSigDecl()== npEqKey "COLON" and (npType() or npTrap()) and
+           npPush pfSpread (pfParts npPop2(),npPop1())
+
+npSigItem()==npTypeVariable() and  (npSigDecl() or npTrap())
+
+npSigItemlist()== npListing function npSigItem
+        and npPush pfListOf pfAppend pfParts npPop1()
+
+npSignature()==
+    npSigItemlist() and
+            npPush pfWDec(pfNothing(),npPop1())
+
+npSemiListing (p)==
+       npListofFun(p,function npSemiBackSet,function pfAppend)
+
+npSemiBackSet()== npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true)
+npDecl()== npEqKey "COLON" and (npType() or npTrap()) and
+           npPush pfTyped (npPop2(),npPop1())
+
+npVariableName()==npName() and
+      (npDecl() or npPush pfTyped(npPop1(),pfNothing()))
+
+npVariable()== npParenthesized function npVariablelist or
+      (npVariableName() and npPush pfListOf [npPop1()])
+
+npVariablelist()== npListing function npVariableName
+
+npListing (p)==npList(p,"COMMA",function pfListOf)
+npQualified(f)==
+    if FUNCALL f
+    then
+     while npEqKey "WHERE" and (npDefinition() or npTrap()) repeat
+             npPush pfWhere(npPop1(),npPop1())
+     true
+    else  npLetQualified  f
+
+npLetQualified f==
+      npEqKey "LET" and
+      (npDefinition() or npTrap()) and
+      npCompMissing "IN"  and
+      (FUNCALL f or npTrap()) and
+      npPush pfWhere(npPop2(),npPop1())
+
+
+npQualifiedDefinition()==
+       npQualified function npDefinitionOrStatement
+
+npTuple (p)==
+    npListofFun(p,function npCommaBackSet,function pfTupleListOf)
+npComma()==  npTuple function npQualifiedDefinition
+
+npQualDef()== npComma() and npPush [npPop1()]
+
+npDefinitionlist ()==npSemiListing(function npQualDef)
+
+npPDefinition ()==
+     npParenthesized function npDefinitionlist and
+                 npPush pfEnSequence npPop1()
+
+npBDefinition()== npPDefinition() or
+            npBracketed function npDefinitionlist
+
+npPileDefinitionlist()==
+ npListAndRecover function npDefinitionlist
+    and npPush pfAppend npPop1()
+
+
+npTypeVariable()== npParenthesized function npTypeVariablelist or
+           npSignatureDefinee() and npPush pfListOf [npPop1()]
+
+npTypeVariablelist()== npListing function npSignatureDefinee
+
+npTyping()==
+      npEqKey "DEFAULT" and  (npDefaultItemlist() or npTrap())
+                and npPush pfTyping npPop1()
+
+npDefaultItemlist()== npPC function npSDefaultItem
+                             and npPush pfUnSequence npPop1 ()
+
+npDefaultDecl()== npEqKey "COLON" and (npType() or npTrap()) and
+           npPush pfSpread (pfParts npPop2(),npPop1())
+
+npDefaultItem()==npTypeVariable() and (npDefaultDecl() or npTrap())
+
+npSDefaultItem()== npListing function npDefaultItem
+        and npPush pfAppend pfParts npPop1()
+
+npBPileDefinition()==
+     npPileBracketed function npPileDefinitionlist
+       and npPush pfSequence pfListOf npPop1 ()
+
+
+npLambda()==
+     (npVariable() and
+      ((npLambda() or npTrap()) and
+       npPush pfLam(npPop2(),npPop1()))) or
+         npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) or
+          npEqKey "COLON" and (npType() or npTrap()) and
+            npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap())
+               and
+                  npPush pfReturnTyped(npPop2(),npPop1())
+
+npDef()==
+    npMatch() =>
+         [op,arg,rt]:=  pfCheckItOut(npPop1())
+         npDefTail() or npTrap()
+         body:=npPop1()
+         null arg => npPush pfDefinition (op,body)
+         npPush pfDefinition (op,pfPushBody(rt,arg,body))
+    false
+
+--npDefTail()== npEqKey "DEF" and npDefinitionOrStatement()
+npDefTail()== (npEqKey "DEF" or npEqKey "MDEF") and npDefinitionOrStatement()
+
+npMdef()==
+    npQuiver() =>
+         [op,arg]:=  pfCheckMacroOut(npPop1())
+         npDefTail() or npTrap()
+         body:=npPop1()
+         null arg => npPush pfMacro (op,body)
+         npPush pfMacro (op,pfPushMacroBody(arg,body))
+    false
+
+
+npSingleRule()==
+    npQuiver() =>
+         npDefTail() or npTrap()
+         npPush pfRule (npPop2(),npPop1())
+    false
+
+npDefinitionItem()==
+   npTyping() or
+      npImport()  or
+          a:=npState()
+          npStatement() =>
+               npEqPeek "DEF" =>
+                  npRestore a
+                  npDef()
+               npRestore a
+               npMacro() or npDefn()
+          npTrap()
+
+npDefinition()== npPP function npDefinitionItem
+            and npPush  pfSequenceToList npPop1 ()
+
+pfSequenceToList x==
+        pfSequence? x =>  pfSequenceArgs  x
+        pfListOf [x]
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/cstream.boot.pamphlet b/src/interp/cstream.boot.pamphlet
new file mode 100644
index 00000000..c9d80c10
--- /dev/null
+++ b/src/interp/cstream.boot.pamphlet
@@ -0,0 +1,145 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp cstream.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+The input stream is parsed into a large s-expression by repeated calls
+to Delay. Delay takes a function f and an argument x and returns a list
+consisting of ("nonnullstream" f x). Eventually multiple calls are made
+and a large list structure is created that consists of 
+("nonnullstream" f x ("nonnullstream" f1 x1 ("nonnullstream" f2 x2...
+
+This delay structure is given to StreamNull which walks along the
+list looking at the head. If the head is "nonnullstream" then the
+function is applied to the argument.
+
+So, in effect, the input is "zipped up" into a Delay data structure
+which is then evaluated by calling StreamNull. This "zippered stream"
+parser was a research project at IBM and Axiom was the testbed (which
+explains the strange parsing technique).
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Stream Utilities
+ 
+npNull x== StreamNull x
+ 
+StreamNull x==
+  null x or EQCAR (x,"nullstream") => true
+  while EQCAR(x,"nonnullstream") repeat
+          st:=APPLY(CADR x,CDDR x)
+          RPLACA(x,CAR st)
+          RPLACD(x,CDR st)
+  EQCAR(x,"nullstream")
+ 
+Delay(f,x)==cons("nonnullstream",[f,:x])
+ 
+StreamNil:= ["nullstream"]
+ 
+incRgen s==Delay(function incRgen1,[s])
+ 
+incRgen1(:z)==
+        [s]:=z
+        a:=shoeread_-line s
+        if NULL a
+        then (CLOSE s;StreamNil)
+
+        else cons(a,incRgen s)
+ 
+incIgen n==Delay(function incIgen1,[n])
+incIgen1(:z)==
+        [n]:=z
+        n:=n+1
+        cons(n,incIgen n)
+ 
+incZip(g,f1,f2)==Delay(function incZip1,[g,f1,f2])
+incZip1(:z)==
+     [g,f1,f2]:=z
+     StreamNull f1 => StreamNil
+     StreamNull f2 => StreamNil
+     cons(FUNCALL(g,car f1,car f2),incZip(g,cdr f1,cdr f2))
+ 
+incAppend(x,y)==Delay(function incAppend1,[x,y])
+ 
+incAppend1(:z)==
+     [x,y]:=z
+     if StreamNull x
+     then if StreamNull y
+          then StreamNil
+          else y
+     else cons(car x,incAppend(cdr x,y))
+ 
+next(f,s)==Delay(function next1,[f,s])
+next1(:z)==
+      [f,s]:=z
+      StreamNull s=> StreamNil
+      h:= APPLY(f, [s])
+      incAppend(car h,next(f,cdr h))
+ 
+nextown(f,g,s)==Delay(function nextown1,[f,g,s])
+nextown1 (:z)==
+      [f,g,s]:=z
+      StreamNull s=>
+           spadcall1 g
+           StreamNil
+      StreamNull s
+      h:=spadcall2 (f, s)
+      incAppend(car h,nextown(f,g,cdr h))
+ 
+nextown2(f,g,e,x)==nextown(cons(f,e),cons(g,e),x)
+ 
+spadcall1(g)==
+    [impl, :env] := g
+    APPLY(impl, [env])
+ 
+spadcall2(f,args) ==
+    [impl, :env] := f
+    APPLY(impl, [args, env])
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/daase.lisp.pamphlet b/src/interp/daase.lisp.pamphlet
new file mode 100644
index 00000000..e5de9ba5
--- /dev/null
+++ b/src/interp/daase.lisp.pamphlet
@@ -0,0 +1,2043 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp daase.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{Database structure}
+In order to understand this program you need to understand some details
+of the structure of the databases it reads. Axiom has 5 databases,
+the interp.daase, operation.daase, category.daase, compress.daase, and
+browse.daase. The compress.daase is special and does not follow the
+normal database format.
+
+\subsection{KAF File Format}
+This documentation refers to KAF files which are random access files.
+NRLIB files are KAF files (look for NRLIB/index.KAF)
+The format of a random access file is
+\begin{verbatim}
+byte-offset-of-key-table
+first-entry
+second-entry
+...
+last-entry
+((key1 . first-entry-byte-address)
+ (key2 . second-entry-byte-address)
+ ...
+ (keyN . last-entry-byte-address))
+\end{verbatim}
+The key table is a standard lisp alist.
+
+To open a database you fetch the first number, seek to that location,
+and (read) which returns the key-data alist. To look up data you
+index into the key-data alist, find the ith-entry-byte-address,
+seek to that address, and (read).
+
+For instance, see src/share/algebra/USERS.DAASE/index.KAF
+
+One existing optimization is that if the data is a simple thing like a
+symbol then the nth-entry-byte-address is replaced by immediate data.
+
+Another existing one is a compression algorithm applied to the
+data so that the very long names don't take up so much space.
+We could probably remove the compression algorithm as 64k is no
+longer considered 'huge'. The database-abbreviation routine
+handles this on read and write-compress handles this on write.
+The squeeze routine is used to compress the keys, the unsqueeze
+routine uncompresses them. Making these two routines disappear
+should remove all of the compression.
+
+Indeed, a faster optimization is to simply read the whole database
+into the image before it is saved. The system would be easier to
+understand and the interpreter would be faster.
+
+The system uses another optimization: database contains a stamp
+(consisting of offset to the main list and build time).  Before
+saving the image selected data is fetched to memory.  When the
+saved image starts it checks if the stamp of saved data matches
+in-core data -- in case of agreement in-core data is used.
+Parts of the datatabase which was not pre-loaded is still
+(lazily) fetched from the filesystem.
+
+\subsection{Database Files}
+
+Database files are very similar to KAF files except that there
+is an optimization (currently broken) which makes the first
+item a pair of two numbers. The first number in the pair is
+the offset of the key-value table, the second is a time stamp.
+If the time stamp in the database matches the time stamp in
+the image the database is not needed (since the internal hash
+tables already contain all of the information). When the database
+is built the time stamp is saved in both the gcl image and the
+database.
+
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;;TTT 7/2/97
+; Regarding the 'ancestors field for a category: At database build
+; time there exists a *ancestors-hash* hash table that gets filled
+; with CATEGORY (not domain) ancestor information. This later provides
+; the information that goes into interp.daase This *ancestors-hash*
+; does not exist at normal runtime (it can be made by a call to
+; genCategoryTable). Note that the ancestor information in
+; *ancestors-hash* (and hence interp.daase) involves #1, #2, etc
+; instead of R, Coef, etc. The latter thingies appear in all
+; .NRLIB/index.KAF files. So we need to be careful when we )lib
+; categories and update the ancestor info.
+
+
+; This file contains the code to build, open and access the .DAASE
+; files this file contains the code to )library NRLIBS and asy files
+
+; There is a major issue about the data that resides in these
+; databases.  the fundamental problem is that the system requires more
+; information to build the databases than it needs to run the
+; interpreter.  in particular, MODEMAP.DAASE is constructed using
+; properties like "modemaps" but the interpreter will never ask for
+; this information.
+
+; So, the design is as follows:
+;  first, the MODEMAP.DAASE needs to be built. this is done by doing
+; a )library on ALL of the NRLIB files that are going into the system.
+; this will bring in "modemap" information and add it to the
+; *modemaps-hash* hashtable.
+;  next, database build proceeds, accessing the "modemap" property
+; from the hashtables. once this completes this information is never
+; used again.
+;  next, the interp.daase database is built. this contains only the
+; information necessary to run the interpreter. note that during the
+; running of the interpreter users can extend the system by do a
+; )library on a new NRLIB file. this will cause fields such as "modemap"
+; to be read and hashed.
+
+; In the old system each constructor (e.g. LIST) had one library directory
+; (e.g. LIST.NRLIB). this directory contained a random access file called
+; the index.KAF file. the interpreter needed this KAF file at runtime for
+; two entries, the operationAlist and the ConstructorModemap.
+; during the redesign for the new compiler we decided to merge all of
+; these .NRLIB/index.KAF files into one database, INTERP.DAASE.
+; requests to get information from this database are intended to be
+; cached so that multiple references do not cause additional disk i/o.
+; this database is left open at all times as it is used frequently by
+; the interpreter. one minor complication is that newly compiled files
+; need to override information that exists in this database.
+;   The design calls for constructing a random read (KAF format) file
+; that is accessed by functions that cache their results. when the
+; database is opened the list of constructor-index pairs is hashed
+; by constructor name. a request for information about a constructor
+; causes the information to replace the index in the hash table. since
+; the index is a number and the data is a non-numeric sexpr there is
+; no source of confusion about when the data needs to be read.
+;
+; The format of this new database is as follows:
+;
+;first entry:
+; an integer giving the byte offset to the constructor alist
+; at the bottom of the file
+;second and subsequent entries (one per constructor)
+; (operationAlist)
+; (constructorModemap)
+; ....
+;last entry: (pointed at by the first entry)
+; an alist of (constructor . index) e.g.
+;  ( (PI offset-of-operationAlist offset-of-constructorModemap)
+;   (NNI offset-of-operationAlist offset-of-constructorModemap)
+;    ....)
+; This list is read at open time and hashed by the car of each item.
+
+; the system has been changed to use the property list of the
+; symbols rather than hash tables. since we already hashed once
+; to get the symbol we need only an offset to get the property
+; list. this also has the advantage that eq hash tables no longer
+; need to be moved during garbage collection.
+;  there are 3 potential speedups that could be done. the best
+; would be to use the value cell of the symbol rather than the
+; property list but i'm unable to determine all uses of the
+; value cell at the present time.
+;  a second speedup is to guarantee that the property list is
+; a single item, namely the database structure. this removes
+; an assoc but leaves one open to breaking the system if someone
+; adds something to the property list. this was not done because
+; of the danger mentioned.
+;  a third speedup is to make the getdatabase call go away, either
+; by making it a macro or eliding it entirely. this was not done
+; because we want to keep the flexibility of changing the database
+; forms.
+
+; the new design does not use hash tables. the database structure
+; contains an entry for each item that used to be in a hash table.
+; initially the structure contains file-position pointers and
+; these are replaced by real data when they are first looked up.
+; the database structure is kept on the property list of the
+; constructor, thus, (get '|DenavitHartenbergMatrix| 'database)
+; will return the database structure object.
+
+; each operation has a property on its symbol name called 'operation
+; which is a list of all of the signatures of operations with that name.
+
+; -- tim daly
+
+(in-package "BOOT")
+
+(defstruct database
+ abbreviation               ; interp.
+ ancestors                  ; interp.
+ constructor                ; interp.
+ constructorcategory        ; interp.
+ constructorkind            ; interp.
+ constructormodemap         ; interp.
+ cosig                      ; interp.
+ defaultdomain              ; interp.
+ modemaps                   ; interp.
+ niladic                    ; interp.
+ object                     ; interp.
+ operationalist             ; interp.
+ documentation              ; browse.
+ constructorform            ; browse.
+ attributes                 ; browse.
+ predicates                 ; browse.
+ sourcefile                 ; browse.
+ parents                    ; browse.
+ users                      ; browse.
+ dependents                 ; browse.
+ spare                      ; superstition
+ ) ; database structure
+
+; there are only a small number of domains that have default domains.
+; rather than keep this slot in every domain we maintain a list here.
+
+(defvar *defaultdomain-list* '(
+  (|MultisetAggregate| |Multiset|)
+  (|FunctionSpace| |Expression|)
+  (|AlgebraicallyClosedFunctionSpace| |Expression|)
+  (|ThreeSpaceCategory| |ThreeSpace|)
+  (|DequeueAggregate| |Dequeue|)
+  (|ComplexCategory| |Complex|)
+  (|LazyStreamAggregate| |Stream|)
+  (|AssociationListAggregate| |AssociationList|)
+  (|QuaternionCategory| |Quaternion|)
+  (|PriorityQueueAggregate| |Heap|)
+  (|PointCategory| |Point|)
+  (|PlottableSpaceCurveCategory| |Plot3D|)
+  (|PermutationCategory| |Permutation|)
+  (|StringCategory| |String|)
+  (|FileNameCategory| |FileName|)
+  (|OctonionCategory| |Octonion|)))
+
+; this hash table is used to answer the question "does domain x
+; have category y?". this is answered by constructing a pair of
+; (x . y) and doing an equal hash into this table.
+
+(defvar *operation-hash* nil "given an operation name, what are its modemaps?")
+(defvar *hasCategory-hash* nil "answers x has y category questions")
+
+(defvar *miss* nil "print out cache misses on getdatabase calls")
+
+   ; note that constructorcategory information need only be kept for
+   ; items of type category. this will be fixed in the next iteration
+   ; when the need for the various caches are reviewed
+
+   ; note that the *modemaps-hash* information does not need to be kept
+   ; for system files. these are precomputed and kept in modemap.daase
+   ; however, for user-defined files these are needed.
+   ; currently these are added to the database for 2 reasons:
+   ;  there is a still-unresolved issue of user database extensions
+   ;  this information is used during database build time
+
+
+
+; this are the streams for the databases. they are always open.
+; there is an optimization for speeding up system startup. if the
+; database is opened and the ..-stream-stamp* variable matches the
+; position information in the database then the database is NOT
+; read in and is assumed to match the in-core version
+
+(defvar *compressvector* nil "a vector of things to compress in the databases")
+(defvar *compressVectorLength* 0 "length of the compress vector")
+(defvar *compress-stream* nil "an stream containing the compress vector")
+(defvar *compress-stream-stamp* 0 "*compress-stream* (position . time)")
+
+(defvar *interp-stream* nil "an open stream to the interpreter database")
+(defvar *interp-stream-stamp* 0 "*interp-stream* (position . time)")
+
+; this is indexed by operation, not constructor
+(defvar *operation-stream* nil "the stream to operation.daase")
+(defvar *operation-stream-stamp* 0 "*operation-stream* (position . time)")
+
+(defvar *browse-stream* nil "an open stream to the browser database")
+(defvar *browse-stream-stamp* 0 "*browse-stream* (position . time)")
+
+; this is indexed by (domain . category)
+(defvar *category-stream* nil "an open stream to the category table")
+(defvar *category-stream-stamp* 0 "*category-stream* (position . time)")
+
+(defvar *allconstructors* nil "a list of all the constructors in the system")
+(defvar *allOperations* nil "a list of all the operations in the system")
+
+(defvar *asharpflags* "-O -laxiom -Fasy -Flsp" "library compiler flags")
+
+(defun asharp (file &optional (flags *asharpflags*))
+ "call the asharp compiler"
+ (system::system
+   (concatenate 'string (|getEnv| "AXIOM") "/compiler/bin/axiomxl "
+    flags " " file)))
+
+(defun resethashtables ()
+ "set all -hash* to clean values. used to clean up core before saving system"
+ (setq *hascategory-hash* (make-hash-table :test #'equal))
+ (setq *operation-hash* (make-hash-table))
+ (setq *allconstructors* nil)
+ (setq *compressvector* nil)
+ (setq *compress-stream-stamp* '(0 . 0))
+ (compressopen)
+ (setq *interp-stream-stamp* '(0 . 0))
+ (interpopen)
+ (setq *operation-stream-stamp* '(0 . 0))
+ (operationopen)
+ (setq *browse-stream-stamp* '(0 . 0))
+ (browseopen)
+ (setq *category-stream-stamp* '(0 . 0))
+ (categoryopen) ;note: this depends on constructorform in browse.daase
+#-:CCL (initial-getdatabase)
+ (close *interp-stream*)
+ (close *operation-stream*)
+ (close *category-stream*)
+ (close *browse-stream*)
+#+:AKCL (gbc t)
+)
+
+(defun initial-getdatabase ()
+ "fetch data we want in the saved system"
+ (let (hascategory constructormodemapAndoperationalist operation constr)
+ (format t "Initial getdatabase~%")
+ (setq hascategory '(
+  (|Equation| . |Ring|)
+  (|Expression| . |CoercibleTo|) (|Expression| . |CommutativeRing|)
+  (|Expression| . |IntegralDomain|) (|Expression| . |Ring|)
+  (|Float| . |RetractableTo|)
+  (|Fraction| . |Algebra|) (|Fraction| . |CoercibleTo|)
+  (|Fraction| . |OrderedSet|) (|Fraction| . |RetractableTo|)
+  (|Integer| . |Algebra|) (|Integer| . |CoercibleTo|)
+  (|Integer| . |ConvertibleTo|) (|Integer| . |LinearlyExplicitRingOver|)
+  (|Integer| . |RetractableTo|)
+  (|List| . |CoercibleTo|) (|List| . |FiniteLinearAggregate|)
+  (|List| . |OrderedSet|)
+  (|Polynomial| . |CoercibleTo|) (|Polynomial| . |CommutativeRing|)
+  (|Polynomial| . |ConvertibleTo|) (|Polynomial| . |OrderedSet|)
+  (|Polynomial| . |RetractableTo|)
+  (|Symbol| . |CoercibleTo|) (|Symbol| . |ConvertibleTo|)
+  (|Variable| . |CoercibleTo|)))
+ (dolist (pair hascategory) (getdatabase pair 'hascategory))
+ (setq constructormodemapAndoperationalist '(
+  |BasicOperator|  |Boolean|
+  |CardinalNumber| |Color|  |Complex|
+  |Database|
+  |Equation| |EquationFunctions2| |Expression|
+  |Float| |Fraction| |FractionFunctions2|
+  |Integer| |IntegralDomain|
+  |Kernel|
+  |List|
+  |Matrix| |MappingPackage1|
+  |Operator| |OutputForm|
+  |NonNegativeInteger|
+  |ParametricPlaneCurve| |ParametricSpaceCurve| |Point| |Polynomial|
+  |PolynomialFunctions2| |PositiveInteger|
+  |Ring|
+  |SetCategory| |SegmentBinding| |SegmentBindingFunctions2| |DoubleFloat|
+  |SparseMultivariatePolynomial| |SparseUnivariatePolynomial| |Segment|
+  |String| |Symbol|
+  |UniversalSegment|
+  |Variable|  |Vector|))
+ (dolist (con constructormodemapAndoperationalist)
+  (getdatabase con 'constructormodemap)
+  (getdatabase con 'operationalist))
+ (setq operation '(
+  |+| |-| |*| |/| |**| |coerce| |convert| |elt| |equation|
+  |float| |sin| |cos| |map| |SEGMENT|))
+ (dolist (op operation) (getdatabase op 'operation))
+ (setq constr '( ;these are sorted least-to-most freq. delete early ones first
+  |Factored| |SparseUnivariatePolynomialFunctions2| |TableAggregate&|
+  |RetractableTo&| |RecursiveAggregate&| |UserDefinedPartialOrdering|
+  |None| |UnivariatePolynomialCategoryFunctions2| |IntegerPrimesPackage|
+  |SetCategory&| |IndexedExponents| |QuotientFieldCategory&| |Polynomial|
+  |EltableAggregate&| |PartialDifferentialRing&| |Set|
+  |UnivariatePolynomialCategory&| |FlexibleArray|
+  |SparseMultivariatePolynomial| |PolynomialCategory&|
+  |DifferentialExtension&| |IndexedFlexibleArray| |AbelianMonoidRing&|
+  |FiniteAbelianMonoidRing&| |DivisionRing&| |FullyLinearlyExplicitRingOver&|
+  |IndexedVector| |IndexedOneDimensionalArray| |LocalAlgebra| |Localize|
+  |Boolean| |Field&| |Vector| |IndexedDirectProductObject| |Aggregate&|
+  |PolynomialRing| |FreeModule| |IndexedDirectProductAbelianGroup|
+  |IndexedDirectProductAbelianMonoid| |SingletonAsOrderedSet|
+  |SparseUnivariatePolynomial| |Fraction| |Collection&| |HomogeneousAggregate&|
+  |RepeatedSquaring| |IntegerNumberSystem&| |AbelianSemiGroup&|
+  |AssociationList| |OrderedRing&| |SemiGroup&| |Symbol|
+  |UniqueFactorizationDomain&| |EuclideanDomain&| |IndexedAggregate&|
+  |GcdDomain&| |IntegralDomain&| |DifferentialRing&| |Monoid&| |Reference|
+  |UnaryRecursiveAggregate&| |OrderedSet&| |AbelianGroup&| |Algebra&|
+  |Module&| |Ring&| |StringAggregate&| |AbelianMonoid&|
+  |ExtensibleLinearAggregate&| |PositiveInteger| |StreamAggregate&|
+  |IndexedString| |IndexedList| |ListAggregate&| |LinearAggregate&|
+  |Character| |String| |NonNegativeInteger| |SingleInteger|
+  |OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |PrimitiveArray|
+  |Integer| |List| |OutputForm|))
+ (dolist (con constr)
+  (let ((c (concatenate 'string
+             (|getEnv| "AXIOM") "/algebra/"
+             (string (getdatabase con 'abbreviation)) ".o")))
+    (format t "   preloading ~a.." c)
+    (if (probe-file c)
+     (progn
+      (put con 'loaded c)
+      (load c)
+      (format t "loaded.~%"))
+     (format t "skipped.~%"))))
+ (format t "~%")))
+
+; format of an entry in interp.daase:
+;  (constructor-name
+;    operationalist
+;    constructormodemap
+;    modemaps		 -- this should not be needed. eliminate it.
+;    object		 -- the name of the object file to load for this con.
+;    constructorcategory -- note that this info is the cadar of the
+;	  constructormodemap for domains and packages so it is stored
+;	  as NIL for them. it is valid for categories.
+;    niladic		 -- t or nil directly
+;    unused
+;    cosig		 -- kept directly
+;    constructorkind	 -- kept directly
+;    defaultdomain	 -- a short list, for %i
+;    ancestors		 -- used to compute new category updates
+;  )
+(defun interpOpen ()
+ "open the interpreter database and hash the keys"
+ (declare (special $spadroot))
+ (let (constructors pos stamp dbstruct)
+  (setq *interp-stream* (open (DaaseName "interp.daase" nil)))
+  (setq stamp (read *interp-stream*))
+  (unless (equal stamp *interp-stream-stamp*)
+   (format t "   Re-reading interp.daase")
+   (setq *interp-stream-stamp* stamp)
+   (setq pos (car stamp))
+   (file-position *interp-stream* pos)
+   (setq constructors (read *interp-stream*))
+   (dolist (item constructors)
+    (setq item (unsqueeze item))
+    (setq *allconstructors* (adjoin (first item) *allconstructors*))
+    (setq dbstruct (make-database))
+    (setf (get (car item) 'database) dbstruct)
+    (setf (database-operationalist dbstruct) (second item))
+    (setf (database-constructormodemap dbstruct) (third item))
+    (setf (database-modemaps dbstruct) (fourth item))
+    (setf (database-object dbstruct) (fifth item))
+    (setf (database-constructorcategory dbstruct) (sixth item))
+    (setf (database-niladic dbstruct) (seventh item))
+    (setf (database-abbreviation dbstruct) (eighth item))
+    (setf (get (eighth item) 'abbreviationfor) (first item)) ;invert
+    (setf (database-cosig dbstruct) (ninth item))
+    (setf (database-constructorkind dbstruct) (tenth item))
+    (setf (database-ancestors dbstruct) (nth 11 item))))
+  (format t "~&")))
+
+; this is an initialization function for the constructor database
+; it sets up 2 hash tables, opens the database and hashes the index values
+
+; there is a slight asymmetry in this code. sourcefile information for
+; system files is only the filename and extension. for user files it
+; contains the full pathname. when the database is first opened the
+; sourcefile slot contains system names. the lookup function
+; has to prefix the $spadroot information if the directory-namestring is
+; null (we don't know the real root at database build time).
+; a object-hash table is set up to look up nrlib and ao information.
+; this slot is empty until a user does a )library call. we remember
+; the location of the nrlib or ao file for the users local library
+; at that time. a NIL result from this probe means that the
+; library is in the system-specified place. when we get into multiple
+; library locations this will also contain system files.
+
+
+; format of an entry in browse.daase:
+; ( constructorname
+;     sourcefile
+;     constructorform
+;     documentation
+;     attributes
+;     predicates
+; )
+
+(defun browseOpen ()
+ "open the constructor database and hash the keys"
+ (declare (special $spadroot))
+ (let (constructors pos stamp dbstruct)
+  (setq *browse-stream* (open (DaaseName "browse.daase" nil)))
+  (setq stamp (read *browse-stream*))
+  (unless (equal stamp *browse-stream-stamp*)
+   (format t "   Re-reading browse.daase")
+   (setq *browse-stream-stamp* stamp)
+   (setq pos (car stamp))
+   (file-position *browse-stream* pos)
+   (setq constructors (read *browse-stream*))
+   (dolist (item constructors)
+    (setq item (unsqueeze item))
+    (unless (setq dbstruct (get (car item) 'database))
+     (format t "browseOpen:~%")
+     (format t "the browse database contains a contructor ~a~%" item)
+     (format t "that is not in the interp.daase file. we cannot~%")
+     (format t "get the database structure for this constructor and~%")
+     (warn "will create a new one~%")
+     (setf (get (car item) 'database) (setq dbstruct (make-database)))
+     (setq *allconstructors* (adjoin item *allconstructors*)))
+    (setf (database-sourcefile dbstruct) (second item))
+    (setf (database-constructorform dbstruct) (third item))
+    (setf (database-documentation dbstruct) (fourth item))
+    (setf (database-attributes dbstruct) (fifth item))
+    (setf (database-predicates dbstruct) (sixth item))
+    (setf (database-parents dbstruct) (seventh item))))
+  (format t "~&")))
+
+(defun categoryOpen ()
+ "open category.daase and hash the keys"
+ (declare (special $spadroot))
+ (let (pos keys stamp)
+  (setq *category-stream* (open (DaaseName "category.daase" nil)))
+  (setq stamp (read *category-stream*))
+  (unless (equal stamp *category-stream-stamp*)
+   (format t "   Re-reading category.daase")
+   (setq *category-stream-stamp* stamp)
+   (setq pos (car stamp))
+   (file-position *category-stream* pos)
+   (setq keys (read *category-stream*))
+   (setq *hasCategory-hash* (make-hash-table :test #'equal))
+   (dolist (item keys)
+    (setq item (unsqueeze item))
+    (setf (gethash (first item) *hasCategory-hash*) (second item))))
+  (format t "~&")))
+
+(defun operationOpen ()
+ "read operation database and hash the keys"
+ (declare (special $spadroot))
+ (let (operations pos stamp)
+  (setq *operation-stream* (open (DaaseName "operation.daase" nil)))
+  (setq stamp (read *operation-stream*))
+  (unless (equal stamp *operation-stream-stamp*)
+   (format t "   Re-reading operation.daase")
+   (setq *operation-stream-stamp* stamp)
+   (setq pos (car stamp))
+   (file-position *operation-stream* pos)
+   (setq operations (read *operation-stream*))
+   (dolist (item operations)
+    (setq item (unsqueeze item))
+    (setf (gethash (car item) *operation-hash*) (cdr item))))
+  (format t "~&")))
+
+(defun addoperations (constructor oldmaps)
+ "add ops from a )library domain to *operation-hash*"
+ (declare (special *operation-hash*))
+ (dolist (map oldmaps) ; out with the old
+  (let (oldop op)
+   (setq op (car map))
+   (setq oldop (getdatabase op 'operation))
+   (setq oldop (lisp::delete (cdr map) oldop :test #'equal))
+   (setf (gethash op *operation-hash*) oldop)))
+ (dolist (map (getdatabase constructor 'modemaps)) ; in with the new
+  (let (op newmap)
+   (setq op (car map))
+   (setq newmap (getdatabase op 'operation))
+   (setf (gethash op *operation-hash*) (cons (cdr map) newmap)))))
+
+(defun showdatabase (constructor)
+ (format t "~&~a: ~a~%" 'constructorkind
+  (getdatabase constructor 'constructorkind))
+ (format t "~a: ~a~%" 'cosig
+  (getdatabase constructor 'cosig))
+ (format t "~a: ~a~%" 'operation
+  (getdatabase constructor 'operation))
+ (format t "~a: ~%" 'constructormodemap)
+  (pprint (getdatabase constructor 'constructormodemap))
+ (format t "~&~a: ~%" 'constructorcategory)
+  (pprint (getdatabase constructor 'constructorcategory))
+ (format t "~&~a: ~%" 'operationalist)
+  (pprint (getdatabase constructor 'operationalist))
+ (format t "~&~a: ~%" 'modemaps)
+  (pprint (getdatabase constructor 'modemaps))
+ (format t "~a: ~a~%" 'hascategory
+  (getdatabase constructor 'hascategory))
+ (format t "~a: ~a~%" 'object
+  (getdatabase constructor 'object))
+ (format t "~a: ~a~%" 'niladic
+  (getdatabase constructor 'niladic))
+ (format t "~a: ~a~%" 'abbreviation
+  (getdatabase constructor 'abbreviation))
+ (format t "~a: ~a~%" 'constructor?
+  (getdatabase constructor 'constructor?))
+ (format t "~a: ~a~%" 'constructor
+  (getdatabase constructor 'constructor))
+ (format t "~a: ~a~%" 'defaultdomain
+  (getdatabase constructor 'defaultdomain))
+ (format t "~a: ~a~%" 'ancestors
+  (getdatabase constructor 'ancestors))
+ (format t "~a: ~a~%" 'sourcefile
+  (getdatabase constructor 'sourcefile))
+ (format t "~a: ~a~%" 'constructorform
+  (getdatabase constructor 'constructorform))
+ (format t "~a: ~a~%" 'constructorargs
+  (getdatabase constructor 'constructorargs))
+ (format t "~a: ~a~%" 'attributes
+  (getdatabase constructor 'attributes))
+ (format t "~a: ~%" 'predicates)
+  (pprint (getdatabase constructor 'predicates))
+ (format t "~a: ~a~%" 'documentation
+  (getdatabase constructor 'documentation))
+ (format t "~a: ~a~%" 'parents
+  (getdatabase constructor 'parents)))
+
+(defun setdatabase (constructor key value)
+ (let (struct)
+  (when (symbolp constructor)
+   (unless (setq struct (get constructor 'database))
+    (setq struct (make-database))
+    (setf (get constructor 'database) struct))
+   (case key
+    (abbreviation
+     (setf (database-abbreviation struct) value)
+     (when (symbolp value)
+      (setf (get value 'abbreviationfor) constructor)))
+    (constructorkind
+     (setf (database-constructorkind struct) value))))))
+
+(defun deldatabase (constructor key)
+  (when (symbolp constructor)
+   (case key
+    (abbreviation
+     (setf (get constructor 'abbreviationfor) nil)))))
+
+(defun getdatabase (constructor key)
+ (declare (special $spadroot) (special *miss*))
+ (when (eq *miss* t) (format t "getdatabase call: ~20a ~a~%" constructor key))
+ (let (data table stream ignore struct)
+  (declare (ignore ignore))
+  (when (or (symbolp constructor)
+          (and (eq key 'hascategory) (pairp constructor)))
+  (case key
+; note that abbreviation, constructorkind and cosig are heavy hitters
+; thus they occur first in the list of things to check
+   (abbreviation
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+      (setq data (database-abbreviation struct))))
+   (constructorkind
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-constructorkind struct))))
+   (cosig
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-cosig struct))))
+   (operation
+    (setq stream *operation-stream*)
+    (setq data (gethash constructor *operation-hash*)))
+   (constructormodemap
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-constructormodemap struct))))
+   (constructorcategory
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-constructorcategory struct))
+     (when (null data) ;domain or package then subfield of constructormodemap
+      (setq data (cadar (getdatabase constructor 'constructormodemap))))))
+   (operationalist
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-operationalist struct))))
+   (modemaps
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-modemaps struct))))
+   (hascategory
+    (setq table  *hasCategory-hash*)
+    (setq stream *category-stream*)
+    (setq data (gethash constructor table)))
+   (object
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-object struct))))
+   (asharp?
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-object struct))))
+   (niladic
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-niladic struct))))
+   (constructor?
+    (when (setq struct (get constructor 'database))
+      (setq data (when (database-operationalist struct) t))))
+   (superdomain ; only 2 superdomains in the world
+    (case constructor
+     (|NonNegativeInteger|
+      (setq data '((|Integer|) (IF (< |#1| 0) |false| |true|))))
+     (|PositiveInteger|
+      (setq data '((|NonNegativeInteger|) (< 0 |#1|))))))
+   (constructor
+    (when (setq data (get constructor 'abbreviationfor))))
+   (defaultdomain
+    (setq data (cadr (assoc constructor *defaultdomain-list*))))
+   (ancestors
+    (setq stream *interp-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-ancestors struct))))
+   (sourcefile
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-sourcefile struct))))
+   (constructorform
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-constructorform struct))))
+   (constructorargs
+    (setq data (cdr (getdatabase constructor 'constructorform))))
+   (attributes
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-attributes struct))))
+   (predicates
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-predicates struct))))
+   (documentation
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-documentation struct))))
+   (parents
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-parents struct))))
+   (users
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-users struct))))
+   (dependents
+    (setq stream *browse-stream*)
+    (when (setq struct (get constructor 'database))
+     (setq data (database-dependents struct))))
+   (otherwise  (warn "~%(GETDATABASE ~a ~a) failed~%" constructor key)))
+  (when (numberp data)		       ;fetch the real data
+   (when *miss* (format t "getdatabase miss: ~20a ~a~%" key constructor))
+   (file-position stream data)
+   (setq data (unsqueeze (read stream)))
+   (case key ; cache the result of the database read
+    (operation           (setf (gethash constructor *operation-hash*) data))
+    (hascategory         (setf (gethash constructor *hascategory-hash*) data))
+    (constructorkind     (setf (database-constructorkind struct) data))
+    (cosig               (setf (database-cosig struct) data))
+    (constructormodemap  (setf (database-constructormodemap struct) data))
+    (constructorcategory (setf (database-constructorcategory struct) data))
+    (operationalist      (setf (database-operationalist struct) data))
+    (modemaps            (setf (database-modemaps struct) data))
+    (object              (setf (database-object struct) data))
+    (niladic             (setf (database-niladic struct) data))
+    (abbreviation        (setf (database-abbreviation struct) data))
+    (constructor         (setf (database-constructor struct) data))
+    (ancestors           (setf (database-ancestors struct) data))
+    (constructorform     (setf (database-constructorform struct) data))
+    (attributes          (setf (database-attributes struct) data))
+    (predicates          (setf (database-predicates struct) data))
+    (documentation       (setf (database-documentation struct) data))
+    (parents             (setf (database-parents struct) data))
+    (users               (setf (database-users struct) data))
+    (dependents          (setf (database-dependents struct) data))
+    (sourcefile          (setf (database-sourcefile struct) data))))
+   (case key ; fixup the special cases
+    (sourcefile
+     (when (and data (string= (directory-namestring data) "")
+	     (string= (pathname-type data) "spad"))
+      (setq data
+       (concatenate 'string $spadroot "/../../src/algebra/" data))))
+    (asharp?                               ; is this asharp code?
+     (if (consp data)
+      (setq data (cdr data))
+      (setq data nil)))
+    (object				   ; fix up system object pathname
+     (if (consp data)
+       (setq data
+	     (if (string= (directory-namestring (car data)) "")
+		 (concatenate 'string $spadroot "/algebra/" (car data) ".o")
+	       (car data)))
+      (when (and data (string= (directory-namestring data) ""))
+       (setq data (concatenate 'string $spadroot "/algebra/" data ".o")))))))
+  data))
+
+; )library top level command  -- soon to be obsolete
+
+(defun |with| (args)
+ (|library| args))
+
+; )library top level command
+
+(defun |library| (args)
+ (declare (special |$options|))
+ (declare (special |$newConlist|))
+ (setq original-directory (get-current-directory))
+ (setq |$newConlist| nil)
+ (localdatabase args |$options|)
+#+:CCL
+ (dolist (a args) (check-module-exists a))
+ (|extendLocalLibdb| |$newConlist|)
+ (system::chdir original-directory)
+ (tersyscommand))
+
+;; check-module-exists looks to see if a module exists in one of the current
+;; libraries and, if not, compiles it.  If the output-library exists but has not
+;; been opened then it opens it first.
+#+:CCL
+(defun check-module-exists (module)
+  (prog (|$options| mdate) 
+    (if (and (not output-library) (filep (or |$outputLibraryName| "user.lib")))
+        (seq (setq |$outputLibraryName| 
+               (if |$outputLibraryName| (truename |$outputLibraryName|)
+                   (make-pathname :directory (get-current-directory) 
+                                  :name "user.lib")))
+             (|openOutputLibrary| |$outputLibraryName|)))
+    (setq mdate (modulep module)) 
+    (setq |$options| '((|nolibrary| nil) (|quiet| nil)))
+    (|sayMSG| (format nil "   Checking for module ~s." (namestring module)))
+    (let* ((fn (concatenate 'string (namestring module) ".lsp"))
+           (fdate (filedate fn)) )
+          (if (and fdate (or (null mdate) (datelessp mdate fdate)))
+             (|compileAsharpLispCmd| (list fn))
+             (let* ((fn (concatenate 'string (namestring module) ".NRLIB"))
+                    (fdate (filedate fn)) )
+                   (if (and fdate (or (null mdate) (datelessp mdate fdate)))
+                       (|compileSpadLispCmd| (list fn))))))))
+  
+; localdatabase tries to find files in the order of:
+;  NRLIB/index.KAF
+;  .asy
+;  .ao, then asharp to .asy
+
+(defun localdatabase (filelist options &optional (make-database? nil))
+ "read a local filename and update the hash tables"
+ (labels (
+  (processOptions (options)
+   (let (only dir noexpose)
+    (when (setq only (assoc '|only| options))
+     (setq options (lisp::delete only options :test #'equal))
+     (setq only (cdr only)))
+    (when (setq dir (assoc '|dir| options))
+     (setq options (lisp::delete dir options :test #'equal))
+     (setq dir (second dir))
+     (when (null dir)
+      (|sayKeyedMsg| 'S2IU0002 nil) ))
+    (when (setq noexpose (assoc '|noexpose| options))
+     (setq options (lisp::delete noexpose options :test #'equal))
+     (setq noexpose 't) )
+    (when options
+     (format t "   Ignoring unknown )library option: ~a~%" options))
+    (values only dir noexpose)))
+  (processDir (dirarg thisdir)
+   (let (allfiles skipasos)
+    (system:chdir (string dirarg))
+    (setq allfiles (directory "*"))
+    (system:chdir thisdir)
+    (values
+     (mapcan #'(lambda (f)
+      (when (string-equal (pathname-type f) "NRLIB")
+       (list (concatenate 'string (namestring f) "/"
+			  vmlisp::*index-filename*)))) allfiles)
+     (mapcan #'(lambda (f)
+      (when (string= (pathname-type f) "asy")
+       (push (pathname-name f) skipasos)
+       (list (namestring f)))) allfiles)
+     (mapcan #'(lambda (f)
+      (when (and (string= (pathname-type f) "ao")
+	     (not (member (pathname-name f) skipasos :test #'string=)))
+       (list (namestring f))))
+     allfiles)
+     ;; At the moment we will only look for user.lib: others are taken care
+     ;; of by localasy and localnrlib.
+#+:CCL
+     (mapcan #'(lambda (f)
+      (when (and (string= (pathname-type f) "lib") (string= (pathname-name f) "user"))
+       (list (namestring f))))
+     allfiles)
+#-:CCL nil
+    ))))
+ (let (thisdir nrlibs asos asys libs object only dir key 
+      (|$forceDatabaseUpdate| t) noexpose)
+  (declare (special |$forceDatabaseUpdate|))
+  (setq thisdir (namestring (truename ".")))
+  (setq noexpose nil)
+  (multiple-value-setq (only dir noexpose) (processOptions options))
+     ;don't force exposure during database build
+  (if make-database? (setq noexpose t))
+  (when dir (multiple-value-setq (nrlibs asys asos libs) (processDir dir thisdir)))
+  (dolist (file filelist)
+   (let ((filename (pathname-name file))
+	 (namedir (directory-namestring file)))
+    (unless namedir (setq thisdir (concatenate 'string thisdir "/")))
+    (cond
+     ((setq file (probe-file
+       (concatenate 'string namedir filename ".NRLIB/"
+                    vmlisp::*index-filename*)))
+      (push (namestring file) nrlibs))
+     ((setq file (probe-file
+       (concatenate 'string namedir filename ".asy")))
+      (push (namestring file) asys))
+     ((setq file (probe-file
+       (concatenate 'string namedir filename ".ao")))
+      (push (namestring file) asos))
+     ('else (format t "   )library cannot find the file ~a.~%" filename)))))
+#+:CCL
+  (dolist (file libs) (|addInputLibrary| (truename file)))
+  (dolist (file (nreverse nrlibs))
+   (setq key (pathname-name (first (last (pathname-directory file)))))
+   (setq object (concatenate 'string (directory-namestring file) "code"))
+   (localnrlib key file object make-database? noexpose))
+  (dolist (file (nreverse asys))
+   (setq object
+    (concatenate 'string (directory-namestring file) (pathname-name file)))
+   (localasy (|astran| file) object only make-database? noexpose))
+  (dolist (file (nreverse asos))
+   (setq object
+    (concatenate 'string (directory-namestring file) (pathname-name file)))
+   (asharp file)
+   (setq file (|astran| (concatenate 'string (pathname-name file) ".asy")))
+   (localasy file object only make-database? noexpose))
+  (HCLEAR |$ConstructorCache|))))
+
+(defun localasy (asy object only make-database? noexpose)
+ "given an alist from the asyfile and the objectfile update the database"
+ (labels (
+  (fetchdata (alist index)
+     (cdr (assoc index alist :test #'string=))))
+  (let (cname kind key alist (systemdir? nil) oldmaps asharp-name dbstruct abbrev)
+#+:CCL
+  ;; Open the library
+  (let (lib)
+    (if (filep (setq lib (make-pathname :name object :type "lib")) )
+        (setq input-libraries (cons (open-library (truename lib)) input-libraries))))
+   (set-file-getter object)  ; sets the autoload property for G-object
+   (dolist (domain asy)
+     (setq key (first domain))
+     (setq alist (rest domain))
+     (setq asharp-name
+	   (foam::axiomxl-global-name (pathname-name object) key
+				     (lassoc '|typeCode| alist)))
+     (if (< (length alist) 4) ;we have a naked function object
+	 (let ((opname key)
+	       (modemap (car (LASSOC '|modemaps| alist))) )
+	   (setq oldmaps (getdatabase opname 'operation))
+	   (setf (gethash opname *operation-hash*)
+		 (adjoin (subst asharp-name opname (cdr modemap))
+			 oldmaps :test #'equal))
+	   (asharpMkAutoloadFunction object asharp-name))
+       (when (if (null only) (not (eq key '%%)) (member key only))
+	(setq *allOperations* nil)	  ; force this to recompute
+	(setq oldmaps (getdatabase key 'modemaps))
+        (setq dbstruct (make-database))
+        (setf (get key 'database) dbstruct)
+        (setq *allconstructors* (adjoin key *allconstructors*))
+        (setf (database-constructorform dbstruct)
+         (fetchdata alist "constructorForm"))
+        (setf (database-constructorkind dbstruct)
+         (fetchdata alist "constructorKind"))
+        (setf (database-constructormodemap dbstruct)
+         (fetchdata alist "constructorModemap"))
+        (unless (setf (database-abbreviation dbstruct)
+		      (fetchdata alist "abbreviation"))
+		(setf (database-abbreviation dbstruct) key)) ; default
+	(setq abbrev (database-abbreviation dbstruct))
+	(setf (get abbrev 'abbreviationfor) key)
+        (setf (database-constructorcategory dbstruct)
+         (fetchdata alist "constructorCategory"))
+        (setf (database-attributes dbstruct)
+         (fetchdata alist "attributes"))
+        (setf (database-sourcefile dbstruct)
+         (fetchdata alist "sourceFile"))
+        (setf (database-operationalist dbstruct)
+         (fetchdata alist "operationAlist"))
+        (setf (database-modemaps dbstruct)
+         (fetchdata alist "modemaps"))
+        (setf (database-documentation dbstruct)
+         (fetchdata alist "documentation"))
+        (setf (database-predicates dbstruct)
+         (fetchdata alist "predicates"))
+        (setf (database-niladic dbstruct)
+         (fetchdata alist "NILADIC"))
+	(addoperations key oldmaps)
+	(setq cname  (|opOf| (database-constructorform dbstruct)))
+	(setq kind (database-constructorkind dbstruct))
+	(if (null noexpose) (|setExposeAddConstr| (cons cname nil)))
+	(unless make-database?
+         (|updateDatabase| key cname systemdir?) ;makes many hashtables???
+         (|installConstructor| cname kind)
+          ;; following can break category database build
+	 (if (eq kind '|category|)
+	     (setf (database-ancestors dbstruct)
+		   (fetchdata alist "ancestors")))
+	 (if (eq kind '|domain|)
+	     (dolist (pair (cdr (assoc "ancestors" alist :test #'string=)))
+		     (setf (gethash (cons cname (caar pair)) *hascategory-hash*)
+			   (cdr pair))))
+	 (if |$InteractiveMode| (setq |$CategoryFrame| |$EmptyEnvironment|)))
+	(setf (database-cosig dbstruct)
+         (cons nil (mapcar #'|categoryForm?|
+          (cddar (database-constructormodemap dbstruct)))))
+        (setf (database-object dbstruct) (cons object asharp-name))
+        (if (eq kind '|category|)
+         (asharpMkAutoLoadCategory object cname asharp-name
+          (database-cosig dbstruct))
+         (asharpMkAutoLoadFunctor object cname asharp-name
+          (database-cosig dbstruct)))
+	(|sayKeyedMsg| 'S2IU0001 (list cname object))))))))
+
+(defun localnrlib (key nrlib object make-database? noexpose)
+ "given a string pathname of an index.KAF and the object update the database"
+ (labels (
+  (fetchdata (alist in index)
+   (let (pos)
+    (setq pos (third (assoc index alist :test #'string=)))
+    (when pos
+     (file-position in pos)
+     (read in)))))
+ (let (alist kind (systemdir? nil) pos constructorform oldmaps abbrev dbstruct)
+  (with-open-file (in nrlib)
+   (file-position in (read in))
+   (setq alist (read in))
+   (setq pos (third (assoc "constructorForm" alist :test #'string=)))
+   (file-position in pos)
+   (setq constructorform (read in))
+   (setq key (car constructorform))
+   (setq oldmaps (getdatabase key 'modemaps))
+   (setq dbstruct (make-database))
+   (setq *allconstructors* (adjoin key *allconstructors*))
+   (setf (get key 'database) dbstruct) ; store the struct, side-effect it...
+   (setf (database-constructorform dbstruct) constructorform)
+   (setq *allOperations* nil)	; force this to recompute
+   (setf (database-object dbstruct) object)
+   (setq abbrev
+     (intern (pathname-name (first (last (pathname-directory object))))))
+   (setf (database-abbreviation dbstruct) abbrev)
+   (setf (get abbrev 'abbreviationfor) key)
+   (setf (database-operationalist dbstruct) nil)
+   (setf (database-operationalist dbstruct)
+    (fetchdata alist in "operationAlist"))
+   (setf (database-constructormodemap dbstruct)
+    (fetchdata alist in "constructorModemap"))
+   (setf (database-modemaps dbstruct) (fetchdata alist in "modemaps"))
+   (setf (database-sourcefile dbstruct) (fetchdata alist in "sourceFile"))
+   (when make-database?
+    (setf (database-sourcefile dbstruct)
+     (file-namestring  (database-sourcefile dbstruct))))
+   (setf (database-constructorkind dbstruct)
+    (setq kind (fetchdata alist in "constructorKind")))
+   (setf (database-constructorcategory dbstruct)
+    (fetchdata alist in "constructorCategory"))
+   (setf (database-documentation dbstruct)
+    (fetchdata alist in "documentation"))
+   (setf (database-attributes dbstruct)
+    (fetchdata alist in "attributes"))
+   (setf (database-predicates dbstruct)
+    (fetchdata alist in "predicates"))
+   (setf (database-niladic dbstruct)
+    (when (fetchdata alist in "NILADIC") t))
+  (addoperations key oldmaps)
+  (unless make-database?
+   (if (eq kind '|category|)
+       (setf (database-ancestors dbstruct)
+	     (SUBLISLIS |$FormalMapVariableList| (cdr constructorform) (fetchdata alist in "ancestors"))))
+   (|updateDatabase| key key systemdir?) ;makes many hashtables???
+   (|installConstructor| key kind) ;used to be key cname ...
+   (|updateCategoryTable| key kind)
+   (if |$InteractiveMode| (setq |$CategoryFrame| |$EmptyEnvironment|)))
+  (setf (database-cosig dbstruct)
+    (cons nil (mapcar #'|categoryForm?|
+     (cddar (database-constructormodemap dbstruct)))))
+  (remprop key 'loaded)
+  (if (null noexpose) (|setExposeAddConstr| (cons key nil)))
+ #-:CCL
+  (setf (symbol-function key) ; sets the autoload property for cname
+    #'(lambda (&rest args)
+     (unless (get key 'loaded)
+      (|startTimingProcess| '|load|)
+      (|loadLibNoUpdate| key key object)) ; used to be cname key
+     (apply key args)))
+ #+:CCL
+  (let (lib)
+    (if (filep (setq lib (make-pathname :name object :type "lib")) )
+        (setq input-libraries (cons (open-library (truename lib)) input-libraries)))
+    (|unloadOneConstructor| (get abbrev 'abbreviationfor) abbrev) )
+  (|sayKeyedMsg| 'S2IU0001 (list key object))))))
+
+
+; making new databases consists of:
+;  1) reset all of the system hash tables
+;  *) set up Union, Record and Mapping
+;  2) map )library across all of the system files (fills the databases)
+;  3) loading some normally autoloaded files
+;  4) making some database entries that are computed (like ancestors)
+;  5) writing out the databases
+;  6) write out 'warm' data to be loaded into the image at build time
+; note that this process should be done in a clean image
+; followed by a rebuild of the system image to include
+; the new index pointers (e.g. *interp-stream-stamp*)
+; the system will work without a rebuild but it needs to
+; re-read the databases on startup. rebuilding the system
+; will cache the information into the image and the databases
+; are opened but not read, saving considerable startup time.
+; also note that the order the databases are written out is
+; critical. interp.daase depends on prior computations and has
+; to be written out last.
+
+(defun make-databases (ext dirlist)
+ (labels (
+    ;; these are types which have no library object associated with them.
+    ;; we store some constructed data to make them perform like library
+    ;; objects, the *operationalist-hash* key entry is used by allConstructors
+  (withSpecialConstructors ()
+   ; note: if item is not in *operationalist-hash* it will not be written
+   ; Category
+   (setf (get '|Category| 'database)
+     (make-database :operationalist nil :niladic t))
+   (push '|Category| *allconstructors*)
+   ; UNION
+   (setf (get '|Union| 'database)
+     (make-database :operationalist nil :constructorkind '|domain|))
+   (push '|Union| *allconstructors*)
+   ; RECORD
+   (setf (get '|Record| 'database)
+    (make-database :operationalist nil :constructorkind '|domain|))
+   (push '|Record| *allconstructors*)
+   ; MAPPING
+   (setf (get '|Mapping| 'database)
+    (make-database :operationalist nil :constructorkind '|domain|))
+   (push '|Mapping| *allconstructors*)
+   ; ENUMERATION
+   (setf (get '|Enumeration| 'database)
+    (make-database :operationalist nil :constructorkind '|domain|))
+   (push '|Enumeration| *allconstructors*)
+   )
+  (final-name (root) 
+    (format nil "~a.daase~a" root ext))
+  )
+ (let (d)
+  (declare (special |$constructorList|))
+  (do-symbols (symbol)
+   (when (get symbol 'database)
+    (setf (get symbol 'database) nil)))
+  (setq *hascategory-hash* (make-hash-table :test #'equal))
+  (setq *operation-hash* (make-hash-table))
+  (setq *allconstructors* nil)
+  (setq *compressvector* nil)
+  (withSpecialConstructors)
+  (localdatabase nil
+     (list (list '|dir| (namestring (truename "./")) ))
+     'make-database)
+  (dolist (dir dirlist)
+	  (localdatabase nil 
+			 (list (list '|dir| 
+				     (namestring (probe-file 
+						  (format nil "./~a" 
+							  dir)))))
+			 'make-database))
+;browse.daase
+#+:AKCL  (load (concatenate 'string (|getEnv| "AXIOM") "/autoload/topics"))  ;; hack
+  (|oldCompilerAutoloadOnceTrigger|)
+  (|browserAutoloadOnceTrigger|)
+#+:AKCL    (|mkTopicHashTable|)
+  (setq |$constructorList| nil) ;; affects buildLibdb
+  (|buildLibdb|)
+  (|dbSplitLibdb|)
+; (|dbAugmentConstructorDataTable|)
+  (|mkUsersHashTable|)
+  (|saveUsersHashTable|)
+  (|mkDependentsHashTable|)
+  (|saveDependentsHashTable|)
+; (|buildGloss|)
+  (write-compress)
+  (write-browsedb)
+  (write-operationdb)
+ ; note: genCategoryTable creates a new *hascategory-hash* table
+ ; this smashes the existing table and regenerates it.
+ ; write-categorydb does getdatabase calls to write the new information
+  (write-categorydb)
+  (dolist (con (|allConstructors|))
+   (let (dbstruct)
+     (when (setq dbstruct (get con 'database))
+	   (setf (database-cosig dbstruct)
+		 (cons nil (mapcar #'|categoryForm?|
+				   (cddar (database-constructormodemap dbstruct)))))
+	   (when (and (|categoryForm?| con)
+		      (= (length (setq d (|domainsOf| (list con) NIL NIL))) 1))
+		 (setq d (caar d))
+		 (when (= (length d) (length (|getConstructorForm| con)))
+		       (format t "   ~a has a default domain of ~a~%" con (car d))
+		       (setf (database-defaultdomain dbstruct) (car d)))))))
+					; note: genCategoryTable creates *ancestors-hash*. write-interpdb
+					; does gethash calls into it rather than doing a getdatabase call.
+  (write-interpdb)
+#+:AKCL  (write-warmdata)
+  (create-initializers)
+  (when (probe-file (final-name "compress"))
+	(delete-file (final-name "compress")))
+  (rename-file "compress.build" (final-name "compress"))
+  (when (probe-file (final-name "interp"))
+	(delete-file (final-name "interp")))
+  (rename-file "interp.build" (final-name "interp"))
+  (when (probe-file (final-name "operation"))
+	(delete-file (final-name "operation")))
+  (rename-file "operation.build" (final-name "operation"))
+  (when (probe-file (final-name "browse")) 
+	(delete-file (final-name "browse")))
+  (rename-file "browse.build" 
+	       (final-name "browse"))
+  (when (probe-file (final-name "category"))
+	(delete-file (final-name "category")))
+  (rename-file "category.build" 
+	       (final-name "category")))))
+
+(defun DaaseName (name erase?)
+ (let (daase filename)
+  (declare (special $spadroot))
+  (if (setq daase (|getEnv| "DAASE"))
+   (progn
+    (setq filename  (concatenate 'string daase "/algebra/" name))
+    (format t "   Using local database ~a.." filename))
+   (setq filename (concatenate 'string $spadroot "/algebra/" name)))
+  (when erase? (system::system (concatenate 'string "rm -f " filename)))
+  filename))
+
+;; rewrite this so it works in mnt
+;;(defun DaaseName (name erase?)
+;; (let (daase filename)
+;;  (declare (special $spadroot))
+;;  (if (setq daase (|getEnv| "DAASE"))
+;;   (progn
+;;    (setq filename  (concatenate 'string daase "/algebra/" name))
+;;    (format t "   Using local database ~a.." filename))
+;;   (setq filename (concatenate 'string $spadroot "/algebra/" name)))
+;;  (when erase? (system::system (concatenate 'string "rm -f " filename)))
+;;  filename))
+
+@
+\subsection{compress.daase}
+The compress database is special. It contains a list of symbols.
+The character string name of a symbol in the other databases is
+represented by a negative number. To get the real symbol back you
+take the absolute value of the number and use it as a byte index
+into the compress database. In this way long symbol names become
+short negative numbers.
+
+<<*>>=
+
+(defun compressOpen ()
+ (let (lst stamp pos)
+  (declare (special $spadroot))
+  (setq *compress-stream*
+    (open (DaaseName "compress.daase"  nil) :direction :input))
+  (setq stamp (read *compress-stream*))
+  (unless (equal stamp *compress-stream-stamp*)
+   (format t "   Re-reading compress.daase")
+   (setq *compress-stream-stamp* stamp)
+   (setq pos (car stamp))
+   (file-position *compress-stream* pos)
+   (setq lst (read *compress-stream*))
+   (setq *compressVectorLength* (car lst))
+   (setq *compressvector*
+     (make-array (car lst) :initial-contents (cdr lst))))))
+
+(setq *attributes* 
+      '(|nil| |infinite| |arbitraryExponent| |approximate| |complex|
+	|shallowMutable| |canonical| |noetherian| |central|
+	|partiallyOrderedSet| |arbitraryPrecision| |canonicalsClosed|
+	|noZeroDivisors| |rightUnitary| |leftUnitary|
+	|additiveValuation| |unitsKnown| |canonicalUnitNormal|
+	|multiplicativeValuation| |finiteAggregate| |shallowlyMutable|
+	|commutative|))
+
+(defun write-compress ()
+ (let (compresslist masterpos out)
+  (close *compress-stream*)
+  (setq out (open "compress.build" :direction :output))
+  (princ "                              " out)
+  (finish-output out)
+  (setq masterpos (file-position out))
+  (setq compresslist
+	(append (|allConstructors|) (|allOperations|) *attributes*))
+  (push "algebra" compresslist)
+  (push "failed" compresslist)
+  (push 'signature compresslist)
+  (push '|ofType| compresslist)
+  (push '|Join| compresslist)
+  (push 'and compresslist)
+  (push '|nobranch| compresslist)
+  (push 'category compresslist)
+  (push '|category| compresslist)
+  (push '|domain| compresslist)
+  (push '|package| compresslist)
+  (push 'attribute compresslist)
+  (push '|isDomain| compresslist)
+  (push '|ofCategory| compresslist)
+  (push '|Union| compresslist)
+  (push '|Record| compresslist)
+  (push '|Mapping| compresslist)
+  (push '|Enumeration| compresslist)
+  (setq *compressVectorLength* (length compresslist))
+  (setq *compressvector*
+    (make-array *compressVectorLength* :initial-contents compresslist))
+  (print (cons (length compresslist) compresslist) out)
+  (finish-output out)
+  (file-position out 0)
+  (print (cons masterpos (get-universal-time)) out)
+  (finish-output out)
+  (close out)))
+
+@
+\subsubsection{interp.daase} 
+\begin{verbatim}
+ format of an entry in interp.daase:
+  (constructor-name
+    operationalist
+    constructormodemap
+    modemaps		 -- this should not be needed. eliminate it.
+    object		 -- the name of the object file to load for this con.
+    constructorcategory -- note that this info is the cadar of the
+	  constructormodemap for domains and packages so it is stored
+	  as NIL for them. it is valid for categories.
+    niladic		 -- t or nil directly
+    unused
+    cosig		 -- kept directly
+    constructorkind	 -- kept directly
+    defaultdomain	 -- a short list, for %i
+    ancestors		 -- used to compute new category updates
+  )
+\end{verbatim}
+
+Here I'll try to outline the interp database write procedure
+
+\begin{verbatim}
+(defun write-interpdb ()
+ "build interp.daase from hash tables"
+ (declare (special $spadroot) (special *ancestors-hash*))
+ (let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
+	concategory categorypos kind niladic cosig abbrev defaultdomain
+	ancestors ancestorspos out)
+  (declare (special *print-pretty*))
+  (print "building interp.daase")
+
+; 1. We open the file we're going to create
+
+  (setq out (open "interp.build" :direction :output))
+
+; 2. We reserve some space at the top of the file for the key-time pair
+;    We will overwrite these spaces just before we close the file.
+
+  (princ "                              " out)
+
+; 3. Make sure we write it out
+  (finish-output out)
+
+; 4. For every constructor in the system we write the parts:
+
+  (dolist (constructor (|allConstructors|))
+   (let (struct)
+
+; 4a. Each constructor has a property list. A property list is a list
+;     of (key . value) pairs. The property we want is called 'database
+;     so there is a ('database . something) in the property list
+
+    (setq struct (get constructor 'database))
+
+; 5 We write the "operationsalist"
+; 5a. We remember the current file position before we write
+;     We need this information so we can seek to this position on read
+
+    (setq opalistpos (file-position out))
+
+; 5b. We get the "operationalist", compress it, and write it out
+
+    (print (squeeze (database-operationalist struct)) out)
+
+; 5c. We make sure it was written
+
+    (finish-output out)
+
+; 6 We write the "constructormodemap"
+; 6a. We remember the current file position before we write
+
+    (setq cmodemappos (file-position out))
+
+; 6b. We get the "constructormodemap", compress it, and write it out
+
+    (print (squeeze (database-constructormodemap struct)) out)
+
+; 6c. We make sure it was written
+
+    (finish-output out)
+
+; 7. We write the "modemaps"
+; 7a. We remember the current file position before we write
+
+    (setq modemapspos (file-position out))
+
+; 7b. We get the "modemaps", compress it, and write it out
+
+    (print (squeeze (database-modemaps struct)) out)
+
+; 7c. We make sure it was written
+
+    (finish-output out)
+
+; 8. We remember source file pathnames in the obj variable
+
+    (if (consp (database-object struct)) ; if asharp code ...
+     (setq obj
+      (cons (pathname-name (car (database-object struct)))
+            (cdr (database-object struct))))
+     (setq obj
+      (pathname-name
+        (first (last (pathname-directory (database-object struct)))))))
+
+; 9. We write the "constructorcategory", if it is a category, else nil
+; 9a. Get the constructorcategory and compress it
+
+    (setq concategory (squeeze (database-constructorcategory struct)))
+
+; 9b. If we have any data we write it out, else we don't write it
+;     Note that if there is no data then the byte index for the
+;     constructorcatagory will not be a number but will be nil.
+
+    (if concategory  ; if category then write data else write nil
+     (progn
+      (setq categorypos (file-position out))
+      (print concategory out)
+      (finish-output out))
+     (setq categorypos nil))
+
+; 10. We get a set of properties which are kept as "immediate" data
+;     This means that the key table will hold this data directly
+;     rather than as a byte index into the file.
+; 10a. niladic data
+
+    (setq niladic (database-niladic struct))
+
+; 10b. abbreviation data (e.g. POLY for polynomial)
+
+    (setq abbrev (database-abbreviation struct))
+
+; 10c. cosig data
+
+    (setq cosig (database-cosig struct))
+
+; 10d. kind data
+
+    (setq kind (database-constructorkind struct))
+
+; 10e. defaultdomain data
+
+    (setq defaultdomain (database-defaultdomain struct))
+
+; 11. The ancestor data might exist. If it does we fetch it, 
+;     compress it, and write it out. If it does not we place
+;     and immediate value of nil in the key-value table
+
+    (setq ancestors (squeeze (gethash constructor *ancestors-hash*))) ;cattable.boot
+    (if ancestors
+     (progn
+      (setq ancestorspos (file-position out))
+      (print ancestors out)
+      (finish-output out))
+     (setq ancestorspos nil))
+
+; 12. "master" is an alist. Each element of the alist has the name of
+;     the constructor and all of the above attributes. When the loop
+;     finishes we will have constructed all of the data for the key-value
+;     table
+
+    (push (list constructor opalistpos cmodemappos modemapspos
+      obj categorypos niladic abbrev cosig kind defaultdomain
+      ancestorspos) master)))
+
+; 13. The loop is done, we make sure all of the data is written
+
+  (finish-output out)
+
+; 14. We remember where the key-value table will be written in the file
+
+  (setq masterpos (file-position out))
+
+; 15. We compress and print the key-value table
+
+  (print (mapcar #'squeeze master) out)
+
+; 16. We make sure we write the table
+
+  (finish-output out)
+
+; 17. We go to the top of the file
+
+  (file-position out 0)
+
+; 18. We write out the (master-byte-position . universal-time) pair
+;     Note that if the universal-time value matches the value of
+;     *interp-stream-stamp* then there is no reason to read the
+;     interp database because all of the data is already cached in
+;     the image. This happens if you build a database and immediatly
+;     save the image. The saved image already has the data since we
+;     just wrote it out. If the *interp-stream-stamp* and the database
+;     time stamp differ we "reread" the database on startup. Actually
+;     we just open the database and fetch as needed. You can see fetches
+;     by setting the *miss* variable non-nil.
+
+  (print (cons masterpos (get-universal-time)) out)
+
+; 19. We make sure we write it.
+
+  (finish-output out)
+
+; 20 And we are done
+
+  (close out)))
+\end{verbatim}
+
+<<*>>=
+(defun write-interpdb ()
+ "build interp.daase from hash tables"
+ (declare (special $spadroot) (special *ancestors-hash*))
+ (let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
+	concategory categorypos kind niladic cosig abbrev defaultdomain
+	ancestors ancestorspos out)
+  (declare (special *print-pretty*))
+  (print "building interp.daase")
+  (setq out (open "interp.build" :direction :output))
+  (princ "                              " out)
+  (finish-output out)
+  (dolist (constructor (|allConstructors|))
+   (let (struct)
+    (setq struct (get constructor 'database))
+    (setq opalistpos (file-position out))
+    (print (squeeze (database-operationalist struct)) out)
+    (finish-output out)
+    (setq cmodemappos (file-position out))
+    (print (squeeze (database-constructormodemap struct)) out)
+    (finish-output out)
+    (setq modemapspos (file-position out))
+    (print (squeeze (database-modemaps struct)) out)
+    (finish-output out)
+    (if (consp (database-object struct)) ; if asharp code ...
+     (setq obj
+      (cons (pathname-name (car (database-object struct)))
+            (cdr (database-object struct))))
+     (setq obj
+      (pathname-name
+        (first (last (pathname-directory (database-object struct)))))))
+    (setq concategory (squeeze (database-constructorcategory struct)))
+    (if concategory  ; if category then write data else write nil
+     (progn
+      (setq categorypos (file-position out))
+      (print concategory out)
+      (finish-output out))
+     (setq categorypos nil))
+    (setq niladic (database-niladic struct))
+    (setq abbrev (database-abbreviation struct))
+    (setq cosig (database-cosig struct))
+    (setq kind (database-constructorkind struct))
+    (setq defaultdomain (database-defaultdomain struct))
+    (setq ancestors (squeeze (gethash constructor *ancestors-hash*))) ;cattable.boot
+    (if ancestors
+     (progn
+      (setq ancestorspos (file-position out))
+      (print ancestors out)
+      (finish-output out))
+     (setq ancestorspos nil))
+    (push (list constructor opalistpos cmodemappos modemapspos
+      obj categorypos niladic abbrev cosig kind defaultdomain
+      ancestorspos) master)))
+  (finish-output out)
+  (setq masterpos (file-position out))
+  (print (mapcar #'squeeze master) out)
+  (finish-output out)
+  (file-position out 0)
+  (print (cons masterpos (get-universal-time)) out)
+  (finish-output out)
+  (close out)))
+
+@
+\subsubsection{browse.daase}
+\begin{verbatim}
+ format of an entry in browse.daase:
+ ( constructorname
+     sourcefile
+     constructorform
+     documentation
+     attributes
+     predicates
+ )
+\end{verbatim}
+This is essentially the same overall process as write-interpdb.
+
+We reserve some space for the (key-table-byte-position . timestamp)
+
+We loop across the list of constructors dumping the data and
+remembering the byte positions in a key-value pair table.
+
+We dump the final key-value pair table, write the byte position and
+time stamp at the top of the file and close the file.
+
+<<*>>=
+(defun write-browsedb ()
+ "make browse.daase from hash tables"
+ (declare (special $spadroot))
+ (let (master masterpos src formpos docpos attpos predpos *print-pretty* out)
+  (declare (special *print-pretty*))
+  (print "building browse.daase")
+  (setq out (open "browse.build" :direction :output))
+  (princ "                              " out)
+  (finish-output out)
+  (dolist (constructor (|allConstructors|))
+   (let (struct)
+    (setq struct (get constructor 'database))
+     ; sourcefile is small. store the string directly
+    (setq src (database-sourcefile struct))
+    (setq formpos (file-position out))
+    (print (squeeze (database-constructorform struct)) out)
+    (finish-output out)
+    (setq docpos (file-position out))
+    (print (database-documentation struct) out)
+    (finish-output out)
+    (setq attpos (file-position out))
+    (print (squeeze (database-attributes struct)) out)
+    (finish-output out)
+    (setq predpos (file-position out))
+    (print (squeeze (database-predicates struct)) out)
+    (finish-output out)
+    (push (list constructor src formpos docpos attpos predpos) master)))
+  (finish-output out)
+  (setq masterpos (file-position out))
+  (print (mapcar #'squeeze master) out)
+  (finish-output out)
+  (file-position out 0)
+  (print (cons masterpos (get-universal-time)) out)
+  (finish-output out)
+  (close out)))
+
+@
+\subsubsection{category.daase}
+This is a single table of category hash table information, dumped in the 
+database format.
+<<*>>=
+(defun write-categorydb ()
+ "make category.daase from scratch. contains the *hasCategory-hash* table"
+ (let (out master pos *print-pretty*)
+  (declare (special *print-pretty*))
+  (print "building category.daase")
+  (|genCategoryTable|)
+  (setq out (open "category.build" :direction :output))
+  (princ "                              " out)
+  (finish-output out)
+  (maphash #'(lambda (key value)
+    (if (or (null value) (eq value t))
+     (setq pos value)
+     (progn
+      (setq pos (file-position out))
+      (print (squeeze value) out)
+      (finish-output out)))
+     (push (list key pos) master))
+     *hasCategory-hash*)
+  (setq pos (file-position out))
+  (print (mapcar #'squeeze master) out)
+  (finish-output out)
+  (file-position out 0)
+  (print (cons pos (get-universal-time)) out)
+  (finish-output out)
+  (close out)))
+
+(defun unsqueeze (expr)
+  (cond ((atom expr)
+	 (cond ((and (numberp expr) (<= expr 0))
+		(svref *compressVector* (- expr)))
+	       (t expr)))
+	(t (rplaca expr (unsqueeze (car expr)))
+	   (rplacd expr (unsqueeze (cdr expr)))
+	   expr)))
+
+(defun squeeze (expr)
+ (let (leaves pos (bound (length *compressvector*)))
+  (labels (
+   (flat (expr)
+    (when (and (numberp expr) (< expr 0) (>= expr bound))
+     (print expr)
+     (break "squeeze found a negative number"))
+    (if (atom expr)
+     (unless (or (null expr)
+                 (and (symbolp expr) (char= (schar (symbol-name expr) 0) #\*)))
+      (setq leaves (adjoin expr leaves)))
+     (progn
+      (flat (car expr))
+      (flat (cdr expr))))))
+  (setq leaves nil)
+  (flat expr)
+  (dolist (leaf leaves)
+   (when (setq pos (position leaf *compressvector*))
+     (nsubst (- pos) leaf expr)))
+  expr)))
+
+@
+\subsubsection{operation.daase}
+This is a single table of operations hash table information, dumped in the 
+database format.
+<<*>>=
+(defun write-operationdb ()
+ (let (pos master out)
+  (declare (special leaves))
+  (setq out (open "operation.build" :direction :output))
+  (princ "                              " out)
+  (finish-output out)
+  (maphash #'(lambda (key value)
+   (setq pos (file-position out))
+   (print (squeeze value) out)
+   (finish-output out)
+   (push (cons key pos) master))
+   *operation-hash*)
+  (finish-output out)
+  (setq pos (file-position out))
+  (print (mapcar #'squeeze master) out)
+  (file-position out 0)
+  (print (cons pos (get-universal-time)) out)
+  (finish-output out)
+  (close out)))
+
+(defun write-warmdata ()
+ "write out information to be loaded into the image at build time"
+ (declare (special |$topicHash|))
+ (with-open-file (out "warm.data" :direction :output)
+  (format out "(in-package \"BOOT\")~%")
+  (format out "(setq |$topicHash| (make-hash-table))~%")
+  (maphash #'(lambda (k v)
+   (format out "(setf (gethash '|~a| |$topicHash|) ~a)~%" k v)) |$topicHash|)))
+
+(defun |allConstructors| ()
+ (declare (special *allconstructors*))
+ *allconstructors*)
+
+(defun |allOperations| ()
+ (declare (special *allOperations*))
+ (unless *allOperations*
+  (maphash #'(lambda (k v) (declare (ignore v)) (push k *allOperations*))
+    *operation-hash*))
+ *allOperations*)
+
+; the variable NOPfuncall is a funcall-able object that is a dummy
+; initializer for libaxiom asharp domains.
+(defvar NOPfuncall (cons 'identity nil))
+
+(defun create-initializers ()
+;; since libaxiom is now built with -name=axiom following unnecessary
+;; (dolist (con (|allConstructors|))
+;;   (let ((sourcefile (getdatabase con 'sourcefile)))
+;;     (if sourcefile
+;;	 (set (foam::axiomxl-file-init-name (pathname-name sourcefile))
+;;	       NOPfuncall))))
+ (set (foam::axiomxl-file-init-name "axiom") NOPfuncall)
+;; (set (foam::axiomxl-file-init-name "axclique") NOPfuncall)
+ (set (foam::axiomxl-file-init-name "filecliq") NOPfuncall)
+ (set (foam::axiomxl-file-init-name "attrib") NOPfuncall)
+;; following needs to happen inside restart since $AXIOM may change
+ (let ((asharprootlib (strconc (|getEnv| "AXIOM") "/aldor/lib/")))
+   (set-file-getter (strconc asharprootlib "runtime"))
+   (set-file-getter (strconc asharprootlib "lang"))
+   (set-file-getter (strconc asharprootlib "attrib"))
+   (set-file-getter (strconc asharprootlib "axlit"))
+   (set-file-getter (strconc asharprootlib "minimach"))
+   (set-file-getter (strconc asharprootlib "axextend"))))
+
+
+
+;---------------------------------------------------------------------
+
+; how the magic works:
+;  when a )library is done on a new compiler file we set up multiple
+;  functions (refered to as autoloaders). there is an autoloader
+;  stored in the symbol-function of the G-filename (e.g. G-basic)
+;  (see set-file-getter function)
+;  and an autoloader stored in the symbol-function of every domain
+;  in the basic.as file ( asharpMkAutoloadFunctor )
+; When a domain is needed the autoloader for the domain is executed.
+;  this autoloader invokes file-getter-name to get the name of the
+;  file (eg basic) and evaluates the name. the FIRST time this is done
+;  for a file the file will be loaded by its autoloader, then it will
+;  return the file object. every other time the file is already
+;  loaded and the file object is returned directly.
+; Once the file object is gotten getconstructor is called to get the
+;  domain. the FIRST time this is done for the domain the autoloader
+;  invokes the file object. every other time the domain already
+;  exists.
+;(defvar *this-file* "no-file")
+
+(defmacro |CCall| (fun &rest args)
+  (let ((ccc (gensym)) (cfun (gensym)) (cenv (gensym)))
+    `(let ((,ccc ,fun))
+       (let ((,cfun (|ClosFun| ,ccc))
+	     (,cenv (|ClosEnv| ,ccc)))
+	 (funcall ,cfun ,@args ,cenv )))))
+
+(defmacro |ClosFun| (x) `(car ,x))
+(defmacro |ClosEnv| (x) `(cdr ,x))
+
+(defun file-runner (name)
+ (declare (special foam-user::|G-domainPrepare!|))
+  (|CCall| foam-user::|G-domainPrepare!| (|CCall| name)))
+
+(defun getConstructor (file-fn asharp-name)
+ (|CCall| file-fn)
+; (eval (cdr (assoc file-id (get name 'asharp-name) :test #'equal))))
+ (eval asharp-name))
+
+(defun getop (dom op type)
+ (declare (special foam-user::|G-domainGetExport!|))
+  (|CCall| foam-user::|G-domainGetExport!| dom
+      (|hashString| (symbol-name op)) type))
+
+; the asharp compiler will allow both constant domains and domains
+; which are functions. localasy sets the autoload property so that
+; the symbol-function contains a function that, when invoked with
+; the correct number of args will return a domain.
+
+; this function is called if we are given a new compiler domain
+; which is a function. the symbol-function of the domain is set
+; to call the function with the correct number of arguments.
+
+(defun wrapDomArgs (obj type?)
+  (cond ((not type?) obj)
+	(t (|makeOldAxiomDispatchDomain| obj))))
+
+;; CCL doesn't have closures, so we use an intermediate function in
+;; asharpMkAutoLoadFunctor.
+#+:CCL
+(defun mkFunctorStub (func cosig cname)
+  (setf (symbol-function cname)
+        (if (vectorp (car func))
+          `(lambda () ',func)  ;; constant domain
+          `(lambda (&rest args2)
+              (apply ',(|ClosFun| func)
+                 (nconc
+                    (mapcar #'wrapDomArgs args2 ',(cdr cosig))
+                    (list ',(|ClosEnv| func))))))))
+
+#+:CCL
+(defun asharpMkAutoLoadFunctor (file cname asharp-name cosig)
+  (setf (symbol-function cname)
+        `(lambda (&rest args)
+            (mkFunctorStub
+              (getconstructor (eval (file-getter-name ',file)) ',asharp-name)
+              ',cosig ',cname)
+            (apply ',cname args))))
+
+#-:CCL
+(defun asharpMkAutoLoadFunctor (file cname asharp-name cosig)
+  (setf (symbol-function cname)
+  #'(lambda (&rest args)
+     (let ((func (getconstructor (eval (file-getter-name file)) asharp-name)))
+      (setf (symbol-function cname)
+       (if (vectorp (car func))
+        #'(lambda () func) ;; constant domain
+        #'(lambda (&rest args)
+            (apply (|ClosFun| func)
+                   (nconc
+                    (mapcar #'wrapDomArgs args (cdr cosig))
+                    (list (|ClosEnv| func)))))))
+      (apply cname args)))))
+
+;; CCL doesn't have closures, so we use an intermediate function in
+;; asharpMkAutoLoadCategory.
+#+:CCL
+(defun mkCategoryStub (func cosig packname)
+  (setf (symbol-function packname)
+        (if (vectorp (car func))
+         `(lambda (self)  ;; constant category
+           (|CCall| (elt ',(car func) 5) ',(cdr func) (wrapDomArgs self t)))
+         `(lambda (self &rest args)
+           (let ((precat
+                  (apply (|ClosFun| ',func)
+                         (nconc
+                          (mapcar #'wrapDomArgs args ',(cdr cosig))
+                          (list (|ClosEnv| ',func))))))
+             (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t)))))
+))
+
+#+:CCL
+(defun asharpMkAutoLoadCategory (file cname asharp-name cosig)
+  (asharpMkAutoLoadFunctor file cname asharp-name cosig)
+  (let ((packname (INTERN (STRCONC cname "&"))))
+    (setf (symbol-function packname)
+          `(lambda (self &rest args)
+                 (mkCategoryStub
+                 (getconstructor (eval (file-getter-name ',file)) ',asharp-name)
+                 ',cosig ',packname)
+            (apply ',packname self args)))))
+
+#-:CCL
+(defun asharpMkAutoLoadCategory (file cname asharp-name cosig)
+  (asharpMkAutoLoadFunctor file cname asharp-name cosig)
+  (let ((packname (INTERN (STRCONC cname '"&"))))
+    (setf (symbol-function packname)
+  #'(lambda (self &rest args)
+     (let ((func (getconstructor (eval (file-getter-name file)) asharp-name)))
+      (setf (symbol-function packname)
+       (if (vectorp (car func))
+	#'(lambda (self)
+	    (|CCall| (elt (car func) 5) (cdr func) (wrapDomArgs self t))) ;; constant category
+	#'(lambda (self &rest args)
+	    (let ((precat
+		   (apply (|ClosFun| func)
+			  (nconc
+			   (mapcar #'wrapDomArgs args (cdr cosig))
+			   (list (|ClosEnv| func))))))
+	      (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t))))))
+      (apply packname self args))))))
+
+#+:CCL
+(defun asharpMkAutoLoadFunction (file asharpname)
+ (set asharpname
+  (cons
+   `(lambda (&rest l)
+     (let ((args (butlast l))
+           (func (getconstructor (eval (file-getter-name ',file)) ',asharpname)))
+        (apply (car func) (append args (list (cdr func))))))
+      ())))
+
+#-:CCL
+(defun asharpMkAutoLoadFunction (file asharpname)
+  (set asharpname
+   (cons
+    #'(lambda (&rest l)
+	(let ((args (butlast l))
+	      (func (getconstructor (eval (file-getter-name file)) asharpname)))
+	  (apply (car func) (append args (list (cdr func))))))
+	())))
+
+; this function will return the internal name of the file object getter
+
+(defun file-getter-name (filename)
+   (foam::axiomxl-file-init-name (pathname-name filename)))
+
+;;need to initialize |G-filename| to a function which loads file
+;; and then returns the new value of |G-filename|
+
+(defun set-file-getter (filename)
+  (let ((getter-name (file-getter-name filename)))
+    (set getter-name
+	 (cons #'init-file-getter  (cons getter-name filename)))))
+
+(defun init-file-getter (env)
+  (let ((getter-name (car env))
+	(filename (cdr env)))
+#-:CCL
+    (load filename)
+#+:CCL
+    (load-module filename)
+    (|CCall| (eval getter-name))))
+
+(defun set-lib-file-getter (filename cname)
+  (let ((getter-name (file-getter-name filename)))
+    (set getter-name
+	 (cons #'init-lib-file-getter  (cons getter-name cname)))))
+
+(defun init-lib-file-getter (env)
+  (let* ((getter-name (car env))
+	 (cname (cdr env))
+	 (filename (getdatabase cname 'object)))
+#-:CCL
+    (load filename)
+#+:CCL
+    (load-module (pathname-name filename))
+    (|CCall| (eval getter-name))))
+
+;; following 2 functions are called by file-exports and file-imports macros
+(defun foam::process-import-entry (entry)
+  (let* ((asharpname (car entry))
+	 (stringname (cadr entry))
+	 (hcode (caddr entry))
+	 (libname (cadddr entry))
+	 (bootname (intern stringname 'boot)))
+    (declare (ignore libname))
+    (if (and (eq hcode 'foam-user::|initializer|) (not (boundp asharpname)))
+	(error (format nil "AxiomXL file ~s is missing!" stringname)))
+    (unless (or (not (numberp hcode)) (zerop hcode) (boundp asharpname))
+	  (when (|constructor?| bootname)
+		(set asharpname
+		     (if (getdatabase bootname 'niladic)
+			 (|makeLazyOldAxiomDispatchDomain| (list bootname))
+		       (cons '|runOldAxiomFunctor|  bootname))))
+	  (when (|attribute?| bootname)
+		(set asharpname (|makeLazyOldAxiomDispatchDomain| bootname))))))
+	  
+		 
+
+;(defun foam::process-export-entry (entry)
+;  (let* ((asharpname (car entry))
+;	 (stringname (cadr entry))
+;	 (hcode (caddr entry))
+;	 (libname (cadddr entry))
+;	 (bootname (intern stringname 'boot)))
+;    (declare (ignore libname))
+;    (when (numberp hcode)
+;	  (setf (get bootname 'asharp-name)
+;		(cons (cons *this-file* asharpname)
+;		      (get bootname 'asharp-name)))
+;	  )))
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/database.boot.pamphlet b/src/interp/database.boot.pamphlet
new file mode 100644
index 00000000..f33d9333
--- /dev/null
+++ b/src/interp/database.boot.pamphlet
@@ -0,0 +1,697 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/database.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+SETANDFILEQ($getUnexposedOperations,true)
+
+--% Functions for manipulating MODEMAP DATABASE
+
+augLisplibModemapsFromCategory(form is [op,:argl],body,signature) ==
+  sl := [["$",:"*1"],:[[a,:p] for a in argl
+    for p in rest $PatternVariableList]]
+  form:= SUBLIS(sl,form)
+  body:= SUBLIS(sl,body)
+  signature:= SUBLIS(sl,signature)
+  opAlist:= SUBLIS(sl,$domainShell.(1)) or return nil
+  nonCategorySigAlist:=
+    mkAlistOfExplicitCategoryOps substitute("*1","$",body)
+  domainList:=
+    [[a,m] for a in rest form for m in rest signature |
+      isCategoryForm(m,$EmptyEnvironment)]
+  catPredList:= [['ofCategory,:u] for u in [["*1",form],:domainList]]
+  for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
+    member(sig,LASSOC(op,nonCategorySigAlist)) repeat
+      pred':= MKPF([pred,:catPredList],'AND)
+      modemap:= [["*1",:sig],[pred',sel]]
+      $lisplibModemapAlist:=
+	[[op,:interactiveModemapForm modemap],:$lisplibModemapAlist]
+
+augmentLisplibModemapsFromFunctor(form,opAlist,signature) ==
+  form:= [formOp,:argl]:= formal2Pattern form
+  opAlist:= formal2Pattern opAlist
+  signature:= formal2Pattern signature
+  for u in form for v in signature repeat
+    if MEMQ(u,$PatternVariableList) then
+      -- we are going to be EVALing categories containing these
+      -- pattern variables
+      $e:=put(u,'mode,v,$e)
+  nonCategorySigAlist:=
+    mkAlistOfExplicitCategoryOps first signature or return nil
+  for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
+    or/[(sig in catSig) for catSig in
+      allLASSOCs(op,nonCategorySigAlist)] repeat
+	skip:=
+	  argl and CONTAINED("$",rest sig) => 'SKIP
+	  nil
+	sel:= substitute(form,"$",sel)
+	patternList:= listOfPatternIds sig
+	--get relevant predicates
+	predList:=
+	  [[a,m] for a in argl for m in rest signature
+	    | MEMQ(a,$PatternVariableList)]
+	sig:= substitute(form,"$",sig)
+	pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND)
+	l:=listOfPatternIds predList
+	if "OR"/[null MEMQ(u,l) for u in argl] then
+	  sayMSG ['"cannot handle modemap for",:bright op,
+			  '"by pattern match" ]
+	  skip:= 'SKIP
+	modemap:= [[form,:sig],[pred',sel,:skip]]
+	$lisplibModemapAlist:= [[op,:interactiveModemapForm modemap],
+	  :$lisplibModemapAlist]
+
+rebuildCDT(filemode) ==
+  clearConstructorAndLisplibCaches()
+  $databaseQueue:local :=nil
+  $e: local := [[NIL]]	  -- We may need to evaluate Categories
+  buildDatabase(filemode,false)
+  $IOindex:= 1
+  $InteractiveFrame:= [[NIL]]
+  0
+
+buildDatabase(filemode,expensive) ==
+  $InteractiveMode: local:= true
+  $constructorList := nil	--looked at by buildLibdb
+  $ConstructorCache:= MAKE_-HASHTABLE('ID)
+  SAY '"Making constructor autoload"
+  makeConstructorsAutoLoad()
+  SAY '"Building category table"
+  genCategoryTable()
+  SAY '"Building libdb.text"
+  buildLibdb()
+  SAY '"splitting libdb.text"
+  dbSplitLibdb()
+  SAY '"creating browse constructor index"
+  dbAugmentConstructorDataTable()
+  SAY '"Building browse.lisp"
+  buildBrowsedb()
+  SAY '"Building constructor users database"
+  mkUsersHashTable()
+  SAY '"Saving constructor users database"
+  saveUsersHashTable()
+  SAY '"Building constructor dependents database"
+  mkDependentsHashTable()
+  SAY '"Saving constructor dependents database"
+  saveDependentsHashTable()
+  SAY '"Building glossary files"
+  buildGloss()
+
+saveUsersHashTable() ==
+  _$ERASE('USERS,'DATABASE,'a)
+  stream:= writeLib1('USERS,'DATABASE,'a)
+  for k in MSORT HKEYS $usersTb repeat
+    rwrite(k, HGET($usersTb, k), stream)
+  RSHUT stream
+
+saveDependentsHashTable() ==
+  _$ERASE('DEPENDENTS,'DATABASE,'a)
+  stream:= writeLib1('DEPENDENTS,'DATABASE,'a)
+  for k in MSORT HKEYS $depTb repeat
+    rwrite(k, HGET($depTb, k), stream)
+  RSHUT stream
+
+getUsersOfConstructor(con) ==
+  stream := readLib1('USERS, 'DATABASE, 'a)
+  val := rread(con, stream, nil)
+  RSHUT stream
+  val
+
+getDependentsOfConstructor(con) ==
+  stream := readLib1('DEPENDENTS, 'DATABASE, 'a)
+  val := rread(con, stream, nil)
+  RSHUT stream
+  val
+
+putModemapIntoDatabase(name,modemap,fileName) ==
+  $forceAdd: local:= nil
+  mml:= ASSOC(name,$databaseQueue)
+  if mml = [] then
+    $databaseQueue:=[[name, modemap],:$databaseQueue]
+  else
+    or/[modemap=map' for map' in CDR mml] => "already there"
+    newEntry:= [modemap,:CDR mml]
+    RPLACD(mml,newEntry)
+  newEntry
+
+orderPredicateItems(pred1,sig,skip) ==
+  pred:= signatureTran pred1
+  pred is ["AND",:l] => orderPredTran(l,sig,skip)
+  pred
+
+orderPredTran(oldList,sig,skip) ==
+  lastPreds:=nil
+  --(1) make two kinds of predicates appear last:
+  -----	 (op *target ..) when *target does not appear later in sig
+  -----	 (isDomain *1 ..)
+  for pred in oldList repeat
+    ((pred is [op,pvar,.] and MEMQ(op,'(isDomain ofCategory))
+       and pvar=first sig and ^(pvar in rest sig)) or
+	(^skip and pred is ['isDomain,pvar,.] and pvar="*1")) =>
+	  oldList:=delete(pred,oldList)
+	  lastPreds:=[pred,:lastPreds]
+--sayBrightlyNT "lastPreds="
+--pp lastPreds
+
+  --(2a) lastDependList=list of all variables that lastPred forms depend upon
+  lastDependList := "UNIONQ"/[listOfPatternIds x for x in lastPreds]
+--sayBrightlyNT "lastDependList="
+--pp lastDependList
+
+  --(2b) dependList=list of all variables that isDom/ofCat forms depend upon
+  dependList :=
+    "UNIONQ"/[listOfPatternIds y for x in oldList |
+      x is ['isDomain,.,y] or x is ['ofCategory,.,y]]
+--sayBrightlyNT "dependList="
+--pp dependList
+
+  --(3a) newList= list of ofCat/isDom entries that don't depend on
+  for x in oldList repeat
+    if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then
+      indepvl:=listOfPatternIds v
+      depvl:=listOfPatternIds body
+    else
+      indepvl := listOfPatternIds x
+      depvl := nil
+    (INTERSECTIONQ(indepvl,dependList) = nil)
+	and INTERSECTIONQ(indepvl,lastDependList) =>
+      somethingDone := true
+      lastPreds := [:lastPreds,x]
+      oldList := delete(x,oldList)
+--if somethingDone then
+--  sayBrightlyNT "Again lastPreds="
+--  pp lastPreds
+--  sayBrightlyNT "Again oldList="
+--  pp oldList
+
+  --(3b) newList= list of ofCat/isDom entries that don't depend on
+  while oldList repeat
+    for x in oldList repeat
+      if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then
+	indepvl:=listOfPatternIds v
+	depvl:=listOfPatternIds body
+      else
+	indepvl := listOfPatternIds x
+	depvl := nil
+      (INTERSECTIONQ(indepvl,dependList) = nil) =>
+	dependList:= setDifference(dependList,depvl)
+	newList:= [:newList,x]
+--  sayBrightlyNT "newList="
+--  pp newList
+
+  --(4) noldList= what is left over
+    (noldList:= setDifference(oldList,newList)) = oldList =>
+--    sayMSG '"NOTE: Parameters to domain have circular dependencies"
+      newList := [:newList,:oldList]
+      return nil
+    oldList:=noldList
+--  sayBrightlyNT "noldList="
+--  pp noldList
+
+  for pred in newList repeat
+    if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then
+      ids:= listOfPatternIds y
+      if and/[id in fullDependList for id in ids] then
+	fullDependList:= insertWOC(x,fullDependList)
+      fullDependList:= UNIONQ(fullDependList,ids)
+
+  newList:=[:newList,:lastPreds]
+
+--substitute (isDomain ..) forms as completely as possible to avoid false paths
+  newList := isDomainSubst newList
+  answer := [['AND,:newList],:INTERSECTIONQ(fullDependList,sig)]
+--sayBrightlyNT '"answer="
+--pp answer
+
+isDomainSubst u == main where
+  main ==
+    u is [head,:tail] =>
+      nhead :=
+	head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)]
+	head
+      [nhead,:isDomainSubst rest u]
+    u
+  fn(x,alist) ==
+    atom x =>
+      IDENTP x and MEMQ(x,$PatternVariableList) and (s := findSub(x,alist)) => s
+      x
+    [CAR x,:[fn(y,alist) for y in CDR x]]
+  findSub(x,alist) ==
+    null alist => nil
+    alist is [['isDomain,y,z],:.] and x = y => z
+    findSub(x,rest alist)
+
+signatureTran pred ==
+  atom pred => pred
+  pred is ['has,D,catForm] and isCategoryForm(catForm,$e) =>
+    ['ofCategory,D,catForm]
+  [signatureTran p for p in pred]
+
+interactiveModemapForm mm ==
+  --  create modemap form for use by the interpreter.  This function
+  --  replaces all specific domains mentioned in the modemap with pattern
+  --  variables, and predicates
+  mm := replaceVars(COPY mm,$PatternVariableList,$FormalMapVariableList)
+  [pattern:=[dc,:sig],pred] := mm
+  pred := [fn x for x in pred] where fn x ==
+    x is [a,b,c] and a ^= 'isFreeFunction and atom c => [a,b,[c]]
+    x
+--pp pred
+  [mmpat, patternAlist, partial, patvars] :=
+    modemapPattern(pattern,sig)
+--pp [pattern, mmpat, patternAlist, partial, patvars]
+  [pred,domainPredicateList] :=
+    substVars(pred,patternAlist,patvars)
+--pp [pred,domainPredicateList]
+  [pred,:dependList]:=
+    fixUpPredicate(pred,domainPredicateList,partial,rest mmpat)
+--pp [pred,dependList]
+  [cond, :.] := pred
+  [mmpat, cond]
+
+modemapPattern(mmPattern,sig) ==
+  --  Returns a list of the pattern of a modemap, an Alist of the
+  --  substitutions made, a boolean flag indicating whether
+  --  the result type is partial, and a list of unused pattern variables
+  patternAlist := nil
+  mmpat := nil
+  patvars := $PatternVariableList
+  partial := false
+  for xTails in tails mmPattern repeat
+    x := first xTails
+    if x is ['Union,dom,tag] and tag = '"failed" and xTails=sig then
+      x := dom
+      partial := true
+    patvar := rassoc(x,patternAlist)
+    not null patvar => mmpat := [patvar,:mmpat]
+    patvar := first patvars
+    patvars := rest patvars
+    mmpat := [patvar,:mmpat]
+    patternAlist := [[patvar,:x],:patternAlist]
+  [NREVERSE mmpat,patternAlist,partial,patvars]
+
+substVars(pred,patternAlist,patternVarList) ==
+  --make pattern variable substitutions
+  domainPredicates := nil
+  for [[patVar,:value],:.] in tails patternAlist repeat
+    pred := substitute(patVar,value,pred)
+    patternAlist := nsubst(patVar,value,patternAlist)
+    domainPredicates := substitute(patVar,value,domainPredicates)
+    if ^MEMQ(value,$FormalMapVariableList) then
+      domainPredicates := [["isDomain",patVar,value],:domainPredicates]
+  everything := [pred,patternAlist,domainPredicates]
+  for var in $FormalMapVariableList repeat
+    CONTAINED(var,everything) =>
+      replacementVar := first patternVarList
+      patternVarList := rest patternVarList
+      pred := substitute(replacementVar,var,pred)
+      domainPredicates := substitute(replacementVar,var,domainPredicates)
+  [pred, domainPredicates]
+
+fixUpPredicate(predClause, domainPreds, partial, sig) ==
+  --  merge the predicates in predClause and domainPreds into a
+  --  single predicate
+  [predicate, fn, :skip] := predClause
+  if first predicate = "AND" then
+    predicates := APPEND(domainPreds,rest predicate)
+  else if predicate ^= MKQ "T"
+--was->then predicates:= REVERSE [predicate, :domainPreds]
+       then predicates:= [predicate, :domainPreds]
+       else predicates := domainPreds or [predicate]
+  if #predicates > 1 then
+    pred := ["AND",:predicates]
+    [pred,:dependList]:=orderPredicateItems(pred,sig,skip)
+  else
+    pred := orderPredicateItems(first predicates,sig,skip)
+    dependList:= if pred is ['isDomain,pvar,[.]] then [pvar] else nil
+  pred := moveORsOutside pred
+  if partial then pred := ["partial", :pred]
+  [[pred, fn, :skip],:dependList]
+
+moveORsOutside p ==
+  p is ['AND,:q] =>
+    q := [moveORsOutside r for r in q]
+    x := or/[r for r in q | r is ['OR,:s]] =>
+      moveORsOutside(['OR,:[['AND,:SUBST(t,x,q)] for t in CDR x]])
+    ['AND,:q]
+  p
+
+replaceVars(x,oldvars,newvars) ==
+  --  replace every identifier in oldvars with the corresponding
+  --  identifier in newvars in the expression x
+  for old in oldvars for new in newvars repeat
+    x := substitute(new,old,x)
+  x
+
+getDomainFromMm mm ==
+  -- Returns the Domain (or package or category) of origin from a pattern
+  -- modemap
+  [., cond] := mm
+  if cond is ['partial, :c] then cond := c
+  condList :=
+    cond is ['AND, :cl] => cl
+    cond is ['OR, ['AND, :cl],:.] => cl	 --all cl's should give same info
+    [cond]
+  val :=
+    for condition in condList repeat
+      condition is ['isDomain, "*1", dom] => return opOf dom
+      condition is ['ofCategory, "*1", cat] => return opOf cat
+  null val =>
+    keyedSystemError("S2GE0016",
+      ['"getDomainFromMm",'"Can't find domain in modemap condition"])
+  val
+
+getFirstArgTypeFromMm mm ==
+  -- Returns the type of the first argument or nil
+  [pats, cond] := mm
+  [.,.,:args] := pats
+  null args => nil
+  arg1 := first args
+  if cond is ['partial, :c] then cond := c
+  condList :=
+    cond is ['AND, :cl] => cl
+    cond is ['OR, ['AND, :cl],:.] => cl	 --all cl's should give same info
+    [cond]
+  type := nil
+  for condition in condList while not type repeat
+      if condition is ['isDomain, a1, dom] and a1=arg1 then type := dom
+  type
+
+isFreeFunctionFromMm mm ==
+  -- This returns true is the modemap represents a free function, ie,
+  -- one not coming from a domain or category.
+  [., cond] := mm
+  isFreeFunctionFromMmCond cond
+
+isFreeFunctionFromMmCond cond ==
+  -- This returns true is the modemap represents a free function, ie,
+  -- one not coming from a domain or category.
+  if cond is ['partial, :c] then cond := c
+  condList :=
+    cond is ['AND, :cl] => cl
+    cond is ['OR, ['AND, :cl],:.] => cl	 --all cl's should give same info
+    [cond]
+  iff := false
+  for condition in condList while not iff repeat
+      if condition is ['isFreeFunction, :.] then iff := true
+  iff
+
+getAllModemapsFromDatabase(op,nargs) ==
+  $getUnexposedOperations: local := true
+  startTimingProcess 'diskread
+  ans := getSystemModemaps(op,nargs)
+  stopTimingProcess 'diskread
+  ans
+
+getModemapsFromDatabase(op,nargs) ==
+  $getUnexposedOperations: local := false
+  startTimingProcess 'diskread
+  ans := getSystemModemaps(op,nargs)
+  stopTimingProcess 'diskread
+  ans
+
+getSystemModemaps(op,nargs) ==
+  mml:= GETDATABASE(op,'OPERATION) =>
+    mms := NIL
+    for (x := [[.,:sig],.]) in mml repeat
+      (NUMBERP nargs) and (nargs ^= #QCDR sig) => 'iterate
+      $getUnexposedOperations or isFreeFunctionFromMm(x) or
+	isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms]
+      'iterate
+    mms
+  nil
+
+getInCoreModemaps(modemapList,op,nargs) ==
+  mml:= LASSOC (op,modemapList) =>
+    mml:= CAR mml
+    [x for (x:= [[dc,:sig],.]) in mml |
+      (NUMBERP nargs => nargs=#rest sig; true) and
+	(cfn := abbreviate (domName := getDomainFromMm x)) and
+	  ($getUnexposedOperations or isExposedConstructor(domName))]
+  nil
+
+mkAlistOfExplicitCategoryOps target ==
+  if target is ['add,a,:l] then
+    target:=a
+  target is ['Join,:l] =>
+    "union"/[mkAlistOfExplicitCategoryOps cat for cat in l]
+  target is ['CATEGORY,.,:l] =>
+    l:= flattenSignatureList ['PROGN,:l]
+    u:=
+      [[atomizeOp op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]]
+	    where
+	      atomizeOp op ==
+		atom op => op
+		op is [a] => a
+		keyedSystemError("S2GE0016",
+		  ['"mkAlistOfExplicitCategoryOps",'"bad signature"])
+    opList:= REMDUP ASSOCLEFT u
+    [[x,:fn(x,u)] for x in opList] where
+      fn(op,u) ==
+	u is [[a,:b],:c] => (a=op => [b,:fn(op,c)]; fn(op,c))
+  isCategoryForm(target,$e) => nil
+  keyedSystemError("S2GE0016",
+    ['"mkAlistOfExplicitCategoryOps",'"bad signature"])
+
+flattenSignatureList(x) ==
+  atom x => nil
+  x is ['SIGNATURE,:.] => [x]
+  x is ['IF,cond,b1,b2] =>
+     append(flattenSignatureList b1, flattenSignatureList b2)
+  x is ['PROGN,:l] =>
+     ll:= []
+     for x in l repeat
+	x is ['SIGNATURE,:.] => ll:=cons(x,ll)
+	ll:= append(flattenSignatureList x,ll)
+     ll
+  nil
+
+mkDatabasePred [a,t] ==
+  isCategoryForm(t,$e) => ['ofCategory,a,t]
+  ['ofType,a,t]
+
+formal2Pattern x ==
+  SUBLIS(pairList($FormalMapVariableList,rest $PatternVariableList),x)
+
+updateDatabase(fname,cname,systemdir?) ==
+ -- for now in NRUNTIME do database update only if forced
+  not $forceDatabaseUpdate => nil
+  $newcompMode = 'true => nil
+  -- these modemaps are never needed in the old scheme
+  if oldFname := constructor? cname then
+    clearClams()
+    clearAllSlams []
+    if GETL(cname, 'LOADED) then
+      clearConstructorCaches()
+  if $forceDatabaseUpdate or not systemdir? then
+    clearClams()
+    clearAllSlams []
+
+removeCoreModemaps(modemapList,c) ==
+  newUserModemaps:= nil
+  c := opOf unabbrev c
+  for [op,mmList] in modemapList repeat
+    temp:= nil
+    for mm in mmList repeat
+      cname := getDomainFromMm mm
+      if cname ^= c then temp:= [:temp,mm]
+    if temp then newUserModemaps:= [:newUserModemaps,[op,temp]]
+  newUserModemaps
+
+addCoreModemap(modemapList,op,modemap,cname) ==
+  entry:= ASSQ(op,modemapList) =>
+    RPLAC(CADR entry,[modemap,:CADR entry])
+    modemapList
+  modeMapList:= [:modemapList,[op,[ modemap]]]
+
+REMOVER(lst,item) ==
+  --destructively removes item from lst
+  not PAIRP lst =>
+    lst=item => nil
+    lst
+  first lst=item => rest lst
+  RPLNODE(lst,REMOVER(first lst,item),REMOVER(rest lst,item))
+
+allLASSOCs(op,alist) ==
+  [value for [key,:value] in alist | key = op]
+
+loadDependents fn ==
+  isExistingFile [fn,$spadLibFT,"*"] =>
+    MEMQ("dependents",RKEYIDS(fn,$spadLibFT)) =>
+      stream:= readLib1(fn,$spadLibFT,"*")
+      l:= rread('dependents,stream,nil)
+      RSHUT stream
+      for x in l repeat
+	x='SubDomain => nil
+	loadIfNecessary x
+
+--% Miscellaneous Stuff
+
+getOplistForConstructorForm (form := [op,:argl]) ==
+  --  The new form is an op-Alist which has entries (<op> . signature-Alist)
+  --	where signature-Alist has entries (<signature> . item)
+  --	  where item has form (<slotNumber> <condition> <kind>)
+  --	    where <kind> =  ELT | CONST | Subsumed | (XLAM..) ..
+  pairlis:= [[fv,:arg] for fv in $FormalMapVariableList for arg in argl]
+  opAlist := getOperationAlistFromLisplib op
+  [:getOplistWithUniqueSignatures(op,pairlis,signatureAlist)
+      for [op,:signatureAlist] in opAlist]
+
+getOplistWithUniqueSignatures(op,pairlis,signatureAlist) ==
+  alist:= nil
+  for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind ^= 'Subsumed repeat
+    alist:= insertAlist(SUBLIS(pairlis,[op,sig]),
+		SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]),
+		alist)
+  alist
+
+--% Code For Modemap Insertion
+
+insertModemap(new,mmList) ==
+  null mmList => [new]
+--isMoreSpecific(new,old:= first mmList) => [new,:mmList]
+--[old,:insertModemap(new,rest mmList)]
+  [new,:mmList]
+
+--% Exposure Group Code
+
+dropPrefix(fn) ==
+  member(fn.0,[char "?",char "-",char "+"]) => SUBSTRING(fn,1,nil)
+  fn
+
+--moved to util.lisp
+--++loadExposureGroupData() ==
+--++  egFile := ['INTERP,'EXPOSED]
+--++--  null MAKE_-INPUT_-FILENAME(egFile) =>
+--++--    throwKeyedMsg("S2IL0003",[namestring egFile])
+--++  stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0)
+--++  $globalExposureGroupAlist := NIL
+--++  egName  := NIL
+--++  egFiles := NIL
+--++  while (not PLACEP (x:= READ_-LINE stream)) repeat
+--++    x := DROPTRAILINGBLANKS x
+--++    SIZE(x) = 0 => 'iterate				-- blank line
+--++    (x.0 = char "#") or (x.0 = char "*") => 'iterate    -- comment
+--++    x.0 = char " " =>
+--++       -- possible exposure group member name and library name
+--++       null egName =>
+--++	 throwKeyedMsg("S2IZ0069A",[namestring egFile,x])
+--++       x := dropLeadingBlanks x
+--++       -- should be two tokens on the line
+--++       p := STRPOS('" ",x,1,NIL)
+--++       NULL p =>
+--++	 throwKeyedMsg("S2IZ0069B",[namestring egFile,x])
+--++       n := object2Identifier SUBSTRING(x,0,p)
+--++       x := dropLeadingBlanks SUBSTRING(x,p+1,NIL)
+--++       SIZE(x) = 0 =>
+--++	 throwKeyedMsg("S2IZ0069B",[namestring egFile,x])
+--++       egFiles := [[n,:object2Identifier x],:egFiles]
+--++    -- have a new group name
+--++    if egName then $globalExposureGroupAlist :=
+--++      [[egName,:nreverse egFiles],:$globalExposureGroupAlist]
+--++    egFiles := NIL
+--++    STRPOS('" ",x,1,NIL) =>
+--++      throwKeyedMsg("S2IZ0069C",[namestring egFile,x])
+--++    egName := object2Identifier x
+--++  if egFiles then $globalExposureGroupAlist :=
+--++      [[egName,:nreverse egFiles],:$globalExposureGroupAlist]
+--++  SHUT stream
+--++  $globalExposureGroupAlist := nreverse $globalExposureGroupAlist
+--++  'done
+
+isExposedConstructor name ==
+  -- this function checks the local exposure data in the frame to
+  -- see if the given constructor is exposed. The format of
+  -- $localExposureData is a vector with
+  --   slot 0: list of groups exposed in the frame
+  --   slot 1: list of constructors explicitly exposed
+  --   slot 2: list of constructors explicitly hidden
+  -- check if it is explicitly hidden
+  MEMQ(name,'(Union Record Mapping)) => true
+  MEMQ(name,$localExposureData.2) => false
+  -- check if it is explicitly exposed
+  MEMQ(name,$localExposureData.1) => true
+  -- check if it is in an exposed group
+  found := NIL
+  for g in $localExposureData.0 while not found repeat
+    null (x := GETALIST($globalExposureGroupAlist,g)) => 'iterate
+    if GETALIST(x,name) then found := true
+  found
+
+displayExposedGroups() ==
+  sayKeyedMsg("S2IZ0049A",[$interpreterFrameName])
+  if null $localExposureData.0
+    then centerAndHighlight '"there are no exposed groups"
+    else for g in $localExposureData.0 repeat
+      centerAndHighlight g
+
+displayExposedConstructors() ==
+  sayKeyedMsg("S2IZ0049B",NIL)
+  if null $localExposureData.1
+    then centerAndHighlight
+      '"there are no explicitly exposed constructors"
+    else for c in $localExposureData.1 repeat
+      centerAndHighlight c
+
+displayHiddenConstructors() ==
+  sayKeyedMsg("S2IZ0049C",NIL)
+  if null $localExposureData.2
+    then centerAndHighlight
+      '"there are no explicitly hidden constructors"
+    else for c in $localExposureData.2 repeat
+      centerAndHighlight c
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/debug.lisp.pamphlet b/src/interp/debug.lisp.pamphlet
new file mode 100644
index 00000000..8f73998d
--- /dev/null
+++ b/src/interp/debug.lisp.pamphlet
@@ -0,0 +1,1235 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/debug.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{interrupt}
+
+A "resumable" break loop for use in trace etc. Unfortunately this
+only works for CCL. We need to define a Common Lisp version. For
+now the function is defined but does nothing.
+<<interrupt>>=
+#-:CCL
+(defun interrupt (&rest ignore))
+
+#+:CCL
+(defun interrupt (&rest ignore)
+  (prog (prompt ifile ofile u v)
+    (setq ifile (rds *debug-io*))
+    (setq ofile (wrs *debug-io*))
+    (setq prompt (setpchar "Break loop (:? for help)> "))
+top (setq u (read))
+    (cond
+      ((equal u ':x) (go exit))
+      ((equal u ':r) (go resume))
+      ((equal u ':q)
+        (progn (lisp::enable-backtrace nil) 
+               (princ "Backtrace now disabled")
+               (terpri)))
+      ((equal u ':v)
+        (progn (lisp::enable-backtrace t)
+               (princ "Backtrace now enabled")
+               (terpri)))
+      ((equal u ':?)
+        (progn
+           (princ ":Q   disables backtrace")
+           (terpri)
+           (princ ":V   enables backtrace")
+           (terpri)
+           (princ ":R   resumes from break")
+           (terpri)
+           (princ ":X   exits from break loop")
+           (terpri)
+           (princ "else enter LISP expressions for evaluation")
+           (terpri)))
+      ((equal u #\eof)
+       (go exit))
+     (t (progn
+           (setq v (errorset u nil nil))
+           (if (listp v) (progn (princ "=> ") (prinl (car v)) (terpri))))) )
+     (go top)
+resume (rds ifile)
+     (wrs ofile)
+     (setpchar prompt)
+     (return nil)
+exit (rds ifile)
+     (wrs ofile)
+     (setpchar prompt)
+     (lisp::unwind)))
+
+@
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;;;  @(#)debug.lisp	2.5      90/02/15  10:27:33
+ 
+; NAME:    Debugging Package
+; PURPOSE: Debugging hooks for Boot code
+ 
+(in-package "BOOT")
+(use-package '("LISP" "VMLISP"))
+ 
+(DEFPARAMETER /COUNTLIST NIL)
+(DEFPARAMETER /TIMERLIST NIL)
+(DEFPARAMETER /TRACESIZE NIL "sets limit on size of object to be mathprinted")
+(DEFVAR CURSTRM *TERMINAL-IO*)
+(DEFVAR /TRACELETNAMES ())
+(DEFVAR /PRETTY () "controls pretty printing of trace output")
+(SETANDFILEQ /ECHO NIL) ;;"prevents echo of SPAD or BOOT code with /c"
+(MAKEPROP 'LISP '/TERMCHR '(#\  #\())
+(MAKEPROP 'LSP '/TERMCHR '(#\  #\())
+(MAKEPROP 'META '/TERMCHR '(#\:  #\())
+(MAKEPROP 'INPUT '/TERMCHR '(#\:  #\<  #\  #\())
+(MAKEPROP 'SPAD '/TERMCHR '(#\:  #\<  #\  #\())
+(MAKEPROP 'BOOT '/TERMCHR '(#\:  #\<  #\  #\())
+(MAKEPROP 'INPUT '/XCAPE #\_)
+(MAKEPROP 'BOOT '/XCAPE '#\_)
+(MAKEPROP 'SPAD '/XCAPE '#\_)
+(MAKEPROP 'META '/READFUN 'META\,RULE)
+(MAKEPROP 'META '/TRAN '/TRANSMETA)
+(MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|)
+(MAKEPROP 'INPUT '/TRAN '/TRANSPAD)
+(MAKEPROP 'BOOT '/READFUN '|New,LEXPR1|)
+(MAKEPROP 'BOOT '/TRAN '/TRANSNBOOT)
+(MAKEPROP 'SPAD '/READFUN '|New,LEXPR|)
+(MAKEPROP 'SPAD '/TRAN '/TRANSPAD)
+ 
+(defmacro |/C,LIB| (&rest L &aux optionlist /editfile
+			  ($prettyprint 't) ($reportCompilation 't))
+  (declare (special optionlist /editfile $prettyprint $reportComilation))
+  `',(|compileConstructorLib| L (/COMP) NIL NIL))
+ 
+(defmacro /C (&rest L) `',(/D-1 L (/COMP) NIL NIL))
+ 
+(defmacro /CT (&rest L) `',(/D-1 L (/COMP) NIL 'T))
+ 
+(defmacro /CTL (&rest L) `',(/D-1 L (/COMP) NIL 'TRACELET))
+ 
+(defmacro /D (&rest L) `',(/D-1 L 'DEFINE NIL NIL))
+ 
+(defmacro /EC (&rest L) `', (/D-1 L (/COMP) 'T NIL))
+ 
+(defmacro /ECT (&rest L) `',(/D-1 L (/COMP) 'T 'T))
+ 
+(defmacro /ECTL (&rest L) `',(/D-1 L (/COMP) 'T 'TRACELET))
+ 
+(defmacro /E (&rest L) `',(/D-1 L NIL 'T NIL))
+ 
+(defmacro /ED (&rest L) `',(/D-1 L 'DEFINE 'T NIL))
+ 
+(defun heapelapsed () 0)
+ 
+(defun /COMP () (if (fboundp 'COMP) 'COMP 'COMP370))
+ 
+(DEFUN /D-1 (L OP EFLG TFLG)
+  (CATCH 'FILENAM
+    (PROG (TO OPTIONL OPTIONS FNL INFILE OUTSTREAM FN )
+          (declare (special fn infile outstream ))
+          (if (member '? L :test #'eq)
+              (RETURN (OBEY "EXEC SPADEDIT /C TELL")))
+          (SETQ OPTIONL (/OPTIONS L))
+          (SETQ FNL (TRUNCLIST L OPTIONL))
+          (SETQ OPTIONS (OPTIONS2UC OPTIONL))
+          (SETQ INFILE (/MKINFILENAM (/GETOPTION OPTIONS 'FROM)))
+          (SETQ TO (/GETOPTION OPTIONS 'TO))
+          (if TO (SETQ TO (/MKOUTFILENAM (/GETOPTION OPTIONS 'TO) INFILE)))
+          (SETQ OUTSTREAM (if TO (DEFSTREAM TO 'OUTPUT) CUROUTSTREAM))
+          (RETURN (mapcar #'(lambda (fn)
+                              (/D-2 FN INFILE OUTSTREAM OP EFLG TFLG))
+			  (or fnl (list /fn)))))))
+ 
+(DEFUN |/D,2,LIB| (FN INFILE CUROUTSTREAM OP EDITFLAG TRACEFLAG)
+       (declare (special CUROUTSTREAM))
+  "Called from compConLib1 (see LISPLIB BOOT) to bind CUROUTSTREAM."
+  (/D-2 FN INFILE CUROUTSTREAM OP EDITFLAG TRACEFLAG))
+ 
+(DEFUN /D-2 (FN INFILE OUTPUTSTREAM OP EDITFLAG TRACEFLAG)
+       (declare (special OUTPUTSTREAM))
+  (PROG (FT oft SFN X EDINFILE FILE DEF KEY RECNO U W SOURCEFILES
+	 ECHOMETA SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM
+	 ISID NBLNK COMMENTCHR $TOKSTACK (/SOURCEFILES |$sourceFiles|)
+	 METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|))
+	 ($FUNCTION FN) $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
+	 TRAPFLAG |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE
+	 (*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun)))
+	(declare (special ECHOMETA SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM
+		     SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES
+		     METAKEYLST DEFINITION_NAME |$sourceFileTypes|
+		     $FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
+		     TRAPFLAG |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE))
+        (if (PAIRP FN) (SETQ FN (QCAR FN)))
+        (SETQ INFILE (OR INFILE (|getFunctionSourceFile| FN)))
+	  ;; $FUNCTION is freely set in getFunctionSourceFile
+	(IF (PAIRP $FUNCTION) (SETQ $FUNCTION (QCAR $FUNCTION)))
+        (SETQ FN $FUNCTION)
+        (SETQ /FN $FUNCTION)
+   LOOP (SETQ SOURCEFILES
+              (cond ( INFILE
+		      (SETQ /SOURCEFILES (CONS INFILE (REMOVE INFILE /SOURCEFILES)))
+		      (LIST INFILE))
+		    ( /EDITFILE
+		      (|insert| (|pathname| /EDITFILE) /SOURCEFILES))
+		    ( 't /SOURCEFILES)))
+        (SETQ RECNO
+              (dolist (file sourcefiles)
+                    (SETQ INPUTSTREAM (DEFSTREAM FILE 'INPUT))
+ 
+                    ;;?(REMFLAG S-SPADKEY 'KEY)    ;  hack !!
+		    (SETQ  FT (|pathnameType| FILE))
+		    (SETQ  oft (|object2Identifier| (UPCASE FT)))
+		    (SETQ XCAPE (OR (GET oft '/XCAPE) #\|))
+                    (SETQ COMMENTCHR (GET oft '/COMMENTCHR))
+                    (SETQ XTOKENREADER (OR (GET oft '/NXTTOK) 'METATOK))
+                    (SETQ DEFINITION_NAME FN)
+                    (SETQ KEY
+                          (STRCONC
+                            (OR (AND (EQ oFT 'SPAD) "")
+                                (AND (EQ oFT 'BOOT) "")
+                                (GET oFT '/PREFIX)
+                                "")
+                            (PNAME FN)))
+                    (SETQ SFN (GET oFT '/READFUN))
+                    (SETQ RECNO (/LOCATE FN KEY FILE 0))
+		    (SHUT INPUTSTREAM)
+                    (cond ((NUMBERP RECNO)
+                           (SETQ /SOURCEFILES (CONS FILE (REMOVE FILE /SOURCEFILES)))
+                           (SETQ INFILE FILE)
+                           (RETURN RECNO)))) )
+        (if (NOT RECNO)
+            (if (SETQ INFILE (/MKINFILENAM '(NIL))) (GO LOOP) (UNWIND)))
+        (TERPRI)
+        (TERPRI)
+	(SETQ INFILE (|pathname| INFILE))
+	(COND
+	 ( EDITFLAG
+          ;;%% next form is used because $FINDFILE seems to screw up
+          ;;%% sometimes. The stream is opened and closed several times
+          ;;%% in case the filemode has changed during editing.
+          (SETQ EDINFILE (make-input-filename INFILE))
+          (SETQ INPUTSTREAM (DEFSTREAM EDINFILE 'INPUT))
+          (|sayBrightly|
+            (LIST  "   editing file" '|%b| (|namestring| EDINFILE) '|%d|))
+          (OBEY
+            (STRCONC
+              (make-absolute-filename "/lib/SPADEDFN ")
+              (|namestring| EDINFILE)
+              " "
+              (STRINGIMAGE $LINENUMBER)))
+          (SHUT INPUTSTREAM)
+          ;(COND
+	  ;  ( (EQ (READ ERRORINSTREAM) 'ABORTPROCESS)
+	  ;    (RETURN 'ABORT) ) )
+          ;;%% next is done in case the diskmode changed
+          ;;(SETQ INFILE (|pathname| (IFCAR
+	  ;; (QSORT ($LISTFILE INFILE)))))
+          (SETQ INPUTSTREAM (DEFSTREAM INFILE 'INPUT))
+          (SETQ RECNO (/LOCATE FN KEY INFILE RECNO))
+	
+	  (COND ((NOT RECNO)
+		 (|sayBrightly| (LIST "   Warning: function" "%b" /FN "%d"
+				      "was not found in the file" "%l" "  " "%b"
+				      (|namestring| INFILE) "%d" "after editing."))
+		 (RETURN NIL)))
+	  ;; next is done in case the diskmode changed
+	  (SHUT INPUTSTREAM) ))
+	;;(SETQ INFILE (|pathname| (IFCAR ($LISTFILE INFILE))))
+	(SETQ INFILE (vmlisp::make-input-filename INFILE))
+	(MAKEPROP /FN 'DEFLOC
+		  (CONS RECNO INFILE))
+	(SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE))))
+	(COND
+	 ( (NULL OP)
+	   (RETURN /FN) ) )
+	(COND
+	 ( (EQ TRACEFLAG 'TRACELET)
+	   (RETURN (/TRACELET-1 (LIST FN) NIL)) ) )
+	(SETQ INPUTSTREAM (DEFSTREAM INFILE 'INPUT))
+	(|sayBrightly|
+	 (LIST  "   Reading file" '|%b| (|namestring| INFILE) '|%d|))
+	(TERPRI)
+	(SETQ $BOOT (EQ oft 'BOOT))
+	(SETQ $NEWSPAD (OR $BOOT (EQ oft 'SPAD)))
+	(SETQ DEF
+	      (COND
+	       ( SFN
+		 ;(+VOL 'METABASE)
+		 (POINT RECNO INPUTSTREAM)
+		 ;(SETQ CHR (CAR INPUTSTREAM))
+		 ;(SETQ ERRCOL 0)
+		 ;(SETQ COUNT 0)
+		 ;(SETQ COLUMN 0)
+		 ;(SETQ TRAPFLAG NIL)
+		 (SETQ OK 'T)
+		 ;(NXTTOK)
+		 ;(SETQ LINE (CURINPUTLINE))
+		 ;(SETQ SPADERRORSTREAM CUROUTSTREAM)
+		 ;(AND /ECHO (SETQ ECHOMETA 'T) (PRINTEXP LINE) (TERPRI))
+		 ;(SFN)
+		 (SETQ DEF (BOOT-PARSE-1 INPUTSTREAM))
+		 (SETQ DEBUGMODE 'YES)
+		 (COND
+		  ( (NULL OK)
+		    (FUNCALL (GET oft 'SYNTAX_ERROR))
+		    NIL )
+		  ( 'T
+		    DEF ) ) )
+	       ( 'T
+		 (let* ((mode-line (read-line inputstream))
+			(pacpos (search "package:" mode-line :test #'equalp))
+			(endpos (search "-*-" mode-line :from-end t))
+			(*package* *package*)
+			(newpac nil))
+		   (when pacpos
+			 (setq newpac (read-from-string mode-line nil nil
+							:start (+ pacpos 8)
+							:end endpos))
+			 (setq *package*
+			       (cond ((find-package newpac))
+				     (t *package*))))
+		   (POINT RECNO INPUTSTREAM)
+		   (READ INPUTSTREAM)))))
+      #+Lucid(system::compiler-options :messages t :warnings t)
+	(COND
+	 ( (SETQ U (GET oft '/TRAN))
+	   (SETQ DEF (FUNCALL U DEF)) ) )
+      (/WRITEUPDATE
+        /FN
+        (|pathnameName| INFILE)
+        (|pathnameType| INFILE)
+        (OR (|pathnameDirectory| INFILE) '*)
+        (OR (KAR (KAR (KDR DEF))) NIL)
+        OP)
+      (COND
+        ( (OR /ECHO $PRETTYPRINT)
+          (PRETTYPRINT DEF OUTPUTSTREAM) ) )
+      (COND
+        ( (EQ oft 'LISP)
+	  (if (EQ OP 'DEFINE) (EVAL DEF)
+	    (compile (EVAL DEF))))
+        ( DEF
+          (FUNCALL OP (LIST DEF)) ) )
+      #+Lucid(system::compiler-options :messages nil :warnings nil)
+      #+Lucid(TERPRI)
+      (COND
+        ( TRACEFLAG
+          (/TRACE-2 /FN NIL) ) )
+      (SHUT INPUTSTREAM)
+      (RETURN (LIST /FN)) ) )
+ 
+(DEFUN FUNLOC (func &aux file)
+  (if (PAIRP func) (SETQ func (CAR func)))
+  (setq file (ifcar (findtag func)))
+  (if file (list (pathname-name file) (pathname-type file) func)
+    nil))
+ 
+(DEFUN /LOCATE (FN KEY INFILE INITRECNO)
+       (PROG (FT RECNO KEYLENGTH LN)
+        (if (AND (NOT (eq 'FROMWRITEUPDATE (|pathnameName| INFILE)))
+                    (NOT (make-input-filename INFILE)))
+            (RETURN NIL))
+	(SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE))))
+        (SETQ KEYLENGTH (STRINGLENGTH KEY))
+	(WHEN (> INITRECNO 1)  ;; we think we know where it is
+	      (POINT INITRECNO INPUTSTREAM)
+	      (SETQ LN (READ-LINE INPUTSTREAM NIL NIL))
+	      (IF (AND LN (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT))
+		  (RETURN INITRECNO)))
+	(SETQ $LINENUMBER 0)
+	(POINT 0 INPUTSTREAM)
+EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
+	(SETQ LN (READ-LINE INPUTSTREAM NIL NIL))
+	(INCF $LINENUMBER)
+	(if (NULL LN) (RETURN NIL))
+	(IF (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT)
+	    (RETURN RECNO))
+        (GO EXAMINE)))
+ 
+(DEFUN MATCH-FUNCTION-DEF (fn key keylength line type)
+       (if (eq type 'LISP) (match-lisp-tag fn line "(def")
+	 (let ((n (mismatch key line)))
+	   (and (= n keylength)
+		(or (= n (length line))
+		    (member (elt line n)
+			    (or (get type '/termchr) '(#\space ))))))))
+ 
+(define-function '|/D,1| #'/D-1)
+ 
+(DEFUN /INITUPDATES (/VERSION)
+   (SETQ FILENAME (STRINGIMAGE /VERSION))
+   (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME) :direction :output
+			     :if-exists :append :if-does-not-exist :create))
+   (PRINTEXP
+ "       Function Name                    Filename             Date   Time"
+      /UPDATESTREAM)
+   (TERPRI /UPDATESTREAM)
+   (PRINTEXP
+ " ---------------------------      -----------------------  -------- -----"
+      /UPDATESTREAM)
+   (TERPRI /UPDATESTREAM) )
+ 
+(defun /UPDATE (&rest ARGS)
+  (LET (( FILENAME (OR (KAR ARGS)
+		       (strconc "/tmp/update." (STRINGIMAGE /VERSION))))
+        (|$createUpdateFiles| NIL))
+       (DECLARE (SPECIAL |$createUpdateFiles|))
+       (CATCH 'FILENAM (/UPDATE-1 FILENAME '(/COMP)))
+       (SAY "Update is finished")))
+
+(defun /DUPDATE (&rest ARGS)
+  (LET (( FILENAME (OR (KAR ARGS)
+		       (strconc "/tmp/update." (STRINGIMAGE /VERSION))))
+        (|$createUpdateFiles| NIL))
+       (DECLARE (SPECIAL |$createUpdateFiles|))
+       (CATCH 'FILENAM (/UPDATE-1 FILENAME 'DEFINE))
+       (SAY "Update is finished")))
+ 
+(DEFUN /UPDATE-1 (UPFILE OP)
+   ;;if /VERSION=0 then no new update files will be written.
+  (prog (STREAM RECORD FUN FILE FUNFILES)
+   (SETQ STREAM (DEFSTREAM (/MKINFILENAM UPFILE) 'INPUT))
+ LOOP
+   (if (STREAM-EOF STREAM) (RETURN NIL))
+   (SETQ RECORD (read-line STREAM))
+   (if (NOT (STRINGP RECORD)) (RETURN NIL))
+   (if (< (LENGTH RECORD) 36) (GO LOOP))
+   (SETQ FUN (STRING2ID-N (SUBSTRING RECORD 0 36) 1))
+   (if (AND (NOT (EQUAL FUN 'QUAD)) (EQUAL (SUBSTRING RECORD 0 1) " "))
+       (GO LOOP))
+   (SETQ FILE (STRING2ID-N RECORD 2))
+   (if (member (cons fun file) funfiles :test #'equal) (go loop))
+   (push (cons fun file) funfiles)
+   (COND ((EQUAL FUN 'QUAD) (/RF-1 FILE))
+         ((/D-2 FUN FILE CUROUTSTREAM OP NIL NIL)))
+   (GO LOOP)))
+ 
+(DEFUN /WRITEUPDATE (FUN FN FT FM FTYPE OP)
+ 
+;;;If /VERSION=0 then no save has yet been done.
+;;;If A disk is not read-write, then issue msg and return.
+;;;If /UPDATESTREAM not set or current /UPDATES file doesnt exist, initialize.
+ 
+   (PROG (IFT KEY RECNO ORECNO COUNT DATE TIME)
+;         (if (EQ 0 /VERSION) (RETURN NIL))
+         (if (EQ 'INPUT FT) (RETURN NIL))
+         (if (NOT |$createUpdateFiles|) (RETURN NIL))
+;         (COND ((/= 0 (directory "A")))
+;               ((SAY "A disk is not read-write. Update file not modified")
+;                (RETURN NIL)))
+         (if (OR (NOT (BOUNDP '/UPDATESTREAM))
+		 (NOT (STREAMP /UPDATESTREAM)))
+             (/INITUPDATES /VERSION))
+;         (SETQ IFT (INTERN (STRINGIMAGE /VERSION)))
+;         (SETQ INPUTSTREAM (open (strconc IFT /WSNAME) :direction :input))
+;         (NEXT INPUTSTREAM)
+;         (SETQ KEY (if (NOT FUN)
+;                       (STRCONC "                                QUAD "
+;                                (PNAME FN))
+;                       (PNAME FUN)))
+;         (SETQ RECNO (/LOCATE KEY (LIST 'FROMWRITEUPDATE /WSNAME) 1))
+;         (SETQ COUNT (COND
+;                       ((NOT (NUMBERP RECNO)) 1)
+;                       ((POINT RECNO INPUTSTREAM)
+;                        (do ((i 1 (1+ i))) ((> i 4)) (read inputstream))
+;                        (1+ (READ INPUTSTREAM)) )))
+;         (COND ((NUMBERP RECNO)
+;                (SETQ ORECNO (NOTE /UPDATESTREAM))
+;                (POINTW RECNO /UPDATESTREAM) ))
+	 (SETQ DATETIME (|getDateAndTime|))
+	 (SETQ DATE (CAR DATETIME))
+	 (SETQ TIME (CDR DATETIME))
+         (PRINTEXP (STRCONC
+                  (COND ((NOT FUN) "                                QUAD ")
+                        ((STRINGPAD (PNAME FUN) 28))) " "
+		  (STRINGIMAGE FM)
+		  (STRINGIMAGE FN) "." (STRINGIMAGE FT)
+                  " "
+                  DATE " " TIME) /UPDATESTREAM)
+         (TERPRI /UPDATESTREAM)
+;         (if (NUMBERP RECNO) (POINTW ORECNO /UPDATESTREAM))
+	 ))
+ 
+(defun |getDateAndTime| ()
+   (MULTIPLE-VALUE-BIND (sec min hour day mon year) (get-decoded-time)
+   (CONS (STRCONC (LENGTH2STR mon) "/"
+		  (LENGTH2STR day) "/"
+		  (LENGTH2STR year) )
+	 (STRCONC (LENGTH2STR hour) ":"
+		  (LENGTH2STR min)))))
+ 
+(DEFUN LENGTH2STR (X &aux XLEN)
+       (cond ( (= 1 (SETQ XLEN (LENGTH (SETQ X (STRINGIMAGE X))))) (STRCONC "0" X))
+	     ( (= 2 XLEN) X)
+	     ( (subseq x (- XLEN 2)))))
+ 
+(defmacro /T (&rest L) (CONS '/TRACE (OR L (LIST /FN))))
+ 
+(defmacro /TRACE (&rest L) `',(/TRACE-0 L))
+ 
+(DEFUN /TRACE-0 (L)
+  (if (member '? L :test #'eq)
+      (OBEY "EXEC NORMEDIT TRACE TELL")
+      (let* ((options (/OPTIONS L)) (FNL (TRUNCLIST L OPTIONS)))
+        (/TRACE-1 FNL OPTIONS))))
+ 
+(define-function '|/TRACE,0| #'/TRACE-0)
+ 
+(defmacro /TRACEANDCOUNT (&rest L) `',
+  (let* ((OPTIONS (/OPTIONS L))
+         (FNL (TRUNCLIST L OPTIONS)))
+    (/TRACE-1 FNL (CONS '(DEPTH) OPTIONS))))
+ 
+(DEFUN /TRACE-1 (FNLIST OPTIONS)
+   (mapcar #'(lambda (X) (/TRACE-2 X OPTIONS)) FNLIST)
+   (/TRACEREPLY))
+ 
+(DEFUN /TRACE-2 (FN OPTIONS)
+  (PROG (U FNVAL COUNTNAM TRACECODE BEFORE AFTER CONDITION
+         TRACENAME CALLER VARS BREAK FROM_CONDITION VARBREAK TIMERNAM
+         ONLYS G WITHIN_CONDITION  DEPTH_CONDITION COUNT_CONDITION
+         LETFUNCODE MATHTRACE )
+        (if (member FN /TRACENAMES :test #'eq) (/UNTRACE-2 FN NIL))
+        (SETQ OPTIONS (OPTIONS2UC OPTIONS))
+        (if (AND |$traceDomains| (|isFunctor| FN) (ATOM FN))
+            (RETURN (|traceDomainConstructor| FN OPTIONS)))
+        (SETQ MATHTRACE (/GETTRACEOPTIONS OPTIONS 'MATHPRINT))
+        (if (AND MATHTRACE (NOT (EQL (ELT (PNAME FN) 0) #\$)) (NOT (GENSYMP FN)))
+            (if (RASSOC FN |$mapSubNameAlist|)
+                (SETQ |$mathTraceList| (CONS FN |$mathTraceList|))
+                (|spadThrowBrightly|
+                  (format nil "mathprint not available for ~A" FN))))
+        (SETQ VARS (/GETTRACEOPTIONS OPTIONS 'VARS))
+        (if VARS
+            (progn (if (NOT (CDR VARS)) (SETQ VARS 'all) (SETQ VARS (CDR VARS)))
+                   (|tracelet| FN VARS)))
+        (SETQ BREAK (/GETTRACEOPTIONS OPTIONS 'BREAK))
+        (SETQ VARBREAK (/GETTRACEOPTIONS OPTIONS 'VARBREAK))
+        (if VARBREAK
+            (progn   (if (NOT (CDR VARBREAK)) (SETQ VARS 'all)
+                         (SETQ VARS (CDR VARBREAK)))
+                     (|breaklet| FN VARS)))
+        (if (and (symbolp fn) (not (boundp FN)) (not (fboundp FN)))
+            (progn
+              (COND ((|isUncompiledMap| FN)
+                     (|sayBrightly|
+                       (format nil
+           "~A must be compiled before it may be traced -- invoke ~A to compile"
+                                            FN FN)))
+                    ((|isInterpOnlyMap| FN)
+                     (|sayBrightly| (format nil
+            "~A cannot be traced because it is an interpret-only function" FN)))
+                    (T (|sayBrightly| (format nil "~A is not a function" FN))))
+              (RETURN NIL)))
+        (if (and (symbolp fn) (boundp FN)
+		 (|isDomainOrPackage| (SETQ FNVAL (EVAL FN))))
+	    (RETURN (|spadTrace| FNVAL OPTIONS)))
+        (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'MASK=))
+            (MAKEPROP FN '/TRANSFORM (CADR U)))
+        (SETQ /TRACENAMES
+              (COND ((/GETTRACEOPTIONS OPTIONS 'ALIAS) /TRACENAMES)
+                    ((ATOM /TRACENAMES) (LIST FN))
+                    ((CONS FN /TRACENAMES))))
+        (SETQ TRACENAME
+              (COND ((SETQ U (/GETTRACEOPTIONS OPTIONS 'ALIAS))
+                     (STRINGIMAGE (CADR U)))
+                    (T
+                     (COND ((AND |$traceNoisely| (NOT VARS)
+                                 (NOT (|isSubForRedundantMapName| FN)))
+                            (|sayBrightly|
+                             (LIST '|%b| (|rassocSub| FN |$mapSubNameAlist|)
+                                   '|%d| "traced"))))
+                     (STRINGIMAGE FN))))
+        (COND (|$fromSpadTrace|
+               (if MATHTRACE (push (INTERN TRACENAME) |$mathTraceList|))
+               (SETQ LETFUNCODE `(SETQ |$currentFunction| ,(MKQ FN)))
+               (SETQ BEFORE
+                     (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'BEFORE))
+                         `(progn ,(CADR U) ,LETFUNCODE)
+                         LETFUNCODE)))
+              (T (SETQ BEFORE
+                       (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'BEFORE))
+                           (CADR U)))))
+        (SETQ AFTER (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'AFTER)) (CADR U)))
+        (SETQ CALLER (/GETTRACEOPTIONS OPTIONS 'CALLER))
+        (SETQ FROM_CONDITION
+              (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'FROM))
+                  (LIST 'EQ '|#9| (LIST 'QUOTE (CADR U)))
+                  T))
+        (SETQ CONDITION
+              (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'WHEN)) (CADR U) T))
+        (SETQ WITHIN_CONDITION T)
+        (COND ((SETQ U (/GETTRACEOPTIONS OPTIONS 'WITHIN))
+               (SETQ G (INTERN (STRCONC (PNAME FN) "/" (PNAME (CADR U)))))
+               (SET G 0)
+               (/TRACE-1
+                 (LIST (CADR U))
+                 `((WHEN NIL)
+                   (BEFORE (SETQ ,G (1+ ,G)))
+                   (AFTER (SETQ ,G (1- ,G)))))
+               (SETQ WITHIN_CONDITION `(> ,G 0))))
+        (SETQ COUNTNAM
+              (AND (/GETTRACEOPTIONS OPTIONS 'COUNT)
+                   (INTERN (STRCONC TRACENAME ",COUNT"))) )
+        (SETQ COUNT_CONDITION
+              (COND ((SETQ U (/GETTRACEOPTIONS OPTIONS 'COUNT))
+                     (SETQ /COUNTLIST (adjoin TRACENAME /COUNTLIST
+					      :test 'equal))
+                     (if (AND (CDR U) (integerp (CADR U)))
+                         `(cond ((<= ,COUNTNAM ,(CADR U)) t)
+                                (t (/UNTRACE-2 ,(MKQ FN) NIL) NIL))
+                         t))
+                    (T T)))
+        (AND (/GETTRACEOPTIONS OPTIONS 'TIMER)
+             (SETQ TIMERNAM (INTERN (STRCONC TRACENAME ",TIMER")))
+             (SETQ /TIMERLIST (adjoin TRACENAME /TIMERLIST :test 'equal)))
+        (SETQ DEPTH_CONDITION
+              (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'DEPTH))
+                  (if (AND (CDR U) (integerp (CADR U)))
+		      (LIST 'LE 'FUNDEPTH (CADR U))
+		    (TRACE_OPTION_ERROR 'DEPTH))
+                  T))
+        (SETQ CONDITION
+              (MKPF
+                (LIST CONDITION WITHIN_CONDITION FROM_CONDITION COUNT_CONDITION
+                      DEPTH_CONDITION )
+                'AND))
+        (SETQ ONLYS (/GETTRACEOPTIONS OPTIONS 'ONLY))
+ 
+        ;TRACECODE meaning:
+        ; 0:        Caller (0,1)           print caller if 1
+        ; 1:        Value (0,1)            print value if 1
+        ; 2...:     Arguments (0,...,9)    stop if 0; print ith if i; all if 9
+        (SETQ TRACECODE
+              (if (/GETTRACEOPTIONS OPTIONS 'NT) "000"
+                  (PROG (F A V C NL BUF)
+                        (SETQ ONLYS (MAPCAR #'COND-UCASE ONLYS))
+                        (SETQ F (OR (member 'F ONLYS :test #'eq)
+                                    (member 'FULL ONLYS :test #'eq)))
+                        (SETQ A (OR F (member 'A ONLYS :test #'eq)
+                                    (member 'ARGS ONLYS :test #'eq)))
+                        (SETQ V (OR F (member 'V ONLYS :test #'eq)
+                                    (member 'VALUE ONLYS :test #'eq)))
+                        (SETQ C (OR F (member 'C ONLYS :test #'eq)
+                                    (member 'CALLER ONLYS :test #'eq)))
+                        (SETQ NL
+                              (if A '(#\9)
+                                  (mapcan #'(lambda (X)
+                                              (if (AND (INTEGERP X)
+                                                       (> X 0)
+                                                       (< X 9))
+                                                  (LIST (FETCHCHAR (STRINGIMAGE X) 0))))
+                                          onlys)))
+                        (if (NOT (OR A V C NL))
+                            (if Caller (return "119") (return "019")))
+                        (SETQ NL (APPEND NL '(\0)))
+                        (SETQ BUF (GETSTR 12))
+                        (SUFFIX (if (or C Caller) #\1 #\0) BUF)
+                        (SUFFIX (if V #\1 #\0) BUF)
+                        (if A (suffix #\9 BUF)
+                            (mapcar #'(lambda (x) (suffix x BUF)) NL))
+                        (RETURN BUF))))
+        (/MONITOR FN TRACECODE BEFORE AFTER CONDITION TIMERNAM
+                  COUNTNAM TRACENAME BREAK )))
+ 
+(DEFUN OPTIONS2UC (L)
+  (COND ((NOT L) NIL)
+        ((ATOM (CAR L))
+         (|spadThrowBrightly|
+           (format nil "~A has wrong format for an option" (car L))))
+        ((CONS (CONS (LC2UC (CAAR L)) (CDAR L)) (OPTIONS2UC (CDR L))))))
+ 
+(DEFUN COND-UCASE (X) (COND ((INTEGERP X) X) ((UPCASE X))))
+ 
+(DEFUN TRACEOPTIONS (X)
+  (COND ((NOT X) NIL)
+        ((EQ (CAR X) '/) X)
+        ((TRACEOPTIONS (CDR X)))))
+ 
+(defmacro |/untrace| (&rest L) `', (/UNTRACE-0 L))
+ 
+(defmacro /UNTRACE (&rest L) `', (/UNTRACE-0 L))
+ 
+(defmacro /U (&rest L) `', (/UNTRACE-0 L))
+ 
+(DEFUN /UNTRACE-0 (L)
+    (PROG (OPTIONL OPTIONS FNL)
+      (if (member '? L :test #'eq) (RETURN (OBEY "EXEC NORMEDIT TRACE TELL")))
+      (SETQ OPTIONL (/OPTIONS L))
+      (SETQ FNL (TRUNCLIST L OPTIONL))
+      (SETQ OPTIONS (if OPTIONL (CAR OPTIONL)))
+      (RETURN (/UNTRACE-1 FNL OPTIONS))))
+ 
+(define-function '|/UNTRACE,0| #'/UNTRACE-0)
+ 
+(defun /UNTRACE-1 (L OPTIONS)
+  (cond
+    ((NOT L)
+     (if (ATOM /TRACENAMES)
+         NIL
+         (mapcar #'(lambda (u) (/UNTRACE-2 (/UNTRACE-REDUCE U) OPTIONS))
+                 (APPEND /TRACENAMES NIL))))
+    ((mapcar #'(lambda (x) (/UNTRACE-2 X OPTIONS)) L)))
+  (/TRACEREPLY))
+ 
+(DEFUN /UNTRACE-REDUCE (X) (if (ATOM X) X (first X))) ; (CAR X) is now a domain
+ 
+(DEFUN /UNTRACE-2 (X OPTIONS)
+ (let (u y)
+  (COND ((AND (|isFunctor| X) (ATOM X))
+         (|untraceDomainConstructor| X))
+        ((OR (|isDomainOrPackage| (SETQ U X))
+             (and (symbolp X) (boundp X)
+		  (|isDomain| (SETQ U (EVAL X)))))
+         (|spadUntrace| U OPTIONS))
+        ((EQCAR OPTIONS 'ALIAS)
+           (if |$traceNoisely|
+               (|sayBrightly| (LIST '|%b| (CADR OPTIONS) '|%d| '**untraced)))
+           (SETQ /TIMERLIST
+		 (REMOVE (STRINGIMAGE (CADR OPTIONS)) /TIMERLIST :test 'equal))
+           (SETQ /COUNTLIST
+		 (REMOVE (STRINGIMAGE (CADR OPTIONS)) /COUNTLIST :test 'equal))
+           (SETQ |$mathTraceList|
+		 (REMOVE (CADR OPTIONS) |$mathTraceList| :test 'equal))
+           (UNEMBED X))
+        ((AND (NOT (MEMBER X /TRACENAMES))
+              (NOT (|isSubForRedundantMapName| X)))
+         (|sayBrightly|
+           (LIST
+             '|%b|
+             (|rassocSub| X |$mapSubNameAlist|)
+             '|%d|
+             "not traced")))
+        (T (SETQ /TRACENAMES (REMOVE X /TRACENAMES :test 'equal))
+           (SETQ |$mathTraceList|
+                 (REMOVE (if (STRINGP X) (INTERN X) X) |$mathTraceList|))
+           (SETQ |$letAssoc| (DELASC X |$letAssoc|))
+           (setq Y (if (IS_GENVAR X) (|devaluate| (EVAL X)) X))
+           (SETQ /TIMERLIST (REMOVE (STRINGIMAGE Y) /TIMERLIST :test 'equal))
+           (SET (INTERN (STRCONC Y ",TIMER")) 0)
+           (SETQ /COUNTLIST (REMOVE (STRINGIMAGE Y) /COUNTLIST :test 'equal))
+           (SET (INTERN (STRCONC Y ",COUNT")) 0)
+           (COND ((AND |$traceNoisely| (NOT (|isSubForRedundantMapName| Y)))
+                  (|sayBrightly|
+                    (LIST '|%b| (|rassocSub| Y |$mapSubNameAlist|)
+                  '|%d| "untraced"))))
+           (UNEMBED X)))))
+ 
+  ;; the following is called by |clearCache|
+(define-function '/UNTRACE\,2 #'/UNTRACE-2)
+ 
+(DEFUN MONITOR-PRINVALUE (VAL NAME)
+  (let (u)
+    (COND ((setq U (GET NAME '/TRANSFORM))
+           (COND
+             ((EQCAR U '&)
+	      (PRINC "//" CURSTRM) (PRIN1 VAL CURSTRM) (TERPRI CURSTRM))
+	     (T (PRINC "! " CURSTRM)
+		(PRIN1 (EVAL (SUBST (MKQ VAL) '* (CAR U))) CURSTRM)
+		(TERPRI CURSTRM)) ))
+          (T
+	   (PRINC ": " CURSTRM)
+           (COND ((NOT (SMALL-ENOUGH VAL)) (|F,PRINT-ONE| VAL CURSTRM))
+                 (/PRETTY (PRETTYPRINT VAL CURSTRM))
+                 (T (COND (|$mathTrace| (TERPRI)))
+		    (PRINMATHOR0 VAL CURSTRM)))))))
+ 
+(DEFUN MONITOR-BLANKS (N) (PRINC (MAKE-FULL-CVEC N " ") CURSTRM))
+ 
+(DEFUN MONITOR-EVALBEFORE (X) (EVALFUN (MONITOR-EVALTRAN X NIL)) X)
+ 
+(DEFUN MONITOR-EVALAFTER (X) (EVALFUN (MONITOR-EVALTRAN X 'T)))
+ 
+(DEFUN MONITOR-EVALTRAN (X FG)
+  (if (HAS_SHARP_VAR X) (MONITOR-EVALTRAN1 X FG) X))
+ 
+(define-function 'MONITOR\,EVALTRAN #'MONITOR-EVALTRAN)
+ 
+(DEFUN MONITOR-EVALTRAN1 (X FG)
+  (let (n)
+    (COND
+      ((SETQ N (|isSharpVarWithNum| X)) (MONITOR-GETVALUE N FG))
+      ((ATOM X) X)
+      ((CONS (MONITOR-EVALTRAN1 (CAR X) FG)
+             (MONITOR-EVALTRAN1 (CDR X) FG))))))
+ 
+(DEFUN HAS_SHARP_VAR (X)
+  (COND ((AND (ATOM X) (IS_SHARP_VAR X)) 'T)
+        ((ATOM X) NIL)
+        ((OR (HAS_SHARP_VAR (CAR X)) (HAS_SHARP_VAR (CDR X))))))
+ 
+(DEFUN IS_SHARP_VAR (X)
+  (AND (IDENTP X)
+       (EQL (ELT (PNAME X) 0) #\#)
+       (INTEGERP (lisp:parse-integer (symbol-name X) :start 1))))
+ 
+(DEFUN MONITOR-GETVALUE (N FG)
+  (COND ((= N 0)
+         (if FG
+             (MKQ /VALUE)
+             (|spadThrowBrightly| "cannot ask for value before execution")))
+        ((= N 9) (MKQ /CALLER))
+        ((<= N (SIZE /ARGS)) (MKQ (ELT /ARGS (1- N))))
+        ((|spadThrowBrightly| (LIST 'function '|%b| /NAME '|%d|
+                              "does not have" '|%b| N '|%d| "arguments")))))
+ 
+(DEFUN MONITOR-PRINARGS (L CODE /TRANSFORM)
+  (let (N)
+    (cond
+      ((= (digit-char-p (elt CODE 2)) 0) NIL)
+      ((= (digit-char-p (elt CODE 2)) 9)
+       (cond
+         (/TRANSFORM
+           (mapcar
+             #'(lambda (x y)
+                 (COND ((EQ Y '*)
+			(PRINC "\\ " CURSTRM)
+                        (MONITOR-PRINT X CURSTRM))
+                       ((EQ Y '&)
+                        (PRINC "\\\\" CURSTRM)
+                        (TERPRI CURSTRM)
+                        (PRINT X CURSTRM))
+                       ((NOT Y) (PRINC "! " CURSTRM))
+                       (T
+			(PRINC "! " CURSTRM)
+                        (MONITOR-PRINT
+                          (EVAL (SUBST (MKQ X) '* Y)) CURSTRM))))
+	    L (cdr /transform)))
+	 (T (PRINC ": " CURSTRM)
+            (COND ((NOT (ATOM L))
+                   (if |$mathTrace| (TERPRI CURSTRM))
+                   (MONITOR-PRINT (CAR L) CURSTRM) (SETQ L (CDR L))))
+            (mapcar #'monitor-printrest L))))
+      ((do ((istep 2 (+ istep 1))
+            (k (maxindex code)))
+	   ((> istep k) nil)
+        (when (not (= 0 (SETQ N (digit-char-p (elt CODE ISTEP)))))
+         (PRINC "\\" CURSTRM)
+         (PRINMATHOR0 N CURSTRM)
+         (PRINC ": " CURSTRM)
+         (MONITOR-PRINARGS-1 L N)))))))
+ 
+(DEFUN MONITOR-PRINTREST (X)
+  (COND ((NOT (SMALL-ENOUGH X))
+         (PROGN (TERPRI)
+                (MONITOR-BLANKS (1+ /DEPTH))
+                (PRINC "\\" CURSTRM)
+                (PRINT X CURSTRM)))
+        ((PROGN (if (NOT |$mathTrace|) (PRINC "\\" CURSTRM))
+                (COND (/PRETTY (PRETTYPRINT X CURSTRM))
+                      ((PRINMATHOR0 X CURSTRM)))))))
+ 
+(DEFUN MONITOR-PRINARGS-1 (L N)
+  (COND ((OR (ATOM L) (LESSP N 1)) NIL)
+        ((EQ N 1) (MONITOR-PRINT (CAR L) CURSTRM))
+        ((MONITOR-PRINARGS-1 (CDR L) (1- N)))))
+ 
+(DEFUN MONITOR-PRINT (X CURSTRM)
+  (COND ((NOT (SMALL-ENOUGH X)) (|F,PRINT-ONE| X CURSTRM))
+        (/PRETTY (PRETTYPRINT X CURSTRM))
+        ((PRINMATHOR0 X CURSTRM))))
+ 
+(DEFUN PRINMATHOR0 (X CURSTRM)
+  (if |$mathTrace| (|maprinSpecial| (|outputTran| X) /DEPTH 80)
+      (PRIN0 X CURSTRM)))
+ 
+(DEFUN SMALL-ENOUGH (X) (if /TRACESIZE (SMALL-ENOUGH-COUNT X 0 /TRACESIZE) t))
+ 
+(DEFUN SMALL-ENOUGH-COUNT (X N M)
+  "Returns number if number of nodes < M otherwise nil."
+  (COND ((< M N) NIL)
+        ((VECP X)
+         (do ((i 0 (1+ i)) (k (maxindex x)))
+             ((> i k) n)
+           (if (NOT (SETQ N (SMALL-ENOUGH-COUNT (ELT X I) (1+ N) M)))
+               (RETURN NIL))))
+        ((ATOM X) N)
+        ((AND (SETQ N (SMALL-ENOUGH-COUNT (CAR X) (1+ N) M))
+              (SMALL-ENOUGH-COUNT (CDR X) N M)))))
+ 
+(DEFUN /OPTIONS (X)
+  (COND ((ATOM X) NIL)
+        ((OR (ATOM (CAR X)) (|isFunctor| (CAAR X))) (/OPTIONS (CDR X)))
+        (X)))
+ 
+(DEFUN /GETOPTION (L OPT) (KDR (/GETTRACEOPTIONS L OPT)))
+ 
+(DEFUN /GETTRACEOPTIONS (L OPT)
+  (COND ((ATOM L) NIL)
+        ((EQ (KAR (CAR L)) OPT) (CAR L))
+        ((/GETTRACEOPTIONS (CDR L) OPT))))
+ 
+(DEFMACRO /TRACELET (&rest L) `',
+  (PROG (OPTIONL FNL)
+        (if (member '? L :test #'eq)
+            (RETURN (OBEY (if (EQ (SYSID) 1)
+                              "EXEC NORMEDIT TRACELET TELL"
+                              "$COPY AZ8F:TRLET.TELL")) ))
+        (SETQ OPTIONL (/OPTIONS L))
+        (SETQ FNL (TRUNCLIST L OPTIONL))
+        (RETURN (/TRACELET-1 FNL OPTIONL))))
+ 
+(DEFUN /TRACELET-1 (FNLIST OPTIONL)
+  (mapcar #'(lambda (x) (/tracelet-2 x optionl)) fnlist)
+  (/TRACE-1 FNLIST OPTIONL)
+  (TRACELETREPLY))
+ 
+(DEFUN TRACELETREPLY ()
+   (if (ATOM /TRACELETNAMES) '(none tracelet)
+       (APPEND /TRACELETNAMES (LIST 'tracelet))))
+ 
+(DEFUN /TRACELET-2 (FN OPTIONL &AUX ($TRACELETFLAG T))
+  (/D-1 (CONS FN OPTIONL) 'COMP NIL NIL)
+  (SETQ /TRACELETNAMES
+        (if (ATOM /TRACELETNAMES) (LIST FN) (CONS FN /TRACELETNAMES)))
+  FN)
+ 
+(defmacro /TRACE-LET (A B)
+  `(PROG1 (SPADLET ,A ,B)
+          . ,(mapcar #'(lambda (x) `(/tracelet-print ',x ,x))
+                     (if (ATOM A) (LIST A) A))))
+ 
+(defun /TRACELET-PRINT (X Y &AUX (/PRETTY 'T))
+  (PRINC (STRCONC (PNAME X) ": ") *terminal-io*)
+  (MONITOR-PRINT Y *terminal-io*))
+ 
+(defmacro /UNTRACELET (&rest L) `',
+  (COND
+    ((NOT L)
+     (if (ATOM /TRACELETNAMES) NIL (EVAL (CONS '/UNTRACELET /TRACELETNAMES))))
+    ((mapcar #'/untracelet-1 L))
+    ((TRACELETREPLY))))
+ 
+(DEFUN /UNTRACELET-1 (X)
+  (COND
+    ((NOT (MEMBER X /TRACELETNAMES))
+     (PROGN (PRINT (STRCONC (PNAME X) " not tracelet")) (TERPRI)))
+    ((PROGN
+       (/UNTRACELET-2 X)
+       (/D-1 (LIST X) 'COMP NIL NIL)))))
+ 
+(DEFUN /UNTRACELET-2 (X)
+  (SETQ /TRACELETNAMES (REMOVE X /TRACELETNAMES))
+  (PRINT (STRCONC (PNAME X) " untracelet")) (TERPRI))
+ 
+(defmacro /EMBED (&rest L) `',
+ (COND ((NOT L) (/EMBEDREPLY))
+       ((member '? L :test #'eq) (OBEY "EXEC NORMEDIT EMBED TELL"))
+       ((EQ 2 (LENGTH L)) (/EMBED-1 (CAR L) (CADR L)))
+       ((MOAN "IMPROPER USE OF /EMBED"))))
+ 
+(defmacro /UNEMBED (&rest L) `',
+  (COND ((NOT L)
+         (if (ATOM (EMBEDDED)) NIL
+             (mapcar #'unembed (embedded)))
+         (SETQ /TRACENAMES NIL)
+         (SETQ /EMBEDNAMES NIL))
+        ((mapcar #'/unembed-1 L)
+         (SETQ /TRACENAMES (S- /TRACENAMES L)) ))
+  (/EMBEDREPLY))
+ 
+(defun /UNEMBED-Q (X)
+  (COND
+    ((NOT (MEMBER X /EMBEDNAMES))
+     (ERROR (STRCONC (PNAME X) " not embeded")))
+    ((PROGN
+       (SETQ /EMBEDNAMES (REMOVE X /EMBEDNAMES))
+       (UNEMBED X)))))
+ 
+(defun /UNEMBED-1 (X)
+  (COND
+    ((NOT (MEMBER X /EMBEDNAMES))
+     (|sayBrightly| (LIST '|%b| (PNAME X) '|%d| "not embeded" '|%l|)))
+    ((PROGN
+       (SETQ /EMBEDNAMES (REMOVE X /EMBEDNAMES))
+       (|sayBrightly| (LIST '|%b| (PNAME X) '|%d| "unembeded" '|%l|))
+       (UNEMBED X)))  ))
+ 
+ 
+ 
+(defun /MONITOR (&rest G5)
+  (PROG (G1 G4 TRACECODE BEFORE AFTER CONDITION
+         TIMERNAM COUNTNAM TRACENAME BREAK)
+        (dcq (G1 TRACECODE BEFORE AFTER CONDITION TIMERNAM COUNTNAM TRACENAME BREAK) G5)
+        (SETQ G4 (macro-function G1))
+        (SETQ TRACECODE (OR TRACECODE "119"))
+        (if COUNTNAM (SET COUNTNAM 0))
+        (if TIMERNAM (SET TIMERNAM 0))
+        (EMBED
+          G1
+          (LIST
+            (if G4 'MLAMBDA 'LAMBDA)
+            '(&rest G6)
+            (LIST
+              '/MONITORX
+              (QUOTE G6)
+              G1
+              (LIST
+                'QUOTE
+                (LIST
+                  TRACENAME (if G4 'MACRO) TRACECODE
+                  COUNTNAM TIMERNAM BEFORE AFTER
+                  CONDITION BREAK |$tracedModemap| ''T)))))
+        (RETURN G1)))
+ 
+(defun /MONITORX (/ARGS FUNCT OPTS &AUX NAME TYPE TRACECODE COUNTNAM TIMERNAM
+                        BEFORE AFTER CONDITION BREAK TRACEDMODEMAP
+                        BREAKCONDITION)
+            (declare (special /ARGS))
+  (DCQ (NAME TYPE TRACECODE COUNTNAM TIMERNAM BEFORE AFTER CONDITION BREAK TRACEDMODEMAP BREAKCONDITION) OPTS)
+  (|stopTimer|)
+  (PROG (C V A NAME1 CURSTRM EVAL_TIME INIT_TIME NOT_TOP_LEVEL
+         (/DEPTH (if (and (BOUNDP '/DEPTH) (numberp /depth)) (1+ /DEPTH) 1))
+         (|depthAlist| (if (BOUNDP '|depthAlist|) (COPY-TREE |depthAlist|) NIL))
+         FUNDEPTH NAMEID YES (|$tracedSpadModemap| TRACEDMODEMAP) (|$mathTrace| NIL)
+	 /caller /name /value /breakcondition curdepth)
+    (declare (special curstrm /depth fundepth |$tracedSpadModemap| |$mathTrace|
+		      /caller /name /value /breakcondition |depthAlist|))
+        (SETQ /NAME NAME)
+        (SETQ NAME1 (PNAME (|rassocSub| (INTERN NAME) |$mapSubNameAlist|)))
+        (SETQ /BREAKCONDITION BREAKCONDITION)
+        (SETQ /CALLER (|rassocSub| (WHOCALLED 6) |$mapSubNameAlist|))
+        (if (NOT (STRINGP TRACECODE))
+            (MOAN "set TRACECODE to \'1911\' and restart"))
+        (SETQ C (digit-char-p (elt TRACECODE 0))
+              V (digit-char-p (elt TRACECODE 1))
+              A (digit-char-p (elt TRACECODE 2)))
+        (if COUNTNAM (SET COUNTNAM (1+ (EVAL COUNTNAM))))
+        (SETQ NAMEID (INTERN NAME))
+        (SETQ NOT_TOP_LEVEL (ASSOC NAMEID |depthAlist| :test #'eq))
+        (if (NOT NOT_TOP_LEVEL)
+            (SETQ |depthAlist| (CONS (CONS NAMEID 1) |depthAlist|))
+            (RPLACD NOT_TOP_LEVEL (1+ (CDR NOT_TOP_LEVEL))))
+        (SETQ FUNDEPTH (CDR (ASSOC NAMEID |depthAlist| :test #'eq)))
+        (SETQ CONDITION (MONITOR-EVALTRAN CONDITION NIL))
+        (SETQ YES (EVALFUN CONDITION))
+        (if (member NAMEID |$mathTraceList| :test #'eq)
+            (SETQ |$mathTrace| T))
+        (if (AND YES |$TraceFlag|)
+            (PROG (|$TraceFlag|)
+                  (SETQ CURSTRM *TERMINAL-IO*)
+                  (if (EQUAL TRACECODE "000") (RETURN NIL))
+                  (TAB 0 CURSTRM)
+                  (MONITOR-BLANKS (1- /DEPTH))
+                  (PRIN0 FUNDEPTH CURSTRM)
+                  (|sayBrightlyNT| (LIST "<enter" '|%b|
+                                         NAME1 '|%d|) CURSTRM)
+                  (COND ((EQ 0 C) NIL)
+                        ((EQ TYPE 'MACRO)
+                         (PRINT " expanded" CURSTRM))
+                        (T (PRINT " from " CURSTRM)
+                           (PRIN0 /CALLER CURSTRM)))
+                  (MONITOR-PRINARGS
+                    (if (SPADSYSNAMEP NAME)
+                        (NREVERSE (REVERSE  (|coerceTraceArgs2E|
+                                              (INTERN NAME1)
+                                              (INTERN NAME)
+                                              /ARGS)))
+                        (|coerceTraceArgs2E| (INTERN NAME1)
+                                             (INTERN NAME) /ARGS))
+                    TRACECODE
+                    (GET (INTERN NAME) '/TRANSFORM))
+                  (if (NOT |$mathTrace|) (TERPRI CURSTRM))))
+        (if before (MONITOR-EVALBEFORE BEFORE))
+        (if (member '|before| BREAK :test #'eq)
+            (|break| (LIST "Break on entering" '|%b| NAME1 '|%d| ":")))
+        (if TIMERNAM (SETQ INIT_TIME (|startTimer|)))
+        (SETQ /VALUE (if (EQ TYPE 'MACRO) (MDEFX FUNCT /ARGS)
+                         (APPLY FUNCT /ARGS)))
+        (|stopTimer|)
+        (if TIMERNAM (SETQ EVAL_TIME (- (|clock|) INIT_TIME)) )
+        (if (AND TIMERNAM (NOT NOT_TOP_LEVEL))
+            (SET TIMERNAM (+ (EVAL TIMERNAM) EVAL_TIME)))
+        (if AFTER (MONITOR-EVALAFTER AFTER))
+        (if (AND YES |$TraceFlag|)
+            (PROG (|$TraceFlag|)
+                  (if (EQUAL TRACECODE "000") (GO SKIP))
+                  (TAB 0 CURSTRM)
+                  (MONITOR-BLANKS (1- /DEPTH))
+                  (PRIN0 FUNDEPTH CURSTRM)
+                  (|sayBrightlyNT| (LIST ">exit " '|%b| NAME1 '|%d|) CURSTRM)
+                  (COND (TIMERNAM
+                         (|sayBrightlyNT| '\( CURSTRM)
+                         (|sayBrightlyNT| (/ EVAL_TIME 60.0) CURSTRM)
+                         (|sayBrightlyNT| '\ sec\) CURSTRM) ))
+                  (if (EQ 1 V)
+                      (MONITOR-PRINVALUE
+                        (|coerceTraceFunValue2E|
+                          (INTERN NAME1) (INTERN NAME) /VALUE)
+                        (INTERN NAME1)))
+                  (if (NOT |$mathTrace|) (TERPRI CURSTRM))
+               SKIP))
+        (if (member '|after| BREAK :test #'eq)
+            (|break| (LIST "Break on exiting" '|%b| NAME1 '|%d| ":")))
+        (|startTimer|)
+        (RETURN /VALUE)))
+ 
+; Functions to run a timer for tracing
+; It avoids timing the tracing function itself by turning the timer
+; on and off
+ 
+(defun |startTimer| ()
+    (SETQ $delay (PLUS $delay (DIFFERENCE (TEMPUS-FUGIT) |$oldTime|)))
+    (SETQ |$timerOn| 'T)
+    (|clock|))
+ 
+(defun |stopTimer| () (SETQ |$oldTime| (TEMPUS-FUGIT) |$timerOn| NIL) (|clock|))
+ 
+(defun |clock| ()
+  (if |$timerOn| (- (TEMPUS-FUGIT) $delay) (- |$oldTime| $delay)))
+ 
+; Functions to trace/untrace a BPI; use as follows:
+; To trace a BPI-value <bpi>, evaluate (SETQ <name> (BPITRACE <bpi>))
+; To later untrace <bpi>, evaluate (BPITRACE <name>)
+ 
+(defun PAIRTRACE (PAIR ALIAS)
+   (RPLACA PAIR (BPITRACE (CAR PAIR) ALIAS )) NIL)
+ 
+(defun BPITRACE (BPI ALIAS &optional OPTIONS)
+  (SETQ NEWNAME (GENSYM))
+  (IF (identp bpi) (setq bpi (symbol-function bpi)))
+  (SET NEWNAME BPI)
+  (SETF (symbol-function NEWNAME) BPI)
+  (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
+  NEWNAME)
+ 
+(defun BPIUNTRACE (X ALIAS) (/UNTRACE-0 (LIST X (LIST 'ALIAS ALIAS))))
+ 
+(defun SPADSYSNAMEP (STR)
+  (let (n i j)
+    (AND (SETQ N (MAXINDEX STR))
+         (SETQ I (position #\. STR :start 1))
+         (SETQ J (position #\, STR :start (1+ I)))
+         (do ((k (1+ j) (1+ k)))
+             ((> k n) t)
+           (if (not (digitp (elt str k))) (return nil))))))
+ 
+; **********************************************************************
+;            Utility functions for Tracing Package
+; **********************************************************************
+ 
+(MAKEPROP '|coerce| '/TRANSFORM '(& & *))
+(MAKEPROP '|comp| '/TRANSFORM '(& * * &))
+(MAKEPROP '|compIf| '/TRANSFORM '(& * * &))
+ 
+;  by having no transform for the 3rd argument, it is simply not printed
+ 
+(MAKEPROP '|compFormWithModemap| '/TRANSFORM '(& * * & *))
+ 
+(defun UNVEC (X)
+  (COND ((REFVECP X) (CONS '$ (VEC_TO_TREE X)))
+        ((ATOM X) X)
+        ((CONS (UNVEC (CAR X)) (UNVEC (CDR X))))))
+ 
+(defun DROPENV (X) (AND X (LIST (CAR X) (CADR X))))
+ 
+(defun SHOWBIND (E)
+  (do ((v e (cdr v))
+       (llev 1 (1+ llev)))
+      ((not v))
+    (PRINT (LIST "LAMBDA LEVEL" LLEV))
+    (do ((w (car v) (cdr w))
+         (clev 1 (1+ clev)))
+        ((not w))
+      (PRINT (LIST "CONTOUR LEVEL" CLEV))
+      (PRINT (mapcar #'car (car W))))))
+ 
+#+:CCL
+(defun break (&rest ignore) (lisp-break ignore) (lisp::unwind))
+
+
+#+:CCL
+(defun lisp-break (&rest ignore)
+  (prog (prompt ifile ofile u v)
+    (setq ifile (rds *debug-io*))
+    (setq ofile (wrs *debug-io*))
+    (setq prompt (setpchar "Break loop (:? for help)> "))
+top (setq u (read))
+    (cond
+      ((equal u ':x) (go exit))
+      ((equal u ':q)
+        (progn (lisp::enable-backtrace nil) 
+               (princ "Backtrace now disabled")
+               (terpri)))
+      ((equal u ':v)
+        (progn (lisp::enable-backtrace t)
+               (princ "Backtrace now enabled")
+               (terpri)))
+      ((equal u ':?)
+        (progn
+           (princ ":Q   disables backtrace")
+           (terpri)
+           (princ ":V   enables backtrace")
+           (terpri)
+           (princ ":X   exits from break loop")
+           (terpri)
+           (princ "else enter LISP expressions for evaluation")
+           (terpri)))
+      ((equal u #\eof)
+       (go exit))
+     (t (progn
+           (setq v (errorset u nil nil))
+           (if (listp v) (progn (princ "=> ") (prinl (car v)) (terpri))))) )
+     (go top)
+exit (rds ifile)
+     (wrs ofile)
+     (setpchar prompt)
+     (return nil)))
+
+(defun lisp-break-from-axiom (&rest ignore) 
+    (boot::|handleLispBreakLoop| boot::|$BreakMode|))
+#+:CCL (setq lisp:*break-loop* 'boot::lisp-break-from-axiom)
+
+<<interrupt>>
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/debugsys.lisp.pamphlet b/src/interp/debugsys.lisp.pamphlet
new file mode 100644
index 00000000..5a97e4c0
--- /dev/null
+++ b/src/interp/debugsys.lisp.pamphlet
@@ -0,0 +1,268 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp debugsys.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{An explanation}
+
+This file is basically the same as the one created during the build of
+interpsys. See the echo lines in the {\bf SAVESYS} block in the
+Makefile.pamphlet file. These are echoed into a temporary file which
+gets loaded into the lisp image to create interpsys.  We simply
+captured that temporary file, replaced the .o files with .lisp files
+(or .lsp or .clisp) and saved it here.
+
+This is a file that can be loaded into a raw lisp image to create a
+running interpreter. Note that almost all of the files are loaded as
+lisp code. cfuns and sockio are exceptions because they depend on the
+loader to link to externs in the lisp image which cannot be done in
+interpreted code. 
+
+We assume that debugsys is being built after interpsys has been built
+as the only use for a debugsys image is to debug a deep system
+problem in interpsys. Thus we can assume that all of these files
+exist. Note that these files are {\bf hard coded} to assume they
+live under {\bf /home/axiomgnu/new}. You need to do a global
+search and replace if you don't place them there. We should write
+lisp code to grab the {\bf AXIOM} shell variable but since (a)
+there is hardly any reason to use this level of debugging and (b)
+if you're screwing around here you've got much harder problems
+to solve so this is not an issue.
+
+For debugging purposes you can add anything to this file
+and it will show up in the debugsys image. 
+
+Note that the nag files have been removed as there is a bug
+in the handling of their autoload code.
+\section{Non-portable code}
+\subsection{GCL only code}
+\subsubsection{use-fast-links}
+The use-fast-links function is a speed optimization on function
+calls. It basically assumes that the call has been properly
+constructed so the compiler can skip argument checks. 
+<<use-fast-links>>=
+#+:gcl (si::use-fast-links nil)
+@ 
+\section{The debugsys.lisp code}
+<<*>>=
+<<use-fast-links>>
+(unless (system:getenv "AXIOM") 
+ (format t "The AXIOM shell variable must be set~%")
+ (format t "The likely value is axiom/mnt/linux~%"))
+(unless (system:getenv "SYS")   
+ (format t "The SYS shell variable must be set~%") 
+ (format t "The likely value is linux~%"))
+(unless (system:getenv "DAASE")
+ (format t "The DAASE shell variable must be set~%")
+ (format t "The likely value is axiom/mnt/linux~%"))
+(trace load)
+#+:GCL
+(defun thepath (file) 
+  (concatenate 'string (system:getenv "AXIOM") "/../.." file))
+(load "sys-pkg.lisp")
+(load "nocompil.lisp")
+(load "bookvol5.lisp")
+(load "util.lisp")
+(in-package "BOOT")
+(setq *sys* (system:getenv "SYS"))
+#+:GCL
+(defun thesymb (file) (intern
+  (concatenate 'string (system:getenv "AXIOM") "/../.." file)))
+(progn (setq timestamp (user::thepath "/src/timestamp")) (yearweek))
+@
+The [[*build-version*]] variable is only introduced into the system
+from the Makefile. Since this isn't going thru the Makefile when
+loaded by hand we need to establish a value.
+<<*>>=
+(setq *build-version* "debug")
+(build-interpsys 
+ (append 
+   (list 
+      "vmlisp.lisp"
+      "hash.lisp"
+      "bootfuns.lisp"
+      "macros.lisp"
+      "unlisp.lisp"
+      "setq.lisp"
+      "astr.clisp"
+      "bits.lisp"
+      "alql.clisp"
+      (thesymb "/int/interp/buildom.clisp")
+      (thesymb "/int/interp/cattable.clisp")
+      "cformat.clisp"
+      (thesymb (concatenate 'string "/obj/" *sys* "/interp/cfuns.o"))
+      (thesymb "/int/interp/clam.clisp")
+      (thesymb "/int/interp/clammed.clisp")
+      "comp.lisp"
+      (thesymb "/int/interp/compat.clisp")
+      (thesymb "/int/interp/compress.clisp")
+      "cparse.clisp"
+      "cstream.clisp"
+      (thesymb "/int/interp/database.clisp")
+      "debug.lisp"
+      "dq.clisp"
+      "fname.lisp"
+      (thesymb "/int/interp/format.clisp")
+      (thesymb "/int/interp/g-boot.clisp")
+      (thesymb "/int/interp/g-cndata.clisp")
+      (thesymb "/int/interp/g-error.clisp")
+      (thesymb "/int/interp/g-opt.clisp")
+      (thesymb "/int/interp/g-timer.clisp")
+      (thesymb "/int/interp/g-util.clisp")
+      "ggreater.lisp"
+      (thesymb "/int/interp/hypertex.clisp")
+      (thesymb "/int/interp/i-analy.clisp")
+      (thesymb "/int/interp/i-code.clisp")
+      (thesymb "/int/interp/i-coerce.clisp")
+      (thesymb "/int/interp/i-coerfn.clisp")
+      (thesymb "/int/interp/i-eval.clisp")
+      (thesymb "/int/interp/i-funsel.clisp")
+      (thesymb "/int/interp/i-intern.clisp")
+      (thesymb "/int/interp/i-map.clisp")
+      (thesymb "/int/interp/i-output.clisp")
+      (thesymb "/int/interp/i-resolv.clisp")
+      (thesymb "/int/interp/i-spec1.clisp")
+      (thesymb "/int/interp/i-spec2.clisp")
+      (thesymb "/int/interp/i-syscmd.clisp")
+      (thesymb "/int/interp/i-toplev.clisp")
+      (thesymb "/int/interp/i-util.clisp")
+      "incl.clisp"
+      "int-top.clisp"
+      "intfile.clisp"
+      (thesymb "/int/interp/lisplib.clisp")
+      "macex.clisp"
+      (thesymb "/int/interp/match.clisp")
+      "monitor.lisp"
+      "msg.clisp"
+      (thesymb "/int/interp/msgdb.clisp")
+      "nci.lisp"
+      "newaux.lisp"
+      (thesymb "/int/interp/newfort.clisp")
+      "nlib.lisp"
+      (thesymb "/int/interp/nrunfast.clisp")
+      (thesymb "/int/interp/nrungo.clisp")
+      (thesymb "/int/interp/nrunopt.clisp")
+      (thesymb "/int/interp/nruntime.clisp")
+      "osyscmd.clisp"
+      "packtran.clisp"
+      (thesymb "/int/interp/pathname.clisp")
+      "pf2sex.clisp"
+      "pile.clisp"
+      "posit.clisp"
+      "property.lisp"
+      "ptrees.clisp"
+      "ptrop.clisp"
+      (thesymb "/int/interp/record.clisp")
+      (thesymb "/int/interp/rulesets.clisp")
+      "scan.clisp"
+      "serror.clisp"
+      (thesymb "/int/interp/server.clisp")
+      (thesymb "/int/interp/setvars.clisp")
+      "sfsfun-l.lisp"
+      "sfsfun.clisp"
+      (thesymb "/int/interp/simpbool.clisp")
+      (thesymb "/int/interp/slam.clisp")
+      (thesymb (concatenate 'string "/obj/" *sys* "/interp/sockio.o"))
+      "spad.lisp"
+      "spaderror.lisp"
+      (thesymb "/int/interp/template.clisp")
+      (thesymb "/int/interp/termrw.clisp")
+      (thesymb "/int/interp/trace.clisp")
+      "union.lisp"
+      "daase.lisp"
+      (thesymb "/int/interp/fortcall.clisp"))
+  (list
+    (thesymb "/int/interp/hashcode.clisp")
+    (thesymb "/int/interp/as.clisp")
+    "foam_l.lisp"
+    "axext_l.lisp")
+  (list
+    "varini.clisp"
+    "parini.clisp"
+    (thesymb "/int/interp/setvart.clisp")
+    "intint.lisp"
+    (thesymb "/int/interp/xrun.clisp")
+    (thesymb "/int/interp/interop.clisp")
+    "patches.lisp"))
+  (list
+    "bootlex.lisp"
+    "def.lisp"
+    "fnewmeta.lisp"
+    "metalex.lisp"
+    "metameta.lisp"
+    "parsing.lisp"
+    "parse.clisp"
+    "postpar.clisp"
+    "postprop.lisp"
+    "preparse.lisp")
+  (list
+    (thesymb "/int/interp/apply.clisp")
+    (thesymb "/int/interp/c-doc.clisp")
+    (thesymb "/int/interp/c-util.clisp")
+    (thesymb "/int/interp/profile.clisp")
+    (thesymb "/int/interp/category.clisp")
+    (thesymb "/int/interp/compiler.clisp")
+    (thesymb "/int/interp/define.clisp")
+    (thesymb "/int/interp/functor.clisp")
+    (thesymb "/int/interp/info.clisp")
+    (thesymb "/int/interp/iterator.clisp")
+    (thesymb "/int/interp/modemap.clisp")
+    (thesymb "/int/interp/nruncomp.clisp")
+    (thesymb "/int/interp/package.clisp")
+    (thesymb "/int/interp/htcheck.clisp")
+    (thesymb "/int/interp/xruncomp.clisp"))
+  (list
+    (thesymb "/int/interp/bc-matrix.clisp")
+    (thesymb "/int/interp/bc-misc.clisp")
+    (thesymb "/int/interp/bc-solve.clisp")
+    (thesymb "/int/interp/bc-util.clisp")
+    (thesymb "/int/interp/ht-util.clisp")
+    (thesymb "/int/interp/htsetvar.clisp")
+    (thesymb "/int/interp/ht-root.clisp")
+    (thesymb "/int/interp/br-con.clisp")
+    (thesymb "/int/interp/br-data.clisp")
+    "showimp.clisp"
+    (thesymb "/int/interp/br-op1.clisp")
+    (thesymb "/int/interp/br-op2.clisp")
+    (thesymb "/int/interp/br-search.clisp")
+    (thesymb "/int/interp/br-util.clisp")
+    (thesymb "/int/interp/topics.clisp")
+    (thesymb "/int/interp/br-prof.clisp")
+    (thesymb "/int/interp/br-saturn.clisp"))
+  (list
+    (thesymb "/int/interp/wi1.clisp")
+    (thesymb "/int/interp/wi2.clisp")
+    (thesymb "/int/interp/pspad1.clisp")
+    (thesymb "/int/interp/pspad2.clisp")
+    (thesymb "/int/interp/mark.clisp")
+    "nspadaux.lisp"
+    "def.lisp")
+  (quote 
+   ())
+  (list 
+   (thesymb "/int/interp/ax.clisp"))
+  (system:getenv "AXIOM"))
+(in-package "SCRATCHPAD-COMPILER")
+(boot::set-restart-hook)
+(in-package "BOOT")
+(load (user::thepath "/int/algebra/warm.data"))
+(|clearClams|)
+(load "obey.lisp")
+;(si::multiply-bignum-stack 10)
+(si::gbc-time 0)
+(setq si::*system-directory* 
+  (user::thepath (concatenate 'string "/mnt/" *sys* "/bin/")))
+(gbc t)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/def.lisp.pamphlet b/src/interp/def.lisp.pamphlet
new file mode 100644
index 00000000..6b0228c1
--- /dev/null
+++ b/src/interp/def.lisp.pamphlet
@@ -0,0 +1,692 @@
+%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/def.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; NAME:     Def
+; PURPOSE:  Defines BOOT code
+
+(provide 'Boot)
+
+(in-package "BOOT")
+
+;;; Common Block
+
+(defparameter deftran nil)
+(defparameter $macroassoc nil)
+(defparameter $ne nil)
+
+(defparameter $op nil
+"$OP is globalized for construction of local function names, e.g.
+foo defined inside of fum gets renamed as fum,foo.")
+
+(defparameter $opassoc nil
+"$OPASSOC is a renaming accumulator to be used with SUBLIS.")
+
+(defparameter $BODY nil)
+
+(defun DEF (FORM SIGNATURE $BODY)
+  (declare (ignore SIGNATURE))
+  (let* ($opassoc
+         ($op (first form))
+         (argl (rest form))
+         ($body (deftran $body))
+         (argl (DEF-INSERT_LET argl))
+         (arglp (DEF-STRINGTOQUOTE argl))
+	 ($body (|bootTransform| $body)))
+      (COMP (SUBLIS $OPASSOC (list (list $OP (list 'LAM arglp $body)))))))
+
+; We are making shallow binding cells for these functions as well
+
+(mapcar #'(lambda (x) (MAKEPROP (FIRST X) 'DEF-TRAN (SECOND X)))
+         '((\: DEF-\:) (\:\: DEF-\:\:) (ELT DEF-ELT)
+           (SETELT DEF-SETELT) (SPADLET DEF-LET)
+           (SEQ DEF-SEQ) (COLLECT DEF-COLLECT)
+           (REPEAT DEF-REPEAT) (TRACE-LET DEF-TRACE-LET)
+           (CATEGORY DEF-CATEGORY) (EQUAL DEF-EQUAL)
+           (|is| DEF-IS) (|isnt| DEF-ISNT) (|where| DEF-WHERE)))
+
+(defun DEF-EQUAL (X)
+  (COND ((NOT (CDR X)) (CONS 'EQUAL X))
+        ((OR (MEMBER '(|One|) X) (MEMBER '(|Zero|) X)
+             (integerp (FIRST X)) (integerp (SECOND X))) (CONS 'EQL X))
+       ; ((AND (EQCAR (FIRST X) 'QUOTE) (IDENTP (CADAR X))) (CONS 'EQ X))
+        ((NOT (FIRST X)) (LIST 'NULL (SECOND X)))
+        ((NOT (SECOND X)) (LIST 'NULL (FIRST X)))
+       ; ((AND (EQCAR (SECOND X) 'QUOTE) (IDENTP (CADADR X))) (CONS 'EQ X))
+        ($BOOT (CONS 'BOOT-EQUAL X))
+	((CONS 'EQUAL X))))
+ 
+(defun DEF-LESSP (x)
+  (cond ((null (cdr x)) (cons '< x))
+	((eq (cadr x) 0) (list 'minusp (car x)))
+	((and (smint-able (car x)) (smint-able (cadr x)))
+	 (cons 'qslessp x))
+	('t (list '> (CADR x) (CAR x)))))
+
+(defun smint-able (x)
+  (or (smintp x)
+      (and (pairp x) (memq (car x) '(|One| |Zero| LENGTH \# QCSIZE QVSIZE QLENGTH)))))
+
+(defun DEF-PROCESS (X &aux $MACROASSOC)
+  (COND ((EQCAR X 'DEF) (DEF (SECOND X) (THIRD X) (FIRST (CDDDDR X))))
+        ((EQCAR X 'MDEF) (B-MDEF (SECOND X) (THIRD X) (FIRST (CDDDDR X))))
+        ((AND (EQCAR X 'WHERE) (EQCAR (cadr X) 'DEF))
+         (let* ((u (cadr X)) (Y (cdr U)))
+           (DEF-PROCESS (LIST 'DEF
+                              (car Y)
+                              (car (setq Y (cdr Y)))
+                              (car (setq Y (cdr Y)))
+                              (CONS 'WHERE (cons (car (setq Y (cdr Y))) (cddr X)))))))
+	((IS-CONSOLE *STANDARD-OUTPUT*)
+	 (SAY "  VALUE = " (EVAL (DEFTRAN X))))
+        ((print-full (DEFTRAN X)))))
+
+(defun B-MDEF (FORM SIGNATURE $BODY)
+  (declare (ignore SIGNATURE))
+ (let* ($OpAssoc
+        ($op (first form)) (argl (cdr form))
+        (GARGL (MAPCAR '(LAMBDA (X) (GENSYM)) ARGL))
+        ($BODY (SUBLISLIS GARGL ARGL (|bootTransform| (DEFTRAN $BODY))))
+        ($BODY (LIST 'SUBLISLIS (CONS 'LIST GARGL) (LIST 'QUOTE GARGL)
+                     (LIST 'QUOTE $BODY))))
+   (COMP (SUBLIS $OPASSOC
+                 (LIST (LIST $OP (LIST 'MLAMBDA (CONS () GARGL) $BODY)))))))
+
+(defun DEF-INNER (FORM SIGNATURE $BODY)
+  "Same as DEF but assumes body has already been DEFTRANned"
+ (let ($OpAssoc ($op (first form)) (argl (rest form)))
+   (let* ((ARGL (DEF-INSERT_LET ARGL))
+          (ARGLP (DEF-STRINGTOQUOTE ARGL)))
+    (COMP (SUBLIS $OPASSOC `((,$OP (LAM ,ARGLP ,$BODY))))))))
+
+(defun DEF-INSERT_LET (X)
+  (if (ATOM X) X
+      (CONS (DEF-INSERT_LET1 (FIRST X)) (DEF-INSERT_LET (CDR X)))))
+
+(defun DEF-INSERT_LET1 (Y)
+  (if (EQCAR Y 'SPADLET)
+      (COND ((IDENTP (SECOND Y))
+             (setq $BODY
+                   (MKPROGN
+                     (LIST (DEF-LET (THIRD Y) (SECOND Y)) $BODY)))
+             (setq Y (SECOND Y)))
+            ((IDENTP (THIRD Y))
+             (setq $BODY
+                   (MKPROGN (LIST (DEFTRAN Y) $BODY))) (setq Y (THIRD Y)))
+            ((ERRHUH)))
+      Y))
+
+(defun MKPROGN (L) (MKPF L 'PROGN))
+
+(defun DEF-STRINGTOQUOTE (X)
+  (COND ((STRINGP X) (LIST 'QUOTE (INTERN X)))
+        ((ATOM X) X)
+        ((CONS (DEF-ADDLET (FIRST X)) (DEF-STRINGTOQUOTE (CDR X))))))
+
+(defun DEF-ADDLET (X)
+  (if (ATOM X)
+      (if (STRINGP X) `(QUOTE ,(intern x))  X)
+      (let ((g (gensym)))
+        (setq $body (mkprogn
+		     (list (def-let (comp\,fluidize x) g)
+			   $body)))
+        g)))
+
+(mapcar #'(lambda (x) (MAKEPROP (CAR X) 'RENAME (CDR X)))
+        '((|true| 'T) (|otherwise| 'T) (|false| NIL)
+          (|and| AND) (|or| OR) (|is| IS)
+          (|list| LIST) (|cons| CONS) (|car| CAR) (|cdr| CDR)
+          (|setDifference| SETDIFFERENCE) (INTERSECTION |intersection|)
+          (|setIntersection| |intersection|) (|setUnion| |union|)
+          (UNION |union|) (REMOVE |remove|) (MEMBER |member|) (ASSOC |assoc|)
+	  (READ VMREAD) (READ-LINE |read-line|)
+          (|apply| APPLY) (|lastNode| LASTPAIR) (LAST |last|)
+          (|in| |member|) (|strconc| STRCONC) (|append| APPEND)
+          (|copy| COPY) (DELETE |delete|) (RASSOC |rassoc|)
+          (|size| SIZE) (|nconc| NCONC)
+          (|setPart| SETELT) (|where| WHERE)
+          (|first| CAR) (|rest| CDR) (|substitute| MSUBST)
+          (|removeDuplicates| REMDUP) (|reverse| REVERSE) (|nreverse| NREVERSE)
+          (|drop| DROP) (|take| TAKE) (|croak| CROAK) (|genvar| GENVAR)
+          (|mkpf| MKPF) (^= NEQUAL) (= EQUAL) (- SPADDIFFERENCE)
+          (+ PLUS) (* TIMES) (/ QUOTIENT)
+          (** EXPT) (|return| RETURN) (|exit| EXIT) (\| SUCHTHAT)
+          (^ NULL) (|not| NULL) (NOT NULL) (REDUCE spadReduce) (DO spadDo)
+          (|atom| ATOM) (|nil| NIL) (|null| NULL) (GET GETL)
+          (T T$)))
+
+; This two-level call allows DEF-RENAME to be locally bound to do
+; nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp)
+
+(defun DEF-RENAME (X) (DEF-RENAME1 X))
+
+(defun DEF-RENAME1 (X)
+  (COND ((symbolp X) (let ((y (get x 'rename))) (if y (first y) x)))
+        ((and (listp X) X)
+         (if (EQCAR X 'QUOTE)
+             X
+             (CONS (DEF-RENAME1 (FIRST X)) (DEF-RENAME1 (CDR X)))))
+        (X)))
+
+(defun DEFTRAN (X)
+ (let (op Y)
+   (COND ((STRINGP X) (DEF-STRING X))
+         ((IDENTP X) (COND ((LASSOC X $MACROASSOC)) (X)))
+         ((ATOM X) X)
+         ((EQ (setq OP (FIRST X)) 'WHERE) (DEF-WHERE (CDR X)))
+         ((EQ OP 'REPEAT) (DEF-REPEAT (CDR X)))
+         ((EQ OP 'COLLECT) (DEF-COLLECT (CDR X)))
+         ((EQ OP 'MAKESTRING)
+          (COND ((STRINGP (SECOND X)) X)
+                ((EQCAR (SECOND X) 'QUOTE)
+                 (LIST 'MAKESTRING (STRINGIMAGE (CADADR X))))
+                ((LIST 'MAKESTRING (DEFTRAN (SECOND X)) )) ))
+         ((EQ OP 'QUOTE)
+          (if (STRINGP (setq y (SECOND X))) (LIST 'MAKESTRING y)
+             (if (and (identp y) (char= (elt (pname y) 0) #\.))
+                 `(intern ,(pname y) ,(package-name *package*)) x)))
+         ((EQ OP 'IS) (|defIS| (CADR X) (CADDR X)))
+         ((EQ OP 'SPADLET) (DEF-LET (CADR X) (caddr x)))
+         ((EQ OP 'DCQ) (LIST 'DCQ (SECOND X) (DEFTRAN (THIRD X))))
+         ((EQ OP 'COND) (CONS 'COND (DEF-COND (CDR X))))
+         ((member (FIRST X) '(|sayBrightly| SAY MOAN CROAK) :test #'eq)
+          (DEF-MESSAGE X))
+         ((setq Y (GETL (FIRST X) 'DEF-TRAN))
+          (funcall Y (MAPCAR #'DEFTRAN (CDR X))))
+         ((mapcar #'DEFTRAN X)))))
+
+(defun DEF-SEQ (U) (SEQOPT (CONS 'SEQ U)))
+
+(defun DEF-MESSAGE (U) (CONS (FIRST U) (mapcar #'def-message1 (cdr u))))
+
+(defun DEF-MESSAGE1 (V)
+  (COND ((AND (STRINGP V) (> (SIZE V) 0) (NOT (EQ (ELT V 0) '\%)))
+         (LIST 'MAKESTRING V))
+        ((EQCAR V 'CONS) (LIST 'CONS (DEF-MESSAGE1 (SECOND V))
+                               (DEF-MESSAGE1 (THIRD V))))
+        ((DEFTRAN V))))
+
+(defun |DEF-:| (X &aux Y)
+       (DCQ (x y) x)
+       `(SPADLET ,(if (or (eq y '|fluid|)
+			  (and (identp x) (char= #\$ (ELT (PNAME X) 0))))
+		      `(FLUID ,X) X)
+		 NIL))
+
+(defmacro |DEF-::| (X)
+  (let ((expr (first x)) (type (second x)))
+    (if (EQUAL TYPE '(|Triple|)) EXPR (ERRHUH))))
+
+(defun DEF-COLLECT (L) (DEF-IT 'COLLECT (MAPCAR #'DEFTRAN (HACKFORIS L))))
+
+(defun DEF-REPEAT (L) (DEF-IT 'REPEAT (mapcar #'DEFTRAN (HACKFORIS L))))
+
+(defun HACKFORIS (L) (mapcar #'hackforis1 L))
+
+(defun HACKFORIS1 (X)
+  (if (AND (MEMBER (KAR X) '(IN ON)) (EQCAR (SECOND X) 'IS))
+      (CONS (FIRST X) (CONS (CONS 'SPADLET (CDADR X)) (CDDR X)))
+      X))
+
+(defun DEF-select (L)
+  (cond ((IDENTP (FIRST L)) (DEF-select1 (FIRST L) (SECOND L)))
+        ((LET* ((G (GENSYM))
+                (U (DEF-select1 G (SECOND L))))
+           (LIST 'PROGN (LIST 'SPADLET G (FIRST L)) U)))))
+
+(defun DEF-select1 (X Y)
+  (if (EQCAR Y 'SEQ)
+      (CONS 'COND (DEF-select2 X (CDR Y)))
+      (MOAN (format nil "Unexpected CASE body: ~S" Y))))
+
+(defun DEF-select2 (X Y)
+  (let (u v)
+    (COND ((NOT Y) (MOAN "Unexpected CASE clause termination"))
+          ((EQCAR (setq U (FIRST Y)) 'EXIT)
+           (LIST (LIST ''T (SECOND U))))
+          ((AND (EQCAR U 'COND) (NOT (CDDR U))
+                (EQCAR (SECOND (setq V (SECOND U))) 'EXIT))
+           (CONS (LIST (DEF-IS (LIST X (FIRST V))) (CADADR V))
+                 (DEF-select2 X (CDR Y))))
+          ((MOAN (format nil "Unexpected CASE clause: ~S" (FIRST Y)))))))
+
+(defun DEF-IT (FN L)
+  (setq L (reverse L))
+  (let ((B (first L)))
+    (let ((it (DEF-IN2ON (NREVERSE (rest L)))))
+      (let ((itp
+              (apply #'APPEND
+                     (mapcar
+                       #'(lambda (x &aux OP Y G)
+                           (if (AND (MEMBER (setq OP (FIRST X)) '(IN ON))
+                                    (NOT (ATOM (SECOND X))))
+                               (if (EQCAR (setq Y (SECOND X)) 'SPADLET)
+                                   (if (ATOM (setq G (SECOND Y)))
+                                       (LIST `(,OP ,G
+                                               ,(DEFTRAN (THIRD X)))
+                                             `(RESET
+                                                ,(DEF-LET
+                                                   (DEFTRAN
+                                                     (THIRD Y)) G)))
+                                       (ERRHUH))
+                                   (LIST
+                                     `(,OP ,(setq G (GENSYM))
+                                       ,(DEFTRAN (THIRD X)))
+                                     `(RESET
+                                        ,(DEF-LET (DEFTRAN (SECOND X))
+                                                  G))))
+                               `(,X)))
+                       IT))))
+        (CONS FN (NCONC ITP (LIST B)))))))
+
+(defun DEF-IN2ON (IT)
+  (mapcar #'(lambda (x) (let (u)
+              (COND
+                ((AND (EQCAR X 'IN) (EQCAR (THIRD X) '|tails|))
+                 (LIST 'ON (SECOND X) (SECOND (THIRD X))))
+                ((AND (EQCAR X 'IN) (EQCAR (setq U (THIRD X)) 'SEGMENT))
+                 (COND
+                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) 1 (THIRD U)))
+                   ((LIST 'STEP (SECOND X) (SECOND U) 1))  ))
+		((AND (EQCAR X 'INBY) (EQCAR (setq U (THIRD X)) 'SEGMENT))
+		 (COND
+                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) (|last| x) (THIRD U)))
+                   ((LIST 'STEP (SECOND X) (SECOND U) (|last| x)))  ))
+                (X))))
+          IT))
+
+(defun DEF-COND (L)
+  (COND ((NOT L) NIL)
+        ((CONS (MAPCAR #'DEFTRAN (FIRST L)) (DEF-COND (CDR L))))))
+
+(defun DEF-LET (FORM RHS)
+  (setq FORM (if (EQCAR FORM '\:) FORM (macroexpand FORM)))
+  (prog (F1 F2)
+   (COND ((EQCAR FORM '\:)
+          (SPADLET F1 (DEFTRAN FORM))
+          (SPADLET F2 (DEFTRAN (LIST 'SPADLET (CADR FORM) RHS)))
+          (COND ((AND (EQ (CAR F2) 'SPADLET) (EQUAL (CADR F2) (CADR FORM)))
+                  (RETURN (LIST 'SPADLET (CADR F1) (CADDR F2)) ))
+                ('T (RETURN (LIST 'PROGN F1 F2)) )) )
+        ((EQCAR FORM 'ELT) (RETURN
+           (DEFTRAN (LIST 'SETELT (CADR FORM) (CADDR FORM) RHS)) )))
+   (RETURN 
+     (COND (|$useDCQnotLET| (|defLETdcq| FORM (DEFTRAN RHS)))
+	   ('T            (|defLET| FORM (DEFTRAN RHS)))))))
+
+(defun |defLETdcq| (FORM RHS &AUX G NAME)
+  ;; see defLET in G-BOOT BOOT
+  (COND
+    ((IDENTP FORM) (LIST 'SPADLET FORM RHS))
+    ((IDENTP RHS)
+       (LIST 'COND (LIST (DEFTRAN (LIST 'IS RHS FORM)) RHS)
+                   (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
+                                                    (MK_LEFORM FORM)) RHS))))
+    ((AND (EQ (CAR RHS) 'SPADLET) (IDENTP (SETQ NAME (CADR RHS)) ))
+       (SPADLET G (GENSYM))
+       (LIST 'COND (LIST (SUBST RHS G (DEFTRAN (LIST 'IS G FORM))) NAME)
+                   (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
+                                                    (MK_LEFORM FORM)) NAME))))
+    ('T (SPADLET G (GENSYM))
+       (LIST 'COND (LIST (SUBST (LIST 'SPADLET G RHS) G
+                                (DEFTRAN (LIST 'IS G FORM))) G)
+                    (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
+                                                  (MK_LEFORM FORM)) G))  ) )))
+
+(defun MK_LEFORM (U)
+  (COND ((IDENTP U) (PNAME U))
+        ((STRINGP U) U)
+        ((ATOM U) (STRINGIMAGE U))
+        ((MEMBER (FIRST U) '(VCONS CONS) :test #'eq)
+         (STRCONC "(" (MK_LEFORM-CONS U) ")") )
+        ((EQ (FIRST U) 'LIST) (STRCONC "(" (MK_LEFORM (SECOND U)) ")") )
+        ((EQ (FIRST U) 'APPEND) (STRCONC "(" (MK_LEFORM-CONS U) ")") )
+        ((EQ (FIRST U) 'QUOTE) (MK_LEFORM (SECOND U)))
+        ((EQ (FIRST U) 'EQUAL) (STRCONC "=" (MK_LEFORM (SECOND U)) ))
+        ((EQ (FIRST U) 'SPADLET) (MK_LEFORM (THIRD U)))
+        ((ERRHUH))))
+
+(defun MK_LEFORM-CONS (U)
+  (COND ((ATOM U) (STRCONC ":" (MK_LEFORM U)))
+        ((EQ (FIRST U) 'APPEND)
+         (STRCONC ":" (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U)) ))
+        ((EQ (THIRD U) NIL) (MK_LEFORM (SECOND U)))
+        ((STRCONC (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U))))))
+
+(defun LET_ERROR (FORM VAL)
+  (|systemError| (format nil "~S is not matched by structure ~S~%" FORM VAL)))
+
+(defun DEF-ISNT (X) (DEFTRAN (LIST 'NULL (CONS 'IS X))))
+
+(defparameter $IS-GENSYMLIST nil)
+
+(defparameter Initial-Gensym (list (gensym)))
+
+(defun DEF-IS (X)
+  (let (($IS-GENSYMLIST Initial-Gensym))
+    (DEF-IS2 (first X) (second x))))
+
+(defun IS-GENSYM ()
+  (if (NOT (CDR $IS-GENSYMLIST)) (RPLACD $IS-GENSYMLIST (LIST (GENSYM))))
+  (pop $IS-GENSYMLIST))
+
+(defparameter $IS-EQLIST nil)
+(defparameter $IS-SPILL_LIST nil)
+
+(defun DEF-IS2 (FORM STRUCT)
+  (let ($IS-EQLIST $IS-SPILL_LIST (FORM (DEFTRAN FORM)))
+    (if (EQCAR STRUCT '|Tuple|)
+        (MOAN "you must use square brackets around right arg. to" '%b "is" '%d))
+    (let* ((X (DEF-IS-EQLIST (DEF-IS-REMDUP STRUCT)))
+           (CODE (if (IDENTP X)
+                     (MKPF (SUBST FORM X $IS-EQLIST) 'AND)
+                     (MKPF `((DCQ ,X ,FORM) . ,$IS-EQLIST) 'AND))))
+      (let ((CODE (MKPF `(,CODE . ,$IS-SPILL_LIST) 'AND)))
+        (if $TRACELETFLAG
+            (let ((L (remove-if #'gensymp (listofatoms x))))
+              `(PROG1 ,CODE
+                      ,@(mapcar #'(lambda (y) `(/tracelet-print ,y ,y)) L)))
+            CODE)))))
+
+(defun DEF-STRING (X)
+ ;; following patches needed to fix reader bug in Lucid Common Lisp
+  (if (and (> (size x) 0) (or (char= (elt x 0) #\.) (char= (elt x 0) #\Page)))
+      `(INTERN ,X ,(package-name *PACKAGE*))
+      `(QUOTE ,(DEFTRAN (INTERN X)))))
+
+(defun DEF-IS-EQLIST (STR)
+  (let (g e)
+    (COND ((NOT STR) (PUSH `(EQ ,(setq G (IS-GENSYM)) NIL) $IS-EQLIST) G)
+          ((EQ STR '\.) (IS-GENSYM))
+          ((IDENTP STR) STR)
+          ((STRINGP STR)
+           (setq E (DEF-STRING STR))
+           (PUSH (LIST (if (ATOM (SECOND E)) 'EQ 'EQUAL)
+                       (setq G (IS-GENSYM)) E)
+                 $IS-EQLIST)
+           G)
+          ((OR (NUMBERP STR) (MEMBER STR '((|Zero|) (|One|))))
+           (PUSH (LIST 'EQ (setq G (IS-GENSYM)) STR) $IS-EQLIST)
+           G)
+          ((ATOM STR) (ERRHUH))
+          ((EQCAR STR 'SPADLET)
+           (COND ((IDENTP (SECOND STR))
+                  (PUSH (DEF-IS2 (cadr str) (caddr STR)) $IS-SPILL_LIST)
+                  (SECOND STR))
+                 ((IDENTP (THIRD STR))
+                  (PUSH (DEFTRAN STR) $IS-SPILL_LIST) (THIRD STR))
+                 ((ERRHUH)) ))
+          ((EQCAR STR 'QUOTE)
+           (PUSH (LIST (COND ((ATOM (SECOND STR)) 'EQ)
+                             ('EQUAL))
+                       (setq G (IS-GENSYM)) STR) $IS-EQLIST) G)
+          ((EQCAR STR 'LIST) (DEF-IS-EQLIST (LIST2CONS STR)))
+          ((OR (EQCAR STR 'CONS) (EQCAR STR 'VCONS))
+           (CONS (DEF-IS-EQLIST (SECOND STR)) (DEF-IS-EQLIST (THIRD STR))))
+          ((EQCAR STR 'APPEND)
+           (if (NOT (IDENTP (SECOND STR))) (ERROR "CANT!"))
+           (PUSH (DEF-IS2 (LIST 'REVERSE (setq G (IS-GENSYM)))
+                          (DEF-IS-REV (THIRD STR) (SECOND STR)))
+                 $IS-EQLIST)
+           (COND ((EQ (SECOND STR) '\.) ''T)
+                 ((PUSH (SUBST (SECOND STR) 'L '(OR (setq L (NREVERSE L)) T))
+
+                        $IS-SPILL_LIST)))
+           G)
+          ((ERRHUH)))))
+
+(defparameter $vl nil)
+
+(defun def-is-remdup (x) (let ($vl) (def-is-remdup1 x)))
+
+(defun def-is-remdup1 (x)
+  (let (rhs lhs g)
+    (COND ((NOT X) NIL)
+          ((EQ X '\.) X)
+          ((IDENTP X)
+           (COND ((MEMBER X $VL)
+                  (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) X) $IS-EQLIST) G)
+                 ((PUSH X $VL) X)))
+          ((MEMBER X '((|Zero|) (|One|))) X)
+          ((ATOM X) X)
+          ((EQCAR X 'SPADLET)
+           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
+           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
+           (LIST 'SPADLET LHS RHS))
+          ((EQCAR X 'LET)
+           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
+           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
+           (LIST 'LET LHS RHS))
+          ((EQCAR X 'QUOTE) X)
+          ((AND (EQCAR X 'EQUAL) (NOT (CDDR X)))
+           (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) (SECOND X)) $IS-EQLIST) G)
+          ((MEMBER (FIRST X) '(LIST APPEND CONS VCONS))
+           (CONS (COND ((EQ (FIRST X) 'VCONS) 'CONS) ( (FIRST X)))
+                 (mapcar #'def-is-remdup1 (cdr x))))
+          ((ERRHUH)))))
+
+(defun LIST2CONS (X)
+"Produces LISP code for constructing a list, involving only CONS."
+ (LIST2CONS-1 (CDR X)))
+
+(defun LIST2CONS-1 (X)
+  (if (NOT X) NIL (LIST 'CONS (FIRST X) (LIST2CONS-1 (CDR X)))))
+
+(defun DEF-IS-REV (X A)
+  (let (y)
+    (if (EQ (FIRST X) 'CONS)
+        (COND ((NOT (THIRD X)) (LIST 'CONS (SECOND X) A))
+              ((setq Y (DEF-IS-REV (THIRD X) NIL))
+               (setf (THIRD Y) (LIST 'CONS (SECOND X) A))
+               Y))
+        (ERRHUH))))
+
+(defparameter $DEFSTACK nil)
+
+(defun DEF-WHERE (args)
+  (let ((x (car args)) (y (cdr args)) $DEFSTACK)
+    (let ((u (DEF-WHERECLAUSELIST Y)))
+      (mapc #'(lambda (X) (DEF-INNER (FIRST X) NIL
+                              (SUBLIS $OPASSOC (SECOND X))))
+              $DEFSTACK)
+      (MKPROGN (NCONC U (LIST (DEFTRAN X)))))))
+
+(defun DEF-WHERECLAUSELIST (L)
+  (if (NOT (CDR L))
+      (DEF-WHERECLAUSE (DEFTRAN (FIRST L)))
+      (REDUCE #'APPEND
+              (mapcar #'(lambda (u) (def-whereclause (deftran u))) L))))
+
+(defun DEF-WHERECLAUSE (X)
+  (COND ((OR (EQCAR X 'SEQ) (EQCAR X 'PROGN))
+         (reduce #'append (mapcar #'def-whereclause (cdr x))))
+        ((EQCAR X 'DEF) (WHDEF (SECOND X) (FIRST (CDDDDR X))) NIL)
+        ((AND (EQCAR X '|exit|) (EQCAR (SECOND X) 'DEF))
+         (WHDEF (CADADR X) (FIRST (CDDDDR (SECOND X)) )) NIL)
+        ((LIST X))))
+
+(defun WHDEF (X Y)
+  "Returns no value -- side effect is to do a compilation or modify a global."
+  (prog ((XP (if (ATOM X) (LIST X) X)) Op)
+    (COND ((NOT (CDR XP))
+           (RETURN (PUSH (CONS (FIRST XP) Y) $MACROASSOC))))
+    (setq OP (INTERNL (PNAME $OP) "\," (FIRST XP)))
+    (SETQ $OPASSOC (PUSH (CONS (FIRST XP) OP) $OPASSOC))
+    (SETQ $DEFSTACK (CONS (LIST (CONS OP (CDR XP)) Y) $DEFSTACK))
+    NIL))
+
+(defun ERRHUH () (|systemError| "problem with BOOT to LISP translation"))
+
+(mapcar #'(lambda (x) (MAKEPROP (first X) 'SEL\,FUNCTION (second X)))
+        '((|aTree| 0)           (|aMode| 1)
+          (|aValue| 2)          (|aModeSet| 3)
+          (|aGeneral| 4)        (|expr| CAR)
+          (|mode| CADR)         (|env| CADDR)
+          (|mmDC| CAAR)         (|cacheName| CADR)
+          (|cacheType| CADDR)   (|cacheReset| CADDDR)
+          (|cacheCount| CADDDDR)(|mmSignature| CDAR)
+          (|mmTarget| CADAR)    (|mmCondition| CAADR)
+          (|mmImplementation| CADADR)
+          (|streamName| CADR)   (|streamDef| CADDR)
+          (|streamCode| CADDDR) (|opSig| CADR)
+          (|attributes| CADDR)  (|op| CAR)
+          (|opcode| CADR)       (|sig| CDDR)
+          (|source| CDR)        (|target| CAR)
+          (|first| CAR)         (|rest| CDR)))
+
+(defun DEF-ELT (args)
+  (let ((EXPR (car args)) (SEL (cadr args)))
+    (let (Y)
+      (COND ((and (symbolp sel) (setq Y (GET SEL 'SEL\,FUNCTION)))
+             (COND ((INTEGERP Y) (LIST 'ELT EXPR Y))
+                   ((LIST Y EXPR))))
+            ((LIST 'ELT EXPR SEL))))))
+
+(defun DEF-SETELT (args)
+  (let ((VAR (first args)) (SEL (second args)) (EXPR (third args)))
+    (let ((y (and (symbolp sel) (get sel 'sel\,function))))
+      (COND (y (COND ((INTEGERP Y) (LIST 'SETELT VAR Y EXPR))
+                     ((LIST 'RPLAC (LIST Y VAR) EXPR))))
+            ((LIST 'SETELT VAR SEL EXPR))))))
+
+(defun DEF-CATEGORY (L)
+  (let (siglist atlist)
+    (mapcar #'(lambda (x) (if (EQCAR (KADR X) 'Signature)
+                              (PUSH X SIGLIST)
+                              (PUSH X ATLIST)))
+            L)
+    (LIST 'CATEGORY (MKQ (NREVERSE SIGLIST)) (MKQ (NREVERSE ATLIST)))))
+
+
+(defun LIST2STRING (X)
+"Converts a list to a string which looks like a printed list,
+except that elements are separated by commas."
+  (COND ((ATOM X) (STRINGIMAGE X))
+        ((STRCONC "(" (LIST2STRING (FIRST X)) (LIST2STRING1 (CDR X)) ")"))))
+
+(defun LIST2STRING1 (X)
+  (COND
+    ((NOT X) "")
+    ((STRCONC "\," (LIST2STRING (FIRST X)) (LIST2STRING1 (CDR X))))))
+
+(defvar |$new2OldRenameAssoc|
+        '((\QUAD . \.) (\' . QUOTE) (|nil| . NIL) (|append| . APPEND)
+          (|union| . UNION) (|cons| . CONS)))
+
+(defun |new2OldLisp| (x) (|new2OldTran| (|postTransform| x)))
+
+(defun |new2OldTran| (x)
+  (PROG (G10463 a b G10465 G10466 G10467 G10469 d G10470 c)
+        (RETURN
+          (prog nil
+                (if (atom x)
+                    (RETURN (let ((y (ASSOC x |$new2OldRenameAssoc|)))
+                              (if y (cdr y) x))))
+                (if (AND (dcq (g10463 a b . g10465) x)
+                         (null G10465)
+                         (EQ G10463 '|where|)
+                         (dcq (g10466 . g10467) b)
+                         (dcq ((g10469 d . g10470) . c) (reverse g10467))
+                         (null G10470)
+                         (EQ G10469 '|exit|)
+                         (EQ G10466 'SEQ)
+                         (OR (setq c (NREVERSE c)) 'T))
+                    (RETURN
+                      `(|where| ,(|new2OldTran| a) ,@(|new2OldTran| c)
+                                ,(|new2OldTran| d))))
+                (return
+                  (case (car x)
+                      (QUOTE x)
+                      (DEF (|newDef2Def| x))
+                      (IF (|newIf2Cond| x))
+                      (|construct| (|newConstruct| (|new2OldTran| (cdr x))))
+                      (T `(,(|new2OldTran| (CAR x)) .
+                           ,(|new2OldTran| (CDR x))))))))))
+
+(defun |newDef2Def| (DEF-EXPR)
+  (if (not (AND (= (length def-expr) 5) (eq (car def-expr) 'DEF)))
+      (LET_ERROR "(DEF,form,a,b,c)" DEF-EXPR)
+      (let ((form (second def-expr))
+            (a (third def-expr))
+            (b (fourth def-expr))
+            (c (fifth def-expr)))
+        `(DEF ,(|new2OldDefForm|  form) ,(|new2OldTran| a)
+           ,(|new2OldTran| b) ,(|new2OldTran| c)))))
+
+(defun |new2OldDefForm| (x)
+  (cond ((ATOM x) (|new2OldTran| x))
+        ((and (listp x)
+              (listp (car x))
+              (eq (caar x) '|is|)
+              (= (length (car x)) 3))
+         (let ((a (second (car x))) (b (third (car x))) (y (cdr x)))
+              (|new2OldDefForm| `((SPADLET ,a ,b) ,@y))))
+        ((CONS (|new2OldTran| (CAR x)) (|new2OldDefForm| (CDR x))))))
+
+(defun |newIf2Cond| (COND-EXPR)
+       (if (not (AND (= (length cond-expr) 4) (EQ (car cond-expr) 'IF)))
+           (LET_ERROR "(IF,a,b,c)" COND-EXPR))
+       (let ((a (second COND-EXPR))
+             (b (third COND-EXPR))
+             (c (fourth COND-EXPR)))
+         (setq a (|new2OldTran| a) b (|new2OldTran| b) c (|new2OldTran| c))
+         (cond ((EQ c '|noBranch|) `(if ,a ,b))
+               (t  `(if ,a ,b ,c)))))
+
+(defun |newConstruct| (l)
+  (if (ATOM l) l
+      `(CONS  ,(CAR l) ,(|newConstruct| (CDR l)))))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot.pamphlet
new file mode 100644
index 00000000..899fbe40
--- /dev/null
+++ b/src/interp/define.boot.pamphlet
@@ -0,0 +1,1535 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/define.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{compCapsuleItems}
+
+The variable [[data]] appears to be unbound at runtime. Optimized
+code won't check for this but interpreted code fails. We should
+PROVE that data is unbound at runtime but have not done so yet.
+Rather than remove the code entirely (since there MIGHT be a 
+path where it is used) we check for the runtime bound case and
+assign [[$myFunctorBody]] if data has a value.
+
+The [[compCapsuleInner]] function in this file LOOKS like it sets
+data and expects code to manipulate the assigned data structure.
+Since we can't be sure we take the least disruptive course of action.
+<<compCapsuleItems>>=
+compCapsuleItems(itemlist,$predl,$e) ==
+  $TOP__LEVEL: local
+  $myFunctorBody :local         -- := data    ---needed for translator
+  if (BOUNDP 'data) then $myFunctorBody:=data -- unbound at runtime?
+  $signatureOfForm: local
+  $suffix: local:= 0
+  for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e)
+  $e
+ 
+@ 
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% FUNCTIONS WHICH MUNCH ON == STATEMENTS
+ 
+compDefine(form,m,e) ==
+  $tripleCache: local:= nil
+  $tripleHits: local:= 0
+  $macroIfTrue: local
+  $packagesUsed: local
+  result:= compDefine1(form,m,e)
+  result
+ 
+compDefine1(form,m,e) ==
+  $insideExpressionIfTrue: local:= false
+  --1. decompose after macro-expanding form
+  ['DEF,lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
+  $insideWhereIfTrue and isMacro(form,e) and (m=$EmptyMode or m=$NoValueMode)
+     => [lhs,m,put(first lhs,'macro,rhs,e)]
+  null signature.target and not MEMQ(KAR rhs,$ConstructorNames) and
+    (sig:= getSignatureFromMode(lhs,e)) =>
+  -- here signature of lhs is determined by a previous declaration
+      compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e)
+  if signature.target=$Category then $insideCategoryIfTrue:= true
+--?? following 3 lines seem bogus, BMT 6/23/93
+--?  if signature.target is ['Mapping,:map] then
+--?    signature:= map
+--?    form:= ['DEF,lhs,signature,specialCases,rhs]
+ 
+-- RDJ (11/83): when argument and return types are all declared,
+--  or arguments have types declared in the environment,
+--  and there is no existing modemap for this signature, add
+--  the modemap by a declaration, then strip off declarations and recurse
+  e := compDefineAddSignature(lhs,signature,e)
+-- 2. if signature list for arguments is not empty, replace ('DEF,..) by
+--       ('where,('DEF,..),..) with an empty signature list;
+--     otherwise, fill in all NILs in the signature
+  not (and/[null x for x in rest signature]) => compDefWhereClause(form,m,e)
+  signature.target=$Category =>
+    compDefineCategory(form,m,e,nil,$formalArgList)
+  isDomainForm(rhs,e) and not $insideFunctorIfTrue =>
+    if null signature.target then signature:=
+      [getTargetFromRhs(lhs,rhs,giveFormalParametersValues(rest lhs,e)),:
+          rest signature]
+    rhs:= addEmptyCapsuleIfNecessary(signature.target,rhs)
+    compDefineFunctor(['DEF,lhs,signature,specialCases,rhs],m,e,nil,
+      $formalArgList)
+  null $form => stackAndThrow ['"bad == form ",form]
+  newPrefix:=
+    $prefix => INTERN STRCONC(encodeItem $prefix,'",",encodeItem $op)
+    getAbbreviation($op,#rest $form)
+  compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList)
+ 
+compDefineAddSignature([op,:argl],signature,e) ==
+  (sig:= hasFullSignature(argl,signature,e)) and
+   not ASSOC(['$,:sig],LASSOC('modemap,getProplist(op,e))) =>
+     declForm:=
+       [":",[op,:[[":",x,m] for x in argl for m in rest sig]],first signature]
+     [.,.,e]:= comp(declForm,$EmptyMode,e)
+     e
+  e
+ 
+hasFullSignature(argl,[target,:ml],e) ==
+  target =>
+    u:= [m or get(x,"mode",e) or return 'failed for x in argl for m in ml]
+    u^='failed => [target,:u]
+ 
+addEmptyCapsuleIfNecessary(target,rhs) ==
+  MEMQ(KAR rhs,$SpecialDomainNames) => rhs
+  ['add,rhs,['CAPSULE]]
+ 
+getTargetFromRhs(lhs,rhs,e) ==
+  --undeclared target mode obtained from rhs expression
+  rhs is ['CAPSULE,:.] =>
+    stackSemanticError(['"target category of ",lhs,
+      '" cannot be determined from definition"],nil)
+  rhs is ['SubDomain,D,:.] => getTargetFromRhs(lhs,D,e)
+  rhs is ['add,D,['CAPSULE,:.]] => getTargetFromRhs(lhs,D,e)
+  rhs is ['Record,:l] => ['RecordCategory,:l]
+  rhs is ['Union,:l] => ['UnionCategory,:l]
+  rhs is ['List,:l] => ['ListCategory,:l]
+  rhs is ['Vector,:l] => ['VectorCategory,:l]
+  [.,target,.]:= compOrCroak(rhs,$EmptyMode,e)
+  target
+ 
+giveFormalParametersValues(argl,e) ==
+  for x in argl repeat
+    e:= put(x,'value,[genSomeVariable(),get(x,'mode,e),nil],e)
+  e
+ 
+macroExpandInPlace(x,e) ==
+  y:= macroExpand(x,e)
+  atom x or atom y => y
+  RPLACA(x,first y)
+  RPLACD(x,rest y)
+  x
+ 
+macroExpand(x,e) ==   --not worked out yet
+  atom x => (u:= get(x,'macro,e) => macroExpand(u,e); x)
+  x is ['DEF,lhs,sig,spCases,rhs] =>
+    ['DEF,macroExpand(lhs,e),macroExpandList(sig,e),macroExpandList(spCases,e),
+      macroExpand(rhs,e)]
+  macroExpandList(x,e)
+ 
+macroExpandList(l,e) ==
+  -- macros should override niladic props
+  (l is [name]) and IDENTP name and GETDATABASE(name, 'NILADIC) and
+	(u := get(name, 'macro, e)) => macroExpand(u,e)
+  [macroExpand(x,e) for x in l]
+ 
+compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
+  categoryCapsule :=
+--+
+    body is ['add,cat,capsule] =>
+      body := cat
+      capsule
+    nil
+  [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
+--+ next two lines
+  if categoryCapsule and not $bootStrapMode then [.,.,e] :=
+    $insideCategoryPackageIfTrue: local := true  --see NRTmakeSlot1
+-->
+    $categoryPredicateList: local :=
+        makeCategoryPredicates(form,$lisplibCategory)
+    compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
+  [d,m,e]
+ 
+makeCategoryPredicates(form,u) ==
+      $tvl := TAKE(#rest form,$TriangleVariableList)
+      $mvl := TAKE(#rest form,rest $FormalMapVariableList)
+      fn(u,nil) where
+        fn(u,pl) ==
+          u is ['Join,:.,a] => fn(a,pl)
+          u is ['has,:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl)
+          u is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE)) => pl
+          atom u => pl
+          fnl(u,pl)
+        fnl(u,pl) ==
+          for x in u repeat pl := fn(x,pl)
+          pl
+ 
+--+ the following function
+mkCategoryPackage(form is [op,:argl],cat,def) ==
+  packageName:= INTERN(STRCONC(PNAME op,'"&"))
+  packageAbb := INTERN(STRCONC(GETDATABASE(op,'ABBREVIATION),'"-"))
+  $options:local := []
+  -- This stops the next line from becoming confused
+  abbreviationsSpad2Cmd ['domain,packageAbb,packageName]
+  -- This is a little odd, but the parser insists on calling
+  -- domains, rather than packages
+  nameForDollar := first SETDIFFERENCE('(S A B C D E F G H I),argl)
+  packageArgl := [nameForDollar,:argl]
+  capsuleDefAlist := fn(def,nil) where fn(x,oplist) ==
+    atom x => oplist
+    x is ['DEF,y,:.] => [y,:oplist]
+    fn(rest x,fn(first x,oplist))
+  explicitCatPart := gn cat where gn cat ==
+    cat is ['CATEGORY,:.] => rest rest cat
+    cat is ['Join,:u] => gn last u
+    nil
+  catvec := eval mkEvalableCategoryForm form
+  fullCatOpList:=JoinInner([catvec],$e).1
+  catOpList :=
+    --note: this gets too many modemaps in general
+    --   this is cut down in NRTmakeSlot1
+    [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList
+         --above line calls the category constructor just compiled
+        | ASSOC(op1,capsuleDefAlist)]
+  null catOpList => nil
+  packageCategory := ['CATEGORY,'domain,
+                     :SUBLISLIS(argl,$FormalMapVariableList,catOpList)]
+  nils:= [nil for x in argl]
+  packageSig := [packageCategory,form,:nils]
+  $categoryPredicateList := SUBST(nameForDollar,'$,$categoryPredicateList)
+  SUBST(nameForDollar,'$,
+      ['DEF,[packageName,:packageArgl],packageSig,[nil,:nils],def])
+ 
+compDefineCategory2(form,signature,specialCases,body,m,e,
+  $prefix,$formalArgList) ==
+    --1. bind global variables
+    $insideCategoryIfTrue: local:= true
+    $TOP__LEVEL: local
+    $definition: local
+                 --used by DomainSubstitutionFunction
+    $form: local
+    $op: local
+    $extraParms: local
+             --Set in DomainSubstitutionFunction, used further down
+--  1.1  augment e to add declaration $: <form>
+    [$op,:argl]:= $definition:= form
+    e:= addBinding("$",[['mode,:$definition]],e)
+ 
+--  2. obtain signature
+    signature':=
+      [first signature,:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
+    e:= giveFormalParametersValues(argl,e)
+ 
+--   3. replace arguments by $1,..., substitute into body,
+--     and introduce declarations into environment
+    sargl:= TAKE(# argl, $TriangleVariableList)
+    $functorForm:= $form:= [$op,:sargl]
+    $formalArgList:= [:sargl,:$formalArgList]
+    aList:= [[a,:sa] for a in argl for sa in sargl]
+    formalBody:= SUBLIS(aList,body)
+    signature' := SUBLIS(aList,signature')
+--Begin lines for category default definitions
+    $functionStats: local:= [0,0]
+    $functorStats: local:= [0,0]
+    $frontier: local := 0
+    $getDomainCode: local := nil
+    $addForm: local:= nil
+    for x in sargl for t in rest signature' repeat
+      [.,.,e]:= compMakeDeclaration([":",x,t],m,e)
+ 
+--   4. compile body in environment of %type declarations for arguments
+    op':= $op
+    -- following line causes cats with no with or Join to be fresh copies
+    if opOf(formalBody)^='Join and opOf(formalBody)^='mkCategory then
+           formalBody := ['Join, formalBody]
+    body:= optFunctorBody (compOrCroak(formalBody,signature'.target,e)).expr
+    if $extraParms then
+      formals:=actuals:=nil
+      for u in $extraParms repeat
+        formals:=[CAR u,:formals]
+        actuals:=[MKQ CDR u,:actuals]
+      body := ['sublisV,['PAIR,['QUOTE,formals],['LIST,:actuals]],body]
+    if argl then body:=  -- always subst for args after extraparms
+        ['sublisV,['PAIR,['QUOTE,sargl],['LIST,:
+          [['devaluate,u] for u in sargl]]],body]
+    body:=
+      ['PROG1,['LET,g:= GENSYM(),body],['SETELT,g,0,mkConstructor $form]]
+    fun:= compile [op',['LAM,sargl,body]]
+ 
+--  5. give operator a 'modemap property
+    pairlis:= [[a,:v] for a in argl for v in $FormalMapVariableList]
+    parSignature:= SUBLIS(pairlis,signature')
+    parForm:= SUBLIS(pairlis,form)
+    lisplibWrite('"compilerInfo",
+      removeZeroOne ['SETQ,'$CategoryFrame,
+       ['put,['QUOTE,op'],'
+        (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
+          MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
+    --Equivalent to the following two lines, we hope
+    if null sargl then
+      evalAndRwriteLispForm('NILADIC,
+            ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
+ 
+--   6. put modemaps into InteractiveModemapFrame
+    $domainShell := eval [op',:MAPCAR('MKQ,sargl)]
+    $lisplibCategory:= formalBody
+    if $LISPLIB then
+      $lisplibForm:= form
+      $lisplibKind:= 'category
+      modemap:= [[parForm,:parSignature],[true,op']]
+      $lisplibModemap:= modemap
+      $lisplibParents  :=         
+        getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
+      $lisplibAncestors := computeAncestorsOf($form,nil)
+      $lisplibAbbreviation := constructor? $op
+      form':=[op',:sargl]
+      augLisplibModemapsFromCategory(form',formalBody,signature')
+    [fun,'(Category),e]
+ 
+mkConstructor form ==
+  atom form => ['devaluate,form]
+  null rest form => ['QUOTE,[first form]]
+  ['LIST,MKQ first form,:[mkConstructor x for x in rest form]]
+ 
+compDefineCategory(df,m,e,prefix,fal) ==
+  $domainShell: local -- holds the category of the object being compiled
+  $lisplibCategory: local
+  not $insideFunctorIfTrue and $LISPLIB =>
+    compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
+  compDefineCategory1(df,m,e,prefix,fal)
+ 
+compDefineFunctor(df,m,e,prefix,fal) ==
+  $domainShell: local -- holds the category of the object being compiled
+  $profileCompiler: local := true
+  $profileAlist:    local := nil
+  $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
+  compDefineFunctor1(df,m,e,prefix,fal)
+ 
+compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
+  m,$e,$prefix,$formalArgList) ==
+    if NRTPARSE = true then
+      [lineNumber,:$functorSpecialCases] := $functorSpecialCases
+--  1. bind global variables
+    $addForm: local
+    $viewNames: local:= nil
+ 
+            --This list is only used in genDomainViewName, for generating names
+            --for alternate views, if they do not already exist.
+            --format: Alist: (domain name . sublist)
+            --sublist is alist: category . name of view
+    $functionStats: local:= [0,0]
+    $functorStats: local:= [0,0]
+    $form: local
+    $op: local
+    $signature: local
+    $functorTarget: local
+    $Representation: local
+         --Set in doIt, accessed in the compiler - compNoStacking
+    $LocalDomainAlist: local  --set in doIt, accessed in genDeltaEntry
+    $LocalDomainAlist:= nil
+    $functorForm: local
+    $functorLocalParameters: local
+    SETQ($myFunctorBody, body)
+    $CheckVectorList: local
+                  --prevents CheckVector from printing out same message twice
+    $getDomainCode: local -- code for getting views
+    $insideFunctorIfTrue: local:= true
+    $functorsUsed: local --not currently used, finds dependent functors
+    $setelt: local :=
+      $QuickCode = true => 'QSETREFV
+      'SETELT
+    $TOP__LEVEL: local
+    $genFVar: local:= 0
+    $genSDVar: local:= 0
+    originale:= $e
+    [$op,:argl]:= form
+    $formalArgList:= [:argl,:$formalArgList]
+    $pairlis := [[a,:v] for a in argl for v in $FormalMapVariableList]
+    $mutableDomain: local :=
+      -- all defaulting packages should have caching turned off
+       isCategoryPackageName $op or   
+         (if BOUNDP '$mutableDomains then MEMQ($op,$mutableDomains)
+            else false )   --true if domain has mutable state
+    signature':=
+      [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]]
+    $functorForm:= $form:= [$op,:argl]
+    if null first signature' then signature':=
+      modemap2Signature getModemap($form,$e)
+    target:= first signature'
+    $functorTarget:= target
+    $e:= giveFormalParametersValues(argl,$e)
+    [ds,.,$e]:= compMakeCategoryObject(target,$e) or
+--+ copy needed since slot1 is reset; compMake.. can return a cached vector
+      sayBrightly '"   cannot produce category object:"
+      pp target
+      return nil
+    $domainShell:= COPY_-SEQ ds
+    $attributesName:local := INTERN STRCONC(PNAME $op,'";attributes")
+    attributeList := disallowNilAttribute ds.2 --see below under "loadTimeAlist"
+--+ 7 lines for $NRT follow
+    $goGetList: local := nil
+-->--these globals used by NRTmakeCategoryAlist, set by NRTsetVector4Part1
+    $condAlist: local := nil
+    $uncondAlist: local := nil
+-->>-- next global initialized here, reset by NRTbuildFunctor
+    $NRTslot1PredicateList: local :=
+      REMDUP [CADR x for x in attributeList]
+-->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT)
+    $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList
+    $NRTslot1Info: local  --set in NRTmakeSlot1 called by NRTbuildFunctor
+       --this is used below to set $lisplibSlot1 global
+    $NRTbase: local := 6 -- equals length of $domainShell
+    $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
+    $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
+    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
+    $NRTaddList: local := nil --list of fncts not defined in capsule (added)
+    $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
+    $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
+    $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
+    -- the above optimizes the calls to local domains
+    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
+    $functionLocations: local := nil --locations of defined functions in source
+    -- generate slots for arguments first, then for $NRTaddForm in compAdd
+    for x in argl repeat NRTgetLocalIndex x
+    [.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e)
+    --The following loop sees if we can economise on ADDed operations
+    --by using those of Rep, if that is the same. Example: DIRPROD
+    if $insideCategoryPackageIfTrue^= true  then
+      if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector))
+         and FindRep(cb) = ab
+               where FindRep cb ==
+                 u:=
+                   while cb repeat
+                     ATOM cb => return nil
+                     cb is [['LET,'Rep,v,:.],:.] => return (u:=v)
+                     cb:=CDR cb
+                 u
+      then $e:= augModemapsFromCategoryRep('_$,ab,cb,target,$e)
+      else $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e)
+    $signature:= signature'
+    operationAlist:= SUBLIS($pairlis,$domainShell.(1))
+    parSignature:= SUBLIS($pairlis,signature')
+    parForm:= SUBLIS($pairlis,form)
+ 
+--  (3.1) now make a list of the functor's local parameters; for
+--  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
+--  in this case, D is replaced by D1,..,Dn (gensyms) which are set
+--  to the A1,..,An view of D
+    if isPackageFunction() then $functorLocalParameters:=
+      [nil,:
+        [nil
+          for i in 6..MAXINDEX $domainShell |
+            $domainShell.i is [.,.,['ELT,'_$,.]]]]
+    --leave space for vector ops and package name to be stored
+--+
+    $functorLocalParameters:=
+      argPars :=
+        makeFunctorArgumentParameters(argl,rest signature',first signature')
+ -- must do above to bring categories into scope --see line 5 of genDomainView
+      argl
+--  4. compile body in environment of %type declarations for arguments
+    op':= $op
+    rettype:= signature'.target
+    T:= compFunctorBody(body,rettype,$e,parForm)
+    -- If only compiling certain items, then ignore the body shell.
+    $compileOnlyCertainItems =>
+       reportOnFunctorCompilation()
+       [nil, ['Mapping, :signature'], originale]
+ 
+    body':= T.expr
+    lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM
+    fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']])
+    --The above statement stops substitutions gettting in one another's way
+--+
+    operationAlist := SUBLIS($pairlis,$lisplibOperationAlist)
+    if $LISPLIB then
+      augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
+    reportOnFunctorCompilation()
+ 
+--  5. give operator a 'modemap property
+--   if $functorsUsed then MAKEPROP(op',"NEEDS",$functorsUsed)
+    if $LISPLIB then
+      modemap:= [[parForm,:parSignature],[true,op']]
+      $lisplibModemap:= modemap
+      $lisplibCategory := modemap.mmTarget
+      $lisplibParents  :=         
+        getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
+      $lisplibAncestors := computeAncestorsOf($form,nil)
+      $lisplibAbbreviation := constructor? $op
+    $insideFunctorIfTrue:= false
+    if $LISPLIB then
+      $lisplibKind:=
+------->This next line prohibits changing the KIND once given
+--------kk:=GETDATABASE($op,'CONSTRUCTORKIND) => kk
+        $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package
+        'domain
+      $lisplibForm:= form
+      if null $bootStrapMode then
+        $NRTslot1Info := NRTmakeSlot1Info()
+        $isOpPackageName: local := isCategoryPackageName $op
+        if $isOpPackageName then lisplibWrite('"slot1DataBase",
+          ['updateSlot1DataBase,MKQ $NRTslot1Info],$libFile)
+        $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations)
+        $lisplibCategoriesExtended := SUBLIS($pairlis,$lisplibCategoriesExtended)
+        -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended
+        libFn := GETDATABASE(op','ABBREVIATION)
+        $lookupFunction: local :=
+            NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm)
+            --either lookupComplete (for forgetful guys) or lookupIncomplete
+        $byteAddress :local := 0
+        $byteVec :local := nil
+        $NRTslot1PredicateList :=
+          [simpBool x for x in $NRTslot1PredicateList]
+        rwriteLispForm('loadTimeStuff,
+          ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
+      $lisplibSlot1 := $NRTslot1Info --NIL or set by $NRTmakeSlot1
+      $lisplibOperationAlist:= operationAlist
+      $lisplibMissingFunctions:= $CheckVectorList
+    lisplibWrite('"compilerInfo",
+       removeZeroOne ['SETQ,'$CategoryFrame,
+        ['put,['QUOTE,op'],'
+         (QUOTE isFunctor),
+          ['QUOTE,operationAlist],['addModemap,['QUOTE,op'],['
+           QUOTE,parForm],['QUOTE,parSignature],true,['QUOTE,op'],
+            ['put,['QUOTE,op' ],'(QUOTE mode),
+             ['QUOTE,['Mapping,:parSignature]],'$CategoryFrame]]]], $libFile)
+    if null argl then
+      evalAndRwriteLispForm('NILADIC,
+            ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'NILADIC], true])
+    [fun,['Mapping,:signature'],originale]
+ 
+disallowNilAttribute x == 
+  res := [y for y in x | car y and car y ^= "nil"]
+--HACK to get rid of nil attibutes ---NOTE: nil is RENAMED to NIL
+
+compFunctorBody(body,m,e,parForm) ==
+  $bootStrapMode = true =>
+    [bootStrapError($functorForm, _/EDITFILE),m,e]
+  T:= compOrCroak(body,m,e)
+  body is [op,:.] and MEMQ(op,'(add CAPSULE)) => T
+  $NRTaddForm :=
+    body is ["SubDomain",domainForm,predicate] => domainForm
+    body
+  T
+ 
+reportOnFunctorCompilation() ==
+  displayMissingFunctions()
+  if $semanticErrorStack then sayBrightly '" "
+  displaySemanticErrors()
+  if $warningStack then sayBrightly '" "
+  displayWarnings()
+  $functorStats:= addStats($functorStats,$functionStats)
+  [byteCount,elapsedSeconds] := $functorStats
+  sayBrightly ['%l,:bright '"  Cumulative Statistics for Constructor",
+    $op]
+  timeString := normalizeStatAndStringify elapsedSeconds
+  sayBrightly ['"      Time:",:bright timeString,'"seconds"]
+  sayBrightly '" "
+  'done
+ 
+displayMissingFunctions() ==
+  null $CheckVectorList => nil
+  loc := nil
+  exp := nil
+  for [[op,sig,:.],:pred] in $CheckVectorList  | null pred repeat
+    null member(op,$formalArgList) and
+      getmode(op,$env) is ['Mapping,:.] =>
+        loc := [[op,sig],:loc]
+    exp := [[op,sig],:exp]
+  if loc then
+    sayBrightly ['%l,:bright '"  Missing Local Functions:"]
+    for [op,sig] in loc for i in 1.. repeat
+      sayBrightly ['"      [",i,'"]",:bright op,
+        ": ",:formatUnabbreviatedSig sig]
+  if exp then
+    sayBrightly ['%l,:bright '"  Missing Exported Functions:"]
+    for [op,sig] in exp for i in 1.. repeat
+      sayBrightly ['"      [",i,'"]",:bright op,
+        ": ",:formatUnabbreviatedSig sig]
+ 
+--% domain view code
+ 
+makeFunctorArgumentParameters(argl,sigl,target) ==
+  $alternateViewList: local:= nil
+  $forceAdd: local:= true
+  $ConditionalOperators: local
+  ("append"/[fn(a,augmentSig(s,findExtras(a,target)))
+              for a in argl for s in sigl]) where
+    findExtras(a,target) ==
+      --  see if conditional information implies anything else
+      --  in the signature of a
+      target is ['Join,:l] => "union"/[findExtras(a,x) for x in l]
+      target is ['CATEGORY,.,:l] => "union"/[findExtras1(a,x) for x in l] where
+        findExtras1(a,x) ==
+          x is ['AND,:l] => "union"/[findExtras1(a,y) for y in l]
+          x is ['OR,:l] => "union"/[findExtras1(a,y) for y in l]
+          x is ['IF,c,p,q] =>
+            union(findExtrasP(a,c),
+                  union(findExtras1(a,p),findExtras1(a,q))) where
+              findExtrasP(a,x) ==
+                x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
+                x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
+                x is ['has,=a,y] and y is ['SIGNATURE,:.] => [y]
+                nil
+        nil
+    augmentSig(s,ss) ==
+       -- if we find something extra, add it to the signature
+      null ss => s
+      for u in ss repeat
+        $ConditionalOperators:=[CDR u,:$ConditionalOperators]
+      s is ['Join,:sl] =>
+        u:=ASSQ('CATEGORY,ss) =>
+          SUBST([:u,:ss],u,s)
+        ['Join,:sl,['CATEGORY,'package,:ss]]
+      ['Join,s,['CATEGORY,'package,:ss]]
+    fn(a,s) ==
+      isCategoryForm(s,$CategoryFrame) =>
+        s is ["Join",:catlist] => genDomainViewList0(a,rest s)
+        [genDomainView(a,a,s,"getDomainView")]
+      [a]
+ 
+genDomainViewList0(id,catlist) ==
+  l:= genDomainViewList(id,catlist,true)
+  l
+ 
+genDomainViewList(id,catlist,firsttime) ==
+  null catlist => nil
+  catlist is [y] and not isCategoryForm(y,$EmptyEnvironment) => nil
+  [genDomainView(if firsttime then id else genDomainViewName(id,first catlist),
+    id,first catlist,"getDomainView"),:genDomainViewList(id,rest catlist,nil)]
+ 
+genDomainView(viewName,originalName,c,viewSelector) ==
+  c is ['CATEGORY,.,:l] => genDomainOps(viewName,originalName,c)
+  code:=
+    c is ['SubsetCategory,c',.] => c'
+    c
+  $e:= augModemapsFromCategory(originalName,viewName,nil,c,$e)
+  --$alternateViewList:= ((viewName,:code),:$alternateViewList)
+  cd:= ['LET,viewName,[viewSelector,originalName,mkDomainConstructor code]]
+  if null member(cd,$getDomainCode) then
+          $getDomainCode:= [cd,:$getDomainCode]
+  viewName
+ 
+genDomainOps(viewName,dom,cat) ==
+  oplist:= getOperationAlist(dom,dom,cat)
+  siglist:= [sig for [sig,:.] in oplist]
+  oplist:= substNames(dom,viewName,dom,oplist)
+  cd:=
+    ['LET,viewName,['mkOpVec,dom,['LIST,:
+      [['LIST,MKQ op,['LIST,:[mkDomainConstructor mode for mode in sig]]]
+        for [op,sig] in siglist]]]]
+  $getDomainCode:= [cd,:$getDomainCode]
+  for [opsig,cond,:.] in oplist for i in 0.. repeat
+    if opsig in $ConditionalOperators then cond:=nil
+    [op,sig]:=opsig
+    $e:= addModemap(op,dom,sig,cond,['ELT,viewName,i],$e)
+  viewName
+ 
+mkOpVec(dom,siglist) ==
+  dom:= getPrincipalView dom
+  substargs:= [['$,:dom.0],:
+    [[a,:x] for a in $FormalMapVariableList for x in rest dom.0]]
+  oplist:= getOperationAlistFromLisplib opOf dom.0
+  --new form is (<op> <signature> <slotNumber> <condition> <kind>)
+  ops:= MAKE_-VEC (#siglist)
+  for (opSig:= [op,sig]) in siglist for i in 0.. repeat
+    u:= ASSQ(op,oplist)
+    ASSOC(sig,u) is [.,n,.,'ELT] => ops.i := dom.n
+    noplist:= SUBLIS(substargs,u)
+ -- following variation on ASSOC needed for GENSYMS in Mutable domains
+    AssocBarGensym(SUBST(dom.0,'$,sig),noplist) is [.,n,.,'ELT] =>
+                   ops.i := dom.n
+    ops.i := [Undef,[dom.0,i],:opSig]
+  ops
+ 
+genDomainViewName(a,category) ==
+--+
+  a
+ 
+compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
+-- form is lhs (f a1 ... an) of definition; body is rhs;
+-- signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
+-- specialCases is (NIL l1 ... ln) where li is list of special cases
+-- which can be given for each ti
+ 
+-- removes declarative and assignment information from form and
+-- signature, placing it in list L, replacing form by ("where",form',:L),
+-- signature by a list of NILs (signifying declarations are in e)
+  $sigAlist: local
+  $predAlist: local
+ 
+-- 1. create sigList= list of all signatures which have embedded
+--    declarations moved into global variable $sigAlist
+  sigList:=
+    [transformType fetchType(a,x,e,form) for a in rest form for x in rest signature]
+       where
+        fetchType(a,x,e,form) ==
+          x => x
+          getmode(a,e) or userError concat(
+            '"There is no mode for argument",a,'"of function",first form)
+        transformType x ==
+          atom x => x
+          x is [":",R,Rtype] =>
+            ($sigAlist:= [[R,:transformType Rtype],:$sigAlist]; x)
+          x is ['Record,:.] => x --RDJ 8/83
+          [first x,:[transformType y for y in rest x]]
+ 
+-- 2. replace each argument of the form (|| x p) by x, recording
+--    the given predicate in global variable $predAlist
+  argList:=
+    [removeSuchthat a for a in rest form] where
+      removeSuchthat x ==
+        x is ["|",y,p] => ($predAlist:= [[y,:p],:$predAlist]; y)
+        x
+ 
+-- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
+--       the type of xi is independent of xj if i < j
+  varList:=
+    orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where
+      argDepAlist:=
+        [[x,:dependencies] for [x,:y] in argSigAlist] where
+          dependencies() ==
+            setUnion(listOfIdentifiersIn y,
+              delete(x,listOfIdentifiersIn LASSOC(x,$predAlist)))
+          argSigAlist:= [:$sigAlist,:pairList(argList,sigList)]
+ 
+-- 4. construct a WhereList which declares and/or defines the xi's in
+--    the order constructed in step 3
+  (whereList:= [addSuchthat(x,[":",x,LASSOC(x,argSigAlist)]) for x in varList])
+     where addSuchthat(x,y) == (p:= LASSOC(x,$predAlist) => ["|",y,p]; y)
+ 
+-- 5. compile new ('DEF,("where",form',:WhereList),:.) where
+--    all argument parameters of form' are bound/declared in WhereList
+  comp(form',m,e) where
+    form':=
+      ["where",defform,:whereList] where
+        defform:=
+          ['DEF,form'',signature',specialCases,body] where
+            form'':= [first form,:argList]
+            signature':= [first signature,:[nil for x in rest signature]]
+ 
+orderByDependency(vl,dl) ==
+  -- vl is list of variables, dl is list of dependency-lists
+  selfDependents:= [v for v in vl for d in dl | MEMQ(v,d)]
+  for v in vl for d in dl | MEMQ(v,d) repeat
+    (SAY(v," depends on itself"); fatalError:= true)
+  fatalError => userError '"Parameter specification error"
+  until (null vl) repeat
+    newl:=
+      [v for v in vl for d in dl | null setIntersection(d,vl)] or return nil
+    orderedVarList:= [:newl,:orderedVarList]
+    vl':= setDifference(vl,newl)
+    dl':= [setDifference(d,newl) for x in vl for d in dl | member(x,vl')]
+    vl:= vl'
+    dl:= dl'
+  REMDUP NREVERSE orderedVarList --ordered so ith is indep. of jth if i < j
+ 
+compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
+  m,oldE,$prefix,$formalArgList) ==
+    [lineNumber,:specialCases] := specialCases
+    e := oldE
+    --1. bind global variables
+    $form: local
+    $op: local
+    $functionStats: local:= [0,0]
+    $argumentConditionList: local
+    $finalEnv: local
+             --used by ReplaceExitEtc to get a common environment
+    $initCapsuleErrorCount: local:= #$semanticErrorStack
+    $insideCapsuleFunctionIfTrue: local:= true
+    $CapsuleModemapFrame: local:= e
+    $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
+    $insideExpressionIfTrue: local:= true
+    $returnMode:= m
+    [$op,:argl]:= form
+    $form:= [$op,:argl]
+    argl:= stripOffArgumentConditions argl
+    $formalArgList:= [:argl,:$formalArgList]
+ 
+    --let target and local signatures help determine modes of arguments
+    argModeList:=
+      identSig:= hasSigInTargetCategory(argl,form,first signature,e) =>
+        (e:= checkAndDeclare(argl,form,identSig,e); rest identSig)
+      [getArgumentModeOrMoan(a,form,e) for a in argl]
+    argModeList:= stripOffSubdomainConditions(argModeList,argl)
+    signature':= [first signature,:argModeList]
+    if null identSig then  --make $op a local function
+      oldE := put($op,'mode,['Mapping,:signature'],oldE)
+ 
+    --obtain target type if not given
+    if null first signature' then signature':=
+      identSig => identSig
+      getSignature($op,rest signature',e) or return nil
+    e:= giveFormalParametersValues(argl,e)
+ 
+    $signatureOfForm:= signature' --this global is bound in compCapsuleItems
+    $functionLocations := [[[$op,$signatureOfForm],:lineNumber],
+      :$functionLocations]
+    e:= addDomain(first signature',e)
+    e:= compArgumentConditions e
+ 
+    if $profileCompiler then
+      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
+
+
+    --4. introduce needed domains into extendedEnv
+    for domain in signature' repeat e:= addDomain(domain,e)
+ 
+    --6. compile body in environment with extended environment
+    rettype:= resolve(signature'.target,$returnMode)
+ 
+    localOrExported :=
+      null member($op,$formalArgList) and
+        getmode($op,e) is ['Mapping,:.] => 'local
+      'exported
+ 
+    --6a skip if compiling only certain items but not this one
+    -- could be moved closer to the top
+    formattedSig := formatUnabbreviated ['Mapping,:signature']
+    $compileOnlyCertainItems and _
+      not member($op, $compileOnlyCertainItems) =>
+        sayBrightly ['"   skipping ", localOrExported,:bright $op]
+        [nil,['Mapping,:signature'],oldE]
+    sayBrightly ['"   compiling ",localOrExported,
+      :bright $op,'": ",:formattedSig]
+ 
+    if $newComp = true then
+      wholeBody := ['DEF, form, signature', specialCases, body]
+      T := CATCH('compCapsuleBody, newComp(wholeBody,$NoValueMode,e))
+           or ["",rettype,e]
+      T := [T.expr.2.2, rettype, T.env]
+      if $newCompCompare=true then
+         oldT := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
+              or ["",rettype,e]
+         SAY '"The old compiler generates:"
+         prTriple oldT
+         SAY '"The new compiler generates:"
+         prTriple T
+    else
+      T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
+           or ["",rettype,e]
+--+
+      NRTassignCapsuleFunctionSlot($op,signature')
+      if $newCompCompare=true then
+         SAY '"The old compiler generates:"
+         prTriple T
+--  A THROW to the above CATCH occurs if too many semantic errors occur
+--  see stackSemanticError
+    catchTag:= MKQ GENSYM()
+    fun:=
+      body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
+      body':= addArgumentConditions(body',$op)
+      finalBody:= ["CATCH",catchTag,body']
+      compileCases([$op,["LAM",[:argl,'_$],finalBody]],oldE)
+    $functorStats:= addStats($functorStats,$functionStats)
+ 
+ 
+--  7. give operator a 'value property
+    val:= [fun,signature',e]
+    [fun,['Mapping,:signature'],oldE] -- oldE:= put($op,'value,removeEnv val,e)
+ 
+getSignatureFromMode(form,e) ==
+  getmode(opOf form,e) is ['Mapping,:signature] =>
+    #form^=#signature => stackAndThrow ["Wrong number of arguments: ",form]
+    EQSUBSTLIST(rest form,take(#rest form,$FormalMapVariableList),signature)
+ 
+hasSigInTargetCategory(argl,form,opsig,e) ==
+  mList:= [getArgumentMode(x,e) for x in argl]
+    --each element is a declared mode for the variable or nil if none exists
+  potentialSigList:=
+    REMDUP
+      [sig
+        for [[opName,sig,:.],:.] in $domainShell.(1) |
+          fn(opName,sig,opsig,mList,form)] where
+            fn(opName,sig,opsig,mList,form) ==
+              opName=$op and #sig=#form and (null opsig or opsig=first sig) and
+                (and/[compareMode2Arg(x,m) for x in mList for m in rest sig])
+  c:= #potentialSigList
+  1=c => first potentialSigList
+    --accept only those signatures op right length which match declared modes
+  0=c => (#(sig:= getSignatureFromMode(form,e))=#form => sig; nil)
+  1<c =>
+    sig:= first potentialSigList
+    stackWarning ["signature of lhs not unique:",:bright sig,"chosen"]
+    sig
+  nil --this branch will force all arguments to be declared
+ 
+compareMode2Arg(x,m) == null x or modeEqual(x,m)
+ 
+getArgumentModeOrMoan(x,form,e) ==
+  getArgumentMode(x,e) or
+    stackSemanticError(["argument ",x," of ",form," is not declared"],nil)
+ 
+getArgumentMode(x,e) ==
+  STRINGP x => x
+  m:= get(x,'mode,e) => m
+ 
+checkAndDeclare(argl,form,sig,e) ==
+ 
+-- arguments with declared types must agree with those in sig;
+-- those that don't get declarations put into e
+  for a in argl for m in rest sig repeat
+    m1:= getArgumentMode(a,e) =>
+      ^modeEqual(m1,m) =>
+        stack:= ["   ",:bright a,'"must have type ",m,
+          '" not ",m1,'%l,:stack]
+    e:= put(a,'mode,m,e)
+  if stack then
+    sayBrightly ['"   Parameters of ",:bright first form,
+      '" are of wrong type:",'%l,:stack]
+  e
+ 
+getSignature(op,argModeList,$e) ==
+  1=#
+    (sigl:=
+      REMDUP
+        [sig
+          for [[dc,:sig],[pred,:.]] in (mmList:= get(op,'modemap,$e)) | dc='_$
+            and rest sig=argModeList and knownInfo pred]) => first sigl
+  null sigl =>
+    (u:= getmode(op,$e)) is ['Mapping,:sig] => sig
+    SAY '"************* USER ERROR **********"
+    SAY("available signatures for ",op,": ")
+    if null mmList
+       then SAY "    NONE"
+       else for [[dc,:sig],:.] in mmList repeat printSignature("     ",op,sig)
+    printSignature("NEED ",op,["?",:argModeList])
+    nil
+  for u in sigl repeat
+    for v in sigl | not (u=v) repeat
+      if SourceLevelSubsume(u,v) then sigl:= delete(v,sigl)
+              --before we complain about duplicate signatures, we should
+              --check that we do not have for example, a partial - as
+              --well as a total one.  SourceLevelSubsume (from CATEGORY BOOT)
+              --should do this
+  1=#sigl => first sigl
+  stackSemanticError(["duplicate signatures for ",op,": ",argModeList],nil)
+ 
+--% ARGUMENT CONDITION CODE
+ 
+stripOffArgumentConditions argl ==
+  [f for x in argl for i in 1..] where
+    f() ==
+      x is ["|",arg,condition] =>
+        condition:= SUBST('_#1,arg,condition)
+        -- in case conditions are given in terms of argument names, replace
+        $argumentConditionList:= [[i,arg,condition],:$argumentConditionList]
+        arg
+      x
+ 
+stripOffSubdomainConditions(margl,argl) ==
+  [f for x in margl for arg in argl for i in 1..] where
+    f ==
+      x is ['SubDomain,marg,condition] =>
+        pair:= ASSOC(i,$argumentConditionList) =>
+          (RPLAC(CADR pair,MKPF([condition,CADR pair],'AND)); marg)
+        $argumentConditionList:= [[i,arg,condition],:$argumentConditionList]
+        marg
+      x
+ 
+compArgumentConditions e ==
+  $argumentConditionList:=
+    [f for [n,a,x] in $argumentConditionList] where
+      f ==
+        y:= SUBST(a,'_#1,x)
+        T := [.,.,e]:= compOrCroak(y,$Boolean,e)
+        [n,x,T.expr]
+  e
+ 
+addArgumentConditions($body,$functionName) ==
+  $argumentConditionList =>
+               --$body is only used in this function
+    fn $argumentConditionList where
+      fn clist ==
+        clist is [[n,untypedCondition,typedCondition],:.] =>
+          ['COND,[typedCondition,fn rest clist],
+            [$true,["argumentDataError",n,
+              MKQ untypedCondition,MKQ $functionName]]]
+        null clist => $body
+        systemErrorHere '"addArgumentConditions"
+  $body
+ 
+putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
+  $elt: local := ($QuickCode => 'QREFELT; 'ELT)
+--+
+  NRTputInTail CDDADR def
+  def
+ 
+ 
+canCacheLocalDomain(dom,elt)==
+   dom is [op,'_$,n] and MEMQ(op,'(ELT QREFELT)) => nil
+   domargsglobal(dom) =>
+        $functorLocalParameters:= [:$functorLocalParameters,dom]
+        PUSH([dom,GENVAR(),[elt,$selector,$funcLocLen]],$usedDomList)
+        $selcount:= $selcount+1
+        $funcLocLen:= $funcLocLen+1
+   nil
+  where
+     domargsglobal(dom) ==
+       dom='_$ => true
+       IDENTP dom => MEMQ(dom,$functorLocalParameters)
+       ATOM dom => true
+       and/[domargsglobal(arg) for arg in rest dom]
+ 
+ 
+compileCases(x,$e) == -- $e is referenced in compile
+  $specialCaseKeyList: local
+  not ($insideFunctorIfTrue=true) => compile x
+  specialCaseAssoc:=
+    [y for y in getSpecialCaseAssoc() | not get(first y,"specialCase",$e) and
+          ([R,R']:= y) and isEltArgumentIn(FindNamesFor(R,R'),x)] where
+        FindNamesFor(R,R') ==
+          [R,:
+            [v
+              for ['LET,v,u,:.] in $getDomainCode | CADR u=R and
+                eval substitute(R',R,u)]]
+        isEltArgumentIn(Rlist,x) ==
+          atom x => nil
+          x is ['ELT,R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
+          x is ["QREFELT",R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
+          isEltArgumentIn(Rlist,first x) or isEltArgumentIn(Rlist,rest x)
+  null specialCaseAssoc => compile x
+  listOfDomains:= ASSOCLEFT specialCaseAssoc
+  listOfAllCases:= outerProduct ASSOCRIGHT specialCaseAssoc
+  cl:=
+    [u for l in listOfAllCases] where
+      u() ==
+        $specialCaseKeyList:= [[D,:C] for D in listOfDomains for C in l]
+        [MKPF([["EQUAL",D,C] for D in listOfDomains for C in l],"AND"),
+          compile COPY x]
+  $specialCaseKeyList:= nil
+  ["COND",:cl,[$true,compile x]]
+ 
+getSpecialCaseAssoc() ==
+  [[R,:l] for R in rest $functorForm
+    for l in rest $functorSpecialCases | l]
+ 
+compile u ==
+  [op,lamExpr] := u
+  if $suffix then
+    $suffix:= $suffix+1
+    op':=
+      opexport:=nil
+      opmodes:=
+        [sel
+          for [[DC,:sig],[.,sel]] in get(op,'modemap,$e) |
+            DC='_$ and (opexport:=true) and
+             (and/[modeEqual(x,y) for x in sig for y in $signatureOfForm])]
+      isLocalFunction op =>
+        if opexport then userError ['%b,op,'%d,'" is local and exported"]
+        INTERN STRCONC(encodeItem $prefix,'";",encodeItem op) where
+          isLocalFunction op ==
+            null member(op,$formalArgList) and
+              getmode(op,$e) is ['Mapping,:.]
+      isPackageFunction() and KAR $functorForm^="CategoryDefaults" =>
+        if null opmodes then userError ['"no modemap for ",op]
+        opmodes is [['PAC,.,name]] => name
+        encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix)
+      encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix)
+    u:= [op',lamExpr]
+  -- If just updating certain functions, check for previous existence.
+  -- Deduce old sequence number and use it (items have been skipped).
+  if $LISPLIB and $compileOnlyCertainItems then
+    parts := splitEncodedFunctionName(u.0, ";")
+--  Next line JHD/SMWATT 7/17/86 to deal with inner functions
+    parts='inner => $savableItems:=[u.0,:$savableItems]
+    unew  := nil
+    for [s,t] in $splitUpItemsAlreadyThere repeat
+       if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t
+    null unew =>
+      sayBrightly ['"   Error: Item did not previously exist"]
+      sayBrightly ['"   Item not saved: ", :bright u.0]
+      sayBrightly ['"   What's there is: ", $lisplibItemsAlreadyThere]
+      nil
+    sayBrightly ['"   Renaming ", u.0, '" as ", unew]
+    u := [unew, :rest u]
+    $savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE
+  optimizedBody:= optimizeFunctionDef u
+  stuffToCompile:=
+    if null $insideCapsuleFunctionIfTrue
+       then optimizedBody
+       else putInLocalDomainReferences optimizedBody
+  $doNotCompileJustPrint=true => (PRETTYPRINT stuffToCompile; op')
+  $macroIfTrue => constructMacro stuffToCompile
+  result:= spadCompileOrSetq stuffToCompile
+  functionStats:=[0,elapsedTime()]
+  $functionStats:= addStats($functionStats,functionStats)
+  printStats functionStats
+  result
+ 
+spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
+        --bizarre hack to take account of the existence of "known" functions
+        --good for performance (LISPLLIB size, BPI size, NILSEC)
+  CONTAINED("",body) => sayBrightly ['"  ",:bright nam,'" not compiled"]
+  if vl is [:vl',E] and body is [nam',: =vl'] then
+      LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam']
+      sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
+  else if (ATOM body or and/[ATOM x for x in body])
+         and vl is [:vl',E] and not CONTAINED(E,body) then
+           macform := ['XLAM,vl',body]
+           LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
+           sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
+  $insideCapsuleFunctionIfTrue => first COMP LIST form
+  compileConstructor form
+ 
+compileConstructor form ==
+  u:= compileConstructor1 form
+  clearClams()                  --clear all CLAMmed functions
+  u
+ 
+compileConstructor1 (form:=[fn,[key,vl,:bodyl]]) ==
+-- fn is the name of some category/domain/package constructor;
+-- we will cache all of its values on $ConstructorCache with reference
+-- counts
+  $clamList: local
+  lambdaOrSlam :=
+    GETDATABASE(fn,'CONSTRUCTORKIND) = 'category => 'SPADSLAM
+    $mutableDomain => 'LAMBDA
+    $clamList:=
+      [[fn,"$ConstructorCache",'domainEqualList,'count],:$clamList]
+    'LAMBDA
+  compForm:= LIST [fn,[lambdaOrSlam,vl,:bodyl]]
+  if GETDATABASE(fn,'CONSTRUCTORKIND) = 'category
+      then u:= compAndDefine compForm
+      else u:=COMP compForm
+  clearConstructorCache fn      --clear cache for constructor
+  first u
+ 
+constructMacro (form is [nam,[lam,vl,body]]) ==
+  ^(and/[atom x for x in vl]) =>
+    stackSemanticError(["illegal parameters for macro: ",vl],nil)
+  ["XLAM",vl':= [x for x in vl | IDENTP x],body]
+ 
+listInitialSegment(u,v) ==
+  null u => true
+  null v => nil
+  first u=first v and listInitialSegment(rest u,rest v)
+  --returns true iff u.i=v.i for i in 1..(#u)-1
+ 
+modemap2Signature [[.,:sig],:.] == sig
+ 
+uncons x ==
+  atom x => x
+  x is ["CONS",a,b] => [a,:uncons b]
+ 
+--% CAPSULE
+ 
+bootStrapError(functorForm,sourceFile) ==
+  ['COND, _
+    ['$bootStrapMode, _
+        ['VECTOR,mkDomainConstructor functorForm,nil,nil,nil,nil,nil]],
+    [''T, ['systemError,['LIST,''%b,MKQ CAR functorForm,''%d,'"from", _
+      ''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]]
+ 
+compAdd(['add,$addForm,capsule],m,e) ==
+  $bootStrapMode = true =>
+    if $addForm is ['Tuple,:.] then code := nil
+       else [code,m,e]:= comp($addForm,m,e)
+    [['COND, _
+       ['$bootStrapMode, _
+           code],_
+       [''T, ['systemError,['LIST,''%b,MKQ CAR $functorForm,''%d,'"from", _
+         ''%b,MKQ namestring _/EDITFILE,''%d,'"needs to be compiled"]]]],m,e]
+  $addFormLhs: local:= $addForm
+  if $addForm is ["SubDomain",domainForm,predicate] then
+    $packagesUsed := [domainForm,:$packagesUsed]
+--+
+    $NRTaddForm := domainForm
+    NRTgetLocalIndex domainForm
+    --need to generate slot for add form since all $ go-get
+    --  slots will need to access it
+    [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
+  else
+    $packagesUsed :=
+      $addForm is ['Tuple,:u] => [:u,:$packagesUsed]
+      [$addForm,:$packagesUsed]
+--+
+    $NRTaddForm := $addForm
+    [$addForm,.,e]:=
+      $addForm is ['Tuple,:.] =>
+        $NRTaddForm := ['Tuple,:[NRTgetLocalIndex x for x in rest $addForm]]
+        compOrCroak(compTuple2Record $addForm,$EmptyMode,e)
+      compOrCroak($addForm,$EmptyMode,e)
+  compCapsule(capsule,m,e)
+ 
+compTuple2Record u == ['Record,:[[":",i,x] for i in 1.. for x in rest u]]
+ 
+compCapsule(['CAPSULE,:itemList],m,e) ==
+  $bootStrapMode = true =>
+    [bootStrapError($functorForm, _/EDITFILE),m,e]
+  $insideExpressionIfTrue: local:= false
+  compCapsuleInner(itemList,m,addDomain('_$,e))
+ 
+compSubDomain(["SubDomain",domainForm,predicate],m,e) ==
+  $addFormLhs: local:= domainForm
+  $addForm: local
+  $NRTaddForm := domainForm
+  [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
+--+
+  compCapsule(['CAPSULE],m,e)
+ 
+compSubDomain1(domainForm,predicate,m,e) ==
+  [.,.,e]:=
+    compMakeDeclaration([":","#1",domainForm],$EmptyMode,addDomain(domainForm,e))
+  u:=
+    compOrCroak(predicate,$Boolean,e) or
+      stackSemanticError(["predicate: ",predicate,
+        " cannot be interpreted with #1: ",domainForm],nil)
+  prefixPredicate:= lispize u.expr
+  $lisplibSuperDomain:=
+    [domainForm,predicate]
+  evalAndRwriteLispForm('evalOnLoad2,
+    ['SETQ,'$CategoryFrame,['put,op':= ['QUOTE,$op],'
+     (QUOTE SuperDomain),dF':= ['QUOTE,domainForm],['put,dF','(QUOTE SubDomain),[
+       'CONS,['QUOTE,[$op,:prefixPredicate]],['DELASC,op',['get,dF','
+         (QUOTE SubDomain),'$CategoryFrame]]],'$CategoryFrame]]])
+  [domainForm,m,e]
+ 
+compCapsuleInner(itemList,m,e) ==
+  e:= addInformation(m,e)
+           --puts a new 'special' property of $Information
+  data:= ["PROGN",:itemList]
+      --RPLACd by compCapsuleItems and Friends
+  e:= compCapsuleItems(itemList,nil,e)
+  localParList:= $functorLocalParameters
+  if $addForm then data:= ['add,$addForm,data]
+  code:=
+    $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data
+    processFunctorOrPackage($form,$signature,data,localParList,m,e)
+  [MKPF([:$getDomainCode,code],"PROGN"),m,e]
+ 
+--% PROCESS FUNCTOR CODE
+ 
+processFunctor(form,signature,data,localParList,e) ==
+  form is ["CategoryDefaults"] =>
+    error "CategoryDefaults is a reserved name"
+  buildFunctor(form,signature,data,localParList,e)
+ 
+<<compCapsuleItems>>
+compSingleCapsuleItem(item,$predl,$e) ==
+  doIt(macroExpandInPlace(item,$e),$predl)
+  $e
+ 
+doIt(item,$predl) ==
+  $GENNO: local:= 0
+  item is ['SEQ,:l,['exit,1,x]] =>
+    RPLACA(item,"PROGN")
+    RPLACA(LASTNODE item,x)
+    for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e)
+        --This will RPLAC as appropriate
+  isDomainForm(item,$e) =>
+     -- convert naked top level domains to import
+    u:= ['import, [first item,:rest item]]
+    stackWarning ["Use: import ", [first item,:rest item]]
+    RPLACA(item,first u)
+    RPLACD(item,rest u)
+    doIt(item,$predl)
+  item is ['LET,lhs,rhs,:.] =>
+    not (compOrCroak(item,$EmptyMode,$e) is [code,.,$e]) =>
+      stackSemanticError(["cannot compile assigned value to",:bright lhs],nil)
+    not (code is ['LET,lhs',rhs',:.] and atom lhs') =>
+      code is ["PROGN",:.] =>
+         stackSemanticError(["multiple assignment ",item," not allowed"],nil)
+      RPLACA(item,first code)
+      RPLACD(item,rest code)
+    lhs:= lhs'
+    if not member(KAR rhs,$NonMentionableDomainNames) and
+      not MEMQ(lhs, $functorLocalParameters) then
+         $functorLocalParameters:= [:$functorLocalParameters,lhs]
+    if code is ['LET,.,rhs',:.] and isDomainForm(rhs',$e) then
+      if isFunctor rhs' then
+        $functorsUsed:= insert(opOf rhs',$functorsUsed)
+        $packagesUsed:= insert([opOf rhs'],$packagesUsed)
+      if lhs="Rep" then
+        $Representation:= (get("Rep",'value,$e)).(0)
+           --$Representation bound by compDefineFunctor, used in compNoStacking
+--+
+        if $NRTopt = true
+          then NRTgetLocalIndex $Representation
+--+
+      $LocalDomainAlist:= --see genDeltaEntry
+        [[lhs,:SUBLIS($LocalDomainAlist,get(lhs,'value,$e).0)],:$LocalDomainAlist]
+--+
+    code is ['LET,:.] =>
+      RPLACA(item,($QuickCode => 'QSETREFV;'SETELT))
+      rhsCode:=
+       rhs'
+      RPLACD(item,['$,NRTgetLocalIndexClear lhs,rhsCode])
+    RPLACA(item,first code)
+    RPLACD(item,rest code)
+  item is [":",a,t] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
+  item is ['import,:doms] =>
+     for dom in doms repeat
+       sayBrightly ['"   importing ",:formatUnabbreviated dom]
+     [.,.,$e] := compOrCroak(item,$EmptyMode,$e)
+     RPLACA(item,'PROGN)
+     RPLACD(item,NIL) -- creates a no-op
+  item is ["IF",:.] => doItIf(item,$predl,$e)
+  item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e)
+  item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
+  item is ['DEF,[op,:.],:.] =>
+    body:= isMacro(item,$e) => $e:= put(op,'macro,body,$e)
+    [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e)
+    RPLACA(item,"CodeDefine")
+        --Note that DescendCode, in CodeDefine, is looking for this
+    RPLACD(CADR item,[$signatureOfForm])
+      --This is how the signature is updated for buildFunctor to recognise
+--+
+    functionPart:= ['dispatchFunction,t.expr]
+    RPLACA(CDDR item,functionPart)
+    RPLACD(CDDR item,nil)
+  u:= compOrCroak(item,$EmptyMode,$e) =>
+    ([code,.,$e]:= u; RPLACA(item,first code); RPLACD(item,rest code))
+  true => cannotDo()
+ 
+isMacro(x,e) ==
+  x is ['DEF,[op,:args],signature,specialCases,body] and
+    null get(op,'modemap,e) and null args and null get(op,'mode,e)
+      and signature is [nil] => body
+ 
+doItIf(item is [.,p,x,y],$predl,$e) ==
+  olde:= $e
+  [p',.,$e]:= comp(p,$Boolean,$e) or userError ['"not a Boolean:",p]
+  oldFLP:=$functorLocalParameters
+  if x^="noBranch" then
+    compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e))
+    x':=localExtras(oldFLP)
+          where localExtras(oldFLP) ==
+            EQ(oldFLP,$functorLocalParameters) => NIL
+            flp1:=$functorLocalParameters
+            oldFLP':=oldFLP
+            n:=0
+            while oldFLP' repeat
+              oldFLP':=CDR oldFLP'
+              flp1:=CDR flp1
+              n:=n+1
+            -- Now we have to add code to compile all the elements
+            -- of functorLocalParameters that were added during the
+            -- conditional compilation
+            nils:=ans:=[]
+            for u in flp1 repeat -- is =u form always an ATOM?
+              if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode])
+                then
+                  nils:=[u,:nils]
+                else
+                  gv := GENSYM()
+                  ans:=[['LET,gv,u],:ans]
+                  nils:=[gv,:nils]
+              n:=n+1
+            $functorLocalParameters:=[:oldFLP,:NREVERSE nils]
+            NREVERSE ans
+  oldFLP:=$functorLocalParameters
+  if y^="noBranch" then
+    compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde))
+    y':=localExtras(oldFLP)
+  RPLACA(item,"COND")
+  RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']])
+ 
+--compSingleCapsuleIf(x,predl,e,$functorLocalParameters) ==
+--  compSingleCapsuleItem(x,predl,e)
+ 
+--% CATEGORY AND DOMAIN FUNCTIONS
+compContained(["CONTAINED",a,b],m,e) ==
+  [a,ma,e]:= comp(a,$EmptyMode,e) or return nil
+  [b,mb,e]:= comp(b,$EmptyMode,e) or return nil
+  isCategoryForm(ma,e) and isCategoryForm(mb,e) =>
+    (T:= [["CONTAINED",a,b],$Boolean,e]; convert(T,m))
+  nil
+ 
+compJoin(["Join",:argl],m,e) ==
+  catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl]
+  catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil)
+  catList':=
+    [extract for x in catList] where
+      extract() ==
+        isCategoryForm(x,e) =>
+          parameters:=
+            union("append"/[getParms(y,e) for y in rest x],parameters)
+              where getParms(y,e) ==
+                atom y =>
+                  isDomainForm(y,e) => LIST y
+                  nil
+                y is ['LENGTH,y'] => [y,y']
+                LIST y
+          x
+        x is ["DomainSubstitutionMacro",pl,body] =>
+          (parameters:= union(pl,parameters); body)
+        x is ["mkCategory",:.] => x
+        atom x and getmode(x,e)=$Category => x
+        stackSemanticError(["invalid argument to Join: ",x],nil)
+        x
+  T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
+  convert(T,m)
+ 
+compForMode(x,m,e) ==
+  $compForModeIfTrue: local:= true
+  comp(x,m,e)
+ 
+compMakeCategoryObject(c,$e) ==
+  not isCategoryForm(c,$e) => nil
+  u:= mkEvalableCategoryForm c => [eval u,$Category,$e]
+  nil
+ 
+quotifyCategoryArgument x == MKQ x
+ 
+makeCategoryForm(c,e) ==
+  not isCategoryForm(c,e) => nil
+  [x,m,e]:= compOrCroak(c,$EmptyMode,e)
+  [x,e]
+ 
+compCategory(x,m,e) ==
+  $TOP__LEVEL: local:= true
+  (m:= resolve(m,["Category"]))=["Category"] and x is ['CATEGORY,
+    domainOrPackage,:l] =>
+      $sigList: local
+      $atList: local
+      $sigList:= $atList:= nil
+      for x in l repeat compCategoryItem(x,nil)
+      rep:= mkExplicitCategoryFunction(domainOrPackage,$sigList,$atList)
+    --if inside compDefineCategory, provide for category argument substitution
+      [rep,m,e]
+  systemErrorHere '"compCategory"
+ 
+mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
+  body:=
+    ["mkCategory",MKQ domainOrPackage,['LIST,:REVERSE sigList],['LIST,:
+      REVERSE atList],MKQ domList,nil] where
+        domList() ==
+          ("union"/[fn sig for ["QUOTE",[[.,sig,:.],:.]] in sigList]) where
+            fn sig == [D for D in sig | mustInstantiate D]
+  parameters:=
+    REMDUP
+      ("append"/
+        [[x for x in sig | IDENTP x and x^='_$]
+          for ["QUOTE",[[.,sig,:.],:.]] in sigList])
+  wrapDomainSub(parameters,body)
+ 
+wrapDomainSub(parameters,x) ==
+   ["DomainSubstitutionMacro",parameters,x]
+ 
+mustInstantiate D ==
+  D is [fn,:.] and ^(MEMQ(fn,$DummyFunctorNames) or GETL(fn,"makeFunctionList"))
+ 
+DomainSubstitutionFunction(parameters,body) ==
+  --see definition of DomainSubstitutionMacro in SPAD LISP
+  if parameters then
+    (body:= Subst(parameters,body)) where
+      Subst(parameters,body) ==
+        ATOM body =>
+          MEMQ(body,parameters) => MKQ body
+          body
+        member(body,parameters) =>
+          g:=GENSYM()
+          $extraParms:=PUSH([g,:body],$extraParms)
+           --Used in SetVector12 to generate a substitution list
+           --bound in buildFunctor
+           --For categories, bound and used in compDefineCategory
+          MKQ g
+        first body="QUOTE" => body
+        PAIRP $definition and
+            isFunctor first body and
+              first body ^= first $definition
+          =>  ['QUOTE,optimize body]
+        [Subst(parameters,u) for u in body]
+  not (body is ["Join",:.]) => body
+  atom $definition => body
+  null rest $definition => body
+           --should not bother if it will only be called once
+  name:= INTERN STRCONC(KAR $definition,";CAT")
+  SETANDFILE(name,nil)
+  body:= ["COND",[name],['(QUOTE T),['SETQ,name,body]]]
+  body
+ 
+compCategoryItem(x,predl) ==
+  x is nil => nil
+  --1. if x is a conditional expression, recurse; otherwise, form the predicate
+  x is ["COND",[p,e]] =>
+    predl':= [p,:predl]
+    e is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
+    compCategoryItem(e,predl')
+  x is ["IF",a,b,c] =>
+    predl':= [a,:predl]
+    if b^="noBranch" then
+      b is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
+      compCategoryItem(b,predl')
+    c="noBranch" => nil
+    predl':= [["not",a],:predl]
+    c is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
+    compCategoryItem(c,predl')
+  pred:= (predl => MKPF(predl,"AND"); true)
+ 
+  --2. if attribute, push it and return
+  x is ["ATTRIBUTE",y] => PUSH(MKQ [y,pred],$atList)
+ 
+  --3. it may be a list, with PROGN as the CAR, and some information as the CDR
+  x is ["PROGN",:l] => for u in l repeat compCategoryItem(u,predl)
+ 
+-- 4. otherwise, x gives a signature for a
+--    single operator name or a list of names; if a list of names,
+--    recurse
+  ["SIGNATURE",op,:sig]:= x
+  null atom op =>
+    for y in op repeat compCategoryItem(["SIGNATURE",y,:sig],predl)
+ 
+  --4. branch on a single type or a signature %with source and target
+  PUSH(MKQ [rest x,pred],$sigList)
+ 
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/domain.lisp.pamphlet b/src/interp/domain.lisp.pamphlet
new file mode 100644
index 00000000..775f3526
--- /dev/null
+++ b/src/interp/domain.lisp.pamphlet
@@ -0,0 +1,247 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp domain.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;; lisp support for creating domain stubs
+
+(in-package "BOOT")
+;;(SETQ |$optimizableConstructorNames| nil)
+
+(defstruct domain constructor args
+  (dollar (check-dollar-fields constructor args)))
+
+(defstruct (old-compiler-domain (:include domain) (:conc-name oldom-))
+  (devaluate (if dollar (|devaluate| dollar)
+	       (CONS constructor (MAPCAR #'|devaluate| args))))
+  (vector nil))  
+
+(defun check-dollar-fields (constructor arglist)
+  (if (some #'(lambda (x) (and (domain-p x) (domain-dollar x))) arglist)
+      (apply constructor (mapcar #'(lambda (x) (if (domain-p x)
+						   (or (domain-dollar x) x)
+						 x)) arglist))
+    nil))
+
+(defun |domain?| (x) (domain-p x))
+
+(defun |Mapping| (&rest args)
+  (make-old-compiler-domain :constructor '|Mapping| :args args
+			    :vector '|Mapping0|))
+
+(defun |Record| (&rest args)
+  (make-old-compiler-domain :constructor '|Record| :args args
+			    :vector '|Record0|))
+
+(defun |Union| (&rest args)
+  (make-old-compiler-domain :constructor '|Union| :args args
+			    :vector '|Union0|))
+
+(defun |devaluate| (x &aux tag dom)
+  (cond ((REFVECP x)
+	 (if (> (QVSIZE x) 5)
+	     (cond ((equal (qvelt x 3) '(|Category|))
+		    (qvelt x 0))
+;; next line will become obsolete
+		   ((|isFunctor| (qvelt x 0)) (qvelt x 0))
+		   ((domain-p (qvelt x 0)) (|devaluate| (qvelt x 0)))
+		   (t x))
+	     x))
+	((and (pairp x) (eq (car x) '|:|) (dcq (tag dom) (cdr x)))
+	 (list (car x) tag (|devaluate| dom)))
+; 20030527 note that domain-p does not exist
+	((not (domain-p x)) x)
+; 20030527 note that old-compiler-domain-p does not exist
+	((old-compiler-domain-p x) (oldom-devaluate x))
+	(t (error "devaluate of new compiler domain"))))
+
+(defun |domainEqual| (x y)
+  (cond ((old-compiler-domain-p x)
+	 (if (old-compiler-domain-p y)
+	     (equalp (oldom-devaluate x) (oldom-devaluate y))
+	     nil))
+	((old-compiler-domain-p y) nil)
+	(t (error "no new compiler domains yet"))))
+
+(defun |domainSelectDollar| (dom)
+  (or (domain-dollar dom) dom))
+
+(defun |domainSetDollar| (dom dollar)
+  (setf (domain-dollar dom) dollar)
+  (if (old-compiler-domain-p dom)
+      (setf (oldom-devaluate dom) (|devaluate| dollar))))
+
+(defun |domainSelectVector| (dom)
+  (let ((vec (oldom-vector dom)))
+    (cond ((vectorp vec) vec)
+	  ((null vec) nil)
+	  ((symbolp vec) ;; case for Records and Unions
+	   (setq vec (funcall vec (domain-args dom)))
+	   (setf (elt vec 0) dom)
+	   (setf (oldom-vector dom) vec))
+	  ((or (fboundp (car vec))
+	       (|loadLib| (cdr vec)) t)
+	   (instantiate (car vec) dom)))))
+
+;;(defun instantiate (innername dom) 
+;;  (let ((vec (apply innername (domain-args dom))))
+;;    (setelt vec 0 dom)
+;;    (setf (oldom-vector dom) vec)
+;;    vec))
+
+(defun instantiate (innername dom)
+  (let* ((infovec (get (domain-constructor dom) '|infovec|))
+	 (|$dollarVec| (getrefv (size (car infovec )))))
+    (declare (special |$dollarVec|))
+    (setf (elt |$dollarVec| 0) dom)
+    (setf (elt |$dollarVec| 1)
+	  (list (symbol-function (|getLookupFun| infovec))
+		|$dollarVec|
+		(elt infovec 1)))
+    (setf (elt |$dollarVec| 2) (elt infovec 2))
+    (setf (oldom-vector dom) |$dollarVec|)
+    (apply innername (domain-args dom))
+    |$dollarVec|))
+  
+(defun universal-domain-constructor (&rest args-env)
+  (let* ((args (fix-domain-args (butlast args-env)))
+	 (env (car (last args-env))))
+    (check-constructor-cache env args)))
+
+(defun fix-domain-args (args)
+  (mapcar #'(lambda (x) (if (and (vectorp x) (domain-p (elt x 0)))
+			    (elt x 0) x)) args))
+
+(defun universal-nocache-domain-constructor (&rest args-env)
+  (let* ((args (butlast args-env))
+	 (env (car (last args-env))))
+    (make-old-compiler-domain :constructor (car env)
+			      :args args
+			      :vector (cdr env))))
+
+(defun universal-category-defaults-constructor (&rest args-env)
+  (let* ((args (butlast args-env))
+	 (env (car (last args-env))))
+    (make-old-compiler-domain :constructor (car env)
+			      :args args
+			      :dollar (car args)
+			      :vector (cdr env))))
+
+(defun cached-constructor (cname)
+  (if (or (|isCategoryPackageName| cname)
+	  (and (boundp '|$mutableDomains|)
+	       (memq cname |$mutableDomains|)))
+      nil
+    t))
+
+(defun |makeDomainStub| (con) 
+  (|systemDependentMkAutoload| (|constructor?| con) con))
+
+(defun |mkAutoLoad| (fn cname)
+  (cond ((or (memq cname |$CategoryNames|)
+	  (eq (GETDATABSE cname 'CONSTRUCTORKIND) '|category|))
+	 (function (lambda (&rest args)
+		     (|autoLoad| fn cname)
+		     (apply cname args))))
+	(t (|systemDependentMkAutoload| fn cname)
+	   (symbol-function cname))))
+
+(defun |systemDependentMkAutoload| (fn cname)
+  (let* ((cnameInner (intern (strconc cname ";")))
+	 (env (list* cname cnameInner fn))
+	 (spadfun
+	  (cond ((|isCategoryPackageName| cname)
+		 (cons #'universal-category-defaults-constructor env))
+		((and (boundp '|$mutableDomains|)
+		      (memq cname |$mutableDomains|))
+		 (cons #'universal-nocache-domain-constructor env))
+		(t (cons #'universal-domain-constructor env)))))
+    (setf (symbol-function cname) (mkConstructor spadfun))
+    (set cname spadfun)))
+
+(defun mkConstructor (spadfun)
+   (function (lambda (&rest args)
+	       (apply (car spadfun) (append args (list (cdr spadfun)))))))
+
+(defun |makeAddDomain| (add-domain dollar)
+  (cond ((old-compiler-domain-p add-domain)
+	 (make-old-compiler-domain :constructor (domain-constructor add-domain)
+			    :args (domain-args add-domain)
+			    :dollar dollar
+			    :vector (cddr (eval (domain-constructor add-domain)))))
+	(t (error "no new compiler adds supported yet"))))
+
+(defun check-constructor-cache (env arglist)
+  (let ((dollar (check-dollar-fields (car env) arglist)))
+    (if dollar (make-old-compiler-domain :constructor (car env)
+					 :args arglist
+					 :dollar dollar
+					 :vector (cdr env))
+      (let* ((constructor (car env))
+	     (devargs (mapcar #'|devaluate| arglist))
+	     (cacheddom
+	      (|lassocShiftWithFunction| devargs
+	       (HGET |$ConstructorCache| constructor)
+	       #'|domainEqualList|)))
+	(if cacheddom (|CDRwithIncrement| cacheddom)
+	  (cdr (|haddProp| |$ConstructorCache| constructor devargs
+		(cons 1 (make-old-compiler-domain :constructor constructor
+						  :args arglist
+						  :devaluate
+						  (cons constructor devargs)
+						  :vector (cdr env))))))))))
+
+
+
+
+	  
+	 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/dq.boot.pamphlet b/src/interp/dq.boot.pamphlet
new file mode 100644
index 00000000..1346ecc9
--- /dev/null
+++ b/src/interp/dq.boot.pamphlet
@@ -0,0 +1,100 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp dq.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- Dequeue functions
+ 
+-- dqUnit makes a unit dq i.e. a dq with one item, from the item
+ 
+-- dqUnitCopy copies a unit dq
+ 
+-- dqAppend appends 2 dq's, destroying the first
+ 
+-- dqConcat concatenates a list of dq's, destroying all but the last
+ 
+-- dqToList transforms a dq to a list
+ 
+dqUnit s==(a:=[s];CONS(a,a))
+ 
+dqUnitCopy s== dqUnit(CAAR s)
+ 
+dqAppend(x,y)==
+    if null x
+    then y
+    else if null y
+         then x
+         else
+              RPLACD (CDR x,CAR y)
+              RPLACD (x,    CDR y)
+              x
+ 
+dqConcat ld==
+    if null ld
+    then nil
+    else if null rest ld
+         then first ld
+         else dqAppend(first ld,dqConcat rest ld)
+ 
+dqToList s==if null s then nil else CAR s
+ 
+dqAddAppend(x,y)==
+    if null x
+    then nil
+    else if null y
+         then nil
+         else
+              RPLACD (CDR x,CAR y)
+              RPLACD (x,    CDR y)
+              x
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/fname.lisp.pamphlet b/src/interp/fname.lisp.pamphlet
new file mode 100644
index 00000000..0a6ccc04
--- /dev/null
+++ b/src/interp/fname.lisp.pamphlet
@@ -0,0 +1,122 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp fname.lisp}
+\author{Stephen M. Watt, Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;;
+;; Lisp support for cleaned up FileName domain.
+;;
+;; Created: June 20, 1991 (Stephen Watt)
+;; 
+
+(in-package "BOOT")
+
+;; E.g.  "/"  "/u/smwatt"  "../src"
+(defun |DirToString| (d)
+  (cond
+    ((equal d '(:root)) "/")
+    ((null d) "")
+    ('t (string-right-trim "/" (namestring (make-pathname :directory d)))) ))
+
+(defun |StringToDir| (s)
+  (cond
+    ((string= s "/") '(:root))
+    ((string= s "")  nil)
+    ('t 
+      (let ((lastc (aref s (- (length s) 1))))
+        (if (char= lastc #\/)
+          (pathname-directory (concat s "name.type"))
+          (pathname-directory (concat s "/name.type")) ))) ))
+
+(defun |myWritable?| (s)
+  (if (not (stringp s)) (|error| "``myWritable?'' requires a string arg."))
+  (if (string= s "") (setq s "."))
+  (if (not (|fnameExists?| s)) (setq s (|fnameDirectory| s)))
+  (if (string= s "") (setq s "."))
+  (if (> (|writeablep| s) 0) 't nil) )
+
+(defun |fnameMake| (d n e)
+  (if (string= e "") (setq e nil))
+  (make-pathname :directory (|StringToDir| d) :name  n :type e))
+
+(defun |fnameDirectory| (f)
+  (|DirToString| (pathname-directory f)))
+
+(defun |fnameName| (f)
+  (let ((s (pathname-name f)))
+    (if s s "") ))
+
+(defun |fnameType| (f)
+  (let ((s (pathname-type f)))
+    (if s s "") ))
+ 
+(defun |fnameExists?| (f)
+  (if (probe-file (namestring f)) 't nil))
+
+(defun |fnameReadable?| (f)
+#+:CCL (file-readablep f)
+#-:CCL
+  (let ((s (open f :direction :input :if-does-not-exist nil)))
+    (cond (s (close s) 't) ('t nil)) )
+  )
+
+(defun |fnameWritable?| (f)
+  (|myWritable?| (namestring f)) )
+
+(defun |fnameNew| (d n e)
+  (if (not (|myWritable?| d))
+    nil
+    (do ((fn))
+        (nil)
+        (setq fn (|fnameMake| d (string (gensym n)) e))
+        (if (not (probe-file (namestring fn)))
+           (return-from |fnameNew| fn)) )))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/fnewmeta.lisp.pamphlet b/src/interp/fnewmeta.lisp.pamphlet
new file mode 100644
index 00000000..29c55dd3
--- /dev/null
+++ b/src/interp/fnewmeta.lisp.pamphlet
@@ -0,0 +1,1008 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp fnewmeta.lisp}
+\author{William Burge}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+<<fnew.meta>>=
+%       Scratchpad II Boot Language Grammar, Common Lisp Version
+%       IBM Thomas J. Watson Research Center
+%       Summer, 1986
+%
+%       NOTE: Substantially different from VM/LISP version, due to
+%             different parser and attempt to render more within META proper.
+
+.META(New NewExpr Process)
+.PACKAGE 'BOOT'
+.DECLARE(tmptok TOK ParseMode DEFINITION_NAME LABLASOC)
+.PREFIX 'PARSE-'
+
+NewExpr:        =')' .(processSynonyms) Command
+              / .(SETQ DEFINITION_NAME (CURRENT-SYMBOL)) Statement ;
+
+Command:        ')' SpecialKeyWord SpecialCommand +() ;
+
+SpecialKeyWord: =(MATCH-CURRENT-TOKEN "IDENTIFIER)
+                .(SETF (TOKEN-SYMBOL (CURRENT-TOKEN)) (unAbbreviateKeyword (CURRENT-SYMBOL))) ;
+
+SpecialCommand: 'show' <'?' / Expression>! +(show #1) CommandTail
+              / ?(MEMBER (CURRENT-SYMBOL) \$noParseCommands)
+                 .(FUNCALL (CURRENT-SYMBOL))
+              / ?(MEMBER (CURRENT-SYMBOL) \$tokenCommands) TokenList
+                  TokenCommandTail
+              / PrimaryOrQM* CommandTail ;
+
+TokenList:      (^?(isTokenDelimiter) +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN))* ;
+
+TokenCommandTail:
+                <TokenOption*>! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ;
+
+TokenOption:    ')' TokenList ;
+
+CommandTail:    <Option*>! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ;
+
+PrimaryOrQM:    '?' +\? / Primary ;
+
+Option:         ')' PrimaryOrQM* ;
+
+Statement:      Expr{0} <(',' Expr{0})* +(Series #2 -#1)>;
+
+InfixWith:      With +(Join #2 #1) ;
+
+With:           'with' Category +(with #1) ;
+
+Category:      'if' Expression 'then' Category <'else' Category>! +(if #3 #2 #1)
+              / '(' Category <(';' Category)*>! ')' +(CATEGORY #2 -#1)
+              / .(SETQ $1 (LINE-NUMBER CURRENT-LINE)) Application 
+                   ( ':' Expression +(Signature #2 #1)
+                             .(recordSignatureDocumentation ##1 $1)
+                           / +(Attribute #1)
+                             .(recordAttributeDocumentation ##1 $1));
+
+Expression:   Expr{(PARSE-rightBindingPowerOf (MAKE-SYMBOL-OF PRIOR-TOKEN) ParseMode)}
+                +#1 ;
+
+Import:         'import' Expr{1000} <(',' Expr{1000})*>! +(import #2 -#1) ;
+
+Infix:          =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail>
+                Expression +(#2 #2 #1) ;
+
+Prefix:         =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail>
+                Expression +(#2 #1) ;
+
+Suffix:         +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail> +(#1 #1) ;
+
+TokTail:        ?(AND (NULL \$BOOT) (EQ (CURRENT-SYMBOL) "\$)
+                      (OR (ALPHA-CHAR-P (CURRENT-CHAR))
+                          (CHAR-EQ (CURRENT-CHAR) '$')
+                          (CHAR-EQ (CURRENT-CHAR) '\%')
+                          (CHAR-EQ (CURRENT-CHAR) '(')))
+                .(SETQ $1 (COPY-TOKEN PRIOR-TOKEN)) Qualification
+                .(SETQ PRIOR-TOKEN $1) ;
+
+Qualification:  '$' Primary1 +=(dollarTran #1 #1) ;
+
+SemiColon:      ';' (Expr{82} / + \/throwAway) +(\; #2 #1) ;
+
+Return:         'return' Expression +(return #1) ;
+
+Exit:           'exit' (Expression / +\$NoValue) +(exit #1) ;
+
+Leave:          'leave' ( Expression / +\$NoValue )
+                ('from' Label +(leaveFrom #1 #1) / +(leave #1)) ;
+
+Seg:            GliphTok{"\.\.} <Expression>! +(SEGMENT #2 #1) ;
+
+Conditional:    'if' Expression 'then' Expression <'else' ElseClause>!
+                   +(if #3 #2 #1) ;
+
+ElseClause:     ?(EQ (CURRENT-SYMBOL) "if) Conditional / Expression ;
+
+Loop:           Iterator* 'repeat' Expr{110} +(REPEAT -#2 #1)
+              / 'repeat' Expr{110} +(REPEAT #1) ;
+
+Iterator:       'for' Primary 'in' Expression
+                ( 'by' Expr{200} +(INBY #3 #2 #1) / +(IN #2 #1) )
+                < '\|' Expr{111} +(\| #1) >
+              / 'while' Expr{190} +(WHILE #1)
+              / 'until' Expr{190} +(UNTIL #1) ;
+
+Expr{RBP}:      NudPart{RBP} <LedPart{RBP}>* +#1;
+
+LabelExpr:      Label Expr{120} +(LABEL #2 #1) ;
+
+Label:          '<<' Name '>>' ;
+
+LedPart{RBP}:   Operation{"Led RBP} +#1;
+
+NudPart{RBP}:   (Operation{"Nud RBP} / Reduction / Form) +#1 ;
+
+Operation{ParseMode RBP}:
+        ^?(MATCH-CURRENT-TOKEN "IDENTIFIER)
+        ?(GETL (SETQ tmptok (CURRENT-SYMBOL)) ParseMode)
+        ?(LT RBP (PARSE-leftBindingPowerOf tmptok ParseMode))
+        .(SETQ RBP (PARSE-rightBindingPowerOf tmptok ParseMode))
+        getSemanticForm{tmptok ParseMode (ELEMN (GETL tmptok ParseMode) 5 NIL)} ;
+
+% Binding powers stored under the Led and Red properties of an operator
+% are set up by the file BOTTOMUP.LISP.  The format for a Led property
+% is <Operator Left-Power Right-Power>, and the same for a Nud, except that
+% it may also have a fourth component <Special-Handler>. ELEMN attempts to
+% get the Nth indicator, counting from 1.
+
+leftBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0)) ;
+
+rightBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105)) ;
+
+getSemanticForm{X IND Y}:
+                ?(AND Y (EVAL Y)) / ?(EQ IND "Nud) Prefix / ?(EQ IND "Led) Infix ;
+
+
+Reduction:      ReductionOp Expr{1000} +(Reduce #2 #1) ;
+
+ReductionOp:    ?(AND (GETL (CURRENT-SYMBOL) "Led)
+                      (MATCH-NEXT-TOKEN "SPECIAL-CHAR (CODE-CHAR 47))) % Forgive me!
+                +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) .(ADVANCE-TOKEN) ;
+
+Form:           'iterate' < 'from' Label +(#1) >! +(iterate -#1)
+              / 'yield' Application +(yield #1)
+              / Application ;
+
+Application: Primary <Selector>* <Application +(#2 #1)>;
+
+Selector: ?NONBLANK ?(EQ (CURRENT-SYMBOL) "\.) ?(CHAR-NE (CURRENT-CHAR) "\ )
+                 '.' PrimaryNoFloat (=\$BOOT +(ELT #2 #1)/ +(#2 #1))
+          / (Float /'.' Primary) (=\$BOOT +(ELT #2 #1)/ +(#2 #1));
+
+PrimaryNoFloat: Primary1 <TokTail> ;
+
+Primary: Float /PrimaryNoFloat ;
+
+Primary1: VarForm <=(AND NONBLANK (EQ (CURRENT-SYMBOL) "\()) Primary1 +(#2 #1)>
+        /Quad
+        /String
+        /IntegerTok
+        /FormalParameter
+        /='\'' (?\$BOOT Data / '\'' Expr{999} +(QUOTE #1))
+        /Sequence
+        /Enclosure ;
+
+Float: FloatBase (?NONBLANK FloatExponent / +0) +=(MAKE-FLOAT #4 #2 #2 #1) ;
+
+FloatBase: ?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CURRENT-CHAR) '.')
+           ?(CHAR-NE (NEXT-CHAR) '.')
+              IntegerTok FloatBasePart
+          /?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) "E)
+              IntegerTok +0 +0
+         /?(DIGITP (CURRENT-CHAR)) ?(EQ (CURRENT-SYMBOL) "\.)
+              +0 FloatBasePart ;
+
+FloatBasePart: '.'
+  (?(DIGITP (CURRENT-CHAR)) +=(TOKEN-NONBLANK (CURRENT-TOKEN)) IntegerTok
+  / +0 +0);
+
+
+FloatExponent: =(AND (MEMBER (CURRENT-SYMBOL) "(E e))
+                     (FIND (CURRENT-CHAR) '+-'))
+                 .(ADVANCE-TOKEN)
+        (IntegerTok/'+' IntegerTok/'-' IntegerTok +=(MINUS #1)/+0)
+       /?(IDENTP (CURRENT-SYMBOL)) =(SETQ $1 (FLOATEXPID (CURRENT-SYMBOL)))
+       .(ADVANCE-TOKEN) +=$1 ;
+
+Enclosure:      '(' ( Expr{6} ')' / ')' +(Tuple) )
+              / '{' ( Expr{6} '}' +(brace (construct #1)) / '}' +(brace)) ;
+
+IntegerTok:     NUMBER ;
+
+FloatTok:       NUMBER +=(IF \$BOOT #1 (BFP- #1)) ;
+
+FormalParameter: FormalParameterTok ;
+
+FormalParameterTok: ARGUMENT-DESIGNATOR ;
+
+Quad:           '$' +\$ / ?\$BOOT GliphTok{"\.} +\. ;
+
+String:         SPADSTRING ;
+
+VarForm:        Name <Scripts +(Scripts #2 #1) > +#1 ;
+
+Scripts:        ?NONBLANK '[' ScriptItem ']' ;
+
+ScriptItem:     Expr{90} <(';' ScriptItem)* +(\; #2 -#1)>
+              / ';' ScriptItem +(PrefixSC #1) ;
+
+Name:           IDENTIFIER +#1 ;
+
+Data:           .(SETQ LABLASOC NIL) Sexpr +(QUOTE =(TRANSLABEL #1 LABLASOC)) ;
+
+Sexpr:          .(ADVANCE-TOKEN) Sexpr1 ;
+
+Sexpr1:       AnyId
+              < NBGliphTok{"\=} Sexpr1
+                 .(SETQ LABLASOC (CONS (CONS #2 ##1) LABLASOC))>
+              / '\'' Sexpr1 +(QUOTE #1)
+              / IntegerTok
+              / '-' IntegerTok +=(MINUS #1)
+              / String
+              / '<' <Sexpr1*>! '>' +=(LIST2VEC #1)
+              / '(' <Sexpr1* <GliphTok{"\.} Sexpr1 +=(NCONC #2 #1)>>! ')' ;
+
+NBGliphTok{tok}:   ?(AND (MATCH-CURRENT-TOKEN "GLIPH tok) NONBLANK)
+                    .(ADVANCE-TOKEN) ;
+
+GliphTok{tok}:     ?(MATCH-CURRENT-TOKEN "GLIPH tok) .(ADVANCE-TOKEN) ;
+
+AnyId:          IDENTIFIER
+              / (='$' +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) / KEYWORD) ;
+
+Sequence:       OpenBracket Sequence1 ']'
+              / OpenBrace Sequence1 '}' +(brace #1) ;
+
+Sequence1:     (Expression +(#2 #1) / +(#1)) <IteratorTail +(COLLECT -#1 #1)>  ;
+
+OpenBracket:    =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\[ )
+                      (=(EQCAR $1 "elt) +(elt =(CADR $1) construct)
+                        / +construct) .(ADVANCE-TOKEN) ;
+
+OpenBrace:      =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\{ )
+                      (=(EQCAR $1 "elt) +(elt =(CADR $1) brace)
+                        / +construct) .(ADVANCE-TOKEN) ;
+
+IteratorTail:   ('repeat' <Iterator*>! / Iterator*) ;
+
+.FIN ;
+
+
+@
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(IN-PACKAGE "BOOT" )
+
+
+(DEFPARAMETER |tmptok| NIL)
+(DEFPARAMETER TOK NIL)
+(DEFPARAMETER |ParseMode| NIL)
+(DEFPARAMETER DEFINITION_NAME NIL)
+(DEFPARAMETER LABLASOC NIL)
+
+
+(DEFUN |PARSE-NewExpr| ()
+  (OR (AND (MATCH-STRING ")") (ACTION (|processSynonyms|))
+           (MUST (|PARSE-Command|)))
+      (AND (ACTION (SETQ DEFINITION_NAME (CURRENT-SYMBOL)))
+           (|PARSE-Statement|)))) 
+
+
+(DEFUN |PARSE-Command| ()
+  (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|))
+       (MUST (|PARSE-SpecialCommand|))
+       (PUSH-REDUCTION '|PARSE-Command| NIL))) 
+
+
+(DEFUN |PARSE-SpecialKeyWord| ()
+  (AND (MATCH-CURRENT-TOKEN 'IDENTIFIER)
+       (ACTION (SETF (TOKEN-SYMBOL (CURRENT-TOKEN))
+                     (|unAbbreviateKeyword| (CURRENT-SYMBOL)))))) 
+
+
+(DEFUN |PARSE-SpecialCommand| ()
+  (OR (AND (MATCH-ADVANCE-STRING "show")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (OR (MATCH-ADVANCE-STRING "?")
+                         (|PARSE-Expression|))))
+           (PUSH-REDUCTION '|PARSE-SpecialCommand|
+               (CONS '|show| (CONS (POP-STACK-1) NIL)))
+           (MUST (|PARSE-CommandTail|)))
+      (AND (MEMBER (CURRENT-SYMBOL) |$noParseCommands|)
+           (ACTION (FUNCALL (CURRENT-SYMBOL))))
+      (AND (MEMBER (CURRENT-SYMBOL) |$tokenCommands|)
+           (|PARSE-TokenList|) (MUST (|PARSE-TokenCommandTail|)))
+      (AND (STAR REPEATOR (|PARSE-PrimaryOrQM|))
+           (MUST (|PARSE-CommandTail|))))) 
+
+
+(DEFUN |PARSE-TokenList| ()
+  (STAR REPEATOR
+        (AND (NOT (|isTokenDelimiter|))
+             (PUSH-REDUCTION '|PARSE-TokenList| (CURRENT-SYMBOL))
+             (ACTION (ADVANCE-TOKEN))))) 
+
+
+(DEFUN |PARSE-TokenCommandTail| ()
+  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-TokenOption|))))
+       (|atEndOfLine|)
+       (PUSH-REDUCTION '|PARSE-TokenCommandTail|
+           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
+       (ACTION (|systemCommand| (POP-STACK-1))))) 
+
+
+(DEFUN |PARSE-TokenOption| ()
+  (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-TokenList|)))) 
+
+
+(DEFUN |PARSE-CommandTail| ()
+  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|))))
+       (|atEndOfLine|)
+       (PUSH-REDUCTION '|PARSE-CommandTail|
+           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
+       (ACTION (|systemCommand| (POP-STACK-1))))) 
+
+
+(DEFUN |PARSE-PrimaryOrQM| ()
+  (OR (AND (MATCH-ADVANCE-STRING "?")
+           (PUSH-REDUCTION '|PARSE-PrimaryOrQM| '?))
+      (|PARSE-Primary|))) 
+
+
+(DEFUN |PARSE-Option| ()
+  (AND (MATCH-ADVANCE-STRING ")")
+       (MUST (STAR REPEATOR (|PARSE-PrimaryOrQM|))))) 
+
+
+(DEFUN |PARSE-Statement| ()
+  (AND (|PARSE-Expr| 0)
+       (OPTIONAL
+           (AND (STAR REPEATOR
+                      (AND (MATCH-ADVANCE-STRING ",")
+                           (MUST (|PARSE-Expr| 0))))
+                (PUSH-REDUCTION '|PARSE-Statement|
+                    (CONS '|Series|
+                          (CONS (POP-STACK-2)
+                                (APPEND (POP-STACK-1) NIL)))))))) 
+
+
+(DEFUN |PARSE-InfixWith| ()
+  (AND (|PARSE-With|)
+       (PUSH-REDUCTION '|PARSE-InfixWith|
+           (CONS '|Join| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-With| ()
+  (AND (MATCH-ADVANCE-STRING "with") (MUST (|PARSE-Category|))
+       (PUSH-REDUCTION '|PARSE-With|
+           (CONS '|with| (CONS (POP-STACK-1) NIL))))) 
+
+
+(DEFUN |PARSE-Category| ()
+  (PROG (G1)
+    (RETURN
+      (OR (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|))
+               (MUST (MATCH-ADVANCE-STRING "then"))
+               (MUST (|PARSE-Category|))
+               (BANG FIL_TEST
+                     (OPTIONAL
+                         (AND (MATCH-ADVANCE-STRING "else")
+                              (MUST (|PARSE-Category|)))))
+               (PUSH-REDUCTION '|PARSE-Category|
+                   (CONS '|if|
+                         (CONS (POP-STACK-3)
+                               (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL))))))
+          (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|))
+               (BANG FIL_TEST
+                     (OPTIONAL
+                         (STAR REPEATOR
+                               (AND (MATCH-ADVANCE-STRING ";")
+                                    (MUST (|PARSE-Category|))))))
+               (MUST (MATCH-ADVANCE-STRING ")"))
+               (PUSH-REDUCTION '|PARSE-Category|
+                   (CONS 'CATEGORY
+                         (CONS (POP-STACK-2)
+                               (APPEND (POP-STACK-1) NIL)))))
+          (AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE)))
+               (|PARSE-Application|)
+               (MUST (OR (AND (MATCH-ADVANCE-STRING ":")
+                              (MUST (|PARSE-Expression|))
+                              (PUSH-REDUCTION '|PARSE-Category|
+                                  (CONS '|Signature|
+                                        (CONS (POP-STACK-2)
+                                         (CONS (POP-STACK-1) NIL))))
+                              (ACTION (|recordSignatureDocumentation|
+                                       (NTH-STACK 1) G1)))
+                         (AND (PUSH-REDUCTION '|PARSE-Category|
+                                  (CONS '|Attribute|
+                                        (CONS (POP-STACK-1) NIL)))
+                              (ACTION (|recordAttributeDocumentation|
+                                       (NTH-STACK 1) G1)))))))))) 
+
+
+(DEFUN |PARSE-Expression| ()
+  (AND (|PARSE-Expr|
+           (|PARSE-rightBindingPowerOf| (MAKE-SYMBOL-OF PRIOR-TOKEN)
+               |ParseMode|))
+       (PUSH-REDUCTION '|PARSE-Expression| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-Import| ()
+  (AND (MATCH-ADVANCE-STRING "import") (MUST (|PARSE-Expr| 1000))
+       (BANG FIL_TEST
+             (OPTIONAL
+                 (STAR REPEATOR
+                       (AND (MATCH-ADVANCE-STRING ",")
+                            (MUST (|PARSE-Expr| 1000))))))
+       (PUSH-REDUCTION '|PARSE-Import|
+           (CONS '|import|
+                 (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Infix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Infix|
+           (CONS (POP-STACK-2)
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Prefix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Prefix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Prefix|
+           (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) 
+
+
+(DEFUN |PARSE-Suffix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (PUSH-REDUCTION '|PARSE-Suffix|
+           (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL))))) 
+
+
+(DEFUN |PARSE-TokTail| ()
+  (PROG (G1)
+    (RETURN
+      (AND (NULL $BOOT) (EQ (CURRENT-SYMBOL) '$)
+           (OR (ALPHA-CHAR-P (CURRENT-CHAR))
+               (CHAR-EQ (CURRENT-CHAR) "$")
+               (CHAR-EQ (CURRENT-CHAR) "%")
+               (CHAR-EQ (CURRENT-CHAR) "("))
+           (ACTION (SETQ G1 (COPY-TOKEN PRIOR-TOKEN)))
+           (|PARSE-Qualification|) (ACTION (SETQ PRIOR-TOKEN G1)))))) 
+
+
+(DEFUN |PARSE-Qualification| ()
+  (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|))
+       (PUSH-REDUCTION '|PARSE-Qualification|
+           (|dollarTran| (POP-STACK-1) (POP-STACK-1))))) 
+
+
+(DEFUN |PARSE-SemiColon| ()
+  (AND (MATCH-ADVANCE-STRING ";")
+       (MUST (OR (|PARSE-Expr| 82)
+                 (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|)))
+       (PUSH-REDUCTION '|PARSE-SemiColon|
+           (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Return| ()
+  (AND (MATCH-ADVANCE-STRING "return") (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Return|
+           (CONS '|return| (CONS (POP-STACK-1) NIL))))) 
+
+
+(DEFUN |PARSE-Exit| ()
+  (AND (MATCH-ADVANCE-STRING "exit")
+       (MUST (OR (|PARSE-Expression|)
+                 (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|)))
+       (PUSH-REDUCTION '|PARSE-Exit|
+           (CONS '|exit| (CONS (POP-STACK-1) NIL))))) 
+
+
+(DEFUN |PARSE-Leave| ()
+  (AND (MATCH-ADVANCE-STRING "leave")
+       (MUST (OR (|PARSE-Expression|)
+                 (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|)))
+       (MUST (OR (AND (MATCH-ADVANCE-STRING "from")
+                      (MUST (|PARSE-Label|))
+                      (PUSH-REDUCTION '|PARSE-Leave|
+                          (CONS '|leaveFrom|
+                                (CONS (POP-STACK-1)
+                                      (CONS (POP-STACK-1) NIL)))))
+                 (PUSH-REDUCTION '|PARSE-Leave|
+                     (CONS '|leave| (CONS (POP-STACK-1) NIL))))))) 
+
+
+(DEFUN |PARSE-Seg| ()
+  (AND (|PARSE-GliphTok| '|..|)
+       (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|)))
+       (PUSH-REDUCTION '|PARSE-Seg|
+           (CONS 'SEGMENT
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Conditional| ()
+  (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|))
+       (MUST (MATCH-ADVANCE-STRING "then")) (MUST (|PARSE-Expression|))
+       (BANG FIL_TEST
+             (OPTIONAL
+                 (AND (MATCH-ADVANCE-STRING "else")
+                      (MUST (|PARSE-ElseClause|)))))
+       (PUSH-REDUCTION '|PARSE-Conditional|
+           (CONS '|if|
+                 (CONS (POP-STACK-3)
+                       (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) 
+
+
+(DEFUN |PARSE-ElseClause| ()
+  (OR (AND (EQ (CURRENT-SYMBOL) '|if|) (|PARSE-Conditional|))
+      (|PARSE-Expression|))) 
+
+
+(DEFUN |PARSE-Loop| ()
+  (OR (AND (STAR REPEATOR (|PARSE-Iterator|))
+           (MUST (MATCH-ADVANCE-STRING "repeat"))
+           (MUST (|PARSE-Expr| 110))
+           (PUSH-REDUCTION '|PARSE-Loop|
+               (CONS 'REPEAT
+                     (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+      (AND (MATCH-ADVANCE-STRING "repeat") (MUST (|PARSE-Expr| 110))
+           (PUSH-REDUCTION '|PARSE-Loop|
+               (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Iterator| ()
+  (OR (AND (MATCH-ADVANCE-STRING "for") (MUST (|PARSE-Primary|))
+           (MUST (MATCH-ADVANCE-STRING "in"))
+           (MUST (|PARSE-Expression|))
+           (MUST (OR (AND (MATCH-ADVANCE-STRING "by")
+                          (MUST (|PARSE-Expr| 200))
+                          (PUSH-REDUCTION '|PARSE-Iterator|
+                              (CONS 'INBY
+                                    (CONS (POP-STACK-3)
+                                     (CONS (POP-STACK-2)
+                                      (CONS (POP-STACK-1) NIL))))))
+                     (PUSH-REDUCTION '|PARSE-Iterator|
+                         (CONS 'IN
+                               (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL))))))
+           (OPTIONAL
+               (AND (MATCH-ADVANCE-STRING "|")
+                    (MUST (|PARSE-Expr| 111))
+                    (PUSH-REDUCTION '|PARSE-Iterator|
+                        (CONS '|\|| (CONS (POP-STACK-1) NIL))))))
+      (AND (MATCH-ADVANCE-STRING "while") (MUST (|PARSE-Expr| 190))
+           (PUSH-REDUCTION '|PARSE-Iterator|
+               (CONS 'WHILE (CONS (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "until") (MUST (|PARSE-Expr| 190))
+           (PUSH-REDUCTION '|PARSE-Iterator|
+               (CONS 'UNTIL (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Expr| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (|PARSE-NudPart| RBP)
+       (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP)))
+       (PUSH-REDUCTION '|PARSE-Expr| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-LabelExpr| ()
+  (AND (|PARSE-Label|) (MUST (|PARSE-Expr| 120))
+       (PUSH-REDUCTION '|PARSE-LabelExpr|
+           (CONS 'LABEL (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Label| ()
+  (AND (MATCH-ADVANCE-STRING "<<") (MUST (|PARSE-Name|))
+       (MUST (MATCH-ADVANCE-STRING ">>")))) 
+
+
+(DEFUN |PARSE-LedPart| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (|PARSE-Operation| '|Led| RBP)
+       (PUSH-REDUCTION '|PARSE-LedPart| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-NudPart| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|)
+           (|PARSE-Form|))
+       (PUSH-REDUCTION '|PARSE-NudPart| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-Operation| (|ParseMode| RBP)
+  (DECLARE (SPECIAL |ParseMode| RBP))
+  (AND (NOT (MATCH-CURRENT-TOKEN 'IDENTIFIER))
+       (GETL (SETQ |tmptok| (CURRENT-SYMBOL)) |ParseMode|)
+       (LT RBP (|PARSE-leftBindingPowerOf| |tmptok| |ParseMode|))
+       (ACTION (SETQ RBP
+                     (|PARSE-rightBindingPowerOf| |tmptok| |ParseMode|)))
+       (|PARSE-getSemanticForm| |tmptok| |ParseMode|
+           (ELEMN (GETL |tmptok| |ParseMode|) 5 NIL)))) 
+
+
+(DEFUN |PARSE-leftBindingPowerOf| (X IND)
+  (DECLARE (SPECIAL X IND))
+  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0))) 
+
+
+(DEFUN |PARSE-rightBindingPowerOf| (X IND)
+  (DECLARE (SPECIAL X IND))
+  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105))) 
+
+
+(DEFUN |PARSE-getSemanticForm| (X IND Y)
+  (DECLARE (SPECIAL X IND Y))
+  (OR (AND Y (EVAL Y)) (AND (EQ IND '|Nud|) (|PARSE-Prefix|))
+      (AND (EQ IND '|Led|) (|PARSE-Infix|)))) 
+
+
+(DEFUN |PARSE-Reduction| ()
+  (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000))
+       (PUSH-REDUCTION '|PARSE-Reduction|
+           (CONS '|Reduce|
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-ReductionOp| ()
+  (AND (GETL (CURRENT-SYMBOL) '|Led|)
+       (MATCH-NEXT-TOKEN 'SPECIAL-CHAR (CODE-CHAR 47))
+       (PUSH-REDUCTION '|PARSE-ReductionOp| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (ACTION (ADVANCE-TOKEN)))) 
+
+
+(DEFUN |PARSE-Form| ()
+  (OR (AND (MATCH-ADVANCE-STRING "iterate")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (AND (MATCH-ADVANCE-STRING "from")
+                          (MUST (|PARSE-Label|))
+                          (PUSH-REDUCTION '|PARSE-Form|
+                              (CONS (POP-STACK-1) NIL)))))
+           (PUSH-REDUCTION '|PARSE-Form|
+               (CONS '|iterate| (APPEND (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "yield") (MUST (|PARSE-Application|))
+           (PUSH-REDUCTION '|PARSE-Form|
+               (CONS '|yield| (CONS (POP-STACK-1) NIL))))
+      (|PARSE-Application|))) 
+
+
+(DEFUN |PARSE-Application| ()
+  (AND (|PARSE-Primary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|)))
+       (OPTIONAL
+           (AND (|PARSE-Application|)
+                (PUSH-REDUCTION '|PARSE-Application|
+                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) 
+
+
+(DEFUN |PARSE-Selector| ()
+  (OR (AND NONBLANK (EQ (CURRENT-SYMBOL) '|.|)
+           (CHAR-NE (CURRENT-CHAR) '| |) (MATCH-ADVANCE-STRING ".")
+           (MUST (|PARSE-PrimaryNoFloat|))
+           (MUST (OR (AND $BOOT
+                          (PUSH-REDUCTION '|PARSE-Selector|
+                              (CONS 'ELT
+                                    (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL)))))
+                     (PUSH-REDUCTION '|PARSE-Selector|
+                         (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+      (AND (OR (|PARSE-Float|)
+               (AND (MATCH-ADVANCE-STRING ".")
+                    (MUST (|PARSE-Primary|))))
+           (MUST (OR (AND $BOOT
+                          (PUSH-REDUCTION '|PARSE-Selector|
+                              (CONS 'ELT
+                                    (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL)))))
+                     (PUSH-REDUCTION '|PARSE-Selector|
+                         (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))) 
+
+
+(DEFUN |PARSE-PrimaryNoFloat| ()
+  (AND (|PARSE-Primary1|) (OPTIONAL (|PARSE-TokTail|)))) 
+
+
+(DEFUN |PARSE-Primary| ()
+  (OR (|PARSE-Float|) (|PARSE-PrimaryNoFloat|))) 
+
+
+(DEFUN |PARSE-Primary1| ()
+  (OR (AND (|PARSE-VarForm|)
+           (OPTIONAL
+               (AND NONBLANK (EQ (CURRENT-SYMBOL) '|(|)
+                    (MUST (|PARSE-Primary1|))
+                    (PUSH-REDUCTION '|PARSE-Primary1|
+                        (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+      (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|)
+      (|PARSE-FormalParameter|)
+      (AND (MATCH-STRING "'")
+           (MUST (OR (AND $BOOT (|PARSE-Data|))
+                     (AND (MATCH-ADVANCE-STRING "'")
+                          (MUST (|PARSE-Expr| 999))
+                          (PUSH-REDUCTION '|PARSE-Primary1|
+                              (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))))))
+      (|PARSE-Sequence|) (|PARSE-Enclosure|))) 
+
+
+(DEFUN |PARSE-Float| ()
+  (AND (|PARSE-FloatBase|)
+       (MUST (OR (AND NONBLANK (|PARSE-FloatExponent|))
+                 (PUSH-REDUCTION '|PARSE-Float| 0)))
+       (PUSH-REDUCTION '|PARSE-Float|
+           (MAKE-FLOAT (POP-STACK-4) (POP-STACK-2) (POP-STACK-2)
+               (POP-STACK-1))))) 
+
+
+(DEFUN |PARSE-FloatBase| ()
+  (OR (AND (FIXP (CURRENT-SYMBOL)) (CHAR-EQ (CURRENT-CHAR) ".")
+           (CHAR-NE (NEXT-CHAR) ".") (|PARSE-IntegerTok|)
+           (MUST (|PARSE-FloatBasePart|)))
+      (AND (FIXP (CURRENT-SYMBOL))
+           (CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) 'E)
+           (|PARSE-IntegerTok|) (PUSH-REDUCTION '|PARSE-FloatBase| 0)
+           (PUSH-REDUCTION '|PARSE-FloatBase| 0))
+      (AND (DIGITP (CURRENT-CHAR)) (EQ (CURRENT-SYMBOL) '|.|)
+           (PUSH-REDUCTION '|PARSE-FloatBase| 0)
+           (|PARSE-FloatBasePart|)))) 
+
+
+(DEFUN |PARSE-FloatBasePart| ()
+  (AND (MATCH-ADVANCE-STRING ".")
+       (MUST (OR (AND (DIGITP (CURRENT-CHAR))
+                      (PUSH-REDUCTION '|PARSE-FloatBasePart|
+                          (TOKEN-NONBLANK (CURRENT-TOKEN)))
+                      (|PARSE-IntegerTok|))
+                 (AND (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)
+                      (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)))))) 
+
+
+(DEFUN |PARSE-FloatExponent| ()
+  (PROG (G1)
+    (RETURN
+      (OR (AND (MEMBER (CURRENT-SYMBOL) '(E |e|))
+               (FIND (CURRENT-CHAR) "+-") (ACTION (ADVANCE-TOKEN))
+               (MUST (OR (|PARSE-IntegerTok|)
+                         (AND (MATCH-ADVANCE-STRING "+")
+                              (MUST (|PARSE-IntegerTok|)))
+                         (AND (MATCH-ADVANCE-STRING "-")
+                              (MUST (|PARSE-IntegerTok|))
+                              (PUSH-REDUCTION '|PARSE-FloatExponent|
+                                  (MINUS (POP-STACK-1))))
+                         (PUSH-REDUCTION '|PARSE-FloatExponent| 0))))
+          (AND (IDENTP (CURRENT-SYMBOL))
+               (SETQ G1 (FLOATEXPID (CURRENT-SYMBOL)))
+               (ACTION (ADVANCE-TOKEN))
+               (PUSH-REDUCTION '|PARSE-FloatExponent| G1)))))) 
+
+
+(DEFUN |PARSE-Enclosure| ()
+  (OR (AND (MATCH-ADVANCE-STRING "(")
+           (MUST (OR (AND (|PARSE-Expr| 6)
+                          (MUST (MATCH-ADVANCE-STRING ")")))
+                     (AND (MATCH-ADVANCE-STRING ")")
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|Tuple| NIL))))))
+      (AND (MATCH-ADVANCE-STRING "{")
+           (MUST (OR (AND (|PARSE-Expr| 6)
+                          (MUST (MATCH-ADVANCE-STRING "}"))
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|brace|
+                                    (CONS
+                                     (CONS '|construct|
+                                      (CONS (POP-STACK-1) NIL))
+                                     NIL))))
+                     (AND (MATCH-ADVANCE-STRING "}")
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|brace| NIL)))))))) 
+
+
+(DEFUN |PARSE-IntegerTok| () (PARSE-NUMBER)) 
+
+
+(DEFUN |PARSE-FloatTok| ()
+  (AND (PARSE-NUMBER)
+       (PUSH-REDUCTION '|PARSE-FloatTok|
+           (IF $BOOT (POP-STACK-1) (BFP- (POP-STACK-1)))))) 
+
+
+(DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) 
+
+
+(DEFUN |PARSE-FormalParameterTok| () (PARSE-ARGUMENT-DESIGNATOR)) 
+
+
+(DEFUN |PARSE-Quad| ()
+  (OR (AND (MATCH-ADVANCE-STRING "$")
+           (PUSH-REDUCTION '|PARSE-Quad| '$))
+      (AND $BOOT (|PARSE-GliphTok| '|.|)
+           (PUSH-REDUCTION '|PARSE-Quad| '|.|)))) 
+
+
+(DEFUN |PARSE-String| () (PARSE-SPADSTRING)) 
+
+
+(DEFUN |PARSE-VarForm| ()
+  (AND (|PARSE-Name|)
+       (OPTIONAL
+           (AND (|PARSE-Scripts|)
+                (PUSH-REDUCTION '|PARSE-VarForm|
+                    (CONS '|Scripts|
+                          (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+       (PUSH-REDUCTION '|PARSE-VarForm| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-Scripts| ()
+  (AND NONBLANK (MATCH-ADVANCE-STRING "[") (MUST (|PARSE-ScriptItem|))
+       (MUST (MATCH-ADVANCE-STRING "]")))) 
+
+
+(DEFUN |PARSE-ScriptItem| ()
+  (OR (AND (|PARSE-Expr| 90)
+           (OPTIONAL
+               (AND (STAR REPEATOR
+                          (AND (MATCH-ADVANCE-STRING ";")
+                               (MUST (|PARSE-ScriptItem|))))
+                    (PUSH-REDUCTION '|PARSE-ScriptItem|
+                        (CONS '|;|
+                              (CONS (POP-STACK-2)
+                                    (APPEND (POP-STACK-1) NIL)))))))
+      (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|))
+           (PUSH-REDUCTION '|PARSE-ScriptItem|
+               (CONS '|PrefixSC| (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Name| ()
+  (AND (PARSE-IDENTIFIER) (PUSH-REDUCTION '|PARSE-Name| (POP-STACK-1)))) 
+
+
+(DEFUN |PARSE-Data| ()
+  (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|)
+       (PUSH-REDUCTION '|PARSE-Data|
+           (CONS 'QUOTE (CONS (TRANSLABEL (POP-STACK-1) LABLASOC) NIL))))) 
+
+
+(DEFUN |PARSE-Sexpr| ()
+  (AND (ACTION (ADVANCE-TOKEN)) (|PARSE-Sexpr1|))) 
+
+
+(DEFUN |PARSE-Sexpr1| ()
+  (OR (AND (|PARSE-AnyId|)
+           (OPTIONAL
+               (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
+                    (ACTION (SETQ LABLASOC
+                                  (CONS (CONS (POP-STACK-2)
+                                         (NTH-STACK 1))
+                                        LABLASOC))))))
+      (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|))
+           (PUSH-REDUCTION '|PARSE-Sexpr1|
+               (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
+      (|PARSE-IntegerTok|)
+      (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|))
+           (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1))))
+      (|PARSE-String|)
+      (AND (MATCH-ADVANCE-STRING "<")
+           (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
+           (MUST (MATCH-ADVANCE-STRING ">"))
+           (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1))))
+      (AND (MATCH-ADVANCE-STRING "(")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (AND (STAR REPEATOR (|PARSE-Sexpr1|))
+                          (OPTIONAL
+                              (AND (|PARSE-GliphTok| '|.|)
+                                   (MUST (|PARSE-Sexpr1|))
+                                   (PUSH-REDUCTION '|PARSE-Sexpr1|
+                                    (NCONC (POP-STACK-2) (POP-STACK-1))))))))
+           (MUST (MATCH-ADVANCE-STRING ")"))))) 
+
+
+(DEFUN |PARSE-NBGliphTok| (|tok|)
+  (DECLARE (SPECIAL |tok|))
+  (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) NONBLANK
+       (ACTION (ADVANCE-TOKEN)))) 
+
+
+(DEFUN |PARSE-GliphTok| (|tok|)
+  (DECLARE (SPECIAL |tok|))
+  (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) (ACTION (ADVANCE-TOKEN)))) 
+
+
+(DEFUN |PARSE-AnyId| ()
+  (OR (PARSE-IDENTIFIER)
+      (OR (AND (MATCH-STRING "$")
+               (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL))
+               (ACTION (ADVANCE-TOKEN)))
+          (PARSE-KEYWORD)))) 
+
+
+(DEFUN |PARSE-Sequence| ()
+  (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|))
+           (MUST (MATCH-ADVANCE-STRING "]")))
+      (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|))
+           (MUST (MATCH-ADVANCE-STRING "}"))
+           (PUSH-REDUCTION '|PARSE-Sequence|
+               (CONS '|brace| (CONS (POP-STACK-1) NIL)))))) 
+
+
+(DEFUN |PARSE-Sequence1| ()
+  (AND (OR (AND (|PARSE-Expression|)
+                (PUSH-REDUCTION '|PARSE-Sequence1|
+                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))
+           (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL)))
+       (OPTIONAL
+           (AND (|PARSE-IteratorTail|)
+                (PUSH-REDUCTION '|PARSE-Sequence1|
+                    (CONS 'COLLECT
+                          (APPEND (POP-STACK-1)
+                                  (CONS (POP-STACK-1) NIL)))))))) 
+
+
+(DEFUN |PARSE-OpenBracket| ()
+  (PROG (G1)
+    (RETURN
+      (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '[)
+           (MUST (OR (AND (EQCAR G1 '|elt|)
+                          (PUSH-REDUCTION '|PARSE-OpenBracket|
+                              (CONS '|elt|
+                                    (CONS (CADR G1)
+                                     (CONS '|construct| NIL)))))
+                     (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|)))
+           (ACTION (ADVANCE-TOKEN)))))) 
+
+
+(DEFUN |PARSE-OpenBrace| ()
+  (PROG (G1)
+    (RETURN
+      (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '{)
+           (MUST (OR (AND (EQCAR G1 '|elt|)
+                          (PUSH-REDUCTION '|PARSE-OpenBrace|
+                              (CONS '|elt|
+                                    (CONS (CADR G1)
+                                     (CONS '|brace| NIL)))))
+                     (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|)))
+           (ACTION (ADVANCE-TOKEN)))))) 
+
+
+(DEFUN |PARSE-IteratorTail| ()
+  (OR (AND (MATCH-ADVANCE-STRING "repeat")
+           (BANG FIL_TEST
+                 (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|)))))
+      (STAR REPEATOR (|PARSE-Iterator|)))) 
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/foam_l.lisp.pamphlet b/src/interp/foam_l.lisp.pamphlet
new file mode 100644
index 00000000..7bf48022
--- /dev/null
+++ b/src/interp/foam_l.lisp.pamphlet
@@ -0,0 +1,945 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/foam\_l.lisp} Pamphlet}
+\author{Stephen M. Watt, Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+
+
+\section{The [[FOAM]] package}
+
+FOAM is the intermediate language for the aldor compiler. FOAM
+means "first order abstract machine" and functions similar to
+RTL for the GCC compiler. It is a "machine" that is used as the
+target for meta-assembler level statments. These are eventually
+expanded for the real target machine (or interpreted directly)
+<<FOAM>>=
+#+:common-lisp (in-package "COMMON-LISP-USER")
+#-:common-lisp (in-package "USER")
+
+(defpackage "FOAM"
+  #+:common-lisp (:use "COMMON-LISP")
+  #-:common-lisp (:use "LISP"))
+
+@
+
+\section{The [[FOAM-USER]] package}
+
+FOAM-USER is the package containing foam statements and macros
+that get inserted into user code versus the foam package which
+provides support for compiler code.
+<<FOAM>>=
+(defpackage "FOAM-USER"
+  #+:common-lisp (:use "COMMON-LISP")
+  #-:common-lisp (:use "LISP")
+  (:use "FOAM"))
+
+@
+
+
+<<*>>=
+<<license>>
+;;;
+;;; FOAM Operations for Common Lisp
+;;;
+
+;;
+;; Client files should begin with
+;;   (in-package "FOAM-USER" :use '("FOAM" "LISP"))
+;;
+;;
+;; To Do:
+;;    Test cases.
+;;    Scan and format functions need to be rewritten to handle complete syntax.
+;;    Deftypes for each Foam type?
+;;
+
+<<FOAM>>
+(in-package "FOAM")
+
+(export '(
+ compile-as-file cases
+
+ |Clos| |Char| |Bool| |Byte| |HInt| |SInt| |BInt| |SFlo| |DFlo| |Ptr| 
+ |Word| |Arb| |Env| |Level| |Arr| |Record|
+
+ |ClosInit| |CharInit| |BoolInit| |ByteInit| |HIntInit| |SIntInit| 
+ |BIntInit| |SFloInit| |DFloInit| |PtrInit| |WordInit| |ArbInit| |EnvInit|
+ |ArrInit| |RecordInit| |LevelInit| 
+
+ |BoolFalse| |BoolTrue| |BoolNot| |BoolAnd| |BoolOr| |BoolEQ| |BoolNE|
+
+ |CharSpace| |CharNewline| |CharMin| |CharMax| |CharIsDigit|
+ |CharIsLetter| |CharEQ| |CharNE| |CharLT| |CharLE|
+ |CharLower| |CharUpper| |CharOrd| |CharNum| |CharCode0|
+
+ |SFlo0| |SFlo1| |SFloMin| |SFloMax| |SFloEpsilon| |SFloIsZero|
+ |SFloIsNeg| |SFloIsPos| |SFloEQ| |SFloNE| |SFloLT|
+ |SFloLE| |SFloNegate| |SFloPrev| |SFloNext| |SFloPlus|
+ |SFloMinus| |SFloTimes| |SFloTimesPlus| |SFloDivide|
+ |SFloRPlus| |SFloRMinus| |SFloRTimes| |SFloRTimesPlus|
+ |SFloRDivide| |SFloDissemble| |SFloAssemble|
+
+ |DFlo0| |DFlo1| |DFloMin| |DFloMax| |DFloEpsilon|
+ |DFloIsZero| |DFloIsNeg| |DFloIsPos| |DFloEQ| |DFloNE|
+ |DFloLT| |DFloLE| |DFloNegate| |DFloPrev| |DFloNext|
+ |DFloPlus| |DFloMinus| |DFloTimes| |DFloTimesPlus|
+ |DFloDivide| |DFloRPlus| |DFloRMinus| |DFloRTimes|
+ |DFloRTimesPlus| |DFloRDivide| |DFloDissemble|
+ |DFloAssemble| |Byte0| |Byte1| |ByteMin| |ByteMax|
+
+ |HInt0| |HInt1| |HIntMin| |HIntMax|
+
+ |SInt0| |SInt1| |SIntMin| |SIntMax| |SIntIsZero| |SIntIsNeg|
+ |SIntIsPos| |SIntIsEven| |SIntIsOdd| |SIntEQ| |SIntNE|
+ |SIntLT| |SIntLE| |SIntNegate| |SIntPrev| |SIntNext|
+ |SIntPlus| |SIntMinus| |SIntTimes| |SIntTimesPlus|
+ |SIntMod| |SIntQuo| |SIntRem| |SIntDivide| |SIntGcd|
+ |SIntPlusMod| |SIntMinusMod| |SIntTimesMod|
+ |SIntTimesModInv| |SIntLength| |SIntShiftUp|
+ |SIntShiftDn| |SIntBit| |SIntNot| |SIntAnd| |SIntOr|
+
+ |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep|
+
+ |BInt0| |BInt1| |BIntIsZero| |BIntIsNeg| |BIntIsPos| |BIntIsEven|
+ |BIntIsOdd| |BIntIsSingle| |BIntEQ| |BIntNE| |BIntLT|
+ |BIntLE| |BIntNegate| |BIntPrev| |BIntNext| |BIntPlus|
+ |BIntMinus| |BIntTimes| |BIntTimesPlus| |BIntMod|
+ |BIntQuo| |BIntRem| |BIntDivide| |BIntGcd|
+ |BIntSIPower| |BIntBIPower| |BIntLength| |BIntShiftUp|
+ |BIntShiftDn| |BIntBit|
+
+ |PtrNil| |PtrIsNil| |PtrMagicEQ| |PtrEQ| |PtrNE|
+
+ |FormatSFlo| |FormatDFlo| |FormatSInt| |FormatBInt|
+ |fgetss| |fputss|
+
+ |ScanSFlo| |ScanDFlo| |ScanSInt| |ScanBInt|
+
+ |SFloToDFlo| |DFloToSFlo| |ByteToSInt| |SIntToByte| |HIntToSInt|
+ |SIntToHInt| |SIntToBInt| |BIntToSInt| |SIntToSFlo|
+ |SIntToDFlo| |BIntToSFlo| |BIntToDFlo| |PtrToSInt|
+ |SIntToPtr| |BoolToSInt|
+
+ |ArrToSFlo| |ArrToDFlo| |ArrToSInt| |ArrToBInt|
+
+ |PlatformRTE| |PlatformOS| |Halt|
+
+ |Clos| |CCall| |ClosEnv| |ClosFun| |SetClosEnv| |SetClosFun|
+ |DDecl| |RNew| |ANew| |RElt| |EElt| |AElt| |Lex|
+ |SetLex| |SetRElt| |SetAElt| |SetEElt|
+ |FoamFree|
+
+ declare-prog declare-type
+ defprog ignore-var block-return
+ defspecials file-exports file-imports
+ typed-let foamfn |FoamProg| |alloc-prog-info|
+
+ |MakeEnv| |EnvLevel| |EnvNext| |EnvInfo| |SetEnvInfo| |FoamEnvEnsure|
+ |MakeLit| |MakeLevel|
+ |printNewLine| |printChar| |printString| |printSInt| |printBInt| |printSFloat|
+ |printDFloat| 
+ |strLength| |formatSInt| |formatBInt| |formatSFloat| |formatDFloat|
+ 
+ |ProgHashCode| |SetProgHashCode| |ProgFun|
+ |G-mainArgc| |G-mainArgv|
+ |stdinFile| |stdoutFile| |stderrFile|
+ |fputc| |fputs| |foamfun|
+
+
+ ;; trancendental functions
+ |sqrt| |pow| |log| |exp| |sin| |cos| |tan| |sinh| |cosh| |tanh| 
+ |asin| |acos| |atan| |atan2|
+
+ ;; debuging
+ |fiSetDebugVar| |fiGetDebugVar| |fiSetDebugger| |fiGetDebugger|
+ ;; Blatent hacks..
+ |G-stdoutVar| |G-stdinVar| |G-stderrVar|
+ |fiStrHash|
+
+ axiomxl-file-init-name
+ axiomxl-global-name
+))
+
+
+;; type defs for Foam types
+(deftype |Char| () 'character)
+(deftype |Clos| () 'list)
+(deftype |Bool| () '(member t nil))
+(deftype |Byte| () 'unsigned-byte)
+(deftype |HInt| () '(integer #.(- (expt 2 15)) #.(1- (expt 2 15))))
+(deftype |SInt| () 'fixnum)
+
+#+:AKCL
+(deftype |BInt| () t)
+#-:AKCL
+(deftype |BInt| () 'integer)
+
+(deftype |SFlo| () 'short-float)
+
+#+:AKCL
+(deftype |DFlo| () t)
+#-:AKCL
+(deftype |DFlo| () 'long-float)
+
+(deftype |Level| () t) ;; structure??
+
+(deftype |Nil|  () t)
+(deftype |Ptr|  () t)
+(deftype |Word| () t)
+(deftype |Arr|  () t)
+(deftype |Record| () t)
+(deftype |Arb|  () t)
+(deftype |Env|  () t)  ; (or cons nil)
+
+;; default values for types.  Used as initializers in lets.
+(defconstant |CharInit| (the |Char| '#\Space))
+(defconstant |ClosInit| (the |Clos| nil))
+(defconstant |BoolInit| (the |Bool| nil))
+(defconstant |ByteInit| (the |Byte| 0))
+(defconstant |HIntInit| (the |HInt| 0))
+(defconstant |SIntInit| (the |SInt| 0))
+(defconstant |BIntInit| (the |BInt|  0))
+(defconstant |SFloInit| (the |SFlo| 0.0s0))
+;; FIXME: Revisit the definition of DFlo as long-double.
+(defconstant |DFloInit| (the |DFlo| 0.0l0))
+(defconstant |PtrInit|  (the |Ptr|  nil))
+(defconstant |ArrInit|  (the |Arr|  nil))
+(defconstant |RecordInit|  (the |Record|  nil))
+(defconstant |WordInit| (the |Word| nil))
+(defconstant |ArbInit|  (the |Arb|  nil))
+(defconstant |EnvInit|  (the |Env|  nil))
+(defconstant |LevelInit|  (the |Level|  nil))
+
+;; Bool values are assumed to be either 'T or NIL.
+;; Thus non-nil values are canonically represented.
+(defmacro |BoolFalse|     () NIL)
+(defmacro |BoolTrue|      () 'T)
+(defmacro |BoolNot|      (x) `(NOT ,x))
+(defmacro |BoolAnd|    (x y)
+  `(let ((xx ,x) (yy ,y)) (AND xx yy))) ;; force evaluation of both args
+(defmacro |BoolOr|     (x y)
+  `(let ((xx ,x) (yy ,y)) (OR  xx yy))) ;; force evaluation of both args
+(defmacro |BoolEQ|     (x y) `(EQ ,x ,y))
+(defmacro |BoolNE|     (x y) `(NOT (|BoolEQ| ,x ,y)))
+
+(defconstant |CharCode0| (code-char 0))
+
+(defmacro |CharSpace|    () '#\Space)
+(defmacro |CharNewline|  () '#\Newline)
+(defmacro |CharMin|      ()  |CharCode0|)
+(defmacro |CharMax|      ()  #.(code-char (1- char-code-limit)))
+(defmacro |CharIsDigit| (x) `(if (DIGIT-CHAR-P (the |Char| ,x)) 't nil))
+(defmacro |CharIsLetter|(x) `(ALPHA-CHAR-P (the |Char| ,x)))
+(defmacro |CharLT|    (x y) `(CHAR< (the |Char| ,x) (the |Char| ,y)))
+(defmacro |CharLE|    (x y) `(CHAR<= (the |Char| ,x) (the |Char| ,y)))
+(defmacro |CharEQ|    (x y) `(CHAR= (the |Char| ,x) (the |Char| ,y)))
+(defmacro |CharNE|    (x y) `(CHAR/= (the |Char| ,x) (the |Char| ,y)))
+(defmacro |CharLower|   (x) `(the |Char| (CHAR-DOWNCASE (the |Char| ,x))))
+(defmacro |CharUpper|   (x) `(the |Char| (CHAR-UPCASE (the |Char| ,x))))
+(defmacro |CharOrd|     (x) `(CHAR-INT (the |Char| ,x)))
+(defmacro |CharNum|     (x) `(INT-CHAR (the |SInt| ,x)))
+
+(defmacro |SFlo0|        () 0.0s0)
+(defmacro |SFlo1|        () 1.0s0)
+(defmacro |SFloMin|      () most-negative-short-float)
+(defmacro |SFloMax|      () most-positive-short-float)
+(defmacro |SFloEpsilon|  () short-float-epsilon)
+(defmacro |SFloIsZero|  (x) `(zerop (the |SFlo| ,x)))
+(defmacro |SFloIsNeg|   (x) `(minusp (the |SFlo| ,x)))
+(defmacro |SFloIsPos|   (x) `(plusp (the |SFlo| ,x)))
+(defmacro |SFloLT|    (x y) `(< (the |SFlo| ,x) (the |SFlo| ,y)))
+(defmacro |SFloLE|    (x y) `(<= (the |SFlo| ,x) (the |SFlo| ,y)))
+(defmacro |SFloEQ|    (x y) `(= (the |SFlo| ,x) (the |SFlo| ,y)))
+(defmacro |SFloNE|    (x y) `(/= (the |SFlo| ,x) (the |SFlo| ,y)))
+(defmacro |SFloNegate|  (x) `(the |SFlo| (- (the |SFlo| ,x))))
+(defmacro |SFloNext|	(x) `(the |SFlo| (+ (the |SFlo| ,x) 1.0s0)))
+(defmacro |SFloPrev|	(x) `(the |SFlo| (- (the |SFlo| ,x) 1.0s0)))
+(defmacro |SFloMinus| (x y) `(the |SFlo| (- (the |SFlo| ,x) (the |SFlo| ,y))))
+(defmacro |SFloTimes| (x y) `(the |SFlo| (* (the |SFlo| ,x) (the |SFlo| ,y))))
+(defmacro |SFloTimesPlus| (x y z)
+  `(the |SFlo| (+ (* (the |SFlo| ,x) (the |SFlo| ,y)) (the |SFlo| ,z))))
+(defmacro |SFloDivide|	(x y) `(the |SFlo| (/ (the |SFlo| ,x) (the |SFlo| ,y))))
+(defmacro |SFloRPlus|  (x y r) `(error "unimplemented operation -- SFloRPlus"))
+(defmacro |SFloRMinus| (x y r) `(error "unimplemented operation -- SFloRTimes"))
+(defmacro |SFloRTimes| (x y r) `(error "unimplemented operation -- SFloRTimes"))
+(defmacro |SFloRTimesPlus| (x y z r) `(error "unimplemented operation -- SFloTimesPlus"))
+(defmacro |SFloRDivide|(x y r) `(error "unimplemented operation -- SFloDivide"))
+(defmacro |SFloDissemble| (x) `(error "unimplemented operation -- SFloDissemble"))
+(defmacro |SFloAssemble| (w x y) `(error "unimplemented operation -- SFloAssemble"))
+
+;; These are no longer foam builtins
+;;(defmacro |SFloRound|    (x) `(the |BInt| (round (the |SFlo| ,x))))
+;;(defmacro |SFloTruncate| (x) `(the |BInt| (truncate (the |SFlo| ,x))))
+;;(defmacro |SFloFloor|    (x) `(the |BInt| (floor (the |SFlo| ,x))))
+;;(defmacro |SFloCeiling|  (x) `(the |BInt| (ceiling (the |SFlo| ,x))))
+
+(defmacro |DFlo0|         () 0.0d0)
+(defmacro |DFlo1|         () 1.0d0)
+(defmacro |DFloMin|       () most-negative-long-float)
+(defmacro |DFloMax|       () most-positive-long-float)
+(defmacro |DFloEpsilon|   () long-float-epsilon)
+(defmacro |DFloIsZero|   (x) `(zerop (the |DFlo| ,x)))
+(defmacro |DFloIsNeg|    (x) `(minusp (the |DFlo| ,x)))
+(defmacro |DFloIsPos|    (x) `(plusp (the |DFlo| ,x)))
+(defmacro |DFloLE|     (x y) `(<= (the |DFlo| ,x) (the |DFlo| ,y)))
+(defmacro |DFloEQ|     (x y) `(= (the |DFlo| ,x) (the |DFlo| ,y)))
+(defmacro |DFloLT|     (x y) `(< (the |DFlo| ,x) (the |DFlo| ,y)))
+(defmacro |DFloNE|     (x y) `(/= (the |DFlo| ,x) (the |DFlo| ,y)))
+(defmacro |DFloNegate|   (x) `(the |DFlo| (- (the |DFlo| ,x))))
+(defmacro |DFloNext| 	 (x) `(the |DFlo| (+ (the |DFlo| ,x) 1.0d0)))
+(defmacro |DFloPrev|	 (x) `(the |DFlo| (- (the |DFlo| ,x) 1.0d0)))
+(defmacro |DFloPlus|   (x y) `(the |DFlo| (+ (the |DFlo| ,x) (the |DFlo| ,y))))
+(defmacro |DFloMinus|  (x y) `(the |DFlo| (- (the |DFlo| ,x) (the |DFlo| ,y))))
+(defmacro |DFloTimes|  (x y) `(the |DFlo| (* (the |DFlo| ,x) (the |DFlo| ,y))))
+(defmacro |DFloDivide| (x y) `(the |DFlo| (/ (the |DFlo| ,x) (the |DFlo| ,y))))
+(defmacro |DFloTimesPlus| (x y z)
+  `(the |DFlo| (+ (* (the |DFlo| ,x) (the |DFlo| ,y)) (the |DFlo| ,z))))
+
+(defmacro |DFloRPlus|  (x y r) `(error "unimplemented operation -- DFloRPlus"))
+(defmacro |DFloRMinus| (x y r) `(error "unimplemented operation -- DFloRTimes"))
+(defmacro |DFloRTimes| (x y r) `(error "unimplemented operation -- DFloRTimes"))
+(defmacro |DFloRTimesPlus| (x y z r) `(error "unimplemented operation -- DFloTimesPlus"))
+(defmacro |DFloRDivide|(x y r) `(error "unimplemented operation -- DFloDivide"))
+
+(defmacro |DFloDissemble| (x) `(error "unimplemented operation -- DFloDissemble"))
+(defmacro |DFloAssemble| (w x y z) `(error "unimplemented operation -- DFloAssemble"))
+
+;; Not builtins anymore
+;;(defmacro |DFloRound|    (x) `(the |BInt| (round (the |DFlo| ,x))))
+;;(defmacro |DFloTruncate| (x) `(the |BInt| (truncate (the |DFlo| ,x))))
+;;(defmacro |DFloFloor|    (x) `(the |BInt| (floor (the |DFlo| ,x))))
+;;(defmacro |DFloCeiling|  (x) `(the |BInt| (ceiling (the |DFlo| ,x))))
+
+(defmacro |Byte0|         () 0)
+(defmacro |Byte1|         () 1)
+(defmacro |ByteMin|       () 0)
+(defmacro |ByteMax|       () 255)
+
+(defmacro |HInt0|         () 0)
+(defmacro |HInt1|         () 1)
+(defmacro |HIntMin|       () #.(- (expt 2 15)))
+(defmacro |HIntMax|       () #.(1- (expt 2 15)))
+
+(defmacro |SInt0|         () 0)
+(defmacro |SInt1|         () 1)
+(defmacro |SIntMin|       () `(the |SInt| most-negative-fixnum))
+(defmacro |SIntMax|       () `(the |SInt| most-positive-fixnum))
+(defmacro |SIntIsZero|   (x) `(zerop (the |SInt| ,x)))
+(defmacro |SIntIsNeg|    (x) `(minusp (the |SInt| ,x)))
+(defmacro |SIntIsPos|    (x) `(plusp (the |SInt| ,x)))
+(defmacro |SIntIsEven|   (x) `(evenp (the |SInt| ,x)))
+(defmacro |SIntIsOdd|    (x) `(oddp (the |SInt| ,x)))
+(defmacro |SIntLE|     (x y) `(<= (the |SInt| ,x) (the |SInt| ,y)))
+(defmacro |SIntEQ|     (x y) `(= (the |SInt| ,x) (the |SInt| ,y)))
+(defmacro |SIntLT|     (x y) `(< (the |SInt| ,x) (the |SInt| ,y)))
+(defmacro |SIntNE|     (x y) `(/= (the |SInt| ,x) (the |SInt| ,y)))
+(defmacro |SIntNegate|   (x) `(the |SInt| (- (the |SInt| ,x))))
+(defmacro |SIntPrev|      (x) `(the |SInt| (1- (the |SInt| ,x))))
+(defmacro |SIntNext|      (x) `(the |SInt| (1+ (the |SInt| ,x))))
+(defmacro |SIntPlus|   (x y) `(the |SInt| (+ (the |SInt| ,x) (the |SInt| ,y))))
+(defmacro |SIntMinus|  (x y) `(the |SInt| (- (the |SInt| ,x) (the |SInt| ,y))))
+(defmacro |SIntTimes|  (x y) `(the |SInt| (* (the |SInt| ,x) (the |SInt| ,y))))
+(defmacro |SIntTimesPlus| (x y z)
+  `(the |SInt| (+ (* (the |SInt| ,x) (the |SInt| ,y)) (the |SInt| ,z))))
+(defmacro |SIntMod|    (x y) `(the |SInt| (mod(the |SInt| ,x)(the |SInt| ,y))))
+(defmacro |SIntQuo|    (x y)
+  `(the |SInt| (values (truncate (the |SInt| ,x) (the |SInt| ,y)))))
+(defmacro |SIntRem|    (x y) `(the |SInt| (rem(the |SInt| ,x)(the |SInt| ,y))))
+;;! declare all let variables
+(defmacro |SIntDivide| (x y) `(truncate (the |SInt| ,x) (the |SInt| ,y)))
+(defmacro |SIntGcd|  (x y) `(the |SInt| (gcd (the |SInt| ,x) (the |SInt| ,y))))
+
+(defmacro |SIntPlusMod|  (a b c)
+  `(the |SInt| (mod (+ (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
+(defmacro |SIntMinusMod| (a b c)
+  `(the |SInt| (mod (- (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
+(defmacro |SIntTimesMod| (a b c)
+  `(the |SInt| (mod (* (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c))))
+;; |SIntTimesModInv|
+(defmacro |SIntLength|  (x) `(the |SInt| (integer-length (the |SInt| ,x))))
+(defmacro |SIntShiftUp| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| ,y))))
+(defmacro |SIntShiftDn| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| (- (the |SInt| ,y))))))
+
+(defmacro |SIntBit|   (x i)
+  `(let ((xx ,x) (ii ,i)) (declare (type |SInt| xx ii)) (logbitp ii xx)))
+(defmacro |SIntNot|     (a) `(the |SInt| (lognot (the |SInt| ,a))))
+(defmacro |SIntAnd|   (a b)
+  `(the |SInt| (logand (the |SInt| ,a) (the |SInt| ,b))))
+(defmacro |SIntOr|    (a b)
+  `(the |SInt| (logior (the |SInt| ,a) (the |SInt| ,b))))
+
+;; WordTimesDouble
+;; WordDivideDouble
+;; WordPlusStep
+;; WordTimesStep
+
+(defmacro |SIntSIPower| (x y)
+  `(let ((xx ,x) (yy ,y))
+     (declare (type |SInt| xx yy))
+     (if (minusp yy) (error "cannot raise integers to negative powers")
+       (the |SInt| (expt xx yy)))))
+(defmacro |SIntBIPower| (x y)
+  `(let ((xx ,x) (yy ,y))
+     (declare (type |SInt| xx))
+     (declare (type |BInt| yy))
+     (if (minusp yy) (error "cannot raise integers to negative powers")
+       (the |SInt| (expt xx yy)))))
+
+(defmacro |BInt0|        () 0)
+(defmacro |BInt1|        () 1)
+(defmacro |BIntIsZero|  (x) `(zerop (the |BInt| ,x)))
+(defmacro |BIntIsNeg|   (x) `(minusp(the |BInt| ,x)))
+(defmacro |BIntIsPos|   (x) `(plusp (the |BInt| ,x)))
+(defmacro |BIntIsEven|  (x) `(evenp (the |BInt| ,x)))
+(defmacro |BIntIsOdd|   (x) `(oddp  (the |BInt| ,x)))
+(defmacro |BIntIsSingle| (x) `(typep ,x '|SInt|))
+(defmacro |BIntLE|    (x y) `(<= (the |BInt| ,x) (the |BInt| ,y)))
+(defmacro |BIntEQ|    (x y) `(=  (the |BInt| ,x) (the |BInt| ,y)))
+(defmacro |BIntLT|    (x y) `(<  (the |BInt| ,x) (the |BInt| ,y)))
+(defmacro |BIntNE|    (x y) `(/= (the |BInt| ,x) (the |BInt| ,y)))
+(defmacro |BIntNegate|  (x) `(the |BInt| (-   (the |BInt| ,x))))
+(defmacro |BIntPrev|     (x) `(the |BInt| (1-  (the |BInt| ,x))))
+(defmacro |BIntNext|     (x) `(the |BInt| (1+  (the |BInt| ,x))))
+(defmacro |BIntPlus|  (x y) `(the |BInt| (+ (the |BInt| ,x) (the |BInt| ,y))))
+(defmacro |BIntMinus| (x y) `(the |BInt| (- (the |BInt| ,x) (the |BInt| ,y))))
+(defmacro |BIntTimes| (x y) `(the |BInt| (* (the |BInt| ,x) (the |BInt| ,y))))
+(defmacro |BIntTimesPlus| (x y z)
+  `(the |BInt| (+ (* (the |BInt| ,x) (the |BInt| ,y)) (the |BInt| ,z))))
+(defmacro |BIntMod|   (x y) `(the |BInt| (mod(the |BInt| ,x)(the |BInt| ,y))))
+(defmacro |BIntQuo|   (x y)
+  `(the |BInt| (values (truncate (the |BInt| ,x) (the |BInt| ,y)))))
+(defmacro |BIntRem|   (x y)
+  `(the |BInt| (rem (the |BInt| ,x) (the |BInt| ,y))))
+(defmacro |BIntDivide| (x y) `(truncate (the |BInt| ,x) (the |BInt| ,y)))
+(defmacro |BIntGcd|   (x y)
+  `(the |BInt| (gcd (the |BInt| ,x) (the |BInt| ,y))))
+(defmacro |BIntSIPower| (x y)
+  `(let ((xx ,x) (yy ,y))
+     (declare (type |BInt| xx))
+     (declare (type |SInt| yy))
+     (if (minusp yy) (error "cannot raise integers to negative powers")
+       (the |BInt| (expt xx yy)))))
+(defmacro |BIntBIPower| (x y)
+  `(let ((xx ,x) (yy ,y))
+     (declare (type |BInt| xx))
+     (declare (type |BInt| yy))
+     (if (minusp yy) (error "cannot raise integers to negative powers")
+       (the |BInt| (expt xx yy)))))
+(defmacro |BIntLength|  (x) `(the |SInt| (integer-length (the |BInt| ,x))))
+(defmacro |BIntShiftUp| (x y) `(the |BInt| (ash (the |BInt| ,x)(the |SInt| ,y))))
+(defmacro |BIntShiftDn| (x y) `(the |BInt| (ash (the |BInt| ,x) (the |SInt| (- (the |SInt| ,y))))))
+
+(defmacro |BIntBit|   (x i)
+  `(let ((xx ,x) (ii ,i)) (declare (type |BInt| xx) (type |SInt| ii))
+	(logbitp ii xx)))
+;;(defmacro |BIntAbs|     (x) `(the |BInt| (abs (the |BInt| ,x))))
+
+(defmacro |PtrNil|      () ())
+(defmacro |PtrIsNil|   (x) `(NULL ,x))
+(defmacro |PtrEQ|    (x y) `(eq ,x ,y))
+(defmacro |PtrNE|    (x y) `(not (eq ,x ,y)))
+
+;; |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep|
+
+
+;;(defvar |FoamOutputString|
+;;  (make-array 80 :element-type 'string-char :adjustable t :fill-pointer 0))
+(defun |FormatNumber| (c arr i)
+  (setq str (format nil "~a" c))
+  (replace arr str :start1 i)
+;;  (incf i (fill-pointer |FoamOutputString|))
+;;  (if (> i (length arr)) (error "not enough space"))
+;;  (setf (fill-pointer |FoamOutputString|) 0)
+  (+ i (length str)))
+
+(defmacro |FormatSFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
+(defmacro |FormatDFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
+(defmacro |FormatSInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
+(defmacro |FormatBInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
+
+(set-syntax-from-char (code-char 0) #\space) ;;makes null char act like white space
+
+(defmacro |ScanSFlo| (arr i)
+  `(read-from-string ,arr nil (|SFlo0|)
+		     :start ,i :preserve-whitespace t))
+(defmacro |ScanDFlo| (arr i)
+  `(read-from-string ,arr nil (|DFlo0|)
+		     :start ,i :preserve-whitespace t))
+(defmacro |ScanSInt| (arr i)
+  `(parse-integer ,arr :start ,i :junk-allowed t))
+(defmacro |ScanBInt| (arr i)
+  `(parse-integer ,arr :start ,i :junk-allowed t))
+
+;; 18/8/93: Evil bug in genfoam---nil generated.
+(defmacro hacked-the (type x)
+  (if x `(the ,type ,x) `(the ,type 0)))
+
+(defmacro |ByteToSInt| (x) `(coerce (hacked-the |Byte| ,x) '|SInt|))
+(defmacro |BoolToSInt|  (x) `(if ,x 1 0))
+(defmacro |BIntToSInt| (x) `(hacked-the |SInt| ,x))
+(defmacro |SIntToBInt| (x) `(hacked-the |BInt| ,x))
+(defmacro |SIntToSFlo| (x) `(coerce (hacked-the |SInt| ,x) '|SFlo|))
+(defmacro |SIntToByte| (x) `(coerce (hacked-the |SInt| ,x) '|Byte|))
+(defmacro |SIntToHInt| (x) `(coerce (hacked-the |SInt| ,x) '|HInt|))
+(defmacro |SIntToDFlo| (x) `(coerce (hacked-the |SInt| ,x) '|DFlo|))
+(defmacro |BIntToSFlo| (x) `(coerce (hacked-the |BInt| ,x) '|SFlo|))
+(defmacro |BIntToDFlo| (x) `(coerce (hacked-the |BInt| ,x) '|DFlo|))
+(defmacro |ArrToSFlo|  (x) `(read-from-string ,x nil (|SFlo0|)))
+(defmacro |ArrToDFlo|  (x) `(read-from-string ,x nil (|DFlo0|)))
+(defmacro |ArrToSInt|  (x) `(read-from-string ,x nil (|SInt0|)))
+(defmacro |ArrToBInt|  (x) `(read-from-string ,x nil (|BInt0|)))
+
+(defmacro |Clos| (x y) `(let ((xx ,x) (yy #',y)) (cons yy xx)))
+(defmacro |ClosFun| (x) `(car ,x))
+(defmacro |ClosEnv| (x) `(cdr ,x))
+(defmacro |SetClosFun| (x y) `(rplaca ,x ,y))
+(defmacro |SetClosEnv| (x y) `(rplacd ,x ,y))
+
+(defmacro |MakeEnv| 	(x y) 
+  `(let ((xx ,x) (yy ,y)) (cons yy (cons xx nil))))
+
+(defmacro |EnvLevel|	(x)   `(car ,x))
+(defmacro |EnvNext|	(x)   `(cadr ,x))
+(defmacro |EnvInfo|	(x)   `(if (and (consp ,x) (consp (cdr ,x)))
+				   (cddr ,x) nil))
+(defmacro |SetEnvInfo|	(x val)   `(rplacd (cdr  ,x) ,val))
+
+#+:CCL
+(defmacro |FoamEnvEnsure| (e) 
+  `(let ((einf (|EnvInfo| ,e)))
+     (if einf (|CCall| einf) nil)))
+#-:CCL
+(defmacro |FoamEnvEnsure| (e) 
+  `(if (|EnvInfo| ,e) (|CCall| (|EnvInfo| ,e)) nil))
+
+(defconstant null-char-string (string (code-char 0)))
+(defmacro |MakeLit| (s) `(concatenate 'string ,s null-char-string))
+
+;; functions are represented by symbols, with the symbol-value being some
+;; information, and the symbol-function is the function itself.
+;; 1-valued lisp should represent progs as either a pair or defstruct.
+
+(defmacro |FunProg| (x) x)
+
+(defstruct FoamProgInfoStruct
+  (funcall nil :type function)
+  (hashval 0   :type |SInt|))
+
+(defun |ProgHashCode| (x)
+  (let ((aa (foam-function-info x)))
+    (if (null aa) 0
+      (FoamProgInfoStruct-hashval aa))))
+
+(defun |SetProgHashCode| (x y)
+  (let ((aa (foam-function-info x)))
+    (if (null aa) 0
+      (setf (FoamProgInfoStruct-hashval aa) y))))
+
+;; In a hurry -> O(n) lookup..
+(defvar foam-function-list ())
+
+(defun alloc-prog-info (fun val)
+  (setq foam-function-list (cons (cons fun val) foam-function-list)))
+
+(defun foam-function-info (fun)
+  (let ((xx (assoc fun foam-function-list)))
+    (if (null xx) nil
+      (cdr xx))))
+
+;; Accessors and constructors
+(defmacro |DDecl| (name &rest args)
+  (setf (get name 'struct-args) args)
+  `(defstruct ,name ,@(insert-types args)))
+
+(defun insert-types (slots)
+  (mapcar #'(lambda (slot)
+	      `(,(car slot) ,(type2init (cadr slot))
+		:type ,(cadr slot)))
+	  slots))
+
+(defmacro |RNew| (name)
+  (let* ((struct-args (get name 'struct-args))
+	 (init-args (mapcar #'(lambda (x) (type2init (cadr x)))
+			    struct-args))
+	 (count (length struct-args)))
+    (cond ((> count 2) `(vector ,@init-args))
+	  ((= count 2) `(cons ,@init-args))
+	  (t `(list ,@init-args)))))
+
+(defmacro |RElt| (name field index rec)
+  (let ((count (length (get name 'struct-args))))
+    (cond ((> count 2) `(svref ,rec ,index))
+	  ((= count 2)
+	   (if (zerop index) `(car ,rec) `(cdr ,rec)))
+	  (t `(car ,rec)))))
+
+(defmacro |SetRElt| (name field index rec val)
+  (let ((count (length (get name 'struct-args))))
+    (cond ((> count 2) `(setf (svref ,rec ,index) ,val))
+	  ((= count 2)
+	   (if (zerop index) `(rplaca ,rec ,val) `(rplacd ,rec ,val)))
+	  (t `(rplaca ,rec ,val)))))
+
+(defmacro |AElt| (name index)
+  `(aref ,name ,index))
+
+(defmacro |SetAElt| (name index val)
+  `(setf (aref ,name ,index) ,val))
+
+(defmacro |MakeLevel| (builder struct)
+  (if (get struct 'struct-args)
+      `(,builder)
+    'nil))
+
+
+(defmacro |EElt| (accessor n var)
+  `(,accessor ,var))
+
+(defmacro |SetEElt| (accessor n var val)
+  `(setf (,accessor ,var) ,val))
+
+(defmacro |Lex| (accessor n var)
+  `(,accessor ,var))
+
+(defmacro |SetLex| (accessor n var val)
+  `(progn ;; (print ',accessor)
+	  (setf (,accessor ,var) ,val)))
+
+;; Atomic arguments for fun don't need a let to hold the fun.
+;; CCall's with arguments need a let to hold the prog and the env.
+(defmacro |CCall| (fun &rest args)
+  (cond ((and (atom fun) (null args))
+	 `(funcall (|FunProg| (|ClosFun| ,fun)) (|ClosEnv| ,fun)))
+	((null args)
+	 `(let ((c ,fun))
+	    (funcall (|FunProg| (|ClosFun| c)) (|ClosEnv| c))))
+	((atom fun)
+	 `(let ((fun (|FunProg| (|ClosFun| ,fun)))
+		(env (|ClosEnv| ,fun)))
+	    (funcall fun ,@args env)))
+	(t
+	 `(let ((c ,fun))
+	    (let ((fun (|FunProg| (|ClosFun| c)))
+		  (env (|ClosEnv| c)))
+	      (funcall fun ,@args env))))))
+
+(defmacro |FoamFree| (o) '())
+
+;; macros for defining things
+
+(defmacro declare-prog (name-result params)
+  `(proclaim '(function ,(car name-result) ,params ,@(cdr name-result))))
+
+(defmacro declare-type (name type)
+  `(proclaim '(type ,name ,type)))
+
+(defmacro defprog (type temps &rest body)
+  `(progn (defun ,(caar type) ,(mapcar #'car (cadr type))
+	    (typed-let ,temps ,@body))
+	  (alloc-prog-info #',(caar type) (make-FoamProgInfoStruct))))
+
+(defmacro defspecials (&rest lst)
+  `(proclaim '(special ,@lst)))
+
+(defmacro top-level-define (&rest junk)
+  `(setq ,@junk))
+
+;; Runtime macros
+
+;; control transfer
+(defmacro block-return (obj val)
+  `(return-from ,obj ,val))
+
+#-:CCL
+(defmacro typed-let (letvars &rest forms)
+  `(let ,(mapcar #'(lambda (var)
+		     (list (car var) (type2init (cadr var))))
+		 letvars )
+     (declare ,@(mapcar #'(lambda (var)
+			    (list 'type (cadr var) (car var)))
+			letvars))
+     ,@forms))
+
+#+:CCL
+(defmacro typed-let (letvars &rest forms)
+  `(let ,(mapcar #'(lambda (var) (car var))
+		 letvars )
+     ,@forms))
+
+(defmacro cases (&rest junk)
+  `(case ,@junk))
+
+
+;;; Boot macros
+(defmacro file-exports (lst)
+  `(eval-when (load eval)
+	      (when (fboundp 'process-export-entry)
+		    (mapcar #'process-export-entry ,lst))
+	nil))
+
+(defmacro file-imports (lst)
+  `(eval-when (load eval)
+	      (when (fboundp 'process-import-entry)
+		    (mapcar #'process-import-entry ,lst))
+	nil))
+
+(defmacro ignore-var (var)
+  `(declare (ignore ,var)))
+
+(defmacro |ANew| (type size)
+  (if (eq type '|Char|)
+      `(make-string ,size)
+      `(make-array ,size
+	       :element-type ',type
+	       :initial-element ,(type2init type))))
+
+#-:CCL
+(defun type2init (x)
+  (cond
+   ((eq x '|Char|) '|CharInit|)
+   ((eq x '|Clos|) '|ClosInit|)
+   ((eq x '|Bool|) '|BoolInit|)
+   ((eq x '|Byte|) '|ByteInit|)
+   ((eq x '|HInt|) '|HIntInit|)
+   ((eq x '|SInt|) '|SIntInit|)
+   ((eq x '|BInt|) '|BIntInit|)
+   ((eq x '|SFlo|) '|SFloInit|)
+   ((eq x '|DFlo|) '|DFloInit|)
+   ((eq x '|Ptr|) '|PtrInit|)
+   ((eq x '|Word|) '|WordInit|)
+   ((eq x '|Arr|) '|ArrInit|)
+   ((eq x '|Record|) '|RecordInit|)
+   ((eq x '|Arb|) '|ArbInit|)
+   ((eq x '|Env|) '|EnvInit|)
+   ((eq x '|Level|) '|LevelInit|)
+   ((eq x '|Nil|) nil)
+   (t nil)))
+
+#+:CCL
+(defun type2init (x) nil)
+
+;; opsys interface
+(defvar |G-mainArgc| 0)
+(defvar |G-mainArgv| (vector))
+(defmacro |stdinFile| () '*standard-input*)
+(defmacro |stdoutFile| () '*standard-output*)
+(defmacro |stderrFile| () '*error-output*)
+
+;; Format functions
+;needs to stop when it gets a null character
+(defun |strLength| (s)
+  (dotimes (i (length s))
+	   (let ((c (schar s i)))
+	     (if (char= c |CharCode0|)
+		 (return i))))
+  (length s))
+
+(defun |formatSInt| (n) (format nil "~D" n))
+(defun |formatBInt| (n) (format nil "~D" n))
+(defun |formatSFloat| (x) (format nil "~G" x))
+(defun |formatDFloat| (x) (format nil "~G" x))
+
+
+;; Printing functions
+(defun |printNewLine| (cs) (terpri cs))
+(defun |printChar|  (cs c) (princ c cs))
+
+;needs to stop when it gets a null character
+(defun |printString| (cs s)
+  (dotimes (i (length s))
+	   (let ((c (schar s i)))
+	     (if (char= c |CharCode0|)
+		 (return i)
+	       (princ c cs)))))
+
+(defun |printSInt| (cs n) (format cs "~D" n))
+(defun |printBInt| (cs n) (format cs "~D" n))
+(defun |printSFloat| (cs x) (format cs "~G" x))
+(defun |printDFloat| (cs x) (format cs "~G" x))
+
+(defun |fputc| (si cs)
+  (|printChar| cs (code-char si))
+  si)
+
+(defun |fputs| (s cs)
+  (|printString| cs s))
+
+;; read a string into s starting at pos i1, ending at i2
+;; we should probably macro-out cases where args are constant
+
+;; fill s[i1..i2] with a null terminated string read from
+;; the given input stream
+(defun |fgetss| (s i1 i2 f)
+  (labels ((aux (n)
+		(if (= n i2)
+		    (progn (setf (schar s n) (code-char 0))
+			   (- n i1))
+		  (let ((c (read-char f)))
+		    (setf (schar s n) c)
+		    (if (equal c #\newline)
+			(progn (setf (char s (+ n 1)) (code-char 0))
+			       (- n i1))
+		      (aux (+ n 1)))))))
+	  (aux i1)))
+		
+;; write s[i1..i2) to the output stream f
+;; stop on any null characters
+
+(defun |fputss| (s i1 i2 f)
+  (labels ((aux (n)
+		(if (= n i2) (- n i1)
+		  (let ((c (schar s n)))
+		    (if  (equal (code-char 0) c)
+			 (- n i1)
+		      (progn (princ c f)	
+			     (aux (+ n 1))))))))
+	  (setq i2 (if (minusp i2) (|strLength| s)
+		     (min i2 (|strLength| s))))
+	  (aux i1)))
+
+;; function for compiling and loading from lisp
+
+(defun compile-as-file (file &optional (opts nil))
+  (let* ((path (pathname file))
+	 (name (pathname-name path))
+	 (dir (pathname-directory path))
+	 (type (pathname-type path))
+	 (lpath (make-pathname :name name :type "l"))
+	 (cpath (make-pathname :name name :type "o")))
+    (if (null type)
+	(setq path (make-pathname :directory dir :name name :type "as")))
+    (if opts
+	(system (format nil "axiomxl ~A -Flsp ~A" opts (namestring path)))
+	(system (format nil "axiomxl -Flsp ~A" (namestring path))))
+    (compile-file (namestring lpath))
+    (load (namestring cpath))))
+
+
+;; given the name of a file (a string), return the name of the AXIOM-XL function
+;; that initialises the file.
+(defun axiomxl-file-init-name (filename)
+  (intern (format nil "G-~a" (string-downcase filename)) 'foam-user))
+
+;; given the name of the file, id name, and hashcode, return the
+;; AXIOM-XL identifier for that object
+
+(defun axiomxl-global-name (file id hashcode)
+  (intern (format nil "G-~a_~a_~9,'0d" (string-downcase file) id hashcode) 'foam-user))
+
+;; double float elementary functions
+(defmacro |sqrt| (x) `(sqrt ,x))
+(defmacro |pow| (a b) `(expt ,a ,b))
+(defmacro |log| (a)  `(log ,a))
+(defmacro |exp| (a) `(exp ,a))
+
+(defmacro |sin| (a) `(sin ,a))
+(defmacro |cos| (a) `(cos ,a))
+(defmacro |tan| (a) `(tan ,a))
+
+(defmacro |sinh| (a) `(sinh ,a))
+(defmacro |cosh| (a) `(cosh ,a))
+(defmacro |tanh| (a) `(tanh ,a))
+
+(defmacro |asin| (a) `(asin ,a))
+(defmacro |acos| (a) `(acos ,a))
+(defmacro |atan| (a) `(atan ,a))
+(defmacro |atan2| (a b) `(atan ,a ,b))
+
+(defun |Halt| (n) 
+  (error (cond ((= n 101) "System Error: Unfortunate use of dependant type")
+	       ((= n 102) "User error: Reached a 'never'")
+	       ((= n 103) "User error: Bad union branch")
+	       ((= n 104) "User error: Assertion failed")
+	       (t (format nil "Unknown halt condition ~a" n)))))
+;; debuging
+(defvar *foam-debug-var* nil)
+(defun |fiGetDebugVar| () *foam-debug-var*)
+
+(defun |fiSetDebugVar| (x) (setq *foam-debug-var* x))
+(defun |fiSetDebugger| (x y) ())
+(defun |fiGetDebugger| (x) ())
+
+;; Output ports
+(setq |G-stdoutVar| t)
+(setq |G-stdinVar| t)
+(setq |G-stderrVar| t)
+
+;; !! Not portable !!
+(defun foam::|fiStrHash| (x) (boot::|hashString| (subseq x 0 (- (length x) 1))))
+
+;; These three functions check that two cons's contain identical entries.
+;; We use EQL to test numbers and EQ everywhere else.  If the structure 
+;; of the two items is different, or any elements are different, we
+;; return false.
+(defmacro |politicallySound| (u v) 
+ `(or (eql ,u ,v) (eq ,u ,v)))
+
+(defun |PtrMagicEQ| (u v) 
+;; I find (as-eg4) that these buggers can be numbers 
+ (cond ( (or (NULL u) (NULL v)) nil)
+       ( (and (ATOM u) (ATOM v)) (eql u v))
+       ( (or (ATOM u) (ATOM v)) nil)
+;; removed for Aldor integration
+;;       ( (equal (length u) (length v)) (|magicEq1| u v)) 
+       (t (eq u v) )))
+
+(defun |magicEq1| (u v)
+ (cond ( (and (atom u) (atom v)) (|politicallySound| u v))
+       ( (or (atom u) (atom v)) nil)
+       ( (|politicallySound| (car u) (car v)) (|magicEq1| (cdr u) (cdr v)))
+       nil ))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/format.boot.pamphlet b/src/interp/format.boot.pamphlet
new file mode 100644
index 00000000..e4c83a31
--- /dev/null
+++ b/src/interp/format.boot.pamphlet
@@ -0,0 +1,802 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp format.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Functions for display formatting system objects
+
+-- some of these are redundant and should be compacted
+$formatSigAsTeX := 1
+
+--% Formatting modemaps
+
+sayModemap m ==
+  -- sayMSG formatModemap displayTranModemap m
+  sayMSG formatModemap old2NewModemaps displayTranModemap m
+
+sayModemapWithNumber(m,n) ==
+  msg := reverse cleanUpSegmentedMsg reverse ["%i","%i",'" ",
+    STRCONC(lbrkSch(),object2String n,rbrkSch()),
+      :formatModemap displayTranModemap m,"%u","%u"]
+  sayMSG flowSegmentedMsg(reverse msg,$LINELENGTH,3)
+
+displayOpModemaps(op,modemaps) ==
+  TERPRI()
+  count:= #modemaps
+  phrase:= (count=1 => 'modemap;'modemaps)
+  sayMSG ['%b,count,'%d,phrase,'" for",'%b,op,'%d,'":"]
+  for modemap in modemaps repeat sayModemap modemap
+
+displayTranModemap (mm is [[x,:sig],[pred,:y],:z]) ==
+  -- The next 8 lines are a HACK to deal with the "partial" definition
+  -- JHD/RSS
+  if pred is ['partial,:pred'] then
+    [b,:c]:=sig
+    sig:=[['Union,b,'"failed"],:c]
+    mm:=[[x,:sig],[pred',:y],:z]
+  else if pred = 'partial then
+    [b,:c]:=sig
+    sig:=[['Union,b,'"failed"],:c]
+    mm:=[[x,:sig],y,:z]
+  mm' := EQSUBSTLIST('(m n p q r s t i j k l),
+    MSORT listOfPredOfTypePatternIds pred,mm)
+  EQSUBSTLIST('(D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14),
+    MSORT listOfPatternIds [sig,[pred,:y]],mm')
+
+listOfPredOfTypePatternIds p ==
+  p is ['AND,:lp] or p is ['OR,:lp] =>
+    UNIONQ([:listOfPredOfTypePatternIds p1 for p1 in lp],NIL)
+  p is [op,a,.] and op = 'ofType =>
+    isPatternVar a => [a]
+    nil
+  nil
+
+removeIsDomains pred ==
+  pred is ['isDomain,a,b] => true
+  pred is ['AND,:predl] =>
+    MKPF([x for x in predl | x isnt ['isDomain,:.]],'AND)
+  pred
+
+canRemoveIsDomain? pred ==
+  -- returns nil OR an alist for substitutions of domains ordered so that
+  -- after substituting for each pair in turn, no left-hand names remain
+  alist :=
+    pred is ['isDomain,a,b] => [[a,:b],:alist]
+    pred is ['AND,:predl] =>
+      [[a,:b] for pred in predl | pred is ['isDomain,a,b]]
+  findSubstitutionOrder? alist
+
+findSubstitutionOrder? alist == fn(alist,nil) where
+  -- returns NIL or an appropriate substituion order
+  fn(alist,res) ==
+    null alist => NREVERSE res
+    choice := or/[x for (x:=[a,:b]) in alist | null containedRight(a,alist)] =>
+      fn(delete(choice,alist),[choice,:res])
+    nil
+
+containedRight(x,alist)== or/[CONTAINED(x,y) for [.,:y] in alist]
+
+removeIsDomainD pred ==
+  pred is ['isDomain,'D,D] =>
+    [D,nil]
+  pred is ['AND,:preds] =>
+    D := nil
+    for p in preds while not D repeat
+      p is ['isDomain,'D,D1] =>
+        D := D1
+        npreds := delete(['isDomain,'D,D1],preds)
+    D =>
+      1 = #npreds => [D,first npreds]
+      [D,['AND,:npreds]]
+    nil
+  nil
+
+formatModemap modemap ==
+  [[dc,target,:sl],pred,:.]:= modemap
+  if alist := canRemoveIsDomain? pred then
+    dc:= substInOrder(alist,dc)
+    pred:= substInOrder(alist,removeIsDomains pred)
+    target:= substInOrder(alist,target)
+    sl:= substInOrder(alist,sl)
+  else if removeIsDomainD pred is [D,npred] then
+    pred := SUBST(D,'D,npred)
+    target := SUBST(D,'D,target)
+    sl := SUBST(D,'D,sl)
+  predPart:= formatIf pred
+  targetPart:= prefix2String target
+  argTypeList:=
+    null sl => nil
+    concat(prefix2String first sl,fn(rest sl)) where
+      fn l ==
+        null l => nil
+        concat(",",prefix2String first l,fn rest l)
+  argPart:=
+    #sl<2 => argTypeList
+    ['"_(",:argTypeList,'"_)"]
+  fromPart:=
+    if dc = 'D and D
+      then concat('%b,'"from",'%d,prefix2String D)
+      else concat('%b,'"from",'%d,prefix2String dc)
+  firstPart:= concat('" ",argPart,'" -> ",targetPart)
+  sayWidth firstPart + sayWidth fromPart > 74 => --allow 5 spaces for " [n]"
+    fromPart:= concat('" ",fromPart)
+    secondPart :=
+      sayWidth fromPart + sayWidth predPart < 75 =>
+        concat(fromPart,predPart)
+      concat(fromPart,'%l,predPart)
+    concat(firstPart,'%l,secondPart)
+  firstPart:= concat(firstPart,fromPart)
+  sayWidth firstPart + sayWidth predPart < 80 =>
+    concat(firstPart,predPart)
+  concat(firstPart,'%l,predPart)
+
+substInOrder(alist,x) ==
+  alist is [[a,:b],:y] => substInOrder(y,SUBST(b,a,x))
+  x
+
+reportOpSymbol op1 ==
+  op := (STRINGP op1 => INTERN op1; op1)
+  modemaps := getAllModemapsFromDatabase(op,nil)
+  null modemaps =>
+    ok := true
+    sayKeyedMsg("S2IF0010",[op1])
+    if SIZE PNAME op1 < 3 then
+      x := UPCASE queryUserKeyedMsg("S2IZ0060",[op1])
+      null MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
+        ok := nil
+        sayKeyedMsg("S2IZ0061",[op1])
+    ok => apropos [op1]
+  sayNewLine()
+  -- filter modemaps on whether they are exposed
+  mmsE := mmsU := NIL
+  for mm in modemaps repeat
+    isFreeFunctionFromMm(mm) or isExposedConstructor getDomainFromMm(mm) => mmsE := [mm,:mmsE]
+    mmsU := [mm,:mmsU]
+  if mmsE then
+    sayMms(op,mmsE,'"exposed") where
+      sayMms(op,mms,label) ==
+        m := # mms
+        sayMSG
+          m = 1 =>
+            ['"There is one",:bright label,'"function called",
+              :bright op,'":"]
+          ['"There are ",m,:bright label,'"functions called",
+            :bright op,'":"]
+        for mm in mms for i in 1.. repeat
+          sayModemapWithNumber(mm,i)
+  if mmsU then
+    if mmsE then sayNewLine()
+    sayMms(op,mmsU,'"unexposed")
+  nil
+
+formatOpType (form:=[op,:argl]) ==
+  null argl => unabbrev op
+  form2String [unabbrev op, :argl]
+
+formatOperationAlistEntry (entry:= [op,:modemaps]) ==
+  -- alist has entries of the form: ((op sig) . pred)
+  -- opsig on this list => op is defined only when the predicate is true
+  ans:= nil
+  for [sig,.,:predtail] in modemaps repeat
+    pred := (predtail is [p,:.] => p; 'T)
+    -- operation is always defined
+    ans :=
+      [concat(formatOpSignature(op,sig),formatIf pred),:ans]
+  ans
+
+formatOperation([[op,sig],.,[fn,.,n]],domain) ==
+  opSigString := formatOpSignature(op,sig)
+  INTEGERP n and Undef = KAR domain.n =>
+    if INTEGERP $commentedOps then $commentedOps := $commentedOps + 1
+    concat(" --",opSigString)
+  opSigString
+
+formatOpSignature(op,sig) ==
+  concat('%b,formatOpSymbol(op,sig),'%d,": ",formatSignature sig)
+
+formatOpConstant op ==
+  concat('%b,formatOpSymbol(op,'($)),'%d,'": constant")
+
+formatOpSymbol(op,sig) ==
+  if op = 'Zero then op := "0"
+  else if op = 'One then op := "1"
+  null sig => op
+  quad := specialChar 'quad
+  n := #sig
+  (op = 'elt) and (n = 3) =>
+    (CADR(sig) = '_$) =>
+      STRINGP (sel := CADDR(sig)) =>
+        [quad,".",sel]
+      [quad,".",quad]
+    op
+  STRINGP op or GET(op,"Led") or GET(op,"Nud") =>
+    n = 3 =>
+      if op = 'SEGMENT then op := '".."
+      op = 'in => [quad,'" ",op,'" ",quad]
+-- stop exquo from being displayed as infix (since it is not accepted
+-- as such by the interpreter)
+      op = 'exquo => op
+      [quad,op,quad]
+    n = 2 =>
+      not GET(op,"Nud") => [quad,op]
+      [op,quad]
+    op
+  op
+
+formatAttribute x ==
+  atom x => ["  ",x]
+  x is [op,:argl] =>
+    for x in argl repeat
+      argPart:= NCONC(argPart,concat(",",formatAttributeArg x))
+    argPart => concat("  ",op,"_(",rest argPart,"_)")
+    ["  ",op]
+
+formatAttributeArg x ==
+  STRINGP x and x ='"*" => "_"*_""
+  atom x => formatOpSymbol (x,nil)
+  x is [":",op,["Mapping",:sig]] =>
+    concat('%b,formatOpSymbol(op,sig),": ",'%d,formatMapping sig)
+  prefix2String0 x
+
+formatMapping sig ==
+  "STRCONC"/concat("Mapping(",formatSignature sig,")")
+
+dollarPercentTran x ==
+    -- Translate $ to %. We actually return %% so that the message
+    -- printer will display a single %
+    x is [y,:z] =>
+        y1 := dollarPercentTran y
+        z1 := dollarPercentTran z
+        EQ(y, y1) and EQ(z, z1) => x
+        [y1, :z1]
+    x = "$" or x = '"$" => "%%"
+    x
+
+formatSignatureAsTeX sig == 
+  $formatSigAsTeX: local := 2
+  formatSignature0 sig
+
+formatSignature sig ==
+  $formatSigAsTeX: local := 1
+  formatSignature0 sig
+
+formatSignatureArgs sml ==
+  $formatSigAsTeX: local := 1
+  formatSignatureArgs0 sml
+  
+formatSignature0 sig ==
+  null sig => "() -> ()"
+  INTEGERP sig => '"hashcode"
+  [tm,:sml] := sig
+  sourcePart:= formatSignatureArgs0 sml
+  targetPart:= prefix2String0 tm
+  dollarPercentTran concat(sourcePart,concat(" -> ",targetPart))
+
+formatSignatureArgs0(sml) ==
+-- formats the arguments of a signature
+  null sml => ["_(_)"]
+  null rest sml => prefix2String0 first sml
+  argList:= prefix2String0 first sml
+  for m in rest sml repeat
+    argList:= concat(argList,concat(",",prefix2String0 m))
+  concat("_(",concat(argList,"_)"))
+
+--% Conversions to string form
+
+expr2String x ==
+  atom (u:= prefix2String0 x) => u
+  "STRCONC"/[atom2String y for y in u]
+
+-- exports (this is a badly named bit of sillyness)
+prefix2StringAsTeX form ==
+  form2StringAsTeX form
+
+prefix2String form ==
+  form2String form
+
+-- local version
+prefix2String0 form ==
+  form2StringLocal form
+
+--  SUBRP form => formWrapId BPINAME form
+--  atom form =>
+--    form=$EmptyMode or form=$quadSymbol => formWrapId specialChar 'quad
+--    STRINGP form => formWrapId form
+--    IDENTP form => 
+--      constructor? form => app2StringWrap(formWrapId form, [form])
+--      formWrapId form
+--    formWrapId STRINGIMAGE form
+
+form2StringWithWhere u ==
+  $permitWhere : local := true
+  $whereList: local := nil
+  s:= form2String u
+  $whereList => concat(s,'%b,'"where",'%d,"%i",$whereList,"%u")
+  s
+
+form2StringWithPrens form ==
+  null (argl := rest form) => [first form]
+  null rest argl => [first form,"(",first argl,")"]
+  form2String form
+
+formString u ==
+  x := form2String u
+  atom x => STRINGIMAGE x
+  "STRCONC"/[STRINGIMAGE y for y in x]
+
+form2String u == 
+  $formatSigAsTeX: local := 1
+  form2StringLocal u
+
+form2StringAsTeX u == 
+  $formatSigAsTeX: local := 2
+  form2StringLocal u
+
+form2StringLocal u ==
+--+
+  $NRTmonitorIfTrue : local := nil
+  $fortInts2Floats  : local := nil
+  form2String1 u
+
+constructorName con ==
+  $abbreviateTypes => abbreviate con
+  con
+
+form2String1 u ==
+  ATOM u => 
+    u=$EmptyMode or u=$quadSymbol => formWrapId specialChar 'quad
+    IDENTP u =>
+      constructor? u => app2StringWrap(formWrapId u, [u])
+      u
+    SUBRP u => formWrapId BPINAME u
+    STRINGP u => formWrapId u
+    WRITE_-TO_-STRING formWrapId u
+  u1 := u
+  op := CAR u
+  argl := CDR u
+  op='Join or op= 'mkCategory => formJoin1(op,argl)
+  $InteractiveMode and (u:= constructor? op) =>
+    null argl => app2StringWrap(formWrapId constructorName op, u1)
+    op = "NTuple"  => [ form2String1 first argl, "*"]
+    op = "Map"     => ["(",:formatSignature0 [argl.1,argl.0],")"]
+    op = 'Record => record2String(argl)
+    null (conSig := getConstructorSignature op) =>
+      application2String(constructorName op,[form2String1(a) for a in argl], u1)
+    ml := rest conSig
+    if not freeOfSharpVars ml then
+      ml:=SUBLIS([[pvar,:val] for pvar in $FormalMapVariableList
+        for val in argl], ml)
+    argl:= formArguments2String(argl,ml)
+      -- extra null check to handle mutable domain hack.
+    null argl => constructorName op
+    application2String(constructorName op,argl, u1)
+  op = "Mapping" => ["(",:formatSignature argl,")"]
+  op = "Record" => record2String(argl)
+  op = 'Union  =>
+    application2String(op,[form2String1 x for x in argl], u1)
+  op = ":" =>
+      null argl => [ '":" ]
+      null rest argl => [ '":", form2String1 first argl ]
+      formDecl2String(argl.0,argl.1)
+  op = "#" and PAIRP argl and LISTP CAR argl =>
+    STRINGIMAGE SIZE CAR argl
+  op = 'Join => formJoin2String argl
+  op = "ATTRIBUTE" => form2String1 first argl
+  op='Zero => 0
+  op='One => 1
+  op = 'AGGLST => tuple2String argl
+  op = 'BRACKET =>
+    argl' := form2String1 first argl
+    ["[",:(atom argl' => [argl']; argl'),"]"]
+  op = "SIGNATURE" =>
+     [operation,sig] := argl
+     concat(operation,": ",formatSignature sig)
+  op = 'COLLECT => formCollect2String argl
+  op = 'construct =>
+    concat(lbrkSch(),
+           tuple2String [form2String1 x for x in argl],rbrkSch())
+  op = "SEGMENT" =>
+    null argl => '".."
+    lo := form2String1 first argl
+    argl := rest argl
+    (null argl) or null (first argl) => [lo, '".."]
+    [lo, '"..", form2String1 first argl]
+  isBinaryInfix op => fortexp0 [op,:argl]
+  -- COMPILED_-FUNCTION_-P(op) => form2String1 coerceMap2E(u1,NIL)
+  application2String(op,[form2String1 x for x in argl], u1)
+
+formWrapId id == 
+  $formatSigAsTeX = 1 => id
+  $formatSigAsTeX = 2 => 
+    sep := '"`"
+    FORMAT(NIL,'"\verb~a~a~a",sep, id, sep)
+  error "Bad formatSigValue"
+
+formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where
+  fn(x,m) ==
+    x=$EmptyMode or x=$quadSymbol => specialChar 'quad
+    STRINGP(x) or IDENTP(x) => x
+    x is [ ='_:,:.] => form2String1 x
+    isValidType(m) and PAIRP(m) and
+      (GETDATABASE(first(m),'CONSTRUCTORKIND) = 'domain) =>
+        (x' := coerceInteractive(objNewWrap(x,m),$OutputForm)) =>
+          form2String1 objValUnwrap x'
+        form2String1 x
+    form2String1 x
+
+formDecl2String(left,right) ==
+  $declVar: local := left
+  whereBefore := $whereList
+  ls:= form2StringLocal left
+  rs:= form2StringLocal right
+  NE($whereList,whereBefore) and $permitWhere => ls
+  concat(form2StringLocal ls,'": ",rs)
+
+formJoin1(op,u) ==
+  if op = 'Join then [:argl,last] := u else (argl := nil; last := [op,:u])
+  last is [id,.,:r] and id in '(mkCategory CATEGORY) =>
+    $abbreviateJoin = true => concat(formJoin2 argl,'%b,'"with",'%d,'"...")
+    $permitWhere = true =>
+      opList:= formatJoinKey(r,id)
+      $whereList:= concat($whereList,"%l",$declVar,": ",
+        formJoin2 argl,'%b,'"with",'%d,"%i",opList,"%u")
+      formJoin2 argl
+    opList:= formatJoinKey(r,id)
+    suffix := concat('%b,'"with",'%d,"%i",opList,"%u")
+    concat(formJoin2 argl,suffix)
+  formJoin2 u
+
+formatJoinKey(r,key) ==
+  key = 'mkCategory =>
+    r is [opPart,catPart,:.] =>
+      opString :=
+        opPart is [='LIST,:u] =>
+          "append"/[concat("%l",formatOpSignature(op,sig),formatIf pred)
+            for [='QUOTE,[[op,sig],pred]] in u]
+        nil
+      catString :=
+        catPart is [='LIST,:u] =>
+          "append"/[concat("%l",'" ",form2StringLocal con,formatIf pred)
+            for [='QUOTE,[con,pred]] in u]
+        nil
+      concat(opString,catString)
+    '"?? unknown mkCategory format ??"
+  -- otherwise we have the CATEGORY form
+  "append"/[fn for x in r] where fn ==
+    x is ['SIGNATURE,op,sig] => concat("%l",formatOpSignature(op,sig))
+    x is ['ATTRIBUTE,a] => concat("%l",formatAttribute a)
+    x
+
+formJoin2 argl ==
+-- argl is a list of categories NOT containing a "with"
+  null argl => '""
+  1=#argl => form2StringLocal argl.0
+  application2String('Join,[form2StringLocal x for x in argl], NIL)
+
+formJoin2String (u:=[:argl,last]) ==
+  last is ["CATEGORY",.,:atsigList] =>
+    postString:= concat("_(",formTuple2String atsigList,"_)")
+    #argl=1 => concat(first argl,'" with ",postString)
+    concat(application2String('Join,argl, NIL)," with ",postString)
+  application2String('Join,u, NIL)
+
+formCollect2String [:itl,body] ==
+  ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"]
+
+formIterator2String x ==
+  x is ["STEP",y,s,.,:l] =>
+    tail:= (l is [f] => form2StringLocal f; nil)
+    concat("for ",y," in ",s,'"..",tail)
+  x is ["tails",y] => concat("tails ",formatIterator y)
+  x is ["reverse",y] => concat("reverse ",formatIterator y)
+  x is ["|",y,p] => concat(formatIterator y," | ",form2StringLocal p)
+  x is ["until",p] => concat("until ",form2StringLocal p)
+  x is ["while",p] => concat("while ",form2StringLocal p)
+  systemErrorHere "formatIterator"
+
+tuple2String argl ==
+  null argl => nil
+  string := first argl
+  if string in '("failed" "nil" "prime" "sqfr" "irred")
+    then string := STRCONC('"_"",string,'"_"")
+    else string :=
+      ATOM string => object2String string
+      [f x for x in string] where
+        f x ==
+          ATOM x => object2String x
+          -- [f CAR x,:f CDR x]
+          [f y for y in x]
+  for x in rest argl repeat
+    if x in '("failed" "nil" "prime" "sqfr" "irred") then
+      x := STRCONC('"_"",x,'"_"")
+    string:= concat(string,concat(",",f x))
+  string
+
+script2String s ==
+  null s => '""   -- just to be safe
+  if not PAIRP s then s := [s]
+  linearFormatForm(CAR s, CDR s)
+
+linearFormatName x ==
+  atom x => x
+  linearFormat x
+
+linearFormat x ==
+  atom x => x
+  x is [op,:argl] and atom op =>
+    argPart:=
+      argl is [a,:l] => [a,:"append"/[[",",x] for x in l]]
+      nil
+    [op,"(",:argPart,")"]
+  [linearFormat y for y in x]
+
+numOfSpadArguments id ==
+  char("*") = (s:= PNAME id).0 =>
+      +/[n for i in 1.. while INTEGERP (n:=PARSE_-INTEGER PNAME s.i)]
+  keyedSystemError("S2IF0012",[id])
+
+linearFormatForm(op,argl) ==
+  s:= PNAME op
+  indexList:= [PARSE_-INTEGER PNAME d for i in 1.. while
+    (DIGITP (d:= s.(maxIndex:= i)))]
+  cleanOp:= INTERN ("STRCONC"/[PNAME s.i for i in maxIndex..MAXINDEX s])
+  fnArgs:=
+    indexList.0 > 0 =>
+      concat('"(",formatArgList take(-indexList.0,argl),'")")
+    nil
+  if #indexList > 1 then
+    scriptArgs:= formatArgList take(indexList.1,argl)
+    argl := drop(indexList.1,argl)
+    for i in rest rest indexList repeat
+      subArglist:= take(i,argl)
+      argl:= drop(i,argl)
+      scriptArgs:= concat(scriptArgs,";",formatArgList subArglist)
+  scriptArgs:=
+    scriptArgs => concat(specialChar 'lbrk,scriptArgs, specialChar 'rbrk)
+    nil
+  l := [(STRINGP f => f; STRINGIMAGE f) for f in
+       concat(cleanOp,scriptArgs,fnArgs)]
+  "STRCONC"/l
+
+formatArgList l ==
+  null l => nil
+  acc:= linearFormat first l
+  for x in rest l repeat
+    acc:= concat(acc,",",linearFormat x)
+  acc
+
+formTuple2String argl ==
+  null argl => nil
+  string:= form2StringLocal first argl
+  for x in rest argl repeat
+    string:= concat(string,concat(",",form2StringLocal x))
+  string
+
+isInternalFunctionName(op) ==
+  (not IDENTP(op)) or (op = "*") or (op = "**") => NIL
+  (1 = SIZE(op':= PNAME op)) or (char("*") ^= op'.0) => NIL
+  -- if there is a semicolon in the name then it is the name of
+  -- a compiled spad function
+  null (e := STRPOS('"_;",op',1,NIL)) => NIL
+  (char(" ") = (y := op'.1)) or (char("*") = y) => NIL
+  table := MAKETRTTABLE('"0123456789",NIL)
+  s := STRPOSL(table,op',1,true)
+  null(s) or s > e => NIL
+  SUBSTRING(op',s,e-s)
+
+application2String(op,argl, linkInfo) ==
+  null argl =>
+    (op' := isInternalFunctionName(op)) => op'
+    app2StringWrap(formWrapId op, linkInfo)
+  1=#argl =>
+    first argl is ["<",:.] => concat(op,first argl)
+    concat(app2StringWrap(formWrapId op, linkInfo)," ",first argl)
+--op in '(UP SM) =>
+--  newop:= (op = "UP" => "P";"M")
+--  concat(newop,concat(lbrkSch(),argl.0,rbrkSch(),argl.1))
+--op='RM  =>concat("M",concat(lbrkSch(),
+--                     argl.0,",",argl.1,rbrkSch(),argl.2))
+--op='MP =>concat("P",concat(argl.0,argl.1))
+  op='SEGMENT =>
+    null argl => '".."
+    (null rest argl) or (null first rest argl) =>
+      concat(first argl, '"..")
+    concat(first argl, concat('"..", first rest argl))
+  concat(app2StringWrap(formWrapId op, linkInfo) ,
+			concat("_(",concat(tuple2String argl,"_)")))
+
+app2StringConcat0(x,y) ==
+  FORMAT(NIL, '"~a ~a", x, y)
+
+app2StringWrap(string, linkInfo) ==
+  not linkInfo => string
+  $formatSigAsTeX = 1 => string
+  $formatSigAsTeX = 2 =>
+    str2 :=  "app2StringConcat0"/form2Fence linkInfo
+    sep := '"`"
+    FORMAT(NIL, '"\lispLink{\verb!(|conPage| '~a)!}{~a}", 
+          str2, string)
+  error "Bad value for $formatSigAsTeX"
+
+record2String x ==
+  argPart := NIL
+  for [":",a,b] in x repeat argPart:=
+    concat(argPart,",",a,": ",form2StringLocal b)
+  null argPart => '"Record()"
+  concat("Record_(",rest argPart,"_)")
+
+plural(n,string) ==
+  suffix:=
+    n = 1 => '""
+    '"s"
+  [:bright n,string,suffix]
+
+formatIf pred ==
+  not pred => nil
+  pred in '(T (QUOTE T)) => nil
+  concat('%b,'"if",'%d,pred2English pred)
+
+formatPredParts s ==
+  s is ['QUOTE,s1] => formatPredParts s1
+  s is ['LIST,:s1] => [formatPredParts s2 for s2 in s1]
+  s is ['devaluate,s1] => formatPredParts s1
+  s is ['getDomainView,s1,.] => formatPredParts s1
+  s is ['SUBST,a,b,c] =>    -- this is a signature
+    s1 := formatPredParts SUBST(formatPredParts a,b,c)
+    s1 isnt [fun,sig] => s1
+    ['SIGNATURE,fun,[formatPredParts(r) for r in sig]]
+  s
+
+pred2English x ==
+  x is ['IF,cond,thenClause,elseClause] =>
+    c := concat('"if ",pred2English cond)
+    t := concat('" then ",pred2English thenClause)
+    e := concat('" else ",pred2English elseClause)
+    concat(c,t,e)
+  x is ['AND,:l] =>
+    tail:="append"/[concat(bright '"and",pred2English x) for x in rest l]
+    concat(pred2English first l,tail)
+  x is ['OR,:l] =>
+    tail:= "append"/[concat(bright '"or",pred2English x) for x in rest l]
+    concat(pred2English first l,tail)
+  x is ['NOT,l] =>
+    concat('"not ",pred2English l)
+  x is [op,a,b] and op in '(has ofCategory) =>
+    concat(pred2English a,'%b,'"has",'%d,form2String abbreviate b)
+  x is [op,a,b] and op in '(HasSignature HasAttribute HasCategory) =>
+    concat(prefix2String0 formatPredParts a,'%b,'"has",'%d,
+      prefix2String0 formatPredParts b)
+  x is [op,a,b] and op in '(ofType getDomainView) =>
+    if b is ['QUOTE,b'] then b := b'
+    concat(pred2English a,'": ",form2String abbreviate b)
+  x is [op,a,b] and op in '(isDomain domainEqual) =>
+    concat(pred2English a,'" = ",form2String abbreviate b)
+  x is [op,:.] and (translation := LASSOC(op,'(
+    (_< . " < ") (_<_= . " <= ")
+      (_> . " > ") (_>_= . " >= ") (_=  . " = ") (_^_= . " _^_= ")))) =>
+        concat(pred2English a,translation,pred2English b)
+  x is ['ATTRIBUTE,form] =>
+    concat("attribute: ",form2String form)
+  form2String x
+
+object2String x ==
+  STRINGP x => x
+  IDENTP x  => PNAME x
+  NULL x    => '""
+  PAIRP  x  => STRCONC(object2String first x, object2String rest x)
+  WRITE_-TO_-STRING x
+
+object2Identifier x ==
+  IDENTP x  => x
+  STRINGP x => INTERN x
+  INTERN WRITE_-TO_-STRING x
+
+blankList x == "append"/[[BLANK,y] for y in x]
+--------------------> NEW DEFINITION (see cformat.boot.pamphlet)
+pkey keyStuff ==
+    if not PAIRP keyStuff then keyStuff := [keyStuff]
+    allMsgs := ['" "]
+    while not null keyStuff repeat
+        dbN := NIL
+        argL := NIL
+        key := first keyStuff
+        keyStuff := IFCDR keyStuff
+        next := IFCAR keyStuff
+        while PAIRP next repeat
+            if CAR next = 'dbN then dbN := CADR next
+            else argL := next
+            keyStuff  := IFCDR keyStuff
+            next      := IFCAR keyStuff
+        oneMsg  := returnStLFromKey(key,argL,dbN)
+        allMsgs := ['" ", :NCONC (oneMsg,allMsgs)]
+    allMsgs
+
+string2Float s ==
+  -- takes a string, calls the parser on it and returns a float object
+  p := ncParseFromString s
+  p isnt [["$elt", FloatDomain, "float"], x, y, z] =>
+    systemError '"string2Float: did not get a float expression"
+  flt := getFunctionFromDomain("float", FloatDomain,
+    [$Integer, $Integer, $PositiveInteger])
+  SPADCALL(x, y, z, flt)
+
+
+
+form2Fence form == 
+  -- body of dbMkEvalable
+  [op, :.] := form
+  kind := GETDATABASE(op,'CONSTRUCTORKIND)
+  kind = 'category => form2Fence1 form
+  form2Fence1 mkEvalable form
+
+form2Fence1 x ==
+  x is [op,:argl] =>
+    op = 'QUOTE => ['"(QUOTE ",:form2FenceQuote first argl,'")"]
+    ['"(", FORMAT(NIL, '"|~a|", op),:"append"/[form2Fence1 y for y in argl],'")"]
+  IDENTP x => FORMAT(NIL, '"|~a|", x)
+--  [x]
+  ['"  ", x]
+
+form2FenceQuote x ==
+  NUMBERP x => [STRINGIMAGE x]
+  SYMBOLP x => [FORMAT(NIL, '"|~a|", x)]
+  atom    x => '"??"   
+  ['"(",:form2FenceQuote first x,:form2FenceQuoteTail rest x]
+
+form2FenceQuoteTail x ==
+  null x => ['")"]
+  atom x => ['" . ",:form2FenceQuote x,'")"]
+  ['" ",:form2FenceQuote first x,:form2FenceQuoteTail rest x]
+
+form2StringList u ==
+  atom (r := form2String u) => [r]
+  r
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/fortcall.boot.pamphlet b/src/interp/fortcall.boot.pamphlet
new file mode 100644
index 00000000..9513e313
--- /dev/null
+++ b/src/interp/fortcall.boot.pamphlet
@@ -0,0 +1,820 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp fortcall.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+makeFort(name,args,decls,results,returnType,aspInfo) ==
+  -- Create an executable Fortran file to call a given library function,
+  -- and a stub Axiom function to process its arguments.
+  -- the following is a list of objects for which values need not be
+  -- passed by the user.
+  dummies := [SECOND(u) for u in args | EQUAL(car u,0)]
+  args := [untangle2(u) for u in args] -- lose spad Union representation
+    where untangle2 u ==
+      atom (v := rest(u)) => v
+      first(v)
+  userArgs := [u for u in args | not member(u,dummies)]  -- Temporary
+  decls := [untangle(u) for u in decls] -- lose spad Union representation
+    where untangle u ==
+      [if atom(rest(v)) then rest(v) else _
+        [if atom(w) then w else rest(w) for w in rest(v)] for v in u]
+  makeFort1(name,args,userArgs,dummies,decls,results,returnType,aspInfo)
+
+makeFort1(name,args,userArgs,dummies,decls,results,returnType,aspInfo) ==
+  asps := [first(u) for u in aspInfo]
+  -- Now reorder the arguments so that all the scalars come first, so
+  -- that when we come to deal with arrays we know all the dimensions.
+  scalarArgs := [u for u in args | atom getFortranType(u,decls)]
+  arrayArgs := [u for u in args | not member(u,scalarArgs)]
+  orderedArgs := [:scalarArgs,:arrayArgs]
+  file := if $fortranDirectory then
+    STRCONC($fortranDirectory,"/",STRINGIMAGE name)
+  else
+    STRINGIMAGE name
+  makeFortranFun(name,orderedArgs,args,dummies,decls,results,file,
+                 $fortranDirectory,returnType,asps)
+  makeSpadFun(name,userArgs,orderedArgs,dummies,decls,results,returnType,asps,
+              aspInfo,file)
+  name
+
+makeFortranFun(name,args,fortranArgs,dummies,decls,results,file,dir,
+               returnType,asps) ==
+  -- Create a C file to call the library function, and compile it.
+  fp := MAKE_-OUTSTREAM(STRCONC(file,".c"))
+  writeCFile(name,args,fortranArgs,dummies,decls,results,returnType,asps,fp)
+  if null dir then dir := '"."
+  asps => SYSTEM STRCONC("cc -c ",file,".c ; mv ",file,".o ",dir)
+  SYSTEM STRCONC("cc ",file,".c -o ",file,".spadexe ",$fortranLibraries)
+
+writeCFile(name,args,fortranArgs,dummies,decls,results,returnType,asps,fp) ==
+  WRITE_-LINE('"#include <stdio.h>",fp)
+  WRITE_-LINE('"#include <sys/select.h>",fp)
+  WRITE_-LINE('"#include <rpc/rpc.h>",fp)
+  WRITE_-LINE('"#ifndef NULL",fp)
+  WRITE_-LINE('"#define NULL 0",fp)
+  WRITE_-LINE('"#endif  NULL",fp)
+  WRITE_-LINE('"#define MAX__ARRAY(x) (x ? x :  20000)",fp)
+  WRITE_-LINE('"#define CHECK(x) if (!x) {fprintf(stderr,_"xdr failed_"); exit(1);}",fp)
+  WRITE_-LINE('"void main()",fp)
+  WRITE_-LINE('"{",fp)
+  WRITE_-LINE('"  XDR xdrs;",fp)
+  WRITE_-LINE('"  {",fp)
+  if $addUnderscoreToFortranNames then
+    routineName := STRCONC(name,STRING(95))
+  else
+    routineName := name
+  -- If it is a function then give it somewhere to stick its result:
+  if returnType then
+    returnName := INTERN STRCONC(name,"__result")
+    wl(['"    ",getCType returnType,'" ",returnName,'",",routineName,'"();"],fp)
+  -- print out type declarations for the Fortran parameters, and build an
+  -- ordered list of pairs [<parameter> , <type>]
+  argList := nil
+  for a in args repeat
+    argList := [[a, getCType getFortranType(a,decls)], :argList]
+    printDec(SECOND first argList,a,asps,fp)
+  argList := nreverse argList;
+  -- read in the data
+  WRITE_-LINE('"    xdrstdio__create(&xdrs, stdin, XDR__DECODE);",fp)
+  for a in argList repeat
+    if LISTP SECOND a then writeMalloc(first a,first SECOND a,rest SECOND a,fp)
+    not MEMQ(first a,[:dummies,:asps]) => writeXDR(a,'"&xdrs",fp)
+  -- now call the Library routine.  FORTRAN names may have an underscore
+  -- appended.
+  if returnType then
+    wt(['"    ",returnName,'"="],fp)
+  else
+    wt(['"    "],fp)
+  wt([routineName,'"("],fp)
+  if first fortranArgs then
+    printCName(first fortranArgs,isPointer?(first fortranArgs,decls),asps,fp)
+  for a in rest fortranArgs repeat
+    PRINC('",",fp)
+    printCName(a,isPointer?(a,decls),asps,fp)
+  writeStringLengths(fortranArgs,decls,fp)
+  WRITE_-LINE('");",fp)
+  -- now export the results.
+  WRITE_-LINE('"    xdrstdio__create(&xdrs, stdout, XDR__ENCODE);",fp)
+  if returnType then
+    writeXDR([returnName,getCType returnType],'"&xdrs",fp)
+  for r in results repeat
+    writeXDR([r,getCType getFortranType(r,decls)],'"&xdrs",fp)
+  WRITE_-LINE('"    exit(0);",fp)
+  WRITE_-LINE('"  }",fp)
+  WRITE_-LINE('"}",fp)
+
+writeStringLengths(fortranArgs,decls,fp) ==
+  for a in fortranArgs repeat
+    if isString?(a,decls) then wt(['",&",a,'"__length"],fp)
+
+isString?(u,decls) ==
+  EQUAL(ty := getFortranType(u,decls),"character") or
+    LISTP(ty) and EQUAL(first ty,"character")
+
+isPointer?(u,decls) ==
+  ty := getFortranType(u,decls)
+  LISTP(ty) or ty in ["character","complex","double complex"]
+
+printCName(u,ispointer,asps,fp) ==
+  member(u,asps) =>
+    PRINC(u,fp)
+    if $addUnderscoreToFortranNames then PRINC(STRING(95),fp)
+  if not ispointer then PRINC('"&",fp)
+  PRINC(u,fp)
+
+getFortranType(u,decls) ==
+  -- find u in decls, return the given (Fortran) type.
+  result := nil
+  for d in decls repeat for dec in rest d repeat
+    atom(dec) and dec=u =>
+      return( result := first d )
+    LISTP(dec) and first(dec)=u =>
+      return( result := [first d,:rest dec] )
+  result => result
+  error ['"Undeclared Fortran parameter: ",u]
+
+getCType t ==
+  -- Return the equivalent C type.
+  LISTP(t) =>
+    --[if first(t)="character" then '"char" else getCType first t,:rest t]
+    first(t)="character" => ['"char",:rest t]
+    first(t)="complex" => ['"float",2,:rest t]
+    first(t)="double complex" =>  ['"double",2,:rest t]
+    [getCType first t,:rest t]
+  t="double" => '"double"
+  t="double precision" => '"double"
+  t="integer" => '"int"
+  t="real" => '"float"
+  t="logical" => '"int"
+  t="character" => ['"char",1]
+  t="complex" => ['"float",2] --'"Complex" -- we use our own typedef
+  t="double complex" =>  ['"double",2] --'"DComplex" -- we use our own typedef
+  error ['"Unrecognised Fortran type: ",t]
+
+XDRFun t ==
+  LISTP(ty := SECOND t) =>
+    if first(ty)='"char" then '"wrapstring" else '"array"
+  ty
+
+printDec(type,dec,asps,fp) ==
+  wt(['"    ",if LISTP(type) then first(type) else type,'" "],fp)
+  member(dec,asps) =>
+    if $addUnderscoreToFortranNames then
+      wl([dec,STRING(95),'"();"],fp)
+    else
+      wl([dec,'"();"],fp)
+  LISTP(type) =>
+    wl(['"*",dec,'" = NULL;"],fp)
+    wl(['"    u__int ",dec, '"__length = 0;"],fp)
+  type = '"char" =>
+    wl(['"*",dec,'" = NULL;"],fp)
+  wl([dec, '";"],fp)
+
+writeXDR(v,str,fp) ==
+  -- Generate the calls to the filters which will read from the temp
+  -- file.  The CHECK macro ensures that the translation worked.
+  underscore := STRING CHAR("__:",0) -- to avoid a compiler bug which won't
+                                     -- parse " ... __" properly.
+  wt(['"    CHECK(xdr",underscore, XDRFun(v), '"(", str, '",&", first(v)],fp)
+  if (LISTP (ty :=SECOND v)) and not EQUAL(first ty,'"char") then
+    wt(['",&",first(v),'"__length,MAX__ARRAY(",first(v),'"__length),"],fp)
+    wt(['"sizeof(",first(ty),'"),xdr",underscore,first ty],fp)
+  wl(['"));"],fp)
+
+prefix2Infix(l) ==
+  atom(l) => [l]
+  #l=2 => [first l,"(",:prefix2Infix SECOND l,")"]
+  #l=3 => ["(",:prefix2Infix SECOND l,first l,:prefix2Infix THIRD l,")"]
+  error '"Function in array dimensions with more than two arguments"
+
+writeMalloc(name,type,dims,fp) ==
+  -- Write out a malloc for array arguments
+  -- Need the size as well
+  wl(['"    ",name,'"__length=",prefix2Infix first dims,:[:["*",:prefix2Infix u]
+      for u in rest dims],'";"], fp)
+  type = '"char" =>
+    wl(['"    ",name,'"=(",type," *)malloc((1+",name,
+       '"__length)*sizeof(",type,'"));"],fp)
+  wl(['"    ",name,'"=(",type," *)malloc(",name,
+     '"__length*sizeof(",type,'"));"],fp)
+
+wl (l,fp) ==
+  for u in l repeat PRINC(u,fp)
+  TERPRI(fp)
+
+wt (l,fp) ==
+  for u in l repeat PRINC(u,fp)
+
+-- spadRecordType(v,decs) ==
+--   -- Build a lisp representation of the declaration of a spad record.
+--   -- This will be the returned type of the spad function which calls the
+--   -- Fortran code.
+--   ["Record",:[spadRecordType1(u,decs) for u in v]]
+-- 
+-- spadRecordType1(u,decls) ==
+--   -- Create a list of the form '( |:| u <spadTypeTTT u>)
+--   [":",u,spadTypeTTT getFortranType(u,decls)]
+
+spadTypeTTT u ==
+  -- Return the spad domain equivalent to the given Fortran type.
+  -- Changed by MCD 8/4/94 to reflect correct format for domains in 
+  -- current system.
+  LISTP u =>
+    first(u)="character" => ["String"]
+    first(u)="logical" and #u=2 => ["List",["Boolean"]]
+    first(u)="logical" => ["List",["List",["Boolean"]]]
+    #u=2 => ["Matrix",spadTypeTTT first u]
+    #u=3 => ["Matrix",spadTypeTTT first u]
+    #u=4 => ["ThreeDimensionalMatrix",spadTypeTTT first u]
+    error '"Can only handle one-, two- and three-dimensional matrices"
+  u = "double" => ["DoubleFloat"]
+  u = "double precision" => ["DoubleFloat"]
+  u = "real" => ["DoubleFloat"]
+  u = "integer" => ["Integer"]
+  u = "logical" => ["Boolean"]
+  u = "character" => ["String"]
+  u = "complex" => ["Complex",["DoubleFloat"]]
+  u = "double complex" => ["Complex",["DoubleFloat"]]
+  error ['"Unrecognised Fortran type: ",u]
+
+mkQuote l ==
+ [addQuote(u)for u in l] where
+    addQuote u ==
+      atom u => ['QUOTE,u]
+      ["construct",:[addQuote(v) for v in u]]
+
+makeLispList(l) ==
+  outputList := []
+  for u in l repeat
+    outputList := [:outputList, _
+                  if atom(u) then ['QUOTE,u] else [["$elt","Lisp","construct"],_
+                  :makeLispList(u)]]
+  outputList
+
+makeSpadFun(name,userArgs,args,dummies,decls,results,returnType,asps,aspInfo,
+            file) ==
+  -- Create an interpreter function for the user to call.
+
+  fType := ["List", ["Record" , [":","key","Symbol"], [":","entry","Any"]]]
+
+  -- To make sure the spad interpreter isn't confused:
+  if returnType then
+    returnName := INTERN STRCONC(name,"Result")
+    decls := [[returnType,returnName], :decls]
+    results := [returnName, :results]
+  argNames := [INTERN STRCONC(STRINGIMAGE(u),'"__arg") for u in userArgs]
+  aType := [axiomType(a,decls,asps,aspInfo) for a in userArgs]
+  aspTypes := [SECOND NTH(POSITION(u,userArgs),aType) for u in asps]
+  nilLst := MAKE_-LIST(#args+1)
+  decPar := [["$elt","Lisp","construct"],:makeLispList decls]
+  fargNames := [INTERN STRCONC(STRINGIMAGE(u),'"__arg") for u in args |
+                 not (MEMQ(u,dummies) or MEMQ(u,asps)) ]
+  for u in asps repeat
+    fargNames := delete(INTERN STRCONC(STRINGIMAGE(u),'"__arg"),fargNames)
+  resPar := ["construct",["@",["construct",:fargNames],_
+             ["List",["Any"]]]]
+  call := [["$elt","Lisp","invokeFortran"],STRCONC(file,".spadexe"),_
+           [["$elt","Lisp","construct"],:mkQuote args],_
+           [["$elt","Lisp","construct"],:mkQuote union(asps,dummies)], decPar,_
+           [["$elt","Lisp","construct"],:mkQuote results],resPar]
+  if asps then
+    -- Make a unique(ish) id for asp files
+    aspId := STRCONC(getEnv('"SPADNUM"), GENTEMP('"NAG"))
+    body := ["SEQ",:makeAspGenerators(asps,aspTypes,aspId),_
+             makeCompilation(asps,file,aspId),_
+             ["pretend",call,fType] ]
+  else
+    body := ["pretend",call,fType]
+  interpret ["DEF",[name,:argNames],["Result",:aType],nilLst,_
+             [["$elt","Result","construct"],body]]
+
+stripNil u ==
+  [CAR(u), ["construct",:CADR(u)], if CADDR(u) then "true" else "false"]
+
+makeUnion aspType ==
+  -- The argument is the type of the asp to be generated.  We would like to
+  -- allow the user to be able to provide a fileName as an alternative
+  -- argument, so this builds the Union of aspType and FileName.
+  ["Union",[":","fp",aspType],[":","fn","FileName"]]
+
+axiomType(a,decls,asps,aspInfo) ==
+  a in asps =>
+    entry := first [u for u in aspInfo | first(u) = a]
+    ftc := ["$elt","FortranType","construct"]
+    rc  := ["$elt", _
+             ["Record",[":","key","Symbol"],[":","entry","FortranType"]], _
+            "construct"]
+    makeUnion ["FortranProgram",_
+      a,_
+      CADR(entry),_
+      ["construct",:mkQuote CADDR entry], _
+      [ ["$elt", "SymbolTable","symbolTable"],_
+          ["construct",_
+            :[[rc,first(v),[ftc,:stripNil rest(v)]] for v in CADDDR entry]]_
+    ] ]
+  spadTypeTTT(getFortranType(a,decls))
+
+makeAspGenerators(asps,types,aspId) ==
+-- The code generated here will manipulate the Fortran output stack and write
+-- the asps out as Fortran.
+  [:makeAspGenerators1(u,v,aspId) for u in asps for v in types]
+
+makeAspGenerators1(asp,type,aspId) ==
+  [[["$elt","FOP","pushFortranOutputStack"] ,_
+    ["filename",'"",STRCONC(STRINGIMAGE asp,aspId),'"f"]] , _
+   makeOutputAsFortran INTERN STRCONC(STRINGIMAGE(asp),'"__arg"), _
+   [["$elt","FOP","popFortranOutputStack"]]   _
+  ]
+
+makeOutputAsFortran arg ==
+  ["IF",["case",arg,"fn"],["outputAsFortran",[arg,"fn"]],_
+                          ["outputAsFortran",[arg,"fp"]] ]
+
+makeCompilation(asps,file,aspId) ==
+  [["$elt","Lisp","compileAndLink"],_
+   ["construct",:[STRCONC(STRINGIMAGE a,aspId,'".f") for a in asps]], _
+   $fortranCompilerName,_
+   STRCONC(file,'".o"),_
+   STRCONC(file,'".spadexe"),_
+   $fortranLibraries]
+
+
+compileAndLink(fortFileList,fortCompiler,cFile,outFile,linkerArgs) ==
+  SYSTEM STRCONC (fortCompiler, addSpaces fortFileList,_
+                  cFile, " -o ",outFile," ",linkerArgs)
+
+addSpaces(stringList) ==
+  l := " "
+  for s in stringList repeat l := STRCONC(l,s," ")
+  l
+
+complexRows z ==
+-- Take a list of lists of complexes (i.e. pairs of floats) and
+-- make them look like a Fortran vector!
+  [:[:pair2list(u.i) for u in z] for i in 0..#(z.0)-1]
+
+pair2list u == [car u,cdr u]
+vec2Lists1 u == [ELT(u,i) for i in 0..#u-1]
+vec2Lists u == [vec2Lists1 ELT(u,i) for i in 0..#u-1]
+
+spad2lisp(u) ==
+  -- Turn complexes into arrays of floats
+  first first(u)="Complex" =>
+    makeVector([makeVector([CADR u,CDDR u],'DOUBLE_-FLOAT)],NIL)
+  -- Turn arrays of complexes into arrays of floats so that tarnsposing
+  -- them puts them in the correct fortran order
+  first first(u)="Matrix" and first SECOND first(u) = "Complex" =>
+    makeVector([makeVector(complexRows vec2Lists rest u,'DOUBLE_-FLOAT)],NIL)
+  rest(u)
+
+invokeFortran(objFile,args,dummies,decls,results,actual) ==
+  actual := [spad2lisp(u) for u in first actual]
+  returnedValues := spadify( _
+        fortCall(objFile,prepareData(args,dummies,actual,decls),_
+                 prepareResults(results,args,dummies,actual,decls)),_
+                            results,decls,inFirstNotSecond(args,dummies),actual)
+
+--  -- If there are one or two elements in returnedValues we must return a
+--  -- cons cell, otherwise a vector.  This is to match the internal
+--  -- representation of an Axiom Record.
+--  #returnedValues = 1 => returnedValues
+--  #returnedValues = 2 => CONS(first returnedValues,SECOND returnedValues)
+--  makeVector(returnedValues,nil)
+
+int2Bool u ==
+  -- Return something which looks like an axiom boolean
+  u=1 => "TRUE"
+  NIL
+
+makeResultRecord(name,type,value) ==
+  -- Take an object returned by the NAG routine and make it into an AXIOM
+  -- object of type Record(key:Symbol,entry:Any) for use by Result.
+  CONS(name,CONS(spadTypeTTT type,value))
+
+spadify(l,results,decls,names,actual) ==
+  -- The elements of list l are the output forms returned from the Fortran
+  -- code: integers, floats and vectors.  Return spad forms of these, of 
+  -- type Record(key:Symbol,entry:Any) (for use with the Result domain).
+  SETQ(RESULTS,l)
+  spadForms := nil
+  for i in 0..(#l -1) repeat
+    fort := NTH(i,l)
+    name := NTH(i,results)
+    ty := getFortranType(name,decls)
+    -- Result is a string
+    STRINGP fort =>
+      spadForms := [makeResultRecord(name,ty,fort), :spadForms]
+    -- Result is a Complex Scalar
+    ty in ["double complex" , "complex"] =>
+       spadForms := [makeResultRecord(name,ty, _
+                                     CONS(ELT(fort,0),ELT(fort,1)) ),:spadForms]
+    -- Result is a Complex vector or array
+    LISTP(ty) and first(ty) in ["double complex" , "complex"] =>
+      dims := [getVal(u,names,actual) for u in rest ty]
+      els := nil
+      if #dims=1 then
+        els := [makeVector([CONS(ELT(fort,2*i),ELT(fort,2*i+1)) _
+                for i in 0..(first(dims)-1)],nil)]
+      else if #dims=2 then
+        for r in 0..(first(dims) - 1) repeat
+          innerEls := nil
+          for c in 0..(SECOND(dims) - 1) repeat
+            offset := 2*(c*first(dims)+r)
+            innerEls := [CONS(ELT(fort,offset),ELT(fort,offset+1)),:innerEls]
+          els := [makeVector(NREVERSE innerEls,nil),:els]
+      else
+         error ['"Can't cope with complex output dimensions higher than 2"]
+      spadForms := [makeResultRecord(name,ty,makeVector(NREVERSE els,nil)),
+                    :spadForms]
+    -- Result is a Boolean vector or array
+    LISTP(ty) and first(ty)="logical" and #ty=2 =>
+      dim := getVal(first rest ty,names,actual)
+      spadForms := [makeResultRecord(name,ty,_
+                          [int2Bool ELT(fort,i) for i in 0..dim-1]), :spadForms]
+    LISTP(ty) and first(ty)="logical" =>
+      dims := [getVal(u,names,actual) for u in rest ty]
+      els := nil
+      if #dims=2 then
+        for r in 0..(first(dims) - 1) repeat
+          innerEls := nil
+          for c in 0..(SECOND(dims) - 1) repeat
+            innerEls := [int2Bool ELT(fort,c*first(dims)+r),:innerEls]
+          els := [NREVERSE innerEls,:els]
+      else
+         error ['"Can't cope with logical output dimensions higher than 2"]
+      spadForms := [makeResultRecord(name,ty,NREVERSE els), :spadForms]
+    -- Result is a vector or array
+    VECTORP fort =>
+      dims := [getVal(u,names,actual) for u in rest ty]
+      els := nil
+      -- Check to see whether we are dealing with a dummy (0-dimensional) array.
+      if MEMQ(0,dims) then
+        els := [[]]
+      else if #dims=1 then
+        els := [makeVector([ELT(fort,i) for i in 0..(first(dims)-1)],nil)]
+      else if #dims=2 then
+        for r in 0..(first(dims) - 1) repeat
+          innerEls := nil
+          for c in 0..(SECOND(dims) - 1) repeat
+            innerEls := [ELT(fort,c*first(dims)+r),:innerEls]
+          els := [makeVector(NREVERSE innerEls,nil),:els]
+      else if #dims=3 then
+        iDim := first(dims)
+        jDim := SECOND dims
+        kDim := THIRD dims
+        for r in 0..(iDim - 1) repeat
+          middleEls := nil
+          for c in 0..(jDim - 1) repeat
+            innerEls := nil
+            for p in 0..(kDim - 1) repeat
+              offset := p*jDim + c*kDim + r
+              innerEls := [ELT(fort,offset),:innerEls]
+            middleEls := [makeVector(NREVERSE innerEls,nil),:middleEls]
+          els := [makeVector(NREVERSE middleEls,nil),:els]
+      else
+         error ['"Can't cope with output dimensions higher than 3"]
+      if not MEMQ(0,dims) then els := makeVector(NREVERSE els,nil)
+      spadForms := [makeResultRecord(name,ty,els), :spadForms]
+    -- Result is a Boolean Scalar
+    atom fort and ty="logical" =>
+      spadForms := [makeResultRecord(name,ty,int2Bool fort), :spadForms]
+    -- Result is a Scalar
+    atom fort => 
+      spadForms := [makeResultRecord(name,ty,fort),:spadForms]
+    error ['"Unrecognised output format: ",fort]
+  NREVERSE spadForms
+
+lispType u ==
+  -- Return the lisp type equivalent to the given Fortran type.
+  LISTP u => lispType first u
+  u = "real" => "SHORT-FLOAT"
+  u = "double" => "DOUBLE-FLOAT"
+  u = "double precision" => "DOUBLE-FLOAT"
+  u = "integer" => "FIXNUM"
+  u = "logical" => "BOOLEAN"
+  u = "character" => "CHARACTER"
+  u = "complex" => "SHORT-FLOAT"
+  u = "double complex" => "DOUBLE-FLOAT"
+  error ['"Unrecognised Fortran type: ",u]
+
+getVal(u,names,values) ==
+  -- if u is the i'th element of names, return the i'th element of values,
+  -- otherwise if it is an arithmetic expression evaluate it.
+  NUMBERP(u) => u
+  LISTP(u) => eval [first(u), :[getVal(v,names,values) for v in rest u]]
+  (place := POSITION(u,names)) => NTH(place,values)
+  error ['"No value found for parameter: ",u]
+
+
+prepareData(args,dummies,values,decls) ==
+-- TTT: we don't 
+-- writeData handles all the mess
+   [args,dummies,values,decls]
+
+
+checkForBoolean u ==
+  u = "BOOLEAN" => "FIXNUM"
+  u
+
+prepareResults(results,args,dummies,values,decls) ==
+  -- Create the floating point zeros (boot doesn't like 0.0d0, 0.0D0 etc)
+  shortZero : fluid := COERCE(0.0,'SHORT_-FLOAT)
+  longZero : fluid := COERCE(0.0,'DOUBLE_-FLOAT)
+  data := nil
+  for u in results repeat
+    type := getFortranType(u,decls)
+    data := [defaultValue(type,inFirstNotSecond(args,dummies),values),:data]
+      where defaultValue(type,argNames,actual) ==
+        LISTP(type) and first(type)="character" => MAKE_-STRING(1)
+        LISTP(type) and first(type) in ["complex","double complex"] =>
+          makeVector(  makeList(
+            2*APPLY('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_
+            if first(type)="complex" then shortZero else longZero),_
+          if first(type)="complex" then "SHORT-FLOAT" else "DOUBLE-FLOAT" )
+        LISTP type => makeVector(_
+          makeList(
+            APPLY('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_
+            defaultValue(first type,argNames,actual)),_
+          checkForBoolean lispType first(type) )
+        type = "integer" => 0
+        type = "real" => shortZero
+        type = "double" => longZero
+        type = "double precision" => longZero
+        type = "logical" => 0
+        type = "character" => MAKE_-STRING(1)
+        type = "complex" => makeVector([shortZero,shortZero],'SHORT_-FLOAT)
+        type = "double complex" => makeVector([longZero,longZero],'LONG_-FLOAT)
+        error ['"Unrecognised Fortran type: ",type]
+  NREVERSE data
+
+-- TTT this is dead code now
+--	transposeVector(u,type) ==
+--	  -- Take a vector of vectors and return a single vector which is in column
+--	  -- order (i.e. swap from C to Fortran order).
+--	  els  := nil
+--	  rows := CAR ARRAY_-DIMENSIONS(u)-1
+--	  cols := CAR ARRAY_-DIMENSIONS(ELT(u,0))-1
+--	  -- Could be a 3D Matrix
+--	  if VECTORP ELT(ELT(u,0),0) then
+--	    planes := CAR ARRAY_-DIMENSIONS(ELT(ELT(u,0),0))-1
+--	    for k in 0..planes repeat for j in 0..cols repeat for i in 0..rows repeat
+--	      els := [ELT(ELT(ELT(u,i),j),k),:els]
+--	  else
+--	    for j in 0..cols repeat for i in 0..rows repeat
+--	      els := [ELT(ELT(u,i),j),:els]
+--	  makeVector(NREVERSE els,type)
+
+
+writeData(tmpFile,indata) ==
+  -- Write the elements of the list data to a temporary file.  Return the
+  -- name of that file.
+  --
+  str := MAKE_-OUTSTREAM(tmpFile)
+  xstr := xdrOpen(str,true)
+  [args,dummies,values,decls] := indata
+  for v in values repeat
+	-- the two Boolean values
+	v = "T" => 
+		xdrWrite(xstr,1)
+	NULL v =>   
+		xdrWrite(xstr,0)
+	-- characters  
+	STRINGP v => 
+		xdrWrite(xstr,v)
+	-- some array
+	VECTORP v =>  
+		rows := CAR ARRAY_-DIMENSIONS(v)
+		-- is it 2d or more (most likely) ?
+		VECTORP ELT(v,0) =>	
+			cols := CAR ARRAY_-DIMENSIONS(ELT(v,0))
+			-- is it 3d ?
+			VECTORP ELT(ELT(v,0),0) =>
+				planes := CAR ARRAY_-DIMENSIONS(ELT(ELT(v,0),0))
+				-- write 3d array
+				xdrWrite(xstr,rows*cols*planes)
+				for k in 0..planes-1 repeat 
+					for j in 0..cols-1 repeat 
+						for i in 0..rows-1 repeat 
+							xdrWrite(xstr,ELT(ELT(ELT(v,i),j),k))
+			-- write 2d array
+			xdrWrite(xstr,rows*cols)
+			for j in 0..cols-1 repeat
+				for i in 0..rows-1 repeat xdrWrite(xstr,ELT(ELT(v,i),j))
+		-- write 1d array
+		xdrWrite(xstr,rows)
+		for i in 0..rows-1 repeat xdrWrite(xstr,ELT(v,i))
+	-- this is used for lists of booleans apparently in f01
+     	LISTP v => 
+		xdrWrite(xstr,LENGTH v)
+	        for el in v repeat 
+			if el then xdrWrite(xstr,1) else xdrWrite(xstr,0) 
+	-- integers
+	INTEGERP v => 
+		xdrWrite(xstr,v)
+	-- floats
+	FLOATP v => 
+		xdrWrite(xstr,v)
+  SHUT(str)
+  tmpFile
+
+readData(tmpFile,results) ==
+  -- read in the results from tmpFile.  The list results is a list of
+  -- dummy objects of the correct type which will receive the data.
+  str := MAKE_-INSTREAM(tmpFile)
+  xstr := xdrOpen(str,false)
+  results := [xdrRead1(xstr,r) for r in results] where
+    xdrRead1(x,dummy) ==
+      VECTORP(dummy) and ZEROP(LENGTH dummy) => dummy
+      xdrRead(x,dummy)
+  SHUT(str)
+  results
+
+generateDataName()==STRCONC($fortranTmpDir,getEnv('"HOST"),
+    getEnv('"SPADNUM"), GENTEMP('"NAG"),'"data")
+generateResultsName()==STRCONC($fortranTmpDir,getEnv('"HOST"),
+    getEnv('"SPADNUM"), GENTEMP('"NAG"),'"results")
+
+
+fortCall(objFile,data,results) ==
+  tmpFile1 := writeData(generateDataName(),data)
+  tmpFile2 := generateResultsName()
+  SYSTEM STRCONC(objFile," < ",tmpFile1," > ",tmpFile2)
+  results := readData(tmpFile2,results)
+  -- SYSTEM STRCONC("rm -f ",tmpFile1," ",tmpFile2)
+  PROBE_-FILE(tmpFile1) and DELETE_-FILE(tmpFile1)
+  PROBE_-FILE(tmpFile2) and DELETE_-FILE(tmpFile2)
+  results
+
+invokeNagman(objFiles,nfile,args,dummies,decls,results,actual) ==
+  actual := [spad2lisp(u) for u in first actual]
+  result := spadify(protectedNagCall(objFiles,nfile, _
+                 prepareData(args,dummies,actual,decls),_
+                 prepareResults(results,args,dummies,actual,decls)),_
+                 results,decls,inFirstNotSecond(args,dummies),actual)
+  -- Tidy up asps
+  -- if objFiles then SYSTEM STRCONC("rm -f ",addSpaces objFiles)
+  for fn in objFiles repeat PROBE_-FILE(fn) and DELETE_-FILE(fn)
+  result
+
+
+nagCall(objFiles,nfile,data,results,tmpFiled,tmpFiler) ==
+  nagMessagesString :=
+     $nagMessages => '"on"
+     '"off"
+  writeData(tmpFiled,data)
+  toSend:=STRCONC($nagHost," ",nfile," ",tmpFiler," ",tmpFiled," ",_
+      STRINGIMAGE($fortPersistence)," ", nagMessagesString," ",addSpaces objFiles)
+  sockSendString(8,toSend)
+  if sockGetInt(8)=1 then
+    results := readData(tmpFiler,results)
+  else
+    error ['"An error was detected while reading data: ", _
+           '"perhaps an incorrect array index was given ?"]
+  results
+
+protectedNagCall(objFiles,nfile,data,results) ==
+ errors :=true
+ val:=NIL
+ td:=generateDataName()
+ tr:=generateResultsName()
+ UNWIND_-PROTECT( (val:=nagCall(objFiles,nfile,data,results,td,tr) ;errors :=NIL),
+	errors =>( resetStackLimits(); sendNagmanErrorSignal();cleanUpAfterNagman(td,tr,objFiles)))
+ val
+
+
+cleanUpAfterNagman(f1,f2,listf)==
+  PROBE_-FILE(f1) and DELETE_-FILE(f1)
+  PROBE_-FILE(f2) and DELETE_-FILE(f2)
+  for fn in listf repeat PROBE_-FILE(fn) and DELETE_-FILE(fn)
+
+sendNagmanErrorSignal()==
+-- excite nagman's signal handler!
+ sockSendSignal(8,15)
+
+
+-- Globals
+-- $fortranDirectory := nil
+-- $fortranLibraries := '"-L/usr/local/lib/f90 -lf90 -L/usr/local/lib -lnag -lm"
+-- $fortranTmpDir := '"/tmp/"
+-- $addUnderscoreToFortranNames := true
+-- $fortranCompilerName := '"f90"
+
+inFirstNotSecond(f,s)==
+ [i for i in f | not i in s]
+
+-- Code for use in the Windows version of the AXIOM/NAG interface.
+
+multiToUnivariate f ==
+  -- Take an AnonymousFunction, replace the bound variables by references to
+  -- elements of a vector, and compile it.
+  (first f) ^= "+->" => error "in multiToUnivariate: not an AnonymousFunction"
+  if PAIRP CADR f then
+    vars := CDADR f -- throw away 'Tuple at start of variable list
+  else
+    vars := [CADR f]
+  body := COPY_-TREE CADDR f
+  newVariable := GENSYM()
+  for index in 0..#vars-1 repeat
+    -- Remember that AXIOM lists, vectors etc are indexed from 1
+    body := NSUBST(["elt",newVariable,index+1],vars.(index),body)
+  -- We want a Vector DoubleFloat -> DoubleFloat
+  target := [["DoubleFloat"],["Vector",["DoubleFloat"]]]
+  rest interpret ["ADEF",[newVariable],target,[[],[]],body]
+
+functionAndJacobian f ==
+  -- Take a mapping into n functions of n variables, produce code which will
+  -- evaluate function and jacobian values.
+  (first f) ^= "+->" => error "in functionAndJacobian: not an AnonymousFunction"
+  if PAIRP CADR f then
+    vars := CDADR f -- throw away 'Tuple at start of variable list
+  else
+    vars := [CADR f]
+  #(vars) ^= #(CDADDR f) => 
+    error "number of variables should equal number of functions"
+  funBodies := COPY_-TREE CDADDR f
+  jacBodies := [:[DF(f,v) for v in vars] for f in funBodies] where
+    DF(fn,var) == 
+      ["@",["convert",["differentiate",fn,var]],"InputForm"]
+  jacBodies := CDDR interpret [["$elt",["List",["InputForm"]],"construct"],:jacBodies]
+  newVariable := GENSYM()
+  for index in 0..#vars-1 repeat
+    -- Remember that AXIOM lists, vectors etc are indexed from 1
+    funBodies := NSUBST(["elt",newVariable,index+1],vars.(index),funBodies)
+    jacBodies := NSUBST(["elt",newVariable,index+1],vars.(index),jacBodies)
+  target := [["Vector",["DoubleFloat"]],["Vector",["DoubleFloat"]],["Integer"]]
+  rest interpret
+    ["ADEF",[newVariable,"flag"],target,[[],[],[]],_
+            ["IF", ["=","flag",1],_
+                   ["vector",["construct",:funBodies]],_
+                   ["vector",["construct",:jacBodies]]]]
+
+
+vectorOfFunctions f ==
+  -- Take a mapping into n functions of m variables, produce code which will
+  -- evaluate function values.
+  (first f) ^= "+->" => error "in vectorOfFunctions: not an AnonymousFunction"
+  if PAIRP CADR f then
+    vars := CDADR f -- throw away 'Tuple at start of variable list
+  else
+    vars := [CADR f]
+  funBodies := COPY_-TREE CDADDR f
+  newVariable := GENSYM()
+  for index in 0..#vars-1 repeat
+    -- Remember that AXIOM lists, vectors etc are indexed from 1
+    funBodies := NSUBST(["elt",newVariable,index+1],vars.(index),funBodies)
+  target := [["Vector",["DoubleFloat"]],["Vector",["DoubleFloat"]]]
+  rest interpret ["ADEF",[newVariable],target,[[],[]],["vector",["construct",:funBodies]]]
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/functor.boot.pamphlet b/src/interp/functor.boot.pamphlet
new file mode 100644
index 00000000..7e952a88
--- /dev/null
+++ b/src/interp/functor.boot.pamphlet
@@ -0,0 +1,1009 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp functor.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--%  Domain printing
+keyItem a ==
+  isDomain a => CDAR a.4
+  a
+  --The item that domain checks on
+ 
+--Global strategy here is to maintain a list of substitutions
+--  ( %in Sublis), of vectors and the names that they have,
+--  which may be either local names ('View1') or global names ('Where1')
+--  The global names are remembered on $Sublis from one
+--  invocation of DomainPrint1 to the next
+ 
+DomainPrint(D,brief) ==
+  -- If brief is non-NIL, %then only a summary is printed
+  $WhereList: local
+  $Sublis: local
+  $WhereCounter: local
+  $WhereCounter:= 1
+  env:=
+    not BOUNDP '$e => $EmptyEnvironment
+    $e='$e => $EmptyEnvironment
+    $e --in case we are called from top level
+  isCategory D => CategoryPrint(D,env)
+  $Sublis:= [[keyItem D,:'original]]
+  SAY '"-----------------------------------------------------------------------"
+  DomainPrint1(D,NIL,env)
+  while ($WhereList) repeat
+    s:= $WhereList
+    $WhereList:= nil
+    for u in s repeat
+      TERPRI()
+      SAY ['"Where ",first u,'" is:"]
+      DomainPrint1(rest u,brief,env)
+  SAY '"-----------------------------------------------------------------------"
+ 
+DomainPrint1(D,brief,$e) ==
+  REFVECP D and not isDomain D => PacPrint D
+  if REFVECP D then D:= D.4
+             --if we were passed a vector, go to the domain
+  Sublis:=
+    [:
+      [[rest u,:INTERNL STRCONC('"View",STRINGIMAGE i)]
+        for u in D for i in 1..],:$Sublis]
+  for u in D for i in 1.. repeat
+    brief and i>1 => nil
+    uu:= COPY_-SEQ rest u
+    uu.4:= '"This domain"
+    if not brief then
+      SAY ['"View number ",i,'" corresponding to categories:"]
+      PRETTYPRINT first u
+    if i=1 and REFVECP uu.5 then
+      vv:= COPY_-SEQ uu.5
+      uu.5:= vv
+      for j in 0..MAXINDEX vv repeat
+        if REFVECP vv.j then
+          l:= ASSQ(keyItem vv.j,Sublis)
+          if l
+             then name:= rest l
+             else
+              name:=DPname()
+              Sublis:= [[keyItem vv.j,:name],:Sublis]
+              $Sublis:= [first Sublis,:$Sublis]
+              $WhereList:= [[name,:vv.j],:$WhereList]
+          vv.j:= name
+    if i>1 then
+      uu.1:= uu.2:= uu.5:= '"As in first view"
+    for i in 6..MAXINDEX uu repeat
+      uu.i:= DomainPrintSubst(uu.i,Sublis)
+      if REFVECP uu.i then
+        name:=DPname()
+        Sublis:= [[keyItem uu.i,:name],:Sublis]
+        $Sublis:= [first Sublis,:$Sublis]
+        $WhereList:= [[name,:uu.i],:$WhereList]
+        uu.i:= name
+      if uu.i is [.,:v] and REFVECP v then
+        name:=DPname()
+        Sublis:= [[keyItem v,:name],:Sublis]
+        $Sublis:= [first Sublis,:$Sublis]
+        $WhereList:= [[name,:v],:$WhereList]
+        uu.i:= [first uu.i,:name]
+    if brief then PRETTYPRINT uu.0 else PRETTYPRINT uu
+ 
+DPname() ==
+  name:= INTERNL STRCONC('"Where",STRINGIMAGE $WhereCounter)
+  $WhereCounter:= $WhereCounter+1
+  name
+ 
+PacPrint v ==
+  vv:= COPY_-SEQ v
+  for j in 0..MAXINDEX vv repeat
+    if REFVECP vv.j then
+      l:= ASSQ(keyItem vv.j,Sublis)
+      if l
+         then name:= rest l
+         else
+          name:=DPname()
+          Sublis:= [[keyItem vv.j,:name],:Sublis]
+          $Sublis:= [first Sublis,:$Sublis]
+          $WhereList:= [[name,:vv.j],:$WhereList]
+      vv.j:= name
+    if PAIRP vv.j and REFVECP(u:=CDR vv.j) then
+      l:= ASSQ(keyItem u,Sublis)
+      if l
+         then name:= rest l
+         else
+          name:=DPname()
+          Sublis:= [[keyItem u,:name],:Sublis]
+          $Sublis:= [first Sublis,:$Sublis]
+          $WhereList:= [[name,:u],:$WhereList]
+      RPLACD(vv.j,name)
+  PRETTYPRINT vv
+ 
+DomainPrintSubst(item,Sublis) ==
+  item is [a,:b] =>
+    c1:= DomainPrintSubst(a,Sublis)
+    c2:= DomainPrintSubst(b,Sublis)
+    EQ(c1,a) and EQ(c2,b) => item
+    [c1,:c2]
+  l:= ASSQ(item,Sublis)
+  l => rest l
+  l:= ASSQ(keyItem item,Sublis)
+  l => rest l
+  item
+ 
+--%  Utilities
+ 
+mkDevaluate a ==
+  null a => nil
+  a is ['QUOTE,a'] => (a' => a; nil)
+  a='$ => MKQ '$
+  a is ['LIST] => nil
+  a is ['LIST,:.] => a
+  ['devaluate,a]
+ 
+getDomainView(domain,catform) ==
+  u:= HasCategory(domain,catform) => u
+  c:= eval catform
+  u:= HasCategory(domain,c.0) => u
+  -- note:  this is necessary because of domain == another domain, e.g.
+  -- Ps are defined to be SUPs with specific arguments so that if one
+  -- asks if a P is a Module over itself, here one has catform= (Module
+  -- (P I)) yet domain is a SUP.  By oding this evaluation, c.0=SUP as
+  -- well and test works --- RDJ 10/31/83
+  throwKeyedMsg("S2IF0009",[devaluate domain, catform])
+ 
+getPrincipalView domain ==
+  pview:= domain
+  for [.,:view] in domain.4 repeat if #view>#pview then pview:= view
+  pview
+ 
+CategoriesFromGDC x ==
+  atom x => nil
+  x is ['LIST,a,:b] and a is ['QUOTE,a'] =>
+    union(LIST LIST a',"union"/[CategoriesFromGDC u for u in b])
+  x is ['QUOTE,a] and a is [b] => [a]
+ 
+compCategories u ==
+  ATOM u => u
+  not ATOM first u =>
+    error ['"compCategories: need an atom in operator position", first u]
+  first u = "Record" =>
+    -- There is no modemap property for these guys so do it by hand.
+    [first u, :[[":", a.1, compCategories1(a.2,'(SetCategory))] for a in rest u]]
+  first u = "Union" or first u = "Mapping" =>
+    -- There is no modemap property for these guys so do it by hand.
+    [first u, :[compCategories1(a,'(SetCategory)) for a in rest u]]
+  u is ['SubDomain,D,.] => compCategories D
+  v:=get(first u,'modemap,$e)
+  ATOM v =>
+    error ['"compCategories: could not get proper modemap for operator",first u]
+  if rest v then
+    sayBrightly ['"compCategories: ", '%b, '"Warning", '%d,
+                 '"ignoring unexpected stuff at end of modemap"]
+    pp rest v
+  -- the next line "fixes" a bad modemap which sometimes appears ....
+  --
+  if rest v and NULL CAAAR v then v:=CDR v
+  v:= CDDAAR v
+  v:=resolvePatternVars(v, rest u) -- replaces #n forms
+  -- select the modemap part of the first entry, and skip result etc.
+  u:=[first u,:[compCategories1(a,b) for a in rest u for b in v]]
+  u
+ 
+compCategories1(u,v) ==
+-- v is the mode of u
+  ATOM u => u
+  isCategoryForm(v,$e) => compCategories u
+  [c,:.] := comp(macroExpand(u,$e),v,$e) => c
+  error 'compCategories1
+ 
+NewbFVectorCopy(u,domName) ==
+  v:= GETREFV SIZE u
+  for i in 0..5 repeat v.i:= u.i
+  for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [Undef,[domName,i],:first u.i]
+  v
+ 
+mkVector u ==
+  u => ['VECTOR,:u]
+  nil
+ 
+optFunctorBody x ==
+  atom x => x
+  x is ['QUOTE,:l] => x
+  x is ['DomainSubstitutionMacro,parms,body] =>
+    optFunctorBody DomainSubstitutionFunction(parms,body)
+  x is ['LIST,:l] =>
+    null l => nil
+    l:= [optFunctorBody u for u in l]
+    and/[optFunctorBodyQuotable u for u in l] =>
+      ['QUOTE,[optFunctorBodyRequote u for u in l]]
+    l=rest x => x --CONS-saving hack
+    ['LIST,:l]
+  x is ['PROGN,:l] => ['PROGN,:optFunctorPROGN l]
+  x is ['COND,:l] =>
+--+
+    l:=
+      [CondClause u for u in l | u and first u] where
+        CondClause [pred,:conseq] ==
+          [optFunctorBody pred,:optFunctorPROGN conseq]
+    l:= EFFACE('((QUOTE T)),l)
+                   --delete any trailing ("T)
+    null l => nil
+    CAAR l='(QUOTE T) =>
+      (null CDAR l => nil; null CDDAR l => CADAR l; ["PROGN",:CDAR l])
+    null rest l and null CDAR l =>
+            --there is no meat to this COND
+      pred:= CAAR l
+      atom pred => nil
+      first pred="HasCategory" => nil
+      ['COND,:l]
+    ['COND,:l]
+  [optFunctorBody u for u in x]
+ 
+optFunctorBodyQuotable u ==
+  null u => true
+  NUMBERP u => true
+  atom u => nil
+  u is ['QUOTE,:.] => true
+  nil
+ 
+optFunctorBodyRequote u ==
+  atom u => u
+  u is ['QUOTE,v] => v
+  systemErrorHere '"optFunctorBodyRequote"
+ 
+optFunctorPROGN l ==
+  l is [x,:l'] =>
+    worthlessCode x => optFunctorPROGN l'
+    l':= optFunctorBody l'
+    l'=[nil] => [optFunctorBody x]
+    [optFunctorBody x,:l']
+  l
+ 
+worthlessCode x ==
+  x is ['COND,:l] and (and/[x is [.,y] and worthlessCode y for x in l]) => true
+  x is ['PROGN,:l] => (null (l':= optFunctorPROGN l) => true; false)
+  x is ['LIST] => true
+  null x => true
+  false
+ 
+cons5(p,l) ==
+  l and (CAAR l = CAR p) => [p,: rest l]
+  LENGTH l < 5 => [p,:l]
+  RPLACD(QCDDDDR l,nil)
+  [p,:l]
+ 
+-- TrimEnvironment e ==
+--   [TrimLocalEnvironment u for u in e] where
+--     TrimLocalEnvironment e ==
+--       [TrimContour u for u in e] where
+--         TrimContour e ==
+--           [u for u in e | Interesting u] where Interesting u == nil
+--                         --clearly a temporary definition
+ 
+setVector0(catNames,definition) ==
+          --returns code to set element 0 of the vector
+          --to the definition of the category
+  definition:= mkDomainConstructor definition
+-- If we call addMutableArg this early, then recurise calls to this domain
+-- (e.g. while testing predicates) will generate new domains => trouble
+--definition:= addMutableArg mkDomainConstructor definition
+  for u in catNames repeat
+    definition:= [($QuickCode => 'QSETREFV; 'SETELT),u,0,definition]
+  definition
+ 
+--presence of GENSYM in arg-list differentiates mutable-domains
+-- addMutableArg nameFormer ==
+--   $mutableDomain =>
+--     nameFormer is ['LIST,:.] => [:nameFormer, '(GENSYM)]
+--     ['APPEND,nameFormer,'(LIST (GENSYM))]
+--   nameFormer
+ 
+--getname D ==
+--  isDomain D or isCategory D => D.0
+--  D
+ 
+setVector12 args ==
+            --The purpose of this function is to replace place holders
+            --e.g. argument names or gensyms, by real values
+  null args => nil
+  args1:=args2:=args
+  for u in $extraParms repeat
+            --A typical element of $extraParms, which is set in
+            --DomainSubstitutionFunction, would be (gensym) cons
+            --(category parameter), e.g. DirectProduct(length vl,NNI)
+            --as in DistributedMultivariatePolynomial
+    args1:=[CAR u,:args1]
+    args2:=[CDR u,:args2]
+  freeof($domainShell.1,args1) and
+      freeof($domainShell.2,args1) and
+          freeof($domainShell.4,args1) => nil  where freeof(a,b) ==
+                  ATOM a => NULL MEMQ(a,b)
+                  freeof(CAR a,b) => freeof(CDR a,b)
+                  false
+  [['SetDomainSlots124,'$,['QUOTE,args1],['LIST,:args2]]]
+ 
+SetDomainSlots124(vec,names,vals) ==
+  l:= PAIR(names,vals)
+  vec.1:= sublisProp(l,vec.1)
+  vec.2:= sublisProp(l,vec.2)
+  l:= [[a,:devaluate b] for a in names for b in vals]
+  vec.4:= SUBLIS(l,vec.4)
+  vec.1:= SUBLIS(l,vec.1)
+ 
+sublisProp(subst,props) ==
+  null props => nil
+  [cp,:props']:= props
+  (a' := inspect(cp,subst)) where
+    inspect(cp is [a,cond,:l],subst) ==
+      cond=true => cp
+                        --keep original CONS
+      cond is ['or,:x] =>
+        (or/[inspect(u,subst) for u in x] => [a,true,:l]; nil)
+      cond is ['has,nam,b] and (val:= ASSQ(nam,subst)) =>
+        ev:=
+          b is ['ATTRIBUTE,c] => HasAttribute(rest val,c)
+          b is ['SIGNATURE,c] => HasSignature(rest val,c)
+          isDomainForm(b,$CategoryFrame) => b=rest val
+          HasCategory(rest val,b)
+        ev => [a,true,:l]
+        nil
+      cp
+  not a' => sublisProp(subst,props')
+  props' := sublisProp(subst,props')
+  EQ(a',cp) and EQ(props',rest props) => props
+  [a',:props']
+ 
+setVector3(name,instantiator) ==
+      --generates code to set element 3 of 'name' from 'instantiator'
+      --element 3 is data structure representing category
+      --returns a single LISP statement
+  instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body)
+  [($QuickCode => 'QSETREFV; 'SETELT),name,3,mkDomainConstructor instantiator]
+ 
+mkDomainFormer x ==
+  if x is ['DomainSubstitutionMacro,parms,body] then
+    x:=DomainSubstitutionFunction(parms,body)
+    x:=SUBLIS($extraParms,x)
+    --The next line ensures that only one copy of this structure will
+    --appear in the BPI being generated, thus saving (some) space
+  x is ['Join,:.] => ['eval,['QUOTE,x]]
+  x
+ 
+mkDomainConstructor x ==
+  atom x => mkDevaluate x
+  x is ['Join] => nil
+  x is ['LIST] => nil
+  x is ['CATEGORY,:.] => MKQ x
+  x is ['mkCategory,:.] => MKQ x
+  x is ['_:,selector,dom] =>
+    ['LIST,MKQ '_:,MKQ selector,mkDomainConstructor dom]
+  x is ['Record,:argl] =>
+    ['LIST,MKQ 'Record,:[mkDomainConstructor y for y in argl]]
+  x is ['Join,:argl] =>
+    ['LIST,MKQ 'Join,:[mkDomainConstructor y for y in argl]]
+  x is ['call,:argl] => ['MKQ, optCall x]
+        --The previous line added JHD/BMT 20/3/84
+        --Necessary for proper compilation of DPOLY SPAD
+  x is [op] => MKQ x
+  x is [op,:argl] => ['LIST,MKQ op,:[mkDomainConstructor a for a in argl]]
+ 
+setVector4(catNames,catsig,conditions) ==
+  if $HackSlot4 then
+    for ['LET,name,cond,:.] in $getDomainCode repeat
+      $HackSlot4:=SUBST(name,cond,$HackSlot4)
+  code:=
+--+
+    ['SETELT,'$,4,'TrueDomain]
+  code:=['(LET TrueDomain (NREVERSE TrueDomain)),:$HackSlot4,code]
+  code:=
+    [:
+      [setVector4Onecat(u,v,w)
+        for u in catNames for v in catsig for w in conditions],:code]
+  ['(LET TrueDomain NIL),:code]
+ 
+setVector4Onecat(name,instantiator,info) ==
+            --generates code to create one item in the
+            --Alist representing a domain
+            --returns a single LISP expression
+  instantiator is ['DomainSubstitutionMacro,.,body] =>
+    setVector4Onecat(name,body,info)
+  data:=
+       --CAR name.4 contains all the names except itself
+       --hence we need to add this on, by the above CONS
+    ['CONS,['CONS,mkDomainConstructor instantiator,['CAR,['ELT,name,4]]],
+      name]
+  data:= ['SETQ,'TrueDomain,['CONS,data,'TrueDomain]]
+  TruthP info => data
+  ['COND,[TryGDC PrepareConditional info,data],:
+    Supplementaries(instantiator,name)] where
+      Supplementaries(instantiator,name) ==
+        slist:=
+          [u for u in $supplementaries | AncestorP(first u,[instantiator])]
+        null slist => nil
+        $supplementaries:= S_-($supplementaries,slist)
+        PRETTYPRINT [instantiator,'" should solve"]
+        PRETTYPRINT slist
+        slist:=
+          [form(u,name) for u in slist] where
+            form([cat,:cond],name) ==
+              u:= ['QUOTE,[cat,:first (eval cat).4]]
+              ['COND,[TryGDC cond,['SETQ,'TrueDomain,['CONS,['CONS,u,name],
+                'TrueDomain]]]]
+        LENGTH slist=1 => [CADAR slist]
+                      --return a list, since it is CONSed
+        slist:= ['PROGN,:slist]
+        [['(QUOTE T),slist]]
+ 
+setVector4part3(catNames,catvecList) ==
+    --the names are those that will be applied to the various vectors
+  generated:= nil
+  for u in catvecList for uname in catNames repeat
+    for v in CADDR u.4 repeat
+      if w:= ASSOC(first v,generated)
+         then RPLACD(w,[[rest v,:uname],:rest w])
+         else generated:= [[first v,[rest v,:uname]],:generated]
+  codeList := nil
+  for [w,:u] in generated repeat
+     code := compCategories w
+     for v in u repeat
+       code:= [($QuickCode => 'QSETREFV; 'SETELT),rest v,first v,code]
+     if CONTAINED('$,w) then $epilogue := [code,:$epilogue]
+                        else codeList := [code,:codeList]
+  codeList
+ 
+PrepareConditional u == u
+ 
+setVector5(catNames,locals) ==
+  generated:= nil
+  for u in locals for uname in catNames repeat
+    if w:= ASSOC(u,generated)
+       then RPLACD(w,[uname,:rest w])
+       else generated:= [[u,uname],:generated]
+  [(w:= mkVectorWithDeferral(first u,first rest u);
+      for v in rest u repeat
+         w:= [($QuickCode => 'QSETREFV; 'SETELT),v,5,w];
+        w)
+          for u in generated]
+ 
+mkVectorWithDeferral(objects,tag) ==
+-- Basically a mkVector, but spots things that aren't safe to instantiate
+-- and places them at the end of $ConstantAssignments, so that they get
+-- called AFTER the constants of $ have been set up.   JHD 26.July.89
+  ['VECTOR,:
+   [if CONTAINED('$,u) then -- It's not safe to instantiate this now
+      $ConstantAssignments:=[:$ConstantAssignments,
+                             [($QuickCode=>'QSETREFV;'SETELT),
+                              [($QuickCode=>'QREFELT;'ELT), tag, 5],
+                                count,
+                                 u]]
+      []
+    else u
+       for u in objects for count in 0..]]
+ 
+DescendCodeAdd(base,flag) ==
+  atom base => DescendCodeVarAdd(base,flag)
+  not (modemap:=get(opOf base,'modemap,$CategoryFrame)) =>
+      if getmode(opOf base,$e) is ["Mapping",target,:formalArgModes]
+         then formalArgs:= take(#formalArgModes,$FormalMapVariableList)
+                --argument substitution if parameterized?
+ 
+         else keyedSystemError("S2OR0001",[opOf base])
+      DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes)
+  for [[[.,:formalArgs],target,:formalArgModes],.] in modemap repeat
+    (ans:= DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes))=>
+      return ans
+  ans
+ 
+DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
+  slist:= pairList(formalArgs,rest $addFormLhs)
+         --base = comp $addFormLhs-- bound in compAdd
+  e:= $e
+  newModes:= SUBLIS(slist,formalArgModes)
+  or/[not comp(u,m,e) for u in rest $addFormLhs for m in newModes] =>
+    return nil
+      --I should check that the actual arguments are of the right type
+  for u in formalArgs for m in newModes repeat
+    [.,.,e]:= compMakeDeclaration(['_:,u,m],m,e)
+      --we can not substitute in the formal arguments before we comp
+      --for that may change the shape of the object, but we must before
+      --we match signatures
+  cat:= (compMakeCategoryObject(target,e)).expr
+  instantiatedBase:= GENVAR()
+  n:=MAXINDEX cat
+  code:=
+    [u
+      for i in 6..n | not atom cat.i and not atom (sig:= first cat.i)
+         and
+          (u:=
+            SetFunctionSlots(SUBLIS(slist,sig),['ELT,instantiatedBase,i],flag,
+              'adding))^=nil]
+     --The code from here to the end is designed to replace repeated LOAD/STORE
+     --combinations (SETELT ...(ELT ..)) by MVCs where this is practicable
+  copyvec:=GETREFV (1+n)
+  for u in code repeat
+      if update(u,copyvec,[]) then code:=delete(u,code)
+    where update(code,copyvec,sofar) ==
+      ATOM code =>nil
+      MEMQ(QCAR code,'(ELT QREFELT)) =>
+          copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar)
+          true
+      code is [x,name,number,u'] and MEMQ(x,'(SETELT QSETREFV)) =>
+        update(u',copyvec,[[name,:number],:sofar])
+  for i in 6..n repeat
+    for u in copyvec.i repeat
+      [name,:count]:=u
+      j:=i+1
+      while j<= MIN(n,i+63) and LASSOC(name,copyvec.j) = count+j-i repeat j:=j+1
+             --Maximum length of an MVC is 64 words
+      j:=j-1
+      j > i+2 =>
+        for k in i..j repeat copyvec.k:=delete([name,:count+k-i],copyvec.k)
+        code:=[['REPLACE, name, instantiatedBase,
+                 INTERN('"START1",'"KEYWORD"), count,
+                  INTERN('"START2",'"KEYWORD"), i,
+                   INTERN('"END2",'"KEYWORD"), j+1],:code]
+    copyvec.i =>
+      v:=[($QuickCode => 'QREFELT;'ELT),instantiatedBase,i]
+      for u in copyvec.i repeat
+        [name,:count]:=u
+        v:=[($QuickCode => 'QSETREFV;'SETELT),name,count,v]
+      code:=[v,:code]
+  [['LET,instantiatedBase,base],:code]
+ 
+DescendCode(code,flag,viewAssoc,EnvToPass) ==
+  -- flag = true if we are walking down code always executed;
+  -- otherwise set to conditions in which
+  code=nil => nil
+  code='noBranch => nil
+  isMacro(code,$e) => nil --RDJ: added 3/16/83
+  code is ['add,base,:codelist] =>
+    codelist:=
+      [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil]
+                  -- must do this first, to get this overriding Add code
+    ['PROGN,:DescendCodeAdd(base,flag),:codelist]
+  code is ['PROGN,:codelist] =>
+    ['PROGN,:
+            --Two REVERSEs leave original order, but ensure last guy wins
+      NREVERSE [v for u in REVERSE codelist |
+                    (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil]]
+  code is ['COND,:condlist] =>
+    c:= [[u2:= ProcessCond(first u,viewAssoc),:q] for u in condlist] where q ==
+          null u2 => nil
+          f:=
+            TruthP u2 => flag;
+            TruthP flag =>
+               flag := ['NOT,u2]
+               u2
+            flag := ['AND,flag,['NOT,u2]];
+            ['AND,flag,u2]
+          [DescendCode(v, f,
+            if first u is ['HasCategory,dom,cat]
+              then [[dom,:cat],:viewAssoc]
+              else viewAssoc,EnvToPass) for v in rest u]
+    TruthP CAAR c => ['PROGN,:CDAR c]
+    while (c and (LAST c is [c1] or LAST c is [c1,[]]) and
+            (c1 = '(QUOTE T) or c1 is ['HasAttribute,:.])) repeat
+                   --strip out some worthless junk at the end
+        c:=NREVERSE CDR NREVERSE c
+    null c => '(LIST)
+    ['COND,:c]
+  code is ['LET,name,body,:.] =>
+                    --only keep the names that are useful
+    if body is [a,:.] and isFunctor a
+      then $packagesUsed:=[body,:$packagesUsed]
+    u:=member(name,$locals) =>
+        CONTAINED('$,body) and isDomainForm(body,$e) =>
+          --instantiate domains which depend on $ after constants are set
+          code:=[($QuickCode => 'QSETREFV; 'SETELT),[($QuickCode => 'QREFELT; 'ELT),'$,5],#$locals-#u,code]
+          $epilogue:=
+            TruthP flag => [code,:$epilogue]
+            [['COND,[ProcessCond(flag,viewAssoc),code]],:$epilogue]
+          nil
+        code
+    code -- doItIf deletes entries from $locals so can't optimize this
+  code is ['CodeDefine,sig,implem] =>
+             --Generated by doIt in COMPILER BOOT
+    dom:= EnvToPass
+    dom:=
+      u:= LASSOC(dom,viewAssoc) => ['getDomainView,dom,u]
+      dom
+    body:= ['CONS,implem,dom]
+    u:= SetFunctionSlots(sig,body,flag,'original)
+    ConstantCreator u =>
+      if not (flag=true) then u:= ['COND,[ProcessCond(flag,viewAssoc),u]]
+      $ConstantAssignments:= [u,:$ConstantAssignments]
+      nil
+    u
+  code is ['_:,:.] => (RPLACA(code,'LIST); RPLACD(code,NIL))
+      --Yes, I know that's a hack, but how else do you kill a line?
+  code is ['LIST,:.] => nil
+  code is ['devaluate,:.] => nil
+  code is ['MDEF,:.] => nil
+  code is ['call,:.] => code
+  code is ['SETELT,:.] => code -- can be generated by doItIf
+  code is ['QSETREFV,:.] => code -- can be generated by doItIf
+  stackWarning ['"unknown Functor code ",code]
+  code
+ 
+ConstantCreator u ==
+  null u => nil
+  u is [q,.,.,u'] and (q='SETELT or q='QSETREFV) => ConstantCreator u'
+  u is ['CONS,:.] => nil
+  true
+ 
+ProcessCond(cond,viewassoc) ==
+  ncond := SUBLIS($pairlis,cond)
+  INTEGERP POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond
+  cond
+--+
+TryGDC cond ==
+            --sees if a condition can be optimised by the use of
+            --information in $getDomainCode
+  atom cond => cond
+  cond is ['HasCategory,:l] =>
+    solved:= nil
+    for u in $getDomainCode | not solved repeat
+      if u is ['LET,name, =cond] then solved:= name
+    solved => solved
+    cond
+  cond
+ 
+SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding"
+--+
+  catNames := ['$]
+  for u in $catvecList for v in catNames repeat
+    null body => return NIL
+    for catImplem in LookUpSigSlots(sig,u.1) repeat
+      if catImplem is [q,.,index] and (q='ELT or q='CONST)
+         then
+          if q is 'CONST and body is ['CONS,a,b] then
+             body := ['CONS,'IDENTITY,['FUNCALL,a,b]]
+          body:= [($QuickCode => 'QSETREFV; 'SETELT),v,index,body]
+          if REFVECP $SetFunctions and TruthP flag then u.index:= true
+                 --used by CheckVector to determine which ops are missing
+          if v='$ then  -- i.e. we are looking at the principal view
+            not REFVECP $SetFunctions => nil
+                    --packages don't set it
+            $MissingFunctionInfo.index:= flag
+            TruthP $SetFunctions.index => (body:= nil; return nil)
+                     -- the function was already assigned
+            $SetFunctions.index:=
+              TruthP flag => true
+              not $SetFunctions.index=>flag --JHD didn't set $SF on this branch
+              ["or",$SetFunctions.index,flag]
+       else
+        if catImplem is ['Subsumed,:truename]
+                  --a special marker generated by SigListUnion
+           then
+            if mode='original 
+               then if truename is [fn,:.] and MEMQ(fn,'(Zero One))
+                    then nil  --hack by RDJ 8/90
+                    else body:= SetFunctionSlots(truename,body,nil,mode)
+               else nil
+           else
+            if not (catImplem is ['PAC,:.]) then
+              keyedSystemError("S2OR0002",[catImplem])
+  body is ['SETELT,:.] => body
+  body is ['QSETREFV,:.] => body
+  nil
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+LookUpSigSlots(sig,siglist) ==
+--+ must kill any implementations below of the form (ELT $ NIL)
+  siglist := $lisplibOperationAlist
+  REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u)
+              and KADDR implem]
+ 
+SigSlotsMatch(sig,pattern,implem) ==
+  sig=pattern => true
+  not (LENGTH CADR sig=LENGTH CADR pattern) => nil
+                       --CADR sig is the actual signature part
+  not (first sig=first pattern) => nil
+  pat' :=SUBSTQ($definition,'$,CADR pattern)
+  sig' :=SUBSTQ($definition,'$,CADR sig)
+  sig'=pat' => true
+  --If we don't have this next test, then we'll recurse in SetFunctionSlots
+  implem is ['Subsumed,:.] => nil
+  SourceLevelSubsume(sig',pat') => true
+  nil
+ 
+CheckVector(vec,name,catvecListMaker) ==
+  code:= nil
+  condAlist :=
+      [[a,:first b] for [.,a,:b] in $getDomainCode]
+        -- used as substitution alist below
+  for i in 6..MAXINDEX vec repeat
+    v:= vec.i
+    v=true => nil
+    null v => nil
+            --a domain, which setVector4part3 will fill in
+    atom v => systemErrorHere '"CheckVector"
+    atom first v =>
+                  --It's a secondary view of a domain, which we
+                  --must generate code to fill in
+      for x in $catNames for y in catvecListMaker repeat
+        if y=v then code:=
+          [[($QuickCode => 'QSETREFV; 'SETELT),name,i,x],:code]
+    if name='$ then
+      ASSOC(first v,$CheckVectorList) => nil
+      $CheckVectorList:=
+        [[first v,:makeMissingFunctionEntry(condAlist,i)],:$CheckVectorList]
+--  member(first v,$CheckVectorList) => nil
+--  $CheckVectorList:= [first v,:$CheckVectorList]
+  code
+ 
+makeMissingFunctionEntry(alist,i) ==
+  tran SUBLIS(alist,$MissingFunctionInfo.i) where
+    tran x ==
+      x is ["HasCategory",a,["QUOTE",b]] => ['has,a,b]
+      x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]]
+      x
+ 
+--%  Under what conditions may views exist?
+ 
+InvestigateConditions catvecListMaker ==
+  -- given a principal view and a list of secondary views,
+  -- discover under what conditions the secondary view are
+  -- always present.
+  $Conditions: local:= nil
+  $principal: local
+  [$principal,:secondaries]:= catvecListMaker
+      --We are not interested in the principal view
+      --The next block allows for the possibility that $principal may
+      --have conditional secondary views
+--+
+  null secondaries => '(T)
+      --return for packages which generally have no secondary views
+  if $principal is [op,:.] then
+    [principal',:.]:=compMakeCategoryObject($principal,$e)
+              --Rather like eval, but quotes parameters first
+    for u in CADR principal'.4 repeat
+      if not TruthP(cond:=CADR u) then
+        new:=['CATEGORY,'domain,['IF,cond,['ATTRIBUTE,CAR u], 'noBranch]]
+        $principal is ['Join,:l] =>
+          not member(new,l) =>
+            $principal:=['Join,:l,new]
+        $principal:=['Join,$principal,new]
+  principal' :=
+    pessimise $principal where
+      pessimise a ==
+        atom a => a
+        a is ['SIGNATURE,:.] => a
+        a is ['IF,cond,:.] =>
+          if not member(cond,$Conditions) then $Conditions:= [cond,:$Conditions]
+          nil
+        [pessimise first a,:pessimise rest a]
+  null $Conditions => [true,:[true for u in secondaries]]
+  PrincipalSecondaries:= getViewsConditions principal'
+  MinimalPrimary:= CAR first PrincipalSecondaries
+  MaximalPrimary:= CAAR $domainShell.4
+  necessarySecondaries:= [first u for u in PrincipalSecondaries | rest u=true]
+  and/[member(u,necessarySecondaries) for u in secondaries] =>
+    [true,:[true for u in secondaries]]
+  $HackSlot4:=
+    MinimalPrimary=MaximalPrimary => nil
+    MaximalPrimaries:=[MaximalPrimary,:CAR (CatEval MaximalPrimary).4]
+    MinimalPrimaries:=[MinimalPrimary,:CAR (CatEval MinimalPrimary).4]
+    MaximalPrimaries:=S_-(MaximalPrimaries,MinimalPrimaries)
+    [[x] for x in MaximalPrimaries]
+  ($Conditions:= Conds($principal,nil)) where
+    Conds(code,previous) ==
+           --each call takes a list of conditions, and returns a list
+           --of refinements of that list
+      atom code => [previous]
+      code is ['DomainSubstitutionMacro,.,b] => Conds(b,previous)
+      code is ['IF,a,b,c] => union(Conds(b,[a,:previous]),Conds(c,previous))
+      code is ['PROGN,:l] => "union"/[Conds(u,previous) for u in l]
+      code is ['CATEGORY,:l] => "union"/[Conds(u,previous) for u in l]
+      code is ['Join,:l] => "union"/[Conds(u,previous) for u in l]
+      [previous]
+  $Conditions:= EFFACE(nil,[EFFACE(nil,u) for u in $Conditions])
+  partList:=
+    [getViewsConditions partPessimise($principal,cond) for cond in $Conditions]
+  masterSecondaries:= secondaries
+  for u in partList repeat
+    for [v,:.] in u repeat
+      if not member(v,secondaries) then secondaries:= [v,:secondaries]
+  --PRETTYPRINT $Conditions
+  --PRETTYPRINT masterSecondaries
+  --PRETTYPRINT secondaries
+  (list:= [mkNilT member(u,necessarySecondaries) for u in secondaries]) where
+    mkNilT u ==
+      u => true
+      nil
+  for u in $Conditions for newS in partList repeat
+    --newS is a list of secondaries and conditions (over and above
+    --u) for which they apply
+    u:=
+      LENGTH u=1 => first u
+      ['AND,:u]
+    for [v,:.] in newS repeat
+      for v' in [v,:CAR (CatEval v).4] repeat
+        if (w:=ASSOC(v',$HackSlot4)) then
+          RPLAC(rest w,if rest w then mkOr(u,rest w) else u)
+    (list:= update(list,u,secondaries,newS)) where
+      update(list,cond,secondaries,newS) ==
+        (list2:=
+          [flist(sec,newS,old,cond) for sec in secondaries for old in list]) where
+            flist(sec,newS,old,cond) ==
+              old=true => old
+              for [newS2,:morecond] in newS repeat
+                old:=
+                  not AncestorP(sec,[newS2]) => old
+                  cond2:= mkAnd(cond,morecond)
+                  null old => cond2
+                  mkOr(cond2,old)
+              old
+        list2
+  list:= [[sec,:ICformat u] for u in list for sec in secondaries]
+  pv:= getPossibleViews $principal
+-- $HackSlot4 is used in SetVector4 to ensure that conditional
+-- extensions of the principal view are handles correctly
+-- here we build the code necessary to remove spurious extensions
+  ($HackSlot4:= [reshape u for u in $HackSlot4]) where
+    reshape u ==
+      ['COND,[TryGDC ICformat rest u],
+             ['(QUOTE T),['RPLACA,'(CAR TrueDomain),
+                             ['delete,['QUOTE,first u],'(CAAR TrueDomain)]]]]
+  $supplementaries:=
+    [u
+      for u in list | not member(first u,masterSecondaries)
+        and not (true=rest u) and not member(first u,pv)]
+  [true,:[LASSOC(ms,list) for ms in masterSecondaries]]
+ 
+ICformat u ==
+      atom u => u
+      u is ['has,:.] => compHasFormat u
+      u is ['AND,:l] or u is ['and,:l] =>
+        l:= REMDUP [ICformat v for [v,:l'] in tails l | not member(v,l')]
+             -- we could have duplicates after, even if not before
+        LENGTH l=1 => first l
+        l1:= first l
+        for u in rest l repeat
+          l1:=mkAnd(u,l1)
+        l1
+      u is ['OR,:l] =>
+        (l:= ORreduce l) where
+          ORreduce l ==
+            for u in l | u is ['AND,:.] or u is ['and,:.] repeat
+                                  --check that B causes (and A B) to go
+              for v in l | not (v=u) repeat
+                if member(v,u) or (and/[member(w,u) for w in v]) then l:=
+                  delete(u,l)
+                       --v subsumes u
+                           --Note that we are ignoring AND as a component.
+                           --Convince yourself that this code still works
+            l
+        LENGTH l=1 => ICformat first l
+        l:= ORreduce REMDUP [ICformat u for u in l]
+                 --causes multiple ANDs to be squashed, etc.
+                 -- and duplicates that have been built up by tidying
+        (l:= Hasreduce l) where
+          Hasreduce l ==
+            for u in l | u is ['HasCategory,name,cond] and cond is ['QUOTE,
+              cond] repeat
+                                  --check that v causes descendants to go
+                for v in l | not (v=u) and v is ['HasCategory, =name,['QUOTE,
+                  cond2]] repeat if DescendantP(cond,cond2) then l:= delete(u,l)
+                       --v subsumes u
+            for u in l | u is ['AND,:l'] or u is ['and,:l'] repeat
+              for u' in l' | u' is ['HasCategory,name,cond] and cond is ['QUOTE,
+                cond] repeat
+                                    --check that v causes descendants to go
+                  for v in l | v is ['HasCategory, =name,['QUOTE,
+                    cond2]] repeat if DescendantP(cond,cond2) then l:= delete(u,l)
+                         --v subsumes u
+            l
+        LENGTH l=1 => first l
+        ['OR,:l]
+      systemErrorHere '"ICformat"
+ 
+partPessimise(a,trueconds) ==
+  atom a => a
+  a is ['SIGNATURE,:.] => a
+  a is ['IF,cond,:.] => (member(cond,trueconds) => a; nil)
+  [partPessimise(first a,trueconds),:partPessimise(rest a,trueconds)]
+ 
+getPossibleViews u ==
+  --returns a list of all the categories that can be views of this one
+  [vec,:.]:= compMakeCategoryObject(u,$e) or
+    systemErrorHere '"getPossibleViews"
+  views:= [first u for u in CADR vec.4]
+  null vec.0 => [CAAR vec.4,:views] --*
+  [vec.0,:views] --*
+      --the two lines marked  ensure that the principal view comes first
+      --if you don't want it, CDR it off
+ 
+getViewsConditions u ==
+ 
+  --returns a list of all the categories that can be views of this one
+  --paired with the condition under which they are such views
+  [vec,:.]:= compMakeCategoryObject(u,$e) or
+    systemErrorHere '"getViewsConditions"
+  views:= [[first u,:CADR u] for u in CADR vec.4]
+  null vec.0 =>
+--+
+    null CAR vec.4 => views
+    [[CAAR vec.4,:true],:views] --*
+  [[vec.0,:true],:views] --*
+      --the two lines marked  ensure that the principal view comes first
+      --if you don't want it, CDR it off
+ 
+DescendCodeVarAdd(base,flag) ==
+   princview := CAR $catvecList
+   [SetFunctionSlots(sig,SUBST('ELT,'CONST,implem),flag,'adding) repeat
+       for i in 6..MAXINDEX princview |
+         princview.i is [sig:=[op,types],:.] and
+           LASSOC([base,:SUBST(base,'$,types)],get(op,'modemap,$e)) is
+                  [[pred,implem]]]
+ 
+resolvePatternVars(p,args) ==
+  p := SUBLISLIS(args, $TriangleVariableList, p)
+  SUBLISLIS(args, $FormalMapVariableList, p)
+
+--resolvePatternVars(p,args) ==
+--  atom p =>
+--    isSharpVarWithNum p => args.(position(p,$FormalMapVariableList))
+--    p
+--  [resolvePatternVars(CAR p,args),:resolvePatternVars(CDR p,args)]
+ 
+-- Mysterious JENKS definition follows:
+--DescendCodeVarAdd(base,flag) ==
+--  baseops := [(u:=LASSOC([base,:SUBST(base,'$,types)],
+--                    get(op,'modemap,$e))) and [sig,:u]
+--                       for (sig := [op,types]) in $CheckVectorList]
+--  $CheckVectorList := [sig for sig in $CheckVectorList
+--                           for op in baseops | null op]
+--  [SetFunctionSlots(sig,implem,flag,'adding)
+--                   for u in baseops | u is [sig,[pred,implem]]]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-boot.boot.pamphlet b/src/interp/g-boot.boot.pamphlet
new file mode 100644
index 00000000..63a7c00a
--- /dev/null
+++ b/src/interp/g-boot.boot.pamphlet
@@ -0,0 +1,485 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/g-boot.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- @(#)g-boot.boot	2.2      89/11/02  14:44:09
+
+--% BOOT to LISP Translation
+ 
+-- these supplement those in DEF and MACRO LISP
+ 
+--% Utilities
+ 
+ 
+$LET := 'SPADLET    -- LET is a standard macro in Common Lisp
+ 
+nakedEXIT? c ==
+  ATOM c => NIL
+  [a,:d] := c
+  IDENTP a =>
+    a = 'EXIT  => true
+    a = 'QUOTE => NIL
+    MEMQ(a,'(SEQ PROG LAMBDA MLAMBDA LAM)) => NIL
+    nakedEXIT?(d)
+  nakedEXIT?(a) or nakedEXIT?(d)
+ 
+mergeableCOND x ==
+  ATOM(x) or x isnt ['COND,:cls] => NIL
+  -- to be mergeable, every result must be an EXIT and the last
+  -- predicate must be a pair
+  ok := true
+  while (cls and ok) repeat
+    [[p,:r],:cls] := cls
+    PAIRP QCDR r => ok := NIL
+    CAR(r) isnt ['EXIT,.] => ok := NIL
+    NULL(cls) and ATOM(p) => ok := NIL
+    NULL(cls) and (p = ''T) => ok := NIL
+  ok
+ 
+mergeCONDsWithEXITs l ==
+  -- combines things like
+  -- (COND (foo (EXIT a)))
+  -- (COND (bar (EXIT b)))
+  -- into one COND
+  NULL l => NIL
+  ATOM l => l
+  NULL PAIRP QCDR l => l
+  a := QCAR l
+  if a is ['COND,:.] then a := flattenCOND a
+  am := mergeableCOND a
+  CDR(l) is [b,:k] and am and mergeableCOND(b) =>
+    b:= flattenCOND b
+    c := ['COND,:QCDR a,:QCDR b]
+    mergeCONDsWithEXITs [flattenCOND c,:k]
+  CDR(l) is [b] and am =>
+    [removeEXITFromCOND flattenCOND ['COND,:QCDR a,[''T,b]]]
+  [a,:mergeCONDsWithEXITs CDR l]
+ 
+removeEXITFromCOND? c ==
+  -- c is '(COND ...)
+  -- only can do it if every clause simply EXITs
+  ok := true
+  c := CDR c
+  while ok and c repeat
+    [[p,:r],:c] := c
+    nakedEXIT? p => ok := NIL
+    [:f,r1] := r
+    nakedEXIT? f => ok := NIL
+    r1 isnt ['EXIT,r2] => ok := NIL
+    nakedEXIT? r2 => ok := NIL
+  ok
+ 
+removeEXITFromCOND c ==
+  -- c is '(COND ...)
+  z := NIL
+  for cl in CDR c repeat
+    ATOM cl => z := CONS(cl,z)
+    cond := QCAR cl
+    length1? cl =>
+      PAIRP(cond) and EQCAR(cond,'EXIT) =>
+        z := CONS(QCDR cond,z)
+      z := CONS(cl,z)
+    cl' := REVERSE cl
+    lastSE := QCAR cl'
+    ATOM lastSE => z := CONS(cl,z)
+    EQCAR(lastSE,'EXIT) =>
+      z := CONS(REVERSE CONS(CADR lastSE,CDR cl'),z)
+    z := CONS(cl,z)
+  CONS('COND,NREVERSE z)
+ 
+flattenCOND body ==
+  -- transforms nested COND clauses to flat ones, if possible
+  body isnt ['COND,:.] => body
+  ['COND,:extractCONDClauses body]
+ 
+extractCONDClauses clauses ==
+  -- extracts nested COND clauses into a flat structure
+  clauses is ['COND, [pred1,:act1],:restClauses] =>
+    if act1 is [['PROGN,:acts]] then act1 := acts
+    restClauses is [[''T,restCond]] =>
+      [[pred1,:act1],:extractCONDClauses restCond]
+    [[pred1,:act1],:restClauses]
+  [[''T,clauses]]
+ 
+--% COND and IF
+ 
+bootIF c ==
+  -- handles IF expressions by turning them into CONDs
+  c is [.,p,t] => bootCOND ['COND,[p,t]]
+  [.,p,t,e] := c
+  bootCOND ['COND,[p,t],[''T,e]]
+ 
+bootCOND c ==
+  -- handles COND expressions: c is ['COND,:.]
+  cls := CDR c
+  NULL cls => NIL
+  cls is [[''T,r],:.] => r
+  [:icls,fcls] := cls
+  ncls := NIL
+  for cl in icls repeat
+    [p,:r] := cl
+    ncls :=
+      r is [['PROGN,:r1]] => CONS([p,:r1],ncls)
+      CONS(cl,ncls)
+  fcls := bootPushEXITintoCONDclause fcls
+  ncls :=
+    fcls is [''T,['COND,:mcls]] =>
+      APPEND(REVERSE mcls,ncls)
+    fcls is [''T,['PROGN,:mcls]] =>
+      CONS([''T,:mcls],ncls)
+    CONS(fcls,ncls)
+  ['COND,:REVERSE ncls]
+ 
+bootPushEXITintoCONDclause e ==
+  e isnt [''T,['EXIT,['COND,:cls]]] => e
+  ncls := NIL
+  for cl in cls repeat
+    [p,:r] := cl
+    ncls :=
+      r is [['EXIT,:.]] => CONS(cl,ncls)
+      r is [r1]           => CONS([p,['EXIT,r1]],ncls)
+      CONS([p,['EXIT,bootTran ['PROGN,:r]]],ncls)
+  [''T,['COND,:NREVERSE ncls]]
+ 
+--% SEQ and PROGN
+ 
+-- following is a more sophisticated def than that in MACRO LISP
+-- it is used for boot code
+ 
+tryToRemoveSEQ e ==
+  -- returns e if unsuccessful
+  e isnt ['SEQ,cl,:cls] => NIL
+  nakedEXIT? cl =>
+    cl is ['COND,[p,['EXIT,r]],:ccls] =>
+      nakedEXIT? p or nakedEXIT? r => e
+      null ccls =>
+        bootCOND ['COND,[p,r],[''T,bootSEQ ['SEQ,:cls]]]
+      bootCOND ['COND,[p,r],[''T,bootSEQ ['SEQ,['COND,:ccls],:cls]]]
+    e
+  bootPROGN ['PROGN,cl,bootSEQ ['SEQ,:cls]]
+ 
+bootAbsorbSEQsAndPROGNs e ==
+  -- assume e is a list from a SEQ or a PROGN
+  ATOM e => e
+  [:cls,lcl] := e
+  g := [:flatten(f) for f in cls] where
+    flatten x ==
+      NULL x => NIL
+      IDENTP x =>
+        MEMQ(x,$labelsForGO) => [x]
+        NIL
+      ATOM x => NIL
+      x is ['PROGN,:pcls,lpcl] =>
+        ATOM lpcl => pcls
+        CDR x
+      -- next usually comes about from if foo then bar := zap
+      x is ['COND,y,[''T,'NIL]] => [['COND,y]]
+      [x]
+  while lcl is ['EXIT,f] repeat
+    lcl := f
+  lcl is ['PROGN,:pcls] => APPEND(g,pcls)
+  lcl is ['COND,[''T,:pcls]] => APPEND(g,pcls)
+  lcl is ['COND,[pred,['EXIT,h]]] =>
+    APPEND(g,[['COND,[pred,h]]])
+  APPEND(g,[lcl])
+ 
+bootSEQ e ==
+  e := ['SEQ,:mergeCONDsWithEXITs bootAbsorbSEQsAndPROGNs CDR e]
+  if e is [.,:cls,lcl] and IDENTP lcl and not MEMQ(lcl,$labelsForGO) then
+    e := ['SEQ,:cls,['EXIT,lcl]]
+  cls := QCDR e
+  cls is [['SEQ,:.]] => tryToRemoveSEQ QCAR cls
+  cls is [['EXIT,body]] =>
+    nakedEXIT? body => bootTran ['SEQ,body]
+    body
+  not (nakedEXIT?(cls) or "or"/[MEMQ(g,$labelsForGO) for g in cls]) =>
+    bootTran ['PROGN,:cls]
+  e is ['SEQ,['COND,[pred,['EXIT,r1]]],:r2] =>
+    nakedEXIT?(pred) or nakedEXIT?(r1) or nakedEXIT?(r2) =>
+      tryToRemoveSEQ e
+    bootTran ['COND,[pred,r1],[''T,:r2]]
+  tryToRemoveSEQ e
+ 
+bootPROGN e ==
+  e := ['PROGN,:bootAbsorbSEQsAndPROGNs CDR e]
+  [.,:cls] := e
+  NULL cls => NIL
+  cls is [body] => body
+  e
+ 
+--% LET
+ 
+defLetForm(lhs,rhs) ==
+--if functionp lhs then
+--  sayMSG ['"Danger: Reassigning value to LISP function:",:bright lhs]
+  [$LET,lhs,rhs]
+ 
+defLET1(lhs,rhs) ==
+  IDENTP lhs         => defLetForm(lhs,rhs)
+  lhs is ['FLUID,id] => defLetForm(lhs,rhs)
+  IDENTP rhs and not CONTAINED(rhs,lhs) =>
+    rhs' := defLET2(lhs,rhs)
+    EQCAR(rhs',$LET) => MKPROGN [rhs',rhs]
+    EQCAR(rhs','PROGN) => APPEND(rhs',[rhs])
+    if IDENTP CAR rhs' then rhs' := CONS(rhs',NIL)
+    MKPROGN [:rhs',rhs]
+  PAIRP(rhs) and EQCAR(rhs, $LET) and IDENTP(name := CADR rhs) =>
+    -- handle things like [a] := x := foo
+    l1 := defLET1(name,CADDR rhs)
+    l2 := defLET1(lhs,name)
+    EQCAR(l2,'PROGN) => MKPROGN [l1,:CDR l2]
+    if IDENTP CAR l2 then l2 := cons(l2,nil)
+    MKPROGN [l1,:l2,name]
+  g := INTERN STRCONC('"LETTMP#",STRINGIMAGE $letGenVarCounter)
+  $letGenVarCounter := $letGenVarCounter + 1
+  rhs' := [$LET,g,rhs]
+  let' := defLET1(lhs,g)
+  EQCAR(let','PROGN) => MKPROGN [rhs',:CDR let']
+  if IDENTP CAR let' then let' := CONS(let',NIL)
+  MKPROGN [rhs',:let',g]
+ 
+defLET2(lhs,rhs) ==
+  IDENTP lhs => defLetForm(lhs,rhs)
+  NULL lhs   => NIL
+  lhs is ['FLUID,id] => defLetForm(lhs,rhs)
+  lhs is [=$LET,a,b] =>
+    a := defLET2(a,rhs)
+    null (b := defLET2(b,rhs)) => a
+    ATOM b => [a,b]
+    PAIRP QCAR b => CONS(a,b)
+    [a,b]
+  lhs is ['CONS,var1,var2] =>
+    var1 = "." or (PAIRP(var1) and EQCAR(var1,'QUOTE)) =>
+      defLET2(var2,addCARorCDR('CDR,rhs))
+    l1 := defLET2(var1,addCARorCDR('CAR,rhs))
+    MEMQ(var2,'(NIL _.)) => l1
+    if PAIRP l1 and ATOM CAR l1 then l1 := cons(l1,nil)
+    IDENTP var2 =>
+      [:l1,defLetForm(var2,addCARorCDR('CDR,rhs))]
+    l2 := defLET2(var2,addCARorCDR('CDR,rhs))
+    if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    APPEND(l1,l2)
+  lhs is ['APPEND,var1,var2] =>
+    patrev := defISReverse(var2,var1)
+    rev := ['REVERSE,rhs]
+    g := INTERN STRCONC('"LETTMP#",STRINGIMAGE $letGenVarCounter)
+    $letGenVarCounter := $letGenVarCounter + 1
+    l2 := defLET2(patrev,g)
+    if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    var1 = "." => [[$LET,g,rev],:l2]
+    last l2 is [=$LET, =var1, val1] =>
+      [[$LET,g,rev],:REVERSE CDR REVERSE l2,
+       defLetForm(var1,['NREVERSE,val1])]
+    [[$LET,g,rev],:l2,defLetForm(var1,['NREVERSE,var1])]
+  lhs is ['EQUAL,var1] =>
+    ['COND,[['EQUAL,var1,rhs],var1]]
+  -- let the IS code take over from here
+  isPred :=
+    $inDefIS => defIS1(rhs,lhs)
+    defIS(rhs,lhs)
+  ['COND,[isPred,rhs]]
+ 
+defLET(lhs,rhs) ==
+  $letGenVarCounter : local := 1
+  $inDefLET : local := true
+  defLET1(lhs,rhs)
+ 
+addCARorCDR(acc,expr) ==
+  NULL PAIRP expr => [acc,expr]
+  acc = 'CAR and EQCAR(expr,'REVERSE) =>
+    cons('last,QCDR expr)
+  funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
+            CDAAR CDDAR CDADR CDDDR)
+  p := position(QCAR expr,funs)
+  p = -1 => [acc,expr]
+  funsA := '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR CAAADR
+             CAADDR CADAAR CADDAR CADADR CADDDR)
+  funsR := '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR CDAADR
+             CDADDR CDDAAR CDDDAR CDDADR CDDDDR)
+  if acc = 'CAR then CONS(funsA.p,QCDR expr)
+  else               CONS(funsR.p,QCDR expr)
+ 
+ 
+--% IS
+ 
+defISReverse(x,a) ==
+  -- reverses forms coming from APPENDs in patterns
+  -- pretty much just a translation of DEF-IS-REV
+  x is ['CONS,:.] =>
+    NULL CADDR x => ['CONS,CADR x, a]
+    y := defISReverse(CADDR x, NIL)
+    RPLAC(CADDR y,['CONS,CADR x,a])
+    y
+  ERRHUH()
+ 
+defIS1(lhs,rhs) ==
+  NULL rhs =>
+    ['NULL,lhs]
+  STRINGP rhs =>
+    ['EQ,lhs,['QUOTE,INTERN rhs]]
+  NUMBERP rhs =>
+    ['EQUAL,lhs,rhs]
+  ATOM rhs =>
+    ['PROGN,defLetForm(rhs,lhs),''T]
+  rhs is ['QUOTE,a] =>
+    IDENTP a => ['EQ,lhs,rhs]
+    ['EQUAL,lhs,rhs]
+  rhs is [=$LET,c,d] =>
+    l :=
+      $inDefLET => defLET1(c,lhs)
+      defLET(c,lhs)
+    ['AND,defIS1(lhs,d),MKPROGN [l,''T]]
+  rhs is ['EQUAL,a] =>
+    ['EQUAL,lhs,a]
+  PAIRP lhs =>
+    g := INTERN STRCONC('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+    $isGenVarCounter := $isGenVarCounter + 1
+    MKPROGN [[$LET,g,lhs],defIS1(g,rhs)]
+  rhs is ['CONS,a,b] =>
+    a = "." =>
+      NULL b =>
+        ['AND,['PAIRP,lhs],
+              ['EQ,['QCDR,lhs],'NIL]]
+      ['AND,['PAIRP,lhs],
+            defIS1(['QCDR,lhs],b)]
+    NULL b =>
+      ['AND,['PAIRP,lhs],
+            ['EQ,['QCDR,lhs],'NIL],_
+            defIS1(['QCAR,lhs],a)]
+    b = "." =>
+      ['AND,['PAIRP,lhs],defIS1(['QCAR,lhs],a)]
+    a1 := defIS1(['QCAR,lhs],a)
+    b1 := defIS1(['QCDR,lhs],b)
+    a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] =>
+      ['AND,['PAIRP,lhs],MKPROGN [c,:cls]]
+    ['AND,['PAIRP,lhs],a1,b1]
+  rhs is ['APPEND,a,b] =>
+    patrev := defISReverse(b,a)
+    g := INTERN STRCONC('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+    $isGenVarCounter := $isGenVarCounter + 1
+    rev := ['AND,['PAIRP,lhs],['PROGN,[$LET,g,['REVERSE,lhs]],''T]]
+    l2 := defIS1(g,patrev)
+    if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    a = "." => ['AND,rev,:l2]
+    ['AND,rev,:l2,['PROGN,defLetForm(a,['NREVERSE,a]),''T]]
+  SAY '"WARNING (defIS1): possibly bad IS code being generated"
+  DEF_-IS [lhs,rhs]
+ 
+defIS(lhs,rhs) ==
+  $isGenVarCounter : local := 1
+  $inDefIS : local := true
+  defIS1(DEFTRAN lhs,rhs)
+ 
+--% OR and AND
+ 
+bootOR e ==
+  -- flatten any contained ORs.
+  cls := CDR e
+  NULL cls => NIL
+  NULL CDR cls => CAR cls
+  ncls := [:flatten(c) for c in cls] where
+    flatten x ==
+      x is ['OR,:.] => QCDR x
+      [x]
+  ['OR,:ncls]
+ 
+bootAND e ==
+  -- flatten any contained ANDs.
+  cls := CDR e
+  NULL cls => 'T
+  NULL CDR cls => CAR cls
+  ncls := [:flatten(c) for c in cls] where
+    flatten x ==
+      x is ['AND,:.] => QCDR x
+      [x]
+  ['AND,:ncls]
+ 
+--% Main Transformation Functions
+ 
+bootLabelsForGO e ==
+  ATOM e => NIL
+  [head,:tail] := e
+  IDENTP head =>
+    head = 'GO => $labelsForGO := CONS(CAR tail,$labelsForGO)
+    head = 'QUOTE => NIL
+    bootLabelsForGO tail
+  bootLabelsForGO head
+  bootLabelsForGO tail
+ 
+bootTran e ==
+  ATOM e => e
+  [head,:tail] := e
+  head = 'QUOTE => e
+  tail := [bootTran t for t in tail]
+  e := [head,:tail]
+  IDENTP head =>
+    head = 'IF    => bootIF e
+    head = 'COND  => bootCOND e
+    head = 'PROGN => bootPROGN  e
+    head = 'SEQ   => bootSEQ  e
+    head = 'OR    => bootOR  e
+    head = 'AND   => bootAND  e
+    e
+  [bootTran head,:QCDR e]
+ 
+bootTransform e ==
+--NULL $BOOT => e
+  $labelsForGO : local := NIL
+  bootLabelsForGO e
+  bootTran e
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-cndata.boot.pamphlet b/src/interp/g-cndata.boot.pamphlet
new file mode 100644
index 00000000..7e09df96
--- /dev/null
+++ b/src/interp/g-cndata.boot.pamphlet
@@ -0,0 +1,262 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp g-cndata.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Manipulation of Constructor Datat
+
+--=======================================================================
+--            Build Table of Lower Case Constructor Names
+--=======================================================================
+mkLowerCaseConTable() ==
+--Called at system build time by function BUILD-INTERPSYS (see util.lisp)
+--Table is referenced by functions conPageFastPath and grepForAbbrev
+  $lowerCaseConTb := MAKE_-HASH_-TABLE()
+  for x in allConstructors() repeat augmentLowerCaseConTable x
+  $lowerCaseConTb
+
+augmentLowerCaseConTable x ==
+  y:=GETDATABASE(x,'ABBREVIATION)
+  item:=[x,y,nil]
+  HPUT($lowerCaseConTb,x,item)
+  HPUT($lowerCaseConTb,DOWNCASE x,item)
+  HPUT($lowerCaseConTb,y,item)
+
+getCDTEntry(info,isName) ==
+  not IDENTP info => NIL
+  (entry := HGET($lowerCaseConTb,info)) =>
+    [name,abb,:.] := entry
+    isName and EQ(name,info) => entry
+    not isName and EQ(abb,info) => entry
+    NIL
+  entry
+ 
+putConstructorProperty(name,prop,val) ==
+  null (entry := getCDTEntry(name,true)) => NIL
+  RPLACD(CDR entry,PUTALIST(CDDR entry,prop,val))
+  true
+
+attribute? name == 
+	MEMQ(name, _*ATTRIBUTES_*)
+ 
+abbreviation? abb ==
+  -- if it is an abbreviation, return the corresponding name
+  GETDATABASE(abb,'CONSTRUCTOR)
+ 
+constructor? name ==
+  -- if it is a constructor name, return the abbreviation
+  GETDATABASE(name,'ABBREVIATION)
+ 
+domainForm? d ==
+  GETDATABASE(opOf d,'CONSTRUCTORKIND) = 'domain
+
+packageForm? d ==
+  GETDATABASE(opOf d,'CONSTRUCTORKIND) = 'package
+
+categoryForm? c ==
+  op := opOf c
+  MEMQ(op, $CategoryNames) => true
+  GETDATABASE(op,'CONSTRUCTORKIND) = 'category => true
+  nil
+
+getImmediateSuperDomain(d) ==
+  IFCAR GETDATABASE(opOf d, 'SUPERDOMAIN)
+
+maximalSuperType d ==
+  d' := GETDATABASE(opOf d, 'SUPERDOMAIN) => maximalSuperType first d'
+  d
+
+-- probably will switch over to 'libName soon
+getLisplibName(c) == getConstructorAbbreviation(c)
+ 
+getConstructorAbbreviation op ==
+  constructor?(op) or throwKeyedMsg("S2IL0015",[op])
+ 
+getConstructorUnabbreviation op ==
+  abbreviation?(op) or throwKeyedMsg("S2IL0019",[op])
+ 
+mkUserConstructorAbbreviation(c,a,type) ==
+  if not atom c then c:= CAR c  --  Existing constructors will be wrapped
+  constructorAbbreviationErrorCheck(c,a,type,'abbreviationError)
+  clearClams()
+  clearConstructorCache(c)
+  installConstructor(c,type)
+  setAutoLoadProperty(c)
+ 
+abbQuery(x) ==
+  abb := GETDATABASE(x,'ABBREVIATION) =>
+   sayKeyedMsg("S2IZ0001",[abb,GETDATABASE(x,'CONSTRUCTORKIND),x])
+  sayKeyedMsg("S2IZ0003",[x])
+ 
+installConstructor(cname,type) ==
+  (entry := getCDTEntry(cname,true)) => entry
+  item := [cname,GETDATABASE(cname,'ABBREVIATION),nil]
+  if BOUNDP '$lowerCaseConTb and $lowerCaseConTb then
+    HPUT($lowerCaseConTb,cname,item)
+    HPUT($lowerCaseConTb,DOWNCASE cname,item)
+ 
+constructorNameConflict(name,kind) ==
+  userError
+    ["The name",:bright name,"conflicts with the name of an existing rule",
+      "%l","please choose another ",kind]
+ 
+constructorAbbreviationErrorCheck(c,a,typ,errmess) ==
+  siz := SIZE (s := PNAME a)
+  if typ = 'category and siz > 7
+    then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL)
+  if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL)
+  if s ^= UPCASE s then throwKeyedMsg("S2IL0006",NIL)
+  abb := GETDATABASE(c,'ABBREVIATION)
+  name:= GETDATABASE(a,'CONSTRUCTOR)
+  type := GETDATABASE(c,'CONSTRUCTORKIND)
+  a=abb and c^=name => lisplibError(c,a,typ,abb,name,type,'duplicateAbb)
+  a=name and c^=name => lisplibError(c,a,typ,abb,name,type,'abbIsName)
+  c=name and typ^=type => lisplibError(c,a,typ,abb,name,type,'wrongType)
+ 
+abbreviationError(c,a,typ,abb,name,type,error) ==
+  sayKeyedMsg("S2IL0009",[a,typ,c])
+  error='duplicateAbb =>
+    throwKeyedMsg("S2IL0010",[a,typ,name])
+  error='abbIsName =>
+    throwKeyedMsg("S2IL0011",[a,type])
+  error='wrongType =>
+    throwKeyedMsg("S2IL0012",[c,type])
+  NIL
+ 
+abbreviate u ==
+  u is ['Union,:arglist] =>
+    ['Union,:[abbreviate a for a in arglist]]
+  u is [op,:arglist] =>
+    abb := constructor?(op) =>
+      [abb,:condAbbrev(arglist,getPartialConstructorModemapSig(op))]
+    u
+  constructor?(u) or u
+ 
+unabbrev u == unabbrev1(u,nil)
+ 
+unabbrevAndLoad u == unabbrev1(u,true)
+ 
+isNameOfType x ==
+  $doNotAddEmptyModeIfTrue:local:= true
+  (val := get(x,'value,$InteractiveFrame)) and
+    (domain := objMode val) and
+      domain in '((Mode) (Domain) (SubDomain (Domain))) => true
+  y := opOf unabbrev x
+  constructor? y
+ 
+unabbrev1(u,modeIfTrue) ==
+  atom u =>
+    modeIfTrue =>
+      d:= isDomainValuedVariable u => u
+      a := abbreviation? u =>
+        GETDATABASE(a,'NILADIC) => [a]
+        largs := ['_$EmptyMode for arg in
+          getPartialConstructorModemapSig(a)]
+        unabbrev1([u,:largs],modeIfTrue)
+      u
+    a:= abbreviation?(u) or u
+    GETDATABASE(a,'NILADIC) => [a]
+    a
+  [op,:arglist] := u
+  op = 'Join => ['Join, :[unabbrev1(x, modeIfTrue) for x in arglist]]
+  d:= isDomainValuedVariable op =>
+    throwKeyedMsg("S2IL0013",[op,d])
+  (r := unabbrevSpecialForms(op,arglist,modeIfTrue)) => r
+  (cname := abbreviation? op) or (constructor?(op) and (cname := op)) =>
+    (r := unabbrevSpecialForms(cname,arglist,modeIfTrue)) => r
+    -- ??? if modeIfTrue then loadIfNecessary cname
+    [cname,:condUnabbrev(op,arglist,
+      getPartialConstructorModemapSig(cname),modeIfTrue)]
+  u
+ 
+unabbrevSpecialForms(op,arglist,modeIfTrue) ==
+  op = 'Mapping => [op,:[unabbrev1(a,modeIfTrue) for a in arglist]]
+  op = 'Union   =>
+    [op,:[unabbrevUnionComponent(a,modeIfTrue) for a in arglist]]
+  op = 'Record =>
+    [op,:[unabbrevRecordComponent(a,modeIfTrue) for a in arglist]]
+  nil
+ 
+unabbrevRecordComponent(a,modeIfTrue) ==
+  a is ["Declare",b,T] or a is [":",b,T] =>
+    [":",b,unabbrev1(T,modeIfTrue)]
+  userError "wrong format for Record type"
+ 
+unabbrevUnionComponent(a,modeIfTrue) ==
+  a is ["Declare",b,T] or a is [":",b,T] =>
+    [":",b,unabbrev1(T,modeIfTrue)]
+  unabbrev1(a, modeIfTrue)
+ 
+condAbbrev(arglist,argtypes) ==
+  res:= nil
+  for arg in arglist for type in argtypes repeat
+    if categoryForm?(type) then arg:= abbreviate arg
+    res:=[:res,arg]
+  res
+ 
+condUnabbrev(op,arglist,argtypes,modeIfTrue) ==
+  #arglist ^= #argtypes =>
+    throwKeyedMsg("S2IL0014",[op,plural(#argtypes,'"argument"),
+      bright(#arglist)])
+  [newArg for arg in arglist for type in argtypes] where newArg ==
+    categoryForm?(type) => unabbrev1(arg,modeIfTrue)
+    arg
+ 
+--% Code Being Phased Out
+ 
+nAssocQ(x,l,n) ==
+  repeat
+    if atom l then return nil
+    if EQ(x,(QCAR l).n) then return QCAR l
+    l:= QCDR l
+ 
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-error.boot.pamphlet b/src/interp/g-error.boot.pamphlet
new file mode 100644
index 00000000..e9f9a30b
--- /dev/null
+++ b/src/interp/g-error.boot.pamphlet
@@ -0,0 +1,223 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/g-error.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- This file contains the error printing code used in BOOT and SPAD.
+-- While SPAD only calls "error" (which is then labeled as an algebra
+-- error, BOOT calls "userError" and "systemError" when a problem is
+-- found.
+--
+-- The variable $BreakMode is set using the system command )set breakmode
+-- and can have one of the values:
+--   break    -- always enter a lisp break when an error is signalled
+--   nobreak  -- do not enter lisp break mode
+--   query    -- ask the user if break mode should be entered
+
+SETANDFILEQ($SystemError,'SystemError)
+SETANDFILEQ($UserError,'UserError)
+SETANDFILEQ($AlgebraError,'AlgebraError)
+
+-- REDERR is used in BFLOAT LISP, should be a macro
+-- REDERR msg == error msg
+
+-- BFLERRMSG func ==
+--  errorSupervisor($AlgebraError,STRCONC(
+--    '"BigFloat: invalid argument to ",func))
+
+argumentDataError(argnum, condit, funname) ==
+  msg := ['"The test",:bright pred2English condit,'"evaluates to",
+    :bright '"false",'%l,'"   for argument",:bright argnum,_
+    '"to the function",:bright funname,'"and this indicates",'%l,_
+    '"   that the argument is not appropriate."]
+  errorSupervisor($AlgebraError,msg)
+
+queryUser msg ==
+  -- display message and return reply
+  sayBrightly msg
+  READ_-LINE _*TERMINAL_-IO_*
+
+-- errorSupervisor is the old style error message trapper
+
+errorSupervisor(errorType,errorMsg) ==
+  errorSupervisor1(errorType,errorMsg,$BreakMode)
+
+errorSupervisor1(errorType,errorMsg,$BreakMode) ==
+  $cclSystem and $BreakMode = 'trapNumerics => 
+    THROW('trapNumerics,$numericFailure)
+  BUMPCOMPERRORCOUNT()
+  errorLabel :=
+      errorType = $SystemError  => '"System error"
+      errorType = $UserError    => '"Apparent user error"
+      errorType = $AlgebraError =>
+        '"Error detected within library code"
+      STRINGP errorType         => errorType
+      '"Error with unknown classification"
+  msg :=
+    errorMsg is ['mathprint, :.] => errorMsg
+    not PAIRP errorMsg => ['"   ", errorMsg]
+    splitmsg := true
+    if member('%b,errorMsg) then splitmsg := nil
+      else if member('%d,errorMsg) then splitmsg := nil
+           else if member('%l,errorMsg) then splitmsg := nil
+    splitmsg => CDR [:['%l,'"   ",u] for u in errorMsg]
+    ['"   ",:errorMsg]
+  sayErrorly(errorLabel, msg)
+  handleLispBreakLoop($BreakMode)
+
+handleLispBreakLoop($BreakMode) ==
+  TERPRI()
+  -- The next line is to try to deal with some reported cases of unwanted
+  -- backtraces appearing, MCD.
+  ENABLE_-BACKTRACE(nil)
+  $BreakMode = 'break =>
+    sayBrightly '" "
+    BREAK()
+  $BreakMode = 'query =>
+    gotIt := nil
+    while not gotIt repeat
+      gotIt := true
+      msgQ := 
+       $cclSystem =>
+         ['%l,'"   You have two options. Enter:",'%l,_
+          '"    ",:bright '"top     ",'"  to return to top level, or",'%l,_
+          '"    ",:bright '"break   ",'"  to enter a LISP break loop.",'%l,_
+          '%l,'"   Please enter your choice now:"]
+       ['%l,'"   You have three options. Enter:",'%l,_
+        '"    ",:bright '"continue",'"  to continue processing,",'%l,_
+        '"    ",:bright '"top     ",'"  to return to top level, or",'%l,_
+        '"    ",:bright '"break   ",'"  to enter a LISP break loop.",'%l,_
+        '%l,'"   Please enter your choice now:"]
+      x := STRING2ID_-N(queryUser msgQ,1)
+      x := 
+        $cclSystem =>
+          selectOptionLC(x,'(top break),NIL)
+        selectOptionLC(x,'(top break continue),NIL)
+      null x =>
+        sayBrightly bright '"  That was not one of your choices!"
+        gotIt := NIL
+      x = 'top => returnToTopLevel()
+      x = 'break =>
+        $BreakMode := 'break
+        if not $cclSystem then
+          sayBrightly ['"   Enter",:bright '":C",
+            '"when you are ready to continue processing where you ",'%l,_
+            '"   interrupted the system, enter",:bright '"(TOP)",_
+            '"when you wish to return",'%l,'"   to top level.",'%l,'%l]
+        BREAK()
+      sayBrightly
+        '"   Processing will continue where it was interrupted."
+      THROW('SPAD__READER, nil)
+  $BreakMode = 'resume =>
+    returnToReader()
+  returnToTopLevel()
+
+TOP() == returnToTopLevel()
+
+returnToTopLevel() ==
+  SETQ(CHR, "ENDOFLINECHR")
+  SETQ(TOK, 'END__UNIT)
+  TOPLEVEL()
+
+returnToReader() ==
+  ^$ReadingFile => returnToTopLevel()
+  sayBrightly ['"   Continuing to read the file...", '%l]
+  THROW('SPAD__READER, nil)
+
+sayErrorly(errorLabel, msg) ==
+  $saturn => saturnSayErrorly(errorLabel, msg)
+  sayErrorly1(errorLabel, msg)
+
+saturnSayErrorly(errorLabel, msg) ==
+  _*STANDARD_-OUTPUT_* : fluid := $texOutputStream
+  old := pushSatOutput("line")
+  sayString '"\bgroup\color{red}"
+  sayString '"\begin{verbatim}"
+  sayErrorly1(errorLabel, msg)
+  sayString '"\end{verbatim}"
+  sayString '"\egroup"
+  popSatOutput(old)
+
+sayErrorly1(errorLabel, msg) ==
+  sayBrightly '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayBrightly ['"   >> ",errorLabel,'":"]
+  m := msg
+  msg is ['mathprint, mathexpr] =>
+    mathprint mathexpr
+  sayBrightly msg
+
+-- systemError is being phased out. Please use keyedSystemError.
+systemError(:x) == errorSupervisor($SystemError,IFCAR x)
+
+-- unexpectedSystemError() ==
+--  systemError '"Oh, no.  Unexpected internal error."
+
+userError x == errorSupervisor($UserError,x)
+
+error(x) == errorSupervisor($AlgebraError,x)
+
+IdentityError(op) ==
+    error(["No identity element for reduce of empty list using operation",op])
+
+throwMessage(:msg) ==
+  if $compilingMap then clearCache $mapName
+  msg' := mkMessage concatList msg
+  sayMSG msg'
+  if $printMsgsToFile then sayMSG2File msg'
+  spadThrow()
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-opt.boot.pamphlet b/src/interp/g-opt.boot.pamphlet
new file mode 100644
index 00000000..33fad9dd
--- /dev/null
+++ b/src/interp/g-opt.boot.pamphlet
@@ -0,0 +1,421 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp g-opt.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% OPTIMIZER
+ 
+optimizeFunctionDef(def) ==
+  if $reportOptimization then
+    sayBrightlyI bright '"Original LISP code:"
+    pp def
+ 
+  def' := optimize COPY def
+ 
+  if $reportOptimization then
+    sayBrightlyI bright '"Optimized LISP code:"
+    pp def'
+    sayBrightlyI bright '"Final LISP code:"
+  [name,[slamOrLam,args,body]] := def'
+ 
+  body':=
+    removeTopLevelCatch body where
+      removeTopLevelCatch body ==
+        body is ["CATCH",g,u] =>
+          removeTopLevelCatch replaceThrowByReturn(u,g)
+        body
+      replaceThrowByReturn(x,g) ==
+        fn(x,g)
+        x
+      fn(x,g) ==
+        x is ["THROW", =g,:u] =>
+          rplac(first x,"RETURN")
+          rplac(rest x,replaceThrowByReturn(u,g))
+        atom x => nil
+        replaceThrowByReturn(first x,g)
+        replaceThrowByReturn(rest x,g)
+  [name,[slamOrLam,args,body']]
+ 
+optimize x ==
+  (opt x; x) where
+    opt x ==
+      atom x => nil
+      (y:= first x)='QUOTE => nil
+      y='CLOSEDFN => nil
+      y is [["XLAM",argl,body],:a] =>
+        optimize rest x
+        argl = "ignore" => RPLAC(first x,body)
+        if not (LENGTH argl<=LENGTH a) then
+          SAY '"length mismatch in XLAM expression"
+          PRETTYPRINT y
+        RPLAC(first x,optimize optXLAMCond SUBLIS(pairList(argl,a),body))
+      atom y =>
+        optimize rest x
+        y="true" => RPLAC(first x,'(QUOTE (QUOTE T)))
+        y="false" => RPLAC(first x,nil)
+      if first y="IF" then (RPLAC(first x,optIF2COND y); y:= first x)
+      op:= GETL(subrname first y,"OPTIMIZE") =>
+        (optimize rest x; RPLAC(first x,FUNCALL(op,optimize first x)))
+      RPLAC(first x,optimize first x)
+      optimize rest x
+ 
+subrname u ==
+  IDENTP u => u
+  COMPILED_-FUNCTION_-P u or MBPIP u => BPINAME u
+  nil
+ 
+optCatch (x is ["CATCH",g,a]) ==
+  $InteractiveMode => x
+  atom a => a
+  if a is ["SEQ",:s,["THROW", =g,u]] then
+    changeThrowToExit(s,g) where
+      changeThrowToExit(s,g) ==
+        atom s or MEMQ(first s,'(QUOTE SEQ REPEAT COLLECT)) => nil
+        s is ["THROW", =g,:u] => (rplac(first s,"EXIT"); rplac(rest s,u))
+        changeThrowToExit(first s,g)
+        changeThrowToExit(rest s,g)
+    rplac(rest a,[:s,["EXIT",u]])
+    ["CATCH",y,a]:= optimize x
+  if hasNoThrows(a,g)
+     then (rplac(first x,first a); rplac(rest x,rest a)) where
+      hasNoThrows(a,g) ==
+        a is ["THROW", =g,:.] => false
+        atom a => true
+        hasNoThrows(first a,g) and hasNoThrows(rest a,g)
+   else
+    changeThrowToGo(a,g) where
+      changeThrowToGo(s,g) ==
+        atom s or first s='QUOTE => nil
+        s is ["THROW", =g,u] =>
+          changeThrowToGo(u,g)
+          rplac(first s,"PROGN")
+          rplac(rest s,[["LET",CADR g,u],["GO",CADR g]])
+        changeThrowToGo(first s,g)
+        changeThrowToGo(rest s,g)
+    rplac(first x,"SEQ")
+    rplac(rest x,[["EXIT",a],CADR g,["EXIT",CADR g]])
+  x
+ 
+optSPADCALL(form is ['SPADCALL,:argl]) ==
+  null $InteractiveMode => form
+  -- last arg is function/env, but may be a form
+  argl is [:argl,fun] =>
+    fun is ['ELT,dom,slot] or fun is ['LISPELT,dom,slot] =>
+      optCall ['call,['ELT,dom,slot],:argl]
+    form
+  form
+ 
+optCall (x is ["call",:u]) ==
+  -- destructively optimizes this new x
+  x:= optimize [u]
+  -- next should happen only as result of macro expansion
+  atom first x => first x
+  [fn,:a]:= first x
+  atom fn => (RPLAC(rest x,a); RPLAC(first x,fn))
+  fn is ["PAC",:.] => optPackageCall(x,fn,a)
+  fn is ["applyFun",name] =>
+    (RPLAC(first x,"SPADCALL"); RPLAC(rest x,[:a,name]); x)
+  fn is [q,R,n] and MEMQ(q,'(ELT QREFELT CONST)) =>
+    not $bootStrapMode and (w:= optCallSpecially(q,x,n,R)) => w
+    q="CONST" =>
+--+
+      ["spadConstant",R,n]
+    --putInLocalDomainReferences will change this to ELT or QREFELT
+    RPLAC(first x,"SPADCALL")
+    if $QuickCode then RPLACA(fn,"QREFELT")
+    RPLAC(rest x,[:a,fn])
+    x
+  systemErrorHere '"optCall"
+ 
+optCallSpecially(q,x,n,R) ==
+    y:= LASSOC(R,$specialCaseKeyList) => optSpecialCall(x,y,n)
+    MEMQ(KAR R,$optimizableConstructorNames) => optSpecialCall(x,R,n)
+    (y:= get(R,"value",$e)) and
+      MEMQ(opOf y.expr,$optimizableConstructorNames) =>
+        optSpecialCall(x,y.expr,n)
+    (
+      (y:= lookup(R,$getDomainCode)) and ([op,y,prop]:= y) and
+        (yy:= LASSOC(y,$specialCaseKeyList)) =>
+         optSpecialCall(x,[op,yy,prop],n)) where
+            lookup(a,l) ==
+              null l => nil
+              [l',:l]:= l
+              l' is ["LET", =a,l',:.] => l'
+              lookup(a,l)
+    nil
+ 
+optCallEval u ==
+  u is ["List",:.] => List Integer()
+  u is ["Vector",:.] => Vector Integer()
+  u is ["PrimitiveArray",:.] => PrimitiveArray Integer()
+  u is ["FactoredForm",:.] => FactoredForm Integer()
+  u is ["Matrix",:.] => Matrix Integer()
+  eval u
+ 
+optCons (x is ["CONS",a,b]) ==
+  a="NIL" =>
+    b='NIL => (rplac(first x,'QUOTE); rplac(rest x,['NIL,:'NIL]); x)
+    b is ['QUOTE,:c] => (rplac(first x,'QUOTE); rplac(rest x,['NIL,:c]); x)
+    x
+  a is ['QUOTE,a'] =>
+    b='NIL => (rplac(first x,'QUOTE); rplac(rest x,[a',:'NIL]); x)
+    b is ['QUOTE,:c] => (rplac(first x,'QUOTE); rplac(rest x,[a',:c]); x)
+    x
+  x
+ 
+optSpecialCall(x,y,n) ==
+  yval := optCallEval y
+  CAAAR x="CONST" =>
+    KAR yval.n = function Undef =>
+      keyedSystemError("S2GE0016",['"optSpecialCall",
+        '"invalid constant"])
+    MKQ yval.n
+  fn := GETL(compileTimeBindingOf first yval.n,'SPADreplace) =>
+    rplac(rest x,CDAR x)
+    rplac(first x,fn)
+    if fn is ["XLAM",:.] then x:=first optimize [x]
+    x is ["EQUAL",:args] => RPLACW(x,DEF_-EQUAL args)
+                --DEF-EQUAL is really an optimiser
+    x
+  [fn,:a]:= first x
+  RPLAC(first x,"SPADCALL")
+  if $QuickCode then RPLACA(fn,"QREFELT")
+  RPLAC(rest x,[:a,fn])
+  x
+ 
+compileTimeBindingOf u ==
+  NULL(name:= BPINAME u)  => keyedSystemError("S2OO0001",[u])
+  name="Undef" => MOAN "optimiser found unknown function"
+  name
+ 
+optMkRecord ["mkRecord",:u] ==
+  u is [x] => ["LIST",x]
+  #u=2 => ["CONS",:u]
+  ["VECTOR",:u]
+ 
+optCond (x is ['COND,:l]) ==
+  if l is [a,[aa,b]] and TruthP aa and b is ["COND",:c] then
+    RPLACD(rest x,c)
+  if l is [[p1,:c1],[p2,:c2],:.] then
+    if (p1 is ['NULL,p1'] and p1' = p2) or (p2 is ['NULL,p2'] and p2' = p1) then
+      l:=[[p1,:c1],['(QUOTE T),:c2]]
+      RPLACD( x,l)
+    c1 is ['NIL] and p2 = '(QUOTE T) and first c2 = '(QUOTE T) =>
+      p1 is ['NULL,p1']=> return p1'
+      return ['NULL,p1]
+  l is [[p1,:c1],[p2,:c2],[p3,:c3]] and TruthP p3 =>
+    EqualBarGensym(c1,c3) =>
+      ["COND",[["OR",p1,["NULL",p2]],:c1],[['QUOTE,true],:c2]]
+    EqualBarGensym(c1,c2) => ["COND",[["OR",p1,p2],:c1],[['QUOTE,true],:c3]]
+    x
+  for y in tails l repeat
+    while y is [[a1,c1],[a2,c2],:y'] and EqualBarGensym(c1,c2) repeat
+      a:=['OR,a1,a2]
+      RPLAC(first first y,a)
+      RPLAC(rest y,y')
+  x
+ 
+AssocBarGensym(key,l) ==
+  for x in l repeat
+    PAIRP x =>
+      EqualBarGensym(key,CAR x) => return x
+ 
+EqualBarGensym(x,y) ==
+  $GensymAssoc: nil
+  fn(x,y) where
+    fn(x,y) ==
+      x=y => true
+      GENSYMP x and GENSYMP y =>
+        z:= ASSOC(x,$GensymAssoc) => (y=rest z => true; false)
+        $GensymAssoc:= [[x,:y],:$GensymAssoc]
+        true
+      null x => y is [g] and GENSYMP g
+      null y => x is [g] and GENSYMP g
+      atom x or atom y => false
+      fn(first x,first y) and fn(rest x,rest y)
+ 
+--Called early, to change IF to COND
+ 
+optIF2COND ["IF",a,b,c] ==
+  b is "noBranch" => ["COND",[["NULL",a],c]]
+  c is "noBranch" => ["COND",[a,b]]
+  c is ["IF",:.] => ["COND",[a,b],:rest optIF2COND c]
+  c is ["COND",:p] => ["COND",[a,b],:p]
+  ["COND",[a,b],[$true,c]]
+ 
+optXLAMCond x ==
+  x is ["COND",u:= [p,c],:l] =>
+    (optPredicateIfTrue p => c; ["COND",u,:optCONDtail l])
+  atom x => x
+  RPLAC(first x,optXLAMCond first x)
+  RPLAC(rest x,optXLAMCond rest x)
+  x
+ 
+optPredicateIfTrue p ==
+  p is ['QUOTE,:.] => true
+  p is [fn,x] and MEMQ(fn,$BasicPredicates) and FUNCALL(fn,x) => true
+  nil
+ 
+optCONDtail l ==
+  null l => nil
+  [frst:= [p,c],:l']:= l
+  optPredicateIfTrue p => [[$true,c]]
+  null rest l => [frst,[$true,["CondError"]]]
+  [frst,:optCONDtail l']
+ 
+optSEQ ["SEQ",:l] ==
+  tryToRemoveSEQ SEQToCOND getRidOfTemps l where
+    getRidOfTemps l ==
+      null l => nil
+      l is [["LET",g,x,:.],:r] and GENSYMP g and 2>numOfOccurencesOf(g,r) =>
+        getRidOfTemps substitute(x,g,r)
+      first l="/throwAway" => getRidOfTemps rest l
+      --this gets rid of unwanted labels generated by declarations in SEQs
+      [first l,:getRidOfTemps rest l]
+    SEQToCOND l ==
+      transform:= [[a,b] for x in l while (x is ["COND",[a,["EXIT",b]]])]
+      before:= take(#transform,l)
+      aft:= after(l,before)
+      null before => ["SEQ",:aft]
+      null aft => ["COND",:transform,'((QUOTE T) (conderr))]
+      true => ["COND",:transform,['(QUOTE T),optSEQ ["SEQ",:aft]]]
+    tryToRemoveSEQ l ==
+      l is ["SEQ",[op,a]] and MEMQ(op,'(EXIT RETURN THROW)) => a
+      l
+ 
+optRECORDELT ["RECORDELT",name,ind,len] ==
+  len=1 =>
+    ind=0 => ["QCAR",name]
+    keyedSystemError("S2OO0002",[ind])
+  len=2 =>
+    ind=0 => ["QCAR",name]
+    ind=1 => ["QCDR",name]
+    keyedSystemError("S2OO0002",[ind])
+  ["QVELT",name,ind]
+ 
+optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] ==
+  len=1 =>
+    ind=0 => ["PROGN",["RPLACA",name,expr],["QCAR",name]]
+    keyedSystemError("S2OO0002",[ind])
+  len=2 =>
+    ind=0 => ["PROGN",["RPLACA",name,expr],["QCAR",name]]
+    ind=1 => ["PROGN",["RPLACD",name,expr],["QCDR",name]]
+    keyedSystemError("S2OO0002",[ind])
+  ["QSETVELT",name,ind,expr]
+ 
+optRECORDCOPY ["RECORDCOPY",name,len] ==
+  len=1 => ["LIST",["CAR",name]]
+  len=2 => ["CONS",["CAR",name],["CDR",name]]
+  ["MOVEVEC",["MAKE_-VEC",len],name]
+ 
+--mkRecordAccessFunction(ind,len) ==
+--  stringOfDs:= $EmptyString
+--  for i in 0..(ind-1) do stringOfDs:= STRCONC(stringOfDs,PNAME "D")
+--  prefix:= if ind=len-1 then PNAME "C" else PNAME "CA"
+--  if $QuickCode then prefix:=STRCONC("Q",prefix)
+--  INTERN(STRCONC(prefix,stringOfDs,PNAME "R"))
+ 
+optSuchthat [.,:u] == ["SUCHTHAT",:u]
+ 
+optMINUS u ==
+  u is ['MINUS,v] =>
+    NUMBERP v => -v
+    u
+  u
+ 
+optQSMINUS u ==
+  u is ['QSMINUS,v] =>
+    NUMBERP v => -v
+    u
+  u
+ 
+opt_- u ==
+  u is ['_-,v] =>
+    NUMBERP v => -v
+    u
+  u
+ 
+optLESSP u ==
+  u is ['LESSP,a,b] =>
+    b = 0 => ['MINUSP,a]
+    ['GREATERP,b,a]
+  u
+ 
+optEQ u ==
+  u is ['EQ,l,r] =>
+    NUMBERP l and NUMBERP r => ['QUOTE,EQ(l,r)]
+    -- That undoes some weird work in Boolean to do with the definition of true
+    u
+  u
+ 
+EVALANDFILEACTQ
+ (
+   for x in '( (call         optCall) _
+              (SEQ          optSEQ)_
+              (EQ optEQ)
+              (MINUS        optMINUS)_
+              (QSMINUS      optQSMINUS)_
+              (_-           opt_-)_
+              (LESSP        optLESSP)_
+              (SPADCALL     optSPADCALL)_
+              (_|           optSuchthat)_
+              (CATCH        optCatch)_
+              (COND         optCond)_
+              (mkRecord     optMkRecord)_
+              (RECORDELT    optRECORDELT)_
+              (SETRECORDELT optSETRECORDELT)_
+              (RECORDCOPY   optRECORDCOPY)) _
+      repeat MAKEPROP(CAR x,'OPTIMIZE,CREATE_-SBC CADR x)
+          --much quicker to call functions if they have an SBC
+    )
+ 
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-timer.boot.pamphlet b/src/interp/g-timer.boot.pamphlet
new file mode 100644
index 00000000..513e367d
--- /dev/null
+++ b/src/interp/g-timer.boot.pamphlet
@@ -0,0 +1,292 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp g-timer.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Code instrumentation facilities
+--  These functions can be used with arbitrary lists of
+--  named stats (listofnames) grouped in classes (listofclasses)
+--  and with measurement types (property, classproperty).
+ 
+printNamedStatsByProperty(listofnames, property) ==
+  total := +/[GETL(name,property) for [name,:.] in listofnames]
+  for [name,:.] in listofnames repeat
+    n := GETL(name, property)
+    strname := STRINGIMAGE name
+    strval  := STRINGIMAGE n
+    sayBrightly concat(bright strname,
+      fillerSpaces(70-#strname-#strval,'"."),bright strval)
+  sayBrightly bright fillerSpaces(72,'"-")
+  sayBrightly concat(bright '"Total",
+    fillerSpaces(65-# STRINGIMAGE total,'"."),bright STRINGIMAGE total)
+ 
+makeLongStatStringByProperty _
+ (listofnames, listofclasses, property, classproperty, units, flag) ==
+  total := 0
+  str := '""
+  otherStatTotal := GETL('other, property)
+  for [name,class,:ab] in listofnames repeat
+    name = 'other => 'iterate
+    cl := CAR LASSOC(class,listofclasses)
+    n := GETL( name, property)
+    PUT(cl,classproperty, n + GETL(cl,classproperty))
+    total := total + n
+    if n >= 0.01
+      then timestr := normalizeStatAndStringify n
+      else
+        timestr := '""
+        otherStatTotal := otherStatTotal + n
+    str := makeStatString(str,timestr,ab,flag)
+  otherStatTotal := otherStatTotal
+  PUT('other, property, otherStatTotal)
+  if otherStatTotal > 0 then
+    str := makeStatString(str,normalizeStatAndStringify otherStatTotal,'O,flag)
+    total := total + otherStatTotal
+    cl := CAR LASSOC('other,listofnames)
+    cl := CAR LASSOC(cl,listofclasses)
+    PUT(cl,classproperty, otherStatTotal + GETL(cl,classproperty))
+  if flag ^= 'long then
+    total := 0
+    str := '""
+    for [class,name,:ab] in listofclasses repeat
+      n := GETL(name, classproperty)
+      n = 0.0 => 'iterate
+      total := total + n
+      timestr := normalizeStatAndStringify n
+      str := makeStatString(str,timestr,ab,flag)
+  total := STRCONC(normalizeStatAndStringify total,'" ", units)
+  str = '"" =>  total
+  STRCONC(str, '" = ", total)
+ 
+normalizeStatAndStringify t ==
+  RNUMP t =>
+      t := roundStat t
+      t = 0.0 => '"0"
+      FORMAT(nil,'"~,2F",t)
+  INTP t =>
+      K := 1024
+      M := K*K
+      t > 9*M => CONCAT(STRINGIMAGE((t + 512*K)/M), '"M")
+      t > 9*K => CONCAT(STRINGIMAGE((t + 512)/K),   '"K")
+      STRINGIMAGE t
+  STRINGIMAGE t
+ 
+significantStat t ==
+   RNUMP t => (t > 0.01)
+   INTP  t => (t > 100)
+   true
+ 
+roundStat t ==
+  not RNUMP t => t
+  (FIX (0.5 + t * 1000.0)) / 1000.0
+ 
+makeStatString(oldstr,time,abb,flag) ==
+  time = '"" => oldstr
+  opening := (flag = 'long => '"("; '" (")
+  oldstr = '"" => STRCONC(time,opening,abb,'")")
+  STRCONC(oldstr,'" + ",time,opening,abb,'")")
+ 
+peekTimedName() == IFCAR $timedNameStack
+ 
+popTimedName() ==
+  name := IFCAR $timedNameStack
+  $timedNameStack := IFCDR $timedNameStack
+  name
+ 
+pushTimedName name ==
+  PUSH(name,$timedNameStack)
+ 
+--currentlyTimedName() == CAR $timedNameStack
+ 
+startTimingProcess name ==
+  updateTimedName peekTimedName()
+  pushTimedName name
+  if EQ(name, 'load) then          statRecordLoadEvent()
+ 
+stopTimingProcess name ==
+  (name ^= peekTimedName()) and null $InteractiveMode =>
+    keyedSystemError("S2GL0015",[name,peekTimedName()])
+  updateTimedName peekTimedName()
+  popTimedName()
+ 
+--% Instrumentation specific to the interpreter
+SETANDFILEQ($oldElapsedSpace, 0)
+SETANDFILEQ($oldElapsedGCTime,0.0)
+SETANDFILEQ($oldElapsedTime,0.0)
+SETANDFILEQ($gcTimeTotal,0.0)
+ 
+-- $timedNameStack is used to hold the names of sections of the
+-- code being timed.
+ 
+SETANDFILEQ($timedNameStack,'(other))
+ 
+SETANDFILEQ($interpreterTimedNames,'(
+-- name         class abbrev
+  (algebra        2 .   B) _
+  (analysis       1 .   A) _
+  (coercion       1 .   C) _
+  (compilation    3 .   T) _
+  (debug          3 .   D) _
+  (evaluation     2 .   E) _
+  (gc             4 .   G) _
+  (history        3 .   H) _
+  (instantiation  3 .   I) _
+  (load           3 .   L) _
+  (modemaps       1 .   M) _
+  (optimization   3 .   Z) _
+  (querycoerce    1 .   Q) _
+  (other          3 .   O) _
+  (diskread       3 .   K) _
+  (print          3 .   P) _
+  (resolve        1 .   R) _
+  ))
+ 
+SETANDFILEQ($interpreterTimedClasses, '(
+-- number class name    short name
+  ( 1    interpreter     .  IN) _
+  ( 2    evaluation      .  EV) _
+  ( 3    other           .  OT) _
+  ( 4    reclaim         .  GC) _
+  ))
+ 
+initializeTimedNames(listofnames,listofclasses) ==
+  for [name,:.] in listofnames repeat
+    PUT(name, 'TimeTotal, 0.0)
+    PUT(name, 'SpaceTotal,  0)
+  for [.,name,:.] in listofclasses repeat
+    PUT( name, 'ClassTimeTotal, 0.0)
+    PUT( name, 'ClassSpaceTotal,  0)
+  $timedNameStack := '(other)
+  computeElapsedTime()
+  PUT('gc, 'TimeTotal, 0.0)
+  PUT('gc, 'SpaceTotal,  0)
+  NIL
+ 
+updateTimedName name ==
+  count := (GETL(name,'TimeTotal) or 0) + computeElapsedTime()
+  PUT(name,'TimeTotal, count) 
+ 
+printNamedStats listofnames ==
+  printNamedStatsByProperty(listofnames, 'TimeTotal)
+  sayBrightly '" "
+  sayBrightly '"Space (in bytes):"
+  printNamedStatsByProperty(listofnames, 'SpaceTotal)
+ 
+makeLongTimeString(listofnames,listofclasses) ==
+  makeLongStatStringByProperty(listofnames, listofclasses,  _
+                               'TimeTotal, 'ClassTimeTotal, _
+                               '"sec", $printTimeIfTrue)
+ 
+makeLongSpaceString(listofnames,listofclasses) ==
+  makeLongStatStringByProperty(listofnames, listofclasses,    _
+                               'SpaceTotal, 'ClassSpaceTotal, _
+                               '"bytes", $printStorageIfTrue)
+ 
+computeElapsedTime() ==
+  -- in total time lists, CAR is VIRTCPU and CADR is TOTCPU
+  currentTime:= elapsedUserTime()
+  currentGCTime:= elapsedGcTime()
+  gcDelta := currentGCTime - $oldElapsedGCTime
+  elapsedSeconds:=
+     -- In CCL total time does not include GC time.
+     $cclSystem => 1.*(currentTime-$oldElapsedTime)/$timerTicksPerSecond
+     1.*(currentTime-$oldElapsedTime-gcDelta)/$timerTicksPerSecond
+  PUT('gc, 'TimeTotal,GETL('gc,'TimeTotal) +
+                   1.*gcDelta/$timerTicksPerSecond)
+  $oldElapsedTime := elapsedUserTime()
+  $oldElapsedGCTime := elapsedGcTime()
+  elapsedSeconds
+ 
+computeElapsedSpace() ==
+  currentElapsedSpace := HEAPELAPSED()
+  elapsedBytes := currentElapsedSpace - $oldElapsedSpace
+  $oldElapsedSpace := currentElapsedSpace
+  elapsedBytes
+ 
+timedAlgebraEvaluation(code) ==
+  startTimingProcess 'algebra
+  r := eval code
+  stopTimingProcess 'algebra
+  r
+ 
+timedOptimization(code) ==
+  startTimingProcess 'optimization
+  $getDomainCode : local := NIL
+  r := lispize code
+  if $reportOptimization then
+    sayBrightlyI bright '"Optimized LISP code:"
+    pp r
+  stopTimingProcess 'optimization
+  r
+ 
+timedEVALFUN(code) ==
+  startTimingProcess 'evaluation
+  r := timedEvaluate code
+  stopTimingProcess 'evaluation
+  r
+ 
+timedEvaluate code ==
+  code is ["LIST",:a] and #a > 200 =>
+    "append"/[eval ["LIST",:x] for x in splitIntoBlocksOf200 a]
+  eval code
+ 
+displayHeapStatsIfWanted() ==
+   $printStorageIfTrue => sayBrightly OLDHEAPSTATS()
+ 
+--EVALANDFILEACTQ(
+--  PUTGCEXIT function displayHeapStatsIfWanted )
+ 
+--% stubs for the stats summary fns
+statRecordInstantiationEvent() == nil
+statRecordLoadEvent()          == nil
+ 
+statisticsSummary()  == '"No statistics available."
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/g-util.boot.pamphlet b/src/interp/g-util.boot.pamphlet
new file mode 100644
index 00000000..deaf2b5c
--- /dev/null
+++ b/src/interp/g-util.boot.pamphlet
@@ -0,0 +1,658 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/g-util.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Utility Functions of General Use
+
+PPtoFile(x, fname) ==
+    stream := DEFIOSTREAM([['MODE, :'OUTPUT], ['FILE, :fname]], 80, 0)
+    PRETTYPRINT(x, stream)
+    SHUT stream
+    x
+
+-- Convert an arbitrary lisp object to canonical boolean.
+bool x ==
+    NULL NULL x
+
+--% Various lispy things
+
+Identity x == x
+
+length1? l == PAIRP l and not PAIRP QCDR l
+
+length2? l == PAIRP l and PAIRP (l := QCDR l) and not PAIRP QCDR l
+
+pairList(u,v) == [[x,:y] for x in u for y in v]
+
+-- GETALIST(alist,prop) == IFCDR assoc(prop,alist)
+GETALIST(alist,prop) == CDR assoc(prop,alist)
+
+PUTALIST(alist,prop,val) ==
+  null alist => [[prop,:val]]
+  pair := assoc(prop,alist) =>
+    CDR pair = val => alist
+    -- else we fall over Lucid's read-only storage feature again
+    QRPLACD(pair,val)
+    alist
+  QRPLACD(LASTPAIR alist,[[prop,:val]])
+  alist
+
+REMALIST(alist,prop) ==
+  null alist => alist
+  alist is [[ =prop,:.],:r] =>
+    null r => NIL
+    QRPLACA(alist,CAR r)
+    QRPLACD(alist,CDR r)
+    alist
+  null rest alist => alist
+  l := alist
+  ok := true
+  while ok repeat
+    [.,[p,:.],:r] := l
+    p = prop =>
+      ok := NIL
+      QRPLACD(l,r)
+    if null (l := QCDR l) or null rest l then ok := NIL
+  alist
+
+deleteLassoc(x,y) ==
+  y is [[a,:.],:y'] =>
+    EQ(x,a) => y'
+    [first y,:deleteLassoc(x,y')]
+  y
+
+--% association list functions
+
+deleteAssoc(x,y) ==
+  y is [[a,:.],:y'] =>
+   a=x => deleteAssoc(x,y')
+   [first y,:deleteAssoc(x,y')]
+  y
+
+deleteAssocWOC(x,y) ==
+  null y => y
+  [[a,:.],:t]:= y
+  x=a => t
+  (fn(x,y);y) where fn(x,y is [h,:t]) ==
+    t is [[a,:.],:t1] =>
+      x=a => RPLACD(y,t1)
+      fn(x,t)
+    nil
+
+insertWOC(x,y) ==
+  null y => [x]
+  (fn(x,y); y) where fn(x,y is [h,:t]) ==
+    x=h => nil
+    null t =>
+      RPLACD(y,[h,:t])
+      RPLACA(y,x)
+    fn(x,t)
+
+
+
+--% Miscellaneous Functions for Working with Strings
+
+fillerSpaces(n,:charPart) ==
+  n <= 0 => '""
+  MAKE_-FULL_-CVEC(n,IFCAR charPart or '" ")
+
+centerString(text,width,fillchar) ==
+  wid := entryWidth text
+  wid >= width => text
+  f := DIVIDE(width - wid,2)
+  fill1 := ""
+  for i in 1..(f.0) repeat
+    fill1 := STRCONC(fillchar,fill1)
+  fill2:= fill1
+  if f.1 ^= 0 then fill1 := STRCONC(fillchar,fill1)
+  [fill1,text,fill2]
+
+stringPrefix?(pref,str) ==
+  -- sees if the first #pref letters of str are pref
+  -- replaces STRINGPREFIXP
+  null (STRINGP(pref) and STRINGP(str)) => NIL
+  (lp := QCSIZE pref) = 0 => true
+  lp > QCSIZE str => NIL
+  ok := true
+  i := 0
+  while ok and (i < lp) repeat
+    not EQ(SCHAR(pref,i),SCHAR(str,i)) => ok := NIL
+    i := i + 1
+  ok
+
+stringChar2Integer(str,pos) ==
+  -- replaces GETSTRINGDIGIT in UT LISP
+  -- returns small integer represented by character in position pos
+  -- in string str. Returns NIL if not a digit or other error.
+  if IDENTP str then str := PNAME str
+  null (STRINGP(str) and
+    INTEGERP(pos) and (pos >= 0) and (pos < QCSIZE(str))) => NIL
+  not DIGITP(d := SCHAR(str,pos)) => NIL
+  DIG2FIX d
+
+dropLeadingBlanks str ==
+  str := object2String str
+  l := QCSIZE str
+  nb := NIL
+  i := 0
+  while (i < l) and not nb repeat
+    if SCHAR(str,i) ^= " " then nb := i
+    else i := i + 1
+  nb = 0 => str
+  nb => SUBSTRING(str,nb,NIL)
+  '""
+
+concat(:l) == concatList l
+
+concatList [x,:y] ==
+  null y => x
+  null x => concatList y
+  concat1(x,concatList y)
+
+concat1(x,y) ==
+  null x => y
+  atom x => (null y => x; atom y => [x,y]; [x,:y])
+  null y => x
+  atom y => [:x,y]
+  [:x,:y]
+
+--% BOOT ravel and reshape
+
+ravel a == a
+
+reshape(a,b) == a
+
+--% Some functions for algebra code
+
+boolODDP x == ODDP x
+
+--% Miscellaneous
+
+freeOfSharpVars x ==
+  atom x => not isSharpVarWithNum x
+  freeOfSharpVars first x and freeOfSharpVars rest x
+
+listOfSharpVars x ==
+  atom x => (isSharpVarWithNum x => LIST x; nil)
+  setUnion(listOfSharpVars first x,listOfSharpVars rest x)
+
+listOfPatternIds x ==
+  isPatternVar x => [x]
+  atom x => nil
+  x is ['QUOTE,:.] => nil
+  UNIONQ(listOfPatternIds first x,listOfPatternIds rest x)
+
+isPatternVar v ==
+  -- a pattern variable consists of a star followed by a star or digit(s)
+  IDENTP(v) and MEMQ(v,'(_*_* _*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10
+    _*11 _*12 _*13 _*14 _*15 _*16 _*17 _*18 _*19 _*20)) and true
+
+removeZeroOne x ==
+  -- replace all occurrences of (Zero) and (One) with
+  -- 0 and 1
+  x = $Zero => 0
+  x = $One => 1
+  atom x => x
+  [removeZeroOne first x,:removeZeroOne rest x]
+
+removeZeroOneDestructively t ==
+  -- replace all occurrences of (Zero) and (One) with
+  -- 0 and 1 destructively
+  t = $Zero => 0
+  t = $One => 1
+  atom t => t
+  RPLNODE(t,removeZeroOneDestructively first t,
+    removeZeroOneDestructively rest t)
+
+flattenSexpr s ==
+  null s => s
+  ATOM s => s
+  [f,:r] := s
+  ATOM f => [f,:flattenSexpr r]
+  [:flattenSexpr f,:flattenSexpr r]
+
+isLowerCaseLetter c == charRangeTest CHAR2NUM c
+
+isUpperCaseLetter c == charRangeTest QSDIFFERENCE(CHAR2NUM c,64)
+
+isLetter c ==
+  n:= CHAR2NUM c
+  charRangeTest n or charRangeTest QSDIFFERENCE(CHAR2NUM c,64)
+
+charRangeTest n ==
+  QSLESSP(153,n) =>
+    QSLESSP(169,n) => false
+    QSLESSP(161,n) => true
+    false
+  QSLESSP(128,n) =>
+    QSLESSP(144,n) => true
+    QSLESSP(138,n) => false
+    true
+  false
+
+update() ==
+  OBEY
+    STRCONC('"SPADEDIT ",STRINGIMAGE _/VERSION,'" ",STRINGIMAGE _/WSNAME,'" A")
+  _/UPDATE()
+
+--% Inplace Merge Sort for Lists
+-- MBM April/88
+
+-- listSort(pred,list) or listSort(pred,list,key)
+-- the pred function is a boolean valued function defining the ordering
+-- the key function extracts the key from an item for comparison by pred
+
+listSort(pred,list,:optional) ==
+   NOT functionp pred => error "listSort: first arg must be a function"
+   NOT LISTP list => error "listSort: second argument must be a list"
+   NULL optional => mergeSort(pred,function Identity,list,LENGTH list)
+   key := CAR optional
+   NOT functionp key => error "listSort: last arg must be a function"
+   mergeSort(pred,key,list,LENGTH list)
+
+-- non-destructive merge sort using NOT GGREATERP as predicate
+MSORT list == listSort(function GLESSEQP, COPY_-LIST list)
+
+-- destructive merge sort using NOT GGREATERP as predicate
+NMSORT list == listSort(function GLESSEQP, list)
+
+-- non-destructive merge sort using ?ORDER as predicate
+orderList l == listSort(function _?ORDER, COPY_-LIST l)
+
+-- dummy defn until clean-up
+-- order     l == orderList l
+
+mergeInPlace(f,g,p,q) ==
+   -- merge the two sorted lists p and q
+   if NULL p then return p
+   if NULL q then return q
+   if FUNCALL(f,FUNCALL(g, QCAR p),FUNCALL(g, QCAR q))
+   then (r := t := p; p := QCDR p)
+   else (r := t := q; q := QCDR q)
+   while not NULL p and not NULL q repeat
+      if FUNCALL(f,FUNCALL(g,QCAR p),FUNCALL(g,QCAR q))
+      then (QRPLACD(t,p); t := p; p := QCDR p)
+      else (QRPLACD(t,q); t := q; q := QCDR q)
+   if NULL p then QRPLACD(t,q) else QRPLACD(t,p)
+   r
+
+mergeSort(f,g,p,n) ==
+   if EQ(n,2) and FUNCALL(f,FUNCALL(g,QCADR p),FUNCALL(g,QCAR p)) then
+      t := p
+      p := QCDR p
+      QRPLACD(p,t)
+      QRPLACD(t,NIL)
+   if QSLESSP(n,3) then return p
+   -- split the list p into p and q of equal length
+   l := QSQUOTIENT(n,2)
+   t := p
+   for i in 1..l-1 repeat t := QCDR t
+   q := rest t
+   QRPLACD(t,NIL)
+   p := mergeSort(f,g,p,l)
+   q := mergeSort(f,g,q,QSDIFFERENCE(n,l))
+   mergeInPlace(f,g,p,q)
+
+--% Throwing with glorious highlighting (maybe)
+
+spadThrow() ==
+  if $interpOnly and $mapName then
+    putHist($mapName,'localModemap, nil, $e)
+  THROW("SPAD__READER",nil)
+
+spadThrowBrightly x ==
+  sayBrightly x
+  spadThrow()
+
+--% Type Formatting Without Abbreviation
+
+formatUnabbreviatedSig sig ==
+  null sig => ["() -> ()"]
+  [target,:args] := sig
+  target := formatUnabbreviated target
+  null args => ['"() -> ",:target]
+  null rest args => [:formatUnabbreviated QCAR args,'" -> ",:target]
+  args := formatUnabbreviatedTuple args
+  ['"(",:args,'") -> ",:target]
+
+formatUnabbreviatedTuple t ==
+  -- t is a list of types
+  null t => t
+  atom t => [t]
+  t0 := formatUnabbreviated QCAR t
+  null rest t => t0
+  [:t0,'",",:formatUnabbreviatedTuple QCDR t]
+
+formatUnabbreviated t ==
+  atom t =>
+    [t]
+  null t =>
+    ['"()"]
+  t is [p,sel,arg] and p in '(_: ":") =>
+    [sel,'": ",:formatUnabbreviated arg]
+  t is ['Union,:args] =>
+    ['Union,'"(",:formatUnabbreviatedTuple args,'")"]
+  t is ['Mapping,:args] =>
+    formatUnabbreviatedSig args
+  t is ['Record,:args] =>
+    ['Record,'"(",:formatUnabbreviatedTuple args,'")"]
+  t is [arg] =>
+    t
+  t is [arg,arg1] =>
+    [arg,'" ",:formatUnabbreviated arg1]
+  t is [arg,:args] =>
+    [arg,'"(",:formatUnabbreviatedTuple args,'")"]
+  t
+
+sublisNQ(al,e) ==
+  atom al => e
+  fn(al,e) where fn(al,e) ==
+    atom e =>
+      for x in al repeat
+        EQ(first x,e) => return (e := rest x)
+      e
+    EQ(a := first e,'QUOTE) => e
+    u := fn(al,a)
+    v := fn(al,rest e)
+    EQ(a,u) and EQ(rest e,v) => e
+    [u,:v]
+
+-- function for turning strings in tex format
+
+str2Outform s ==
+  parse := ncParseFromString s or systemError '"String for TeX will not parse"
+  parse2Outform parse
+
+parse2Outform x ==
+  x is [op,:argl] =>
+    nargl := [parse2Outform y for y in argl]
+    op = 'construct => ['BRACKET,['ARGLST,:[parse2Outform y for y in argl]]]
+    op = 'brace and nargl is [[BRACKET,:r]] => ['BRACE,:r]
+    [op,:nargl]
+  x
+
+str2Tex s ==
+  outf := str2Outform s
+  val := coerceInt(mkObj(wrap outf, '(OutputForm)), '(TexFormat))
+  val := objValUnwrap val
+  CAR val.1
+
+opOf x ==
+  atom x => x
+  first x
+
+getProplist(x,E) ==
+  not atom x => getProplist(first x,E)
+  u:= search(x,E) => u
+  --$InteractiveMode => nil
+  --$InteractiveMode and (u:= search(x,$InteractiveFrame)) => u
+  (pl:=search(x,$CategoryFrame)) =>
+    pl
+--  (pl:=PROPLIST x) => pl
+-- Above line commented out JHD/BMT 2.Aug.90
+
+search(x,e is [curEnv,:tailEnv]) ==
+  searchCurrentEnv(x,curEnv) or searchTailEnv(x,tailEnv)
+
+searchCurrentEnv(x,currentEnv) ==
+  for contour in currentEnv repeat
+    if u:= ASSQ(x,contour) then return (signal:= u)
+  KDR signal
+
+searchTailEnv(x,e) ==
+  for env in e repeat
+    signal:=
+      for contour in env repeat
+        if (u:= ASSQ(x,contour)) and ASSQ("FLUID",u) then return (signal:= u)
+      if signal then return signal
+  KDR signal
+
+augProplist(proplist,prop,val) ==
+  $InteractiveMode => augProplistInteractive(proplist,prop,val)
+  while (proplist is [[ =prop,:.],:proplist']) repeat proplist:= proplist'
+  val=(u:= LASSOC(prop,proplist)) => proplist
+  null val =>
+    null u => proplist
+    DELLASOS(prop,proplist)
+  [[prop,:val],:proplist]
+
+augProplistOf(var,prop,val,e) ==
+  proplist:= getProplist(var,e)
+  semchkProplist(var,proplist,prop,val)
+  augProplist(proplist,prop,val)
+
+semchkProplist(x,proplist,prop,val) ==
+  prop="isLiteral" =>
+    LASSOC("value",proplist) or LASSOC("mode",proplist) => warnLiteral x
+  MEMQ(prop,'(mode value)) =>
+    LASSOC("isLiteral",proplist) => warnLiteral x
+
+addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) ==
+  EQ(proplist,getProplist(var,e)) => e
+  $InteractiveMode => addBindingInteractive(var,proplist,e)
+  if curContour is [[ =var,:.],:.] then curContour:= rest curContour
+                 --Previous line should save some space
+  [[[lx,:curContour],:tailContour],:tailEnv] where lx:= [var,:proplist]
+
+position(x,l) ==
+  posn(x,l,0) where
+    posn(x,l,n) ==
+      null l => -1
+      x=first l => n
+      posn(x,rest l,n+1)
+
+insert(x,y) ==
+  member(x,y) => y
+  [x,:y]
+
+after(u,v) ==
+  r:= u
+  for x in u for y in v repeat r:= rest r
+  r
+
+
+$blank := char ('_ )
+
+trimString s ==
+  leftTrim rightTrim s
+
+leftTrim s ==
+  k := MAXINDEX s
+  k < 0 => s
+  s.0 = $blank =>
+    for i in 0..k while s.i = $blank repeat (j := i)
+    SUBSTRING(s,j + 1,nil)
+  s
+
+rightTrim s ==  -- assumed a non-empty string
+  k := MAXINDEX s
+  k < 0 => s
+  s.k = $blank =>
+    for i in k..0 by -1 while s.i = $blank repeat (j := i)
+    SUBSTRING(s,0,j)
+  s
+
+pp x ==
+  PRETTYPRINT x
+  x
+
+pr x ==
+  F_,PRINT_-ONE x
+  nil
+
+quickAnd(a,b) ==
+  a = true => b
+  b = true => a
+  a = false or b = false => false
+  simpBool ['AND,a,b]
+
+quickOr(a,b) ==
+  a = true or b = true => true
+  b = false => a
+  a = false => b
+  simpCatPredicate simpBool ['OR,a,b]
+
+intern x ==
+  STRINGP x =>
+    DIGITP x.0 => string2Integer x
+    INTERN x
+  x
+
+--------------------> NEW DEFINITION (override in interop.boot.pamphlet)
+isDomain a ==
+  REFVECP a and #a>5 and GETDATABASE(a.0,'CONSTRUCTORKIND) = 'domain
+
+-- variables used by browser
+
+$htHash      := MAKE_-HASH_-TABLE()
+$glossHash   := MAKE_-HASH_-TABLE()
+$lispHash    := MAKE_-HASH_-TABLE()
+$sysHash     := MAKE_-HASH_-TABLE()
+$htSystemCommands := '(
+ (boot . development) clear display (fin . development) edit help
+ frame history load quit read set show synonym system
+ trace what )
+$currentSysList := [opOf x for x in $htSystemCommands] --see ht-root
+$outStream   := nil
+$recheckingFlag    := false     --see transformAndRecheckComments
+$exposeFlag        := false     --if true, messages go to $outStream
+$exposeFlagHeading := false     --see htcheck.boot
+$checkingXmptex? := false       --see htcheck.boot
+$exposeDocHeading:= nil         --see htcheck.boot
+$charPlus := char '_+
+$charBlank:= (char '_ )
+$charLbrace:= char '_{
+$charRbrace:= char '_}
+$charBack := char '_\
+$charDash := char '_-
+
+$charTab            := CODE_-CHAR(9)
+$charNewline        := CODE_-CHAR(10)
+$charFauxNewline    := CODE_-CHAR(25)
+$stringNewline      := PNAME CODE_-CHAR(10)
+$stringFauxNewline  := PNAME CODE_-CHAR(25)
+
+$charExclusions := [char 'a, char 'A]
+$charQuote := char '_'
+$charSemiColon := char '_;
+$charComma     := char '_,
+$charPeriod    := char '_.
+$checkPrenAlist := [[char '_(,:char '_)],[char '_{,:char '_}],[char '_[,:char '_]]]
+$charEscapeList:= [char '_%,char '_#,$charBack]
+$charIdentifierEndings := [char '__, char '_!, char '_?]
+$charSplitList := [$charComma,$charPeriod,char '_[, char '_],$charLbrace, $charRbrace, char '_(, char '_), char '_$, char '_%]
+$charDelimiters := [$charBlank, char '_(, char '_), $charBack]
+$HTspadmacros := '("\spadtype" "\spadcommand" "\spadop" "\spadfun" "\spadatt" "\spadsyscom" "\spad" "\s")
+$HTmacs := [
+  ['"\beginmenu",$charRbrace,'"menu",$charLbrace,'"\begin"],
+   ['"\endmenu",$charRbrace,'"menu",$charLbrace,'"\end"],
+     ['"\beginitems",$charRbrace,'"items",$charLbrace,'"\begin"],
+       ['"\enditems",$charRbrace,'"items",$charLbrace,'"\end"],
+         ['"\beginscroll",$charRbrace,'"scroll",$charLbrace,'"\begin"],
+           ['"\endscroll",$charRbrace,'"scroll",$charLbrace,'"\end"]]
+
+$HTlinks := '(
+  "\downlink"
+  "\menulink"
+  "\menudownlink"
+  "\menuwindowlink"
+  "\menumemolink")
+
+$HTlisplinks := '(
+  "\lispdownlink"
+  "\menulispdownlink"
+  "\menulispwindowlink"
+  "\menulispmemolink"
+  "\lispwindowlink"
+  "\lispmemolink")
+
+$beginEndList := '(
+  "page"
+  "items"
+  "menu"
+  "scroll"
+  "verbatim"
+  "detail")
+
+isDefaultPackageName x == (s := PNAME x).(MAXINDEX s) = char '_&
+
+
+-- gensym utils
+
+charDigitVal c ==
+  digits := '"0123456789"
+  n := -1
+  for i in 0..#digits-1 while n < 0 repeat
+      if c = digits.i then n := i
+  n < 0 => error '"Character is not a digit"
+  n
+
+gensymInt g ==
+  not GENSYMP g => error '"Need a GENSYM"
+  p := PNAME g
+  n := 0
+  for i in 2..#p-1 repeat n := 10 * n + charDigitVal p.i
+  n
+
+
+
+-- Push into the BOOT package when invoked in batch mode.
+AxiomCore::$sysScope := '"BOOT"
+@
+
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ggreater.lisp.pamphlet b/src/interp/ggreater.lisp.pamphlet
new file mode 100644
index 00000000..7e41fa81
--- /dev/null
+++ b/src/interp/ggreater.lisp.pamphlet
@@ -0,0 +1,234 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/ggreater.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(IMPORT-MODULE "vmlisp")
+(in-package "VMLISP")
+
+(DEFUN LEXGREATERP (COMPERAND-1 COMPERAND-2)
+    ;;  "Order of types: pair NIL vec ivec/rvec cvec ident num fbpi mbpi other"
+    (COND
+      ((EQ COMPERAND-1 COMPERAND-2) NIL)
+      ((consp COMPERAND-1)
+        (COND
+          ( (consp COMPERAND-2)
+            (COND
+              ( (EQUAL (qcar COMPERAND-1) (qcar COMPERAND-2))
+                (LEXGREATERP (qcdr COMPERAND-1) (qcdr COMPERAND-2)) )
+              ( (LEXGREATERP (qcar COMPERAND-1) (qcar COMPERAND-2)) ) ) )
+          ('else t)))
+      ((consp COMPERAND-2) NIL)
+      ((NULL COMPERAND-1) 'T )
+      ((NULL COMPERAND-2) NIL)
+      ((VECP COMPERAND-1)
+        (COND
+          ((VECP COMPERAND-2) (LEXVGREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((VECP COMPERAND-2) NIL)
+      ((OR (IVECP COMPERAND-1) (RVECP COMPERAND-1))
+        (COND
+          ( (OR (IVECP COMPERAND-2) (RVECP COMPERAND-2))
+            (LEXVGREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((OR (IVECP COMPERAND-2) (RVECP COMPERAND-2)) NIL )
+      ((stringp COMPERAND-1)
+        (COND
+          ((stringp COMPERAND-2)
+            (STRING-GREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((stringp COMPERAND-2) NIL)
+      ((symbolp COMPERAND-1)
+        (COND
+          ((symbolp COMPERAND-2)
+            (STRING-GREATERP (symbol-name COMPERAND-1) (symbol-name COMPERAND-2)) )
+          ('else t)))
+      ((symbolp COMPERAND-2) NIL )
+      ((numberp COMPERAND-1)
+        (COND
+          ( (numberp COMPERAND-2)
+            (> COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((numberp COMPERAND-2) NIL)
+      ((CHARACTERP COMPERAND-1)
+	(COND 
+          ((CHARACTERP COMPERAND-2)
+	    (CHAR-GREATERP COMPERAND-1 COMPERAND-2) )
+	  ('else t)))
+      ((CHARACTERP COMPERAND-2)	NIL )
+      ((FBPIP COMPERAND-1)
+        (COND
+          ((FBPIP COMPERAND-2)
+            (LEXGREATERP (BPINAME COMPERAND-1) (BPINAME COMPERAND-2)) )
+          ('else t)))
+      ((FBPIP COMPERAND-2) NIL)
+      ((MBPIP COMPERAND-1)
+        (COND
+          ((MBPIP COMPERAND-2)
+            (LEXGREATERP (BPINAME COMPERAND-1) (BPINAME COMPERAND-2)) )
+          ('else t)))
+      ((MBPIP COMPERAND-2)
+        NIL )
+      ((> (SXHASH COMPERAND-1) (SXHASH COMPERAND-2)))))
+
+(DEFUN LEXVGREATERP (VECTOR-COMPERAND-1 VECTOR-COMPERAND-2)
+  (declare (simple-vector vector-comperand-1 vector-comperand-2))
+    (PROG (L1 L2 I T1 T2)
+     (declare (fixnum i l1 l2) )
+      (SETQ I -1)
+      (SETQ L1 (length VECTOR-COMPERAND-1))
+      (SETQ L2 (length VECTOR-COMPERAND-2))
+  LP  (setq i (1+ i))
+      (COND
+        ((EQL L1 I) (RETURN NIL))
+        ((EQL L2 I) (RETURN 'T)))
+      (COND
+        ((EQUAL
+            (SETQ T1 (svref VECTOR-COMPERAND-1 I))
+            (SETQ T2 (svref VECTOR-COMPERAND-2 I)))
+          (GO LP)))
+      (RETURN (LEXGREATERP T1 T2)) ) )
+
+
+(DEFUN GGREATERP (COMPERAND-1 COMPERAND-2)
+    ;;  "Order of types: pair NIL vec ivec/rvec cvec ident num fbpi mbpi other"
+    (COND
+      ((EQ COMPERAND-1 COMPERAND-2) NIL)
+      ((symbolp COMPERAND-1)
+        (COND
+          ((symbolp COMPERAND-2)
+            (CGREATERP (symbol-name COMPERAND-1) (symbol-name COMPERAND-2)) )
+          ('else t)))
+      ((symbolp COMPERAND-2) NIL )
+      ((consp COMPERAND-1)
+        (COND
+          ( (consp COMPERAND-2)
+            (COND
+              ( (EQUAL (qcar COMPERAND-1) (qcar COMPERAND-2))
+                (GGREATERP (qcdr COMPERAND-1) (qcdr COMPERAND-2)) )
+              ( (GGREATERP (qcar COMPERAND-1) (qcar COMPERAND-2)) ) ) )
+          ('else t)))
+      ((consp COMPERAND-2) NIL)
+      ((NULL COMPERAND-1) 'T )
+      ((NULL COMPERAND-2) NIL)
+      ((VECP COMPERAND-1)
+        (COND
+          ((VECP COMPERAND-2) (VGREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((VECP COMPERAND-2) NIL)
+      ((OR (IVECP COMPERAND-1) (RVECP COMPERAND-1))
+        (COND
+          ( (OR (IVECP COMPERAND-2) (RVECP COMPERAND-2))
+            (VGREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((OR (IVECP COMPERAND-2) (RVECP COMPERAND-2)) NIL )
+      ((stringp COMPERAND-1)
+        (COND
+          ((stringp COMPERAND-2)
+            (CGREATERP COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((stringp COMPERAND-2) NIL)
+      ((numberp COMPERAND-1)
+        (COND
+          ( (numberp COMPERAND-2)
+            (> COMPERAND-1 COMPERAND-2) )
+          ('else t)))
+      ((numberp COMPERAND-2) NIL)
+      ((CHARACTERP COMPERAND-1)
+	(COND 
+          ((CHARACTERP COMPERAND-2)
+	    (CHAR> COMPERAND-1 COMPERAND-2) )
+	  ('else t)))
+      ((CHARACTERP COMPERAND-2)	NIL )
+      ((FBPIP COMPERAND-1)
+        (COND
+          ((FBPIP COMPERAND-2)
+            (GGREATERP (BPINAME COMPERAND-1) (BPINAME COMPERAND-2)) )
+          ('else t)))
+      ((FBPIP COMPERAND-2) NIL)
+      ((MBPIP COMPERAND-1)
+        (COND
+          ((MBPIP COMPERAND-2)
+            (GGREATERP (BPINAME COMPERAND-1) (BPINAME COMPERAND-2)) )
+          ('else t)))
+      ((MBPIP COMPERAND-2)
+        NIL )
+      ((> (SXHASH COMPERAND-1) (SXHASH COMPERAND-2)))))
+
+(DEFUN VGREATERP (VECTOR-COMPERAND-1 VECTOR-COMPERAND-2)
+  (declare (simple-vector vector-comperand-1 vector-comperand-2))
+    (PROG (L1 L2 I T1 T2)
+     (declare (fixnum i l1 l2) )
+      (SETQ I -1)
+      (SETQ L1 (length VECTOR-COMPERAND-1))
+      (SETQ L2 (length VECTOR-COMPERAND-2))
+  LP  (setq i (1+ i))
+      (COND
+        ((EQL L1 I) (RETURN NIL))
+        ((EQL L2 I) (RETURN 'T)))
+      (COND
+        ((EQUAL
+            (SETQ T1 (svref VECTOR-COMPERAND-1 I))
+            (SETQ T2 (svref VECTOR-COMPERAND-2 I)))
+          (GO LP)))
+      (RETURN (GGREATERP T1 T2)) ) )
+
+(defvar SORTGREATERP #'GGREATERP "default sorting predicate")
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/guess.boot.pamphlet b/src/interp/guess.boot.pamphlet
new file mode 100644
index 00000000..4f4d2544
--- /dev/null
+++ b/src/interp/guess.boot.pamphlet
@@ -0,0 +1,369 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp guess.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+$minThreshold := 3
+$maxThreshold := 7
+ 
+--=======================================================================
+--                        Build Directories
+--=======================================================================
+buildOperationWordTable() ==
+  $opWordTable := buildWordTable [PNAME x for x in allOperations()]
+ 
+buildWordTable u ==
+  table:= MAKE_-HASHTABLE 'ID
+  for s in u repeat
+    words := wordsOfString s
+    key := UPCASE s.0
+    HPUT(table,key,[[s,:words],:HGET(table,key)])
+  for key in HKEYS table repeat
+    HPUT(table,key,
+      listSort(function GLESSEQP,removeDupOrderedAlist
+        listSort(function GLESSEQP, HGET(table,key),function CAR),
+          function CADR))
+  table
+
+measureWordTable u ==
+  +/[+/[#entry for entry in HGET(u,key)] for key in HKEYS u]
+
+removeDupOrderedAlist u ==
+  -- removes duplicate entries in ordered alist
+  -- (where duplicates are adjacent)
+  for x in tails u repeat
+    (y := rest x) and first first x = first first y => RPLACD(x,rest y)
+  u
+ 
+wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s]
+ 
+wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s]
+ 
+wordsOfString1(s,j) ==
+  k := or/[i for i in j..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] =>
+    tailWords:=
+      UPPER_-CASE_-P s.(k+1) =>
+        n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not UPPER_-CASE_-P s.i]
+        null n => [SUBSTRING(s,k,nil)]
+        n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)]
+      m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] =>
+        [SUBSTRING(s,k,m-k),:wordsOfString1(s,m)]
+      [SUBSTRING(s,k,nil)]
+    k > j+1 => [SUBSTRING(s,j,k-j),:tailWords]
+    tailWords
+  nil
+
+wordKeys s == 
+  REMDUP [UPCASE s.0,:fn(s,1,-1,MAXINDEX s,nil)] where fn(s,i,lastKeyIndex,n,acc) ==
+    i > n => acc
+    UPPER_-CASE_-P s.i =>
+--    i = lastKeyIndex + 1 => fn(s,i + 1,i,n,[s.i,:rest acc])
+      fn(s,i + 1,i,n,[s.i,:acc])
+    fn(s,i + 1,lastKeyIndex,n,acc)
+
+--=======================================================================
+--               Augment Function Directories
+--=======================================================================
+add2WordFunctionTable fn ==
+--called from DEF
+  $functionTable and
+    null LASSOC(s := PNAME fn,HGET($functionTable,(key := UPCASE s.0))) =>
+      HPUT($functionTable,key,[[s,:wordsOfString s],:HGET($functionTable,key)])
+ 
+--=======================================================================
+--                       Guess Function Name
+--=======================================================================
+findWords(word,table) == 
+  $lastWord := word
+  $lastTable:= table
+  $totalWords:= nil
+  $countThreshold := $minThreshold
+  $lastMinimum := -1
+  res := findApproximateWords(word,table) 
+  if null res then
+    $countThreshold := $countThreshold + 2
+    res := findApproximateWords(word,table) 
+  $lastAlist := mySort res =>
+--    $lastMinimum := CAR LAST $lastAlist
+--    $lastWords := wordSort CDAR $lastAlist
+--    $totalWords:= $lastWords
+--    $lastAlist := CDR  $lastAlist
+--    $totalWords
+      $lastMinimum := CAAR $lastAlist
+      $lastWords := wordSort CDAR $lastAlist
+      $totalWords:= $lastWords
+      $lastAlist := CDR  $lastAlist
+      $totalWords
+  $lastWords := nil
+
+wordSort u == REMDUP listSort(function GLESSEQP,u)
+
+more() == moreWords($lastWord,$lastTable)
+
+moreWords(word,table) ==
+  $lastAlist =>
+     $lastMinimum := CAR LAST pp $lastAlist
+     numberOfLastWords := #$lastWords
+     $lastWords := "append"/(ASSOCRIGHT $lastAlist)
+     if #$lastWords > numberOfLastWords then 
+       trialLastAlist := 
+         [p for p in $lastAlist | p.0 < $maxThreshold]
+       trialLastWords := "append"/(ASSOCRIGHT trialLastAlist)
+       if #trialLastWords > numberOfLastWords then
+         $lastWords := trialLastWords         
+     $totalWords:= wordSort [:$lastWords,:$totalWords]
+     $lastAlist := nil
+     $totalWords
+  $countThreshold := $countThreshold + 2
+  $lastAlist := findApproximateWords(word,table)
+  moreWords(word,table)
+
+findApproximateWords(word,table) ==
+  count := $countThreshold
+  words:= wordsOfString word
+  upperWord:= UPCASE COPY word
+  n := #words
+  threshold:=
+    n = 1 => count
+    count+1
+ 
+  --first try to break up as list of words
+  alist:= nil
+  for i in 1..#words repeat
+    $penalty :local := (i = 1 => 0; 1)
+    wordAlist:= HGET(table,UPCASE (first words).0)
+    for [x,:wordList] in wordAlist repeat
+      k := findApproxWordList(words,wordList,n,threshold,#wordList) 
+      k =>
+        k := k + $penalty
+        k <= $lastMinimum => 'skip
+        alist := consAlist(k,x,alist)
+      
+    if i = 1 and null alist then
+        --no winners, so try flattening to upper case and checking again
+        wordSize := SIZE word
+        lastThreshold := MAX(threshold - 1,wordSize/2)
+        for [x,:.] in wordAlist repeat
+          k := deltaWordEntry(upperWord,UPCASE x)
+          k < lastThreshold => alist := consAlist(k,x,alist)
+
+    rotateWordList words
+
+  alist
+
+consAlist(x,y,alist) ==
+  u := ASSOC(x,alist) => 
+    RPLACD(u,[y,:CDR u])
+    alist
+  [[x,y],:alist]
+
+findApproxWordList(words,wordList,n,threshold,w) ==
+  val := findApproxWordList1(words,wordList,n,threshold,w)
+  null val => val
+--pp [val,:wordList]
+  val
+
+findApproxWordList1(words,wordList,n,threshold,w) ==
+  two := threshold - 2
+  n = w => 
+      k := findApproxSimple(words,wordList,threshold) => k 
+
+      n < 3 => false
+      threshold := threshold - 1
+      sum := 0      --next, throw out one bad word
+
+      badWord := false
+      for entry in wordList for part in words while sum < threshold repeat
+        k:= deltaWordEntry(part,entry)
+        k < two => sum:= sum + k
+        null badWord => badWord := true
+        sum := 1000
+      sum < threshold => 
+--      pp [2,sum,wordList]
+        sum + 2
+
+  n+1 = w =>    --assume one word is missing
+      sum := 0
+      badWord := false
+      for entries in tails wordList for part in words
+           while sum < threshold repeat
+        entry := first entries
+        k:= deltaWordEntry(part,entry)
+        k < two => sum:= sum + k
+        null badWord =>
+          badWord := true
+          entries := rest entries      --skip this bad word
+          entry := first entries
+          k := deltaWordEntry(part,entry)
+          k < two => sum := sum + k
+          sum := 1000
+        sum := 1000
+      sum < threshold => 
+--      pp [3,sum,wordList]
+        sum + 2
+      false
+  n-1 = w =>    --assume one word too many
+      sum := 0  --here: KEEP it hard to satisfy
+      badWord := false
+      for entry in wordList for parts in tails words
+           while sum < threshold repeat
+        part := first parts
+        k:= deltaWordEntry(part,entry)
+        k < 2 => sum:= sum + k
+        null badWord =>
+          badWord := true
+          parts := rest parts      --skip this bad word
+          part := first parts
+          k := deltaWordEntry(part,entry)
+          k < 2 => sum := sum + k
+          return (sum := 1000)
+        return (sum := 1000)
+      sum < threshold =>
+--      pp [4,sum,wordList]
+        $penalty = 1 => sum
+        sum + 1
+      false
+  false
+
+findApproxSimple(words,wordList,threshold) ==
+  sum := 0
+  --first try matching words in order
+  for entry in wordList for part in words while sum < threshold repeat
+    sum:= sum + deltaWordEntry(part,entry)
+  sum < threshold => 
+--  pp ['"--->",sum,:wordList]
+    sum
+  nil
+      
+rotateWordList u ==
+  v := u
+  p := CAR v
+  while QCDR v repeat
+    RPLACA(v,CADR v) 
+    v := QCDR v
+  RPLACA(v,p)
+  u
+
+deltaWordEntry(word,entry) ==
+  word = entry => 0
+  word.0 ^= entry.0 => 1000
+  #word > 2 and stringPrefix?(word,entry) => 1
+  ABS(diff := SIZE word - SIZE entry) > 4 => 1000
+  canForgeWord(word,entry)
+ 
+--+ Note these are optimized definitions below-- see commented out versions
+--+   to understand the algorithm
+canForgeWord(word,entry) ==
+  forge(word,0,MAXINDEX word,entry,0,MAXINDEX entry,0)
+ 
+forge(word,w,W,entry,e,E,n) ==
+  w > W =>
+    e > E => n
+    QSADD1 QSPLUS(E-e,n)
+  e > E => QSADD1 QSPLUS(W-w,n)
+  word.w = entry.e => forge(word,w+1,W,entry,e+1,E,n)
+  w=W or e=E => forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+  word.w=entry.(e+1) =>
+    word.(w+1) = entry.e => forge(word,w+2,W,entry,e+2,E,QSADD1 n)
+    forge(word,w+1,W,entry,e+2,E,QSADD1 n)
+  word.(w+1)=entry.e => forge(word,w+2,W,entry,e+1,E,QSADD1 n)
+ 
+  (deltaW := W-w) > 1 and (deltaE := E-e) > 1 =>
+    --if word is long, can we delete chars to match 2 consective chars
+    deltaW >= deltaE and
+      (k := or/[j for j in (w+2)..(W-1) | word.j = entry.e])
+        and word.(k+1) = entry.(e+1) =>
+          forge(word,k+2,W,entry,e+2,E,QSPLUS(k-w,n))
+    deltaW <= deltaE and
+    --if word is short, can we insert chars so as to match 2 consecutive chars
+      (k := or/[j for j in (e+2)..(E-1) | word.w = entry.j])
+        and word.(w+1) = entry.(k+1) =>
+          forge(word,w+2,W,entry,k+2,E,QSPLUS(n,k-e))
+    forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+  --check for two consecutive matches down the line
+  forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+ 
+--+ DO NOT REMOVE DEFINITIONS BELOW which explain the algorithm
+--+ canForgeWord(word,entry) ==--
+--+ [d,i,s,t] := forge(word,0,MAXINDEX word,entry,0,MAXINDEX entry,0,0,0,0)
+--+ --d=deletions, i=insertions, s=substitutions, t=transpositions
+--+ --list is formed only for tuning purposes-- remove later on
+--+ d + i + s + t
+ 
+--+forge(word,w,W,entry,e,E,d,i,s,t) ==
+--+  w > W =>
+--+    e > E => [d,i,s,t]
+--+    [d,E-e+i+1,s,t]
+--+  e > E => [W-w+d+1,i,s,t]
+--+  word.w = entry.e => forge(word,w+1,W,entry,e+1,E,d,i,s,t)
+--+  w=W or e=E => forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+--+  word.w=entry.(e+1) =>
+--+    word.(w+1) = entry.e => forge(word,w+2,W,entry,e+2,E,d,i,s,t+1)
+--+    forge(word,w+1,W,entry,e+2,E,d,i+1,s,t)
+--+  word.(w+1)=entry.e => forge(word,w+2,W,entry,e+1,E,d+1,i,s,t)
+--+
+--+  (deltaW := W-w) > 1 and (deltaE := E-e) > 1 =>
+--+    --if word is long, can we delete chars to match 2 consective chars
+--+    deltaW >= deltaE and
+--+      (k := or/[j for j in (w+2)..(W-1) | word.j = entry.e])
+--+        and word.(k+1) = entry.(e+1) =>
+--+          forge(word,k+2,W,entry,e+2,E,d+k-w,i,s,t)
+--+    deltaW <= deltaE and
+--+    --if word is short, can we insert chars so as to match 2 consecutive chars
+--+      (k := or/[j for j in (e+2)..(E-1) | word.w = entry.j])
+--+        and word.(w+1) = entry.(k+1) =>
+--+          forge(word,w+2,W,entry,k+2,E,d,i+k-e,s,t)
+--+    forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+--+  --check for two consecutive matches down the line
+--+  forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+ 
+mySort u == listSort(function GLESSEQP,u)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/hash.lisp.pamphlet b/src/interp/hash.lisp.pamphlet
new file mode 100644
index 00000000..46c7cf17
--- /dev/null
+++ b/src/interp/hash.lisp.pamphlet
@@ -0,0 +1,147 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/hash.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(IMPORT-MODULE "vmlisp")
+(in-package "VMLISP")
+
+(export '(MAKE-HASHTABLE HGET HKEYS HCOUNT HPUT HPUT* HREM HCLEAR HREMPROP
+          HASHEQ HASHUEQUAL HASHCVEC HASHID HASHTABLEP CVEC UEQUAL ID HPUTPROP
+	  HASHTABLE-CLASS))
+
+;17.0 Operations on Hashtables
+;17.1 Creation
+
+(defun MAKE-HASHTABLE (id1 &optional (id2 nil))
+ (declare (ignore id2))
+   (let ((test (case id1
+		     ((EQ ID) #'eq)
+		     (CVEC #'equal)
+		     (EQL #'eql)
+		     #+Lucid ((UEQUAL EQUALP) #'EQUALP)
+		     #-Lucid ((UEQUAL EQUAL) #'equal)
+		     (otherwise (error "bad arg to make-hashtable")))))     
+      (make-hash-table :test test)))
+
+;17.2 Accessing
+
+(defmacro HGET (table key &rest default)
+   `(gethash ,key ,table ,@default))
+
+(defun HKEYS (table)
+   (let (keys)
+      (maphash
+        #'(lambda (key val) (declare (ignore val)) (push key keys)) table)
+        keys))
+
+#+Lucid
+(define-function 'HASHTABLE-CLASS #'system::hash-table-test)
+
+#+AKCL
+(clines "int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}")
+#+AKCL
+(defentry memory-value-short(object int) (int "mem_value"))
+
+;(memory-value-short  (make-hash-table :test 'equal) 12) is 0,1,or 2
+;depending on whether the test is eq,eql or equal.
+#+AKCL
+(defun HASHTABLE-CLASS (table)
+  (case (memory-value-short table 12)
+	(0 'EQ)
+	(1 'EQL)
+	(2 'EQUAL)
+	(t "error unknown hash table class")))
+
+#+:CCL
+(defun HASHTABLE-CLASS (table)
+  (case (hashtable-flavour table)
+	(0 'EQ)
+	(1 'EQL)
+	(2 'EQUAL)
+	(t (format nil "error unknown hash table class ~a" (hashtable-flavour table)))))
+
+(define-function 'HCOUNT #'hash-table-count)
+
+;17.4 Searching and Updating
+
+(defun HPUT (table key value) (setf (gethash key table) value))
+
+(defun HPUT* (table alist)
+  (mapc #'(lambda (pair) (hput table (car pair) (cdr pair))) alist))
+
+(defmacro HREM (table key) `(remhash ,key ,table))
+
+(defun HREMPROP (table key property)
+  (let ((plist (gethash key table)))
+    (if plist (setf (gethash key table)
+                    (delete property plist :test #'equal :key #'car)))))
+
+;17.5 Updating
+
+(define-function 'HCLEAR #'clrhash)
+
+;17.6 Miscellaneous
+
+(define-function 'HASHTABLEP #'hash-table-p)
+
+(define-function 'HASHEQ #'sxhash)
+
+(define-function 'HASHUEQUAL #'sxhash)
+
+(define-function 'HASHCVEC #'sxhash)
+
+(define-function 'HASHID #'sxhash)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/hashcode.boot.pamphlet b/src/interp/hashcode.boot.pamphlet
new file mode 100644
index 00000000..4a0f640e
--- /dev/null
+++ b/src/interp/hashcode.boot.pamphlet
@@ -0,0 +1,131 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp hashcode.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- Type hasher for old compiler style type names which produces a hash code
+-- compatible with the asharp compiler.  Takes a hard error if the type
+-- is parameterized, but has no constructor modemap.
+getDomainHash dom == SPADCALL(CDR dom, (CAR dom).4)
+
+hashType(type, percentHash) ==
+	SYMBOLP type  =>
+           type = '$ => percentHash
+           type = "%" => percentHash
+           hashString SYMBOL_-NAME type
+        STRINGP type  => hashCombine(hashString type, 
+   					hashString('"Enumeration"))
+        type is ['QUOTE, val] => hashType(val, percentHash)
+	type is [dom] => hashString SYMBOL_-NAME dom
+	type is ['_:, ., type2] => hashType(type2, percentHash)
+        isDomain type => getDomainHash type
+	[op, :args] := type
+	hash := hashString SYMBOL_-NAME op
+	op = 'Mapping =>
+		hash := hashString '"->"
+		[retType, :mapArgs] := args
+		for arg in mapArgs repeat
+			hash := hashCombine(hashType(arg, percentHash), hash)
+                retCode := hashType(retType, percentHash)
+                EQL(retCode, $VoidHash) => hash
+		hashCombine(retCode, hash)
+	op = 'Enumeration =>
+		for arg in args repeat
+			hash := hashCombine(hashString(STRING arg), hash)
+		hash
+	op in $DomainsWithoutLisplibs =>
+		for arg in args repeat
+			hash := hashCombine(hashType(arg, percentHash), hash)
+		hash
+
+	cmm :=   CDDAR getConstructorModemap(op)
+	cosig := CDR   GETDATABASE(op, 'COSIG)
+	for arg in args for c in cosig for ct in cmm repeat
+		if c then
+			hash := hashCombine(hashType(arg, percentHash), hash)
+		else
+			hash := hashCombine(7, hash)
+--           !!!   If/when asharp hashes values using their type, use instead
+--			ctt := EQSUBSTLIST(args, $FormalMapVariableList, ct)
+--			hash := hashCombine(hashType(ctt, percentHash), hash)
+
+
+	hash
+
+--The following are in cfuns.lisp
+$hashModulus := 1073741789 			-- largest 30-bit prime
+
+-- Produce a 30-bit hash code.  This function must produce the same codes
+-- as the asharp string hasher in src/strops.c
+hashString str ==
+	h := 0
+	for i in 0..#str-1 repeat
+		j := CHAR_-CODE char str.i
+		h := LOGXOR(h, ASH(h, 8))
+		h := h + j + 200041
+		h := LOGAND(h, 1073741823)	-- 0x3FFFFFFF
+	REM(h, $hashModulus)
+
+-- Combine two hash codes to make a new one.  Must be the same as in
+-- the hashCombine function in aslib/runtime.as in asharp.
+hashCombine(hash1, hash2) ==
+	 MOD(ASH(LOGAND(hash2, 16777215), 6) + hash1, $hashModulus)
+
+
+$VoidHash := hashString '"Void"
+
+
+-- following two lines correct bad coSig properties due to SubsetCategory
+--putConstructorProperty('LocalAlgebra,'coSig,'(NIL T T T))
+--putConstructorProperty('Localize,'coSig,'(NIL T T T))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ht-root.boot.pamphlet b/src/interp/ht-root.boot.pamphlet
new file mode 100644
index 00000000..3d8d08af
--- /dev/null
+++ b/src/interp/ht-root.boot.pamphlet
@@ -0,0 +1,311 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp ht-root.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+$historyDisplayWidth := 120
+$newline := char 10
+
+downlink page ==
+  $saturn => downlinkSaturn page
+  htInitPage('"Bridge",nil)
+  htSay('"\replacepage{", page, '"}")
+  htShowPage()
+
+downlinkSaturn fn ==
+  u := dbReadLines(fn)
+  lines := '""
+  while u is [line,:u] repeat
+    n := MAXINDEX line
+    n < 1 => nil
+    line.0 = (char '_%) => nil
+    lines := STRCONC(lines,line)
+  issueHTSaturn lines
+
+dbNonEmptyPattern pattern ==
+  null pattern => '"*"
+  pattern := STRINGIMAGE pattern
+  #pattern > 0 => pattern
+  '"*"
+
+htSystemVariables() == main where
+  main ==
+    not $fullScreenSysVars => htSetVars()
+    classlevel := $UserLevel
+    $levels : local := '(compiler development interpreter)
+    $heading  : local := nil
+    while classlevel ^= first $levels repeat $levels := rest $levels
+    table := NREVERSE fn($setOptions,nil,true)
+    htInitPage('"System Variables",nil)
+    htSay '"\beginmenu"
+    lastHeading := nil
+    for [heading,name,message,.,key,variable,options,func] in table repeat
+      htSay('"\newline\item ")
+      if heading = lastHeading then htSay '"\tab{8}" else
+        htSay(heading,'"\tab{8}")
+        lastHeading := heading
+      htSay('"{\em ",name,"}\tab{22}",message)
+      htSay('"\tab{80}")
+      key = 'FUNCTION =>
+         null options => htMakePage [['bcLinks,['"reset",'"",func,nil]]]
+         [msg,class,var,valuesOrFunction,:.] := first options  --skip first message
+         functionTail(name,class,var,valuesOrFunction)
+         for option in rest options repeat
+           option is ['break,:.] => 'skip
+           [msg,class,var,valuesOrFunction,:.] := option
+           htSay('"\newline\tab{22}", msg,'"\tab{80}")
+           functionTail(name,class,var,valuesOrFunction)
+      val := eval variable
+      displayOptions(name,key,variable,val,options)
+    htSay '"\endmenu"
+    htShowPage()
+  functionTail(name,class,var,valuesOrFunction) ==
+    val := eval var
+    atom valuesOrFunction =>
+      htMakePage '((domainConditions (isDomain STR (String))))
+      htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]]
+      htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]]
+    displayOptions(name,class,var,val,valuesOrFunction)
+  displayOptions(name,class,variable,val,options) ==
+    class = 'INTEGER =>
+      htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]]
+      htMakePage '((domainConditions (isDomain INT (Integer))))
+      htMakePage  [['bcStrings,[5,STRINGIMAGE val,name,'INT]]]
+    class = 'STRING =>
+      htSay('"{\em ",val,'"}\space{1}")
+    for x in options repeat
+      val = x or val = true and x = 'on or null val and x = 'off =>
+        htSay('"{\em ",x,'"}\space{1}")
+      htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]]
+  fn(t,al,firstTime) ==
+    atom t => al
+    if firstTime then $heading := opOf first t
+    fn(rest t,gn(first t,al),firstTime)
+  gn(t,al) ==
+    [.,.,class,key,.,options,:.] := t
+    not MEMQ(class,$levels) => al
+    key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al]
+    key = 'TREE => fn(options,al,false)
+    key = 'FUNCTION => [[$heading,:t],:al]
+    systemError key
+
+htSetSystemVariableKind(htPage,[variable,name,fun]) ==
+  value := htpLabelInputString(htPage,name)
+  if STRINGP value and fun then value := FUNCALL(fun,value)
+--SCM::what to do???  if not FIXP value then userError ???
+  SET(variable,value)
+  htSystemVariables ()
+
+htSetSystemVariable(htPage,[name,value]) ==
+  value :=
+    value = 'on => true
+    value = 'off => nil
+    value
+  SET(name,value)
+  htSystemVariables ()
+
+htGloss(pattern) == htGlossPage(nil,dbNonEmptyPattern pattern or '"*",true)
+
+htGlossPage(htPage,pattern,tryAgain?) ==
+  $wildCard: local := char '_*
+  pattern = '"*" => downlink 'GlossaryPage
+  filter := pmTransFilter pattern
+  grepForm := mkGrepPattern(filter,'none)
+  $key: local := 'none
+  results := applyGrep(grepForm,'gloss)
+  --pathname := STRCONC('"/tmp/",PNAME resultFile,'".text.", getEnv '"SPADNUM")
+  --instream := MAKE_-INSTREAM pathname
+  defstream := MAKE_-INSTREAM STRCONC(getEnv '"AXIOM",'"/algebra/glossdef.text")
+  lines := gatherGlossLines(results,defstream)
+  -- OBEY STRCONC('"rm -f ", pathname)
+  --PROBE_-FILE(pathname) and DELETE_-FILE(pathname)
+  --SHUT instream
+  heading :=
+    pattern = '"" => '"Glossary"
+    null lines => ['"No glossary items match {\em ",pattern,'"}"]
+    ['"Glossary items matching {\em ",pattern,'"}"]
+  null lines =>
+    tryAgain? and #pattern > 0 =>
+      (pattern.(k := MAXINDEX(pattern))) = char 's =>
+        htGlossPage(htPage,SUBSTRING(pattern,0,k),true)
+      UPPER_-CASE_-P pattern.0 =>
+        htGlossPage(htPage,DOWNCASE pattern,false)
+      errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]])
+    errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]])
+  htInitPageNoScroll(nil,heading)
+  htSay('"\beginscroll\beginmenu")
+  for line in lines repeat
+    tick := charPosition($tick,line,1)
+    htSay('"\item{\em \menuitemstyle{}}\tab{0}{\em ",escapeString SUBSTRING(line,0,tick),'"} ",SUBSTRING(line,tick + 1,nil))
+  htSay '"\endmenu "
+  htSay '"\endscroll\newline "
+  htMakePage [['bcLinks,['"Search",'"",'htGlossSearch,nil]]]
+  htSay '" for glossary entry matching "
+  htMakePage [['bcStrings, [24,'"*",'filter,'EM]]]
+  htShowPageNoScroll()
+
+gatherGlossLines(results,defstream) ==
+  acc := nil
+  for keyline in results repeat
+    --keyline := READLINE instream
+    n := charPosition($tick,keyline,0)
+    keyAndTick := SUBSTRING(keyline,0,n + 1)
+    byteAddress := string2Integer SUBSTRING(keyline,n + 1,nil)
+    FILE_-POSITION(defstream,byteAddress)
+    line := READLINE defstream
+    k := charPosition($tick,line,1)
+    pointer := SUBSTRING(line,0,k)
+    def := SUBSTRING(line,k + 1,nil)
+    xtralines := nil
+    while not EOFP defstream and (x := READLINE defstream) and
+      (j := charPosition($tick,x,1)) and (nextPointer := SUBSTRING(x,0,j))
+        and (nextPointer = pointer) repeat
+          xtralines := [SUBSTRING(x,j + 1,nil),:xtralines]
+    acc := [STRCONC(keyAndTick,def, "STRCONC"/NREVERSE xtralines),:acc]
+  REVERSE acc
+
+htGlossSearch(htPage,junk) ==  htGloss htpLabelInputString(htPage,'filter)
+
+htGreekSearch(filter) ==
+  ss := dbNonEmptyPattern filter
+  s := pmTransFilter ss
+  s is ['error,:.] => bcErrorPage s
+  not s => errorPage(nil,[['"Missing search string"],nil,
+    '"\vspace{2}\centerline{To select one of the greek letters:}\newline ",
+      '"\centerline{{\em first} enter a search key into the input area}\newline ",
+        '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"])
+  filter := patternCheck s
+  names := '(alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu pi)
+  for x in names repeat
+    superMatch?(filter,PNAME x) => matches := [x,:matches]
+    nonmatches := [x,:nonmatches]
+  matches    := NREVERSE matches
+  nonmatches := NREVERSE nonmatches
+  htInitPage('"Greek Names",nil)
+  null matches =>
+    htInitPage(['"Greek names matching search string {\em ",ss,'"}"],nil)
+    htSay("\vspace{2}\centerline{Sorry, but no greek letters match your search string}\centerline{{\em ",ss,"}}\centerline{Click on the up-arrow to try again}")
+    htShowPage()
+  htInitPage(['"Greek letters matching search string {\em ",ss,'"}"],nil)
+  if nonmatches
+    then htSay('"The greek letters that {\em match} your search string {\em ",ss,'"}:")
+    else htSay('"Your search string {\em ",ss,"} matches all of the greek letters:")
+  htSay('"{\em \table{")
+  for x in matches repeat htSay('"{",x,'"}")
+  htSay('"}}\vspace{1}")
+  if nonmatches then
+    htSay('"The greek letters that {\em do not match} your search string:{\em \table{")
+    for x in nonmatches repeat htSay('"{",x,'"}")
+    htSay('"}}")
+  htShowPage()
+
+htTextSearch(filter) ==
+  s := pmTransFilter dbNonEmptyPattern filter
+  s is ['error,:.] => bcErrorPage s
+  not s => errorPage(nil,[['"Missing search string"],nil,
+    '"\vspace{2}\centerline{To select one of the lines of text:}\newline ",
+      '"\centerline{{\em first} enter a search key into the input area}\newline ",
+        '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"])
+  filter := s
+  lines := ['"{{\em Fruit flies} *like* a {\em banana and califlower ears.}}",
+            '"{{\em Sneak Sears Silas with Savings Snatch}}"]
+  for x in lines repeat
+    superMatch?(filter,x) => matches := [x,:matches]
+    nonmatches := [x,:nonmatches]
+  matches    := NREVERSE matches
+  nonmatches := NREVERSE nonmatches
+  htInitPage('"Text Matches",nil)
+  null matches =>
+    htInitPage(['"Lines matching search string {\em ",s,'"}"],nil)
+    htSay("\vspace{2}\centerline{Sorry, but no lines match your search string}\centerline{{\em ",s,"}}\centerline{Click on the up-arrow to try again}")
+    htShowPage()
+  htInitPage(['"Lines matching search string {\em ",s,'"}"],nil)
+  if nonmatches
+    then htSay('"The lines that {\em match} your search string {\em ",s,'"}:")
+    else htSay('"Your search string {\em ",s,"} matches both lines:")
+  htSay('"{\em \table{")
+  for x in matches repeat htSay('"{",x,'"}")
+  htSay('"}}\vspace{1}")
+  if nonmatches then
+    htSay('"The line that {\em does not match} your search string:{\em \table{")
+    for x in nonmatches repeat htSay('"{",x,'"}")
+    htSay('"}}")
+  htShowPage()
+
+htTutorialSearch pattern ==
+  s := dbNonEmptyPattern pattern or return
+    errorPage(nil,['"Empty search key",nil,'"\vspace{3}\centerline{You must enter some search string"])
+  s := mkUnixPattern s
+  source := '"$AXIOM/share/hypertex/pages/ht.db"
+  target :='"/tmp/temp.text.$SPADNUM"
+  OBEY STRCONC('"$AXIOM/lib/hthits",'" _"",s,'"_" ",source,'" > ",target)
+  lines := dbReadLines 'temp
+  htInitPageNoScroll(nil,['"Tutorial Pages mentioning {\em ",pattern,'"}"])
+  htSay('"\beginscroll\table{")
+  for line in lines repeat
+    [name,title,.] := dbParts(line,3,0)
+    htSay ['"{\downlink{",title,'"}{",name,'"}}"]
+  htSay '"}"
+  htShowPage()
+
+mkUnixPattern s ==
+  u := mkUpDownPattern s
+  starPositions := REVERSE [i for i in 1..(-1 + MAXINDEX u) | u.i = $wild]
+  for i in starPositions repeat
+    u := STRCONC(SUBSTRING(u,0,i),'".*",SUBSTRING(u,i + 1,nil))
+  if u.0 ^= $wild then u := STRCONC('"[^a-zA-Z]",u)
+                  else u := SUBSTRING(u,1,nil)
+  if u.(k := MAXINDEX u) ^= $wild then u := STRCONC(u,'"[^a-zA-Z]")
+                                  else u := SUBSTRING(u,0,k)
+  u
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ht-util.boot.pamphlet b/src/interp/ht-util.boot.pamphlet
new file mode 100644
index 00000000..f875959f
--- /dev/null
+++ b/src/interp/ht-util.boot.pamphlet
@@ -0,0 +1,753 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp ht-util.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- HyperTeX Utilities for generating basic Command pages
+--)package "BOOT"
+
+$bcParseOnly := true
+
+-- List of issued hypertex lines
+$htLineList := nil
+
+-- pointer to the page we are currently defining
+$curPage := nil
+
+-- List of currently active window named
+$activePageList := nil
+
+htpDestroyPage(pageName) ==
+  pageName in $activePageList =>
+    SET(pageName, nil)
+    $activePageList := NREMOVE($activePageList, pageName)
+
+htpName htPage ==
+-- GENSYM whose value is the page
+  ELT(htPage, 0)
+
+htpSetName(htPage, val) ==
+  SETELT(htPage, 0, val)
+
+htpDomainConditions htPage ==
+-- List of Domain conditions
+  ELT(htPage, 1)
+
+htpSetDomainConditions(htPage, val) ==
+  SETELT(htPage, 1, val)
+
+htpDomainVariableAlist htPage ==
+-- alist of pattern variables and conditions
+  ELT(htPage, 2)
+
+htpSetDomainVariableAlist(htPage, val) ==
+  SETELT(htPage, 2, val)
+
+htpDomainPvarSubstList htPage ==
+-- alist of user pattern variables to system vars
+  ELT(htPage, 3)
+
+htpSetDomainPvarSubstList(htPage, val) ==
+  SETELT(htPage, 3, val)
+
+htpRadioButtonAlist htPage ==
+-- alist of radio button group names and labels
+  ELT(htPage, 4)
+
+htpButtonValue(htPage, groupName) ==
+  for buttonName in LASSOC(groupName, htpRadioButtonAlist htPage) repeat
+    (stripSpaces htpLabelInputString(htPage, buttonName)) = '"t" =>
+      return buttonName
+
+htpSetRadioButtonAlist(htPage, val) ==
+  SETELT(htPage, 4, val)
+
+htpInputAreaAlist htPage ==
+-- Alist of input-area labels, and default values
+  ELT(htPage, 5)
+
+htpSetInputAreaAlist(htPage, val) ==
+  SETELT(htPage, 5, val)
+
+htpAddInputAreaProp(htPage, label, prop) ==
+  SETELT(htPage, 5, [[label, nil, nil, nil, :prop], :ELT(htPage, 5)])
+
+htpPropertyList htPage ==
+-- Association list of user-defined properties
+  ELT(htPage, 6)
+
+htpProperty(htPage, propName) ==
+  LASSOC(propName, ELT(htPage, 6))
+
+htpSetProperty(htPage, propName, val) ==
+  pair := ASSOC(propName, ELT(htPage, 6))
+  pair => RPLACD(pair, val)
+  SETELT(htPage, 6, [[propName, :val], :ELT(htPage, 6)])
+
+htpLabelInputString(htPage, label) ==
+-- value user typed as input string on page
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props and STRINGP (s := ELT(props,0)) =>
+    s = '"" => s
+    trimString s
+  nil
+
+htpLabelFilteredInputString(htPage, label) ==
+-- value user typed as input string on page
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props =>
+    #props > 5 and ELT(props, 6) =>
+      FUNCALL(SYMBOL_-FUNCTION ELT(props, 6), ELT(props, 0))
+    replacePercentByDollar ELT(props, 0)
+  nil
+
+replacePercentByDollar s == fn(s,0,MAXINDEX s) where
+  fn(s,i,n) ==
+    i > n => '""
+    (m := charPosition(char "%",s,i)) > n => SUBSTRING(s,i,nil)
+    STRCONC(SUBSTRING(s,i,m - i),'"$",fn(s,m + 1,n))
+
+htpSetLabelInputString(htPage, label, val) ==
+------------------> OBSELETE
+-- value user typed as input string on page
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => SETELT(props, 0, STRINGIMAGE val)
+  nil
+
+htpLabelSpadValue(htPage, label) ==
+-- Scratchpad value of parsed and evaled inputString, as (type . value)
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => ELT(props, 1)
+  nil
+
+htpSetLabelSpadValue(htPage, label, val) ==
+-- value user typed as input string on page
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => SETELT(props, 1, val)
+  nil
+
+htpLabelErrorMsg(htPage, label) ==
+-- error message associated with input area
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => ELT(props, 2)
+  nil
+
+htpSetLabelErrorMsg(htPage, label, val) ==
+-- error message associated with input area
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => SETELT(props, 2, val)
+  nil
+
+htpLabelType(htPage, label) ==
+-- either 'string or 'button
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => ELT(props, 3)
+  nil
+
+htpLabelDefault(htPage, label) ==
+-- default value for the input area
+  msg := htpLabelInputString(htPage, label) =>
+    msg = '"t" => 1
+    msg = '"nil" => 0
+    msg
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props =>
+    ELT(props, 4)
+  nil
+
+
+htpLabelSpadType(htPage, label) ==
+-- pattern variable for target domain for input area
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => ELT(props, 5)
+  nil
+
+htpLabelFilter(htPage, label) ==
+-- string to string mapping applied to input area strings before parsing
+  props := LASSOC(label, htpInputAreaAlist htPage)
+  props => ELT(props, 6)
+  nil
+
+htpPageDescription htPage ==
+-- a list of all the commands issued to create the basic-command page
+  ELT(htPage, 7)
+
+htpSetPageDescription(htPage, pageDescription) ==
+  SETELT(htPage, 7, pageDescription)
+
+htpAddToPageDescription(htPage, pageDescrip) ==
+-------------> OBSELETE <-----------
+  SETELT(htPage, 7, nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7)))
+
+iht line ==
+-- issue a single hyperteTeX line, or a group of lines
+  $newPage => nil
+  PAIRP line =>
+    $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList)
+  $htLineList := [basicStringize line, :$htLineList]
+
+bcHt line ==
+--line = '"\##1" => harharhar()
+  iht line
+  PAIRP line =>
+    if $newPage then htpAddToPageDescription($curPage, [['text, :line]])
+  if $newPage then htpAddToPageDescription($curPage, [['text, line]])
+
+bcIssueHt line ==
+  PAIRP line => htMakePage1 line
+  iht line
+
+mapStringize l ==
+  ATOM l => l
+  RPLACA(l, basicStringize CAR l)
+  RPLACD(l, mapStringize CDR l)
+  l
+
+basicStringize s ==
+  STRINGP s =>
+    s = '"\$"      => '"\%"
+    s = '"{\em $}" => '"{\em \%}"
+    s
+  s = '_$ => '"\%"
+  PRINC_-TO_-STRING s
+
+stringize s ==
+  STRINGP s => s
+  PRINC_-TO_-STRING s
+
+htInitPage(title, propList) ==
+----------------------------> OBSELETE---cannot return $curPage
+-- start defining a hyperTeX page
+  htInitPageNoScroll(propList, title)
+  htSayStandard '"\beginscroll "
+  $curPage
+
+
+--htInitPageNoHeading(propList) ==
+-----------------------> replaced by htInitPageNoScroll
+-- start defining a hyperTeX page
+--  $curPage := htpMakeEmptyPage(propList)
+--  if $saturn then $saturnPage := htpMakeEmptyPage(propList)
+--  $newPage := true
+--  $htLineList := nil
+--  $curPage
+
+htAddHeading(title) ==
+------------------------> OBSELETE
+  htNewPage title
+  $curPage
+
+htShowPage() ==
+-- show the page which has been computed
+  htSayStandard '"\endscroll"
+  htShowPageNoScroll()
+
+htShowPageNoScroll() ==
+------------------------> OBSELETE
+-- show the page which has been computed
+  htSayStandard '"\autobuttons"
+  htpSetPageDescription($curPage, nreverse htpPageDescription $curPage)
+  $newPage := false
+  $htLineList := nil
+  htMakePage htpPageDescription $curPage
+  line := APPLY(function CONCAT, nreverse $htLineList)
+  issueHT line
+  endHTPage()
+
+htMakePage itemList ==
+------------------------> OBSELETE
+-- make a page given the description in itemList
+  if $newPage then htpAddToPageDescription($curPage, itemList)
+  htMakePage1 itemList
+
+htMakePage1 itemList ==
+-- make a page given the description in itemList
+  for [itemType, :items] in itemList repeat
+    itemType = 'text              => iht items
+    itemType = 'lispLinks         => htLispLinks items
+    itemType = 'lispmemoLinks     => htLispMemoLinks items
+    itemType = 'bcLinks           => htBcLinks items               --->
+    itemType = 'bcLinksNS         => htBcLinks(items,true)
+    itemType = 'bcLispLinks       => htBcLispLinks items           --->
+    itemType = 'radioButtons      => htRadioButtons items
+    itemType = 'bcRadioButtons    => htBcRadioButtons items
+    itemType = 'inputStrings      => htInputStrings items
+    itemType = 'domainConditions  => htProcessDomainConditions items
+    itemType = 'bcStrings         => htProcessBcStrings items
+    itemType = 'toggleButtons     => htProcessToggleButtons items
+    itemType = 'bcButtons         => htProcessBcButtons items
+    itemType = 'doneButton        => htProcessDoneButton items
+    itemType = 'doitButton        => htProcessDoitButton items
+    systemError ['"unknown itemType", itemType]
+
+htMakeErrorPage htPage ==
+------------------> OBSELETE
+  $newPage := false
+  $htLineList := nil
+  $curPage := htPage
+  htMakePage htpPageDescription htPage
+  line := APPLY(function CONCAT, nreverse $htLineList)
+  issueHT line
+  endHTPage()
+
+htQuote s ==
+-- wrap quotes around a piece of hyperTeX
+  iht '"_""
+  iht s
+  iht '"_""
+
+htProcessToggleButtons buttons ==
+  iht '"\newline\indent{5}\beginitems "
+  for [message, info, defaultValue, buttonName] in buttons repeat
+    if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then
+      setUpDefault(buttonName, ['button, defaultValue])
+    iht ['"\item{\em\inputbox[", htpLabelDefault($curPage, buttonName), '"]{",
+         buttonName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}\space{}"]
+    bcIssueHt message
+    iht '"\space{}}"
+    bcIssueHt info
+  iht '"\enditems\indent{0} "
+
+htProcessBcButtons buttons ==
+  for [defaultValue, buttonName] in buttons repeat
+    if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then
+      setUpDefault(buttonName, ['button, defaultValue])
+    k := htpLabelDefault($curPage,buttonName)
+    k = 0 => iht ['"\off{",buttonName,'"}"]
+    k = 1 => iht ['"\on{", buttonName,'"}"]
+    iht ['"\inputbox[", htpLabelDefault($curPage, buttonName), '"]{",
+         buttonName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}"]
+
+htProcessBcStrings strings ==
+---------------------> OBSELETE <------------------------
+  for [numChars, default, stringName, spadType, :filter] in strings repeat
+    mess2 := '""
+    if NULL LASSOC(stringName, htpInputAreaAlist $curPage) then
+      setUpDefault(stringName, ['string, default, spadType, filter])
+    if htpLabelErrorMsg($curPage, stringName) then
+      iht ['"\centerline{{\em ", htpLabelErrorMsg($curPage, stringName), '"}}"]
+      mess2 := CONCAT(mess2, bcSadFaces())
+      htpSetLabelErrorMsg($curPage, stringName, nil)
+    iht ['"\inputstring{", stringName, '"}{",
+         numChars, '"}{", htpLabelDefault($curPage,stringName), '"} ", mess2]
+
+bcSadFaces() ==
+  '"\space{1}{\em\htbitmap{error}\htbitmap{error}\htbitmap{error}}"
+
+htLispLinks(links,:option) ==
+  [links,options] := beforeAfter('options,links)
+  indent := LASSOC('indent,options) or 5
+  iht '"\newline\indent{"
+  iht stringize indent
+  iht '"}\beginitems"
+  for [message, info, func, :value] in links repeat
+    iht '"\item["
+    call := (IFCAR option => '"\lispmemolink"; '"\lispdownlink")
+    htMakeButton(call,message, mkCurryFun(func, value))
+    iht ['"]\space{}"]
+    bcIssueHt info
+  iht '"\enditems\indent{0} "
+
+htLispMemoLinks(links) == htLispLinks(links,true)
+
+htBcLinks(links,:options) ==
+-------------------------> OBSELETE
+  skipStateInfo? := IFCAR options
+  [links,options] := beforeAfter('options,links)
+  for [message, info, func, :value] in links repeat
+    htMakeButton('"\lispdownlink",message,
+                   mkCurryFun(func, value),skipStateInfo?)
+    bcIssueHt info
+
+htBcLispLinks links ==
+-------------------------> OBSELETE
+  [links,options] := beforeAfter('options,links)
+  for [message, info, func, :value] in links repeat
+    htMakeButton('"\lisplink",message, mkCurryFun(func, value))
+    bcIssueHt info
+
+beforeAfter(x,u) == [[y for [y,:r] in tails u while x ^= y],r]
+
+mkCurryFun(fun, val) ==
+  name := GENTEMP()
+  code :=
+    ['DEFUN, name, '(arg), ['APPLY, MKQ fun, ['CONS, 'arg, MKQ val]]]
+  EVAL code
+  name
+
+htRadioButtons [groupName, :buttons] ==
+  htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons],
+                                    : htpRadioButtonAlist $curPage])
+  boxesName := GENTEMP()
+  iht ['"\newline\indent{5}\radioboxes{", boxesName,
+     '"}{\htbmfile{pick}}{\htbmfile{unpick}}\beginitems "]
+  defaultValue := '"1"
+  for [message, info, buttonName] in buttons repeat
+    if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then
+      setUpDefault(buttonName, ['button, defaultValue])
+      defaultValue := '"0"
+    iht ['"\item{\em\radiobox[", htpLabelDefault($curPage, buttonName), '"]{",
+         buttonName, '"}{",boxesName, '"}\space{}"]
+    bcIssueHt message
+    iht '"\space{}}"
+    bcIssueHt info
+  iht '"\enditems\indent{0} "
+
+htBcRadioButtons [groupName, :buttons] ==
+  htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons],
+                                    : htpRadioButtonAlist $curPage])
+  boxesName := GENTEMP()
+  iht ['"\radioboxes{", boxesName,
+     '"}{\htbmfile{pick}}{\htbmfile{unpick}} "]
+  defaultValue := '"1"
+  for [message, info, buttonName] in buttons repeat
+    if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then
+      setUpDefault(buttonName, ['button, defaultValue])
+      defaultValue := '"0"
+    iht ['"{\em\radiobox[", htpLabelDefault($curPage, buttonName), '"]{",
+         buttonName, '"}{",boxesName, '"}"]
+    bcIssueHt message
+    iht '"\space{}}"
+    bcIssueHt info
+
+setUpDefault(name, props) ==
+---------------> OBSELETE <----------------
+  htpAddInputAreaProp($curPage, name, props)
+
+buttonNames buttons ==
+  [buttonName for [.,., buttonName] in buttons]
+
+htInputStrings strings ==
+  iht '"\newline\indent{5}\beginitems "
+  for [mess1, mess2, numChars, default, stringName, spadType, :filter]
+   in strings repeat
+    if NULL LASSOC(stringName, htpInputAreaAlist $curPage) then
+      setUpDefault(stringName, ['string, default, spadType, filter])
+    if htpLabelErrorMsg($curPage, stringName) then
+      iht ['"\centerline{{\em ", htpLabelErrorMsg($curPage, stringName), '"}}"]
+
+      mess2 := CONCAT(mess2, bcSadFaces())
+      htpSetLabelErrorMsg($curPage, stringName, nil)
+    iht '"\item "
+    bcIssueHt mess1
+    iht ['"\inputstring{", stringName, '"}{",
+         numChars, '"}{", htpLabelDefault($curPage,stringName), '"} "]
+    bcIssueHt mess2
+  iht '"\enditems\indent{0}\newline "
+
+htProcessDomainConditions condList ==
+  htpSetDomainConditions($curPage, renamePatternVariables condList)
+  htpSetDomainVariableAlist($curPage, computeDomainVariableAlist())
+
+renamePatternVariables condList ==
+  htpSetDomainPvarSubstList($curPage,
+    renamePatternVariables1(condList, nil, $PatternVariableList))
+  substFromAlist(condList, htpDomainPvarSubstList $curPage)
+
+renamePatternVariables1(condList, substList, patVars) ==
+  null condList => substList
+  [cond, :restConds] := condList
+  cond is ['isDomain, pv, pattern] or cond is ['ofCategory, pv, pattern]
+    or cond is ['Satisfies, pv, cond] =>
+      if pv = $EmptyMode then nsubst := substList
+      else nsubst := [[pv, :car patVars], :substList]
+      renamePatternVariables1(restConds, nsubst, rest patVars)
+  substList
+
+substFromAlist(l, substAlist) ==
+  for [pvar, :replace] in substAlist repeat
+    l := SUBST(replace, pvar, l)
+  l
+
+computeDomainVariableAlist() ==
+  [[pvar, :pvarCondList pvar] for [., :pvar] in
+    htpDomainPvarSubstList $curPage]
+
+pvarCondList pvar ==
+  nreverse pvarCondList1([pvar], nil, htpDomainConditions $curPage)
+
+pvarCondList1(pvarList, activeConds, condList) ==
+  null condList => activeConds
+  [cond, : restConds] := condList
+  cond is [., pv, pattern] and pv in pvarList =>
+    pvarCondList1(nconc(pvarList, pvarsOfPattern pattern),
+                  [cond, :activeConds], restConds)
+  pvarCondList1(pvarList, activeConds, restConds)
+
+pvarsOfPattern pattern ==
+  NULL LISTP pattern => nil
+  [pvar for pvar in rest pattern | pvar in $PatternVariableList]
+
+htMakeTemplates(templateList, numLabels) ==
+  templateList := [templateParts template for template in templateList]
+  [[substLabel(i, template) for template in templateList]
+    for i in 1..numLabels] where substLabel(i, template) ==
+      PAIRP template =>
+        INTERN CONCAT(first template, PRINC_-TO_-STRING i, rest template)
+      template
+
+templateParts template ==
+  NULL STRINGP template => template
+  i := SEARCH('"%l", template)
+  null i => template
+  [SUBSEQ(template, 0, i), : SUBSEQ(template, i+2)]
+
+htMakeDoneButton(message, func) ==
+  bcHt '"\newline\vspace{1}\centerline{"
+  if message = '"Continue" then
+    bchtMakeButton('"\lispdownlink", "\ContinueBitmap", func)
+  else
+    bchtMakeButton('"\lispdownlink",CONCAT('"\box{", message, '"}"), func)
+  bcHt '"} "
+
+htProcessDoneButton [label , func] ==
+  iht '"\newline\vspace{1}\centerline{"
+
+  if label = '"Continue" then
+    htMakeButton('"\lispdownlink", "\ContinueBitmap", func)
+  else if label = '"Push to enter names" then
+    htMakeButton('"\lispdownlink",'"\ControlBitmap{ClickToSet}", func)
+  else
+    htMakeButton('"\lispdownlink", CONCAT('"\box{", label, '"}"), func)
+
+  iht '"} "
+
+htMakeButton(htCommand, message, func,:options) ==
+----------> OBSELETE <----------------------------------
+  skipStateInfo? := IFCAR options
+  iht [htCommand, '"{"]
+  bcIssueHt message
+  skipStateInfo? =>
+    iht ['"}{(|htDoneButton| '|", func, '"| ",htpName $curPage, '")}"]
+  iht ['"}{(|htDoneButton| '|", func, '"| (PROGN "]
+  for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat
+    iht ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "]
+    if type = 'string then
+      iht ['"_"\stringvalue{", id, '"}_""]
+    else
+      iht ['"_"\boxvalue{", id, '"}_""]
+    iht '") "
+  iht [htpName $curPage, '"))}"]
+
+bchtMakeButton(htCommand, message, func) ==
+  bcHt [htCommand, '"{", message,
+       '"}{(|htDoneButton| '|", func, '"| (PROGN "]
+  for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat
+    bcHt ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "]
+    if type = 'string then
+      bcHt ['"_"\stringvalue{", id, '"}_""]
+    else
+      bcHt ['"_"\boxvalue{", id, '"}_""]
+    bcHt '") "
+  bcHt [htpName $curPage, '"))} "]
+
+htProcessDoitButton [label, command, func] ==
+  fun := mkCurryFun(func, [command])
+  iht '"\newline\vspace{1}\centerline{"
+  htMakeButton('"\lispcommand", CONCAT('"\box{", label, '"}"), fun)
+  iht '"} "
+  iht '"\vspace{2}{Select \  \UpButton{} \  to go back one page.}"
+  iht '"\newline{Select \  \ExitButton{QuitPage} \  to remove this window.}"
+
+htMakeDoitButton(label, command) ==
+  -- use bitmap button if just plain old "Do It"
+  if label = '"Do It" then
+    bcHt '"\newline\vspace{1}\centerline{\lispcommand{\DoItBitmap}{(|doDoitButton| "
+  else
+    bcHt ['"\newline\vspace{1}\centerline{\lispcommand{\box{", label,
+       '"}}{(|doDoitButton| "]
+  bcHt htpName $curPage
+  bcHt ['" _"", htEscapeString command, '"_""]
+  bcHt '")}}"
+
+  bcHt '"\vspace{2}{Select \  \UpButton{} \  to go back one page.}"
+  bcHt '"\newline{Select \  \ExitButton{QuitPage} \  to remove this window.}"
+
+doDoitButton(htPage, command) ==
+  executeInterpreterCommand command
+
+executeInterpreterCommand command ==
+  PRINC command
+  TERPRI()
+  ncSetCurrentLine(command)
+  CATCH('SPAD__READER, parseAndInterpret command)
+  PRINC MKPROMPT()
+  FINISH_-OUTPUT()
+
+htDoneButton(func, htPage) ==
+  typeCheckInputAreas htPage =>
+    htMakeErrorPage htPage
+  NULL FBOUNDP func =>
+    systemError ['"unknown function", func]
+  FUNCALL(SYMBOL_-FUNCTION func, htPage)
+
+typeCheckInputAreas htPage ==
+  -- This needs to be severly beefed up
+  inputAlist := nil
+  errorCondition := false
+  for entry in htpInputAreaAlist htPage
+   | entry is [stringName, ., ., ., 'string, ., spadType, filter] repeat
+    condList :=
+      LASSOC(LASSOC(spadType,htpDomainPvarSubstList htPage),
+             htpDomainVariableAlist htPage)
+    string := htpLabelFilteredInputString(htPage, stringName)
+    $bcParseOnly =>
+      null ncParseFromString string =>
+        htpSetLabelErrorMsg(htPage, '"Syntax Error", '"Syntax Error")
+      nil
+    val := checkCondition(htpLabelInputString(htPage, stringName),
+                          string, condList)
+    STRINGP val =>
+      errorCondition := true
+      htpSetLabelErrorMsg(htPage, stringName, val)
+    htpSetLabelSpadValue(htPage, stringName, val)
+  errorCondition
+
+checkCondition(s1, string, condList) ==
+  condList is [['Satisfies, pvar, pred]] =>
+    val := FUNCALL(pred, string)
+    STRINGP val => val
+    ['(String), :wrap s1]
+  condList isnt [['isDomain, pvar, pattern]] =>
+    systemError '"currently invalid domain condition"
+  pattern is '(String) => ['(String), :wrap s1]
+  val := parseAndEval string
+  STRINGP val =>
+    val = '"Syntax Error " => '"Error: Syntax Error "
+    condErrorMsg pattern
+  [type, : data] := val
+  newType := CATCH('SPAD__READER, resolveTM(type, pattern))
+  null newType =>
+    condErrorMsg pattern
+  coerceInt(val, newType)
+
+condErrorMsg type ==
+  typeString := form2String type
+  if PAIRP typeString then typeString := APPLY(function CONCAT, typeString)
+  CONCAT('"Error: Could not make your input into a ", typeString)
+
+parseAndEval string ==
+  $InteractiveMode :fluid := true
+  $BOOT: fluid := NIL
+  $SPAD: fluid := true
+  $e:fluid := $InteractiveFrame
+  $QuietCommand:local := true
+  parseAndEval1 string
+
+parseAndEval1 string ==
+  syntaxError := false
+  pform :=
+    $useNewParser =>
+      v := applyWithOutputToString('ncParseFromString, [string])
+      CAR v => CAR v
+      syntaxError := true
+      CDR v
+    oldParseString string
+  syntaxError =>
+     '"Syntax Error "
+  pform =>
+    val := applyWithOutputToString('processInteractive, [pform, nil])
+    CAR val => CAR val
+    '"Type Analysis Error"
+  nil
+
+oldParseString string ==
+  tree := applyWithOutputToString('string2SpadTree, [string])
+  CAR tree => parseTransform postTransform CAR tree
+  CDR tree
+
+makeSpadCommand(:l) ==
+  opForm := CONCAT(first l, '"(")
+  lastArg := last l
+  l := rest l
+  argList := nil
+  for arg in l while arg ^= lastArg repeat
+    argList := [CONCAT(arg, '", "), :argList]
+  argList := nreverse [lastArg, :argList]
+  CONCAT(opForm, APPLY(function CONCAT, argList), '")")
+
+htMakeInputList stringList ==
+-- makes an input form for constructing a list
+  lastArg := last stringList
+  argList := nil
+  for arg in stringList while arg ^= lastArg repeat
+    argList := [CONCAT(arg, '", "), :argList]
+  argList := nreverse [lastArg, :argList]
+  bracketString APPLY(function CONCAT, argList)
+
+
+-- predefined filter strings
+bracketString string == CONCAT('"[",string,'"]")
+
+quoteString string == CONCAT('"_"", string, '"_"")
+
+$funnyQuote := char 127
+$funnyBacks := char 128
+
+htEscapeString str ==
+  str := SUBSTITUTE($funnyQuote, char '_", str)
+  SUBSTITUTE($funnyBacks, char '_\, str)
+
+unescapeStringsInForm form ==
+  STRINGP form =>
+    str := NSUBSTITUTE(char '_", $funnyQuote, form)
+    NSUBSTITUTE(char '_\, $funnyBacks, str)
+  CONSP form =>
+    unescapeStringsInForm CAR form
+    unescapeStringsInForm CDR form
+    form
+  form
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/htcheck.boot.pamphlet b/src/interp/htcheck.boot.pamphlet
new file mode 100644
index 00000000..d2dd018c
--- /dev/null
+++ b/src/interp/htcheck.boot.pamphlet
@@ -0,0 +1,153 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/htcheck.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+$primitiveHtCommands := '(
+  ("\ContinueButton"     . 1)
+  ("\andexample"         . 1)
+  ("\autobutt" .    0)
+  ("\autobuttons".  0)
+  ("\begin"  .      1)
+  ("\beginscroll".  0)
+  ("\bound"  .      1)
+  ("\fbox"    .      1)
+  ("\centerline" .      1)
+  ("\downlink" .    2)
+  ("\em"     .      0)
+  ("\end"    .      1)
+  ("\endscroll"  .  0)
+  ("\example"            . 1)
+  ("\free"   .      1)
+  ("\graphpaste" .  1)
+  ("\helppage" .    1)
+  ("\htbmdir"            . 0)
+  ("\htbmfile"   .  1)
+  ("\indent" .      1)
+  ("\inputbitmap"        . 1)
+  ("\inputstring" . 3)
+  ("\item"   .      0)
+  ("\keyword"            . 1)
+  ("\link"               . 2)
+  ("\lispdownlink"       . 2)
+  ("\lispmemolink"       . 2)
+  ("\lispwindowlink"     . 2)
+  ("\menudownlink"       . 2)
+  ("\menuitemstyle"      . 1)
+  ("\menulink"           . 2)
+  ("\menulispdownlink"   . 2)
+  ("\menulispmemolink"   . 2)
+  ("\menulispwindowlink" . 2)
+  ("\menumemolink"       . 2)
+  ("\menuwindowlink"     . 2)
+  ("\newline" .     0)
+  ("\radioboxes" .  3)
+  ("\space"  .      1)
+  ("\spadcommand" . 1)
+  ("\stringvalue" . 1)
+  ("\tab"    .      1)
+  ("\table"              . 1)
+  ("\vspace" .      1)
+  ("\windowlink"         . 2))
+
+buildHtMacroTable() ==
+  $htMacroTable := MAKE_-HASHTABLE 'UEQUAL
+  fn := CONCAT(getEnv '"AXIOM", '"/share/hypertex/pages/util.ht")
+  if PROBE_-FILE(fn) then
+    instream := MAKE_-INSTREAM fn
+    while not EOFP instream repeat
+      line := READLINE instream
+      getHtMacroItem line is [string,:numOfArgs] =>
+        HPUT($htMacroTable,string,numOfArgs)
+    for [s,:n] in $primitiveHtCommands repeat HPUT($htMacroTable,s,n)
+  else
+    sayBrightly '"Warning: macro table not found"
+  $htMacroTable
+
+getHtMacroItem line ==
+  null stringPrefix?('"\newcommand{",line) => nil
+  k := charPosition(char '_},line,11)
+  command := SUBSTRING(line,12,k - 12)
+  numOfArgs :=
+    m := #line
+    i := charPosition(char '_[,line,k)
+    i = m => 0
+    j := charPosition(char '_],line,i + 1)
+    digitString := SUBSTRING(line,i + 1,j - i - 1)
+    and/[DIGITP digitString.i for i in 0..MAXINDEX digitString]
+      => PARSE_-INTEGER digitString
+    return nil
+  [command,:numOfArgs]
+
+spadSysChoose(tree,form) ==     --tree is ((word . tree) ..)
+  null form => true
+  null tree => false
+  lookupOn :=
+    form is [key,arg] => key
+    form
+  newTree := LASSOC(lookupOn,tree) => spadSysBranch(newTree,IFCAR IFCDR form)
+  false
+
+spadSysBranch(tree,arg) ==  --tree is (msg kind TREEorSomethingElse ...)
+  null arg => true
+  kind := tree.2
+  kind = 'TREE => spadSysChoose(tree.4,arg)
+  kind = 'LITERALS => member(arg,tree.4)
+  kind = 'INTEGER  => INTEGERP arg
+  kind = 'FUNCTION => atom arg
+  systemError '"unknown tree branch"
+
+buildHtMacroTable()
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/htsetvar.boot.pamphlet b/src/interp/htsetvar.boot.pamphlet
new file mode 100644
index 00000000..0d664ff9
--- /dev/null
+++ b/src/interp/htsetvar.boot.pamphlet
@@ -0,0 +1,500 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp htsetvar.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+htsv() ==
+  startHTPage(50)
+  htSetVars()
+
+htSetVars() ==
+  $path := nil
+  $lastTree := nil
+  if 0 ^= LASTATOM $setOptions then htMarkTree($setOptions,0)
+  htShowSetTree($setOptions)
+
+htShowSetTree(setTree) ==
+  $path := TAKE(- LASTATOM setTree,$path)
+  page := htInitPage(mkSetTitle(),nil)
+  htpSetProperty(page, 'setTree, setTree)
+  links := nil
+  maxWidth1 := maxWidth2 := 0
+  for setData in setTree repeat
+    satisfiesUserLevel setData.setLevel =>
+      okList := [setData,:okList]
+      maxWidth1 := MAX(# PNAME setData.setName,maxWidth1)
+      maxWidth2 := MAX(htShowCount STRINGIMAGE setData.setLabel,maxWidth2)
+  maxWidth1 := MAX(9,maxWidth1)
+  maxWidth2 := MAX(41,maxWidth2)
+  tabset1 := STRINGIMAGE (maxWidth1)
+  tabset2 := STRINGIMAGE (maxWidth2 + maxWidth1 - 1)
+  htSay('"\tab{2}\newline Variable\tab{",STRINGIMAGE (maxWidth1 + (maxWidth2/3)),'"}Description\tab{",STRINGIMAGE(maxWidth2 + maxWidth1 + 2),'"}Value\newline\beginitems ")
+  for setData in REVERSE okList repeat
+      htSay '"\item"
+      label := STRCONC('"\menuitemstyle{",setData.setName,'"}")
+      links := [label,[['text,'"\tab{",tabset1,'"}",setData.setLabel,'"\tab{",tabset2,'"}{\em ",htShowSetTreeValue setData,'"}"]],
+                'htShowSetPage, setData.setName]
+      htMakePage [['bcLispLinks, links,'options,'(indent . 0)]]
+  htSay '"\enditems"
+  htShowPage()
+
+htShowCount s == --# discounting {\em .. }
+  m := #s
+  m < 8 => m - 1
+  i := 0
+  count := 0
+  while i < m - 7 repeat
+    s.i = char '_{ and  s.(i+1) = char '_\ and s.(i+2) = char 'e
+      and s.(i+3) = char 'm => i := i + 6     --discount {\em }
+    i := i + 1
+    count := count + 1
+  count + (m - i)
+
+htShowSetTreeValue(setData) ==
+  st := setData.setType
+  st = 'FUNCTION => object2String FUNCALL(setData.setVar,"%display%")
+  st = 'INTEGER  => object2String eval setData.setVar
+  st = 'STRING  => object2String eval setData.setVar
+  st = 'LITERALS =>
+    object2String translateTrueFalse2YesNo eval setData.setVar
+  st = 'TREE     => '"..."
+  systemError()
+
+mkSetTitle() == STRCONC('"Command {\em )set ",listOfStrings2String $path,'"}")
+
+listOfStrings2String u ==
+  null u => '""
+  STRCONC(listOfStrings2String rest u,'" ",stringize first u)
+
+htShowSetPage(htPage, branch) ==
+  setTree := htpProperty(htPage, 'setTree)
+  $path := [branch,:TAKE(- LASTATOM setTree,$path)]
+  setData := ASSOC(branch, setTree)
+  null setData =>
+    systemError('"No Set Data")
+  st := setData.setType
+  st = 'FUNCTION => htShowFunctionPage(htPage, setData)
+  st = 'INTEGER  =>  htShowIntegerPage(htPage,setData)
+  st = 'LITERALS => htShowLiteralsPage(htPage, setData)
+  st = 'TREE     => htShowSetTree(setData.setLeaf)
+
+  st = 'STRING   =>  -- have to add this
+     htSetNotAvailable(htPage,'")set compiler")
+
+  systemError '"Unknown data type"
+
+htShowLiteralsPage(htPage, setData) ==
+  htSetLiterals(htPage,setData.setName,setData.setLabel,
+                setData.setVar,setData.setLeaf,'htSetLiteral)
+
+htSetLiterals(htPage,name,message,variable,values,functionToCall) ==
+  page := htInitPage('"Set Command", htpPropertyList htPage)
+  htpSetProperty(page, 'variable, variable)
+  bcHt ['"\centerline{Set {\em ", name, '"}}\newline"]
+  bcHt ['"{\em Description: } ", message, '"\newline\vspace{1} "]
+  bcHt '"Select one of the following: \newline\tab{3} "
+  links := [[STRCONC('"",STRINGIMAGE opt), '"\newline\tab{3}", functionToCall, opt] for opt in values]
+  htMakePage [['bcLispLinks, :links]]
+  bcHt ["\indent{0}\newline\vspace{1} The current setting is: {\em ",
+        translateTrueFalse2YesNo EVAL variable, '"} "]
+  htShowPage()
+
+htSetLiteral(htPage, val) ==
+  htInitPage('"Set Command", nil)
+  SET(htpProperty(htPage, 'variable), translateYesNo2TrueFalse val)
+  htKill(htPage,val)
+
+htShowIntegerPage(htPage, setData) ==
+  page := htInitPage(mkSetTitle(), htpPropertyList htPage)
+  htpSetProperty(page, 'variable, setData.setVar)
+  bcHt ['"\centerline{Set {\em ", setData.setName, '"}}\newline"]
+--  message := isKeyedMsgInDb($path,'(setvar text A)) or setData.setLabel
+  message := setData.setLabel
+  bcHt ['"{\em Description: } ", message, '"\newline\vspace{1} "]
+  [$htInitial,$htFinal] := setData.setLeaf
+  if $htFinal = $htInitial + 1
+    then
+      bcHt '"Enter the integer {\em "
+      bcHt stringize $htInitial
+      bcHt '"} or {\em "
+      bcHt stringize $htFinal
+      bcHt '"}:"
+    else if null $htFinal then
+      bcHt '"Enter an integer greater than {\em "
+      bcHt stringize ($htInitial - 1)
+      bcHt '"}:"
+    else
+      bcHt '"Enter an integer between {\em "
+      bcHt stringize $htInitial
+      bcHt '"} and {\em "
+      bcHt stringize $htFinal
+      bcHt '"}:"
+  htMakePage [
+    '(domainConditions (Satisfies S chkRange)),
+      ['bcStrings,[5,eval setData.setVar,'value,'S]]]
+  htSetvarDoneButton('"Select to Set Value",'htSetInteger)
+  htShowPage()
+
+htSetInteger(htPage) ==
+  htInitPage(mkSetTitle(), nil)
+  val := chkRange htpLabelInputString(htPage,'value)
+  not INTEGERP val =>
+    errorPage(htPage,['"Value Error",nil,'"\vspace{3}\centerline{{\em ",val,'"}}\vspace{2}\newline\centerline{Click on \UpBitmap{} to re-enter value}"])
+  SET(htpProperty(htPage, 'variable), val)
+  htKill(htPage,val)
+
+htShowFunctionPage(htPage,setData) ==
+  fn := setData.setDef => FUNCALL(fn,htPage)
+  htpSetProperty(htPage,'setData,setData)
+  htpSetProperty(htPage,'parts, setData.setLeaf)
+  htShowFunctionPageContinued(htPage)
+
+htShowFunctionPageContinued(htPage) ==
+  parts := htpProperty(htPage,'parts)
+  setData := htpProperty(htPage,'setData)
+  [[phrase,kind,variable,checker,initValue,:.],:restParts] := parts
+  htpSetProperty(htPage, 'variable, variable)
+  htpSetProperty(htPage, 'checker, checker)
+  htpSetProperty(htPage, 'parts, restParts)
+  kind = 'LITERALS => htSetLiterals(htPage,setData.setName,
+                                    phrase,variable,checker,'htFunctionSetLiteral)
+  page := htInitPage(mkSetTitle(), htpPropertyList htPage)
+  bcHt ['"\centerline{Set {\em ", setData.setName, '"}}\newline"]
+  bcHt ['"{\em Description: } ", setData.setLabel, '"\newline\vspace{1} "]
+  currentValue := EVAL variable
+  htMakePage
+    [ ['domainConditions, ['Satisfies,'S,checker]],
+      ['text,:phrase],
+        ['inputStrings,
+          [ '"", '"", 60, currentValue, 'value, 'S]]]
+  htSetvarDoneButton('"Select To Set Value",'htSetFunCommand)
+  htShowPage()
+
+htSetvarDoneButton(message, func) ==
+  bcHt '"\newline\vspace{1}\centerline{"
+
+  if message = '"Select to Set Value" or message = '"Select to Set Values"  then
+    bchtMakeButton('"\lisplink",'"\ControlBitmap{ClickToSet}", func)
+  else
+    bchtMakeButton('"\lisplink",CONCAT('"\fbox{", message, '"}"), func)
+
+  bcHt '"} "
+
+
+htFunctionSetLiteral(htPage, val) ==
+  htInitPage('"Set Command", nil)
+  SET(htpProperty(htPage, 'variable), translateYesNo2TrueFalse val)
+  htSetFunCommandContinue(htPage,val)
+
+htSetFunCommand(htPage) ==
+  variable := htpProperty(htPage,'variable)
+  checker := htpProperty(htPage,'checker)
+  value := htCheck(checker,htpLabelInputString(htPage,'value))
+  SET(variable,value) --kill this later
+  htSetFunCommandContinue(htPage,value)
+
+htSetFunCommandContinue(htPage,value) ==
+  parts := htpProperty(htPage,'parts)
+  continue :=
+    null parts => false
+    parts is [['break,predicate],:restParts] => eval predicate
+    true
+  continue =>
+    htpSetProperty(htPage,'parts,restParts)
+    htShowFunctionPageContinued(htPage)
+  htKill(htPage,value)
+
+htKill(htPage,value) ==
+  htInitPage('"System Command", nil)
+  string := STRCONC('"{\em )set ",listOfStrings2String [value,:$path],'"}")
+  htMakePage [
+     '(text
+        "{Here is the AXIOM system command you could have issued:}"
+            "\vspace{2}\newline\centerline{\tt"),
+      ['text,:string]]
+  htMakePage '((text . "}\vspace{1}\newline\rm"))
+  htSay '"\vspace{2}{Select \  \UpButton{} \  to go back.}"
+  htSay '"\newline{Select \  \ExitButton{QuitPage} \  to remove this window.}"
+  htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+  htShowPage()
+
+htSetNotAvailable(htPage,whatToType) ==
+  page := htInitPage('"Unavailable Set Command", htpPropertyList htPage)
+  htInitPage('"Unavailable System Command", nil)
+  string := STRCONC('"{\em ",whatToType,'"}")
+  htMakePage [
+     '(text "\vspace{1}\newline"
+        "{Sorry, but this system command is not available through HyperDoc. Please directly issue this command in an AXIOM window for more information:}"
+            "\vspace{2}\newline\centerline{\tt"),
+      ['text,:string]]
+  htMakePage '((text . "}\vspace{1}\newline"))
+  htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+  htShowPage()
+
+htDoNothing(htPage,command) == nil
+
+htCheck(checker,value) ==
+  PAIRP checker => htCheckList(checker,parseWord value)
+  FUNCALL(checker,value)
+
+parseWord x ==
+  STRINGP x =>
+    and/[DIGITP x.i for i in 0..MAXINDEX x] => PARSE_-INTEGER x
+    INTERN x
+  x
+
+htCheckList(checker,value) ==
+  if value in '(y ye yes Y YE YES) then value := 'yes
+  if value in '(n no N NO) then value := 'no
+  checker is [n,m] and INTEGERP n =>
+    m = n + 1 =>
+      value in checker => value
+      n
+    null m =>
+      INTEGERP value and value >= n => value
+      n
+    INTEGERP m =>
+      INTEGERP value and value >= n and value <= m => value
+      n
+  value in checker => value
+  first checker
+--  emlist := "STRCONC"/[STRCONC('" {\em ",PNAME x,'"} ") for x in checker]
+--  STRCONC('"Please enter one of: ",emlist)
+
+translateYesNoToTrueFalse x ==
+  x = 'yes => true
+  x = 'no => false
+  x
+
+chkNameList x ==
+  u := bcString2ListWords x
+  parsedNames := [ncParseFromString x for x in u]
+  and/[IDENTP x for x in parsedNames] => parsedNames
+  '"Please enter a list of identifiers separated by blanks"
+
+chkPosInteger s ==
+  (u := parseOnly s) and INTEGERP u and u > 0 => u
+  '"Please enter a positive integer"
+
+chkOutputFileName s ==
+  bcString2WordList s in '(CONSOLE console) => 'console
+  chkDirectory s
+
+chkDirectory s == s
+
+chkNonNegativeInteger s ==
+  (u := ncParseFromString s) and INTEGERP u and u >= 0 => u
+  '"Please enter a non-negative integer"
+
+chkRange s ==
+  (u := ncParseFromString s) and INTEGERP u
+    and u >= $htInitial and (NULL $htFinal or u <= $htFinal)
+      => u
+  null $htFinal =>
+    STRCONC('"Please enter an integer greater than ",stringize ($htInitial - 1))
+  STRCONC('"Please enter an integer between ",stringize $htInitial,'" and ",
+            stringize $htFinal)
+
+chkAllNonNegativeInteger s ==
+  (u := ncParseFromString s) and u in '(a al all A AL ALL) and 'ALL
+    or chkNonNegativeInteger s
+       or '"Please enter {\em all} or a non-negative integer"
+
+htMakePathKey path ==
+  null path => systemError '"path is not set"
+  INTERN fn(PNAME first path,rest path) where
+    fn(a,b) ==
+      null b => a
+      fn(STRCONC(a,'".",PNAME first b),rest b)
+
+htMarkTree(tree,n) ==
+  RPLACD(LASTTAIL tree,n)
+  for branch in tree repeat
+    branch.3 = 'TREE => htMarkTree(branch.5,n + 1)
+
+htSetHistory htPage ==
+  msg := "when the history facility is on (yes), results of computations are saved in memory"
+  data := ['history,msg,'history,'LITERALS,'$HiFiAccess,'(on off yes no)]
+  htShowLiteralsPage(htPage,data)
+
+htSetOutputLibrary htPage == 
+  htSetNotAvailable(htPage,'")set compiler output")
+
+htSetInputLibrary htPage == 
+  htSetNotAvailable(htPage,'")set compiler input")
+
+htSetExpose htPage ==
+  htSetNotAvailable(htPage,'")set expose")
+
+htSetKernelProtect htPage ==
+ htSetNotAvailable(htPage,'")set kernel protect")
+
+htSetKernelWarn htPage ==
+ htSetNotAvailable(htPage,'")set kernel warn")
+
+htSetOutputCharacters htPage ==
+  htSetNotAvailable(htPage,'")set output characters")
+
+htSetLinkerArgs htPage ==
+  htSetNotAvailable(htPage,'")set fortran calling linker")
+
+htSetCache(htPage,:options) ==
+  $path := '(functions cache)
+  htPage := htInitPage(mkSetTitle(),nil)
+  $valueList := nil
+  htMakePage '(
+   (text
+    "Use this system command to cause the AXIOM interpreter to `remember' "
+    "past values of interpreter functions. "
+    "To remember a past value of a function, the interpreter "
+    "sets up a {\em cache} for that function based on argument values. "
+    "When a value is cached for a given argument value, its value is gotten "
+    "from the cache and not recomputed. Caching can often save much "
+    "computing time, particularly with recursive functions or functions that "
+    "are expensive to compute and that are called repeatedly "
+    "with the same argument."
+    "\vspace{1}\newline ")
+   (domainConditions (Satisfies S chkNameList))
+   (text
+      "Enter below a list of interpreter functions you would like specially cached. "
+      "Use the name {\em all} to give a default setting for all "
+      "interpreter functions. "
+      "\vspace{1}\newline "
+      "Enter {\em all} or a list of names (separate names by blanks):")
+   (inputStrings ("" "" 60 "all" names S))
+   (doneButton "Push to enter names" htCacheAddChoice))
+  htShowPage()
+
+htCacheAddChoice htPage ==
+  names := bcString2WordList htpLabelInputString(htPage,'names)
+  $valueList := [listOfStrings2String names,:$valueList]
+  null names => htCacheAddQuery()
+  null rest names => htCacheOne names
+  page := htInitPage(mkSetTitle(),nil)
+  htpSetProperty(page,'names,names)
+  htMakePage '(
+    (domainConditions (Satisfies ALLPI chkAllPositiveInteger))
+    (text
+      "For each function, enter below a {\em cache length}, a positive integer. "
+      "This number tells how many past values will "
+      "be cached. "
+      "A cache length of {\em 0} means the function won't be cached. "
+      "To cache all past values, "
+      "enter {\em all}."
+      "\vspace{1}\newline "
+      "For each function name, enter {\em all} or a positive integer:"))
+  for i in 1.. for name in names repeat htMakePage [
+      ['inputStrings,
+        [STRCONC('"Function {\em ",name,'"} will cache"),
+          '"values",5,10,htMakeLabel('"c",i),'ALLPI]]]
+  htSetvarDoneButton('"Select to Set Values",'htCacheSet)
+  htShowPage()
+
+htMakeLabel(prefix,i) == INTERN STRCONC(prefix,stringize i)
+
+htCacheSet htPage ==
+  names := htpProperty(htPage,'names)
+  for i in 1.. for name in names repeat
+    num := chkAllNonNegativeInteger
+             htpLabelInputString(htPage,htMakeLabel('"c",i))
+    $cacheAlist := ADDASSOC(INTERN name,num,$cacheAlist)
+  if (n := LASSOC('all,$cacheAlist)) then
+    $cacheCount := n
+    $cacheAlist := deleteAssoc('all,$cacheAlist)
+  htInitPage('"Cache Summary",nil)
+  bcHt '"In general, interpreter functions "
+  bcHt
+    $cacheCount = 0 => "will {\em not} be cached."
+    bcHt '"cache "
+    htAllOrNum $cacheCount
+    '"} values."
+  bcHt '"\vspace{1}\newline "
+  if $cacheAlist then
+--    bcHt '" However, \indent{3}"
+    for [name,:val] in $cacheAlist | val ^= $cacheCount repeat
+      bcHt '"\newline function {\em "
+      bcHt stringize name
+      bcHt '"} will cache "
+      htAllOrNum val
+      bcHt '"} values"
+  htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+  htShowPage()
+
+htAllOrNum val == bcHt
+  val = 'all => '"{\em all"
+  val = 0 => '"{\em no"
+  STRCONC('"the last {\em ",stringize val)
+
+htCacheOne names ==
+  page := htInitPage(mkSetTitle(),nil)
+  htpSetProperty(page,'names,names)
+  htMakePage '(
+    (domainConditions (Satisfies ALLPI chkAllPositiveInteger))
+    (text
+      "Enter below a {\em cache length}, a positive integer. "
+      "This number tells how many past values will "
+      "be cached. To cache all past values, "
+      "enter {\em all}."
+      "\vspace{1}\newline ")
+    (inputStrings
+      ("Enter {\em all} or a positive integer:"
+       "" 5 10 c1 ALLPI)))
+  htSetvarDoneButton('"Select to Set Value",'htCacheSet)
+  htShowPage()
+
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/hypertex.boot.pamphlet b/src/interp/hypertex.boot.pamphlet
new file mode 100644
index 00000000..430abc4e
--- /dev/null
+++ b/src/interp/hypertex.boot.pamphlet
@@ -0,0 +1,142 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp hypertex.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- HyperTex Spad interface
+
+-- SETANDFILEQ($SendXEventToHyperTeX, 8)
+SETANDFILEQ($LinkToPage, 96)
+SETANDFILEQ($StartPage, 97)
+SETANDFILEQ($SendLine, 98)
+SETANDFILEQ($EndOfPage, 99)
+SETANDFILEQ($PopUpPage, 95)
+SETANDFILEQ($PopUpNamedPage, 94)
+SETANDFILEQ($KillPage, 93)
+SETANDFILEQ($ReplacePage, 92)
+SETANDFILEQ($ReplaceNamedPage, 91)
+SETANDFILEQ($SpadError, 90)
+SETANDFILEQ($PageStuff, 100)
+
+
+
+-- Issue a line of HyperTex
+issueHT line ==
+--  unescapeStringsInForm line
+  sockSendInt($MenuServer, $SendLine)
+  sockSendString($MenuServer, line)
+
+endHTPage() ==
+  sockSendInt($MenuServer, $EndOfPage)
+
+testPage() ==
+  startHTPage(50)
+  issueHT '"\page{TestPage}{Test Page generated from Lisp} "
+  issueHT '"\horizontalline\beginscroll\beginitems "
+  issueHT '"\item \downlink{Quayle Jokes}{ChickenPage} \space{2} "
+  issueHT '"The misadventures of the White House bellboy. "
+  issueHT '"\enditems\endscroll\autobuttons "
+  endHTPage()
+
+-- Replace a current hypertex page
+replaceNamedHTPage(window, name) ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $ReplaceNamedPage)
+  sockSendInt($MenuServer, window)
+  sockSendString($MenuServer, name)
+
+-- Start up a form page from spad
+startHTPopUpPage cols ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $PopUpPage)
+  sockSendInt($MenuServer, cols)
+  sockGetInt($MenuServer)
+
+-- Start a page from spad.  Using the spcified number of columns
+startHTPage cols ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $StartPage)
+  sockSendInt($MenuServer, cols)
+
+-- Start a replace page sequence
+startReplaceHTPage w ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $ReplacePage)
+  sockSendInt($MenuServer, w)
+
+-- Kill a page feom scratchpad
+killHTPage w ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $KillPage)
+  sockSendInt($MenuServer, w)
+
+linkToHTPage name ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $LinkToPage)
+  sockSendString($MenuServer, name)
+
+popUpNamedHTPage(name,cols) ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $PopUpNamedPage)
+  sockSendInt($MenuServer, cols)
+  sockSendString($MenuServer, name)
+  sockGetInt($MenuServer)
+
+sendHTErrorSignal() ==
+  sockSendInt($MenuServer, $SpadError)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-analy.boot.pamphlet b/src/interp/i-analy.boot.pamphlet
new file mode 100644
index 00000000..ff2d62fa
--- /dev/null
+++ b/src/interp/i-analy.boot.pamphlet
@@ -0,0 +1,832 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-analy.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Interpreter Analysis Functions
+
+--% Basic Object Type Identification
+
+getBasicMode x ==  getBasicMode0(x,$useIntegerSubdomain)
+
+getBasicMode0(x,useIntegerSubdomain) ==
+  --  if x is one of the basic types (Integer String Float Boolean) then
+  --  this function returns its type, and nil otherwise
+  x is nil => $EmptyMode
+  STRINGP x => $String
+  INTEGERP x =>
+    useIntegerSubdomain =>
+      x > 0 => $PositiveInteger
+      x = 0 => $NonNegativeInteger
+      $Integer
+    $Integer
+  FLOATP x => $DoubleFloat
+  (x='noBranch) or (x='noValue) => $NoValueMode
+  nil
+
+getBasicObject x ==
+  INTEGERP    x =>
+    t :=
+      not $useIntegerSubdomain => $Integer
+      x > 0 => $PositiveInteger
+      x = 0 => $NonNegativeInteger
+      $Integer
+    objNewWrap(x,t)
+  STRINGP x => objNewWrap(x,$String)
+  FLOATP  x => objNewWrap(x,$DoubleFloat)
+  NIL
+
+getMinimalVariableTower(var,t) ==
+  -- gets the minimal polynomial subtower of t that contains the
+  -- given variable. Returns NIL if none.
+  STRINGP(t) or IDENTP(t) => NIL
+  t = $Symbol => t
+  t is ['Variable,u] =>
+    (u = var) => t
+    NIL
+  t is ['Polynomial,.] => t
+  t is ['RationalFunction,D] => ['Polynomial,D]
+  t is [up,t',u,.] and MEMQ(up,$univariateDomains) =>
+    -- power series have one more arg and different ordering
+    u = var => t
+    getMinimalVariableTower(var,t')
+  t is [up,u,t'] and MEMQ(up,$univariateDomains) =>
+    u = var => t
+    getMinimalVariableTower(var,t')
+  t is [mp,u,t'] and MEMQ(mp,$multivariateDomains) =>
+    var in u => t
+    getMinimalVariableTower(var,t')
+  null (t' := underDomainOf t) => NIL
+  getMinimalVariableTower(var,t')
+
+getMinimalVarMode(id,m) ==
+  --  This function finds the minimum polynomial subtower type of the
+  --  polynomial domain tower m which id to which can be coerced
+  --  It includes all polys above the found level if they are
+  --  contiguous.
+  --  E.g.:    x and G P[y] P[x] I ---> P[y] P[x] I
+  --           x and P[y] G P[x] I ---> P[x] I
+  m is ['Mapping, :.] => m
+  defaultMode :=
+    $Symbol
+  null m => defaultMode
+  (vl := polyVarlist m) and ((id in vl) or 'all in vl) =>
+    SUBSTQ('(Integer),$EmptyMode,m)
+  (um := underDomainOf m) => getMinimalVarMode(id,um)
+  defaultMode
+
+polyVarlist m ==
+  --  If m is a polynomial type this function returns a list of its
+  --  top level variables, and nil otherwise
+  -- ignore any QuotientFields that may separate poly types
+  m is [=$QuotientField,op] => polyVarlist op
+  m is [op,a,:.] =>
+    op in '(UnivariateTaylorSeries UnivariateLaurentSeries
+      UnivariatePuiseuxSeries) =>
+        [., ., a, :.] := m
+        a := removeQuote a
+        [a]
+    op in '(Polynomial RationalFunction Expression) =>
+      '(all)
+    a := removeQuote a
+    op in '(UnivariatePolynomial) =>
+      [a]
+    op in $multivariateDomains =>
+          a
+  nil
+
+--% Pushing Down Target Information
+
+pushDownTargetInfo(op,target,arglist) ==
+  -- put target info on args for certain operations
+  target = $OutputForm => NIL
+  target = $Any        => NIL
+  n := LENGTH arglist
+  pushDownOnArithmeticVariables(op,target,arglist)
+  (pdArgs := pushDownOp?(op,n)) =>
+    for i in pdArgs repeat
+      x := arglist.i
+      if not getTarget(x) then putTarget(x,target)
+  nargs := #arglist
+  1 = nargs =>
+    (op = 'SEGMENT) and (target is ['UniversalSegment,S]) =>
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,S)
+  2 = nargs =>
+    op = "*" =>            -- only push down on 1st arg if not immed
+      if not getTarget CADR arglist then putTarget(CADR arglist,target)
+      getTarget(x := CAR arglist) => NIL
+      if getUnname(x) ^= $immediateDataSymbol then putTarget(x,target)
+    op = "**" or op = "^" =>           -- push down on base
+      if not getTarget CAR arglist then putTarget(CAR arglist,target)
+    (op = 'equation) and (target is ['Equation,S]) =>
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,S)
+    (op = 'gauss) and (target is ['Gaussian,S]) =>
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,S)
+    (op = '_/) =>
+      targ :=
+        target is ['Fraction,S] => S
+        target
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,targ)
+    (op = 'SEGMENT) and (target is ['Segment,S]) =>
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,S)
+    (op = 'SEGMENT) and (target is ['UniversalSegment,S]) =>
+      for x in arglist repeat
+        if not getTarget(x) then putTarget(x,S)
+    NIL
+  NIL
+
+pushDownOnArithmeticVariables(op,target,arglist) ==
+  -- tries to push appropriate target information onto variable
+  -- occurring in arithmetic expressions
+  PAIRP(target) and CAR(target) = 'Variable => NIL
+  not MEMQ(op,'(_+ _- _* _*_* _/)) => NIL
+  not containsPolynomial(target)   => NIL
+  for x in arglist for i in 1.. repeat
+    VECP(x) =>   -- leaf
+      transferPropsToNode(xn := getUnname(x),x)
+      getValue(x) or (xn = $immediateDataSymbol) => NIL
+      t := getMinimalVariableTower(xn,target) or target
+      if not getTarget(x) then putTarget(x,t)
+    PAIRP(x) =>  -- node
+      [op',:arglist'] := x
+      pushDownOnArithmeticVariables(getUnname op',target,arglist')
+  arglist
+
+pushDownOp?(op,n) ==
+  -- determine if for op with n arguments whether for all modemaps
+  -- the target type is equal to one or more arguments. If so, a list
+  -- of the appropriate arguments is returned.
+  ops := [sig for [sig,:.] in getModemapsFromDatabase(op,n)]
+  null ops => NIL
+  op in '(_+ _* _- _exquo) => [i for i in 0..(n-1)]
+  -- each signature has form
+  -- [domain of implementation, target, arg1, arg2, ...]
+  -- sameAsTarg is a vector that counts the number of modemaps that
+  -- have the corresponding argument equal to the target type
+  sameAsTarg := GETZEROVEC n
+  numMms := LENGTH ops
+  for [.,targ,:argl] in ops repeat
+    for arg in argl for i in 0.. repeat
+      targ = arg => SETELT(sameAsTarg,i,1 + sameAsTarg.i)
+  -- now see which args have their count = numMms
+  ok := NIL
+  for i in 0..(n-1) repeat
+    if numMms = sameAsTarg.i then ok := cons(i,ok)
+  reverse ok
+
+--% Bottom Up Processing
+
+-- Also see I-SPEC BOOT for special handlers and I-MAP BOOT for
+-- user function processing.
+
+bottomUp t ==
+  -- bottomUp takes an attributed tree, and returns the modeSet for it.
+  -- As a side-effect it also evaluates the tree.
+  t is [op,:argl] =>
+    tar := getTarget op
+    getUnname(op) ^= $immediateDataSymbol and (v := getValue op) =>
+      om := objMode(v)
+      null tar => [om]
+      (r := resolveTM(om,tar)) => [r]
+      [om]
+    if atom op then
+      opName:= getUnname op
+      if opName in $localVars then
+        putModeSet(op,bottomUpIdentifier(op,opName))
+      else
+        transferPropsToNode(opName,op)
+    else
+      opName := NIL
+      bottomUp op
+
+    opVal := getValue op
+
+    -- call a special handler if we are not being package called
+    dol := getAtree(op,'dollar) and (opName ^= 'construct)
+
+    (null dol) and (fn:= GETL(opName,"up")) and (u:= FUNCALL(fn, t)) => u
+    nargs := #argl
+    if opName then for x in argl for i in 1.. repeat
+      putAtree(x,'callingFunction,opName)
+      putAtree(x,'argumentNumber,i)
+      putAtree(x,'totalArgs,nargs)
+
+    if tar then pushDownTargetInfo(opName,tar,argl)
+
+    -- see if we are calling a declared user map
+    -- if so, push down the declared types as targets on the args
+    if opVal and (objVal opVal  is ['MAP,:.]) and
+      (getMode op is ['Mapping,:ms]) and (nargs + 1= #ms) then
+        for m in rest ms for x in argl repeat putTarget(x,m)
+
+    argModeSetList:= [bottomUp x for x in argl]
+
+    if ^tar and opName = "*" and nargs = 2 then
+        [[t1],[t2]] := argModeSetList
+        tar := computeTypeWithVariablesTarget(t1, t2)
+        tar =>
+            pushDownTargetInfo(opName,tar,argl)
+            argModeSetList:= [bottomUp x for x in argl]
+
+    ms := bottomUpForm(t,op,opName,argl,argModeSetList)
+
+    -- given no target or package calling, force integer constants to
+    -- belong to tightest possible subdomain
+
+    op := CAR t                -- may have changed in bottomUpElt
+    $useIntegerSubdomain and null tar and null dol and
+      isEqualOrSubDomain(first ms,$Integer) =>
+        val := objVal getValue op
+        isWrapped val =>       -- constant if wrapped
+          val := unwrap val
+          bm := getBasicMode val
+          putValue(op,objNewWrap(val,bm))
+          putModeSet(op,[bm])
+        ms
+    ms
+  m := getBasicMode t => [m]
+  IDENTP (id := getUnname t) =>
+    putModeSet(t,bottomUpIdentifier(t,id))
+  keyedSystemError("S2GE0016",['"bottomUp",'"unknown object form"])
+
+computeTypeWithVariablesTarget(p, q) ==
+    polyVarlist(p) or polyVarlist(q) =>
+        t := resolveTT(p, q)
+        polyVarlist(t) => t
+        NIL
+    NIL
+
+bottomUpCompile t ==
+  $genValue:local := false
+  ms := bottomUp t
+  COMP_-TRAN_-1 objVal getValue t
+  ms
+
+bottomUpUseSubdomain t ==
+  $useIntegerSubdomain : local := true
+  ms := bottomUp t
+  ($immediateDataSymbol ^= getUnname(t)) or ($Integer ^= CAR(ms)) => ms
+  null INTEGERP(num := objValUnwrap getValue t) => ms
+  o := getBasicObject(num)
+  putValue(t,o)
+  ms := [objMode o]
+  putModeSet(t,ms)
+  ms
+
+bottomUpPredicate(pred, name) ==
+  putTarget(pred,$Boolean)
+  ms := bottomUp pred
+  $Boolean ^= first ms => throwKeyedMsg('"S2IB0001",[name])
+  ms
+
+bottomUpCompilePredicate(pred, name) ==
+  $genValue:local := false
+  bottomUpPredicate(pred,name)
+
+bottomUpIdentifier(t,id) ==
+  m := isType t => bottomUpType(t, m)
+  EQ(id,'noMapVal) => throwKeyedMsg('"S2IB0002",NIL)
+  EQ(id,'noBranch) =>
+    keyedSystemError("S2GE0016",
+      ['"bottomUpIdentifier",'"trying to evaluate noBranch"])
+  transferPropsToNode(id,t)
+  defaultType := ['Variable,id]
+  -- This was meant to stop building silly symbols but had some unfortunate
+  -- side effects, like not being able to say e:=foo in the interpreter.  MCD
+--  defaultType :=
+--    getModemapsFromDatabase(id,1) =>
+--      userError ['"Cannot use operation name as a variable: ", id]
+--    ['Variable, id]
+  u := getValue t => --non-cached values MAY be re-evaluated
+    tar := getTarget t
+    expr:= objVal u
+    om := objMode(u)
+    (om ^= $EmptyMode) and (om isnt ['RuleCalled,.]) =>
+      $genValue or GENSYMP(id) =>
+        null tar => [om]
+        (r := resolveTM(om,tar)) => [r]
+        [om]
+      bottomUpDefault(t,id,defaultType,getTarget t)
+    interpRewriteRule(t,id,expr) or
+      (isMapExpr expr and [objMode(u)]) or
+        keyedSystemError("S2GE0016",
+          ['"bottomUpIdentifier",'"cannot evaluate identifier"])
+  bottomUpDefault(t,id,defaultType,getTarget t)
+
+bottomUpDefault(t,id,defaultMode,target) ==
+  if $genValue
+    then bottomUpDefaultEval(t,id,defaultMode,target,nil)
+    else bottomUpDefaultCompile(t,id,defaultMode,target,nil)
+
+bottomUpDefaultEval(t,id,defaultMode,target,isSub) ==
+  -- try to get value case.
+
+  -- 1. declared mode but no value case
+  (m := getMode t) =>
+    m is ['Mapping,:.] => throwKeyedMsg('"S2IB0003",[getUnname t])
+
+    -- hmm, try to treat it like target mode or declared mode
+    if isPartialMode(m) then m := resolveTM(['Variable,id],m)
+    -- if there is a target, probably want it to be that way and not
+    -- declared mode. Like "x" in second line:
+    --   x : P[x] I
+    --   y : P[x] I
+    target and not isSub and
+      (val := coerceInteractive(objNewWrap(id,['Variable,id]),target))=>
+        putValue(t,val)
+        [target]
+    -- Ok, see if we can make it into declared mode from symbolic form
+    -- For example, (x : P[x] I; x + 1)
+    not target and not isSub and m and
+      (val := coerceInteractive(objNewWrap(id,['Variable,id]),m)) =>
+        putValue(t,val)
+        [m]
+    -- give up
+    throwKeyedMsg('"S2IB0004",[id,m])
+
+  -- 2. no value and no mode case
+  val := objNewWrap(id,defaultMode)
+  (null target) or (defaultMode = target) =>
+    putValue(t,val)
+    [defaultMode]
+  if isPartialMode target then
+    -- this hackery will go away when Symbol is not the default type
+    if defaultMode = $Symbol and (target is [D,x,.]) then
+      (D in $univariateDomains and (x = id)) or
+        (D in $multivariateDomains and (id in x)) =>
+           dmode := [D,x,$Integer]
+           (val' := coerceInteractive(objNewWrap(id,
+             ['Variable,id]),dmode)) =>
+               defaultMode := dmode
+               val := val'
+      NIL
+    target := resolveTM(defaultMode,target)
+  -- The following is experimental.  SCM 10/11/90
+  if target and (tm := getMinimalVarMode(id, target)) then
+    target := tm
+  (null target) or null (val' := coerceInteractive(val,target)) =>
+    putValue(t,val)
+    [defaultMode]
+  putValue(t,val')
+  [target]
+
+bottomUpDefaultCompile(t,id,defaultMode,target,isSub) ==
+  tmode := getMode t
+  tval  := getValue t
+  expr:=
+    id in $localVars => id
+    tmode or tval =>
+      envMode := tmode or objMode tval
+      envMode is ['Variable, :.] => objVal tval
+      id = $immediateDataSymbol => objVal tval
+      ['getValueFromEnvironment,MKQ id,MKQ envMode]
+    wrap id
+  tmode and tval and (mdv := objMode tval) =>
+    if isPartialMode tmode then
+      null (tmode := resolveTM(mdv,tmode)) =>
+        keyedMsgCompFailure("S2IB0010",NIL)
+    putValue(t,objNew(expr,tmode))
+    [tmode]
+  tmode or (tval and (tmode := objMode tval)) =>
+    putValue(t,objNew(expr,tmode))
+    [tmode]
+  obj := objNew(expr,defaultMode)
+  canCoerceFrom(defaultMode, target) and
+    (obj' := coerceInteractive(obj, target)) =>
+        putValue(t, obj')
+        [target]
+  putValue(t,obj)
+  [defaultMode]
+
+interpRewriteRule(t,id,expr) ==
+  null get(id,'isInterpreterRule,$e) => NIL
+  (ms:= selectLocalMms(t,id,nil,nil)) and (ms:=evalForm(t,id,nil,ms)) =>
+    ms
+  nil
+
+bottomUpForm(t,op,opName,argl,argModeSetList) ==
+  not($inRetract) =>
+    bottomUpForm3(t,op,opName,argl,argModeSetList)
+  bottomUpForm2(t,op,opName,argl,argModeSetList)
+
+bottomUpForm3(t,op,opName,argl,argModeSetList) ==
+  $origArgModeSetList:local  := COPY argModeSetList
+  bottomUpForm2(t,op,opName,argl,argModeSetList)
+
+bottomUpForm2(t,op,opName,argl,argModeSetList) ==
+  not atom t and EQ(opName,"%%") => bottomUpPercent t
+  opVal := getValue op
+
+  -- for things with objects in operator position, be careful before
+  -- we enter general modemap selection
+
+  lookForIt :=
+    getAtree(op,'dollar) => true
+    not opVal => true
+    opMode := objMode opVal
+    not (opModeTop := IFCAR opMode) => true
+    opModeTop in '(Record Union) => false
+    opModeTop in '(Variable Mapping FunctionCalled RuleCalled AnonymousFunction) => true
+    false
+
+  -- get rid of Union($, "failed") except when op is "=" and all
+  -- modesets are the same
+
+  $genValue and
+    ^(opName = "=" and argModeSetList is [[m],[=m]] and m is ['Union,:.]) and
+      (u := bottomUpFormUntaggedUnionRetract(t,op,opName,argl,argModeSetList)) => u
+
+  lookForIt and (u := bottomUpFormTuple(t, op, opName, argl, argModeSetList)) => u
+
+  -- opName can change in the call to selectMms
+
+  (lookForIt and (mmS := selectMms(op,argl,getTarget op))) and
+    (mS := evalForm(op,opName := getUnname op,argl,mmS)) =>
+      putModeSet(op,mS)
+  bottomUpForm0(t,op,opName,argl,argModeSetList)
+
+bottomUpFormTuple(t, op, opName, args, argModeSetList) ==
+  getAtree(op,'dollar) => NIL
+  null (singles := getModemapsFromDatabase(opName, 1)) => NIL
+
+  -- see if any of the modemaps have Tuple arguments
+  haveTuple := false
+  for mm in singles while not haveTuple repeat
+    if getFirstArgTypeFromMm(mm) is ["Tuple",.] then haveTuple := true
+  not haveTuple => nil
+  nargs := #args
+  nargs = 1 and getUnname first args = "Tuple" => NIL
+  nargs = 1 and (ms := bottomUp first args) and
+    (ms is [["Tuple",.]] or ms is [["List",.]]) => NIL
+
+  -- now make the args into a tuple
+
+  newArg := [mkAtreeNode "Tuple",:args]
+  bottomUp [op, newArg]
+
+removeUnionsAtStart(argl,modeSets) ==
+  null $genValue => modeSets
+  for arg in argl for ms in modeSets repeat
+    null (v := getValue arg) => nil
+    m := objMode(v)
+    m isnt ['Union,:.] => nil
+    val := objVal(v)
+    null isWrapped val => nil
+    val' := retract v
+    m' := objMode val'
+    putValue(arg,val')
+    putModeSet(arg,[m'])
+    RPLACA(ms,m')
+  modeSets
+
+printableArgModeSetList() ==
+  amsl := nil
+  for a in reverse $origArgModeSetList repeat
+    b := prefix2String first a
+    if ATOM b then b := [b]
+    amsl := ['%l,:b,:amsl]
+  if amsl then amsl := rest amsl
+  amsl
+
+bottomUpForm0(t,op,opName,argl,argModeSetList) ==
+  op0 := op
+  opName0 := opName
+
+  m := isType t =>
+    bottomUpType(t, m)
+
+  opName = 'copy and argModeSetList is [[['Record,:rargs]]] =>
+    -- this is a hack until Records go through the normal
+    -- modemap selection process
+    rtype := ['Record,:rargs]
+    code := optRECORDCOPY(['RECORDCOPY,getArgValue(CAR argl, rtype),#rargs])
+
+    if $genValue then code := wrap timedEVALFUN code
+    val := objNew(code,rtype)
+    putValue(t,val)
+    putModeSet(t,[rtype])
+
+  m := getModeOrFirstModeSetIfThere op
+  m is ['Record,:.] and argModeSetList is [[['Variable,x]]] and
+      member(x,getUnionOrRecordTags m) and (u := bottomUpElt t) => u
+  m is ['Union,:.] and argModeSetList is [[['Variable,x]]] =>
+      member(x,getUnionOrRecordTags m) and (u := bottomUpElt t) => u
+      not $genValue =>
+        amsl := printableArgModeSetList()
+        throwKeyedMsgSP("S2IB0008",['"the union object",amsl], op)
+      object := retract getValue op
+      object = 'failed =>
+        throwKeyedMsgSP("S2IB0008",['"the union object",amsl], op)
+      putModeSet(op,[objMode(object)])
+      putValue(op,object)
+      (u := bottomUpElt t) => u
+      bottomUpForm0(t,op,opName,argl,argModeSetList)
+
+  (opName ^= "elt") and (opName ^= "apply") and
+    #argl = 1 and first first argModeSetList is ['Variable, var]
+      and var in '(first last rest) and
+        isEltable(op, argl, #argl) and (u := bottomUpElt t) => u
+
+  $genValue and
+    ( u:= bottomUpFormRetract(t,op,opName,argl,argModeSetList) ) => u
+
+  (opName ^= "elt") and (opName ^= "apply") and
+    isEltable(op, argl, #argl) and (u := bottomUpElt t) => u
+
+  if FIXP $HTCompanionWindowID then
+    mkCompanionPage('operationError, t)
+
+  amsl := printableArgModeSetList()
+  opName1 :=
+    opName0 = $immediateDataSymbol =>
+        (o := coerceInteractive(getValue op0,$OutputForm)) =>
+            outputTran objValUnwrap o
+        NIL
+    opName0
+
+  if null(opName1) then
+    opName1 :=
+        (o := getValue op0) => prefix2String objMode o
+        '"<unknown type>"
+    msgKey :=
+        null amsl => "S2IB0013"
+        "S2IB0012"
+  else
+    msgKey :=
+        null amsl => "S2IB0011"
+        (n := isSharpVarWithNum opName1) =>
+            opName1 := n
+            "S2IB0008g"
+        "S2IB0008"
+
+  sayIntelligentMessageAboutOpAvailability(opName1, #argl)
+
+  not $genValue =>
+    keyedMsgCompFailureSP(msgKey,[opName1, amsl], op0)
+  throwKeyedMsgSP(msgKey,[opName1, amsl], op0)
+
+sayIntelligentMessageAboutOpAvailability(opName, nArgs) ==
+  -- see if we can give some decent messages about the availability if
+  -- library messages
+
+  NUMBERP opName => NIL
+
+  oo :=  object2Identifier opOf opName
+  if ( oo = "%" ) or ( oo = "Domain" ) or ( domainForm? opName ) then
+    opName := "elt"
+
+  nAllExposedMmsWithName := #getModemapsFromDatabase(opName, NIL)
+  nAllMmsWithName        := #getAllModemapsFromDatabase(opName, NIL)
+
+  -- first see if there are ANY ops with this name
+
+  if nAllMmsWithName = 0 then
+    sayKeyedMsg("S2IB0008a", [opName])
+  else if nAllExposedMmsWithName = 0 then
+    nAllMmsWithName = 1 => sayKeyedMsg("S2IB0008b", [opName])
+    sayKeyedMsg("S2IB0008c", [opName, nAllMmsWithName])
+  else
+    -- now talk about specific arguments
+    nAllExposedMmsWithNameAndArgs   := #getModemapsFromDatabase(opName, nArgs)
+    nAllMmsWithNameAndArgs          := #getAllModemapsFromDatabase(opName, nArgs)
+    nAllMmsWithNameAndArgs = 0 =>
+        sayKeyedMsg("S2IB0008d", [opName, nArgs, nAllExposedMmsWithName, nAllMmsWithName - nAllExposedMmsWithName])
+    nAllExposedMmsWithNameAndArgs = 0 =>
+        sayKeyedMsg("S2IB0008e", [opName, nArgs, nAllMmsWithNameAndArgs - nAllExposedMmsWithNameAndArgs])
+    sayKeyedMsg("S2IB0008f", [opName, nArgs, nAllExposedMmsWithNameAndArgs, nAllMmsWithNameAndArgs - nAllExposedMmsWithNameAndArgs])
+  nil
+
+bottomUpType(t, type) ==
+  mode :=
+    if isPartialMode type then '(Mode)
+    else if categoryForm?(type) then '(SubDomain (Domain))
+         else '(Domain)
+  val:= objNew(type,mode)
+  putValue(t,val)
+  -- have to fix the following
+  putModeSet(t,[mode])
+
+bottomUpPercent(tree is [op,:argl]) ==
+  -- handles a call %%(5), which means the output of step 5
+  -- %%() is the same as %%(-1)
+  null argl =>
+    val:= fetchOutput(-1)
+    putValue(op,val)
+    putModeSet(op,[objMode(val)])
+  argl is [t] =>
+    i:= getArgValue(t,$Integer) =>
+      val:= fetchOutput i
+      putValue(op,val)
+      putModeSet(op,[objMode(val)])
+    throwKeyedMsgSP('"S2IB0006",NIL,t)
+  throwKeyedMsgSP('"S2IB0006",NIL,op)
+
+bottomUpFormRetract(t,op,opName,argl,amsl) ==
+  -- tries to find one argument, which can be pulled back, and calls
+  -- bottomUpForm again. We do not retract the first argument to a
+  -- setelt, because this is presumably a destructive operation and
+  -- the retract can create a new object.
+
+  -- if no such operation exists in the database, don't bother
+  $inRetract: local := true
+  null getAllModemapsFromDatabase(getUnname op,#argl) => NIL
+
+  u := bottomUpFormAnyUnionRetract(t,op,opName,argl,amsl) => u
+
+  a  := NIL
+  b  := NIL
+  ms := NIL
+  for x in argl for m in amsl for i in 1.. repeat
+    -- do not retract first arg of a setelt
+    (i = 1) and (opName = "setelt") =>
+        a := [x,:a]
+        ms := [m,:ms]
+    (i = 1) and (opName = "set!") =>
+        a := [x,:a]
+        ms := [m,:ms]
+    if PAIRP(m) and CAR(m) = $EmptyMode then return NIL
+    object:= retract getValue x
+    a:= [x,:a]
+    EQ(object,'failed) =>
+        putAtree(x,'retracted,nil)
+        ms := [m, :ms]
+    b:= true
+    RPLACA(m,objMode(object))
+    ms := [COPY_-TREE m, :ms]
+    putAtree(x,'retracted,true)
+    putValue(x,object)
+    putModeSet(x,[objMode(object)])
+  --insert pulled-back items
+  a := nreverse a
+  ms := nreverse ms
+
+  -- check that we haven't seen these types before
+  typesHad := getAtree(t, 'typesHad)
+  if member(ms, typesHad) then b := nil
+  else putAtree(t, 'typesHad, cons(ms, typesHad))
+
+  b and bottomUpForm(t,op,opName,a,amsl)
+
+retractAtree atr ==
+    object:= retract getValue atr
+    EQ(object,'failed) =>
+        putAtree(atr,'retracted,nil)
+        nil
+    putAtree(atr,'retracted,true)
+    putValue(atr,object)
+    putModeSet(atr,[objMode(object)])
+    true
+
+bottomUpFormAnyUnionRetract(t,op,opName,argl,amsl) ==
+  -- see if we have a Union
+
+  ok := NIL
+  for m in amsl while not ok repeat
+    if atom first(m) then return NIL
+    first m = $Any => ok := true
+    (first first m = 'Union) => ok := true
+  not ok => NIL
+
+  a:= NIL
+  b:= NIL
+
+  for x in argl for m in amsl for i in 0.. repeat
+    m0 := first m
+    if ( (m0 = $Any) or (first m0 = 'Union) ) and
+      ('failed^=(object:=retract getValue x)) then
+        b := true
+        RPLACA(m,objMode(object))
+        putModeSet(x,[objMode(object)])
+        putValue(x,object)
+    a := cons(x,a)
+  b and bottomUpForm(t,op,opName,nreverse a,amsl)
+
+bottomUpFormUntaggedUnionRetract(t,op,opName,argl,amsl) ==
+  -- see if we have a Union with no tags, if so retract all such guys
+
+  ok := NIL
+  for [m] in amsl while not ok repeat
+    if atom m then return NIL
+    if m is ['Union, :.] and null getUnionOrRecordTags m then ok := true
+  not ok => NIL
+
+  a:= NIL
+  b:= NIL
+
+  for x in argl for m in amsl for i in 0.. repeat
+    m0 := first m
+    if (m0 is ['Union, :.] and null getUnionOrRecordTags m0) and
+      ('failed ^= (object:=retract getValue x)) then
+        b := true
+        RPLACA(m,objMode(object))
+        putModeSet(x,[objMode(object)])
+        putValue(x,object)
+    a := cons(x,a)
+  b and bottomUpForm(t,op,opName,nreverse a,amsl)
+
+bottomUpElt (form:=[op,:argl]) ==
+  -- this transfers expressions that look like function calls into
+  -- forms with elt or apply.
+
+    ms := bottomUp op
+    ms and (ms is [['Union,:.]] or ms is [['Record,:.]]) =>
+        RPLAC(CDR form, [op,:argl])
+        RPLAC(CAR form, mkAtreeNode "elt")
+        bottomUp form
+
+    target  := getTarget form
+
+    newOps := [mkAtreeNode "elt", mkAtreeNode "apply"]
+    u := nil
+
+    while ^u for newOp in newOps repeat
+        newArgs := [op,:argl]
+        if selectMms(newOp, newArgs, target) then
+            RPLAC(CDR form, newArgs)
+            RPLAC(CAR form, newOp)
+            u := bottomUp form
+
+    while ^u and ( "and"/[retractAtree(a) for a in newArgs] ) repeat
+        while ^u for newOp in newOps repeat
+            newArgs := [op,:argl]
+            if selectMms(newOp, newArgs, target) then
+                RPLAC(CDR form, newArgs)
+                RPLAC(CAR form, newOp)
+                u := bottomUp form
+    u
+
+isEltable(op,argl,numArgs) ==
+  -- determines if the object might possible have an elt function
+  -- we exclude Mapping and Variable types explicitly
+  v := getValue op =>
+    ZEROP numArgs => true
+    not(m := objMode(v)) => nil
+    m is ['Mapping, :.] => nil
+    objVal(v) is ['MAP, :mapDef] and numMapArgs(mapDef) > 0 => nil
+    true
+  m := getMode op =>
+    ZEROP numArgs => true
+    m is ['Mapping, :.] => nil
+    true
+  numArgs ^= 1 => nil
+  name := getUnname op
+  name = 'SEQ => nil
+--not (name in '(a e h s)) and getAllModemapsFromDatabase(name, nil) => nil
+  arg := first argl
+  (getUnname arg) ^= 'construct => nil
+  true
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-code.boot.pamphlet b/src/interp/i-code.boot.pamphlet
new file mode 100644
index 00000000..c58ff15e
--- /dev/null
+++ b/src/interp/i-code.boot.pamphlet
@@ -0,0 +1,164 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-code.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Interpreter Code Generation Routines
+
+--Modified by JHD 9/9/93 to fix a problem with coerces inside
+--interpreter functions being used as mappings. They were being
+--handled with $useCoerceOrCroak being NIL, and therefore internal
+--coercions were not correctly handled. Fix: remove dependence
+--on $useCoerceOrCroak, and test explicitly for Mapping types.
+
+--% COERCE
+
+intCodeGenCOERCE(triple,t2) ==
+  -- NOTE: returns a triple
+  t1 := objMode triple
+  t1 = $EmptyMode => NIL
+  t1 = t2 => triple
+  val := objVal triple
+
+  -- if request is for a coerce to t2 from a coerce from
+  -- to to t1, and t1 = Void or canCoerce(t0,t2), then optimize
+
+  (val is ['coerceOrCroak,trip,t1', .]) and
+    (t0 := objCodeMode trip) and ([.,val0] := objCodeVal trip) and
+      ( (t1 = $Void) or canCoerceFrom(removeQuote t0,t2) ) =>
+         -- just generate code for coercion, don't coerce constants
+         -- might be too big
+         intCodeGenCOERCE(objNew(val0, removeQuote t0), t2)
+
+  val is ['THROW,label,code] =>
+    if label is ['QUOTE, l] then label := l
+    null($compilingMap) or (label ^= mapCatchName($mapName)) =>
+      objNew(['THROW,label,wrapped2Quote objVal
+        intCodeGenCOERCE(objNew(code,t1),t2)],t2)
+    -- we have a return statement. just send it back as is
+    objNew(val,t2)
+
+  val is ['PROGN,:code,lastCode] =>
+    objNew(['PROGN,:code,wrapped2Quote objVal
+      intCodeGenCOERCE(objNew(lastCode,t1),t2)],t2)
+
+  val is ['COND,:conds] =>
+    objNew(['COND,
+      :[[p,wrapped2Quote objVal intCodeGenCOERCE(objNew(v,t1),t2)]
+        for [p,v] in conds]],t2)
+
+  -- specially handle subdomain
+  absolutelyCanCoerceByCheating(t1,t2) => objNew(val,t2)
+
+  -- specially handle coerce to Any
+  t2 = '(Any) => objNew(['CONS,MKQ t1,val],t2)
+
+  -- optimize coerces from Any
+  (t1 = '(Any)) and (val is [ ='CONS,t1',val']) =>
+    intCodeGenCOERCE(objNew(val',removeQuote t1'),t2)
+
+  -- specially handle coerce from Equation to Boolean
+  (t1 is ['Equation,:.]) and (t2 = $Boolean) =>
+    coerceByFunction(triple,t2)
+
+  -- next is hack for if-then-elses
+  (t1 = '$NoValueMode) and (val is ['COND,pred]) =>
+    code :=
+      ['COND,pred,
+        [MKQ true,['throwKeyedMsg,MKQ "S2IM0016",MKQ $mapName]]]
+    objNew(code,t2)
+
+  -- optimize coerces to Expression
+  t2 = $OutputForm =>
+    coerceByFunction(triple,t2)
+
+  isSubDomain(t1, $Integer) =>
+    intCodeGenCOERCE(objNew(val, $Integer), t2)
+
+  -- generate code
+  -- 1. See if the coercion will go through (absolutely)
+  --    Must be careful about variables or else things like
+  --    P I --> P[x] P I might not have the x in the original polynomial
+  --    put in the correct place
+
+  (not containsVariables(t2)) and canCoerceByFunction(t1,t2) =>
+    -- try coerceByFunction
+    (not canCoerceByMap(t1,t2)) and
+      (code := coerceByFunction(triple,t2)) => code
+    intCodeGenCoerce1(val,t1,t2)
+
+  -- 2. Set up a failure point otherwise
+
+  intCodeGenCoerce1(val,t1,t2)
+
+intCodeGenCoerce1(val,t1,t2) ==
+  -- Internal function to previous one
+  -- designed to ensure that we don't use coerceOrCroak on mappings
+--(t2 is ['Mapping,:.]) => THROW('coerceOrCroaker, 'croaked)
+  objNew(['coerceOrCroak,mkObjCode(['wrap,val],t1),
+        MKQ t2, MKQ $mapName],t2)
+
+--% Map components
+
+wrapMapBodyWithCatch body ==
+  -- places a CATCH around the map body
+  -- note that we will someday have to fix up the catch identifier
+  -- to use the generated internal map name
+  $mapThrowCount = 0 => body
+  if body is ['failCheck,['coerceOrFail,trip,targ,mapn]]
+    then
+      trip is ['LIST,v,m,e] =>
+        ['failCheck,['coerceOrFail,
+          ['LIST,['CATCH,MKQ mapCatchName $mapName, v],m,e],targ,mapn]]
+      keyedSystemError("S2GE0016",['"wrapMapBodyWithCatch",
+        '"bad CATCH for in function form"])
+    else ['CATCH,MKQ mapCatchName $mapName,body]
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-coerce.boot.pamphlet b/src/interp/i-coerce.boot.pamphlet
new file mode 100644
index 00000000..e69d13b2
--- /dev/null
+++ b/src/interp/i-coerce.boot.pamphlet
@@ -0,0 +1,1454 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-coerce.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{Coercion conventions}
+
+\begin{verbatim}
+Coercion conventions
+
+Coercion involves the  changing of the datatype of an  object.  This
+   can be  done for conformality of  operations or, for  example, to
+   change the structure of an object  into one that is understood by
+   the printing routines.
+
+The actual coercion  is controlled  by the  function "coerce"  which
+   takes  and delivers  wrapped operands.   Also  see the  functions
+   interpCoerce and coerceInteractive.
+
+Sometimes one  does not  want to  actually change  the datatype  but
+   rather wants to determine  whether it is possible to do  so.  The
+   controlling function  to do this  is "canCoerceFrom".   The value
+   passed   to  specific   coercion  routines   in   this  case   is
+   "$fromCoerceable$".   The value returned is  true or false.   See
+   specific examples for more info.
+
+The special routines that  do the coercions typically  involve a "2"
+   in their  names.   For example, G2E  converts type  "Gaussian" to
+   type  "Expression".   These  special  routines take  and  deliver
+   unwrapped operands.   The determination of which  special routine
+   to  use  is  often  made  by  consulting  the  list  $CoerceTable
+   (currently in COT BOOT) and  this is controlled by coerceByTable.
+   Note that the special routines are in the file COERCEFN BOOT.
+\end{verbatim}
+\section{Function getConstantFromDomain}
+[[getConstantFromDomain]] is used to look up the constants $0$ and $1$
+from the given [[domainForm]].
+\begin{enumerate}
+\item if [[isPartialMode]] (see i-funsel.boot) returns true then the
+domain modemap contains the constant [[$EmptyMode]] which indicates
+that the domain is not fully formed. In this case we return [[NIL]].
+\end{enumerate}
+<<getConstantFromDomain>>=
+getConstantFromDomain(form,domainForm) ==
+    isPartialMode domainForm => NIL
+    opAlist := getOperationAlistFromLisplib first domainForm
+    key := opOf form
+    entryList := LASSOC(key,opAlist)
+    entryList isnt [[sig, ., ., .]] =>
+        key = "One" => getConstantFromDomain(["1"], domainForm)
+        key = "Zero" => getConstantFromDomain(["0"], domainForm)
+        throwKeyedMsg("S2IC0008",[form,domainForm])
+    -- i.e., there should be exactly one item under this key of that form
+    domain := evalDomain domainForm
+    SPADCALL compiledLookupCheck(key,sig,domain)
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+--%  Algebraic coercions using interactive code
+
+algCoerceInteractive(p,source,target) ==
+  -- now called in some groebner code
+  $useConvertForCoercions : local := true
+  source := devaluate source
+  target := devaluate target
+  u := coerceInteractive(objNewWrap(p,source),target)
+  u => objValUnwrap(u)
+  error ['"can't convert",p,'"of mode",source,'"to mode",target]
+
+spad2BootCoerce(x,source,target) ==
+  -- x : source and we wish to coerce to target
+  -- used in spad code for Any
+  null isValidType source => throwKeyedMsg("S2IE0004",[source])
+  null isValidType target => throwKeyedMsg("S2IE0004",[target])
+  x' := coerceInteractive(objNewWrap(x,source),target) =>
+    objValUnwrap(x')
+  throwKeyedMsgCannotCoerceWithValue(wrap x,source,target)
+
+--%  Functions for Coercion or Else We'll Get Rough
+
+coerceOrFail(triple,t,mapName) ==
+  -- some code generated for this is in coerceInt0
+  t = $NoValueMode => triple
+  t' := coerceInteractive(triple,t)
+  t' => objValUnwrap(t')
+  sayKeyedMsg("S2IC0004",[mapName,objMode triple,t])
+  '"failed"
+
+coerceOrCroak(triple, t, mapName) ==
+  -- this does the coercion and returns the value or dies
+  t = $NoValueMode => triple
+  t' := coerceOrConvertOrRetract(triple,t)
+  t' => objValUnwrap(t')
+  mapName = 'noMapName =>
+    throwKeyedMsgCannotCoerceWithValue(objVal triple,objMode triple, t)
+  sayKeyedMsg("S2IC0005",[mapName])
+  throwKeyedMsgCannotCoerceWithValue(objVal triple,objMode triple, t)
+
+coerceOrThrowFailure(value, t1, t2) ==
+  (result := coerceOrRetract(objNewWrap(value, t1), t2)) or
+    coercionFailure()
+  objValUnwrap(result)
+
+--%  Retraction functions
+
+retract object ==
+  type := objMode object
+  STRINGP type => 'failed
+  type = $EmptyMode => 'failed
+  val := objVal object
+  not isWrapped val and val isnt ['MAP,:.] => 'failed
+  type' := equiType(type)
+  (ans := retract1 objNew(val,equiType(type))) = 'failed => ans
+  objNew(objVal ans,eqType objMode ans)
+
+retract1 object ==
+  -- this function is the new version of the old "pullback"
+  -- it first tries to change the datatype of an object to that of
+  -- largest contained type. Examples: P RN -> RN, RN -> I
+  -- This is mostly for cases such as constant polynomials or
+  -- quotients with 1 in the denominator.
+  type := objMode object
+  STRINGP type => 'failed
+  val := objVal object
+  type = $PositiveInteger =>    objNew(val,$NonNegativeInteger)
+  type = $NonNegativeInteger => objNew(val,$Integer)
+  type = $Integer and SINTP unwrap val => objNew(val, $SingleInteger)
+  type' := equiType(type)
+  if not EQ(type,type') then object := objNew(val,type')
+  (1 = #type') or (type' is ['Union,:.]) or
+    (type' is ['FunctionCalled,.])
+     or (type' is ['OrderedVariableList,.]) or (type is ['Variable,.]) =>
+      (object' := retract2Specialization(object)) => object'
+      'failed
+  null (underDomain := underDomainOf type') => 'failed
+  -- try to retract the "coefficients"
+  -- think of P RN -> P I or M RN -> M I
+  object' := retractUnderDomain(object,type,underDomain)
+  object' ^= 'failed => object'
+  -- see if we can use the retract functions
+  (object' := coerceRetract(object,underDomain)) => object'
+  -- see if we have a special case here
+  (object' := retract2Specialization(object)) => object'
+  'failed
+
+retractUnderDomain(object,type,underDomain) ==
+  null (ud := underDomainOf underDomain) => 'failed
+  [c,:args] := deconstructT type
+  1 ^= #args => 'failed
+  1 ^= #c => 'failed
+  type'' := constructT(c,[ud])
+  (object' := coerceInt(object,type'')) => object'
+  'failed
+
+retract2Specialization object ==
+  -- handles some specialization retraction cases, like matrices
+  val := objVal object
+  val' := unwrap val
+  type := objMode object
+
+  type = $Any =>
+    [dom,:obj] := val'
+    objNewWrap(obj,dom)
+  type is ['Union,:unionDoms] => coerceUnion2Branch object
+  type = $Symbol =>
+    objNewWrap(1,['OrderedVariableList,[val']])
+  type is ['OrderedVariableList,var] =>
+    coerceInt(objNewWrap(var.(val'-1),$Symbol), '(Polynomial (Integer)))
+-- !! following retract seems wrong and breaks ug13.input
+--  type is ['Variable,var] =>
+--    coerceInt(object,$Symbol)
+  type is ['Polynomial,D] =>
+    val' is [ =1,x,:.] =>
+      vl := REMDUP reverse varsInPoly val'
+      1 = #vl => coerceInt(object,['UnivariatePolynomial,x,D])
+      NIL
+    val' is [ =0,:.] => coerceInt(object, D)
+    NIL
+  type is ['Matrix,D] =>
+    n := # val'
+    m := # val'.0
+    n = m => objNew(val,['SquareMatrix,n,D])
+    objNew(val,['RectangularMatrix,n,m,D])
+  type is ['RectangularMatrix,n,m,D] =>
+    n = m => objNew(val,['SquareMatrix,n,D])
+    NIL
+  (type is [agg,D]) and (agg in '(Vector Segment UniversalSegment)) =>
+    D = $PositiveInteger => objNew(val,[agg,$NonNegativeInteger])
+    D = $NonNegativeInteger => objNew(val,[agg,$Integer])
+    NIL
+  type is ['Array,bds,D] =>
+    D = $PositiveInteger => objNew(val,['Array,bds,$NonNegativeInteger])
+    D = $NonNegativeInteger => objNew(val,['Array,bds,$Integer])
+    NIL
+  type is ['List,D] =>
+    D isnt ['List,D'] =>
+      -- try to retract elements
+      D = $PositiveInteger => objNew(val,['List,$NonNegativeInteger])
+      D = $NonNegativeInteger => objNew(val,['List,$Integer])
+      null val' => nil
+--        null (um := underDomainOf D) => nil
+--        objNewWrap(nil,['List,um])
+      vl := nil
+      tl := nil
+      bad := nil
+      for e in val' while not bad repeat
+        (e' := retract objNewWrap(e,D)) = 'failed => bad := true
+        vl := [objValUnwrap e',:vl]
+        tl := [objMode e',:tl]
+      bad => NIL
+      (m := resolveTypeListAny tl) = D => NIL
+      D = equiType(m) => NIL
+      vl' := nil
+      for e in vl for t in tl repeat
+        t = m => vl' := [e,:vl']
+        e' := coerceInt(objNewWrap(e,t),m)
+        null e' => return NIL
+        vl' := [objValUnwrap e',:vl']
+      objNewWrap(vl',['List,m])
+    D' = $PositiveInteger =>
+      objNew(val,['List,['List,$NonNegativeInteger]])
+    D' = $NonNegativeInteger =>
+      objNew(val,['List,['List,$Integer]])
+    D' is ['Variable,.] or D' is ['OrderedVariableList,.] =>
+        coerceInt(object,['List,['List,$Symbol]])
+
+    n := # val'
+    m := # val'.0
+    null isRectangularList(val',n,m) => NIL
+    coerceInt(object,['Matrix,D'])
+  type is ['Expression,D] =>
+    [num,:den] := val'
+    -- coerceRetract already handles case where den = 1
+    num isnt [0,:num] => NIL
+    den isnt [0,:den] => NIL
+    objNewWrap([num,:den],[$QuotientField, D])
+  type is ['SimpleAlgebraicExtension,k,rep,.] =>
+    -- try to retract as an element of rep and see if we can get an
+    -- element of k
+    val' := retract objNew(val,rep)
+    while (val' ^= 'failed) and
+      (equiType(objMode val') ^= k) repeat
+        val' := retract val'
+    val' = 'failed => NIL
+    val'
+
+  type is ['UnivariatePuiseuxSeries, coef, var, cen] =>
+    coerceInt(object, ['UnivariateLaurentSeries, coef, var, cen])
+  type is ['UnivariateLaurentSeries, coef, var, cen] =>
+    coerceInt(object, ['UnivariateTaylorSeries, coef, var, cen])
+
+  type is ['FunctionCalled,name] =>
+    null (m := get(name,'mode,$e)) => NIL
+    isPartialMode m => NIL
+    objNew(val,m)
+  NIL
+
+coerceOrConvertOrRetract(T,m) ==
+  $useConvertForCoercions : local := true
+  coerceOrRetract(T,m)
+
+coerceOrRetract(T,m) ==
+  (t' := coerceInteractive(T,m)) => t'
+  t := T
+  ans := nil
+  repeat
+    ans => return ans
+    t := retract t   -- retract is new name for pullback
+    t = 'failed => return ans
+    ans := coerceInteractive(t,m)
+  ans
+
+coerceRetract(object,t2) ==
+  -- tries to handle cases such as P I -> I
+  (val := objValUnwrap(object)) = "$fromCoerceable$" => NIL
+  t1 := objMode object
+  t2 = $OutputForm => NIL
+  isEqualOrSubDomain(t1,$Integer) and typeIsASmallInteger(t2) and SMINTP(val) =>
+    objNewWrap(val,t2)
+  t1 = $Integer    => NIL
+  t1 = $Symbol     => NIL
+  t1 = $OutputForm => NIL
+  (c := retractByFunction(object, t2)) => c
+  t1 is [D,:.] =>
+    fun := GETL(D,'retract) or
+           INTERN STRCONC('"retract",STRINGIMAGE D)
+    functionp fun =>
+      PUT(D,'retract,fun)
+      c := CATCH('coerceFailure,FUNCALL(fun,object,t2))
+      (c = $coerceFailure) => NIL
+      c
+    NIL
+  NIL
+
+retractByFunction(object,u) ==
+  -- tries to retract by using function "retractIfCan"
+  -- if the type belongs to the correct category.
+  $reportBottomUpFlag: local := NIL
+  t := objMode object
+  -- JHD/CRF not ofCategory(t,['RetractableTo,u]) => NIL
+  val := objValUnwrap object
+
+  -- try to get and apply the function "retractable?"
+  target := ['Union,u,'"failed"]
+  funName := 'retractIfCan
+  if $reportBottomUpFlag then
+    sayFunctionSelection(funName,[t],target,NIL,
+      '"coercion facility (retraction)")
+  -- JHD/CRF if (mms := findFunctionInDomain(funName,t,target,[t],[t],'T,'T))
+  -- MCD: changed penultimate variable to NIL.
+  if (mms := append(findFunctionInDomain(funName,t,target,[t],[t],NIL,'T),
+                    findFunctionInDomain(funName,u,target,[t],[t],NIL,'T)))
+-- The above two lines were:      (RDJ/BMT 6/95)
+--  if (mms := append(findFunctionInDomain(funName,t,target,[t],[t],'T,'T),
+--                    findFunctionInDomain(funName,u,target,[t],[t],'T,'T)))
+    then mms := orderMms(funName,mms,[t],[t],target)
+  if $reportBottomUpFlag then
+    sayFunctionSelectionResult(funName,[t],mms)
+  null mms => NIL
+
+  -- [[dc,:.],slot,.]:= CAR mms
+  dc := CAAAR mms
+  slot := CADAR mms
+  dcVector:= evalDomain dc
+  fun :=
+--+
+    compiledLookup(funName,[target,t],dcVector)
+  NULL fun => NIL
+  CAR(fun) = function Undef => NIL
+--+
+  $: fluid := dcVector
+  object' := coerceUnion2Branch objNewWrap(SPADCALL(val,fun),target)
+  u' := objMode object'
+  u = u' => object'
+  NIL
+
+--% Coercion utilities
+
+-- The next function extracts the structural definition of constants
+-- from a given domain. For example, getConstantFromDomain('(One),S)
+-- returns the representation of 1 in the domain S.
+
+constantInDomain?(form,domainForm) ==
+    opAlist := getOperationAlistFromLisplib first domainForm
+    key := opOf form
+    entryList := LASSOC(key,opAlist)
+    entryList is [[., ., ., type]] and type in '(CONST ASCONST) => true
+    key = "One" => constantInDomain?(["1"], domainForm)
+    key = "Zero" => constantInDomain?(["0"], domainForm)
+    false
+
+<<getConstantFromDomain>>
+
+domainOne(domain) == getConstantFromDomain('(One),domain)
+
+domainZero(domain) == getConstantFromDomain('(Zero),domain)
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+equalOne(object, domain) ==
+  -- tries using constant One and "=" from domain
+  -- object should not be wrapped
+  eqfunc := getFunctionFromDomain("=",domain,[domain,domain])
+  SPADCALL(object,getConstantFromDomain('(One),domain),eqfunc)
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+equalZero(object, domain) ==
+  -- tries using constant Zero and "=" from domain
+  -- object should not be wrapped
+  eqfunc := getFunctionFromDomain("=",domain,[domain,domain])
+  SPADCALL(object,getConstantFromDomain('(Zero),domain),eqfunc)
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+algEqual(object1, object2, domain) ==
+  -- sees if 2 objects of the same domain are equal by using the
+  -- "=" from the domain
+  -- objects should not be wrapped
+--  eqfunc := getFunctionFromDomain("=",domain,[domain,domain])
+  eqfunc := compiledLookupCheck("=",[$Boolean,domain,domain],evalDomain domain)
+  SPADCALL(object1,object2, eqfunc)
+
+--%  main algorithms for canCoerceFrom and coerceInteractive
+
+-- coerceInteractive and canCoerceFrom are the two coercion functions
+-- for $InteractiveMode. They translate RN, RF and RR to QF I, QF P
+-- and RE RN, respectively, and call coerceInt or canCoerce, which
+-- both work in the same way (e.g. coercion from t1 to t2):
+
+-- 1. they try to coerce t1 to t2 directly (tower coercion), and, if
+--   this fails, to coerce t1 to the last argument of t2 and embed
+--   this last argument into t2. These embedding functions are now only
+--   defined in the algebra code. (RSS 2-27-87)
+
+-- 2. the tower coercion looks whether there is any applicable local
+--   coercion, which means, one defined in boot or in algebra code.
+--   If there is an applicable function from a constructor, which is
+--   inside the type tower of t1, to the top level constructor of t2,
+--   then this constructor is bubbled up inside t1. This means,
+--   special coercion functions (defined in boot) are called, which
+--   commute two constructors in a tower. Then the local coercion is
+--   called on these constructors, which both are on top level now.
+
+-- example:
+-- let t1 = A B C D E (short for (A (B (C (D (E))))), where A ... E are
+--   type constructors), and t2 = F D G H I J
+-- there is no coercion from t1 to t2 directly, so we try to coerce
+--   t1 to s1 = D G H I J, the last argument of t2
+-- we create the type s2 = A D B C E and call a local coercion A2A
+--   from t1 to s2, which, by recursively calling coerce, bubbles up
+--   the constructor D
+-- then we call a commute coerce from s2 to s3 = D A B C E and a local
+--   coerce D2D from s3 to s1
+-- finally we embed s1 into t2, which completes the coercion t1 to t2
+
+-- the result of canCoerceFrom is TRUE or NIL
+-- the result of coerceInteractive is a object or NIL (=failed)
+-- all boot coercion functions have the following result:
+-- 1. if u=$fromCoerceable$, then TRUE or NIL
+-- 2. if the coercion succeeds, the coerced value (this may be NIL)
+-- 3. if the coercion fails, they throw to a catch point in
+--      coerceByFunction
+
+--% Interpreter Coercion Query Functions
+
+canCoerce1(t1,t2) ==
+  -- general test for coercion
+  -- the result is NIL if it fails
+  t1 = t2 => true
+  absolutelyCanCoerceByCheating(t1,t2) or t1 = '(None) or t2 = '(Any) or
+    t1 in '((Mode)  (Domain) (SubDomain (Domain))) =>
+      t2 = $OutputForm => true
+      NIL
+    -- next is for tagged union selectors for the time being
+    t1 is ['Variable,=t2] or t2 is ['Variable,=t1] => true
+    STRINGP t1 =>
+      t2 = $String => true
+      t2 = $OutputForm => true
+      t2 is ['Union,:.] => canCoerceUnion(t1,t2)
+      t2 is ['Variable,v] and (t1 = PNAME(v)) => true
+      NIL
+    STRINGP t2 =>
+      t1 is ['Variable,v] and (t2 = PNAME(v)) => true
+      NIL
+    atom t1 or atom t2 => NIL
+    null isValidType(t2) => NIL
+
+    absolutelyCannotCoerce(t1,t2) => NIL
+
+    nt1 := CAR t1
+    nt2 := CAR t2
+
+    EQ(nt1,'Mapping) => EQ(nt2,'Any)
+    EQ(nt2,'Mapping) =>
+      EQ(nt1,'Variable) or EQ(nt1,'FunctionCalled) =>
+        canCoerceExplicit2Mapping(t1,t2)
+      NIL
+    EQ(nt1,'Union) or EQ(nt2,'Union) => canCoerceUnion(t1,t2)
+
+    -- efficiency hack
+    t1 is ['Segment, s1] and t2 is ['UniversalSegment, s2] and
+        (isEqualOrSubDomain(s1, s2) or canCoerce(s1, s2)) => true
+
+    t1 is ['Tuple,S] and t2 ^= '(OutputForm) => canCoerce(['List, S], t2)
+
+    isRingT2 := ofCategory(t2,'(Ring))
+    isRingT2 and isEqualOrSubDomain(t1,$Integer) => true
+    (ans := canCoerceTopMatching(t1,t2,nt1,nt2)) ^= 'maybe => ans
+    t2 = $Integer => canCoerceLocal(t1,t2)   -- is true
+    ans := canCoerceTower(t1,t2) or
+      [.,:arg]:= deconstructT t2
+      arg and
+        t:= last arg
+        canCoerce(t1,t) and canCoerceByFunction(t,t2) and 'T
+    ans or (t1 in '((PositiveInteger) (NonNegativeInteger))
+      and canCoerce($Integer,t2))
+
+canCoerceFrom0(t1,t2) ==
+-- top level test for coercion, which transfers all RN, RF and RR into
+-- equivalent types
+  startTimingProcess 'querycoerce
+  q :=
+    isEqualOrSubDomain(t1,t2) or t1 = '(None) or t2 = '(Any) or
+      if t2 = $OutputForm then (s1 := t1; s2 := t2)
+      else (s1:= equiType(t1); s2:= equiType(t2))
+
+      -- make sure we are trying to coerce to a legal type
+      -- in particular, polynomials are repeated, etc.
+      null isValidType(t2) => NIL
+      null isLegitimateMode(t2,nil,nil) => NIL
+
+      t1 = $RationalNumber =>
+        isEqualOrSubDomain(t2,$Integer) => NIL
+        canCoerce(t1,t2) or canCoerce(s1,s2)
+      canCoerce(s1,s2)
+  stopTimingProcess 'querycoerce
+  q
+
+isSubTowerOf(t1,t2) ==
+  -- assumes RF and RN stuff has been expanded
+  -- tests whether t1 is somewhere inside t2
+  isEqualOrSubDomain(t1,t2) => true
+  null (u := underDomainOf t2) => nil
+  isSubTowerOf(t1,u)
+
+canCoerceTopMatching(t1,t2,tt1,tt2) ==
+  -- returns true, nil or maybe
+  -- for example, if t1 = P[x] D1 and t2 = P[y] D2 and x = y then
+  -- canCoerce will only be true if D1 = D2
+  not EQ(tt1,tt2) => 'maybe
+  doms := '(Polynomial List Matrix FiniteSet Vector Stream Gaussian)
+  MEMQ(tt1,doms) => canCoerce(CADR t1, CADR t2)
+  not (MEMQ(tt1,$univariateDomains) or MEMQ(tt2,$multivariateDomains)) =>
+    'maybe
+  u2 := deconstructT t2
+  1 = #u2 => NIL
+  u1 := deconstructT t1
+  1 = #u1 => NIL                             -- no under domain
+  first(u1) ^= first(u2) => 'maybe
+  canCoerce(underDomainOf t1, underDomainOf t2)
+
+canCoerceExplicit2Mapping(t1,t is ['Mapping,target,:argl]) ==
+  -- determines if there a mapping called var with the given args
+  -- and target
+  $useCoerceOrCroak: local := nil
+  t1 is ['Variable,var] =>
+    null (mms :=selectMms1(var,target,argl,[NIL for a in argl],true)) => NIL
+    mm := CAAR mms
+    mm is [., targ, :.] =>
+      targ = target => true
+      false
+    false
+  t1 is ['FunctionCalled,fun] =>
+    funNode := mkAtreeNode fun
+    transferPropsToNode(fun,funNode)
+    mms := CATCH('coerceOrCroaker, selectLocalMms(funNode,fun,argl,target))
+    CONSP mms =>
+      mms is [[['interpOnly,:.],:.]] => nil
+      mm := CAAR mms
+      mm is [., targ, :.] =>
+        targ = target => true
+        false
+      false
+    NIL
+  NIL
+
+canCoerceUnion(t1,t2) ==
+  -- sees if one can coerce to or from a Union Domain
+  -- assumes one of t1 and t2 is one
+
+  -- get the domains in the union, checking for tagged unions
+  if (isUnion1 := t1 is ['Union,:uds1]) then
+    unionDoms1 :=
+      uds1 and first uds1 is [":",:.] => [t for [.,.,t] in uds1]
+      uds1
+  if (isUnion2 := t2 is ['Union,:uds2]) then
+    unionDoms2 :=
+      uds2 and first uds2 is [":",:.] => [t for [.,.,t] in uds2]
+      uds2
+
+  isUnion2 =>
+    member(t1,unionDoms2) => true
+    isUnion1 =>
+      and/[or/[canCoerce(ud1,ud2) for ud2 in unionDoms2]
+        for ud1 in unionDoms1]
+    or/[canCoerce(t1,ud) for ud in unionDoms2]
+  -- next, a little lie
+  t1 is ['Union,d1, ='"failed"] and t2 = d1 => true
+  isUnion1 =>
+    and/[canCoerce(ud,t2) for ud in unionDoms1]
+  keyedSystemError("S2GE0016",['"canCoerceUnion",
+     '"called with 2 non-Unions"])
+
+canCoerceByMap(t1,t2) ==
+  -- idea is this: if t1 is D U1 and t2 is D U2, then look for
+  -- map: (U1 -> U2, D U1) -> D U2.  If it exists, then answer true
+  -- if canCoerceFrom(t1,t2).
+  u2 := deconstructT t2
+  1 = #u2 => NIL
+  u1 := deconstructT t1
+  1 = #u1 => NIL                             -- no under domain
+  CAR(u1) ^= CAR(u2) => NIL
+  top := CAAR u1
+  u1 := underDomainOf t1
+  u2 := underDomainOf t2
+
+  absolutelyCannotCoerce(u1,u2) => NIL
+
+  -- save some time for those we know about
+  know := '(List Vector Segment Stream UniversalSegment Array
+    Polynomial UnivariatePolynomial SquareMatrix Matrix)
+  top in know => canCoerce(u1,u2)
+
+  null selectMms1('map,t2,[['Mapping,u2,u1],t1],
+    [['Mapping,u2,u1],u1],NIL) => NIL
+  -- don't bother checking for Undef, so avoid instantiation
+  canCoerce(u1,u2)
+
+canCoerceTower(t1,t2) ==
+-- tries to find a coercion between top level t2 and somewhere inside t1
+-- builds new bubbled type, for which coercion is called recursively
+  canCoerceByMap(t1,t2) or newCanCoerceCommute(t1,t2) or
+   canCoerceLocal(t1,t2) or canCoercePermute(t1,t2) or
+    [c1,:arg1]:= deconstructT t1
+    arg1 and
+      TL:= NIL
+      arg:= arg1
+      until x or not arg repeat x:=
+        t:= last arg
+        [c,:arg]:= deconstructT t
+        TL:= [c,arg,:TL]
+        arg and coerceIntTest(t,t2) and
+          CDDR TL =>
+            s:= constructT(c1,replaceLast(arg1,bubbleConstructor TL))
+            canCoerceLocal(t1,s) and
+              [c2,:arg2]:= deconstructT last s
+              s1:= bubbleConstructor [c2,arg2,c1,arg1]
+              canCoerceCommute(s,s1) and canCoerceLocal(s1,t2)
+          s:= bubbleConstructor [c,arg,c1,arg1]
+          newCanCoerceCommute(t1,s) and canCoerceLocal(s,t2)
+      x
+
+canCoerceLocal(t1,t2) ==
+  -- test for coercion on top level
+  p:= ASSQ(CAR t1,$CoerceTable)
+  p and ASSQ(CAR t2,CDR p) is [.,:[tag,fun]] =>
+    tag='partial => NIL
+    tag='total   => true
+    (functionp(fun) and
+       (v:=CATCH('coerceFailure,FUNCALL(fun,'_$fromCoerceable_$,t1,t2)))
+         and v ^= $coerceFailure)  or  canCoerceByFunction(t1,t2)
+  canCoerceByFunction(t1,t2)
+
+canCoerceCommute(t1,t2) ==
+-- THIS IS OUT-MODED AND WILL GO AWAY SOON  RSS 2-87
+-- t1 is t2 with the two top level constructors commuted
+-- looks for the existence of a commuting function
+  CAR(t1) in (l := [$QuotientField, 'Gaussian]) and
+    CAR(t2) in l => true
+  p:= ASSQ(CAR t1,$CommuteTable)
+  p and ASSQ(CAR t2,CDR p) is [.,:['commute,.]]
+
+newCanCoerceCommute(t1,t2) ==
+  coerceIntCommute(objNewWrap("$fromCoerceable$",t1),t2)
+
+canCoercePermute(t1,t2) ==
+  -- try to generate a sequence of transpositions that will convert
+  -- t1 into t2
+  t2 in '((Integer) (OutputForm)) => NIL
+  towers := computeTTTranspositions(t1,t2)
+  -- at this point, CAR towers = t1 and last towers should be similar
+  -- to t2 in the sense that the components of t1 are in the same order
+  -- as in t2. If length towers = 2 and t2 = last towers, we quit to
+  -- avoid an infinte loop.
+  NULL towers or NULL CDR towers => NIL
+  NULL CDDR towers and t2 = CADR towers => NIL
+  -- do the coercions successively, quitting if any fail
+  ok := true
+  for t in CDR towers while ok repeat
+    ok := canCoerce(t1,t)
+    if ok then t1 := t
+  ok
+
+canConvertByFunction(m1,m2) ==
+  null $useConvertForCoercions => NIL
+  canCoerceByFunction1(m1,m2,'convert)
+
+canCoerceByFunction(m1,m2) == canCoerceByFunction1(m1,m2,'coerce)
+
+canCoerceByFunction1(m1,m2,fun) ==
+  -- calls selectMms with $Coerce=NIL and tests for required target=m2
+  $declaredMode:local:= NIL
+  $reportBottomUpFlag:local:= NIL
+  -- have to handle cases where we might have changed from RN to QF I
+  -- make 2 lists of expanded and unexpanded types
+  l1 := REMDUP [m1,eqType m1]
+  l2 := REMDUP [m2,eqType m2]
+  ans  := NIL
+  for t1 in l1 while not ans repeat
+    for t2 in l2 while not ans repeat
+      l := selectMms1(fun,t2,[t1],[t1],NIL)
+      ans := [x for x in l | x is [sig,:.] and CADR sig=t2 and
+       CADDR sig=t1 and
+        CAR(sig) isnt ['TypeEquivalence,:.]] and true
+  ans
+
+absolutelyCanCoerceByCheating(t1,t2) ==
+  -- this typically involves subdomains and towers where the only
+  -- difference is a subdomain
+  isEqualOrSubDomain(t1,t2) => true
+  typeIsASmallInteger(t1) and t2 = $Integer => true
+  ATOM(t1) or ATOM(t2) => false
+  [tl1,:u1] := deconstructT t1
+  [tl2,:u2] := deconstructT t2
+  tl1 = '(Stream) and tl2 = '(InfiniteTuple) =>
+    #u1 ^= #u2 => false
+    "and"/[absolutelyCanCoerceByCheating(x1,x2) for x1 in u1 for x2 in u2]
+  tl1 ^= tl2 => false
+  #u1 ^= #u2 => false
+  "and"/[absolutelyCanCoerceByCheating(x1,x2) for x1 in u1 for x2 in u2]
+
+absolutelyCannotCoerce(t1,t2) ==
+  -- response of true means "definitely cannot coerce"
+  -- this is largely an efficiency hack
+  ATOM(t1) or ATOM(t2) => NIL
+  t2 = '(None) => true
+  n1   := CAR t1
+  n2   := CAR t2
+  QFI  := [$QuotientField, $Integer]
+  int2 := isEqualOrSubDomain(t2,$Integer)
+  scalars := '(BigFloat NewFloat Float DoubleFloat RationalNumber)
+
+  MEMQ(n1,scalars) and int2 => true
+  (t1 = QFI) and int2       => true
+
+  num2 := int2 or MEMQ(n2,scalars) or (t2 = QFI)
+  isVar1 := MEMQ(n1,'(Variable Symbol))
+
+  num2 and isVar1 => true
+  num2 and MEMQ(n1,$univariateDomains) => true
+  num2 and MEMQ(n1,$multivariateDomains) => true
+  miscpols :=  '(Polynomial ElementaryFunction SimpleAlgebraicExtension)
+  num2 and MEMQ(n1,miscpols) => true
+
+  aggs :=  '(
+    Matrix List Vector Stream Array RectangularMatrix FiniteSet
+       )
+  u1 := underDomainOf t1
+  u2 := underDomainOf t2
+  MEMQ(n1,aggs) and (u1 = t2) => true
+  MEMQ(n2,aggs) and (u2 = t1) => true
+
+  algs :=  '(
+    SquareMatrix Gaussian RectangularMatrix Quaternion
+       )
+  nonpols := append(aggs,algs)
+  num2 and MEMQ(n1,nonpols) => true
+  isVar1 and MEMQ(n2,nonpols) and
+    absolutelyCannotCoerce(t1,u2) => true
+
+  (MEMQ(n1,scalars) or (t1 = QFI)) and (t2 = '(Polynomial (Integer))) =>
+    true
+
+  v2 := deconstructT t2
+  1 = #v2 => NIL
+  v1 := deconstructT t1
+  1 = #v1 => NIL
+  CAR(v1) ^= CAR(v2) => NIL
+  absolutelyCannotCoerce(u1,u2)
+
+typeIsASmallInteger x == (x = $SingleInteger)
+
+
+--% Interpreter Coercion Functions
+
+coerceInteractive(triple,t2) ==
+  -- bind flag for recording/reporting instantiations
+  -- (see recordInstantiation)
+  t1 := objMode triple
+  val := objVal triple
+  null(t2) or t2 = $EmptyMode => NIL
+  t2 = t1 => triple
+  t2 = '$NoValueMode => objNew(val,t2)
+  if t2 is ['SubDomain,x,.] then t2:= x
+  -- JHD added category Aug 1996 for BasicMath
+  t1 in '((Category) (Mode) (Domain) (SubDomain (Domain))) =>
+    t2 = $OutputForm => objNew(val,t2)
+    NIL
+  t1 = '$NoValueMode =>
+    if $compilingMap then clearDependentMaps($mapName,nil)
+    throwKeyedMsg("S2IC0009",[t2,$mapName])
+  $insideCoerceInteractive: local := true
+  expr2 := EQUAL(t2,$OutputForm)
+  if expr2 then startTimingProcess 'print
+  else startTimingProcess 'coercion
+  -- next 2 lines handle cases like '"failed"
+  result :=
+    expr2 and (t1 = val) => objNew(val,$OutputForm)
+    expr2 and t1 is ['Variable,var] => objNewWrap(var,$OutputForm)
+    coerceInt0(triple,t2)
+  if expr2 then stopTimingProcess 'print
+  else stopTimingProcess 'coercion
+  result
+
+coerceInt0(triple,t2) ==
+  -- top level interactive coercion, which transfers all RN, RF and RR
+  -- into equivalent types
+  val := objVal triple
+  t1  := objMode triple
+
+  val='_$fromCoerceable_$ => canCoerceFrom(t1,t2)
+  t1 = t2 => triple
+  if t2 = $OutputForm then
+    s1 := t1
+    s2 := t2
+  else
+    s1 := equiType(t1)
+    s2 := equiType(t2)
+    s1 = s2 => return objNew(val,t2)
+  -- t1 is ['Mapping,:.] and t2 ^= '(Any) => NIL
+  -- note: may be able to coerce TO mapping
+  -- treat Exit like Any
+  -- handle case where we must generate code
+  null(isWrapped val) and
+    (t1 isnt ['FunctionCalled,:.] or not $genValue)=>
+      intCodeGenCOERCE(triple,t2)
+  t1 = $Any and t2 ^= $OutputForm and ([t1',:val'] := unwrap val) and
+    (ans := coerceInt0(objNewWrap(val',t1'),t2)) => ans
+  if not EQ(s1,t1) then triple := objNew(val,s1)
+  x := coerceInt(triple,s2) =>
+    EQ(s2,t2) => x
+    objSetMode(x,t2)
+    x
+  NIL
+
+coerceInt(triple, t2) ==
+  val := coerceInt1(triple, t2) => val
+  t1 := objMode triple
+  t1 is ['Variable, :.] =>
+    newMode := getMinimalVarMode(unwrap objVal triple, nil)
+    newVal := coerceInt(triple, newMode)
+    coerceInt(newVal, t2)
+  nil
+
+coerceInt1(triple,t2) ==
+  -- general interactive coercion
+  -- the result is a new triple with type m2 or NIL (= failed)
+  $useCoerceOrCroak: local := true
+  t2 = $EmptyMode => NIL
+  t1 := objMode triple
+  t1=t2 => triple
+  val := objVal triple
+  absolutelyCanCoerceByCheating(t1,t2) => objNew(val,t2)
+  isSubDomain(t2, t1) => coerceSubDomain(val, t1, t2)
+
+  if typeIsASmallInteger(t1) then
+    (t2 = $Integer) or typeIsASmallInteger(t2) => return objNew(val,t2)
+    sintp := SINTP val
+    sintp and (t2 = $PositiveInteger) and val > 0 => return objNew(val,t2)
+    sintp and (t2 = $NonNegativeInteger) and val >= 0 => return objNew(val,t2)
+
+  typeIsASmallInteger(t2) and isEqualOrSubDomain(t1, $Integer) and INTP val =>
+    SINTP val => objNew(val,t2)
+    NIL
+
+  t2 = $Void => objNew(voidValue(),$Void)
+  t2 = $Any => objNewWrap([t1,:unwrap val],'(Any))
+
+  t1 = $Any and t2 ^= $OutputForm and ([t1',:val'] := unwrap val) and
+    (ans := coerceInt(objNewWrap(val',t1'),t2)) => ans
+
+  -- next is for tagged union selectors for the time being
+  t1 is ['Variable,=t2] or t2 is ['Variable,=t1] => objNew(val,t2)
+
+  STRINGP t2 =>
+    t1 is ['Variable,v] and (t2 = PNAME(v)) => objNewWrap(t2,t2)
+    val' := unwrap val
+    (t2 = val') and ((val' = t1) or (t1 = $String)) => objNew(val,t2)
+    NIL
+  --  t1 is ['Tuple,S] and t2 ^= '(OutputForm) =>
+  t1 is ['Tuple,S]  =>
+    coerceInt1(objNewWrap(asTupleAsList unwrap val, ['List, S]), t2)
+  t1 is ['Union,:.] => coerceIntFromUnion(triple,t2)
+  t2 is ['Union,:.] => coerceInt2Union(triple,t2)
+  (STRINGP t1) and (t2 = $String) => objNew(val,$String)
+  (STRINGP t1) and (t2 is ['Variable,v]) =>
+    t1 = PNAME(v) => objNewWrap(v,t2)
+    NIL
+  (STRINGP t1) and (t1 = unwrap val) =>
+    t2 = $OutputForm => objNew(t1,$OutputForm)
+    NIL
+  atom t1 => NIL
+
+  if t1 = $AnonymousFunction and (t2 is ['Mapping,target,:margl]) then
+    $useCoerceOrCroak := nil
+    [.,vars,:body] := unwrap val
+    vars :=
+      atom vars => [vars]
+      vars is ['Tuple,:.] => rest vars
+      vars
+    #margl ^= #vars => 'continue
+    tree := mkAtree ['ADEF,vars,[target,:margl],[NIL for x in rest t2],:body]
+    CATCH('coerceOrCroaker, bottomUp tree) = 'croaked => nil
+    return getValue tree
+
+  (t1 = $Symbol) and (t2 is ['Mapping,target,:margl]) =>
+    null (mms := selectMms1(unwrap val,nil,margl,margl,target)) => NIL
+    [dc,targ,:argl] := CAAR mms
+    targ ^= target => NIL
+    $genValue =>
+      fun := getFunctionFromDomain(unwrap val,dc,argl)
+      objNewWrap(fun,t2)
+    val := NRTcompileEvalForm(unwrap val, CDR CAAR mms, evalDomain dc)
+    objNew(val, t2)
+  (t1 is ['Variable,sym]) and (t2 is ['Mapping,target,:margl]) =>
+    null (mms := selectMms1(sym,target,margl,margl,NIL)) => 
+       null (mms := selectMms1(sym,target,margl,margl,true)) => NIL
+    [dc,targ,:argl] := CAAR mms
+    targ ^= target => NIL
+    dc is ["__FreeFunction__",:freeFun] => objNew( freeFun, t2 )
+    $genValue => objNewWrap( getFunctionFromDomain(sym,dc,argl), t2 )
+    val := NRTcompileEvalForm(sym, CDR CAAR mms, evalDomain dc)
+    objNew(val, t2)
+  (t1 is ['FunctionCalled,sym]) and (t2 is ['Mapping,target,:margl]) =>
+    symNode := mkAtreeNode sym
+    transferPropsToNode(sym,symNode)
+    null (mms := selectLocalMms(symNode,sym,margl,target)) => NIL
+    [dc,targ,:argl] := CAAR mms
+    targ ^= target => NIL
+    ml := [target,:margl]
+    intName :=
+      or/[mm for mm in mms | (mm is [[., :ml1],oldName,:.]
+        and compareTypeLists(ml1,ml))] => [oldName]
+      NIL
+    null intName => NIL
+    objNewWrap(intName,t2)
+  (t1 is ['FunctionCalled,sym]) =>
+    (t3 := get(sym,'mode,$e)) and t3 is ['Mapping,:.] =>
+      (triple' := coerceInt(triple,t3)) => coerceInt(triple',t2)
+      NIL
+    NIL
+
+  EQ(CAR(t1),'Variable) and PAIRP(t2) and
+    (isEqualOrSubDomain(t2,$Integer) or
+      (t2 = [$QuotientField, $Integer]) or MEMQ(CAR(t2),
+        '(RationalNumber BigFloat NewFloat Float DoubleFloat))) => NIL
+
+  ans := coerceRetract(triple,t2) or coerceIntTower(triple,t2) or
+    [.,:arg]:= deconstructT t2
+    arg and
+      t:= coerceInt(triple,last arg)
+      t and coerceByFunction(t,t2)
+  ans or (isSubDomain(t1,$Integer) and
+    coerceInt(objNew(val,$Integer),t2)) or
+      coerceIntAlgebraicConstant(triple,t2) or
+        coerceIntX(val,t1,t2)
+
+coerceSubDomain(val, tSuper, tSub) ==
+  -- Try to coerce from a sub domain to a super domain
+  val = '_$fromCoerceable_$ => nil
+  super := GETDATABASE(first tSub, 'SUPERDOMAIN)
+  superDomain := first super
+  superDomain = tSuper =>
+    coerceImmediateSubDomain(val, tSuper, tSub, CADR super)
+  coerceSubDomain(val, tSuper, superDomain) =>
+    coerceImmediateSubDomain(val, superDomain, tSub, CADR super)
+  nil
+
+coerceImmediateSubDomain(val, tSuper, tSub, pred) ==
+  predfn := getSubDomainPredicate(tSuper, tSub, pred)
+  FUNCALL(predfn, val, nil) => objNew(val, tSub)
+  nil
+
+getSubDomainPredicate(tSuper, tSub, pred) ==
+  $env: local := $InteractiveFrame
+  predfn := HGET($superHash, CONS(tSuper, tSub)) => predfn
+  name := GENSYM()
+  decl := ['_:, name, ['Mapping, $Boolean, tSuper]]
+  interpret(decl, nil)
+  arg := GENSYM()
+  pred' := SUBST(arg, "#1", pred)
+  defn := ['DEF, [name, arg], '(NIL NIL), '(NIL NIL), removeZeroOne pred']
+  interpret(defn, nil)
+  op := mkAtree name
+  transferPropsToNode(name, op)
+  predfn := CADAR selectLocalMms(op, name, [tSuper],$Boolean)
+  HPUT($superHash, CONS(tSuper, tSub), predfn)
+  predfn
+
+coerceIntX(val,t1, t2) ==
+  -- some experimental things
+  t1 = '(List (None)) =>
+    -- this will almost always be an empty list
+    null unwrap val =>
+      -- try getting a better flavor of List
+      null (t0 := underDomainOf(t2)) => NIL
+      coerceInt(objNewWrap(val,['List,t0]),t2)
+    NIL
+  NIL
+
+compareTypeLists(tl1,tl2) ==
+  -- returns true if every type in tl1 is = or is a subdomain of
+  -- the corresponding type in tl2
+  for t1 in tl1 for t2 in tl2 repeat
+    null isEqualOrSubDomain(t1,t2) => return NIL
+  true
+
+coerceIntAlgebraicConstant(object,t2) ==
+  -- should use = from domain, but have to check on defaults code
+  t1 := objMode object
+  val := objValUnwrap object
+  ofCategory(t1,'(Monoid)) and ofCategory(t2,'(Monoid)) and
+    val = getConstantFromDomain('(One),t1) =>
+      objNewWrap(getConstantFromDomain('(One),t2),t2)
+  ofCategory(t1,'(AbelianMonoid)) and ofCategory(t2,'(AbelianMonoid)) and
+    val = getConstantFromDomain('(Zero),t1) =>
+      objNewWrap(getConstantFromDomain('(Zero),t2),t2)
+  NIL
+
+stripUnionTags doms ==
+  [if dom is [":",.,dom'] then dom' else dom for dom in doms]
+
+isTaggedUnion u ==
+  u is ['Union,:tl] and tl and first tl is [":",.,.] and true
+
+getUnionOrRecordTags u ==
+  tags := nil
+  if u is ['Union, :tl] or u is ['Record, :tl] then
+      for t in tl repeat
+         if t is [":",tag,.] then tags := cons(tag, tags)
+  tags
+
+coerceUnion2Branch(object) ==
+  [.,:unionDoms] := objMode object
+  doms := orderUnionEntries unionDoms
+  predList:= mkPredList doms
+  doms := stripUnionTags doms
+  val' := objValUnwrap object
+  predicate := NIL
+  targetType:= NIL
+  for typ in doms for pred in predList while ^targetType repeat
+    evalSharpOne(pred,val') =>
+      predicate := pred
+      targetType := typ
+  null targetType => keyedSystemError("S2IC0013",NIL)
+  predicate is ['EQCAR,.,p] => objNewWrap(CDR val',targetType)
+  objNew(objVal object,targetType)
+
+coerceBranch2Union(object,union) ==
+  -- assumes type is a member of unionDoms
+  unionDoms := CDR union
+  doms := orderUnionEntries unionDoms
+  predList:= mkPredList doms
+  doms := stripUnionTags doms
+  p := position(objMode object,doms)
+  p = -1 => keyedSystemError("S2IC0014",[objMode object,union])
+  val := objVal object
+  predList.p is ['EQCAR,.,tag] =>
+    objNewWrap([removeQuote tag,:unwrap val],union)
+  objNew(val,union)
+
+coerceInt2Union(object,union) ==
+  -- coerces to a Union type, adding numeric tags
+  -- first cut
+  unionDoms := stripUnionTags CDR union
+  t1 := objMode object
+  member(t1,unionDoms) => coerceBranch2Union(object,union)
+  val := objVal object
+  val' := unwrap val
+  (t1 = $String) and member(val',unionDoms) =>
+    coerceBranch2Union(objNew(val,val'),union)
+  noCoerce := true
+  val' := nil
+  for d in unionDoms while noCoerce repeat
+    (val' := coerceInt(object,d)) => noCoerce := nil
+  val' => coerceBranch2Union(val',union)
+  NIL
+
+coerceIntFromUnion(object,t2) ==
+  -- coerces from a Union type to something else
+  coerceInt(coerceUnion2Branch object,t2)
+
+coerceIntByMap(triple,t2) ==
+  -- idea is this: if t1 is D U1 and t2 is D U2, then look for
+  -- map: (U1 -> U2, D U1) -> D U2.  If it exists, then create a
+  -- function to do the coercion on the element level and call the
+  -- map function.
+  t1 := objMode triple
+  t2 = t1 => triple
+  u2 := deconstructT t2    -- compute t2 first because of Expression
+  1 = #u2 => NIL           -- no under domain
+  u1 := deconstructT t1
+  1 = #u1 => NIL
+  CAAR u1 ^= CAAR u2 => nil  -- constructors not equal
+  ^valueArgsEqual?(t1, t2) => NIL
+--  CAR u1 ^= CAR u2 => NIL
+  top := CAAR u1
+  u1 := underDomainOf t1
+  u2 := underDomainOf t2
+
+  -- handle a couple of special cases for subdomains of Integer
+  top in '(List Vector Segment Stream UniversalSegment Array)
+    and isSubDomain(u1,u2) => objNew(objVal triple, t2)
+
+  args := [['Mapping,u2,u1],t1]
+  if $reportBottomUpFlag then
+    sayFunctionSelection('map,args,t2,NIL,
+      '"coercion facility (map)")
+  mms := selectMms1('map,t2,args,args,NIL)
+  if $reportBottomUpFlag then
+    sayFunctionSelectionResult('map,args,mms)
+  null mms => NIL
+
+  [[dc,:sig],slot,.]:= CAR mms
+  fun := compiledLookup('map,sig,evalDomain(dc))
+  NULL fun => NIL
+  [fn,:d]:= fun
+  fn = function Undef => NIL
+  -- now compile a function to do the coercion
+  code := ['SPADCALL,['CONS,["function","coerceIntByMapInner"],MKQ [u1,:u2]],
+    wrapped2Quote objVal triple,MKQ fun]
+  -- and apply the function
+  val := CATCH('coerceFailure,timedEvaluate code)
+  (val = $coerceFailure) => NIL
+  objNewWrap(val,t2)
+
+coerceIntByMapInner(arg,[u1,:u2]) == coerceOrThrowFailure(arg,u1,u2)
+-- [u1,:u2] gets passed as the "environment", which is why we have this
+-- slightly clumsy locution  JHD 31.July,1990
+
+valueArgsEqual?(t1, t2) ==
+  -- returns true if the object-valued arguments to t1 and t2 are the same
+  -- under coercion
+  coSig := CDR GETDATABASE(CAR t1, 'COSIG)
+  constrSig := CDR getConstructorSignature CAR t1
+  tl1 := replaceSharps(constrSig, t1)
+  tl2 := replaceSharps(constrSig, t2)
+  not MEMQ(NIL, coSig) => true
+  done := false
+  value := true
+  for a1 in CDR t1 for a2 in CDR t2 for cs in coSig
+    for m1 in tl1 for m2 in tl2 while not done repeat
+          ^cs =>
+            trip := objNewWrap(a1, m1)
+            newVal := coerceInt(trip, m2)
+            null newVal => (done := true; value := false)
+            ^algEqual(a2, objValUnwrap newVal, m2) =>
+              (done := true; value := false)
+  value
+
+coerceIntTower(triple,t2) ==
+  -- tries to find a coercion from top level t2 to somewhere inside t1
+  -- builds new argument type, for which coercion is called recursively
+  x := coerceIntByMap(triple,t2) => x
+  x := coerceIntCommute(triple,t2) => x
+  x := coerceIntPermute(triple,t2) => x
+  x := coerceIntSpecial(triple,t2) => x
+  x := coerceIntTableOrFunction(triple,t2) => x
+  t1 := objMode triple
+  [c1,:arg1]:= deconstructT t1
+  arg1 and
+    TL:= NIL
+    arg:= arg1
+    until x or not arg repeat
+      t:= last arg
+      [c,:arg]:= deconstructT t
+      TL:= [c,arg,:TL]
+      x := arg and coerceIntTest(t,t2) =>
+        CDDR TL =>
+          s := constructT(c1,replaceLast(arg1,bubbleConstructor TL))
+          (null isValidType(s)) => (x := NIL)
+          x := (coerceIntByMap(triple,s) or
+            coerceIntTableOrFunction(triple,s)) =>
+              [c2,:arg2]:= deconstructT last s
+              s:= bubbleConstructor [c2,arg2,c1,arg1]
+              (null isValidType(s)) => (x := NIL)
+              x:= coerceIntCommute(x,s) =>
+                x := (coerceIntByMap(x,t2) or
+                  coerceIntTableOrFunction(x,t2))
+        s:= bubbleConstructor [c,arg,c1,arg1]
+        (null isValidType(s)) => (x := NIL)
+        x:= coerceIntCommute(triple,s) =>
+          x:= (coerceIntByMap(x,t2) or
+            coerceIntTableOrFunction(x,t2))
+    x
+
+coerceIntSpecial(triple,t2) ==
+  t1 := objMode triple
+  t2 is ['SimpleAlgebraicExtension,R,U,.] and t1 = R =>
+    null (x := coerceInt(triple,U)) => NIL
+    coerceInt(x,t2)
+  NIL
+
+coerceIntTableOrFunction(triple,t2) ==
+  -- this function does the actual coercion to t2, but not to an
+  -- argument type of t2
+  null isValidType t2 => NIL  -- added 9-18-85 by RSS
+  null isLegitimateMode(t2,NIL,NIL) => NIL  -- added 6-28-87 by RSS
+  t1 := objMode triple
+  p:= ASSQ(CAR t1,$CoerceTable)
+  p and ASSQ(CAR t2,CDR p) is [.,:[tag,fun]] =>
+    val := objVal triple
+    fun='Identity => objNew(val,t2)
+    tag='total =>
+      coerceByTable(fun,val,t1,t2,'T) or coerceByFunction(triple,t2)
+    coerceByTable(fun,val,t1,t2,NIL) or coerceByFunction(triple,t2)
+  coerceByFunction(triple,t2)
+
+coerceCommuteTest(t1,t2) ==
+  null isLegitimateMode(t2,NIL,NIL) => NIL
+
+  -- sees whether t1 = D1 D2 R and t2 = D2 D1 S
+  null (u1 := underDomainOf t1) => NIL
+  null (u2 := underDomainOf t2) => NIL
+
+  -- must have underdomains (ie, R and S must be there)
+
+  null (v1 := underDomainOf u1) => NIL
+  null (v2 := underDomainOf u2) => NIL
+
+  -- now check that cross of constructors is correct
+  (CAR(deconstructT t1) = CAR(deconstructT u2)) and
+    (CAR(deconstructT t2) = CAR(deconstructT u1))
+
+coerceIntCommute(obj,target) ==
+  -- note that the value in obj may be $fromCoerceable$, for canCoerce
+  source := objMode obj
+  null coerceCommuteTest(source,target) => NIL
+  S := underDomainOf source
+  T := underDomainOf target
+  source = T => NIL      -- handle in other ways
+
+  source is [D,:.] =>
+    fun := GETL(D,'coerceCommute) or
+           INTERN STRCONC('"commute",STRINGIMAGE D)
+    functionp fun =>
+      PUT(D,'coerceCommute,fun)
+      u := objValUnwrap obj
+      c := CATCH('coerceFailure,FUNCALL(fun,u,source,S,target,T))
+      (c = $coerceFailure) => NIL
+      u = "$fromCoerceable$" => c
+      objNewWrap(c,target)
+    NIL
+  NIL
+
+coerceIntPermute(object,t2) ==
+  t2 in '((Integer) (OutputForm)) => NIL
+  t1 := objMode object
+  towers := computeTTTranspositions(t1,t2)
+  -- at this point, CAR towers = t1 and last towers should be similar
+  -- to t2 in the sense that the components of t1 are in the same order
+  -- as in t2. If length towers = 2 and t2 = last towers, we quit to
+  -- avoid an infinte loop.
+  NULL towers or NULL CDR towers => NIL
+  NULL CDDR towers and t2 = CADR towers => NIL
+  -- do the coercions successively, quitting if any fail
+  ok := true
+  for t in CDR towers while ok repeat
+    null (object := coerceInt(object,t)) => ok := NIL
+  ok => object
+  NIL
+
+computeTTTranspositions(t1,t2) ==
+  -- decompose t1 into its tower parts
+  tl1 := decomposeTypeIntoTower t1
+  tl2 := decomposeTypeIntoTower t2
+  -- if not at least 2 parts, don't bother working here
+  null (rest tl1 and rest tl2) => NIL
+  -- determine the relative order of the parts of t1 in t2
+  p2 := [position(d1,tl2) for d1 in tl1]
+  member(-1,p2) => NIL            -- something not present
+  -- if they are all ascending, this function will do nothing
+  p2' := MSORT p2
+  p2 = p2' => NIL
+  -- if anything is repeated twice, leave
+  p2' ^= MSORT REMDUP p2' => NIL
+  -- create a list of permutations that transform the tower parts
+  -- of t1 into the order they are in in t2
+  n1 := #tl1
+  p2 := LIST2VEC compress(p2,0,# REMDUP tl1) where
+    compress(l,start,len) ==
+      start >= len => l
+      member(start,l) => compress(l,start+1,len)
+      compress([(i < start => i; i - 1) for i in l],start,len)
+  -- p2 now has the same position numbers as p1, we need to determine
+  -- a list of permutations that takes p1 into p2.
+  -- them
+  perms := permuteToOrder(p2,n1-1,0)
+  towers := [tl1]
+  tower := LIST2VEC tl1
+  for perm in perms repeat
+    t := tower.(CAR perm)
+    tower.(CAR perm) := tower.(CDR perm)
+    tower.(CDR perm) := t
+    towers := CONS(VEC2LIST tower,towers)
+  towers := [reassembleTowerIntoType tower for tower in towers]
+  if CAR(towers) ^= t2 then towers := cons(t2,towers)
+  NREVERSE towers
+
+decomposeTypeIntoTower t ==
+  ATOM t => [t]
+  d := deconstructT t
+  NULL rest d => [t]
+  rd := REVERSE t
+  [reverse QCDR rd,:decomposeTypeIntoTower QCAR rd]
+
+reassembleTowerIntoType tower ==
+  ATOM tower => tower
+  NULL rest tower => CAR tower
+  [:top,t,s] := tower
+  reassembleTowerIntoType [:top,[:t,s]]
+
+permuteToOrder(p,n,start) ==
+  -- p is a vector of the numbers 0..n. This function returns a list
+  -- of swaps of adjacent elements so that p will be in order. We only
+  -- begin looking at index start
+  r := n - start
+  r <= 0 => NIL
+  r = 1 =>
+    p.r < p.(r+1) => NIL
+    [[r,:(r+1)]]
+  p.start = start => permuteToOrder(p,n,start+1)
+  -- bubble up element start to the top. Find out where it is
+  stpos := NIL
+  for i in start+1..n while not stpos repeat
+    if p.i = start then stpos := i
+  perms := NIL
+  while stpos ^= start repeat
+    x := stpos - 1
+    perms := [[x,:stpos],:perms]
+    t := p.stpos
+    p.stpos := p.x
+    p.x := t
+    stpos := x
+  APPEND(NREVERSE perms,permuteToOrder(p,n,start+1))
+
+coerceIntTest(t1,t2) ==
+  -- looks whether there exists a table entry or a coercion function
+  -- thus the type can be bubbled before coerceIntTableOrFunction is called
+  t1=t2 or
+    b:=
+      p:= ASSQ(CAR t1,$CoerceTable)
+      p and ASSQ(CAR t2,CDR p)
+    b or coerceConvertMmSelection('coerce,t1,t2) or
+      ($useConvertForCoercions and
+        coerceConvertMmSelection('convert,t1,t2))
+
+coerceByTable(fn,x,t1,t2,isTotalCoerce) ==
+  -- catch point for 'failure in boot coercions
+  t2 = $OutputForm and ^(newType? t1) => NIL
+  isWrapped x =>
+    x:= unwrap x
+    c:= CATCH('coerceFailure,FUNCALL(fn,x,t1,t2))
+    c=$coerceFailure => NIL
+    objNewWrap(c,t2)
+  isTotalCoerce => objNew([fn,x,MKQ t1,MKQ t2],t2)
+  objNew(['catchCoerceFailure,MKQ fn,x,MKQ t1,MKQ t2],t2)
+
+catchCoerceFailure(fn,x,t1,t2) ==
+  -- compiles a catchpoint for compiling boot coercions
+  c:= CATCH('coerceFailure,FUNCALL(fn,x,t1,t2))
+  c = $coerceFailure =>
+    throwKeyedMsgCannotCoerceWithValue(wrap unwrap x,t1,t2)
+  c
+
+coercionFailure() ==
+  -- does the throw on coercion failure
+  THROW('coerceFailure,$coerceFailure)
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+coerceByFunction(T,m2) ==
+  -- using the new modemap selection without coercions
+  -- should not be called by canCoerceFrom
+  x := objVal T
+  x = '_$fromCoerceable_$ => NIL
+  m2 is ['Union,:.] => NIL
+  m1 := objMode T
+  m2 is ['Boolean,:.] and m1 is ['Equation,ud] =>
+    dcVector := evalDomain ud
+    fun :=
+      isWrapped x =>
+        NRTcompiledLookup("=", [$Boolean, ud, ud], dcVector)
+      NRTcompileEvalForm("=", [$Boolean, ud, ud], dcVector)
+    [fn,:d]:= fun
+    isWrapped x =>
+      x:= unwrap x
+      objNewWrap(SPADCALL(CAR x,CDR x,fun),m2)
+    x isnt ['SPADCALL,a,b,:.] => keyedSystemError("S2IC0015",NIL)
+    code := ['SPADCALL, a, b, fun]
+    objNew(code,$Boolean)
+  -- If more than one function is found, any should suffice, I think -scm
+  if not (mm := coerceConvertMmSelection(funName := 'coerce,m1,m2)) then
+    mm := coerceConvertMmSelection(funName := 'convert,m1,m2)
+  mm =>
+    [[dc,tar,:args],slot,.]:= mm
+    dcVector := evalDomain(dc)
+    fun:=
+      isWrapped x =>
+        NRTcompiledLookup(funName,[tar,:args],dcVector)
+      NRTcompileEvalForm(funName,[tar,:args],dcVector)
+    [fn,:d]:= fun
+    fn = function Undef => NIL
+    isWrapped x =>
+      $: fluid := dcVector
+      val := CATCH('coerceFailure, SPADCALL(unwrap x,fun))
+      (val = $coerceFailure) => NIL
+      objNewWrap(val,m2)
+    env := fun
+    code := ['failCheck, ['SPADCALL, x, env]]
+--  tar is ['Union,:.] => objNew(['failCheck,code],m2)
+    objNew(code,m2)
+  -- try going back to types like RN instead of QF I
+  m1' := eqType m1
+  m2' := eqType m2
+  (m1 ^= m1') or (m2 ^= m2') => coerceByFunction(objNew(x,m1'),m2')
+  NIL
+
+hasCorrectTarget(m,sig is [dc,tar,:.]) ==
+  -- tests whether the target of signature sig is either m or a union
+  -- containing m. It also discards TEQ as it is not meant to be
+  -- used at top-level
+  dc is ['TypeEquivalence,:.] => NIL
+  m=tar => 'T
+  tar is ['Union,t,'failed] => t=m
+  tar is ['Union,'failed,t] and t=m
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-coerfn.boot.pamphlet b/src/interp/i-coerfn.boot.pamphlet
new file mode 100644
index 00000000..034067d3
--- /dev/null
+++ b/src/interp/i-coerfn.boot.pamphlet
@@ -0,0 +1,2309 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-coerfn.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+Special coercion routines
+
+This is the newly revised set of coercion functions to work with
+the new library and the new runtime system.
+
+coerceByTable is driven off $CoerceTable which is used to match
+the top-level constructors of the source and object types.  The
+form of $CoerceTable is an alist where the "properties" are the
+source top-level constructors and the values are triples
+                target-domain coercion-type function
+where target-domain is the top-level constructor of the target,
+coercion-type is one of 'total, 'partial or 'indeterm, and
+function is the name of the function to call to handle the
+coercion. coercion-type is used by canCoerce and friends: 'total
+means that a coercion can definitely be performed, 'partial means
+that one cannot tell whether a coercion can be performed unless
+you have the actual data (like telling whether a Polynomial Integer
+can be coerced to an Integer: you have to know whether it is a
+constant polynomial), and 'indeterm means that you might be able
+to tell without data, but you need to call the function with the
+argument "$fromCoerceable$" for a response of true or false. As an
+example of this last kind, you may be able to coerce a list to a
+vector but you have to know what the underlying types are. So
+List Integer is coerceable to Vector Integer but List Float is
+not necessarily coerceable to Vector Integer.
+
+The functions always take three arguments:
+     value                this is the unwrapped source object
+     source-type          this is the type of the source
+     target-type          this is the requested type of the target
+For ethical reasons and to avoid eternal damnation, we try to use
+library functions to perform a lot of the structure manipulations.
+However, we sometimes cheat for efficiency reasons, particularly to
+avoid intermediate instantiations.
+
+the following are older comments:
+
+This file  contains the special  coercion routines that  convert from
+one  datatype to  another  in the  interpreter.   The  choice of  the
+primary special routine is made by  the function coerceByTable.  Note
+that not all coercions use these functions, as some are done via SPAD
+algebra code  and controlled by  the function coerceByFunction.   See
+the file COERCE BOOT for more information.
+
+some assumption about the call of commute and embed functions:
+embed functions are called for one level embedding only,
+  e.g. I to P I, but not I to P G I
+commute functions are called for two types which differ only in the
+  permutation of the two top type constructors
+  e.g. G P RN to P G RN, but not G P I to P G RN or
+    P[x] G RN to G P RN
+
+all functions in this file should call canCoerce and coerceInt, as
+  opposed to canCoerceFrom and coerceInteractive
+
+all these coercion functions have the following result:
+1. if u=$fromCoerceable$, then TRUE or NIL
+2. if the coercion succeeds, the coerced value (this may be NIL)
+3. if the coercion fails, they throw to a catch point in
+     coerceByTable
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+SETANDFILEQ($coerceFailure,GENSYM())
+
+position1(x,y) ==
+  -- this is used where we want to assume a 1-based index
+  1 + position(x,y)
+
+--% Direct Product, New and Old
+
+DP2DP(u,source is [.,n,S],target is [.,m,T]) ==
+  n ^= m => nil
+  u = '_$fromCoerceable_$ => canCoerce(S,T)
+  null (u' := coerceInt(objNewWrap(u,['Vector,S]),['Vector,T])) =>
+    coercionFailure()
+  objValUnwrap u'
+
+--% Distributed Multivariate Polynomials, New and Old
+
+Dmp2Dmp(u,source is [dmp,v1,S], target is [.,v2,T]) ==
+  -- the variable lists must share some variables, or u is a constant
+  u = '_$fromCoerceable_$ =>
+    v:= intersection(v1,v2)
+    v and
+      w2:= SETDIFFERENCE(v2,v)
+      t1:= if w1 then [dmp,w1,S] else S
+      t2:= if w2 then [dmp,w2,T] else T
+      canCoerce(t1,t2)
+  null u => domainZero(target)
+  u is [[e,:c]] and e=LIST2VEC [0 for v in v1] =>
+    z:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(z)
+    coercionFailure()
+  v:= intersection(v1,v2) =>
+    w1:= SETDIFFERENCE(v1,v) =>
+      coerceDmp1(u,source,target,v,w1)
+    coerceDmp2(u,source,target)
+  coercionFailure()
+
+coerceDmp1(u,source is [.,v1,S],target is [.,v2,T],v,w) ==
+  -- coerces one Dmp to another, where v1 is not a subset of v2
+  -- v is the intersection, w the complement of v1 and v2
+  t:= ['DistributedMultivariatePolynomial,w,S]
+  x:= domainZero(target)
+  one:= domainOne(T)
+  plusfunc:= getFunctionFromDomain('_+,target,[target,target])
+  multfunc:= getFunctionFromDomain('_*,target,[target,target])
+  pat1:= [member(x,v) for x in v1]
+  pat2:= [member(x,w) for x in v1]
+  pat3:= [member(x,v) and POSN1(x,v) for x in v2]
+  for [e,:c] in u until not z repeat
+    exp:= LIST2VEC [y for x in pat2 for y in VEC2LIST e | x]
+    z:= coerceInt(objNewWrap([CONS(exp,c)],t),target) =>
+      li:= [y for x in pat1 for y in VEC2LIST e | x]
+      a:= [CONS(LIST2VEC [if x then li.x else 0 for x in pat3],one)]
+      x:= SPADCALL(x,SPADCALL(objValUnwrap(z),a,multfunc),plusfunc)
+  z => x
+  coercionFailure()
+
+coerceDmp2(u,source is [.,v1,S],target is [.,v2,T]) ==
+  -- coerces one Dmp to another, where v1 is included in v2
+  x:= domainZero(target)
+  one:= domainOne(T)
+  plusfunc:= getFunctionFromDomain('_+,target,[target,target])
+  multfunc:= getFunctionFromDomain('_*,target,[target,target])
+  pat:= [member(x,v1) and POSN1(x,v1) for x in v2]
+  for [e,:c] in u until not z repeat
+    z:= coerceInt(objNewWrap(c,S),target) =>
+      li:= VEC2LIST e
+      a:= [CONS(LIST2VEC [if x then li.x else 0 for x in pat],one)]
+      x:= SPADCALL(x,SPADCALL(objValUnwrap(z),a,multfunc),plusfunc)
+    NIL
+  z => x
+  coercionFailure()
+
+Dmp2Expr(u,source is [dmp,vars,S], target is [Expr,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(S, target)
+
+    null vars =>
+        [[., :c]] := u
+        not (c := coerceInt(objNewWrap(c, S), target)) => coercionFailure()
+        objValUnwrap(c)
+
+    syms := [objValUnwrap coerceInt(objNewWrap(var, $Symbol), target) for
+                var in vars]
+    sum := domainZero(target)
+
+    plus := getFunctionFromDomain("+",  target, [target, target])
+    mult := getFunctionFromDomain("*",  target, [target, target])
+    expn := getFunctionFromDomain("**", target, [target, $Integer])
+
+    for [e, :c] in u repeat
+        not (c := coerceInt(objNewWrap(c, S), target)) => coercionFailure()
+        c := objValUnwrap(c)
+        term := domainOne(target)
+        for i in 0.. for sym in syms repeat
+            exp := e.i
+            e.i > 0 => term := SPADCALL(term, SPADCALL(sym, e.i, expn), mult)
+        sum := SPADCALL(sum, SPADCALL(c, term, mult), plus)
+
+    sum
+
+Dmp2Mp(u, source is [dmp, x, S], target is [mp, y, T]) ==
+  source' := [dmp,y,T]
+  u = '_$fromCoerceable_$ =>
+    x = y => canCoerce(S,T)
+    canCoerce(source',target)
+  null u => domainZero(target)  -- 0 dmp is = nil
+  x ^= y =>
+    (u' := coerceInt(objNewWrap(u,source),source')) or coercionFailure()
+    (u' := coerceInt(u',target)) or coercionFailure()
+    objValUnwrap(u')
+
+  -- slight optimization for case #u = 1, x=y , #x =1 and S=T
+  -- I know it's pathological, but it may avoid an instantiation
+  (x=y) and (1 = #u) and (1 = #x) and (S = T) =>
+    [1,1,[(CAAR u).0,0,:CDAR u]]
+
+  (u' := coerceDmpCoeffs(u,S,T)) = 'failed =>
+    coercionFailure()
+  plusfunc := getFunctionFromDomain("+",target,[target,target])
+  u'' := genMpFromDmpTerm(u'.0, 0)
+  for i in 1..(#u' - 1) repeat
+    u'' := SPADCALL(u'',genMpFromDmpTerm(u'.i, 0),plusfunc)
+  u''
+
+coerceDmpCoeffs(u,S,T) ==
+  -- u is a dmp, S is domain of coeffs, T is domain to coerce coeffs to
+  S = T => u
+  u' := nil
+  bad := nil
+  for [e,:c] in u repeat
+    bad => nil
+    null (c' := coerceInt(objNewWrap(c,S),T)) => return (bad := true)
+    u' := [[e,:objValUnwrap(c')],:u']
+  bad => 'failed
+  nreverse u'
+
+sortAndReorderDmpExponents(u,vl) ==
+  vl' := reverse MSORT vl
+  n := (-1) + #vl
+  pos := LIST2VEC LZeros (n+1)
+  for i in 0..n repeat pos.i := position(vl.i,vl')
+  u' := nil
+  for [e,:c] in u repeat
+    e' := LIST2VEC LZeros (n+1)
+    for i in 0..n repeat e'.(pos.i) := e.i
+    u' := [[e',:c],:u']
+  reverse u'
+
+domain2NDmp(u, source, target is [., y, T]) ==
+  target' := ['DistributedMultivariatePolynomial,y,T]
+  u = '_$fromCoerceable_$ => canCoerce(source,target')
+  (u' := coerceInt(objNewWrap(u,source),target')) =>
+    (u'' := coerceInt(u',target)) =>
+      objValUnwrap(u'')
+    coercionFailure()
+  coercionFailure()
+
+Dmp2NDmp(u,source is [dmp,x,S],target is [ndmp,y,T]) ==
+  -- a null DMP = 0
+  null u => domainZero(target)
+  target' := [dmp,y,T]
+  u = '_$fromCoerceable_$ => Dmp2Dmp(u,source,target')
+  (u' := Dmp2Dmp(u,source,target')) => addDmpLikeTermsAsTarget(u',target)
+  coercionFailure()
+
+addDmpLikeTermsAsTarget(u,target) ==
+  u' := domainZero(target)
+  func := getFunctionFromDomain("+",target,[target,target])
+  for t in u repeat u' := SPADCALL(u',[t],func)
+  u'
+
+-- rewrite ?
+Dmp2P(u, source is [dmp,vl, S], target is [.,T]) ==
+  -- a null DMP = 0
+  null u => domainZero(target)
+  u = '_$fromCoerceable_$ =>
+    t := canCoerce(S,T)
+    null t => canCoerce(S,target)
+    t
+
+  S is ['Polynomial,.] =>
+    mp := coerceInt(objNewWrap(u,source),['MultivariatePolynomial,vl,S])
+      or coercionFailure()
+    p := coerceInt(mp,target) or coercionFailure()
+    objValUnwrap p
+
+  -- slight optimization for case #u = 1, #vl =1 and S=T
+  -- I know it's pathological, but it may avoid an instantiation
+  (1 = #u) and (1 = #vl) and (S = T) =>
+    (lexp:= (CAAR u).0) = 0 => [1,:CDAR u]
+    [1,vl.0,[lexp,0,:CDAR u]]
+
+  vl' := reverse MSORT vl
+  source' := [dmp,vl',S]
+  target' := ['MultivariatePolynomial,vl',S]
+  u' := sortAndReorderDmpExponents(u,vl)
+  u' := coerceInt(objNewWrap(u',source'),target')
+  if u' then
+    u' := translateMpVars2PVars (objValUnwrap(u'),vl')
+    u' := coerceInt(objNewWrap(u',['Polynomial,S]),target)
+  u' => objValUnwrap(u')
+  -- get drastic. create monomials
+  source' := [dmp,vl,T]
+  u' := domainZero(target)
+  oneT := domainOne(T)
+  plusfunc := getFunctionFromDomain("+",target,[target,target])
+  multfunc := getFunctionFromDomain("*",target,[target,target])
+  for [e,:c] in u repeat
+    (c' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    (e' := coerceInt(objNewWrap([[e,:oneT]],source'),target)) or
+      coercionFailure()
+    t := SPADCALL(objValUnwrap(e'),objValUnwrap(c'),multfunc)
+    u' := SPADCALL(u',t,plusfunc)
+  coercionFailure()
+
+translateMpVars2PVars (u, vl) ==
+  u is [ =1, v, :termlist] =>
+    [ 1, vl.(v-1),
+      :[[e,:translateMpVars2PVars(c,vl)] for [e,:c] in termlist]]
+  u
+
+Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) ==
+  null u =>    -- this is true if u = 0
+    domainZero(target)
+
+  u = '_$fromCoerceable_$ =>
+    member(var,vl) =>
+      vl' := remove(vl,var)
+      null vl' =>         -- no remaining variables
+        canCoerce(S,T)
+      null rest vl' =>    -- one remaining variable
+        canCoerce([up,first vl',S],T)
+      canCoerce([dmp,vl',S], T)
+    canCoerce(source,T)
+
+  -- check constant case
+  (null rest u) and (first(u) is [e,:c]) and
+    ( and/[(0 = e.i) for i in 0..(-1 + #vl)] ) =>
+      (x := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+      objValUnwrap(x)
+
+  -- check non-member case
+  null member(var,vl) =>
+    (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure()
+    [[0,:objValUnwrap u']]
+
+  vl' := remove(vl,var)
+
+  -- only one variable in DMP case
+  null vl' =>
+    u' := nreverse SORTBY('CAR,[[e.0,:c] for [e,:c] in u])
+    (u' := coerceInt(objNewWrap(u',[up,var,S]),target)) or
+      coercionFailure()
+    objValUnwrap u'
+
+  S1 := [dmp,vl',S]
+  plusfunc:= getFunctionFromDomain('_+,T,[T,T])
+  zero := getConstantFromDomain('(Zero),T)
+  x := NIL
+  pos:= POSN1(var,vl)
+  for [e,:c] in u until not y repeat
+    exp:= e.pos
+    e1:= removeVectorElt(e,pos)
+    y:= coerceInt(objNewWrap([[e1,:c]],S1),T) =>
+      -- need to be careful about zeros
+      p:= ASSQ(exp,x) =>
+        c' := SPADCALL(CDR p,objValUnwrap(y),plusfunc)
+        c' = zero => x := REMALIST(x,exp)
+        RPLACD(p,c')
+      zero = objValUnwrap(y) => 'iterate
+      x := CONS(CONS(exp,objValUnwrap(y)),x)
+  y => nreverse SORTBY('CAR,x)
+  coercionFailure()
+
+removeVectorElt(v,pos) ==
+  -- removes the pos'th element from vector v
+  LIST2VEC [x for x in VEC2LIST v for y in 0.. | not (y=pos)]
+
+removeListElt(l,pos) ==
+  pos = 0 => CDR l
+  [CAR l, :removeListElt(CDR l,pos-1)]
+
+NDmp2domain(u,source is [ndmp,x,S],target) ==
+  -- a null NDMP = 0
+  null u => domainZero(target)
+  dmp := 'DistributedMultivariatePolynomial
+  source' := [dmp,x,S]
+  u = '_$fromCoerceable_$ => canCoerce(source',target)
+  u' := addDmpLikeTermsAsTarget(u,source')
+  (u'' := coerceInt(objNewWrap(u',source'),target)) =>
+    objValUnwrap(u'')
+  coercionFailure()
+
+NDmp2NDmp(u,source is [ndmp,x,S],target is [.,y,T]) ==
+  -- a null NDMP = 0
+  null u => domainZero(target)
+  dmp := 'DistributedMultivariatePolynomial
+  source' := [dmp,x,S]
+  target' := [dmp,y,T]
+  u = '_$fromCoerceable_$ => canCoerce(source',target')
+  u' := addDmpLikeTermsAsTarget(u,source')
+  (u'' := coerceInt(objNewWrap(u',source'),target')) =>
+    addDmpLikeTermsAsTarget(objValUnwrap(u''),target)
+  coercionFailure()
+
+--% Expression
+
+Expr2Complex(u,source is [.,S], target is [.,T]) ==
+    u = '_$fromCoerceable_$ => nil   -- can't tell, in general
+
+    not member(S, [$Integer, $Float, $DoubleFloat]) => coercionFailure()
+    not member(T, [$Float, $DoubleFloat]) => coercionFailure()
+
+    complexNumeric := getFunctionFromDomain("complexNumeric", ['Numeric, S], [source])
+
+    -- the following might fail
+    cf := SPADCALL(u,complexNumeric)  -- returns a Float
+    T = $DoubleFloat =>
+        null (z := coerceInt(objNewWrap(cf, ['Complex, $Float]), ['Complex, $DoubleFloat])) =>
+            coercionFailure()
+        objValUnwrap z
+    cf
+
+Expr2Dmp(u,source is [Expr,S], target is [dmp,v2,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(source, T)
+
+    null v2 =>
+        not (z := coerceInt(objNewWrap(u, source), T)) => coercionFailure()
+        [[LIST2VEC NIL, :objValUnwrap z]]
+
+    obj := objNewWrap(u, source)
+    univ := coerceInt(obj, ['UnivariatePolynomial, first v2, T])
+    not univ =>
+        T = source => coercionFailure()
+        not (z := coerceInt(obj, [dmp, v2, source])) =>
+            coercionFailure()
+        z := objValUnwrap z
+        for term in z repeat
+            [., :c] := term
+            not (c := coerceInt(objNewWrap(c, source), T)) => coercionFailure()
+            RPLACD(term, objValUnwrap c)
+        z
+
+    univ := objValUnwrap univ
+
+    -- only one variable
+
+    null rest v2 =>
+        for term in univ repeat
+            RPLACA(term, VECTOR CAR term)
+        univ
+
+    -- more than one variable
+
+    summands := nil
+    for [e,:c] in univ repeat
+        summands := Expr2Dmp1(summands,
+            LIST2VEC [e, :[0 for v in rest v2]], c, T, 1, rest v2, T)
+
+    plus := getFunctionFromDomain("+", target, [target, target])
+    sum  := domainZero target
+    for summand in summands repeat
+        sum := SPADCALL([summand], sum, plus)
+    sum
+
+Expr2Dmp1(summands, vec, c, source, index, varList, T) ==
+    if null varList then
+        if not (source = T) then
+            not (c := coerceInt(objNewWrap(c, source), T)) => coercionFailure()
+            c := objValUnwrap c
+        summands := [[vec, :c], :summands]
+    else
+        univ := coerceInt(objNewWrap(c, source),
+            ['UnivariatePolynomial, first varList, T])
+        univ := objValUnwrap univ
+
+        for [e,:c] in univ repeat
+            vec := COPY_-SEQ vec
+            vec.index := e
+            summands := Expr2Dmp1(summands, vec, c, T, index+1, rest varList, T)
+    summands
+
+Expr2Mp(u,source is [Expr,S], target is [.,v2,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(source, T)
+
+    dmp := ['DistributedMultivariatePolynomial,v2,T]
+    d   := Expr2Dmp(u,source, dmp)
+    not (m := coerceInt(objNewWrap(d, dmp), target)) => coercionFailure()
+    objValUnwrap m
+
+Expr2Up(u,source is [Expr,S], target is [.,var,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(source, T)
+    kernelFunc := getFunctionFromDomain("kernels", source, [source])
+    kernelDom  := ['Kernel, source]
+    nameFunc   := getFunctionFromDomain("name", kernelDom, [kernelDom])
+    kernels    := SPADCALL(u,kernelFunc)
+    v1         := [SPADCALL(kernel, nameFunc) for kernel in kernels]
+
+    not member(var, v1) => coercionFailure()
+
+    -- variable is a kernel
+
+    varKernel  := kernels.(POSN1(var, v1))
+    univFunc   := getFunctionFromDomain("univariate", source, [source, kernelDom])
+    sup        := ['SparseUnivariatePolynomial, source]
+
+    fracUniv   := SPADCALL(u, varKernel, univFunc)
+    denom      := CDR fracUniv
+
+    not equalOne(denom, sup) => coercionFailure()
+
+    numer      := CAR fracUniv
+    uniType := ['UnivariatePolynomial, var, source]
+    (z := coerceInt(objNewWrap(numer, uniType), target)) => objValUnwrap z
+    coercionFailure()
+
+--% Kernels over Expr
+
+Ker2Ker(u,source is [.,S], target is [.,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(S, T)
+  not (m := coerceInt(objNewWrap(u, source), S)) => coercionFailure()
+  u' := objValUnwrap m
+  not (m' := coerceInt(objNewWrap(u', S), T)) => coercionFailure()
+  u'' := objValUnwrap m'
+  not (m'' := coerceInt(objNewWrap(u'', T), target)) => coercionFailure()
+  objValUnwrap m''
+
+Ker2Expr(u,source is [.,S], target) ==
+  u = '_$fromCoerceable_$ => canCoerce(S, target)
+  not (m := coerceByFunction(objNewWrap(u, source), S)) => coercionFailure()
+  u':= objValUnwrap m
+  not (m' := coerceInt(objNewWrap(u', S), target)) => coercionFailure()
+  objValUnwrap m'
+
+
+--% Factored objects
+
+Factored2Factored(u,oldmode,newmode) ==
+  [.,oldargmode,:.]:= oldmode
+  [.,newargmode,:.]:= newmode
+  u = '_$fromCoerceable_$ => canCoerce(oldargmode,newargmode)
+  u' := unwrap u
+  unit' := coerceInt(objNewWrap(first u',oldargmode),newargmode)
+  null unit' => coercionFailure()
+  factors := KDR u'
+  factors' := [(coerceFFE(x,oldargmode,newargmode)) for x in factors]
+  member('failed,factors') => coercionFailure()
+  [objValUnwrap(unit'),:factors']
+
+coerceFFE(ffe, oldmode, newmode) ==
+  fac' := coerceInt(objNewWrap(ffe.1,oldmode),newmode)
+  null fac' => 'failed
+  LIST2VEC [ffe.0,objValUnwrap(fac'),ffe.2]
+
+--% Complex
+
+Complex2underDomain(u,[.,S],target) ==
+  u = '_$fromCoerceable_$ => nil
+  [r,:i] := u
+  i=domainZero(S) =>
+    [r',.,.]:= coerceInt(objNewWrap(r,S),target) or
+      coercionFailure()
+    r'
+  coercionFailure()
+
+Complex2FR(u,S is [.,R],target is [.,T]) ==
+  u = '_$fromCoerceable_$ =>
+    S ^= T => nil
+    R = $Integer => true
+    nil
+  S ^= T => coercionFailure()
+  package :=
+    R = $Integer => ['GaussianFactorizationPackage]
+    coercionFailure()
+  factor := getFunctionFromDomain('factor,package,[S])
+  SPADCALL(u,factor)
+
+Complex2Expr(u, source is [.,S], target is [., T]) ==
+  u = '_$fromCoerceable_$ =>
+    T is ['Complex, T1] and canCoerceFrom(S, T1) or coercionFailure()
+  E := defaultTargetFE source
+  negOne := coerceInt(objNewWrap(-1, $Integer), E)
+  null negOne => coercionFailure()
+  sqrtFun := getFunctionFromDomain('sqrt, E, [E])
+  i := SPADCALL(objValUnwrap negOne, sqrtFun)
+  realFun := getFunctionFromDomain('real, source, [source])
+  imagFun := getFunctionFromDomain('imag, source, [source])
+  real := SPADCALL(u, realFun)
+  imag := SPADCALL(u, imagFun)
+  realExp := coerceInt(objNewWrap(real, S), E)
+  null realExp => coercionFailure()
+  imagExp := coerceInt(objNewWrap(imag, S), E)
+  null imagExp => coercionFailure()
+  timesFun := getFunctionFromDomain('_*, E, [E, E])
+  plusFun  := getFunctionFromDomain('_+, E, [E, E])
+  newVal := SPADCALL(objValUnwrap(realExp),
+             SPADCALL(i, objValUnwrap imagExp, timesFun), plusFun)
+  newObj := objNewWrap(newVal, E)
+  finalObj := coerceInt(newObj, target)
+  finalObj => objValUnwrap finalObj
+  coercionFailure()
+
+--% Integer
+
+I2EI(n,source,target) ==
+  n = '_$fromCoerceable_$ => nil
+  if not ODDP(n) then n else coercionFailure()
+
+I2OI(n,source,target) ==
+  n = '_$fromCoerceable_$ => nil
+  if ODDP(n) then n else coercionFailure()
+
+I2PI(n,source,target) ==
+  n = '_$fromCoerceable_$ => nil
+  if n > 0 then n else coercionFailure()
+
+I2NNI(n,source,target) ==
+  n = '_$fromCoerceable_$ => nil
+  if n >= 0 then n else coercionFailure()
+
+--% List
+
+L2Tuple(val, source is [.,S], target is [.,T]) ==
+    val = '_$fromCoerceable_$ => canCoerce(S,T)
+    null (object := coerceInt1(mkObjWrap(val,source), ['List, T])) =>
+      coercionFailure()
+    asTupleNew0 objValUnwrap object
+
+L2DP(l, source is [.,S], target is [.,n,T]) ==
+  -- need to know size of the list
+  l = '_$fromCoerceable_$ => nil
+  n ^= SIZE l => coercionFailure()
+  (v := coerceInt(objNewWrap(LIST2VEC l,['Vector,S]),['Vector,T])) or
+    coercionFailure()
+  V2DP(objValUnwrap v, ['Vector, T], target)
+
+V2DP(v, source is [.,S], target is [.,n,T]) ==
+  -- need to know size of the vector
+  v = '_$fromCoerceable_$ => nil
+  n ^= SIZE v => coercionFailure()
+  (v1 := coerceInt(objNewWrap(v,source),['Vector,T])) or
+    coercionFailure()
+  dpFun  := getFunctionFromDomain('directProduct, target, [['Vector,T]])
+  SPADCALL(objValUnwrap v1, dpFun)
+
+L2V(l, source is [.,S], target is [.,T]) ==
+  l = '_$fromCoerceable_$ => canCoerce(S,T)
+  (v := coerceInt(objNewWrap(LIST2VEC l,['Vector,S]),target)) or
+    coercionFailure()
+  objValUnwrap(v)
+
+V2L(v, source is [.,S], target is [.,T]) ==
+  v = '_$fromCoerceable_$ => canCoerce(S,T)
+  (l := coerceInt(objNewWrap(VEC2LIST v,['List,S]),target)) or
+    coercionFailure()
+  objValUnwrap(l)
+
+L2M(u,[.,D],[.,R]) ==
+  u = '_$fromCoerceable_$ => nil
+  D is ['List,E] and isRectangularList(u,#u,# first u) =>
+    u' := nil
+    for x in u repeat
+      x' := nil
+      for y in x repeat
+        (y' := coerceInt(objNewWrap(y,E),R)) or coercionFailure()
+        x' := [objValUnwrap(y'),:x']
+      u' := [LIST2VEC reverse x',:u']
+    LIST2VEC reverse u'
+  coercionFailure()
+
+L2Record(l,[.,D],[.,:al]) ==
+  l = '_$fromCoerceable_$ => nil
+  #l = #al =>
+    v:= [u for x in l for [":",.,D'] in al] where u ==
+      T:= coerceInt(objNewWrap(x,D),D') or return 'failed
+      objValUnwrap(T)
+    v = 'failed => coercionFailure()
+    #v = 2 => [v.0,:v.1]
+    LIST2VEC v
+  coercionFailure()
+
+L2Rm(u,source is [.,D],target is [.,n,m,R]) ==
+  u = '_$fromCoerceable_$ => nil
+  D is ['List,E] and isRectangularList(u,n,m) =>
+    L2M(u,source,['Matrix,R])
+  coercionFailure()
+
+L2Sm(u,source is [.,D],[.,n,R]) ==
+  u = '_$fromCoerceable_$ => nil
+  D is ['List,E] and isRectangularList(u,n,n) =>
+    L2M(u,source,['Matrix,R])
+  coercionFailure()
+
+L2Set(x,source is [.,S],target is [.,T]) ==
+  x = '_$fromCoerceable_$ => canCoerce(S,T)
+  -- call library function  brace  to get a set
+  target' := ['Set,S]
+  u := objNewWrap(
+    SPADCALL(x,getFunctionFromDomain('brace,target',[source])),
+      target')
+  (u := coerceInt(u,target)) or coercionFailure()
+  objValUnwrap u
+
+Set2L(x,source is [.,S],target is [.,T]) ==
+  x = '_$fromCoerceable_$ => canCoerce(S,T)
+  -- call library function  destruct  to get a list
+  u := objNewWrap(
+    SPADCALL(x,getFunctionFromDomain('destruct,source,[source])),
+      ['List,S])
+  (u := coerceInt(u,target)) or coercionFailure()
+  objValUnwrap u
+
+Agg2Agg(x,source is [agg1,S],target is [.,T]) ==
+  x = '_$fromCoerceable_$ => canCoerce(S,T)
+  S = T => coercionFailure()         -- library function
+  target' := [agg1,T]
+  (u := coerceInt(objNewWrap(x,source),target')) or coercionFailure()
+  (u := coerceInt(u,target)) or coercionFailure()
+  objValUnwrap u
+
+Agg2L2Agg(x,source is [.,S],target) ==
+  -- tries to use list as an intermediate type
+  mid := ['List,S]
+  x = '_$fromCoerceable_$ =>
+    canCoerce(source,mid) and canCoerce(mid,target)
+  (u := coerceInt(objNewWrap(x,source),mid)) or coercionFailure()
+  (u := coerceInt(u,target)) or coercionFailure()
+  objValUnwrap u
+
+isRectangularList(x,p,q) ==
+  p=0 or p=#x =>
+    n:= #first x
+    and/[n=#y for y in rest x] => p=0 or q=n
+
+--% Matrix
+
+M2L(x,[.,S],target) ==
+  mid := ['Vector,['Vector,S]]
+  x = '_$fromCoerceable_$ => canCoerce(mid,target)
+  (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure()
+  objValUnwrap u
+
+M2M(x,[.,R],[.,S]) ==
+  x = '_$fromCoerceable_$ => canCoerce(R,S)
+  n := # x
+  m := # x.0
+  v := nil
+  for i in 0..(n-1) repeat
+    u := nil
+    for j in 0..(m-1) repeat
+      y := x.i.j
+      (y' := coerceInt(objNewWrap(y,R),S)) or coercionFailure()
+      u := [objValUnwrap y',:u]
+    v := [LIST2VEC reverse u,:v]
+  LIST2VEC reverse v
+
+M2Rm(x,source is [.,R],[.,p,q,S]) ==
+  x = '_$fromCoerceable_$ => nil
+  n:= #x
+  m:= #x.0
+  n=p and m=q => M2M(x,source,[nil,S])
+  coercionFailure()
+
+M2Sm(x,source is [.,R],[.,p,S]) ==
+  x = '_$fromCoerceable_$ => nil
+  n:= #x
+  m:= #x.(0)
+  n=m and m=p => M2M(x,source,[nil,S])
+  coercionFailure()
+
+M2V(x,[.,S],target) ==
+  mid := ['Vector,['Vector,S]]
+  x = '_$fromCoerceable_$ =>  canCoerce(mid,target)
+  (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure()
+  objValUnwrap u
+
+--% Multivariate Polynomial
+
+Mp2Dmp(u, source is [., x, S], target is [dmp, y, T]) ==
+  -- Change the representation to a DMP with the same variables and
+  -- coerce.
+  target' := [dmp,x,S]
+  u = '_$fromCoerceable_$ => canCoerce(target',target)
+
+  -- check if we have a constant
+  u is [ =0,:c] =>
+    null (u' := coerceInt(objNewWrap(c,S),target)) =>
+      coercionFailure()
+    objValUnwrap(u')
+
+  plus := getFunctionFromDomain('_+,target',[target',target'])
+  mult := getFunctionFromDomain('_*,target',[target',target'])
+  one := domainOne(S)
+  zero := domainZero(S)
+  (u' := coerceInt(objNewWrap(Mp2SimilarDmp(u,S,#x,plus,mult,one,zero),
+    target'),target)) or coercionFailure()
+  objValUnwrap(u')
+
+Mp2SimilarDmp(u,S,n,plus,mult,one,zero) ==
+  u is [ =0,:c] =>
+    c = zero => NIL  -- zero for dmp
+    [[LIST2VEC LZeros n,:c]]
+  u is [ =1,x,:terms] =>
+    u' := NIL  -- zero for dmp
+    for [e,:c] in terms repeat
+      e' := LIST2VEC LZeros n
+      e'.(x-1) := e
+      t := [[e',:one]]
+      t := SPADCALL(t,Mp2SimilarDmp(c,S,n,plus,mult,one,zero),mult)
+      u' := SPADCALL(u',t,plus)
+    u'
+
+Mp2Expr(u,source is [mp,vars,S], target is [Expr,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(S, target)
+
+    dmp := ['DistributedMultivariatePolynomial, vars, S]
+    not (d := coerceInt(objNewWrap(u, source), dmp)) => coercionFailure()
+    Dmp2Expr(objValUnwrap d, dmp, target)
+
+Mp2FR(u,S is [.,vl,R],[.,T]) ==
+  u = '_$fromCoerceable_$ =>
+    S ^= T => nil
+    R in '((Integer) (Fraction (Integer))) => true
+    nil
+  S ^= T => coercionFailure()
+  package :=
+    R = $Integer =>
+      ovl := ['OrderedVariableList, vl]
+      ['MultivariateFactorize,ovl, ['IndexedExponents, ovl],R,S]
+    R is ['Fraction, D] =>
+      ovl := ['OrderedVariableList, vl]
+      package := ['MRationalFactorize,['IndexedExponents, ovl], ovl, D, S]
+    coercionFailure()
+  factor := getFunctionFromDomain('factor,package,[S])
+  SPADCALL(u,factor)
+
+Mp2Mp(u,source is [mp,x,S], target is [.,y,T]) ==
+  -- need not deal with case of x = y (coerceByMapping)
+  common := intersection(y,x)
+  x' := SETDIFFERENCE(x,common)
+  y' := SETDIFFERENCE(y,common)
+
+  u = '_$fromCoerceable_$ =>
+    x = y => canCoerce(S,T)
+    null common => canCoerce(source,T)
+    null x' => canCoerce(S,target)
+    null y' => canCoerce([mp,x',S],T)
+    canCoerce([mp,x',S],[mp,y',T])
+
+  -- first check for constant case
+  u is [ =0,:c] =>
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+
+  plus  := getFunctionFromDomain('_+,target,[target,target])
+
+  -- now no-common-variables case
+
+  null common =>
+    times := getFunctionFromDomain('_*,target,[target,target])
+    expn  := getFunctionFromDomain('_*_*,target,
+      [target,$NonNegativeInteger])
+    Mp2MpAux0(u,S,target,x,plus,times,expn)
+
+  -- if source vars are all in target
+  null x' =>
+    monom := getFunctionFromDomain('monomial,target,
+      [target,['OrderedVariableList,y],$NonNegativeInteger])
+    Mp2MpAux1(u,S,target,x,y,plus,monom)
+
+  -- if target vars are all in source
+  null y' =>    -- change source to MP[common] MP[x'] S
+    univariate := getFunctionFromDomain('univariate,
+      source,[source,['OrderedVariableList,x]])
+    u' := Mp2MpAux2(u,x,common,x',common,x',univariate,S,NIL)
+    (u' := coerceInt(objNewWrap(u', [mp,common,[mp,x',S]]),target)) or
+      coercionFailure()
+    objValUnwrap(u')
+
+  -- we have a mixture
+  (u' := coerceInt(objNewWrap(u,source),[mp,common,[mp,x',S]])) or
+    coercionFailure()
+  (u' := coerceInt(u',target)) or coercionFailure()
+  objValUnwrap(u')
+
+Mp2MpAux0(u,S,target,vars,plus,times,expn) ==
+  -- for case when no common variables
+  u is [ =0,:c] =>
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+  [.,var,:terms] := u
+  [mp,.,T] := target
+  x := coerceInt(objNewWrap(vars.(var-1),['Variable,vars.(var-1)]),
+    [mp,vars,$Integer]) or coercionFailure()
+  (x := coerceInt(x,T)) or coercionFailure()
+  x := [0,:objValUnwrap x]
+  sum := domainZero(target)
+  for [e,:c] in terms repeat
+    prod := SPADCALL(SPADCALL(x,e,expn),
+      Mp2MpAux0(c,S,target,vars,plus,times,expn),times)
+    sum := SPADCALL(sum,prod,plus)
+  sum
+
+Mp2MpAux1(u,S,target,varl1,varl2,plus,monom) ==
+  -- for case when source vars are all in target
+  u is [ =0,:c] =>
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+  [.,var,:terms] := u
+  sum := domainZero(target)
+  for [e,:c] in terms repeat
+    mon := SPADCALL( Mp2MpAux1(c,S,target,varl1,varl2,plus,monom),
+      position1(varl1.(var-1), varl2),e,monom)
+    sum := SPADCALL(sum,mon,plus)
+  sum
+
+Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder) ==
+  -- target vars are all in source
+  mp2 := ['MultivariatePolynomial,oldcomm,['MultivariatePolynomial,
+    oldrest,S]]
+  common =>
+    u is [ =0,:c] =>
+      (u' := coerceInt(objNewWrap(c,S),mp2)) or coercionFailure()
+      objValUnwrap(u')
+    [var,:common] := common
+    u' := SPADCALL(u,position1(var,x),univariate)
+    null(rest(u')) and (first(first(u')) = 0) =>
+      Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder)
+    [1,position1(var,oldcomm),:[[e,:Mp2MpAux2(c,x,oldcomm,oldrest,
+      common,restvars,univariate,S,isUnder)] for [e,:c] in u']]
+  null isUnder =>
+    [0,:Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,true)]
+  -- just treat like elt of [mp,x',S]
+  u is [ =0,:c] => u
+  [var,:restvars] := restvars
+  u' := SPADCALL(u,position1(var,x),univariate)
+  null(rest(u')) and (first(first(u')) = 0) =>
+    Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder)
+  [1,position1(var,oldrest),:[[e,:Mp2MpAux2(c,x,oldcomm,oldrest,
+    common,restvars,univariate,S,isUnder)] for [e,:c] in u']]
+
+genMpFromDmpTerm(u, oldlen) ==
+
+  -- given one term of a DMP representation of a polynomial, this creates
+  -- the corresponding MP term.
+
+  patlen := oldlen
+  [e,:c] := u
+  numexps := # e
+  patlen >= numexps => [0, :c]
+  for i in patlen..(numexps - 1) repeat
+    e.i = 0 => patlen := patlen + 1
+    return nil
+  patlen >= numexps => [0, :c]
+  [1, 1+patlen, [e.patlen,:genMpFromDmpTerm(u,patlen+1)]]
+
+Mp2P(u, source is [mp,vl, S], target is [p,R]) ==
+  u = '_$fromCoerceable_$ => canCoerce(S,target)
+  S is ['Polynomial,.] => MpP2P(u,vl,S,R)
+  vl' := REVERSE MSORT vl
+  -- if Mp2Mp fails, a THROW will occur
+  u' := Mp2Mp(u,source,[mp,vl',S])
+  u' := translateMpVars2PVars (u',vl')
+  (u' := coerceInt(objNewWrap(u',[p,S]),target)) or coercionFailure()
+  objValUnwrap(u')
+
+MpP2P(u,vl,PS,R) ==
+  -- u has type MP(vl,PS). Want to coerce to P R.
+  PR := ['Polynomial,R]
+  u is [ =0,:c] =>
+    (u' :=coerceInt(objNewWrap(c,PS),PR)) or
+      coercionFailure()
+    objValUnwrap u'
+  [ .,pos,:ec] := u
+  multivariate := getFunctionFromDomain('multivariate,
+    PR,[['SparseUnivariatePolynomial,PR],$Symbol])
+  sup := [[e,:MpP2P(c,vl,PS,R)] for [e,:c] in ec]
+  p := SPADCALL(sup,vl.(pos-1),multivariate)
+  --(p' :=coerceInt(objNewWrap(p,PS),['Polynomial,R])) or coercionFailure()
+  --objValUnwrap(p')
+
+Mp2Up(u,source is [mp,vl,S],target is [up,x,T]) ==
+  u = '_$fromCoerceable_$ =>
+    member(x,vl) =>
+      vl = [x] => canCoerce(S,T)
+      canCoerce([mp,delete(x,vl),S],T)
+    canCoerce(source,T)
+
+  u is [ =0,:c] =>      -- constant polynomial?
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap u'
+
+  null member(x,vl) =>
+    (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure()
+    [[0,:objValUnwrap(u')]]
+
+  vl = [x] =>
+    u' := [[e,:c] for [e,.,:c] in CDDR u]
+    (u' := coerceInt(objNewWrap(u',[up,x,S]),target))
+      or coercionFailure()
+    objValUnwrap u'
+
+  -- do a univariate to transform u to a UP(x,P S) and then coerce again
+  var := position1(x,vl)
+  UPP := ['UnivariatePolynomial,x,source]
+  univariate := getFunctionFromDomain('univariate,
+    source,[source,['OrderedVariableList,vl]])
+  upU := SPADCALL(u,var,univariate)  -- we may assume this has type UPP
+  (u' := coerceInt(objNewWrap(upU,UPP),target)) or coercionFailure()
+  objValUnwrap u'
+
+--% OrderedVariableList
+
+OV2OV(u,source is [.,svl], target is [.,tvl]) ==
+  svl = intersection(svl,tvl) =>
+    u = '_$fromCoerceable_$ => true
+    position1(svl.(u-1),tvl)
+  u = '_$fromCoerceable_$ => nil
+  coercionFailure()
+
+OV2P(u,source is [.,svl], target is [.,T]) ==
+  u = '_$fromCoerceable_$ => true
+  v := svl.(unwrap(u)-1)
+  [1,v,[1,0,:domainOne(T)]]
+
+OV2poly(u,source is [.,svl], target is [p,vl,T]) ==
+  u = '_$fromCoerceable_$ =>
+    p = 'UnivariatePolynomial => (# svl = 1) and (p = svl.0)
+    and/[member(v,vl) for v in svl]
+  v := svl.(unwrap(u)-1)
+  val' := [1,:domainOne(T)]
+  p = 'UnivariatePolynomial =>
+    v ^= vl => coercionFailure()
+    [[1,:domainOne(T)]]
+  null member(v,vl) => coercionFailure()
+  val' := [[1,:domainOne(T)]]
+  source' := ['UnivariatePolynomial,v,T]
+  (u' := coerceInt(objNewWrap(val',source'),target)) or
+    coercionFailure()
+  objValUnwrap(u')
+
+OV2SE(u,source is [.,svl], target) ==
+  u = '_$fromCoerceable_$ => true
+  svl.(unwrap(u)-1)
+
+OV2Sy(u,source is [.,svl], target) ==
+  u = '_$fromCoerceable_$ => true
+  svl.(unwrap(u)-1)
+
+--% Polynomial
+
+varsInPoly(u) ==
+  u is [ =1, v, :termlist] =>
+    [v,:varsInPoly(c) for [e,:c] in termlist]
+  nil
+
+P2FR(u,S is [.,R],[.,T]) ==
+  u = '_$fromCoerceable_$ =>
+    S ^= T => nil
+    R in '((Integer) (Fraction (Integer))) => true
+    nil
+  S ^= T => coercionFailure()
+  package :=
+    R = $Integer =>
+      ['MultivariateFactorize,$Symbol,['IndexedExponents, $Symbol],R,S]
+    R is ['Fraction, D] =>
+      package := ['MRationalFactorize,['IndexedExponents, $Symbol],$Symbol,
+                 D, S]
+    coercionFailure()
+  factor := getFunctionFromDomain('factor,package,[S])
+  SPADCALL(u,factor)
+
+P2Dmp(u, source is [., S], target is [., y, T]) ==
+  u = '_$fromCoerceable_$ =>
+    -- might be able to say yes
+    canCoerce(source,T)
+  u is [ =0,:c] =>       -- polynomial is a constant
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+  univariate := getFunctionFromDomain('univariate,
+    source,[source,$Symbol])
+  plus := getFunctionFromDomain("+",target,[target,target])
+  monom := getFunctionFromDomain('monomial,target,
+    [target,['OrderedVariableList,y],$NonNegativeInteger])
+  P2DmpAux(u,source,S,target,copy y,y,T,univariate,plus,monom)
+
+P2Expr(u, source is [.,S], target is [., T]) ==
+  u = '_$fromCoerceable_$ =>
+    canCoerce(S, T)
+  S = T => coercionFailure()
+  newS := ['Polynomial, T]
+  val := coerceInt(objNewWrap(u, source), newS)
+  null val => coercionFailure()
+  val := coerceInt(val, target)
+  null val => coercionFailure()
+  objValUnwrap val
+
+P2DmpAux(u,source,S,target,varlist,vars,T,univariate,plus,monom) ==
+  u is [ =0,:c] =>       -- polynomial is a constant
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+
+  -- if no variables left, try to go to underdomain of target (T)
+  null vars =>
+    (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure()
+    -- if successful, embed
+    (u' := coerceByFunction(u',target)) or coercionFailure()
+    objValUnwrap(u')
+
+  -- there are variables, so get them out of u
+  [x,:vars] := vars
+  sup := SPADCALL(u,x,univariate)  -- this is a SUP P S
+  null sup =>           -- zero? unlikely.
+    domainZero(target)
+  -- degree 0 polynomial? (variable did not occur)
+  null(rest(sup)) and first(sup) is [ =0,:c] =>
+    -- call again, but with one less var
+    P2DmpAux(c,source,S,target,varlist,vars,T,univariate,plus,monom)
+  var := position1(x,varlist)
+  u' := domainZero(target)
+  for [e,:c] in sup repeat
+    u'' := SPADCALL(
+      P2DmpAux(c,source,S,target,varlist,vars,T,univariate,plus,monom),
+        var,e,monom)
+    u' := SPADCALL(u',u'',plus)
+  u'
+
+P2Mp(u, source is [., S], target is [., y, T]) ==
+  u = '_$fromCoerceable_$ =>
+    -- might be able to say yes
+    canCoerce(source,T)
+  univariate := getFunctionFromDomain('univariate,
+    source,[source,$Symbol])
+  P2MpAux(u,source,S,target,copy y,y,T,univariate)
+
+P2MpAux(u,source,S,target,varlist,vars,T,univariate) ==
+  u is [ =0,:c] =>       -- polynomial is a constant
+    (u' := coerceInt(objNewWrap(c,S),target)) or
+      coercionFailure()
+    objValUnwrap(u')
+
+  -- if no variables left, try to go to underdomain of target (T)
+  null vars =>
+    (u' := coerceInt(objNewWrap(u,source),T)) or
+      coercionFailure()
+    -- if successful, embed
+    [ 0,:objValUnwrap(u')]
+
+  -- there are variables, so get them out of u
+  [x,:vars] := vars
+  sup := SPADCALL(u,x,univariate)  -- this is a SUP P S
+  null sup =>           -- zero? unlikely.
+    domainZero(target)
+  -- degree 0 polynomial? (variable did not occur)
+  null(rest(sup)) and first(sup) is [ =0,:c] =>
+    -- call again, but with one less var
+    P2MpAux(c,source,S,target,varlist,vars,T,univariate)
+  terms := [[e,:P2MpAux(c,source,S,target,varlist,vars,T,univariate)] for
+    [e,:c] in sup]
+  [1, position1(x,varlist), :terms]
+
+varIsOnlyVarInPoly(u, var) ==
+  u is [ =1, v, :termlist] =>
+    v ^= var => nil
+    and/[varIsOnlyVarInPoly(c,var) for [e,:c] in termlist]
+  true
+
+P2Up(u,source is [.,S],target is [.,x,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,T)
+  u is [ =0,:c] =>
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+
+  -- see if the target var is the polynomial vars
+  varsFun := getFunctionFromDomain('variables,source,[source])
+  vars := SPADCALL(u,varsFun)
+  not member(x,vars) =>
+    (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure()
+    [[0,:objValUnwrap(u')]]
+
+  -- do a univariate to transform u to a UP(x,P S) and then coerce again
+  UPP := ['UnivariatePolynomial,x,source]
+  univariate := getFunctionFromDomain('univariate,
+    source,[source,$Symbol])
+  upU := SPADCALL(u,x,univariate)  -- we may assume this has type UPP
+  (u' := coerceInt(objNewWrap(upU,UPP),target)) or coercionFailure()
+  objValUnwrap(u')
+
+--% Fraction
+
+Qf2PF(u,source is [.,D],target) ==
+  u = '_$fromCoerceable_$ => canCoerce(D,target)
+  [num,:den] := u
+  num':= coerceInt(objNewWrap(num,D),target) or
+    coercionFailure()
+  num' := objValUnwrap num'
+  den':= coerceInt(objNewWrap(den,D),target) or
+    coercionFailure()
+  den' := objValUnwrap den'
+  equalZero(den', target) => throwKeyedMsg("S2IA0001",NIL)
+  SPADCALL(num',den', getFunctionFromDomain("/",target,[target,target]))
+
+Qf2F(u,source is [.,D,:.],target) ==
+  D = $Integer =>
+    u = '_$fromCoerceable_$ => true
+    Rn2F(u,source,target)
+  u = '_$fromCoerceable_$ => canCoerce(D,target)
+  [num,:den] := u
+  [.,:num']:= coerceInt(objNewWrap(num,D),target) or
+    coercionFailure()
+  [.,:den']:= coerceInt(objNewWrap(den,D),target) or
+    coercionFailure()
+  (unwrap num') * 1.0 / (unwrap den')
+
+Rn2F(rnum, source, target) ==
+  float(CAR(rnum)/CDR(rnum))
+
+-- next function is needed in RN algebra code
+--Rn2F([a,:b],source,target) ==
+--  al:=if LINTP a then QLENGTHCODE a else 4
+--  bl:=if LINTP b then QLENGTHCODE b else 4
+--  MAX(al,bl) < 36 => FLOAT a / FLOAT b
+--  sl:=0
+--  if al>32 then
+--     sl:=35*(al-32)/4
+--     a:=a/2**sl
+--  if bl>32 then
+--     sbl:=35*(bl-32)/4
+--     b:=b/2**sbl
+--     sl:=sl-sbl
+--  ans:=FLOAT a /FLOAT b
+--  sl=0 => ans
+--  ans*2**sl
+
+Qf2domain(u,source is [.,D],target) ==
+  -- tests whether it is an element of the underlying domain
+  useUnder := (ut := underDomainOf target) and canCoerce(source,ut)
+  u = '_$fromCoerceable_$ => useUnder
+  not (containsPolynomial(D) and containsPolynomial(target)) and
+    useUnder => coercionFailure()    -- let other mechanism handle it
+  [num, :den] := u
+  (num' := coerceInt(objNewWrap(num,D),target)) or coercionFailure()
+  num' := objValUnwrap(num')
+  equalOne(den,D) => num'
+  (target is [.,[=$QuotientField,T]]) or
+    (target is [.,.,[=$QuotientField,T]]) =>
+      (den' := coerceInt(objNewWrap(den,D),T)) or coercionFailure()
+      den' := [domainOne(T),:objValUnwrap(den')]
+      timesfunc:= getFunctionFromDomain('_*,target,
+        [[$QuotientField,T],target])
+      SPADCALL(den',num',timesfunc)
+  coercionFailure()
+
+Qf2EF(u,[.,S],target) ==
+  u = '_$fromCoerceable_$ => canCoerce(S,target)
+  [num,:den] := u
+  (num' := coerceInt(objNewWrap(num,S),target)) or
+    coercionFailure()
+  (den' := coerceInt(objNewWrap(den,S),target)) or
+    coercionFailure()
+  divfun := getFunctionFromDomain("/",target,[target,target])
+  SPADCALL(objValUnwrap(num'),objValUnwrap(den'),divfun)
+
+Qf2Qf(u0,[.,S],target is [.,T]) ==
+  u0 = '_$fromCoerceable_$ =>
+    S = ['Polynomial, [$QuotientField, $Integer]] and
+      T = '(Polynomial (Integer)) => true
+    canCoerce(S,T)
+  [a,:b] := u0
+  S = ['Polynomial, [$QuotientField, $Integer]] and
+    T = '(Polynomial (Integer)) =>
+      (a' := coerceInt(objNewWrap(a,S),target)) =>
+        (b' := coerceInt(objNewWrap(b,S),target)) =>
+          divfunc:= getFunctionFromDomain('_/,target,[target,target])
+          SPADCALL(objValUnwrap(a'),objValUnwrap(b'),divfunc)
+        coercionFailure()
+      coercionFailure()
+  (a' := coerceInt(objNewWrap(a,S),T)) =>
+    (b' := coerceInt(objNewWrap(b,S),T)) =>
+      [objValUnwrap(a'),:objValUnwrap(b')]
+    coercionFailure()
+  coercionFailure()
+
+-- partOf(x,i) ==
+--   VECP x => x.i
+--   i=0 => first x
+--   i=1 => rest x
+--   systemError '"partOf"
+
+--% RectangularMatrix
+
+Rm2L(x,[.,.,.,R],target) == M2L(x,['Matrix,R],target)
+
+Rm2M(x,[.,.,.,R],target is [.,S]) == M2M(x,[nil,R],target)
+
+Rm2Sm(x,[.,n,m,S],[.,p,R]) ==
+  x = '_$fromCoerceable_$ => n=m and m=p and canCoerce(S,R)
+  n=m and m=p =>
+    M2M(x,[nil,S],[nil,R])
+  coercionFailure()
+
+Rm2V(x,[.,.,.,R],target) == M2V(x,['Matrix,R],target)
+
+--% Script
+
+Scr2Scr(u, source is [.,S], target is [.,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(S,T)
+  null (v := coerceInt(objNewWrap(CDR u,S),T)) =>
+    coercionFailure()
+  [CAR u, :objValUnwrap(v)]
+
+--% SparseUnivariatePolynomialnimial
+
+SUP2Up(u,source is [.,S],target is [.,x,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,T) or canCoerce(S,T)
+  null u => u
+  S = T => u
+  -- try to go underneath first
+  null (u' := coerceInt(objNewWrap(u,source),T)) =>
+    -- must be careful in case any of the coeffs come back 0
+    u' := NIL
+    zero := getConstantFromDomain('(Zero),T)
+    for [e,:c] in u repeat
+      c' := objValUnwrap (coerceInt(objNewWrap(c,S),T) or
+        coercionFailure())
+      c' = zero => 'iterate
+      u' := [[e,:c'],:u']
+    nreverse u'
+  [[0,:objValUnwrap u']]
+
+--% SquareMatrix
+
+Sm2L(x,[.,.,R],target) == M2L(x,['Matrix,R],target)
+
+Sm2M(x,[.,n,R],target is [.,S]) == M2M(x,[nil,R],target)
+
+Sm2PolyType(u,source is [sm,n,S], target is [pol,vl,T]) ==
+  -- only really handles cases like:
+  --      SM[2] P I -> P[x,y] SM[2] P I
+  -- works for UP, MP, DMP and NDMP
+  u = '_$fromCoerceable_$ => canCoerce(source,T)
+  -- first want to check case S is Polynomial
+  S is ['Polynomial,S'] =>
+    -- check to see if variable occurs in any of the terms
+    if ATOM vl
+      then vl' := [vl]
+      else vl' := vl
+    novars := true
+    for i in 0..(n-1) while novars repeat
+      for j in 0..(n-1) while novars repeat
+        varsUsed := varsInPoly u.i.j
+        or/[member(x,varsUsed) for x in vl'] => novars := nil
+    novars => coercionFailure()
+    source' := [sm,n,[pol,vl,S]]
+    null (u' := coerceInt(objNewWrap(u,source),source')) =>
+      coercionFailure()
+    null (u' := coerceInt(u',target)) =>
+      coercionFailure()
+    objValUnwrap(u')
+  -- let other cases be handled by standard machinery
+  coercionFailure()
+
+Sm2Rm(x,[.,n,R],[.,p,q,S]) ==
+  x = '_$fromCoerceable_$ => p=q and p=n and canCoerce(R,S)
+  p=q and p=n =>
+    M2M(x,[nil,R],[nil,S])
+  coercionFailure()
+
+Sm2V(x,[.,.,R],target) == M2V(x,['Matrix,R],target)
+
+--% Symbol
+
+Sy2OV(u,source,target is [.,vl]) ==
+  u = '_$fromCoerceable_$ => nil
+  position1(u,vl)
+
+Sy2Dmp(u,source,target is [dmp,vl,S]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,S)
+  len:= #vl
+  -1^=(n:= position(u,vl)) =>
+    u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1]
+    objValUnwrap(coerceInt(objNew(u,[dmp,vl,$Integer]),target))
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[Zeros len,:objValUnwrap u]]
+
+Sy2Mp(u,source,target is [mp,vl,S]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,S)
+  (n:= position1(u,vl)) ^= 0 =>
+    [1,n,[1,0,:domainOne(S)]]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [0,:objValUnwrap(u)]
+
+Sy2NDmp(u,source,target is [ndmp,vl,S]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,S)
+  len:= #vl
+  -1^=(n:= position(u,vl)) =>
+    u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1]
+    objValUnwrap(coerceInt(objNew(u,[ndmp,vl,$Integer]),target))
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[Zeros len,:objValUnwrap(u)]]
+
+Sy2P(u,source,target is [poly,S]) ==
+  u = '_$fromCoerceable_$ => true
+  -- first try to get it into an underdomain
+  if (S ^= $Integer) then
+    u' := coerceInt(objNewWrap(u,source),S)
+    if u' then return [0,:objValUnwrap(u')]
+  -- if that failed, return it as a polynomial variable
+  [1,u,[1,0,:domainOne(S)]]
+
+Sy2Up(u,source,target is [up,x,S]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,S)
+  u=x => [[1,:domainOne(S)]]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[0,:objValUnwrap u]]
+
+Sy2Var(u,source,target is [.,x]) ==
+  u = '_$fromCoerceable_$ => NIL
+  u=x => u
+  coercionFailure()
+
+--% Univariate Polynomial
+
+Up2Dmp(u,source is ['UnivariatePolynomial,var,S],
+ target is ['DistributedMultivariatePolynomial,vl,T]) ==
+  -- var must be a member of vl, or u is a constant
+  u = '_$fromCoerceable_$ => member(var,vl) and canCoerce(S,target)
+  null u => domainZero(target)
+  u is [[e,:c]] and e=0 =>
+    z:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(z)
+    coercionFailure()
+  member(var,vl) =>
+    x:= domainZero(target)
+    one:= domainOne(T)
+    plusfunc:= getFunctionFromDomain('_+,target,[target,target])
+    multfunc:= getFunctionFromDomain('_*,target,[target,target])
+    n:= #vl ; p:= POSN1(var,vl)
+    l1:= not (p=0) and [0 for m in 1..p]
+    l2:= not (p=n-1) and [0 for m in p..n-2]
+    for [e,:c] in u until not z repeat
+      z:= coerceInt(objNewWrap(c,S),target) =>
+        y:= SPADCALL(objValUnwrap(z),
+          [[LIST2VEC [:l1,e,:l2],:one]],multfunc)
+        x:= SPADCALL(x,y,plusfunc)
+    z => x
+    coercionFailure()
+  coercionFailure()
+
+Up2Expr(u,source is [up,var,S], target is [Expr,T]) ==
+    u = '_$fromCoerceable_$ => canCoerce(S, target)
+
+    null u => domainZero(target)
+
+    u is [[e,:c]] and e=0 =>
+        (z := coerceInt(objNewWrap(c, S), target)) => objValUnwrap(z)
+        coercionFailure()
+
+    sym := objValUnwrap coerceInt(objNewWrap(var, $Symbol), target)
+
+    plus := getFunctionFromDomain("+",  target, [target, target])
+    mult := getFunctionFromDomain("*",  target, [target, target])
+    expn := getFunctionFromDomain("**", target, [target, $Integer])
+
+    -- coerce via Horner's rule
+
+    [e1, :c1] := first u
+    if not (S = target) then
+        not (c1 := coerceInt(objNewWrap(c1, S), target)) => coercionFailure()
+        c1 := objValUnwrap(c1)
+
+    for [e2, :c2] in rest u repeat
+        coef :=
+            e1 - e2 = 1 => sym
+            SPADCALL(sym, e1-e2, expn)
+        if not (S = target) then
+            not (c2 := coerceInt(objNewWrap(c2, S), target)) =>
+                coercionFailure()
+            c2 := objValUnwrap(c2)
+        coef := SPADCALL(SPADCALL(c1, coef, mult), c2, plus)
+        e1 := e2
+        c1 := coef
+
+    e1 = 0 => c1
+    e1 = 1 => SPADCALL(sym, c1, mult)
+    SPADCALL(SPADCALL(sym, e1, expn), c1, mult)
+
+Up2FR(u,S is [.,x,R],target is [.,T]) ==
+  u = '_$fromCoerceable_$ =>
+    S ^= T => nil
+    R in '((Integer) (Fraction (Integer))) => true
+    nil
+  S ^= T => coercionFailure()
+  package :=
+    R = $Integer => ['UnivariateFactorize,S]
+    R = $RationalNumber => package := ['RationalFactorize,S]
+    coercionFailure()
+  factor := getFunctionFromDomain('factor,package,[S])
+  SPADCALL(u,factor)
+
+Up2Mp(u,source is [.,x,S], target is [.,vl,T]) ==
+  u = '_$fromCoerceable_$ =>
+    member(x,vl) => canCoerce(S,T)
+    canCoerce(source,T)
+
+  null u => domainZero(target)
+
+  null(rest(u)) and (first(u) is [e,:c]) and e=0 =>
+    x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x)
+    coercionFailure()
+
+  null member(x,vl) =>
+    (x := coerceInt(objNewWrap(u,source),T)) or coercionFailure()
+    [0,:objValUnwrap(x)]
+
+  plus  := getFunctionFromDomain('_+,target,[target,target])
+  monom := getFunctionFromDomain('monomial,target,
+    [target,['OrderedVariableList,vl],$NonNegativeInteger])
+  sum := domainZero(target)
+  pos := position1(x,vl)
+
+  for [e,:c] in u repeat
+    (p := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    mon := SPADCALL(objValUnwrap(p),pos,e,monom)
+    sum := SPADCALL(sum,mon,plus)
+  sum
+
+Up2P(u,source is [.,var,S],target is [.,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(S,target)
+  null u => domainZero(target)
+  u is [[e,:c]] and e=0 =>
+    x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x)
+    coercionFailure()
+  pol:= domainZero(target)
+  one:= domainOne(T)
+  plusfunc := getFunctionFromDomain("+",target,[target,target])
+  multfunc := getFunctionFromDomain("*",target,[target,target])
+  for [e,:c] in u until not x repeat
+    x:= coerceInt(objNewWrap(c,S),target) =>
+      term:= SPADCALL([1,var,[e,0,:one]],objValUnwrap(x),multfunc)
+      pol:= SPADCALL(pol,term,plusfunc)
+    coercionFailure()
+  x => pol
+  coercionFailure()
+
+Up2SUP(u,source is [.,x,S],target is [.,T]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,T) or canCoerce(S,T)
+  null u => u
+  S = T => u
+  -- try to go underneath first
+  null (u' := coerceInt(objNewWrap(u,source),T)) =>
+    u' := NIL
+    zero := getConstantFromDomain('(Zero),T)
+    for [e,:c] in u repeat
+      c' := objValUnwrap (coerceInt(objNewWrap(c,S),T) or
+        coercionFailure())
+      c' = zero => 'iterate
+      u' := [[e,:c'],:u']
+    nreverse u'
+  [[0,:objValUnwrap u']]
+
+Up2Up(u,source is [.,v1,S], target is [.,v2,T]) ==
+  -- if v1 = v2 then this is handled by coerceIntByMap
+  -- this only handles case where poly is a constant
+  u = '_$fromCoerceable_$ =>
+    v1=v2 => canCoerce(S,T)
+    canCoerce(source,T)
+  null u => u
+  u is [[e,:c]] and e=0 =>
+    x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x)
+    coercionFailure()
+  coercionFailure()
+
+insertAlist(a,b,l) ==
+  null l => [[a,:b]]
+  a = l.0.0 => (RPLAC(CDAR l,b);l)
+  _?ORDER(l.0.0,a) => [[a,:b],:l]
+  (fn(a,b,l);l) where fn(a,b,l) ==
+    null rest l => RPLAC(rest l,[[a,:b]])
+    a = l.1.0 => RPLAC(rest l.1,b)
+    _?ORDER(l.1.0,a) => RPLAC(rest l,[[a,:b],:rest l])
+    fn(a,b,rest l)
+
+--% Union
+
+Un2E(x,source,target) ==
+  ['Union,:branches] := source
+  x = '_$fromCoerceable_$ =>
+    and/[canCoerce(t, target) for t in branches | ^ STRINGP t]
+  coerceUn2E(x,source)
+
+--% Variable
+
+Var2OV(u,source,target is [.,vl]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => member(sym,vl)
+  member(sym,vl) => position1(sym,vl)
+  coercionFailure()
+
+Var2Dmp(u,source,target is [dmp,vl,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S)
+
+  len := #vl
+  -1 ^= (n:= position(sym,vl)) =>
+    LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],
+      :getConstantFromDomain('(One),S)]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[Zeros len,:objValUnwrap u]]
+
+Var2Gdmp(u,source,target is [dmp,vl,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S)
+
+  len := #vl
+  -1 ^= (n:= position(sym,vl)) =>
+    LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],
+      :getConstantFromDomain('(One),S)]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[Zeros len,:objValUnwrap u]]
+
+Var2Mp(u,source,target is [mp,vl,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S)
+  (n:= position1(u,vl)) ^= 0 =>
+    [1,n,[1,0,:getConstantFromDomain('(One),S)]]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [0,:objValUnwrap u]
+
+Var2NDmp(u,source,target is [ndmp,vl,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S)
+
+  len:= #vl
+  -1^=(n:= position(u,vl)) =>
+    LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],
+      :getConstantFromDomain('(One),S)]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[Zeros len,:objValUnwrap(u)]]
+
+Var2P(u,source,target is [poly,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => true
+
+  -- first try to get it into an underdomain
+  if (S ^= $Integer) then
+    u' := coerceInt(objNewWrap(u,source),S)
+    if u' then return [0,:objValUnwrap(u')]
+  -- if that failed, return it as a polynomial variable
+  [1,sym,[1,0,:getConstantFromDomain('(One),S)]]
+
+Var2QF(u,source,target is [qf,S]) ==
+  u = '_$fromCoerceable_$ => canCoerce(source,S)
+
+  S = $Integer => coercionFailure()
+  sym := CADR source
+  (u' := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [objValUnwrap u',:getConstantFromDomain('(One),S)]
+
+Var2FS(u,source,target is [fs,S]) ==
+  u = '_$fromCoerceable_$ => true
+  (v := coerceInt(objNewWrap(u,source),['Polynomial,S])) or
+    coercionFailure()
+  (v := coerceInt(v,target)) or coercionFailure()
+  objValUnwrap v
+
+Var2Up(u,source,target is [up,x,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S)
+
+  x=sym => [[1,:getConstantFromDomain('(One),S)]]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[0,:objValUnwrap u]]
+
+Var2SUP(u,source,target is [sup,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => (sym = "?") or canCoerce(source,S)
+
+  sym = "?" => [[1,:getConstantFromDomain('(One),S)]]
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  [[0,:objValUnwrap u]]
+
+Var2UpS(u,source,target is [ups,x,S]) ==
+  sym := CADR source
+  u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S)
+
+  mid := ['UnivariatePolynomial,x,S]
+  x = sym =>
+    u := Var2Up(u,source,mid)
+    (u := coerceInt(objNewWrap(u,mid),target)) or coercionFailure()
+    objValUnwrap u
+  (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure()
+  (u := coerceInt(u,target)) or coercionFailure()
+  objValUnwrap u
+
+Var2OtherPS(u,source,target is [.,x,S]) ==
+  sym := CADR source
+  mid := ['UnivariatePowerSeries,x,S]
+  u = '_$fromCoerceable_$ =>
+    (sym = x) or (canCoerce(source,mid) and canCoerce(mid,target))
+  u := Var2UpS(u,source,mid)
+  (u := coerceInt(objNewWrap(u,mid),target)) or coercionFailure()
+  objValUnwrap u
+
+--% Vector
+
+V2M(u,[.,D],[.,R]) ==
+  u = '_$fromCoerceable_$ =>
+    D is ['Vector,:.] => nil  -- don't have data
+    canCoerce(D,R)
+  -- first see if we are coercing a vector of vectors
+  D is ['Vector,E] and
+    isRectangularVector(u,MAXINDEX u,MAXINDEX u.0) =>
+      LIST2VEC
+        [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R))
+           for j in 0..MAXINDEX(x:=u.i)] for i in 0..MAXINDEX u]
+  -- if not, try making it into a 1 by n matrix
+  coercionFailure()
+--LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(u.i,D),R))
+--  for i in 0..MAXINDEX(u)]]
+
+V2Rm(u,[.,D],[.,n,m,R]) ==
+  u = '_$fromCoerceable_$ => nil
+  D is [.,E,:.] and isRectangularVector(u,n-1,m-1) =>
+    LIST2VEC
+      [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R))
+         for j in 0..MAXINDEX(x:=u.i)] for i in 0..MAXINDEX u]
+  coercionFailure()
+
+V2Sm(u,[.,D],[.,n,R]) ==
+  u = '_$fromCoerceable_$ => nil
+  D is [.,E,:.] and isRectangularVector(u,n-1,n-1) =>
+    LIST2VEC
+      [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R))
+         for j in 0..MAXINDEX(x:=u.i)] for i in 0..MAXINDEX u]
+  coercionFailure()
+
+isRectangularVector(x,p,q) ==
+  MAXINDEX x = p =>
+    and/[q=MAXINDEX x.i for i in 0..p]
+
+-- Polynomial and Expression to Univariate series types
+
+P2Uts(u, source, target) ==
+  P2Us(u,source, target, 'taylor)
+
+P2Uls(u, source, target) ==
+  P2Us(u,source, target, 'laurent)
+
+P2Upxs(u, source, target) ==
+  P2Us(u,source, target, 'puiseux)
+
+P2Us(u, source is [.,S], target is [.,T,var,cen], type) ==
+  u = '_$fromCoerceable_$ =>
+    -- might be able to say yes
+    canCoerce(S,T)
+  T isnt ['Expression, :.] => coercionFailure()
+  if S ^= '(Float) then S := $Integer
+  obj := objNewWrap(u, source)
+  E := ['Expression, S]
+  newU := coerceInt(obj, E)
+  null newU => coercionFailure()
+  EQtype := ['Equation, E]
+  eqfun := getFunctionFromDomain('_=, EQtype, [E,E])
+  varE := coerceInt(objNewWrap(var, '(Symbol)), E)
+  null varE => coercionFailure()
+  cenE := coerceInt(objNewWrap(cen, T), E)
+  null cenE => coercionFailure()
+  eq := SPADCALL(objValUnwrap(varE), objValUnwrap(cenE), eqfun)
+  package := ['ExpressionToUnivariatePowerSeries, S, E]
+  func := getFunctionFromDomain(type, package, [E, EQtype])
+  newObj := SPADCALL(objValUnwrap(newU), eq, func)
+  newType := CAR newObj
+  newVal  := CDR newObj
+  newType = target => newVal
+  finalObj := coerceInt(objNewWrap(newVal, newType), target)
+  null finalObj => coercionFailure()
+  objValUnwrap finalObj
+
+
+--% General Coercion Commutation Functions
+
+-- general commutation functions are called with 5 values
+--     u           object of type source
+--     source      type of u
+--     S           underdomain of source
+--     target      coercion target type
+--     T           underdomain of T
+-- Because of checking, can always assume S and T have underdomains.
+
+--% Complex
+
+commuteComplex(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ =>
+    canCoerce(S,target) and canCoerce(T,target)
+  [real,:imag] := u
+  (real := coerceInt(objNewWrap(real,S),target)) or coercionFailure()
+  (imag := coerceInt(objNewWrap(imag,S),target)) or coercionFailure()
+  T' := underDomainOf T
+  i := [domainZero(T'),
+       :domainOne(T')]
+  (i := coerceInt(objNewWrap(i,T),target)) or coercionFailure()
+  f := getFunctionFromDomain("*",target,[target,target])
+  i := SPADCALL(objValUnwrap i, objValUnwrap imag, f)
+  f := getFunctionFromDomain("+",target,[target,target])
+  SPADCALL(objValUnwrap real,i,f)
+
+--% Quaternion
+
+commuteQuaternion(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ =>
+    canCoerce(S,target) and canCoerce(T,target)
+  c := [objValUnwrap(coerceInt(objNewWrap(x,S),target)
+    or coercionFailure()) for x in VEC2LIST u]
+  q := '(Quaternion (Integer))
+  e := [[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]
+  e := [(coerceInt(objNewWrap(LIST2VEC x,q),T)
+    or coercionFailure()) for x in e]
+  e :=[objValUnwrap(coerceInt(x,target) or coercionFailure()) for x in e]
+  u' := domainZero(target)
+  mult := getFunctionFromDomain("*",target,[target,target])
+  plus := getFunctionFromDomain("+",target,[target,target])
+  for x in c for y in e repeat
+    u' := SPADCALL(u',SPADCALL(x,y,mult),plus)
+  u'
+
+--% Fraction
+
+commuteFraction(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ =>
+    ofCategory(target,'(Field)) => canCoerce(S,target)
+    canCoerce(S,T) and canCoerce(T,target)
+  [n,:d] := u
+  ofCategory(target,'(Field)) =>
+    -- see if denominator can go over to target
+    (d' := coerceInt(objNewWrap(d,S),target)) or coercionFailure()
+    -- if so, try to invert it
+    inv := getFunctionFromDomain('inv,target,[target])
+    d' := SPADCALL(objValUnwrap d',inv)
+    -- now coerce to target
+    (n' := coerceInt(objNewWrap(n,S),target)) or coercionFailure()
+    multfunc := getFunctionFromDomain("*",target,[target,target])
+    SPADCALL(d',objValUnwrap n',multfunc)
+  -- see if denominator can go over to QF part of target
+  (d' := coerceInt(objNewWrap(d,S),T)) or coercionFailure()
+  -- if so, try to invert it
+  inv := getFunctionFromDomain('inv,T,[T])
+  d' := SPADCALL(objValUnwrap d',inv)
+  -- now coerce to target
+  (d' := coerceInt(objNewWrap(d',T),target)) or coercionFailure()
+  (n' := coerceInt(objNewWrap(n,S),target)) or coercionFailure()
+  multfunc := getFunctionFromDomain("*",target,[target,target])
+  SPADCALL(objValUnwrap d',objValUnwrap n',multfunc)
+
+--% SquareMatrix
+
+commuteSquareMatrix(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ =>
+    canCoerce(S,target) and canCoerce(T,target)
+  -- commuting matrices of matrices should be a no-op
+  S is ['SquareMatrix,:.] =>
+     source=target => u
+     coercionFailure()
+  u' := domainZero(target)
+  plusfunc := getFunctionFromDomain("+",target,[target,target])
+  multfunc := getFunctionFromDomain("*",target,[target,target])
+  zero := domainZero(S)
+  [sm,n,:.] := source
+  S' := [sm,n,$Integer]
+  for i in 0..(n-1) repeat
+    for j in 0..(n-1) repeat
+      (e := u.i.j) = zero => 'iterate
+      (e' := coerceInt(objNewWrap(e,S),target)) or coercionFailure()
+      (Eij := coerceInt(objNewWrap(makeEijSquareMatrix(i,j,n),S'),T)) or
+        coercionFailure()
+      (Eij := coerceInt(Eij,target)) or coercionFailure()
+      e' := SPADCALL(objValUnwrap(e'),objValUnwrap(Eij),multfunc)
+      u' := SPADCALL(e',u',plusfunc)
+  u'
+
+makeEijSquareMatrix(i, j, dim) ==
+  -- assume using 0 based scale, makes a dim by dim matrix with a
+  -- 1 in the i,j position, zeros elsewhere
+  LIST2VEC [LIST2VEC [((i=r) and (j=c) => 1; 0)
+    for c in 0..(dim-1)] for r in 0..(dim-1)]
+
+--% Univariate Polynomial and Sparse Univariate Polynomial
+
+commuteUnivariatePolynomial(u,source,S,target,T) ==
+  commuteSparseUnivariatePolynomial(u,source,S,target,T)
+
+commuteSparseUnivariatePolynomial(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ =>
+    canCoerce(S,target) and canCoerce(T,target)
+
+  u' := domainZero(target)
+  null u => u'
+
+  T'  := underDomainOf T
+  one := domainOne(T')
+  monom := getFunctionFromDomain('monomial,T,[T',$NonNegativeInteger])
+  plus  := getFunctionFromDomain("+",target,[target,target])
+  times := getFunctionFromDomain("*",target,[target,target])
+
+  for [e,:c] in u repeat
+    (c := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    m := SPADCALL(one,e,monom)
+    (m := coerceInt(objNewWrap(m,T),target)) or coercionFailure()
+    c := objValUnwrap c
+    m := objValUnwrap m
+    u' := SPADCALL(u',SPADCALL(c,m,times),plus)
+  u'
+
+--% Multivariate Polynomials
+
+commutePolynomial(u,source,S,target,T) ==
+  commuteMPolyCat(u,source,S,target,T)
+
+commuteMultivariatePolynomial(u,source,S,target,T) ==
+  commuteMPolyCat(u,source,S,target,T)
+
+commuteDistributedMultivariatePolynomial(u,source,S,target,T) ==
+  commuteMPolyCat(u,source,S,target,T)
+
+commuteNewDistributedMultivariatePolynomial(u,source,S,target,T) ==
+  commuteMPolyCat(u,source,S,target,T)
+
+commuteMPolyCat(u,source,S,target,T) ==
+  u = '_$fromCoerceable_$ => canCoerce(S,target)
+  -- check constant case
+  isconstfun := getFunctionFromDomain("ground?",source,[source])
+  SPADCALL(u,isconstfun) =>
+    constfun := getFunctionFromDomain("ground",source,[source])
+    c := SPADCALL(u,constfun)
+    (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure()
+    objValUnwrap(u')
+
+  lmfun := getFunctionFromDomain('leadingMonomial,source,[source])
+  lm := SPADCALL(u,lmfun)    -- has type source, is leading monom
+
+  lcfun := getFunctionFromDomain('leadingCoefficient,source,[source])
+  lc := SPADCALL(lm,lcfun)    -- has type S, is leading coef
+  (lc' := coerceInt(objNewWrap(lc,S),target)) or coercionFailure()
+
+  pmfun := getFunctionFromDomain('primitiveMonomials,source,[source])
+  lm := first SPADCALL(lm,pmfun) -- now we have removed the leading coef
+  (lm' := coerceInt(objNewWrap(lm,source),T)) or coercionFailure()
+  (lm' := coerceInt(lm',target)) or coercionFailure()
+
+  rdfun := getFunctionFromDomain('reductum,source,[source])
+  rd := SPADCALL(u,rdfun)    -- has type source, is reductum
+  (rd' := coerceInt(objNewWrap(rd,source),target)) or coercionFailure()
+
+  lc' := objValUnwrap lc'
+  lm' := objValUnwrap lm'
+  rd' := objValUnwrap rd'
+
+  plusfun := getFunctionFromDomain("+",target,[target,target])
+  multfun := getFunctionFromDomain("*",target,[target,target])
+  SPADCALL(SPADCALL(lc',lm',multfun),rd',plusfun)
+
+------------------------------------------------------------------------
+-- Format for alist member is:  domain  coercionType function
+--   here coercionType can be one of 'total, 'partial or 'indeterm
+--   (indeterminant - cannot tell in a simple way).
+--
+-- In terms of canCoerceFrom, 'total implies true, 'partial implies
+--   false (just cannot tell without actual data) and 'indeterm means
+--   to call the function with the data = "$fromCoerceable$" for a
+--   response of true or false.
+------------------------------------------------------------------------
+-- There are no entries here for RationalNumber or RationalFunction.
+-- These should have been changed to QF I and QF P, respectively, by
+-- a function like deconstructTower.  RSS 8-1-85
+------------------------------------------------------------------------
+
+SETANDFILEQ($CoerceTable, '(                                          _
+  (Complex . ( _
+    (Expression                       indeterm   Complex2Expr) _
+    (Factored                         indeterm   Complex2FR) _
+    (Integer                          partial    Complex2underDomain) _
+    (PrimeField                       partial    Complex2underDomain) _
+    ))_
+  (DirectProduct . (                                                  _
+    (DirectProduct                        partial    DP2DP)           _
+   ))                                                                 _
+  (DistributedMultivariatePolynomial . (                              _
+    (DistributedMultivariatePolynomial    indeterm   Dmp2Dmp) _
+    (Expression                           indeterm   Dmp2Expr) _
+    (Factored                             indeterm   Mp2FR) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   Dmp2NDmp) _
+    (MultivariatePolynomial               indeterm   Dmp2Mp) _
+    (Polynomial                           indeterm   Dmp2P) _
+    (UnivariatePolynomial                 indeterm   Dmp2Up) _
+    ))_
+  (Expression . (
+    (Complex                                         partial    Expr2Complex) _
+    (DistributedMultivariatePolynomial               indeterm   Expr2Dmp) _
+    (HomogeneousDistributedMultivariatePolynomial    indeterm   Expr2Dmp) _
+    (MultivariatePolynomial                          indeterm   Expr2Mp) _
+    (UnivariateLaurentSeries                         indeterm   P2Uls) _
+    (UnivariatePolynomial                            indeterm   Expr2Up) _
+    (UnivariatePuiseuxSeries                         indeterm   P2Upxs) _
+    (UnivariateTaylorSeries                          indeterm   P2Uts) _
+    )) _
+
+  (Kernel . ( _
+    (Kernel                                          indeterm   Ker2Ker) _
+    (Expression                                      indeterm   Ker2Expr) _
+     )) _
+
+  (Factored . ( _
+    (Factored                             indeterm   Factored2Factored) _
+    ))_
+  (Fraction . ( _
+    (DistributedMultivariatePolynomial    partial    Qf2domain) _
+    (ElementaryFunction                   indeterm   Qf2EF) _
+    (Expression                           indeterm   Qf2EF) _
+    (Fraction                             indeterm   Qf2Qf) _
+    (HomogeneousDistributedMultivariatePolynomial partial    Qf2domain) _
+    (Integer                              partial    Qf2domain) _
+    (MultivariatePolynomial               partial    Qf2domain) _
+    (Polynomial                           partial    Qf2domain) _
+    (PrimeField                           indeterm   Qf2PF) _
+    (UnivariateLaurentSeries              indeterm   P2Uls) _
+    (UnivariatePolynomial                 partial    Qf2domain) _
+    (UnivariatePuiseuxSeries              indeterm   P2Upxs) _
+    (UnivariateTaylorSeries               indeterm   P2Uts) _
+    ))_
+  (Int . ( _
+    (Expression                           total      ncI2E) _
+    (Integer                              total      ncI2I) _
+  ))_
+  (Baby . ( _
+    (Expression                           total      ncI2E) _
+    (Integer                              total      ncI2I) _
+  ))_
+  (Integer . ( _
+    (Baby                                 total      I2ncI) _
+    (EvenInteger                          partial    I2EI) _
+    (Int                                  total      I2ncI) _
+    (NonNegativeInteger                   partial    I2NNI) _
+    (OddInteger                           partial    I2OI) _
+    (PositiveInteger                      partial    I2PI) _
+    ))_
+  (List . ( _
+    (DirectProduct                        indeterm   L2DP) _
+    (Matrix                               partial    L2M) _
+    (Record                               partial    L2Record) _
+    (RectangularMatrix                    partial    L2Rm) _
+    (Set                                  indeterm   L2Set) _
+    (SquareMatrix                         partial    L2Sm) _
+    (Stream                               indeterm   Agg2Agg) _
+    (Tuple                                indeterm   L2Tuple) _
+    (Vector                               indeterm   L2V) _
+    ))_
+  ))
+
+SETANDFILEQ($CoerceTable,NCONC($CoerceTable,'( _
+  (Matrix . ( _
+    (List                                 indeterm   M2L) _
+    (RectangularMatrix                    partial    M2Rm) _
+    (SquareMatrix                         partial    M2Sm) _
+    (Vector                               indeterm   M2L) _
+    ))_
+  (MultivariatePolynomial . ( _
+    (DistributedMultivariatePolynomial    indeterm   Mp2Dmp) _
+    (Expression                           indeterm   Mp2Expr) _
+    (Factored                             indeterm   Mp2FR) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   domain2NDmp) _
+    (MultivariatePolynomial               indeterm   Mp2Mp) _
+    (Polynomial                           indeterm   Mp2P) _
+    (UnivariatePolynomial                 indeterm   Mp2Up) _
+    ))_
+  (HomogeneousDirectProduct . ( _
+    (HomogeneousDirectProduct             indeterm   DP2DP) _
+   ))_
+  (HomogeneousDistributedMultivariatePolynomial . ( _
+    (Complex                              indeterm   NDmp2domain) _
+    (DistributedMultivariatePolynomial    indeterm   NDmp2domain) _
+    (Expression                           indeterm   Dmp2Expr) _
+    (Factored                             indeterm   Mp2FR) _
+    (Fraction                             indeterm   NDmp2domain) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   NDmp2NDmp) _
+    (MultivariatePolynomial               indeterm   NDmp2domain) _
+    (Polynomial                           indeterm   NDmp2domain) _
+    (Quaternion                           indeterm   NDmp2domain) _
+    (UnivariatePolynomial                 indeterm   NDmp2domain) _
+    ))_
+  (OrderedVariableList . ( _
+    (DistributedMultivariatePolynomial    indeterm   OV2poly) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   OV2poly) _
+    (MultivariatePolynomial               indeterm   OV2poly) _
+    (OrderedVariableList                  indeterm   OV2OV) _
+    (Polynomial                           total      OV2P) _
+    (Symbol                               total      OV2Sy) _
+    (UnivariatePolynomial                 indeterm   OV2poly) _
+    ))_
+  (Polynomial . ( _
+    (DistributedMultivariatePolynomial    indeterm   P2Dmp) _
+    (Expression                           indeterm   P2Expr) _
+    (Factored                             indeterm   P2FR) _
+    (HomogeneousDistributedMultivariatePolynomial partial    domain2NDmp) _
+    (MultivariatePolynomial               indeterm   P2Mp) _
+    (UnivariateLaurentSeries              indeterm   P2Uls) _
+    (UnivariatePolynomial                 indeterm   P2Up) _
+    (UnivariatePuiseuxSeries              indeterm   P2Upxs) _
+    (UnivariateTaylorSeries               indeterm   P2Uts) _
+    ))_
+  (Set . ( _
+    (List                                 indeterm   Set2L) _
+    (Vector                               indeterm   Agg2L2Agg) _
+    ))_
+  (RectangularMatrix . ( _
+    (List                                 indeterm   Rm2L) _
+    (Matrix                               indeterm   Rm2M) _
+    (SquareMatrix                         indeterm   Rm2Sm) _
+    (Vector                               indeterm   Rm2V) _
+    ))_
+  (SparseUnivariatePolynomial . ( _
+    (UnivariatePolynomial                       indeterm   SUP2Up) _
+    ))_
+  (SquareMatrix . (
+    -- ones for polys needed for M[2] P I -> P[x,y] M[2] P I, say
+    (DistributedMultivariatePolynomial            partial    Sm2PolyType) _
+    (HomogeneousDistributedMultivariatePolynomial partial    Sm2PolyType) _
+    (List                                         indeterm   Sm2L) _
+    (Matrix                                       indeterm   Sm2M) _
+    (MultivariatePolynomial                       partial    Sm2PolyType) _
+    (RectangularMatrix                            indeterm   Sm2Rm) _
+    (UnivariatePolynomial                         indeterm   Sm2PolyType) _
+    (Vector                                       indeterm   Sm2V) _
+    ) ) _
+  (Symbol . ( _
+    (DistributedMultivariatePolynomial            indeterm   Sy2Dmp) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   Sy2NDmp) _
+    (MultivariatePolynomial                       indeterm   Sy2Mp) _
+    (OrderedVariableList                          partial    Sy2OV) _
+    (Polynomial                                   total      Sy2P) _
+    (UnivariatePolynomial                         indeterm   Sy2Up) _
+    (Variable                                     indeterm   Sy2Var) _
+    ) ) _
+  (UnivariatePolynomial . ( _
+    (DistributedMultivariatePolynomial            indeterm   Up2Dmp) _
+    (Expression                                   indeterm   Up2Expr) _
+    (Factored                                     indeterm   Up2FR) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   domain2NDmp) _
+    (MultivariatePolynomial                       indeterm   Up2Mp) _
+    (Polynomial                                   indeterm   Up2P) _
+    (SparseUnivariatePolynomial                   indeterm   Up2SUP) _
+    (UnivariatePolynomial                         indeterm   Up2Up) _
+    ) ) _
+  (Variable . ( _
+    (AlgebraicFunction                            total      Var2FS) _
+    (ContinuedFractionPowerSeries                 indeterm   Var2OtherPS) _
+    (DistributedMultivariatePolynomial            indeterm   Var2Dmp) _
+    (ElementaryFunction                           total      Var2FS) _
+    (Fraction                                     indeterm   Var2QF) _
+    (FunctionalExpression                         total      Var2FS) _
+    (GeneralDistributedMultivariatePolynomial     indeterm   Var2Gdmp) _
+    (HomogeneousDistributedMultivariatePolynomial indeterm   Var2NDmp) _
+    (LiouvillianFunction                          total      Var2FS) _
+    (MultivariatePolynomial                       indeterm   Var2Mp) _
+    (OrderedVariableList                          indeterm   Var2OV) _
+    (Polynomial                                   total      Var2P) _
+    (SparseUnivariatePolynomial                   indeterm   Var2SUP) _
+    (Symbol                                       total      Identity) _
+    (UnivariatePolynomial                         indeterm   Var2Up) _
+    (UnivariatePowerSeries                        indeterm   Var2UpS) _
+    ) ) _
+  (Vector . ( _
+    (DirectProduct                        indeterm   V2DP) _
+    (List                                 indeterm   V2L) _
+    (Matrix                               indeterm   V2M) _
+    (RectangularMatrix                    indeterm   V2Rm) _
+    (Set                                  indeterm   Agg2L2Agg) _
+    (SquareMatrix                         indeterm   V2Sm) _
+    (Stream                               indeterm   Agg2Agg) _
+    ) ) _
+  ) ) )
+
+-- this list is too long for the parser, so it has to be split into parts
+-- specifies the commute functions
+-- commute stands for partial commute function
+--SETANDFILEQ($CommuteTable, '(                                           _
+--  (DistributedMultivariatePolynomial . (                                _
+--    (DistributedMultivariatePolynomial    commute    commuteMultPol)    _
+--    (Complex                              commute    commuteMultPol)    _
+--    (MultivariatePolynomial               commute    commuteMultPol)    _
+--    (NewDistributedMultivariatePolynomial commute    commuteMultPol)    _
+--    (Polynomial                           commute    commuteMultPol)    _
+--    (Quaternion                           commute    commuteMultPol)    _
+--    (Fraction                             commute    commuteMultPol)    _
+--    (SquareMatrix                         commute    commuteMultPol)    _
+--    (UnivariatePolynomial                 commute    commuteMultPol)    _
+--    ))                                                                  _
+--  (Complex . (                                                         _
+--    (DistributedMultivariatePolynomial    commute    commuteG2)         _
+--    (MultivariatePolynomial               commute    commuteG2)         _
+--    (NewDistributedMultivariatePolynomial commute    commuteG2)         _
+--    (Polynomial                           commute    commuteG1)         _
+--    (Fraction                             commute    commuteG1)         _
+--    (SquareMatrix                         commute    commuteG2)         _
+--    (UnivariatePolynomial                 commute    commuteG2)         _
+--    ))                                                                  _
+--  (MultivariatePolynomial . (                                           _
+--    (DistributedMultivariatePolynomial    commute    commuteMultPol)    _
+--    (Complex                             commute    commuteMultPol)    _
+--    (MultivariatePolynomial               commute    commuteMultPol)    _
+--    (NewDistributedMultivariatePolynomial commute    commuteMultPol)    _
+--    (Polynomial                           commute    commuteMultPol)    _
+--    (Quaternion                           commute    commuteMultPol)    _
+--    (Fraction                        commute    commuteMultPol)    _
+--    (SquareMatrix                         commute    commuteMultPol)    _
+--    (UnivariatePolynomial                       commute    commuteMultPol)    _
+--    ))                                                                  _
+--  (Polynomial . (                                                       _
+--    (DistributedMultivariatePolynomial    commute    commuteMultPol)    _
+--    (Complex                              commute    commuteMultPol)    _
+--    (MultivariatePolynomial               commute    commuteMultPol)    _
+--    (NewDistributedMultivariatePolynomial commute    commuteMultPol)    _
+--    (Polynomial                           commute    commuteMultPol)    _
+--    (Quaternion                           commute    commuteMultPol)    _
+--    (Fraction                             commute    commuteMultPol)    _
+--    (SquareMatrix                         commute    commuteMultPol)    _
+--    (UnivariatePolynomial                 commute    commuteMultPol)    _
+--    ))                                                                  _
+--  (Quaternion . (                                                       _
+--    (DistributedMultivariatePolynomial    commute    commuteQuat2)      _
+--    (MultivariatePolynomial               commute    commuteQuat2)      _
+--    (NewDistributedMultivariatePolynomial commute    commuteQuat2)      _
+--    (Polynomial                           commute    commuteQuat1)      _
+--    (SquareMatrix                         commute    commuteQuat2)      _
+--    (UnivariatePolynomial                       commute    commuteQuat2)      _
+--    ))                                                                  _
+--  (SquareMatrix . (                                                     _
+--    (DistributedMultivariatePolynomial    commute    commuteSm2)        _
+--    (Complex                             commute    commuteSm1)        _
+--    (MultivariatePolynomial               commute    commuteSm2)        _
+--    (NewDistributedMultivariatePolynomial commute    commuteSm2)        _
+--    (Polynomial                           commute    commuteSm1)        _
+--    (Quaternion                           commute    commuteSm1)        _
+--    (SparseUnivariatePolynomial           commute    commuteSm1)        _
+--    (UnivariatePolynomial                 commute    commuteSm2)        _
+--    ))                                                                  _
+--  (UnivariatePolynomial . (                                                   _
+--    (DistributedMultivariatePolynomial    commute    commuteUp2)        _
+--    (Complex                              commute    commuteUp1)        _
+--    (MultivariatePolynomial               commute    commuteUp2)        _
+--    (NewDistributedMultivariatePolynomial commute    commuteUp2)        _
+--    (Polynomial                           commute    commuteUp1)        _
+--    (Quaternion                           commute    commuteUp1)        _
+--    (Fraction                        commute    commuteUp1)        _
+--    (SparseUnivariatePolynomial           commute    commuteUp1)        _
+--    (SquareMatrix                         commute    commuteUp2)        _
+--    (UnivariatePolynomial                 commute    commuteUp2)        _
+--    ))                                                                  _
+--  ))
+
+SETANDFILEQ($CommuteTable, '(                                           _
+  (Complex . (                                                         _
+    (DistributedMultivariatePolynomial    commute    commuteG2)         _
+    (MultivariatePolynomial               commute    commuteG2)         _
+    (HomogeneousDistributedMultivariatePolynomial commute    commuteG2) _
+    (Polynomial                           commute    commuteG1)         _
+    (Fraction                             commute    commuteG1)         _
+    (SquareMatrix                         commute    commuteG2)         _
+    (UnivariatePolynomial                 commute    commuteG2)         _
+    ))                                                                  _
+  (Polynomial . (                                                       _
+    (Complex                              commute    commuteMultPol)    _
+    (MultivariatePolynomial               commute    commuteMultPol)    _
+    (HomogeneousDistributedMultivariatePolynomial commute    commuteMultPol)_
+    (Polynomial                           commute    commuteMultPol)    _
+    (Quaternion                           commute    commuteMultPol)    _
+    (Fraction                             commute    commuteMultPol)    _
+    (SquareMatrix                         commute    commuteMultPol)    _
+    (UnivariatePolynomial                 commute    commuteMultPol)    _
+    ))                                                                  _
+  (SquareMatrix . (                                                     _
+    (DistributedMultivariatePolynomial    commute    commuteSm2)        _
+    (Complex                              commute    commuteSm1)        _
+    (MultivariatePolynomial               commute    commuteSm2)        _
+    (HomogeneousDistributedMultivariatePolynomial commute    commuteSm2)_
+    (Polynomial                           commute    commuteSm1)        _
+    (Quaternion                           commute    commuteSm1)        _
+    (SparseUnivariatePolynomial           commute    commuteSm1)        _
+    (UnivariatePolynomial                 commute    commuteSm2)        _
+    ))                                                                  _
+  ))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-eval.boot.pamphlet b/src/interp/i-eval.boot.pamphlet
new file mode 100644
index 00000000..0803bae7
--- /dev/null
+++ b/src/interp/i-eval.boot.pamphlet
@@ -0,0 +1,474 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-eval.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Constructor Evaluation
+
+$noEvalTypeMsg := nil
+
+evalDomain form ==
+  if $evalDomain then
+    sayMSG concat('"   instantiating","%b",prefix2String form,"%d")
+  startTimingProcess 'instantiation
+  newType? form => form
+  result := eval mkEvalable form
+  stopTimingProcess 'instantiation
+  result
+
+mkEvalable form ==
+  form is [op,:argl] =>
+    op="QUOTE" => form
+    op="WRAPPED" => mkEvalable devaluate argl
+    op="Record" => mkEvalableRecord form
+    op="Union"  => mkEvalableUnion  form
+    op="Mapping"=> mkEvalableMapping form
+    op="Enumeration" => form
+    loadIfNecessary op
+    kind:= GETDATABASE(op,'CONSTRUCTORKIND)
+    cosig := GETDATABASE(op, 'COSIG) =>
+      [op,:[val for x in argl for typeFlag in rest cosig]] where val ==
+        typeFlag =>
+          kind = 'category => MKQ x
+          VECP x => MKQ x
+          loadIfNecessary x
+          mkEvalable x
+        x is ['QUOTE,:.] => x
+        x is ['_#,y] => ['SIZE,MKQ y]
+        MKQ x
+    [op,:[mkEvalable x for x in argl]]
+  form=$EmptyMode => $Integer
+  IDENTP form and constructor?(form) => [form]
+  FBPIP form => BPINAME form
+  form
+
+mkEvalableMapping form ==
+  [first form,:[mkEvalable d for d in rest form]]
+
+mkEvalableRecord form ==
+  [first form,:[[":",n,mkEvalable d] for [":",n,d] in rest form]]
+
+mkEvalableUnion form ==
+  isTaggedUnion form =>
+    [first form,:[[":",n,mkEvalable d] for [":",n,d] in rest form]]
+  [first form,:[mkEvalable d for d in rest form]]
+
+evaluateType0 form ==
+  -- Takes a parsed, unabbreviated type and evaluates it, replacing
+  --  type valued variables with their values, and calling bottomUp
+  --  on non-type valued arguemnts to the constructor
+  --  and finally checking to see whether the type satisfies the
+  --  conditions of its modemap
+  -- However, the input might be an attribute, not a type
+  -- $noEvalTypeMsg: fluid := true
+  domain:= isDomainValuedVariable form => domain
+  form = $EmptyMode => form
+  form = "?"        => $EmptyMode
+  STRINGP form => form
+  form = "$" => form
+  $expandSegments : local := nil
+  form is ['typeOf,.] =>
+    form' := mkAtree form
+    bottomUp form'
+    objVal getValue(form')
+  form is [op,:argl] =>
+    op='CATEGORY =>
+      argl is [x,:sigs] => [op,x,:[evaluateSignature(s) for s in sigs]]
+      form
+    op in '(Join Mapping) =>
+      [op,:[evaluateType arg for arg in argl]]
+    op='Union  =>
+      argl and first argl is [x,.,.] and member(x,'(_: Declare)) =>
+        [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
+      [op,:[evaluateType arg for arg in argl]]
+    op='Record =>
+      [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
+    op='Enumeration => form
+    constructor? op => evaluateType1 form
+    NIL
+  constructor? form =>
+    ATOM form => evaluateType [form]
+    throwEvalTypeMsg("S2IE0003",[form,form])
+
+evaluateType form ==
+  -- Takes a parsed, unabbreviated type and evaluates it, replacing
+  --  type valued variables with their values, and calling bottomUp
+  --  on non-type valued arguemnts to the constructor
+  --  and finally checking to see whether the type satisfies the
+  --  conditions of its modemap
+  domain:= isDomainValuedVariable form => domain
+  form = $EmptyMode => form
+  form = "?"        => $EmptyMode
+  STRINGP form => form
+  form = "$" => form
+  $expandSegments : local := nil
+  form is ['typeOf,.] =>
+    form' := mkAtree form
+    bottomUp form'
+    objVal getValue(form')
+  form is [op,:argl] =>
+    op='CATEGORY =>
+      argl is [x,:sigs] => [op,x,:[evaluateSignature(s) for s in sigs]]
+      form
+    op in '(Join Mapping) =>
+      [op,:[evaluateType arg for arg in argl]]
+    op='Union  =>
+      argl and first argl is [x,.,.] and member(x,'(_: Declare)) =>
+        [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
+      [op,:[evaluateType arg for arg in argl]]
+    op='Record =>
+      [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
+    op='Enumeration => form
+    evaluateType1 form
+  constructor? form =>
+    ATOM form => evaluateType [form]
+    throwEvalTypeMsg("S2IE0003",[form,form])
+  throwEvalTypeMsg("S2IE0004",[form])
+
+evaluateType1 form ==
+  --evaluates the arguments passed to a constructor
+  [op,:argl]:= form
+  constructor? op =>
+    null (sig := getConstructorSignature form) =>
+       throwEvalTypeMsg("S2IE0005",[form])
+    [.,:ml] := sig
+    ml := replaceSharps(ml,form)
+    # argl ^= #ml => throwEvalTypeMsg("S2IE0003",[form,form])
+    for x in argl for m in ml for argnum in 1.. repeat
+      typeList := [v,:typeList] where v ==
+        categoryForm?(m) =>
+          m := evaluateType MSUBSTQ(x,'_$,m)
+          evalCategory(x' := (evaluateType x), m) => x'
+          throwEvalTypeMsg("S2IE0004",[form])
+        m := evaluateType m
+        GETDATABASE(opOf m,'CONSTRUCTORKIND) = 'domain and 
+            (tree := mkAtree x) and  putTarget(tree,m) and ((bottomUp tree) is [m1]) =>
+                [zt,:zv]:= z1:= getAndEvalConstructorArgument tree
+                (v:= coerceOrRetract(z1,m)) => objValUnwrap v
+                throwKeyedMsgCannotCoerceWithValue(zv,zt,m)
+        if x = $EmptyMode then x := $quadSymbol
+        throwEvalTypeMsg("S2IE0006",[makeOrdinal argnum,m,form])
+    [op,:NREVERSE typeList]
+  throwEvalTypeMsg("S2IE0007",[op])
+
+throwEvalTypeMsg(msg, args) ==
+  $noEvalTypeMsg => spadThrow()
+  throwKeyedMsg(msg, args)
+
+makeOrdinal i ==
+  ('(first second third fourth fifth sixth seventh eighth ninth tenth)).(i-1)
+
+evaluateSignature sig ==
+  -- calls evaluateType on a signature
+  sig is [ ='SIGNATURE,fun,sigl] =>
+    ['SIGNATURE,fun,
+      [(t = '_$ => t; evaluateType(t)) for t in sigl]]
+  sig
+
+--% Code Evaluation
+
+-- This code generates, then evaluates code during the bottom up phase
+-- of interpretation
+
+splitIntoBlocksOf200 a ==
+  null a => nil
+  [[first (r:=x) for x in tails a for i in 1..200],
+    :splitIntoBlocksOf200 rest r]
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+evalForm(op,opName,argl,mmS) ==
+  -- applies the first applicable function
+
+  for mm in mmS until form repeat
+    [sig,fun,cond]:= mm
+    (CAR sig) = 'interpOnly => form := CAR sig
+    #argl ^= #CDDR sig => 'skip ---> RDJ 6/95
+    form:=
+      $genValue or null cond =>
+        [getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL
+         for x in argl for t in CDDR sig]
+      [getArgValueComp2(x,t,c,sideEffectedArg?(t,sig,opName),opName) or return NIL
+        for x in argl for t in CDDR sig for c in cond]
+    form or null argl =>
+      dc:= CAR sig
+      form :=
+        dc='local => --[fun,:form]
+          atom fun =>
+            fun in $localVars => ['SPADCALL,:form,fun]
+            [fun,:form,NIL]
+          ['SPADCALL,:form,fun]
+        dc is ["__FreeFunction__",:freeFun] =>
+          ['SPADCALL,:form,freeFun]
+        fun is ['XLAM,xargs,:xbody] =>
+          rec :=  first form
+          xbody is [['RECORDELT,.,ind,len]] =>
+            optRECORDELT([CAAR xbody,rec,ind,len])
+          xbody is [['SETRECORDELT,.,ind,len,.]] =>
+            optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form])
+          xbody is [['RECORDCOPY,.,len]] =>
+            optRECORDCOPY([CAAR xbody,rec,len])
+          ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)]
+        dcVector := evalDomain dc
+        fun0 :=
+          newType? CAAR mm =>
+            mm' := first ncSigTransform mm
+            ncGetFunction(opName, first mm', rest mm')
+          NRTcompileEvalForm(opName,rest sig,dcVector)
+        null fun0 => throwKeyedMsg("S2IE0008",[opName])
+        [bpi,:domain] := fun0
+        EQ(bpi,function Undef) =>
+         sayKeyedMsg("S2IE0009",[opName,formatSignature CDR sig,CAR sig])
+         NIL
+        if $NRTmonitorIfTrue = true then
+          sayBrightlyNT ['"Applying ",first fun0,'" to:"]
+          pp [devaluateDeeply x for x in form]
+        _$:fluid := domain
+        ['SPADCALL, :form, fun0]
+  not form => nil
+--  not form => throwKeyedMsg("S2IE0008",[opName])
+  form='interpOnly => rewriteMap(op,opName,argl)
+  targetType := CADR sig
+  if CONTAINED('_#,targetType) then targetType := NRTtypeHack targetType
+  evalFormMkValue(op,form,targetType)
+
+sideEffectedArg?(t,sig,opName) ==
+  opString := SYMBOL_-NAME opName
+  (opName ^= 'setelt) and (ELT(opString, #opString-1) ^= char '_!) => nil
+  dc := first sig
+  t = dc
+
+getArgValue(a, t) ==
+  atom a and not VECP a =>
+    t' := coerceOrRetract(getBasicObject a,t)
+    t' and wrapped2Quote objVal t'
+  v := getArgValue1(a, t) => v
+  alt := altTypeOf(objMode getValue a, a, nil) =>
+    t' := coerceInt(getValue a, alt)
+    t' := coerceOrRetract(t',t)
+    t' and wrapped2Quote objVal t'
+  nil
+
+getArgValue1(a,t) ==
+  -- creates a value for a, coercing to t
+  t' := getValue(a) =>
+    (m := getMode a) and (m is ['Mapping,:ml]) and (m = t) and
+      objValUnwrap(t') is ['MAP,:.] =>
+        getMappingArgValue(a,t,m)
+    t' := coerceOrRetract(t',t)
+    t' and wrapped2Quote objVal t'
+  systemErrorHere '"getArgValue"
+
+getArgValue2(a,t,se?,opName) ==
+  se? and (objMode(getValue a) ^= t) =>
+    throwKeyedMsg("S2IE0013", [opName, objMode(getValue a), t])
+  getArgValue(a,t)
+
+getArgValueOrThrow(x, type) ==
+  getArgValue(x,type) or throwKeyedMsg("S2IC0007",[type])
+
+getMappingArgValue(a,t,m is ['Mapping,:ml]) ==
+  (una := getUnname a) in $localVars =>
+    $genValue =>
+      name := get(una,'name,$env)
+      a.0 := name
+      mmS := selectLocalMms(a,name,rest ml, nil)
+      or/[mm for mm in mmS |
+        (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
+      NIL
+    una
+  mmS := selectLocalMms(a,una,rest ml, nil)
+  or/[mm for mm in mmS |
+    (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
+  NIL
+
+getArgValueComp2(arg, type, cond, se?, opName) ==
+  se? and (objMode(getValue arg) ^= type) =>
+    throwKeyedMsg("S2IE0013", [opName, objMode(getValue arg), type])
+  getArgValueComp(arg, type, cond)
+
+getArgValueComp(arg,type,cond) ==
+  -- getArgValue for compiled case.  if there is a condition then
+  --  v must be data to verify that coerceInteractive succeeds.
+  v:= getArgValue(arg,type)
+  null v => nil
+  null cond => v
+  v is ['QUOTE,:.] or getBasicMode v => v
+  n := getUnnameIfCan arg
+  if num := isSharpVarWithNum n then
+    not $compilingMap => n := 'unknownVar
+    alias := get($mapName,'alias,$e)
+    n := alias.(num - 1)
+  keyedMsgCompFailure("S2IE0010",[n])
+
+evalFormMkValue(op,form,tm) ==
+  val:=
+    u:=
+      $genValue => wrap timedEVALFUN form
+      form
+    objNew(u,tm)
+--+
+  if $NRTmonitorIfTrue = true then
+    sayBrightlyNT ['"Value of ",op.0,'" ===> "]
+    pp unwrap u
+  putValue(op,val)
+  [tm]
+
+failCheck x ==
+  x = '"failed" =>
+    stopTimingProcess peekTimedName()
+    THROW('interpreter,objNewWrap('"failed",$String))
+  x = $coerceFailure =>
+    NIL
+  x
+
+--% Some Antique Comments About the Interpreter
+
+--EVAL BOOT contains the top level interface to the Scratchhpad-II
+--interpreter.  The Entry point into the interpreter from the parser is
+--processInteractive.
+--The type analysis algorithm is contained in the file BOTMUP BOOT,
+--and MODSEL boot,
+--the map handling routines are in MAP BOOT and NEWMAP BOOT, and
+--the interactive coerce routines are in COERCE BOOT and COERCEFN BOOT.
+--
+--Conventions:
+--    All spad values in the interpreter are passed around in triples.
+--    These are lists of three items: [value,mode,environment].  The value
+--    may be wrapped (this is a pair whose CAR is the atom WRAPPED and
+--    whose CDR is the value), which indicates that it is a real value,
+--    or unwrapped in which case it needs to be EVALed to produce the
+--    proper value.  The mode is the type of value, and should always be
+--    completely specified (not contain $EmptyMode).  The environment
+--    is always empty, and is included for historical reasons.
+--
+--Modemaps:
+--    Modemaps are descriptions of compiled Spad function which the
+--    interpreter uses to perform type analysis. They consist of patterns
+--    of types for the arguments, and conditions the types must satisfy
+--    for the function to apply.  For each function name there is a list
+--    of modemaps in file MODEMAP DATABASE for each distinct function with
+--    that name. The following is the list of the modemaps for "*"
+--    (multiplication. The first modemap (the one with the labels) is for
+--    module mltiplication which is multiplication of an element of a
+--    module by a member of its scalar domain.
+--
+--   This is the signature pattern for the modemap, it is of the form:
+--    (DomainOfComputation TargetType <ArgumentType ...>)
+--          |
+--          |                This is the predicate that needs to be
+--          |                 satisfied for the modemap to apply
+--          |                            |
+--          V                            |
+--     /-----------/                     |
+-- ( ( (*1 *1 *2 *1)                     V
+--       /-----------------------------------------------------------/
+--     ( (AND (ofCategory *1 (Module *2)) (ofCategory *2 (SimpleRing))) )
+--      . CATDEF) <-- This is the file where the function was defined
+--   ( (*1 *1 *2 *1)
+--     ( (AND (isDomain *2 (Integer)) (ofCategory *1 (AbelianGroup))) )
+--      . CATDEF)
+--   ( (*1 *1 *2 *1)
+--     ( (AND
+--         (isDomain *2 (NonNegativeInteger))
+--         (ofCategory *1 (AbelianMonoid))) )
+--      . CATDEF)
+--   ((*1 *1 *1 *1) ((ofCategory *1 (SemiGroup)) ) . CATDEF)
+--      )
+--
+--Environments:
+--    Environments associate properties with atoms.
+--    (see CUTIL BOOT for the exact structure of environments).
+--    Some common properties are:
+-- modeSet:
+--    During interpretation we build a modeSet property for each node in
+--    the expression.  This is (in theory) a list of all the types
+--    possible for the node.  In the current implementation these
+--    modeSets always contain a single type.
+-- value:
+--    Value properties are always triples.  This is where the values of
+--    variables are stored.  We also build value properties for internal
+--    nodes during the bottom up phase.
+-- mode:
+--    This is the declared type of an identifier.
+--
+--  There are several different environments used in the interpreter:
+--    $InteractiveFrame : this is the environment where the user
+--     values are stored.  Any side effects of evaluation of a top-level
+--     expression are stored in this environment.  It is always used as
+--     the starting environment for interpretation.
+--    $e : This is the name used for $InteractiveFrame while interpreting.
+--    $env : This is local environment used by the interpreter.
+--     Only temporary information (such as types of local variables is
+--     stored in $env.
+--     It is thrown away after evaluation of each expression.
+--
+--Frequently used global variables:
+--    $genValue : if true then evaluate generated code, otherwise leave
+--      code unevaluated.  If $genValue is false then we are compiling.
+--    $op: name of the top level operator (unused except in map printing)
+--    $mapList:  list of maps being type analyzed, used in recursive
+--               map type anlysis.
+--    $compilingMap: true when compiling a map, used to detect where to
+--                   THROW when interpret-only is invoked
+--    $compilingLoop: true when compiling a loop body, used to control
+--                    nesting level of interp-only loop CATCH points
+--    $interpOnly: true when in interpret only mode, used to call
+--                 alternate forms of COLLECT and REPEAT.
+--    $inCOLLECT: true when compiling a COLLECT, used only for hacked
+--                stream compiler.
+--    $StreamFrame: used in printing streams, it is the environment
+--                  where local stream variables are stored
+--    $declaredMode: Weak type propagation for symbols, set in upCOERCE
+--                   and upLET.  This variable is used to determine
+--                   the alternate polynomial types of Symbols.
+--    $localVars: list of local variables in a map body
+--    $MapArgumentTypeList: hack for stream compilation
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-funsel.boot.pamphlet b/src/interp/i-funsel.boot.pamphlet
new file mode 100644
index 00000000..6e34e518
--- /dev/null
+++ b/src/interp/i-funsel.boot.pamphlet
@@ -0,0 +1,1833 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-funsel.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+New Selection of Modemaps
+
+selection of applicable modemaps is done in two steps:
+  first it tries to find a modemap inside an argument domain, and if
+  this fails, by evaluation of pattern modemaps
+the result is a list of functions with signatures, which have the
+  following form:
+  [sig,elt,cond] where
+    sig is the signature gained by evaluating the modemap condition
+    elt is the slot number to get the implementation
+    cond are runtime checks which are the results of evaluating the
+    modemap condition
+
+the following flags are used:
+ $Coerce is NIL, if function selection is done which requires exact
+   matches (e.g. for coercion functions)
+ if $SubDom is true, then runtime checks have to be compiled
+\end{verbatim}
+\section{Functions}
+\subsection{isPartialMode}
+[[isPartialMode]] tests whether m contains [[$EmptyMode]]. The
+constant [[$EmptyMode]] (defined in bootfuns.lisp) evaluates to
+[[|$EmptyMode|]]. This constants is inserted in a modemap during
+compile time if the modemap is not yet complete.
+<<isPartialMode>>=
+isPartialMode m ==
+  CONTAINED($EmptyMode,m)
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+SETANDFILEQ($constructorExposureList, '(Boolean Integer String))
+
+sayFunctionSelection(op,args,target,dc,func) ==
+  $abbreviateTypes : local := true
+  startTimingProcess 'debug
+  fsig := formatSignatureArgs args
+  if not LISTP fsig then fsig := LIST fsig
+  if func then func := bright ['"by ",func]
+  sayMSG concat ['%l,:bright '"Function Selection for",op,:func,'%l,
+    '"      Arguments:",:bright fsig]
+  if target then sayMSG concat ['"      Target type:",
+    :bright prefix2String target]
+  if dc	 then sayMSG concat ['"      From:     ",
+    :bright prefix2String dc]
+  stopTimingProcess 'debug
+
+sayFunctionSelectionResult(op,args,mmS) ==
+  $abbreviateTypes : local := true
+  startTimingProcess 'debug
+  if mmS then printMms mmS
+  else sayMSG concat ['"   -> no function",:bright op,
+    '"found for arguments",:bright formatSignatureArgs args]
+  stopTimingProcess 'debug
+
+selectMms(op,args,$declaredMode) ==
+  -- selects applicable modemaps for node op and arguments args
+  -- if there is no local modemap, and it is not a package call, then
+  --   the cached function selectMms1 is called
+  startTimingProcess 'modemaps
+  n:= getUnname op
+  val := getValue op
+  opMode := objMode val
+
+  -- see if we have a functional parameter
+  ((isSharpVarWithNum(n) and opMode) or (val and opMode)) and
+      opMode is ['Mapping,:ta] =>
+	imp :=
+	  val => wrapped2Quote objVal val
+	  n
+	[[['local,:ta], imp , NIL]]
+
+  ((isSharpVarWithNum(n) and opMode) or (val and opMode)) and
+      opMode is ['Variable,f] =>
+	 emptyAtree op
+	 op.0 := f
+	 selectMms(op,args,$declaredMode)
+
+  isSharpVarWithNum(n) and opMode is ['FunctionCalled,f] =>
+	 op.0 := f
+	 selectMms(op,args,$declaredMode)
+
+  types1 := getOpArgTypes(n,args)
+  numArgs := #args
+  member('(SubDomain (Domain)),types1) => NIL
+  member('(Domain),types1) => NIL
+  member($EmptyMode,types1) => NIL
+
+  tar := getTarget op
+  dc  := getAtree(op,'dollar)
+
+  null dc and val and objMode(val) = $AnonymousFunction =>
+      tree := mkAtree objValUnwrap getValue op
+      putTarget(tree,['Mapping,tar,:types1])
+      bottomUp tree
+      val := getValue tree
+      [[['local,:rest objMode val], wrapped2Quote objVal val, NIL]]
+
+  if (n = 'map) and (first types1 = $AnonymousFunction)
+    then
+      tree := mkAtree objValUnwrap getValue first args
+      ut :=
+	tar => underDomainOf tar
+	NIL
+      ua := [underDomainOf x for x in rest types1]
+      member(NIL,ua) => NIL
+      putTarget(tree,['Mapping,ut,:ua])
+      bottomUp tree
+      val := getValue tree
+      types1 := [objMode val,:rest types1]
+      RPLACA(args,tree)
+
+  if numArgs = 1 and (n = "numer" or n = "denom") and
+    isEqualOrSubDomain(first types1,$Integer) and null dc then
+      dc := ['Fraction, $Integer]
+      putAtree(op, 'dollar, dc)
+
+
+  if $reportBottomUpFlag then sayFunctionSelection(n,types1,tar,dc,NIL)
+
+  identType := 'Variable
+  for x in types1 while not $declaredMode repeat
+      not EQCAR(x,identType) => $declaredMode:= x
+  types2 := [altTypeOf(x,y,$declaredMode) for x in types1 for y in args]
+
+  mmS:=
+    dc => selectDollarMms(dc,n,types1,types2)
+
+    if n = "/" and tar = $Integer then
+      tar := $RationalNumber
+      putTarget(op,tar)
+
+    -- now to speed up some standard selections
+    if not tar then
+      tar := defaultTarget(op,n,#types1,types1)
+      if tar and $reportBottomUpFlag then
+	sayMSG concat ['"      Default target type:",
+	  :bright prefix2String tar]
+
+    selectLocalMms(op,n,types1,tar) or
+      (VECTORP op and selectMms1(n,tar,types1,types2,'T))
+  if $reportBottomUpFlag then sayFunctionSelectionResult(n,types1,mmS)
+  stopTimingProcess 'modemaps
+  mmS
+
+-- selectMms1 is in clammed.boot
+
+selectMms2(op,tar,args1,args2,$Coerce) ==
+  -- decides whether to find functions from a domain or package
+  --   or by general modemap evaluation
+  or/[STRINGP arg for arg in args1] => NIL
+  if tar = $EmptyMode then tar := NIL
+  nargs := #args1
+  mmS := NIL
+  mmS :=
+    -- special case map for the time being
+    $Coerce and (op = 'map) and (2 = nargs) and
+      (first(args1) is ['Variable,fun]) =>
+	null (ud := underDomainOf CADR args1) => NIL
+	if tar then ut := underDomainOf(tar)
+	else ut := nil
+	null (mapMms := selectMms1(fun,ut,[ud],[NIL],true)) => NIL
+	mapMm := CDAAR mapMms
+	selectMms1(op,tar,[['Mapping,:mapMm],CADR args1],
+	  [NIL,CADR args2],$Coerce)
+
+    $Coerce and (op = 'map) and (2 = nargs) and
+      (first(args1) is ['FunctionCalled,fun]) =>
+	null (ud := underDomainOf CADR args1) => NIL
+	if tar then ut := underDomainOf(tar)
+	else ut := nil
+	funNode := mkAtreeNode fun
+	transferPropsToNode(fun,funNode)
+	null (mapMms := selectLocalMms(funNode,fun,[ud],NIL)) => NIL
+	mapMm := CDAAR mapMms
+	selectMms1(op,tar,[['Mapping,:mapMm],CADR args1],
+	  [NIL,CADR args2],$Coerce)
+
+    -- get the argument domains and the target
+    a := nil
+    for x in args1 repeat if x then a := cons(x,a)
+    for x in args2 repeat if x then a := cons(x,a)
+    if tar and not isPartialMode tar then a := cons(tar,a)
+
+    -- for typically homogeneous functions, throw in resolve too
+    if op in '(_= _+ _* _- ) then
+      r := resolveTypeList a
+      if r ^= nil then a := cons(r,a)
+
+    if tar and not isPartialMode tar then
+      if xx := underDomainOf(tar) then a := cons(xx,a)
+    for x in args1 repeat
+      PAIRP(x) and CAR(x) in '(List Vector Stream FiniteSet Array) =>
+	xx := underDomainOf(x) => a := cons(xx,a)
+
+    -- now extend this list with those from the arguments to
+    -- any Unions, Mapping or Records
+
+    a' := nil
+    a := nreverse REMDUP a
+    for x in a repeat
+      null x => 'iterate
+      x = '(RationalRadicals) => a' := cons($RationalNumber,a')
+      x is ['Union,:l] =>
+	-- check if we have a tagged union
+	l and first l is [":",:.] =>
+	  for [.,.,t] in l repeat
+	    a' := cons(t,a')
+	a' := append(reverse l,a')
+      x is ['Mapping,:l] => a' := append(reverse l,a')
+      x is ['Record,:l] =>
+	a' := append(reverse [CADDR s for s in l],a')
+      x is ['FunctionCalled,name] =>
+	(xm := get(name,'mode,$e)) and not isPartialMode xm =>
+	  a' := cons(xm,a')
+    a := append(a,REMDUP a')
+    a := [x for x in a | PAIRP(x)]
+
+    -- step 1. see if we have one without coercing
+    a' := a
+    while a repeat
+      x:= CAR a
+      a:= CDR a
+      ATOM x => 'iterate
+      mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,NIL,NIL))
+
+    -- step 2. if we didn't get one, trying coercing (if we are
+    --	       suppose to)
+
+    if null(mmS) and $Coerce then
+      a := a'
+      while a repeat
+	x:= CAR a
+	a:= CDR a
+	ATOM x => 'iterate
+	mmS := append(mmS,
+	  findFunctionInDomain(op,x,tar,args1,args2,$Coerce,NIL))
+
+    mmS or selectMmsGen(op,tar,args1,args2)
+  mmS and orderMms(op, mmS,args1,args2,tar)
+
+isAVariableType t ==
+    t is ['Variable,.] or t = $Symbol or t is ['OrderedVariableList,.]
+
+defaultTarget(opNode,op,nargs,args) ==
+  -- this is for efficiency. Chooses standard targets for operations
+  -- when no target exists.
+
+  target := nil
+
+  nargs = 0 =>
+    op = 'nil =>
+      putTarget(opNode, target := '(List (None)))
+      target
+    op = 'true	or op = 'false =>
+      putTarget(opNode, target := $Boolean)
+      target
+    op = 'pi =>
+      putTarget(opNode, target := ['Pi])
+      target
+    op = 'infinity =>
+      putTarget(opNode, target := ['OnePointCompletion, $Integer])
+      target
+    member(op, '(plusInfinity minusInfinity)) =>
+      putTarget(opNode, target := ['OrderedCompletion, $Integer])
+      target
+    target
+
+  a1 := CAR args
+  ATOM a1 => target
+  a1f := QCAR a1
+
+  nargs = 1 =>
+    op = 'kernel =>
+      putTarget(opNode, target := ['Kernel, ['Expression, $Integer]])
+      target
+    op = 'list =>
+      putTarget(opNode, target := ['List, a1])
+      target
+    target
+
+  a2 := CADR args
+
+  nargs >= 2 and op = "draw" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] =>
+
+    -- this clears up some confusion over 2D and 3D graphics
+
+    symNode := mkAtreeNode sym
+    transferPropsToNode(sym,symNode)
+
+    nargs >= 3 and CADDR args is ['Segment,.] =>
+      selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL)
+      putTarget(opNode, target := '(ThreeDimensionalViewport))
+      target
+
+    (mms := selectLocalMms(symNode,sym,[$DoubleFloat],NIL)) =>
+      [.,targ,:.] := CAAR mms
+      targ = $DoubleFloat =>
+	  putTarget(opNode, target := '(TwoDimensionalViewport))
+	  target
+      targ = ['Point, $DoubleFloat] =>
+	  putTarget(opNode, target := '(ThreeDimensionalViewport))
+	  target
+      target
+
+    target
+
+  nargs >= 2 and op = "makeObject" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] =>
+    -- we won't actually bother to put a target on makeObject
+    -- this is just to figure out what the first arg is
+    symNode := mkAtreeNode sym
+    transferPropsToNode(sym,symNode)
+
+    nargs >= 3 and CADDR args is ['Segment,.] =>
+      selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL)
+      target
+
+    selectLocalMms(symNode,sym,[$DoubleFloat],NIL)
+    target
+
+  nargs = 2 =>
+    op = "elt" =>
+	a1 = '(BasicOperator) and a2 is ['List, ['OrderedVariableList, .]] =>
+	   ['Expression, $Integer]
+	target
+
+    op = "eval" =>
+	a1 is ['Expression,b1] and a2 is ['Equation, ['Polynomial,b2]] =>
+	    target :=
+	      canCoerce(b2, a1) => a1
+	      t := resolveTT(b1, b2)
+	      (not t) or (t = $Any) => nil
+	      resolveTT(a1, t)
+	    if target then putTarget(opNode, target)
+	    target
+	a1 is ['Equation, .] and a2 is ['Equation, .] =>
+	    target := resolveTT(a1, a2)
+	    if target and not (target = $Any) then putTarget(opNode,target)
+	    else target := nil
+	    target
+	a1 is ['Equation, .] and a2 is ['List, a2e] and a2e is ['Equation, .] =>
+	    target := resolveTT(a1, a2e)
+	    if target and not (target = $Any) then putTarget(opNode,target)
+	    else target := nil
+	    target
+	a2 is ['Equation, a2e] or a2 is ['List, ['Equation, a2e]] =>
+	    target := resolveTT(a1, a2e)
+	    if target and not (target = $Any) then putTarget(opNode,target)
+	    else target := nil
+	    target
+
+    op = "**" or op = "^" =>
+      a2 = $Integer =>
+	if (target := resolveTCat(a1,'(Field))) then
+	  putTarget(opNode,target)
+	target
+      a1 = '(AlgebraicNumber) and (a2 = $Float or a2 = $DoubleFloat) =>
+	  target := ['Expression, a2]
+	  putTarget(opNode,target)
+	  target
+      a1 = '(AlgebraicNumber) and a2 is ['Complex, a3] and (a3 = $Float or a3 = $DoubleFloat) =>
+	  target := ['Expression, a3]
+	  putTarget(opNode,target)
+	  target
+      ((a2 = $RationalNumber) and
+	(typeIsASmallInteger(a1) or isEqualOrSubDomain(a1,$Integer))) =>
+	    putTarget(opNode, target := '(AlgebraicNumber))
+	    target
+      ((a2 = $RationalNumber) and (isAVariableType(a1)
+	  or a1 is ['Polynomial,.] or a1 is ['RationalFunction,.])) =>
+	    putTarget(opNode, target := defaultTargetFE a1)
+	    target
+      isAVariableType(a1) and (a2 = $PositiveInteger or a2 = $NonNegativeInteger) =>
+	  putTarget(opNode, target := '(Polynomial (Integer)))
+	  target
+      isAVariableType(a2) =>
+	putTarget(opNode, target := defaultTargetFE a1)
+	target
+      a2 is ['Polynomial, D] =>
+	(a1 = a2) or isAVariableType(a1)
+	 or ((a1 is ['RationalFunction, D1]) and (D1 = D)) or (a1 = D)
+	  or ((a1 is [=$QuotientField, D1]) and (D1 = a1)) =>
+	    putTarget(opNode, target := defaultTargetFE a2)
+	    target
+	target
+      a2 is ['RationalFunction, D] =>
+	(a1 = a2) or isAVariableType(a1)
+	 or ((a1 is ['RationalFunction, D1]) and (D1 = D)) or (a1 = D)
+	  or ((a1 is [=$QuotientField, D1]) and (D1 = a1)) =>
+	    putTarget(opNode, target := defaultTargetFE a2)
+	    target
+	target
+      target
+
+    op = '_/ =>
+      isEqualOrSubDomain(a1, $Integer) and isEqualOrSubDomain(a2, $Integer) =>
+	putTarget(opNode, target := $RationalNumber)
+	target
+      a1 = a2 =>
+	if (target := resolveTCat(CAR args,'(Field))) then
+	  putTarget(opNode,target)
+	target
+      a1 is ['Variable,.] and a2 is ['Variable,.] =>
+	putTarget(opNode,target := mkRationalFunction  '(Integer))
+	target
+      isEqualOrSubDomain(a1,$Integer) and a2 is ['Variable,.] =>
+	putTarget(opNode,target := mkRationalFunction '(Integer))
+	target
+      a1 is ['Variable,.] and
+	a2 is ['Polynomial,D] =>
+	  putTarget(opNode,target := mkRationalFunction D)
+	  target
+	target
+      a2 is ['Variable,.] and
+	a1 is ['Polynomial,D] =>
+	  putTarget(opNode,target := mkRationalFunction D)
+	  target
+	target
+      a2 is ['Polynomial,D] and (a1 = D) =>
+	putTarget(opNode,target := mkRationalFunction D)
+	target
+      target
+
+  a3 := CADDR args
+  nargs = 3 =>
+    op = "eval" =>
+	a3 is ['List, a3e] =>
+	    target := resolveTT(a1, a3e)
+	    if not (target = $Any) then putTarget(opNode,target)
+	    else target := nil
+	    target
+
+	target := resolveTT(a1, a3)
+	if not (target = $Any) then putTarget(opNode,target)
+	else target := nil
+	target
+  target
+
+mkRationalFunction D ==	 ['Fraction, ['Polynomial, D]]
+
+defaultTargetFE(a,:options) ==
+  a is ['Variable,.] or a = $RationalNumber or MEMQ(QCAR a,
+    [QCAR $Symbol, 'RationalRadicals,
+     'Pi]) or typeIsASmallInteger(a) or isEqualOrSubDomain(a, $Integer) or
+       a = '(AlgebraicNumber) =>
+          IFCAR options => [$FunctionalExpression, ['Complex, $Integer]]
+          [$FunctionalExpression, $Integer]
+  a is ['Complex,uD] => defaultTargetFE(uD, true)
+  a is [D,uD] and MEMQ(D, '(Polynomial RationalFunction Fraction)) =>
+     defaultTargetFE(uD, IFCAR options)
+  a is [=$FunctionalExpression,.] => a
+  IFCAR options => [$FunctionalExpression, ['Complex, a]]
+  [$FunctionalExpression, a]
+
+altTypeOf(type,val,$declaredMode) ==
+  (EQCAR(type,'Symbol) or EQCAR(type,'Variable)) and
+    (a := getMinimalVarMode(objValUnwrap getValue(val),$declaredMode)) =>
+      a
+  type is ['OrderedVariableList,vl] and
+    INTEGERP(val1 := objValUnwrap getValue(val)) and
+      (a := getMinimalVarMode(vl.(val1 - 1),$declaredMode)) =>
+	a
+  type = $PositiveInteger    => $Integer
+  type = $NonNegativeInteger => $Integer
+  type = '(List (PositiveInteger)) => '(List (Integer))
+  NIL
+
+getOpArgTypes(opname, args) ==
+  l := getOpArgTypes1(opname, args)
+  [f(a,opname) for a in l] where
+    f(x,op) ==
+      x is ['FunctionCalled,g] and op ^= 'name =>
+	m := get(g,'mode,$e) =>
+	  m is ['Mapping,:.] => m
+	  x
+	x
+      x
+
+getOpArgTypes1(opname, args) ==
+  null args => NIL
+  -- special cases first
+  opname = 'coef and args is [b,n] =>
+    [CAR getModeSet b, CAR getModeSetUseSubdomain n]
+  opname = 'monom and args is [d,c] =>
+    [CAR getModeSetUseSubdomain d,CAR getModeSet c]
+  opname = 'monom and args is [v,d,c] =>
+    [CAR getModeSet v,CAR getModeSetUseSubdomain d,CAR getModeSet c]
+  (opname = 'cons) and (2 = #args) and (CADR(args) = 'nil) =>
+    ms := [CAR getModeSet x for x in args]
+    if CADR(ms) = '(List (None)) then
+      ms := [first ms,['List,first ms]]
+    ms
+  nargs := #args
+  v := argCouldBelongToSubdomain(opname,nargs)
+  mss := NIL
+  for i in 0..(nargs-1) for x in args repeat
+    ms :=
+      v.i = 0 => CAR getModeSet x
+      CAR getModeSetUseSubdomain x
+    mss := [ms,:mss]
+  nreverse mss
+
+argCouldBelongToSubdomain(op, nargs) ==
+  -- this returns a vector containing 0 or ^0 for each argument.
+  -- if ^0, this indicates that there exists a modemap for the
+  -- op that needs a subdomain in that position
+  nargs = 0 => NIL
+  v := GETZEROVEC nargs
+  isMap(op) => v
+  mms := getModemapsFromDatabase(op,nargs)
+  null mms => v
+  nargs:=nargs-1
+  -- each signature has form
+  -- [domain of implementation, target, arg1, arg2, ...]
+  for [sig,cond,:.] in mms repeat
+    for t in CDDR sig for i in 0..(nargs) repeat
+      CONTAINEDisDomain(t,cond) =>
+	  v.i := 1 + v.i
+  v
+
+CONTAINEDisDomain(symbol,cond) ==
+-- looks for [isSubDomain,symbol,[domain]] in cond: returning T or NIL
+-- with domain being one of PositiveInteger and NonNegativeInteger
+   ATOM cond => false
+   MEMQ(QCAR cond,'(AND OR and or)) =>
+       or/[CONTAINEDisDomain(symbol, u) for u in QCDR cond]
+   EQ(QCAR cond,'isDomain) =>
+       EQ(symbol,CADR cond) and PAIRP(dom:=CADDR cond) and
+	 MEMQ(dom,'(PositiveInteger NonNegativeInteger))
+   false
+
+selectDollarMms(dc,name,types1,types2) ==
+  -- finds functions for name in domain dc
+  isPartialMode dc => throwKeyedMsg("S2IF0001",NIL)
+  mmS := findFunctionInDomain(name,dc,NIL,types1,types2,'T,'T) =>
+    orderMms(name, mmS,types1,types2,NIL)
+  if $reportBottomUpFlag then sayMSG
+    ["%b",'"          function not found in ",prefix2String dc,"%d","%l"]
+  NIL
+
+selectLocalMms(op,name,types,tar) ==
+  -- partial rewrite, looks now for exact local modemap
+  mmS:= getLocalMms(name,types,tar) => mmS
+  obj := getValue op
+  obj and (objVal obj is ['MAP,:mapDef]) and
+    analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar)
+
+-- next defn may be better, test when more time. RSS 3/11/94
+-- selectLocalMms(op,name,types,tar) ==
+--  mmS := getLocalMms(name,types,tar)
+--  -- if no target, just return what we got
+--  mmS and null tar => mmS
+--  matchingMms := nil
+--  for mm in mmS repeat
+--    [., targ, :.] := mm
+--    if tar = targ then matchingMms := cons(mm, matchingMms)
+--  -- if we got some exact matchs on the target, return them
+--  matchingMms => nreverse matchingMms
+--
+--  obj := getValue op
+--  obj and (objVal obj is ['MAP,:mapDef]) and
+--    analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar)
+
+getLocalMms(name,types,tar) ==
+  -- looks for exact or subsumed local modemap in $e
+  mmS := NIL
+  for  (mm:=[dcSig,:.]) in get(name,'localModemap,$e) repeat
+    -- check format and destructure
+    dcSig isnt [dc,result,:args] => NIL
+    -- make number of args is correct
+    #types ^= #args => NIL
+    -- check for equal or subsumed arguments
+    subsume := (not $useIntegerSubdomain) or (tar = result) or
+      get(name,'recursive,$e)
+    acceptableArgs :=
+      and/[f(b,a,subsume) for a in args for b in types] where
+	f(x,y,subsume) ==
+	  if subsume
+	    then isEqualOrSubDomain(x,y)
+	    else x = y
+    not acceptableArgs =>
+      -- interpreted maps are ok
+      dc = 'interpOnly and not($Coerce)=> mmS := [mm,:mmS]
+      NIL
+    mmS := [mm,:mmS]
+  nreverse mmS
+
+mmCost(name, sig,cond,tar,args1,args2) ==
+  cost := mmCost0(name, sig,cond,tar,args1,args2)
+  res := CADR sig
+  res = $PositiveInteger => cost - 2
+  res = $NonNegativeInteger => cost - 1
+  res = $DoubleFloat => cost + 1
+  cost
+
+mmCost0(name, sig,cond,tar,args1,args2) ==
+  sigArgs := CDDR sig
+  n:=
+    null cond => 1
+    not (or/cond) => 1
+    0
+
+  -- try to favor homogeneous multiplication
+
+--if name = "*" and 2 = #sigArgs and first sigArgs ^= first rest sigArgs then n := n + 1
+
+  -- because of obscure problem in evalMm, sometimes we will have extra
+  -- modemaps with the wrong number of arguments if we want to the one
+  -- with no arguments and the name is overloaded. Thus check for this.
+
+  if args1 then
+    for x1 in args1 for x2 in args2 for x3 in sigArgs repeat
+      n := n +
+	isEqualOrSubDomain(x1,x3) => 0
+	topcon := first deconstructT x1
+	topcon2 := first deconstructT x3
+	topcon = topcon2 => 3
+	CAR topcon2 = 'Mapping => 2
+	4
+  else if sigArgs then n := n + 100000000000
+
+  res := CADR sig
+  res=tar => 10000*n
+  10000*n + 1000*domainDepth(res) + hitListOfTarget(res)
+
+orderMms(name, mmS,args1,args2,tar) ==
+  -- it counts the number of necessary coercions of the argument types
+  -- if this isn't enough, it compares the target types
+  mmS and null rest mmS => mmS
+  mS:= NIL
+  N:= NIL
+  for mm in MSORT mmS repeat
+    [sig,.,cond]:= mm
+    b:= 'T
+    p:= CONS(m := mmCost(name, sig,cond,tar,args1,args2),mm)
+    mS:=
+      null mS => list p
+      m < CAAR mS => CONS(p,mS)
+      S:= mS
+      until b repeat
+	b:= null CDR S or m < CAADR S =>
+	  RPLACD(S,CONS(p,CDR S))
+	S:= CDR S
+      mS
+  mmS and [CDR p for p in mS]
+
+domainDepth(d) ==
+  -- computes the depth of lisp structure d
+  atom d => 0
+  MAX(domainDepth(CAR d)+1,domainDepth(CDR d))
+
+hitListOfTarget(t) ==
+  -- assigns a number between 1 and 998 to a type t
+
+  -- want to make it hard to go to Polynomial Pi
+
+  t = '(Polynomial (Pi)) => 90000
+
+  EQ(CAR t, 'Polynomial) => 300
+  EQ(CAR t, 'List) => 400
+  EQ(CAR t,'Matrix) => 910
+  EQ(CAR t,'UniversalSegment) => 501
+  EQ(CAR t,'RationalFunction) => 900
+  EQ(CAR t,'Union) => 999
+  EQ(CAR t,'Expression) => 1600
+  500
+
+--------------------> NEW DEFINITION (override in interop.boot.pamphlet)
+getFunctionFromDomain(op,dc,args) ==
+  -- finds the function op with argument types args in dc
+  -- complains, if no function or ambiguous
+
+  $reportBottomUpFlag:local:= NIL
+  member(CAR dc,$nonLisplibDomains) =>
+    throwKeyedMsg("S2IF0002",[CAR dc])
+  not constructor? CAR dc =>
+    throwKeyedMsg("S2IF0003",[CAR dc])
+
+  p := findFunctionInDomain(op,dc,NIL,args,args,NIL,NIL)
+
+  -- NEW COMPILER COMPATIBILITY ON
+
+  if not p then
+    p :=
+      op = "^" =>
+	  findFunctionInDomain("**",dc,NIL,args,args,NIL,NIL)
+      op = "**" =>
+	  findFunctionInDomain("^",dc,NIL,args,args,NIL,NIL)
+      nil
+
+  -- NEW COMPILER COMPATIBILITY OFF
+
+  p =>
+    domain := evalDomain dc
+    for mm in nreverse p until b repeat
+      [[.,:sig],:.] := mm
+      b := compiledLookup(op,sig,domain)
+    b or  throwKeyedMsg("S2IS0023",[op,dc])
+
+
+  throwKeyedMsg("S2IF0004",[op,dc])
+
+isOpInDomain(opName,dom,nargs) ==
+  -- returns true only if there is an op in the given domain with
+  -- the given number of arguments
+  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
+  mmList := subCopy(mmList,constructSubst dom)
+  null mmList => NIL
+  gotOne := NIL
+  nargs := nargs + 1
+  for mm in CDR mmList while not gotOne repeat
+    nargs = #CAR mm => gotOne := [mm, :gotOne]
+  gotOne
+
+findCommonSigInDomain(opName,dom,nargs) ==
+  -- this looks at all signatures in dom with given opName and nargs
+  -- number of arguments. If no matches, returns NIL. Otherwise returns
+  -- a "signature" where a type position is non-NIL only if all
+  -- signatures shares that type .
+  CAR(dom) in '(Union Record Mapping) => NIL
+  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
+  mmList := subCopy(mmList,constructSubst dom)
+  null mmList => NIL
+  gotOne := NIL
+  nargs := nargs + 1
+  vec := NIL
+  for mm in CDR mmList repeat
+    nargs = #CAR mm =>
+      null vec	=> vec := LIST2VEC CAR mm
+      for i in 0.. for x in CAR mm repeat
+	if vec.i and vec.i ^= x then vec.i := NIL
+  VEC2LIST vec
+
+findUniqueOpInDomain(op,opName,dom) ==
+  -- return function named op in domain dom if unique, choose one if not
+  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
+  mmList := subCopy(mmList,constructSubst dom)
+  null mmList =>
+    throwKeyedMsg("S2IS0021",[opName,dom])
+  if #CDR mmList > 1 then
+    mm := selectMostGeneralMm CDR mmList
+    sayKeyedMsg("S2IS0022",[opName,dom,['Mapping,:CAR mm]])
+  else mm := CADR mmList
+  [sig,slot,:.] := mm
+  fun :=
+--+
+      $genValue =>
+	 compiledLookupCheck(opName,sig,evalDomain dom)
+      NRTcompileEvalForm(opName, sig, evalDomain dom)
+  NULL(fun) or NULL(PAIRP(fun)) => NIL
+  CAR fun = function(Undef) => throwKeyedMsg("S2IS0023",[opName,dom])
+  binVal :=
+    $genValue => wrap fun
+    fun
+  putValue(op,objNew(binVal,m:=['Mapping,:sig]))
+  putModeSet(op,[m])
+
+selectMostGeneralMm mmList ==
+  -- selects the modemap in mmList with arguments all the other
+  -- argument types can be coerced to
+  -- also selects function with #args closest to 2
+  min := 100
+  mml := mmList
+  while mml repeat
+    [mm,:mml] := mml
+    sz := #CAR mm
+    if (met := ABS(sz - 3)) < min then
+      min := met
+      fsz := sz
+  mmList := [mm for mm in mmList | (#CAR mm) = fsz]
+  mml := CDR mmList
+  genMm := CAR mmList
+  while mml repeat
+    [mm,:mml] := mml
+    and/[canCoerceFrom(genMmArg,mmArg) for mmArg in CDAR mm
+      for genMmArg in CDAR genMm] => genMm := mm
+  genMm
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
+  -- looks for a modemap for op with signature	args1 -> tar
+  --   in the domain of computation dc
+  -- tar may be NIL (= unknown)
+  null isLegitimateMode(tar, nil, nil) => nil
+  dcName:= CAR dc
+  member(dcName,'(Union Record Mapping)) =>
+    -- First cut code that ignores args2, $Coerce and $SubDom
+    -- When domains no longer have to have Set, the hard coded 6 and 7
+    -- should go.
+    op = '_= =>
+	#args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL
+	tar and tar ^= '(Boolean) => NIL
+	[[[dc, '(Boolean), dc, dc], 6, [NIL, NIL]]]
+    op = 'coerce =>
+	#args1 ^= 1 or args1.0 ^= dc => NIL
+	tar and tar ^= $OutputForm => NIL
+	[[[dc, $OutputForm, dc], 7, [NIL, NIL]]]
+    member(dcName,'(Record Union)) =>
+      findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom)
+    NIL
+  fun:= NIL
+  ( p := ASSQ(op,getOperationAlistFromLisplib dcName) ) and
+    SL := constructSubst dc
+    -- if the arglist is homogeneous, first look for homogeneous
+    -- functions. If we don't find any, look at remaining ones
+    if isHomogeneousList args1 then
+      q := NIL
+      r := NIL
+      for mm in CDR p repeat
+	-- CDAR of mm is the signature argument list
+	if isHomogeneousList CDAR mm then q := [mm,:q]
+	else r := [mm,:r]
+      q := allOrMatchingMms(q,args1,tar,dc)
+      for mm in q repeat
+	mm:= subCopy(mm,SL)
+	fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+      r := reverse r
+    else r := CDR p
+    r := allOrMatchingMms(r,args1,tar,dc)
+    if not fun then    -- consider remaining modemaps
+      for mm in r repeat
+	mm:= subCopy(mm,SL)
+	fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+  if not fun and $reportBottomUpFlag then
+    sayMSG concat
+      ['"   -> no appropriate",:bright op,'"found in",
+	:bright prefix2String dc]
+  fun
+
+allOrMatchingMms(mms,args1,tar,dc) ==
+  -- if there are exact matches on the arg types, return them
+  -- otherwise return the original list
+  null mms or null rest mms => mms
+  x := NIL
+  for mm in mms repeat
+    [sig,:.] := mm
+    [res,:args] := MSUBSTQ(dc,"$",sig)
+    args ^= args1 => nil
+    x := CONS(mm,x)
+  if x then x
+  else mms
+
+isHomogeneousList y ==
+  y is [x] => true
+  y and rest y =>
+    z := CAR y
+    "and"/[x = z for x in CDR y]
+  NIL
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+findFunctionInDomain1(mm,op,tar,args1,args2,SL) ==
+  -- tests whether modemap mm is appropriate for the function
+  -- defined by op, target type tar and argument types args
+  $RTC:local:= NIL
+  -- $RTC is a list of run-time checks to be performed
+  dc:= CDR ASSQ('$,SL)
+  [sig,slot,cond,y] := mm
+  if CONTAINED('_#, sig) or CONTAINED('construct, sig) then
+    sig := [replaceSharpCalls t for t in sig]
+  matchMmCond cond and matchMmSig(mm,tar,args1,args2) and
+    EQ(y,'Subsumed) and
+      -- hmmmm: do Union check in following because (as in DP)
+      -- Unions are subsumed by total modemaps which are in the
+      -- mm list in findFunctionInDomain.
+      y := 'ELT	     -- if subsumed fails try it again
+      not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and
+	(f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f
+    EQ(y,'ELT) => [[CONS(dc,sig),slot,nreverse $RTC]]
+    EQ(y,'CONST) => [[CONS(dc,sig),slot,nreverse $RTC]]
+--  EQ(y,'ASCONST) => [[CONS(dc,sig),slot,nreverse $RTC]]
+    y is ['XLAM,:.] => [[CONS(dc,sig),y,nreverse $RTC]]
+    sayKeyedMsg("S2IF0006",[y])
+    NIL
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
+  -- looks for a modemap for op with signature	args1 -> tar
+  --   in the domain of computation dc
+  -- tar may be NIL (= unknown)
+  dcName:= CAR dc
+  not MEMQ(dcName,'(Record Union)) => NIL
+  fun:= NIL
+ --  cat := constructorCategory dc
+  makeFunc := GETL(dcName,"makeFunctionList") or
+      systemErrorHere '"findFunctionInCategory"
+  [funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame)
+  -- get list of implementations and remove sharps
+  maxargs := -1
+  impls := nil
+  for [a,b,d] in funlist repeat
+    not EQ(a,op) => nil
+    d is ['XLAM,xargs,:.] =>
+      if PAIRP(xargs) then maxargs := MAX(maxargs,#xargs)
+      else maxargs := MAX(maxargs,1)
+      impls := cons([b,nil,true,d],impls)
+    impls := cons([b,d,true,d],impls)
+  impls := NREVERSE impls
+  if maxargs ^= -1 then
+    SL:= NIL
+    for i in 1..maxargs repeat
+      impls := SUBSTQ(GENSYM(),INTERNL('"#",STRINGIMAGE i),impls)
+  impls and
+    SL:= constructSubst dc
+    for mm in impls repeat
+      mm:= subCopy(mm,SL)
+      fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+  if not fun and $reportBottomUpFlag then
+    sayMSG concat
+      ['"   -> no appropriate",:bright op,'"found in",
+	:bright prefix2String dc]
+  fun
+
+matchMmCond(cond) ==
+  -- tests the condition, which comes with a modemap
+  -- cond is 'T or a list, but I hate to test for 'T (ALBI)
+  $domPvar: local := nil
+  atom cond or
+    cond is ['AND,:conds] or cond is ['and,:conds] =>
+      and/[matchMmCond c for c in conds]
+    cond is ['OR,:conds] or cond is ['or,:conds] =>
+      or/[matchMmCond c for c in conds]
+    cond is ['has,dom,x] =>
+      hasCaty(dom,x,NIL) ^= 'failed
+    cond is ['not,cond1] => not matchMmCond cond1
+    keyedSystemError("S2GE0016",
+      ['"matchMmCond",'"unknown form of condition"])
+
+matchMmSig(mm,tar,args1,args2) ==
+  -- matches the modemap signature against  args1 -> tar
+  -- if necessary, runtime checks are created for subdomains
+  -- then the modemap condition is evaluated
+  [sig,:.]:= mm
+  if CONTAINED('_#, sig) then
+    sig := [replaceSharpCalls COPY t for t in sig]
+  null args1 => matchMmSigTar(tar,CAR sig)
+  a:= CDR sig
+  arg:= NIL
+  for i in 1.. while args1 and args2 and a until not b repeat
+    x1:= CAR args1
+    args1:= CDR args1
+    x2:= CAR args2
+    args2:= CDR args2
+    x:= CAR a
+    a:= CDR a
+    rtc:= NIL
+    if x is ['SubDomain,y,:.] then x:= y
+    b := isEqualOrSubDomain(x1,x) or
+      (STRINGP(x) and (x1 is ['Variable,v]) and (x = PNAME v)) or
+	$SubDom and isSubDomain(x,x1) => rtc:= 'T
+	$Coerce => x2=x or canCoerceFrom(x1,x)
+	x1 is ['Variable,:.] and x = '(Symbol)
+    $RTC:= CONS(rtc,$RTC)
+  null args1 and null a and b and matchMmSigTar(tar,CAR sig)
+
+matchMmSigTar(t1,t2) ==
+  -- t1 is a target type specified by :: or by a declared variable
+  -- t2 is the target of a modemap signature
+  null t1 or
+    isEqualOrSubDomain(t2,t1) => true
+    if t2 is ['Union,a,b] then
+      if a='"failed" then return matchMmSigTar(t1, b)
+      if b='"failed" then return matchMmSigTar(t1, a)
+    $Coerce and
+      isPartialMode t1 => resolveTM(t2,t1)
+-- I think this should be true	-SCM
+--    true
+      canCoerceFrom(t2,t1)
+
+constructSubst(d) ==
+  -- constructs a substitution which substitutes d for $
+  -- and the arguments of d for #1, #2 ..
+  SL:= list CONS('$,d)
+  for x in CDR d for i in 1.. repeat
+    SL:= CONS(CONS(INTERNL('"#",STRINGIMAGE i),x),SL)
+  SL
+
+filterModemapsFromPackages(mms, names, op) ==
+  -- mms is a list of modemaps
+  -- names is a list of domain constructors
+  -- this returns a 2-list containing those modemaps that have one
+  -- of the names in the package source of the modemap and all the
+  -- rest of the modemaps in the second element.
+  good := NIL
+  bad  := NIL
+  -- hack to speed up factorization choices for mpolys and to overcome
+  -- some poor naming of packages
+  mpolys := '("Polynomial" "MultivariatePolynomial"
+   "DistributedMultivariatePolynomial"
+      "HomogeneousDistributedMultivariatePolynomial")
+  mpacks := '("MFactorize" "MRationalFactorize")
+  for mm in mms repeat
+    isFreeFunctionFromMm(mm) => bad := cons(mm, bad)
+    type := getDomainFromMm mm
+    null type => bad := cons(mm,bad)
+    if PAIRP type then type := first type
+    GETDATABASE(type,'CONSTRUCTORKIND) = 'category => bad := cons(mm,bad)
+    name := object2String type
+    found := nil
+    for n in names while not found repeat
+      STRPOS(n,name,0,NIL) => found := true
+      -- hack, hack
+      (op = 'factor) and member(n,mpolys) and member(name,mpacks) =>
+	found := true
+    if found
+      then good := cons(mm, good)
+      else bad := cons(mm,bad)
+  [good,bad]
+
+
+isTowerWithSubdomain(towerType,elem) ==
+  not PAIRP towerType => NIL
+  dt := deconstructT towerType
+  2 ^= #dt => NIL
+  s := underDomainOf(towerType)
+  isEqualOrSubDomain(s,elem) and constructM(first dt,[elem])
+
+selectMmsGen(op,tar,args1,args2) ==
+  -- general modemap evaluation of op with argument types args1
+  -- evaluates the condition and looks for the slot number
+  -- returns all functions which are applicable
+  -- args2 is a list of polynomial types for symbols
+  $Subst: local := NIL
+  $SymbolType: local := NIL
+
+  null (S := getModemapsFromDatabase(op,QLENGTH args1)) => NIL
+
+  if (op = 'map) and (2 = #args1) and
+    (CAR(args1) is ['Mapping,., elem]) and
+      (a := isTowerWithSubdomain(CADR args1,elem))
+	then args1 := [CAR args1,a]
+
+  -- we first split the modemaps into two groups:
+  --   haves:	 these are from packages that have one of the top level
+  --		 constructor names in the package name
+  --   havenots: everything else
+
+  -- get top level constructor names for constructors with parameters
+  conNames := nil
+  if op = 'reshape then args := APPEND(rest args1, rest args2)
+  else args := APPEND(args1,args2)
+  if tar then args := [tar,:args]
+  -- for common aggregates, use under domain also
+  for a in REMDUP args repeat
+    a =>
+      atom a => nil
+      fa := QCAR a
+      fa in '(Record Union) => NIL
+      conNames := insert(STRINGIMAGE fa, conNames)
+
+  if conNames
+    then [haves,havenots] := filterModemapsFromPackages(S,conNames,op)
+    else
+      haves := NIL
+      havenots := S
+
+  mmS := NIL
+
+  if $reportBottomUpFlag then
+    sayMSG ['%l,:bright '"Modemaps from Associated Packages"]
+
+  if haves then
+    [havesExact,havesInexact] := exact?(haves,tar,args1) where
+      exact?(mmS,tar,args) ==
+	ex := inex := NIL
+	for (mm := [sig,[mmC,:.],:.]) in mmS repeat
+	  [c,t,:a] := sig
+	  ok := true
+	  for pat in a for arg in args while ok repeat
+	    not CONTAINED(['isDomain,pat,arg],mmC) => ok := NIL
+	  ok => ex := CONS(mm,ex)
+	  inex := CONS(mm,inex)
+	[ex,inex]
+    if $reportBottomUpFlag then
+      for mm in APPEND(havesExact,havesInexact) for i in 1.. repeat
+	sayModemapWithNumber(mm,i)
+    if havesExact then
+      mmS := matchMms(havesExact,op,tar,args1,args2) where
+	matchMms(mmaps,op,tar,args1,args2) ==
+	  mmS := NIL
+	  for [sig,mmC] in mmaps repeat
+	    -- sig is [dc,result,:args]
+	    $Subst :=
+	      tar and not isPartialMode tar =>
+		-- throw in the target if it is not the same as one
+		-- of the arguments
+		res := CADR sig
+		member(res,CDDR sig) => NIL
+		[[res,:tar]]
+	      NIL
+	    [c,t,:a] := sig
+	    if a then matchTypes(a,args1,args2)
+	    not EQ($Subst,'failed) =>
+	      mmS := nconc(evalMm(op,tar,sig,mmC),mmS)
+	  mmS
+      if mmS then
+	if $reportBottomUpFlag then
+	  sayMSG '"   found an exact match!"
+	return mmS
+    mmS := matchMms(havesInexact,op,tar,args1,args2)
+  else if $reportBottomUpFlag then sayMSG '"   no modemaps"
+  mmS => mmS
+
+  if $reportBottomUpFlag then
+    sayMSG ['%l,:bright '"Remaining General Modemaps"]
+  --  for mm in havenots for i in 1.. repeat sayModemapWithNumber(mm,i)
+
+  if havenots then
+    [havesNExact,havesNInexact] := exact?(havenots,tar,args1)
+    if $reportBottomUpFlag then
+      for mm in APPEND(havesNExact,havesNInexact) for i in 1.. repeat
+	sayModemapWithNumber(mm,i)
+    if havesNExact then
+      mmS := matchMms(havesNExact,op,tar,args1,args2)
+      if mmS then
+	if $reportBottomUpFlag then
+	  sayMSG '"   found an exact match!"
+	return mmS
+    mmS := matchMms(havesNInexact,op,tar,args1,args2)
+  else if $reportBottomUpFlag then sayMSG '"   no modemaps"
+  mmS
+
+matchTypes(pm,args1,args2) ==
+  -- pm is a list of pattern variables, args1 a list of argument types,
+  --   args2 a list of polynomial types for symbols
+  -- the result is a match from pm to args, if one exists
+  for v in pm for t1 in args1 for t2 in args2 until $Subst='failed repeat
+    p:= ASSQ(v,$Subst) =>
+      t:= CDR p
+      t=t1 => $Coerce and EQCAR(t1,'Symbol) and
+	(q := ASSQ(v,$SymbolType)) and t2 and
+	  (t3 := resolveTT(CDR q, t2)) and
+	    RPLACD(q, t3)
+      $Coerce =>
+	if EQCAR(t,'Symbol) and (q := ASSQ(v,$SymbolType)) then
+	  t := CDR q
+	if EQCAR(t1,'Symbol) and t2 then t1:= t2
+	t0 := resolveTT(t,t1) => RPLACD(p,t0)
+	$Subst:= 'failed
+      $Subst:= 'failed
+    $Subst:= CONS(CONS(v,t1),$Subst)
+    if EQCAR(t1,'Symbol) and t2 then $SymbolType:= CONS(CONS(v,t2),$SymbolType)
+
+evalMm(op,tar,sig,mmC) ==
+  -- evaluates a modemap with signature sig and condition mmC
+  -- the result is a list of lists [sig,slot,cond] or NIL
+  --if $Coerce is NIL, tar has to be the same as the computed target type
+--if CONTAINED('LinearlyExplicitRingOver,mmC) then hohoho()
+  mS:= NIL
+  for st in evalMmStack mmC repeat
+    SL:= evalMmCond(op,sig,st)
+    not EQ(SL,'failed) =>
+      SL := fixUpTypeArgs SL
+      sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig]
+      not containsVars sig =>
+	isFreeFunctionFromMmCond mmC and (m := evalMmFreeFunction(op,tar,sig,mmC)) =>
+	   mS:= nconc(m,mS)
+	"or"/[^isValidType(arg) for arg in sig] => nil
+	[dc,t,:args]:= sig
+	$Coerce or null tar or tar=t =>
+	  mS:= nconc(findFunctionInDomain(op,dc,t,args,args,NIL,'T),mS)
+  mS
+
+evalMmFreeFunction(op,tar,sig,mmC) ==
+  [dc,t,:args]:= sig
+  $Coerce or null tar or tar=t =>
+     nilArgs := nil
+     for a in args repeat nilArgs := [NIL,:nilArgs]
+     [[[["__FreeFunction__",:dc],t,:args], [t, :args], nilArgs]]
+  nil
+
+evalMmStack(mmC) ==
+  -- translates the modemap condition mmC into a list of stacks
+  mmC is ['AND,:a] =>
+    ["NCONC"/[evalMmStackInner cond for cond in a]]
+  mmC is ['OR,:args] => [:evalMmStack a for a in args]
+  mmC is ['partial,:mmD] => evalMmStack mmD
+  mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] =>
+    evalMmStack CONS('AND,[['ofCategory,pvar,c] for c in args])
+  mmC is ['ofType,:.] => [NIL]
+  mmC is ['has,pat,x] =>
+    MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
+      [[['ofCategory,pat,['CATEGORY,'unknown,x]]]]
+    [['ofCategory,pat,x]]
+  [[mmC]]
+
+evalMmStackInner(mmC) ==
+  mmC is ['OR,:args] =>
+    keyedSystemError("S2GE0016",
+      ['"evalMmStackInner",'"OR condition nested inside an AND"])
+  mmC is ['partial,:mmD] => evalMmStackInner mmD
+  mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] =>
+    [['ofCategory, pvar, c] for c in args]
+  mmC is ['ofType,:.] => NIL
+  mmC is ['isAsConstant] => NIL
+  mmC is ['has,pat,x] =>
+    MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
+      [['ofCategory,pat,['CATEGORY,'unknown,x]]]
+    [['ofCategory,pat,x]]
+  [mmC]
+
+evalMmCond(op,sig,st) ==
+  $insideEvalMmCondIfTrue : local := true
+  evalMmCond0(op,sig,st)
+
+evalMmCond0(op,sig,st) ==
+  -- evaluates the nonempty list of modemap conditions st
+  -- the result is either 'failed or a substitution list
+  SL:= evalMmDom st
+  SL='failed => 'failed
+  for p in SL until p1 and not b repeat b:=
+    p1:= ASSQ(CAR p,$Subst)
+    p1 and
+      t1:= CDR p1
+      t:= CDR p
+      t=t1 or
+	containsVars t =>
+	  if $Coerce and EQCAR(t1,'Symbol) then t1:= getSymbolType CAR p
+	  resolveTM1(t1,t)
+	$Coerce and
+	  -- if we are looking at the result of a function, the coerce
+	  -- goes the opposite direction
+	  (t1 = $AnonymousFunction and t is ['Mapping, :.]) => t
+	  CAR p = CADR sig and not member(CAR p, CDDR sig) =>
+	    canCoerceFrom(t,t1) => 'T
+	    NIL
+	  canCoerceFrom(t1,t) => 'T
+	  isSubDomain(t,t1) => RPLACD(p,t1)
+	  EQCAR(t1,'Symbol) and canCoerceFrom(getSymbolType CAR p,t)
+  ( SL and p1 and not b and 'failed ) or evalMmCat(op,sig,st,SL)
+
+fixUpTypeArgs SL ==
+  for (p := [v, :t2]) in SL repeat
+    t1 := LASSOC(v, $Subst)
+    null t1 => RPLACD(p,replaceSharpCalls t2)
+    RPLACD(p, coerceTypeArgs(t1, t2, SL))
+  SL
+
+replaceSharpCalls t ==
+  noSharpCallsHere t => t
+  doReplaceSharpCalls t
+
+doReplaceSharpCalls t ==
+  ATOM t => t
+  t is ['_#, l] => #l
+  t is ['construct,: l] => EVAL ['LIST,:l]
+  [CAR t,:[ doReplaceSharpCalls u for u in CDR t]]
+
+noSharpCallsHere t ==
+  t isnt [con, :args] => true
+  MEMQ(con,'(construct _#)) => NIL
+  and/[noSharpCallsHere u for u in args]
+
+coerceTypeArgs(t1, t2, SL) ==
+  -- if the type t has type-valued arguments, coerce them to the new types,
+  -- if needed.
+  t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2
+  con1 ^= con2 => t2
+  coSig := CDR GETDATABASE(CAR t1, 'COSIG)
+  and/coSig => t2
+  csub1 := constructSubst t1
+  csub2 := constructSubst t2
+  cs1 := CDR getConstructorSignature con1
+  cs2 := CDR getConstructorSignature con2
+  [con1, :
+    [makeConstrArg(arg1, arg2, constrArg(c1,csub1,SL),
+      constrArg(c2,csub2,SL), cs)
+       for arg1 in args1 for arg2 in args2 for c1 in cs1 for c2 in cs2
+	 for cs in coSig]]
+
+constrArg(v,sl,SL) ==
+  x := LASSOC(v,sl) =>
+    y := LASSOC(x,SL) => y
+    y := LASSOC(x, $Subst) => y
+    x
+  y := LASSOC(x, $Subst) => y
+  v
+
+makeConstrArg(arg1, arg2, t1, t2, cs) ==
+  if arg1 is ['_#, l] then arg1 := # l
+  if arg2 is ['_#, l] then arg2 := # l
+  cs => arg2
+  t1 = t2 => arg2
+  obj1 := objNewWrap(arg1, t1)
+  obj2 := coerceInt(obj1, t2)
+  null obj2 => throwKeyedMsgCannotCoerceWithValue(wrap arg1,t1,t2)
+  objValUnwrap obj2
+
+evalMmDom(st) ==
+  -- evals all isDomain(v,d) of st
+  SL:= NIL
+  for mmC in st until SL='failed repeat
+    mmC is ['isDomain,v,d] =>
+      STRINGP d => SL:= 'failed
+      p:= ASSQ(v,SL) and not (d=CDR p) => SL:= 'failed
+      d1:= subCopy(d,SL)
+      CONSP(d1) and MEMQ(v,d1) => SL:= 'failed
+      SL:= augmentSub(v,d1,SL)
+    mmC is ['isFreeFunction,v,fun] =>
+      SL:= augmentSub(v,subCopy(fun,SL),SL)
+  SL
+
+orderMmCatStack st ==
+  -- tries to reorder stack so that free pattern variables appear
+  -- as parameters first
+  null(st) or null rest(st) => st
+  vars := DELETE_-DUPLICATES [CADR(s) for s in st | isPatternVar(CADR(s))]
+  null vars => st
+  havevars := nil
+  haventvars := nil
+  for s in st repeat
+    cat := CADDR s
+    mem := nil
+    for v in vars while not mem repeat
+      if MEMQ(v,cat) then
+	mem := true
+	havevars := cons(s,havevars)
+    if not mem then haventvars := cons(s,haventvars)
+  null havevars => st
+  st := nreverse nconc(haventvars,havevars)
+  SORT(st, function mmCatComp)
+
+mmCatComp(c1, c2) ==
+  b1 := ASSQ(CADR c1, $Subst)
+  b2 := ASSQ(CADR c2, $Subst)
+  b1 and null(b2) => true
+  false
+
+evalMmCat(op,sig,stack,SL) ==
+  -- evaluates all ofCategory's of stack as soon as possible
+  $hope:local:= NIL
+  numConds:= #stack
+  stack:= orderMmCatStack [mmC for mmC in stack | EQCAR(mmC,'ofCategory)]
+  while stack until not makingProgress repeat
+    st := stack
+    stack := NIL
+    makingProgress := NIL
+    for mmC in st repeat
+      S:= evalMmCat1(mmC,op, SL)
+      S='failed and $hope =>
+	stack:= CONS(mmC,stack)
+      S = 'failed => return S
+      not atom S =>
+	makingProgress:= 'T
+	SL:= mergeSubs(S,SL)
+  if stack or S='failed then 'failed else SL
+
+evalMmCat1(mmC is ['ofCategory,d,c],op, SL) ==
+  -- evaluates mmC using information from the lisplib
+  -- d may contain variables, and the substitution list $Subst is used
+  -- the result is a substitution or failed
+  $domPvar: local := NIL
+  $hope:= NIL
+  NSL:= hasCate(d,c,SL)
+  NSL='failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) )
+    and (EQCAR(CDR p,'Variable) or EQCAR(CDR p,'Symbol)) =>
+      RPLACD(p,getSymbolType d)
+      hasCate(d,c,SL)
+  NSL='failed and isPatternVar d =>
+    -- following is hack to take care of the case where we have a
+    -- free substitution variable with a category condition on it.
+    -- This would arise, for example, where a package has an argument
+    -- that is not in a needed modemap.	 After making the following
+    -- dummy substitutions, the package can be instantiated and the
+    -- modemap used.	   RSS 12-22-85
+    -- If c is not Set, Ring or Field then the more general mechanism
+    dom := defaultTypeForCategory(c, SL)
+    null dom =>
+      op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
+    null (p := ASSQ(d,$Subst)) =>
+      dom =>
+	NSL := [CONS(d,dom)]
+      op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
+    if containsVars dom then dom := resolveTM(CDR p, dom)
+    $Coerce and canCoerce(CDR p, dom) =>
+      NSL := [CONS(d,dom)]
+    op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
+  NSL
+
+hasCate(dom,cat,SL) ==
+  -- asks whether dom has cat under SL
+  -- augments substitution SL or returns 'failed
+  dom = $EmptyMode => NIL
+  isPatternVar dom =>
+    (p:= ASSQ(dom,SL)) and ((NSL := hasCate(CDR p,cat,SL)) ^= 'failed) =>
+       NSL
+    (p:= ASSQ(dom,$Subst)) or (p := ASSQ(dom, SL)) =>
+--	S:= hasCate(CDR p,cat,augmentSub(CAR p,CDR p,copy SL))
+      S:= hasCate1(CDR p,cat,SL, dom)
+      not (S='failed) => S
+      hasCateSpecial(dom,CDR p,cat,SL)
+    if SL ^= 'failed then $hope:= 'T
+    'failed
+  SL1 := [[v,:d] for [v,:d] in SL | not containsVariables d]
+  if SL1 then cat := subCopy(cat, SL1)
+  hasCaty(dom,cat,SL)
+
+hasCate1(dom, cat, SL, domPvar) ==
+  $domPvar:local := domPvar
+  hasCate(dom, cat, SL)
+
+hasCateSpecial(v,dom,cat,SL) ==
+  -- v is a pattern variable, dom it's binding under $Subst
+  -- tries to change dom, so that it has category cat under SL
+  -- the result is a substitution list or 'failed
+  dom is ['FactoredForm,arg] =>
+    if isSubDomain(arg,$Integer) then arg := $Integer
+    d := ['FactoredRing,arg]
+    SL:= hasCate(arg,'(Ring),augmentSub(v,d,SL))
+    SL = 'failed => 'failed
+    hasCaty(d,cat,SL)
+  EQCAR(cat,'Field) or EQCAR(cat, 'DivisionRing) =>
+    if isSubDomain(dom,$Integer) then dom := $Integer
+    d:= eqType [$QuotientField, dom]
+    hasCaty(dom,'(IntegralDomain),augmentSub(v,d,SL))
+  cat is ['PolynomialCategory, d, :.] =>
+    dom' := ['Polynomial, d]
+    (containsVars d or canCoerceFrom(dom, dom'))
+       and hasCaty(dom', cat, augmentSub(v,dom',SL))
+  isSubDomain(dom,$Integer) =>
+    NSL:= hasCate($Integer,cat,augmentSub(v,$Integer,SL))
+    NSL = 'failed =>
+      hasCateSpecialNew(v, dom, cat, SL)
+    hasCaty($Integer,cat,NSL)
+  hasCateSpecialNew(v, dom, cat, SL)
+
+-- to be used in $newSystem only
+hasCateSpecialNew(v,dom,cat,SL) ==
+  fe := member(QCAR cat, '(ElementaryFunctionCategory
+       TrigonometricFunctionCategory ArcTrigonometricFunctionCategory
+	HyperbolicFunctionCategory ArcHyperbolicFunctionCategory
+	 PrimitiveFunctionCategory SpecialFunctionCategory Evalable
+	  CombinatorialOpsCategory TranscendentalFunctionCategory
+	   AlgebraicallyClosedFunctionSpace ExpressionSpace
+	     LiouvillianFunctionCategory FunctionSpace))
+  alg := member(QCAR cat, '(RadicalCategory AlgebraicallyClosedField))
+  fefull := fe or alg or EQCAR(cat, 'CombinatorialFunctionCategory)
+  partialResult :=
+    EQCAR(dom, 'Variable) or EQCAR(dom, 'Symbol) =>
+      CAR(cat) in
+       '(SemiGroup AbelianSemiGroup Monoid AbelianGroup AbelianMonoid
+         PartialDifferentialRing Ring InputForm) =>
+        	d := ['Polynomial, $Integer]
+        	augmentSub(v, d, SL)
+      EQCAR(cat, 'Group) =>
+        d := ['Fraction, ['Polynomial, $Integer]]
+        augmentSub(v, d, SL)
+      fefull =>
+        d := defaultTargetFE dom
+        augmentSub(v, d, SL)
+      'failed
+    isEqualOrSubDomain(dom, $Integer) =>
+      fe =>
+        d := defaultTargetFE $Integer
+        augmentSub(v, d, SL)
+      alg =>
+        d := '(AlgebraicNumber)
+        --d := defaultTargetFE $Integer
+        augmentSub(v, d, SL)
+      'failed
+    underDomainOf dom = $ComplexInteger =>
+      d := defaultTargetFE $ComplexInteger
+      hasCaty(d,cat,augmentSub(v, d, SL))
+    (dom = $RationalNumber) and alg =>
+      d := '(AlgebraicNumber)
+      --d := defaultTargetFE $Integer
+      augmentSub(v, d, SL)
+    fefull =>
+      d := defaultTargetFE dom
+      augmentSub(v, d, SL)
+    'failed
+  partialResult = 'failed => 'failed
+  hasCaty(d, cat, partialResult)
+
+hasCaty(d,cat,SL) ==
+  -- calls hasCat, which looks up a hashtable and returns:
+  -- 1. T, NIL or a (has x1 x2) condition, if cat is not parameterized
+  -- 2. a list of pairs (argument to cat,condition) otherwise
+  -- then the substitution SL is augmented, or the result is 'failed
+  cat is ['CATEGORY,.,:y] => hasAttSig(d,subCopy(y,constructSubst d),SL)
+  cat is ['SIGNATURE,foo,sig] =>
+    hasSig(d,foo,subCopy(sig,constructSubst d),SL)
+  cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL)
+  x:= hasCat(opOf d,opOf cat) =>
+    y:= KDR cat =>
+      S	 := constructSubst d
+      for [z,:cond] in x until not (S1='failed) repeat
+	S' := [[p, :mkDomPvar(p, d, z, y)] for [p,:d] in S]
+	if $domPvar then
+	  dom := [CAR d, :[domArg(arg, i, z, y) for i in 0..
+			   for arg in CDR d]]
+	  SL := augmentSub($domPvar, dom, copy SL)
+	z' := [domArg2(a, S, S') for a in z]
+	S1:= unifyStruct(y,z',copy SL)
+	if not (S1='failed) then S1:=
+	  atom cond => S1
+	  ncond := subCopy(cond, S)
+	  ncond is ['has, =d, =cat] => 'failed
+	  hasCaty1(ncond,S1)
+      S1
+    atom x => SL
+    ncond := subCopy(x, constructSubst d)
+    ncond is ['has, =d, =cat] => 'failed
+    hasCaty1(ncond, SL)
+  'failed
+
+mkDomPvar(p, d, subs, y) ==
+  l := MEMQ(p, $FormalMapVariableList) =>
+    domArg(d, #$FormalMapVariableList - #l, subs, y)
+  d
+
+domArg(type, i, subs, y) ==
+  p := MEMQ($FormalMapVariableList.i, subs) =>
+    y.(#subs - #p)
+  type
+
+domArg2(arg, SL1, SL2) ==
+  isSharpVar arg => subCopy(arg, SL1)
+  arg = '_$ and $domPvar => $domPvar
+  subCopy(arg, SL2)
+
+hasCaty1(cond,SL) ==
+  -- cond is either a (has a b) or an OR clause of such conditions
+  -- SL is augmented, if cond is true, otherwise the result is 'failed
+  $domPvar: local := NIL
+  cond is ['has,a,b] => hasCate(a,b,SL)
+  cond is ['AND,:args] =>
+    for x in args while not (S='failed) repeat S:=
+      x is ['has,a,b] => hasCate(a,b, SL)
+      -- next line is for an obscure bug in the table
+      x is [['has,a,b]] => hasCate(a,b, SL)
+      --'failed
+      hasCaty1(x, SL)
+    S
+  cond is ['OR,:args] =>
+    for x in args until not (S='failed) repeat S:=
+      x is ['has,a,b] => hasCate(a,b,copy SL)
+      -- next line is for an obscure bug in the table
+      x is [['has,a,b]] => hasCate(a,b,copy SL)
+      --'failed
+      hasCaty1(x, copy SL)
+    S
+  keyedSystemError("S2GE0016",
+    ['"hasCaty1",'"unexpected condition from category table"])
+
+hasAttSig(d,x,SL) ==
+  -- d is domain, x a list of attributes and signatures
+  -- the result is an augmented SL, if d has x, 'failed otherwise
+  for y in x until SL='failed repeat SL:=
+    y is ['ATTRIBUTE,a] => hasAtt(d,a,SL)
+    y is ['SIGNATURE,foo,s] => hasSig(d,foo,s,SL)
+    keyedSystemError("S2GE0016",
+      ['"hasAttSig",'"unexpected form of unnamed category"])
+  SL
+
+hasSigAnd(andCls, S0, SL) ==
+  dead := NIL
+  SA := 'failed
+  for cls in andCls while not dead repeat
+    SA :=
+      atom cls => copy SL
+      cls is ['has,a,b] =>
+	hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
+      keyedSystemError("S2GE0016",
+	['"hasSigAnd",'"unexpected condition for signature"])
+    if SA = 'failed then dead := true
+  SA
+
+hasSigOr(orCls, S0, SL) ==
+  found := NIL
+  SA := 'failed
+  for cls in orCls until found repeat
+    SA :=
+      atom cls => copy SL
+      cls is ['has,a,b] =>
+	hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
+      cls is ['AND,:andCls] or cls is ['and,:andCls] =>
+	hasSigAnd(andCls, S0, SL)
+      keyedSystemError("S2GE0016",
+	['"hasSigOr",'"unexpected condition for signature"])
+    if SA ^= 'failed then found := true
+  SA
+
+hasSig(dom,foo,sig,SL) ==
+  -- tests whether domain dom has function foo with signature sig
+  -- under substitution SL
+  $domPvar: local := nil
+  fun:= constructor? CAR dom =>
+    S0:= constructSubst dom
+    p := ASSQ(foo,getOperationAlistFromLisplib CAR dom) =>
+      for [x,.,cond,.] in CDR p until not (S='failed) repeat
+	S:=
+	  atom cond => copy SL
+	  cond is ['has,a,b] =>
+	    hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
+	  cond is ['AND,:andCls] or cond is ['and,:andCls] =>
+	    hasSigAnd(andCls, S0, SL)
+	  cond is ['OR,:orCls] or cond is ['or,:orCls] =>
+	    hasSigOr(orCls, S0, SL)
+	  keyedSystemError("S2GE0016",
+	     ['"hasSig",'"unexpected condition for signature"])
+	not (S='failed) => S:= unifyStruct(subCopy(x,S0),sig,S)
+      S
+    'failed
+  'failed
+
+hasAtt(dom,att,SL) ==
+  -- tests whether dom has attribute att under SL
+  -- needs S0 similar to hasSig above ??
+  $domPvar: local := nil
+  fun:= CAR dom =>
+    atts:= subCopy(GETDATABASE(fun,'ATTRIBUTES),constructSubst dom) =>
+      PAIRP (u := getInfovec CAR dom) =>
+	--UGH! New world has attributes stored as pairs not as lists!!
+	for [x,:cond] in atts until not (S='failed) repeat
+	  S:= unifyStruct(x,att,copy SL)
+	  not atom cond and not (S='failed) => S := hasCatExpression(cond,S)
+	S
+      for [x,cond] in atts until not (S='failed) repeat
+	S:= unifyStruct(x,att,copy SL)
+	not atom cond and not (S='failed) => S := hasCatExpression(cond,S)
+      S
+    'failed
+  'failed
+
+hasCatExpression(cond,SL) ==
+  cond is ['OR,:l] =>
+    or/[(y:=hasCatExpression(x,SL)) ^= 'failed for x in l] => y
+  cond is ['AND,:l] =>
+    and/[(SL:= hasCatExpression(x,SL)) ^= 'failed for x in l] => SL
+  cond is ['has,a,b] => hasCate(a,b,SL)
+  keyedSystemError("S2GE0016",
+    ['"hasSig",'"unexpected condition for attribute"])
+
+unifyStruct(s1,s2,SL) ==
+  -- tests for equality of s1 and s2 under substitutions SL and $Subst
+  -- the result is a substitution list or 'failed
+  s1=s2 => SL
+  if s1 is ['_:,x,.] then s1:= x
+  if s2 is ['_:,x,.] then s2:= x
+  if ^atom s1 and CAR s1 = '_# then s1:= LENGTH CADR s1
+  if ^atom s2 and CAR s2 = '_# then s2:= LENGTH CADR s2
+  s1=s2 => SL
+  isPatternVar s1 => unifyStructVar(s1,s2,SL)
+  isPatternVar s2 => unifyStructVar(s2,s1,SL)
+  atom s1 or atom s2 => 'failed
+  until null s1 or null s2 or SL='failed repeat
+    SL:= unifyStruct(CAR s1,CAR s2,SL)
+    s1:= CDR s1
+    s2:= CDR s2
+  s1 or s2 => 'failed
+  SL
+
+unifyStructVar(v,s,SL) ==
+  -- the first argument is a pattern variable, which is not substituted
+  -- by SL
+  CONTAINED(v,s) => 'failed
+  ps := LASSOC(s, SL)
+  s1 := (ps => ps; s)
+  (s0 := LASSOC(v, SL)) or (s0 := LASSOC(v,$Subst)) =>
+    S:= unifyStruct(s0,s1,copy SL)
+    S='failed =>
+      $Coerce and not atom s0 and constructor? CAR s0 =>
+	containsVars s0 or containsVars s1 =>
+	  ns0 := subCopy(s0, SL)
+	  ns1 := subCopy(s1, SL)
+	  containsVars ns0 or containsVars ns1 =>
+	    $hope:= 'T
+	    'failed
+	  if canCoerce(ns0, ns1) then s3 := s1
+	  else if canCoerce(ns1, ns0) then s3 := s0
+	  else s3 := nil
+	  s3 =>
+	    if (s3 ^= s0) then SL := augmentSub(v,s3,SL)
+	    if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL)
+	    SL
+	  'failed
+	$domPvar =>
+	  s3 := resolveTT(s0,s1)
+	  s3 =>
+	    if (s3 ^= s0) then SL := augmentSub(v,s3,SL)
+	    if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL)
+	    SL
+	  'failed
+--	  isSubDomain(s,s0) => augmentSub(v,s0,SL)
+	'failed
+      'failed
+    augmentSub(v,s,S)
+  augmentSub(v,s,SL)
+
+ofCategory(dom,cat) ==
+  -- entry point to category evaluation from other points than type
+  --   analysis
+  -- the result is true or NIL
+  $Subst:local:= NIL
+  $hope:local := NIL
+  IDENTP dom => NIL
+  cat is ['Join,:cats] => and/[ofCategory(dom,c) for c in cats]
+  (hasCaty(dom,cat,NIL) ^= 'failed)
+
+printMms(mmS) ==
+  -- mmS a list of modemap signatures
+  sayMSG '" "
+  for [sig,imp,.] in mmS for i in 1.. repeat
+    istr := STRCONC('"[",STRINGIMAGE i,'"]")
+    if QCSIZE(istr) = 3 then istr := STRCONC(istr,'" ")
+    sayMSG [:bright istr,'"signature:   ",:formatSignature CDR sig]
+    CAR sig='local =>
+      sayMSG ['"      implemented: local function ",imp]
+    imp is ['XLAM,:.] =>
+      sayMSG concat('"      implemented: XLAM from ",
+	prefix2String CAR sig)
+    sayMSG concat('"      implemented: slot ",imp,
+      '" from ",prefix2String CAR sig)
+  sayMSG '" "
+
+containsVars(t) ==
+  -- tests whether term t contains a * variable
+  atom t => isPatternVar t
+  containsVars1(t)
+
+containsVars1(t) ==
+  -- recursive version, which works on a list
+  [t1,:t2]:= t
+  atom t1 =>
+    isPatternVar t1 or
+      atom t2 => isPatternVar t2
+      containsVars1(t2)
+  containsVars1(t1) or
+    atom t2 => isPatternVar t2
+    containsVars1(t2)
+
+<<isPartialMode>>
+
+getSymbolType var ==
+-- var is a pattern variable
+  p:= ASSQ(var,$SymbolType) => CDR p
+  t:= '(Polynomial (Integer))
+  $SymbolType:= CONS(CONS(var,t),$SymbolType)
+  t
+
+isEqualOrSubDomain(d1,d2) ==
+  -- last 2 parts are for tagged unions (hack for now, RSS)
+  (d1=d2) or isSubDomain(d1,d2) or
+    (atom(d1) and ((d2 is ['Variable,=d1]) or (d2 is [=d1])))
+     or (atom(d2) and ((d1 is ['Variable,=d2]) or (d1 is [=d2])))
+
+defaultTypeForCategory(cat, SL) ==
+  -- this function returns a domain belonging to cat
+  -- note that it is important to note that in some contexts one
+  -- might not want to use this result. For example, evalMmCat1
+  -- calls this and should possibly fail in some cases.
+  cat := subCopy(cat, SL)
+  c := CAR cat
+  d := GETDATABASE(c, 'DEFAULTDOMAIN)
+  d => [d, :CDR cat]
+  cat is [c] =>
+    c = 'Field => $RationalNumber
+    c in '(Ring IntegralDomain EuclideanDomain GcdDomain
+      OrderedRing DifferentialRing) => '(Integer)
+    c = 'OrderedSet => $Symbol
+    c = 'FloatingPointSystem => '(Float)
+    NIL
+  cat is [c,p1] =>
+    c = 'FiniteLinearAggregate => ['Vector, p1]
+    c = 'VectorCategory => ['Vector, p1]
+    c = 'SetAggregate => ['Set, p1]
+    c = 'SegmentCategory => ['Segment, p1]
+    NIL
+  cat is [c,p1,p2] =>
+    NIL
+  cat is [c,p1,p2,p3] =>
+    cat is ['MatrixCategory, d, ['Vector, =d], ['Vector, =d]] =>
+      ['Matrix, d]
+    NIL
+  NIL
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-intern.boot.pamphlet b/src/interp/i-intern.boot.pamphlet
new file mode 100644
index 00000000..144aa0e5
--- /dev/null
+++ b/src/interp/i-intern.boot.pamphlet
@@ -0,0 +1,818 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-intern.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+Internal Interpreter Facilities
+
+Vectorized Attributed Trees
+
+The interpreter translates parse forms into vats for analysis.
+These contain a number of slots in each node for information.
+The leaves are now all vectors, though the leaves for basic types
+such as integers and strings used to just be the objects themselves.
+The vectors for the leaves with such constants now have the value
+of $immediateDataSymbol as their name. Their are undoubtably still
+some functions that still check whether a leaf is a constant. Note
+that if it is not a vector it is a subtree.
+
+attributed tree nodes have the following form:
+slot         description
+----         -----------------------------------------------------
+ 0           operation name or literal
+ 1           declared mode of variable
+ 2           computed value of subtree from this node
+ 3           modeset: list of single computed mode of subtree
+ 4           prop list for extra things
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+SETANDFILEQ($useParserSrcPos, NIL)
+SETANDFILEQ($transferParserSrcPos, NIL)
+
+--  Making Trees
+
+mkAtreeNode x ==
+  -- maker of attrib tree node
+  v := MAKE_-VEC 5
+  v.0 := x
+  v
+
+mkAtree x ==
+  -- maker of attrib tree from parser form
+  mkAtree1 mkAtreeExpandMacros x
+
+mkAtreeWithSrcPos(form, posnForm) ==
+    posnForm and $useParserSrcPos => pf2Atree(posnForm)
+    transferSrcPosInfo(posnForm, mkAtree form)
+
+mkAtree1WithSrcPos(form, posnForm) ==
+  transferSrcPosInfo(posnForm, mkAtree1 form)
+
+mkAtreeNodeWithSrcPos(form, posnForm) ==
+  transferSrcPosInfo(posnForm, mkAtreeNode form)
+
+transferSrcPosInfo(pf, atree) ==
+    not (pf and $transferParserSrcPos) => atree
+    pos := pfPosOrNopos(pf)
+    pfNoPosition?(pos) => atree
+
+    -- following is a hack because parser code for getting filename
+    -- seems wrong.
+    fn := lnPlaceOfOrigin poGetLineObject(pos)
+    if NULL fn or fn = '"strings" then fn := '"console"
+
+    putSrcPos(atree, fn, pfSourceText(pf), pfLinePosn(pos), pfCharPosn(pos))
+    atree
+
+mkAtreeExpandMacros x ==
+  -- handle macro expansion. if the macros have args we require that
+  -- we match the correct number of args
+  if x isnt ['MDEF,:.] and x isnt ['DEF,['macro,:.],:.] then
+    atom x and (m := isInterpMacro x) =>
+      [args,:body] := m
+      args => 'doNothing
+      x := body
+    x is [op,:argl] =>
+      op = 'QUOTE => 'doNothing
+      op = 'where and argl is [before,after] =>
+        -- in a where clause, what follows "where" (the "after" parm
+        -- above) might be a local macro, so do not expand the "before"
+        -- part yet
+        x := [op,before,mkAtreeExpandMacros after]
+      argl := [mkAtreeExpandMacros a for a in argl]
+      (m := isInterpMacro op) =>
+        [args,:body] := m
+        #args = #argl =>
+          sl := [[a,:s] for a in args for s in argl]
+          x := SUBLISNQ(sl,body)
+        null args => x := [body,:argl]
+        x := [op,:argl]
+      x := [mkAtreeExpandMacros op,:argl]
+  x
+
+mkAtree1 x ==
+  -- first special handler for making attrib tree
+  null x => throwKeyedMsg("S2IP0005",['"NIL"])
+  VECP x => x
+  atom x =>
+    x in '(noBranch noMapVal) => x
+    x in '(nil true false) => mkAtree2([x],x,NIL)
+    x = '_/throwAway =>
+      -- don't want to actually compute this
+      tree := mkAtree1 '(void)
+      putValue(tree,objNewWrap(voidValue(),$Void))
+      putModeSet(tree,[$Void])
+      tree
+    getBasicMode x =>
+      v := mkAtreeNode $immediateDataSymbol
+      putValue(v,getBasicObject x)
+      v
+    IDENTP x => mkAtreeNode x
+    keyedSystemError("S2II0002",[x])
+  x is [op,:argl] => mkAtree2(x,op,argl)
+  systemErrorHere '"mkAtree1"
+
+-- mkAtree2 and mkAtree3 were created because mkAtree1 got so big
+
+mkAtree2(x,op,argl) ==
+  nargl := #argl
+  (op= '_-) and (nargl = 1) and (INTEGERP CAR argl) =>
+    mkAtree1(MINUS CAR argl)
+  op='_: and argl is [y,z] => [mkAtreeNode 'Declare,:argl]
+  op='COLLECT => [mkAtreeNode op,:transformCollect argl]
+  op= 'break =>
+    argl is [.,val] =>
+      if val = '$NoValue then val := '(void)
+      [mkAtreeNode op,mkAtree1 val]
+    [mkAtreeNode op,mkAtree1 '(void)]
+  op= 'return =>
+    argl is [val] =>
+      if val = '$NoValue then val := '(void)
+      [mkAtreeNode op,mkAtree1 val]
+    [mkAtreeNode op,mkAtree1 '(void)]
+  op='exit => mkAtree1 CADR argl
+  op = 'QUOTE => [mkAtreeNode op,:argl]
+  op='SEGMENT =>
+    argl is [a] => [mkAtreeNode op, mkAtree1 a]
+    z :=
+      null argl.1 => nil
+      mkAtree1 argl.1
+    [mkAtreeNode op, mkAtree1 argl.0,z]
+  op in '(pretend is isnt) =>
+    [mkAtreeNode op,mkAtree1 first argl,:rest argl]
+  op =  '_:_: =>
+    [mkAtreeNode 'COERCE,mkAtree1 first argl,CADR argl]
+  x is ['_@, expr, type] =>
+    t := evaluateType unabbrev type
+    t = '(DoubleFloat) and expr is [['_$elt, '(Float), 'float], :args] =>
+        mkAtree1 [['_$elt, '(DoubleFloat), 'float], :args]
+    t = '(DoubleFloat) and INTEGERP expr =>
+        v := mkAtreeNode $immediateDataSymbol
+        putValue(v,getBasicObject float expr)
+        v
+    t = '(Float) and INTEGERP expr =>
+        mkAtree1 ["::", expr, t]
+    typeIsASmallInteger(t) and INTEGERP expr =>
+        mkAtree1 ["::", expr, t]
+    [mkAtreeNode 'TARGET,mkAtree1 expr, type]
+  (op='case) and (nargl = 2)  =>
+    [mkAtreeNode 'case,mkAtree1 first argl,unabbrev CADR argl]
+  op='REPEAT => [mkAtreeNode op,:transformREPEAT argl]
+  op='LET and argl is [['construct,:.],rhs] =>
+    [mkAtreeNode 'LET,first argl,mkAtree1 rhs]
+  op='LET and argl is [['_:,a,.],rhs] =>
+    mkAtree1 ['SEQ,first argl,['LET,a,rhs]]
+  op is ['_$elt,D,op1] =>
+    op1 is '_= =>
+      a' := [mkAtreeNode '_=,:[mkAtree1 arg for arg in argl]]
+      [mkAtreeNode 'Dollar,D,a']
+    [mkAtreeNode 'Dollar,D,mkAtree1 [op1,:argl]]
+  op='_$elt =>
+    argl is [D,a] =>
+      INTEGERP a =>
+        a = 0 => mkAtree1 [['_$elt,D,'Zero]]
+        a = 1 => mkAtree1 [['_$elt,D,'One]]
+        t := evaluateType unabbrev [D]
+        typeIsASmallInteger(t) and SINTP a =>
+            v := mkAtreeNode $immediateDataSymbol
+            putValue(v,mkObjWrap(a, t))
+            v
+        mkAtree1 ["*",a,[['_$elt,D,'One]]]
+      [mkAtreeNode 'Dollar,D,mkAtree1 a]
+    keyedSystemError("S2II0003",['"$",argl,
+      '"not qualifying an operator"])
+  mkAtree3(x,op,argl)
+
+mkAtree3(x,op,argl) ==
+  op='REDUCE and argl is [op1,axis,body] =>
+    [mkAtreeNode op,axis,mkAtree1 op1,mkAtree1 body]
+  op='has => [mkAtreeNode op, :argl]
+  op='_| => [mkAtreeNode 'AlgExtension,:[mkAtree1 arg for arg in argl]]
+  op='_= => [mkAtreeNode 'equation,:[mkAtree1 arg for arg in argl]]
+  op='not and argl is [["=",lhs,rhs]] =>
+    [mkAtreeNode 'not,[mkAtreeNode "=",mkAtree1 lhs,mkAtree1 rhs]]
+  op='in and argl is [var ,['SEGMENT,lb,ul]] =>
+    upTest:=
+      null ul => NIL
+      mkLessOrEqual(var,ul)
+    lowTest:=mkLessOrEqual(lb,var)
+    z :=
+      ul => ['and,lowTest,upTest]
+      lowTest
+    mkAtree1 z
+  x is ['IF,p,'noBranch,a] => mkAtree1 ['IF,['not,p],a,'noBranch]
+  x is ['RULEDEF,:.] => [mkAtreeNode 'RULEDEF,:CDR x]
+  x is ['MDEF,sym,junk1,junk2,val] =>
+    -- new macros look like  macro f ==  or macro f(x) ===
+    -- so transform into that format
+    mkAtree1 ['DEF,['macro,sym],junk1,junk2,val]
+  x is ["~=",a,b] => mkAtree1 ['not,["=",a,b]]
+  x is ["+->",funargs,funbody] =>
+    if funbody is [":",body,type] then
+      types := [type]
+      funbody := body
+    else types := [NIL]
+    v := collectDefTypesAndPreds funargs
+    types := [:types,:v.1]
+    [mkAtreeNode 'ADEF,[v.0,types,[NIL for a in types],funbody],
+      if v.2 then v.2 else true, false]
+  x is ['ADEF,arg,:r] =>
+    r := mkAtreeValueOf r
+    v :=
+      null arg => VECTOR(NIL,NIL,NIL)
+      PAIRP arg and rest arg and first arg^= "|" =>
+        collectDefTypesAndPreds ['Tuple,:arg]
+      null rest arg => collectDefTypesAndPreds first arg
+      collectDefTypesAndPreds arg
+    [types,:r'] := r
+    at := [fn(x,y) for x in rest types for y in v.1] where
+      fn(a,b) ==
+        a and b =>
+          if a = b then a
+          else throwMessage '"   double declaration of parameter"
+        a or b
+    r := [[first types,:at],:r']
+    [mkAtreeNode 'ADEF,[v.0,:r],if v.2 then v.2 else true,false]
+  x is ['where,before,after] =>
+    [mkAtreeNode 'where,before,mkAtree1 after]
+  x is ['DEF,['macro,form],.,.,body] =>
+    [mkAtreeNode 'MDEF,form,body]
+  x is ['DEF,a,:r] =>
+    r := mkAtreeValueOf r
+    a is [op,:arg] =>
+      v :=
+        null arg => VECTOR(NIL,NIL,NIL)
+        PAIRP arg and rest arg and first arg^= "|" =>
+          collectDefTypesAndPreds ['Tuple,:arg]
+        null rest arg => collectDefTypesAndPreds first arg
+        collectDefTypesAndPreds arg
+      [types,:r'] := r
+      -- see case for ADEF above for defn of fn
+      at := [fn(x,y) for x in rest types for y in v.1]
+      r := [[first types,:at],:r']
+      [mkAtreeNode 'DEF,[[op,:v.0],:r],if v.2 then v.2 else true,false]
+    [mkAtreeNode 'DEF,[a,:r],true,false]
+--x is ['when,y,pred] =>
+--  y isnt ['DEF,a,:r] =>
+--    keyedSystemError("S2II0003",['"when",y,'"improper argument form"])
+--  a is [op,p1,:pr] =>
+--    null pr => mkAtree1 ['DEF,[op,["|",p1,pred]],:r]
+--    mkAtree1 ['DEF,[op,["|",['Tuple,p1,:pr],pred]],:r]
+--  [mkAtreeNode 'DEF, CDR y,pred,false]
+--x is ['otherwise,u] =>
+--  throwMessage '"   otherwise is no longer supported."
+  z :=
+    getBasicMode op =>
+      v := mkAtreeNode $immediateDataSymbol
+      putValue(v,getBasicObject op)
+      v
+    atom op => mkAtreeNode op
+    mkAtree1 op
+  [z,:[mkAtree1 y for y in argl]]
+
+collectDefTypesAndPreds args ==
+  -- given an arglist to a DEF-like form, this function returns
+  -- a vector of three things:
+  --   slot 0: just the variables
+  --   slot 1: the type declarations on the variables
+  --   slot 2: a predicate for all arguments
+  pred := types := vars := NIL
+  junk :=
+    IDENTP args =>
+      types := [NIL]
+      vars  := [args]
+    args is [":",var,type] =>
+      types := [type]
+      var is ["|",var',p] =>
+        vars := [var']
+        pred := addPred(pred,p) where
+          addPred(old,new) ==
+            null new => old
+            null old => new
+            ['and,old,new]
+      vars := [var]
+    args is ["|",var,p] =>
+      pred := addPred(pred,p)
+      var is [":",var',type] =>
+        types := [type]
+        vars := [var']
+      var is ['Tuple,:.] or var is ["|",:.] =>
+        v := collectDefTypesAndPreds var
+        vars  := [:vars,:v.0]
+        types := [:types,:v.1]
+        pred  := addPred(pred,v.2)
+      vars := [var]
+      types := [NIL]
+    args is ['Tuple,:args'] =>
+      for a in args' repeat
+        v := collectDefTypesAndPreds a
+        vars  := [:vars,first v.0]
+        types := [:types,first v.1]
+        pred  := addPred(pred,v.2)
+    types := [NIL]
+    vars  := [args]
+  VECTOR(vars,types,pred)
+
+mkAtreeValueOf l ==
+  -- scans for ['valueOf,atom]
+  not CONTAINED('valueOf,l) => l
+  mkAtreeValueOf1 l
+
+mkAtreeValueOf1 l ==
+  null l or atom l or null rest l => l
+  l is ['valueOf,u] and IDENTP u =>
+    v := mkAtreeNode $immediateDataSymbol
+    putValue(v,get(u,'value,$InteractiveFrame) or
+      objNewWrap(u,['Variable,u]))
+    v
+  [mkAtreeValueOf1 x for x in l]
+
+mkLessOrEqual(lhs,rhs) == ['not,['_<,rhs,lhs]]
+
+emptyAtree expr ==
+  -- remove mode, value, and misc. info from attrib tree
+  VECP expr =>
+    $immediateDataSymbol = expr.0 => nil
+    expr.1:= NIL
+    expr.2:= NIL
+    expr.3:= NIL
+    -- kill proplist too?
+  atom expr => nil
+  for e in expr repeat emptyAtree e
+
+unVectorize body ==
+  -- transforms from an atree back into a tree
+  VECP body =>
+    name := getUnname body
+    name ^= $immediateDataSymbol => name
+    objValUnwrap getValue body
+  atom body => body
+  body is [op,:argl] =>
+    newOp:=unVectorize op
+    if newOp = 'SUCHTHAT then newOp := '_|
+    if newOp = 'COERCE then newOp := '_:_:
+    if newOp = 'Dollar then newOp := "$elt"
+    [newOp,:unVectorize argl]
+  systemErrorHere '"unVectorize"
+
+
+--  Stuffing and Getting Info
+
+putAtree(x,prop,val) ==
+  x is [op,:.] =>
+    -- only willing to add property if op is a vector
+    -- otherwise will be pushing to deeply into calling structure
+    if VECP op then putAtree(op,prop,val)
+    x
+  null VECP x => x     -- just ignore it
+  n := QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3)))
+    => x.n := val
+  x.4 := insertShortAlist(prop,val,x.4)
+  x
+
+getAtree(x,prop) ==
+  x is [op,:.] =>
+    -- only willing to get property if op is a vector
+    -- otherwise will be pushing to deeply into calling structure
+    VECP op => getAtree(op,prop)
+    NIL
+  null VECP x => NIL     -- just ignore it
+  n:= QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3)))
+    => x.n
+  QLASSQ(prop,x.4)
+
+putTarget(x, targ) ==
+  -- want to put nil modes perhaps to clear old target
+  if targ = $EmptyMode then targ := nil
+  putAtree(x,'target,targ)
+
+getTarget(x) == getAtree(x,'target)
+
+insertShortAlist(prop,val,al) ==
+  pair := QASSQ(prop,al) =>
+    RPLACD(pair,val)
+    al
+  [[prop,:val],:al]
+
+transferPropsToNode(x,t) ==
+  propList := getProplist(x,$env)
+  QLASSQ('Led,propList) or QLASSQ('Nud,propList) => nil
+  node :=
+    VECP t => t
+    first t
+  for prop in '(mode localModemap value name generatedCode)
+    repeat transfer(x,node,prop)
+      where
+        transfer(x,node,prop) ==
+          u := get(x,prop,$env) => putAtree(node,prop,u)
+          (not (x in $localVars)) and (u := get(x,prop,$e)) =>
+            putAtree(node,prop,u)
+  if not getMode(t) and (am := get(x,'automode,$env)) then
+    putModeSet(t,[am])
+    putMode(t,am)
+  t
+
+isLeaf x == atom x     --may be a number or a vector
+
+getMode x ==
+  x is [op,:.] => getMode op
+  VECP x => x.1
+  m := getBasicMode x => m
+  keyedSystemError("S2II0001",[x])
+
+putMode(x,y) ==
+  x is [op,:.] => putMode(op,y)
+  null VECP x => keyedSystemError("S2II0001",[x])
+  x.1 := y
+
+getValue x ==
+  VECP x => x.2
+  atom x =>
+    t := getBasicObject x => t
+    keyedSystemError("S2II0001",[x])
+  getValue first x
+
+putValue(x,y) ==
+  x is [op,:.] => putValue(op,y)
+  null VECP x => keyedSystemError("S2II0001",[x])
+  x.2 := y
+
+putValueValue(vec,val) ==
+  putValue(vec,val)
+  vec
+
+getUnnameIfCan x ==
+  VECP x => x.0
+  x is [op,:.] => getUnnameIfCan op
+  atom x => x
+  nil
+
+getUnname x ==
+  x is [op,:.] => getUnname op
+  getUnname1 x
+
+getUnname1 x ==
+  VECP x => x.0
+  null atom x => keyedSystemError("S2II0001",[x])
+  x
+
+computedMode t ==
+  getModeSet t is [m] => m
+  keyedSystemError("S2GE0016",['"computedMode",'"non-singleton modeset"])
+
+putModeSet(x,y) ==
+  x is [op,:.] => putModeSet(op,y)
+  not VECP x => keyedSystemError("S2II0001",[x])
+  x.3 := y
+  y
+
+getModeOrFirstModeSetIfThere x ==
+  x is [op,:.] => getModeOrFirstModeSetIfThere op
+  VECP x =>
+    m := x.1 => m
+    val := x.2 => objMode val
+    y := x.aModeSet =>
+      (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => m
+      first y
+    NIL
+  m := getBasicMode x => m
+  NIL
+
+getModeSet x ==
+  x and PAIRP x => getModeSet first x
+  VECP x =>
+    y:= x.aModeSet =>
+      (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) =>
+        [m]
+      y
+    keyedSystemError("S2GE0016",['"getModeSet",'"no mode set"])
+  m:= getBasicMode x => [m]
+  null atom x => getModeSet first x
+  keyedSystemError("S2GE0016",['"getModeSet",
+    '"not an attributed tree"])
+
+getModeSetUseSubdomain x ==
+  x and PAIRP x => getModeSetUseSubdomain first x
+  VECP(x) =>
+    -- don't play subdomain games with retracted args
+    getAtree(x,'retracted) => getModeSet x
+    y := x.aModeSet =>
+      (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) =>
+        [m]
+      val := getValue x
+      (x.0 = $immediateDataSymbol) and (y = [$Integer]) =>
+        val := objValUnwrap val
+        m := getBasicMode0(val,true)
+        x.2 := objNewWrap(val,m)
+        x.aModeSet := [m]
+        [m]
+      null val => y
+      isEqualOrSubDomain(objMode(val),$Integer) and
+        INTEGERP(f := objValUnwrap val) =>
+          [getBasicMode0(f,true)]
+      y
+    keyedSystemError("S2GE0016",
+      ['"getModeSetUseSubomain",'"no mode set"])
+  m := getBasicMode0(x,true) => [m]
+  null atom x => getModeSetUseSubdomain first x
+  keyedSystemError("S2GE0016",
+    ['"getModeSetUseSubomain",'"not an attributed tree"])
+
+atree2EvaluatedTree x == atree2Tree1(x,true)
+
+atree2Tree1(x,evalIfTrue) ==
+  (triple := getValue x) and objMode(triple) ^= $EmptyMode =>
+    coerceOrCroak(triple,$OutputForm,$mapName)
+  isLeaf x =>
+    VECP x => x.0
+    x
+  [atree2Tree1(y,evalIfTrue) for y in x]
+
+--% Environment Utilities
+
+-- getValueFromEnvironment(x,mode) ==
+--   $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v
+--   $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e))   => v
+--   throwKeyedMsg("S2IE0001",[x])
+getValueFromEnvironment(x,mode) ==
+  $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v
+  $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e))   => v
+  null(v := coerceInt(objNew(x, ['Variable, x]), mode)) =>
+     throwKeyedMsg("S2IE0001",[x])
+  objValUnwrap v
+
+getValueFromSpecificEnvironment(id,mode,e) ==
+  PAIRP e =>
+    u := get(id,'value,e) =>
+      objMode(u) = $EmptyMode =>
+        systemErrorHere '"getValueFromSpecificEnvironment"
+      v := objValUnwrap u
+      mode isnt ['Mapping,:mapSig] => v
+      v isnt ['MAP,:.] => v
+      v' := coerceInt(u,mode)
+      null v' => throwKeyedMsg("S2IC0002",[objMode u,mode])
+      objValUnwrap v'
+
+    m := get(id,'mode,e) =>
+      -- See if we can make it into declared mode from symbolic form
+      -- For example, (x : P[x] I; x + 1)
+      if isPartialMode(m) then m' := resolveTM(['Variable,id],m)
+      else m' := m
+      m' and
+        (u := coerceInteractive(objNewWrap(id,['Variable,id]),m')) =>
+          objValUnwrap u
+
+      throwKeyedMsg("S2IE0002",[id,m])
+    $failure
+  $failure
+
+addBindingInteractive(var,proplist,e is [[curContour,:.],:.]) ==
+  -- change proplist of var in e destructively
+  u := ASSQ(var,curContour) =>
+    RPLACD(u,proplist)
+    e
+  RPLAC(CAAR e,[[var,:proplist],:curContour])
+  e
+
+augProplistInteractive(proplist,prop,val) ==
+  u := ASSQ(prop,proplist) =>
+    RPLACD(u,val)
+    proplist
+  [[prop,:val],:proplist]
+
+getFlag x == get("--flags--",x,$e)
+
+putFlag(flag,value) ==
+  $e := put ("--flags--", flag, value, $e)
+
+get(x,prop,e) ==
+  $InteractiveMode => get0(x,prop,e)
+  get1(x,prop,e)
+
+get0(x,prop,e) ==
+  null atom x => get(QCAR x,prop,e)
+  u:= QLASSQ(x,CAR QCAR e) => QLASSQ(prop,u)
+  (tail:= CDR QCAR e) and (u:= fastSearchCurrentEnv(x,tail)) =>
+    QLASSQ(prop,u)
+  nil
+
+get1(x,prop,e) ==
+    --this is the old get
+  null atom x => get(QCAR x,prop,e)
+  prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
+    LASSOC("modemap",getProplist(x,$CapsuleModemapFrame))
+      or get2(x,prop,e)
+  LASSOC(prop,getProplist(x,e)) or get2(x,prop,e)
+
+get2(x,prop,e) ==
+  prop="modemap" and constructor? x =>
+    (u := getConstructorModemap(x)) => [u]
+    nil
+  nil
+
+getI(x,prop) == get(x,prop,$InteractiveFrame)
+
+putI(x,prop,val) == ($InteractiveFrame := put(x,prop,val,$InteractiveFrame))
+
+getIProplist x == getProplist(x,$InteractiveFrame)
+
+removeBindingI x ==
+  RPLAC(CAAR $InteractiveFrame,deleteAssocWOC(x,CAAR $InteractiveFrame))
+
+rempropI(x,prop) ==
+  id:=
+    atom x => x
+    first x
+  getI(id,prop) =>
+    recordNewValue(id,prop,NIL)
+    recordOldValue(id,prop,getI(id,prop))
+    $InteractiveFrame:= remprop(id,prop,$InteractiveFrame)
+
+remprop(x,prop,e) ==
+  u:= ASSOC(prop,pl:= getProplist(x,e)) =>
+    e:= addBinding(x,DELASC(first u,pl),e)
+    e
+  e
+
+fastSearchCurrentEnv(x,currentEnv) ==
+  u:= QLASSQ(x,CAR currentEnv) => u
+  while (currentEnv:= QCDR currentEnv) repeat
+    u:= QLASSQ(x,CAR currentEnv) => u
+
+put(x,prop,val,e) ==
+  $InteractiveMode and not EQ(e,$CategoryFrame) =>
+    putIntSymTab(x,prop,val,e)
+  --e must never be $CapsuleModemapFrame
+  null atom x => put(first x,prop,val,e)
+  newProplist:= augProplistOf(x,prop,val,e)
+  prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
+    SAY ["**** modemap PUT on CapsuleModemapFrame: ",val]
+    $CapsuleModemapFrame:=
+      addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame),
+        $CapsuleModemapFrame)
+    e
+  addBinding(x,newProplist,e)
+
+putIntSymTab(x,prop,val,e) ==
+  null atom x => putIntSymTab(first x,prop,val,e)
+  pl0 := pl := search(x,e)
+  pl :=
+    null pl => [[prop,:val]]
+    u := ASSQ(prop,pl) =>
+      RPLACD(u,val)
+      pl
+    lp := LASTPAIR pl
+    u := [[prop,:val]]
+    RPLACD(lp,u)
+    pl
+  EQ(pl0,pl) => e
+  addIntSymTabBinding(x,pl,e)
+
+addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) ==
+  -- change proplist of var in e destructively
+  u := ASSQ(var,curContour) =>
+    RPLACD(u,proplist)
+    e
+  RPLAC(CAAR e,[[var,:proplist],:curContour])
+  e
+
+
+--% Source and position information
+
+-- In the following, src is a string containing an original input line,
+-- line is the line number of the string within the source file,
+-- and col is the index within src of the start of the form represented
+-- by x. x is a VAT.
+
+putSrcPos(x, file, src, line, col) ==
+    putAtree(x, 'srcAndPos, srcPos_New(file, src, line, col))
+
+getSrcPos(x) == getAtree(x, 'srcAndPos)
+
+srcPosNew(file, src, line, col) == LIST2VEC [file, src, line, col]
+
+srcPosFile(sp) ==
+    if sp then sp.0 else nil
+
+srcPosSource(sp) ==
+    if sp then sp.1 else nil
+
+srcPosLine(sp) ==
+    if sp then sp.2 else nil
+
+srcPosColumn(sp) ==
+    if sp then sp.3 else nil
+
+srcPosDisplay(sp) ==
+    null sp => nil
+    s := STRCONC('"_"", srcPosFile sp, '"_", line ",
+        STRINGIMAGE srcPosLine sp, '": ")
+    sayBrightly [s, srcPosSource sp]
+    col  := srcPosColumn sp
+    dots :=
+        col = 0 => '""
+        fillerSpaces(col, '".")
+    sayBrightly [fillerSpaces(#s, '" "), dots, '"^"]
+    true
+
+--% Functions on interpreter objects
+
+-- Interpreter objects used to be called triples because they had the
+-- structure [value, type, environment].  For many years, the environment
+-- was not used, so finally in January, 1990, the structure of objects
+-- was changed to be (type . value).  This was chosen because it was the
+-- structure of objects of type Any.  Sometimes the values are wrapped
+-- (see the function isWrapped to see what this means physically).
+-- Wrapped values are not actual values belonging to their types.  An
+-- unwrapped value must be evaluated to get an actual value.  A wrapped
+-- value must be unwrapped before being passed to a library function.
+-- Typically, an unwrapped value in the interpreter consists of LISP
+-- code, e.g., parts of a function that is being constructed.
+--                 RSS 1/14/90
+
+-- These are the new structure functions.
+
+mkObj(val, mode) == CONS(mode,val)              -- old names
+mkObjWrap(val, mode) == CONS(mode,wrap val)
+mkObjCode(val, mode) == ['CONS, MKQ mode,val ]
+
+objNew(val, mode) == CONS(mode,val)             -- new names as of 10/14/93
+objNewWrap(val, mode) == CONS(mode,wrap val)
+objNewCode(val, mode) == ['CONS, MKQ mode,val ]
+objSetVal(obj,val) == RPLACD(obj,val)
+objSetMode(obj,mode) == RPLACA(obj,mode)
+
+objVal obj == CDR obj
+objValUnwrap obj == unwrap CDR obj
+objMode obj == CAR obj
+objEnv obj == $NE
+
+objCodeVal obj == CADDR obj
+objCodeMode obj == CADR obj
+
+
+
+
+--% Library compiler structures needed by the interpreter
+
+-- Tuples and Crosses
+
+asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts)
+asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts)
+
+asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]]
+asTupleNewCode0(listForm) == ["asTupleNew0", listForm]
+
+asTupleSize(at) == CAR at
+asTupleAsVector(at) == CDR at
+asTupleAsList(at) == VEC2LIST asTupleAsVector at
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-map.boot.pamphlet b/src/interp/i-map.boot.pamphlet
new file mode 100644
index 00000000..b66f02b9
--- /dev/null
+++ b/src/interp/i-map.boot.pamphlet
@@ -0,0 +1,1185 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-map.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% User Function Creation and Analysis Code
+
+SETANDFILEQ($mapTarget,nil)
+SETANDFILEQ($mapReturnTypes,nil)
+SETANDFILEQ($mapName,'noMapName)
+SETANDFILEQ($mapThrowCount, 0) -- times a "return" occurs in map
+SETANDFILEQ($compilingMap, NIL)
+SETANDFILEQ($definingMap, NIL)
+
+--% Generating internal names for functions
+
+SETANDFILEQ($specialMapNameSuffix, NIL)
+
+makeInternalMapName(userName,numArgs,numMms,extraPart) ==
+  name := CONCAT('"*",STRINGIMAGE numArgs,'";",
+    object2String userName,'";",STRINGIMAGE numMms,'";",
+      object2String frameName first $interpreterFrameRing )
+  if extraPart then name := CONCAT(name,'";",extraPart)
+  if $specialMapNameSuffix then
+    name := CONCAT(name,'";",$specialMapNameSuffix)
+  INTERN name
+
+isInternalMapName name ==
+  -- this only returns true or false as a "best guess"
+  (not IDENTP(name)) or (name = "*") or (name = "**") => false
+  sz := SIZE (name' := PNAME name)
+  (sz < 7) or (char("*") ^= name'.0) => false
+  null DIGITP name'.1 => false
+  null STRPOS('"_;",name',1,NIL) => false
+  -- good enough
+  true
+
+makeInternalMapMinivectorName(name) ==
+  STRINGP name =>
+    INTERN STRCONC(name,'";MV")
+  INTERN STRCONC(PNAME name,'";MV")
+
+mkCacheName(name) == INTERNL(STRINGIMAGE name,'";AL")
+
+mkAuxiliaryName(name) == INTERNL(STRINGIMAGE name,'";AUX")
+
+--% Adding a function definition
+
+isMapExpr x == x is ['MAP,:.]
+
+isMap x ==
+  y := get(x,'value,$InteractiveFrame) =>
+    objVal y is ['MAP,:.] => x
+
+addDefMap(['DEF,lhs,mapsig,.,rhs],pred) ==
+  -- Create a new map, add to an existing one, or define a variable
+  --   compute the dependencies for a map
+
+  -- next check is for bad forms on the lhs of the ==, such as
+  -- numbers, constants.
+  if not PAIRP lhs then
+    op := lhs
+    putHist(op,'isInterpreterRule,true,$e)
+    putHist(op,'isInterpreterFunction,false,$e)
+    lhs := [lhs]
+  else
+    -- this is a function definition. If it has been declared
+    -- previously, make sure it is Mapping.
+    op := first lhs
+    (oldMode := get(op,'mode,$e)) and oldMode isnt ['Mapping,:.] =>
+      throwKeyedMsg("S2IM0001",[op,oldMode])
+    putHist(op,'isInterpreterRule,false,$e)
+    putHist(op,'isInterpreterFunction,true,$e)
+
+  (NUMBERP(op) or op in '(true false nil % %%)) =>
+    throwKeyedMsg("S2IM0002",[lhs])
+
+  -- verify a constructor abbreviation is not used on the lhs
+  op ^= (op' := unabbrev op) => throwKeyedMsg("S2IM0003",[op,op'])
+
+  -- get the formal parameters. These should only be atomic symbols
+  -- that are not numbers.
+  parameters := [p for p in rest lhs | IDENTP(p)]
+
+  -- see if a signature has been given. if anything in mapsig is NIL,
+  -- then declaration was omitted.
+  someDecs := nil
+  allDecs := true
+  mapmode := ['Mapping]
+  $env:local := [[NIL]]
+  $eval:local := true           --generate code-- don't just type analyze
+  $genValue:local := true       --evaluate all generated code
+  for d in mapsig repeat
+    if d then
+      someDecs := true
+      d' := evaluateType unabbrev d
+      isPartialMode d' => throwKeyedMsg("S2IM0004",NIL)
+--      tree := mkAtree d'
+--      null (d' := isType tree) => throwKeyedMsg("S2IM0005",[d])
+      mapmode := [d',:mapmode]
+    else allDecs := false
+  if allDecs then
+    mapmode := nreverse mapmode
+    putHist(op,'mode,mapmode,$e)
+    sayKeyedMsg("S2IM0006",[formatOpSignature(op,rest mapmode)])
+  else if someDecs then throwKeyedMsg("S2IM0007",[op])
+
+  -- if map is declared, check that signature arg count is the
+  -- same as what is given.
+  if get(op,'mode,$e) is ['Mapping,.,:mapargs] then
+    EQCAR(rhs,'rules) =>
+      0 ^= (numargs := # rest lhs) =>
+        throwKeyedMsg("S2IM0027",[numargs,op])
+    # rest lhs ^= # mapargs => throwKeyedMsg("S2IM0008",[op])
+  --get all the user variables in the map definition.  This is a multi
+  --step process as this should not include recursive calls to the map
+  --itself, or the formal parameters
+  userVariables1 := getUserIdentifiersIn rhs
+  $freeVars: local := NIL
+  $localVars: local := NIL
+  for parm in parameters repeat mkLocalVar($mapName,parm)
+  userVariables2 := setDifference(userVariables1,findLocalVars(op,rhs))
+  userVariables3 := setDifference(userVariables2, parameters)
+  userVariables4 := REMDUP setDifference (userVariables3, [op])
+
+  --figure out the new dependencies for the new map (what it depends on)
+  newDependencies := makeNewDependencies (op, userVariables4)
+  putDependencies (op, newDependencies)
+  clearDependencies(op,'T)
+  addMap(lhs,rhs,pred)
+
+addMap(lhs,rhs,pred) ==
+  [op,:argl] := lhs
+  $sl: local:= nil
+  formalArgList:= [mkFormalArg(makeArgumentIntoNumber x,s)
+    for x in argl for s in $FormalMapVariableList]
+  argList:=
+    [fn for x in formalArgList] where
+      fn ==
+        if x is ["SUCHTHAT",s,p] then (predList:= [p,:predList]; x:= s)
+        x
+  mkMapAlias(op,argl)
+  argPredList:= NREVERSE predList
+  finalPred :=
+-- handle g(a,T)==a+T confusion between pred=T and T variable
+    MKPF((pred and (pred ^= 'T) => [:argPredList,SUBLISNQ($sl,pred)]; argPredList),"and")
+  body:= SUBLISNQ($sl,rhs)
+  oldMap :=
+    (obj := get(op,'value,$InteractiveFrame)) => objVal obj
+    NIL
+  newMap := augmentMap(op,argList,finalPred,body,oldMap)
+  null newMap =>
+    sayRemoveFunctionOrValue op
+    putHist(op,'alias,nil,$e)
+    ""      -- clears value--- see return from addDefMap in tree2Atree1
+  if get(op,'isInterpreterRule,$e) then type := ['RuleCalled,op]
+  else type := ['FunctionCalled,op]
+  recursive :=
+    depthOfRecursion(op,newMap) = 0 => false
+    true
+  putHist(op,'recursive,recursive,$e)
+  objNew(newMap,type)
+
+augmentMap(op,args,pred,body,oldMap) ==
+  pattern:= makePattern(args,pred)
+  newMap:=deleteMap(op,pattern,oldMap)
+  body="" =>
+    if newMap=oldMap then
+      sayMSG ['"   Cannot find part of",:bright op,'"to delete."]
+    newMap  --just delete rule if body is 
+  entry:= [pattern,:body]
+  resultMap:=
+    newMap is ["MAP",:tail] => ["MAP",:tail,entry]
+    ["MAP",entry]
+  resultMap
+
+deleteMap(op,pattern,map) ==
+  map is ["MAP",:tail] =>
+    newMap:= ['MAP,:[x for x in tail | w]] where w ==
+      x is [=pattern,:replacement] => sayDroppingFunctions(op,[x])
+      true
+    null rest newMap => nil
+    newMap
+  NIL
+
+getUserIdentifiersIn body ==
+  null body => nil
+  IDENTP body =>
+    isSharpVarWithNum body => nil
+    body="" => nil
+    [body]
+  body is ["WRAPPED",:.] => nil
+  (body is ["COLLECT",:itl,body1]) or (body is ['REPEAT,:itl,body1]) =>
+    userIds :=
+      S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1)
+    S_-(userIds,getIteratorIds itl)
+  body is [op,:l] =>
+    argIdList:= "append"/[getUserIdentifiersIn y for y in l]
+    bodyIdList :=
+      CONSP op or not (GET(op,'Nud) or GET(op,'Led) or GET(op,'up))=>
+        NCONC(getUserIdentifiersIn op, argIdList)
+      argIdList
+    REMDUP bodyIdList
+
+getUserIdentifiersInIterators itl ==
+  for x in itl repeat
+    x is ["STEP",i,:l] =>
+      varList:= [:"append"/[getUserIdentifiersIn y for y in l],:varList]
+    x is ["IN",.,y]   => varList:= [:getUserIdentifiersIn y,:varList]
+    x is ["ON",.,y]   => varList:= [:getUserIdentifiersIn y,:varList]
+    x is [op,a] and op in '(_| WHILE UNTIL) =>
+      varList:= [:getUserIdentifiersIn a,:varList]
+    keyedSystemError("S2GE0016",['"getUserIdentifiersInIterators",
+      '"unknown iterator construct"])
+  REMDUP varList
+
+getIteratorIds itl ==
+  for x in itl repeat
+    x is ["STEP",i,:.] => varList:= [i,:varList]
+    x is ["IN",y,:.]   => varList:= [y,:varList]
+    x is ["ON",y,:.]   => varList:= [y,:varList]
+    nil
+  varList
+
+makeArgumentIntoNumber x ==
+  x=$Zero => 0
+  x=$One => 1
+  atom x => x
+  x is ["-",n] and NUMBERP n => -n
+  [removeZeroOne first x,:removeZeroOne rest x]
+
+mkMapAlias(op,argl) ==
+  u:= mkAliasList argl
+  newAlias :=
+    alias:= get(op,"alias",$e) => [(y => y; x) for x in alias for y in u]
+    u
+  $e:= putHist(op,"alias",newAlias,$e)
+
+mkAliasList l == fn(l,nil) where fn(l,acc) ==
+  null l => NREVERSE acc
+  not IDENTP first l or first l in acc => fn(rest l,[nil,:acc])
+  fn(rest l,[first l,:acc])
+
+args2Tuple args ==
+  args is [first,:rest] =>
+    null rest => first
+    ["Tuple",:args]
+  nil
+
+makePattern(args,pred) ==
+  nargs:= #args
+  nargs = 1 =>
+    pred is ["=","#1",n] => n
+    addPatternPred("#1",pred)
+  u:= canMakeTuple(nargs,pred) => u
+  addPatternPred(["Tuple",:TAKE(nargs,$FormalMapVariableList)],pred)
+
+addPatternPred(arg,pred) ==
+  pred=true => arg
+  ["|",arg,pred]
+
+canMakeTuple(nargs,pred) ==
+  pred is ["and",:l] and nargs=#l and
+    (u:= [(x is ["=",=y,a] => a; return nil)
+      for y in $FormalMapVariableList for x in orderList l]) =>
+        ["Tuple",:u]
+
+sayRemoveFunctionOrValue x ==
+  (obj := getValue x) and (md := objMode obj) =>
+    md = $EmptyMode =>
+      sayMessage ['"  ",:bright x,'"now has no function parts."]
+    sayMessage ['"   value for",:bright x,'"has been removed."]
+  sayMessage ['"  ",:bright x,'"has no value so this does nothing."]
+
+sayDroppingFunctions(op,l) ==
+  sayKeyedMsg("S2IM0017",[#l,op])
+  if $displayDroppedMap then
+    for [pattern,:replacement] in l repeat
+      displaySingleRule(op,pattern,replacement)
+  nil
+
+makeRuleForm(op,pattern)==
+  pattern is ["Tuple",:l] => [op,:l]
+  [op,:pattern]
+
+mkFormalArg(x,s) ==
+  isConstantArgument x => ["SUCHTHAT",s,["=",s,x]]
+  isPatternArgument x => ["SUCHTHAT",s,["is",s,x]]
+  IDENTP x =>
+    y:= LASSOC(x,$sl) => ["SUCHTHAT",s,["=",s,y]]
+    $sl:= [[x,:s],:$sl]
+    s
+  ['SUCHTHAT,s,["=",s,x]]
+
+isConstantArgument x ==
+  NUMBERP x => x
+  x is ["QUOTE",.] => x
+
+isPatternArgument x == x is ["construct",:.]
+
+--% Map dependencies
+
+makeNewDependencies (op, userVariables) ==
+  null userVariables => nil
+  --add the new dependencies
+  [[(first userVariables),op],
+    :makeNewDependencies (op, rest userVariables)]
+
+putDependencies (op, dependencies) ==
+  oldDependencies := getFlag "$dependencies"
+  --remove the obsolete dependencies:  all those that applied to the
+  --old definition, but may not apply here.  If they do, they'll be
+  --in the list of new dependencies anyway
+  oldDependencies := removeObsoleteDependencies (op, oldDependencies) where
+    removeObsoleteDependencies (op, oldDep) ==
+      null oldDep => nil
+      op = rest first oldDep =>
+        removeObsoleteDependencies (op, rest oldDep)
+      [first oldDep,:removeObsoleteDependencies (op, rest oldDep)]
+  --Create the list of dependencies to output.  This will be all the
+  --old dependencies that are still applicable, and all the new ones
+  --that have just been generated.  Remember that the list of
+  --dependencies does not just include those for the map just being
+  --defined, but includes those for all maps and variables that exist
+  newDependencies := union (dependencies, oldDependencies)
+  putFlag ("$dependencies", newDependencies)
+
+clearDependencies(x,clearLocalModemapsIfTrue) ==
+  $dependencies: local:= COPY getFlag "$dependencies"
+  clearDep1(x,nil,nil,$dependencies)
+
+clearDep1(x,toDoList,doneList,depList) ==
+  x in doneList => nil
+  clearCache x
+  newDone:= [x,:doneList]
+  until null a repeat
+    a:= ASSQ(x,depList)
+    a =>
+      depList:= delete(a,depList)
+      toDoList:= setUnion(toDoList,
+        setDifference(CDR a,doneList))
+  toDoList is [a,:res] => clearDep1(a,res,newDone,depList)
+  'done
+
+--% Formatting and displaying maps
+
+displayRule(op,rule) ==
+  null rule => nil
+  mathprint ["CONCAT","Definition:   ", rule]
+  nil
+
+outputFormat(x,m) ==
+  -- this is largely junk and is being phased out
+  IDENTP m => x
+  m=$OutputForm or m=$EmptyMode => x
+  categoryForm?(m) => x
+  isMapExpr x => x
+  containsVars x => x
+  atom(x) and CAR(m) = 'List => x
+  (x is ['construct,:.]) and m = '(List (Expression)) => x
+  T:= coerceInteractive(objNewWrap(x,maximalSuperType(m)),
+    $OutputForm) or return x
+  objValUnwrap T
+
+displaySingleRule($op,pattern,replacement) ==
+  mathprint ['MAP,[pattern,:replacement]]
+
+displayMap(headingIfTrue,$op,map) ==
+  mathprint
+    headingIfTrue => ['CONCAT,PNAME "value:  ",map]
+    map
+
+simplifyMapPattern (x,alias) ==
+  for a in alias
+    for m in $FormalMapVariableList | a and ^CONTAINED(a,x) repeat
+      x:= substitute(a,m,x)
+  [lhs,:rhs]:= x
+  rhs := simplifyMapConstructorRefs rhs
+  x := [lhs,:rhs]
+  lhs is ["|",y,pred] =>
+    pred:= predTran pred
+    sl:= getEqualSublis pred =>
+      y':= SUBLIS(sl,y)
+      pred:= unTrivialize SUBLIS(sl,pred) where unTrivialize x ==
+        x is [op,:l] and op in '(_and _or) =>
+          MKPF([unTrivialize y for y in l],op)
+        x is [op,a,=a] and op in '(_= is)=> true
+        x
+      rhs':= SUBLIS(sl,rhs)
+      pred=true => [y',:rhs']
+      [["PAREN",["|",y',pred]],:rhs']
+    pred=true => [y,:rhs]
+    [["PAREN",["|",y,pred]],:rhs]
+  lhs=true => ["true",:rhs]
+  x
+
+simplifyMapConstructorRefs form ==
+  -- try to linear format constructor names
+  ATOM form => form
+  [op,:args] := form
+  op in '(exit SEQ) =>
+    [op,:[simplifyMapConstructorRefs a for a in args]]
+  op in '(REPEAT) =>
+    [op,first args,:[simplifyMapConstructorRefs a for a in rest args]]
+  op in '(_: _:_: _@) =>
+    args is [obj,dom] =>
+      dom' := prefix2String dom
+      --if ATOM dom' then dom' := [dom']
+      --[op,obj,APPLY('CONCAT,dom')]
+      dom'' :=
+          ATOM dom' => dom'
+          NULL CDR dom' => CAR dom'
+          APPLY('CONCAT, dom')
+      [op,obj, dom'']
+    form
+  form
+
+predTran x ==
+  x is ["IF",a,b,c] =>
+    c = "false" => MKPF([predTran a,predTran b],"and")
+    b = "true" => MKPF([predTran a,predTran c],"or")
+    b = "false" and c = "true" => ["not",predTran a]
+    x
+  x
+
+getEqualSublis pred == fn(pred,nil) where fn(x,sl) ==
+  (x:= SUBLIS(sl,x)) is [op,:l] and op in '(_and _or) =>
+    for y in l repeat sl:= fn(y,sl)
+    sl
+  x is ["is",a,b] => [[a,:b],:sl]
+  x is ["=",a,b] =>
+    IDENTP a and not CONTAINED(a,b) => [[a,:b],:sl]
+    IDENTP b and not CONTAINED(b,a) => [[b,:a],:sl]
+    sl
+  sl
+
+--% User function analysis
+
+mapCatchName mapname ==
+   INTERN STRCONC('"$",STRINGIMAGE mapname,'"CatchMapIdentifier$")
+
+analyzeMap(op,argTypes,mapDef, tar) ==
+  -- Top level enty point for map type analysis.  Sets up catch point
+  --  for interpret-code mode.
+  $compilingMap:local := true
+  $definingMap:local := true
+  $minivector     : local := nil   -- later becomes value of $minivectorName
+  $mapThrowCount  : local := 0     -- number of "return"s encountered
+  $mapReturnTypes : local := nil   -- list of types from returns
+  $repeatLabel    : local := nil   -- for loops; see upREPEAT
+  $breakCount     : local := 0     -- breaks from loops; ditto
+  $mapTarget      : local := tar
+  $interpOnly: local := NIL
+  $mapName : local := op.0
+  if get($mapName,'recursive,$e) then
+    argTypes := [f t for t in argTypes] where
+      f x ==
+        isEqualOrSubDomain(x,$Integer) => $Integer
+        x
+  mapAndArgTypes := [$mapName,:argTypes]
+  member(mapAndArgTypes,$analyzingMapList) =>
+    -- if the map is declared, return the target type
+    (getMode op) is ['Mapping,target,:.] => target
+    throwKeyedMsg("S2IM0009",
+      [$mapName,['" ", map for [map,:.] in $analyzingMapList]])
+  PUSH(mapAndArgTypes,$analyzingMapList)
+  mapDef := mapDefsWithCorrectArgCount(#argTypes, mapDef)
+  null mapDef => (POP $analyzingMapList; nil)
+
+  UNWIND_-PROTECT(x:=CATCH('mapCompiler,analyzeMap0(op,argTypes,mapDef)),
+    POP $analyzingMapList)
+  x='tryInterpOnly =>
+    opName:=getUnname op
+    fun := mkInterpFun(op,opName,argTypes)
+    if getMode op isnt ['Mapping,:sig] then
+      sig := [nil,:[nil for type in argTypes]]
+    $e:=putHist(opName,'localModemap,
+      [[['interpOnly,:sig],fun,NIL]],$e)
+  x
+
+analyzeMap0(op,argTypes,mapDef) ==
+  -- Type analyze and compile a map.  Returns the target type of the map.
+  --  only called if there is no applicable compiled map
+  $MapArgumentTypeList:local:= argTypes
+  numMapArgs mapDef ^= #argTypes => nil
+  ((m:=getMode op) is ['Mapping,:sig]) or (m and (sig:=[m])) =>
+    -- op has mapping property only if user has declared the signature
+    analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList)
+  analyzeUndeclaredMap(getUnname op,argTypes,mapDef,$mapList)
+
+compFailure msg ==
+  -- Called when compilation fails in such a way that interpret-code
+  --  mode might be of some use.
+  not $useCoerceOrCroak =>    THROW('coerceOrCroaker, 'croaked)
+  if $reportInterpOnly then
+    sayMSG msg
+    sayMSG '"   We will attempt to interpret the code."
+  null $compilingMap => THROW('loopCompiler,'tryInterpOnly)
+  THROW('mapCompiler,'tryInterpOnly)
+
+mkInterpFun(op,opName,argTypes) ==
+  -- creates a function form to put in fun slot of interp-only
+  -- local modemaps
+  getMode op isnt ['Mapping,:sig] => nil
+  parms := [var for type in argTypes for var in $FormalMapVariableList]
+  arglCode := ['LIST,:[argCode for type in argTypes
+    for argName in parms]] where argCode ==
+      ['putValueValue,['mkAtreeNode,MKQ argName],
+        objNewCode(['wrap,argName],type)]
+  funName := GENSYM()
+  body:=['rewriteMap1,MKQ opName,arglCode,MKQ sig]
+  putMapCode(opName,body,sig,funName,parms,false)
+  genMapCode(opName,body,sig,funName,parms,false)
+  funName
+
+rewriteMap(op,opName,argl) ==
+  -- interpret-code handler for maps.  Recursively calls the interpreter
+  --   on the body of the map.
+  not $genValue =>
+    get(opName,'mode,$e) isnt ['Mapping,:sig] =>
+      compFailure  ['"   Cannot compile map:",:bright opName]
+    arglCode := ['LIST,:[argCode for arg in argl for argName in
+      $FormalMapVariableList]] where argCode ==
+        ['putValueValue,['mkAtreeNode,MKQ argName],
+          objNewCode(['wrap,wrapped2Quote(objVal getValue arg)],
+            getMode arg)]
+    putValue(op,objNew(['rewriteMap1,MKQ opName,arglCode,MKQ sig],
+      CAR sig))
+    putModeSet(op,[CAR sig])
+  rewriteMap0(op,opName,argl)
+
+putBodyInEnv(opName, numArgs) ==
+  val := get(opName, 'value, $e)
+  val is [.,'MAP, :bod] =>
+    $e := putHist(opName, 'mapBody, combineMapParts
+      mapDefsWithCorrectArgCount(numArgs, bod), $e)
+  'failed
+
+removeBodyFromEnv(opName) ==
+  $e := putHist(opName, 'mapBody, nil, $e)
+
+
+rewriteMap0(op,opName,argl) ==
+  -- $genValue case of map rewriting
+  putBodyInEnv(opName, #argl)
+  if (s := get(opName,'mode,$e)) then
+    tar := CADR s
+    argTypes := CDDR s
+  else
+    tar:= nil
+    argTypes:= nil
+  get(opName,'mode,$e) is ['Mapping,tar,:argTypes]
+  $env: local := [[NIL]]
+  for arg in argl
+    for var in $FormalMapVariableList repeat
+      if argTypes then
+        t := CAR argTypes
+        argTypes:= CDR argTypes
+        val :=
+          t is ['Mapping,:.] => getValue arg
+          coerceInteractive(getValue arg,t)
+      else
+        val:= getValue arg
+      $env:=put(var,'value,val,$env)
+      if VECP arg then $env := put(var,'name,getUnname arg,$env)
+      (m := getMode arg) => $env := put(var,'mode,m,$env)
+  null (val:= interpMap(opName,tar)) =>
+    throwKeyedMsg("S2IM0010",[opName])
+  putValue(op,val)
+  removeBodyFromEnv(opName)
+  ms := putModeSet(op,[objMode val])
+
+rewriteMap1(opName,argl,sig) ==
+  -- compiled case of map rewriting
+  putBodyInEnv(opName, #argl)
+  if sig then
+    tar:= CAR sig
+    argTypes:= CDR sig
+  else
+    tar:= nil
+    argTypes:= nil
+  evArgl := NIL
+  for arg in reverse argl repeat
+    v := getValue arg
+    evArgl := [objNew(objVal v, objMode v),:evArgl]
+  $env : local := [[NIL]]
+  for arg in argl for evArg in evArgl
+    for var in $FormalMapVariableList repeat
+      if argTypes then
+        t:=CAR argTypes
+        argTypes:= CDR argTypes
+        val :=
+          t is ['Mapping,:.] => evArg
+          coerceInteractive(evArg,t)
+      else
+        val:= evArg
+      $env:=put(var,'value,val,$env)
+      if VECP arg then $env := put(var,'name,getUnname arg,$env)
+      (m := getMode arg) => $env := put(var,'mode,m,$env)
+  val:= interpMap(opName,tar)
+  removeBodyFromEnv(opName)
+  objValUnwrap(val)
+
+interpMap(opName,tar) ==
+  -- call the interpreter recursively on map body
+  $genValue : local:= true
+  $interpMapTag : local := nil
+  $interpOnly : local := true
+  $localVars : local := NIL
+  for lvar in get(opName,'localVars,$e) repeat mkLocalVar(opName,lvar)
+  $mapName : local := opName
+  $mapTarget : local := tar
+  body:= get(opName,'mapBody,$e)
+  savedTimerStack := COPY $timedNameStack
+  catchName := mapCatchName $mapName
+  c := CATCH(catchName, interpret1(body,tar,nil))
+--  $interpMapTag and $interpMapTag ^= mapCatchName $mapName =>
+--    THROW($interpMapTag,c)
+  while savedTimerStack ^= $timedNameStack repeat
+    stopTimingProcess peekTimedName()
+  c  -- better be a triple
+
+analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList) ==
+  -- analyzes and compiles maps with declared signatures.  argTypes
+  -- is a list of types of the arguments, sig is the declared signature
+  -- mapDef is the stored form of the map body.
+  opName := getUnname op
+  $mapList:=[opName,:$mapList]
+  $mapTarget := CAR sig
+  (mmS:= get(opName,'localModemap,$e)) and
+    (mm:= or/[mm for (mm:=[[.,:mmSig],:.]) in mmS | mmSig=sig]) =>
+      compileCoerceMap(opName,argTypes,mm)
+  -- The declared map needs to be compiled
+  compileDeclaredMap(opName,sig,mapDef)
+  argTypes ^= CDR sig =>
+    analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList)
+  CAR sig
+
+compileDeclaredMap(op,sig,mapDef) ==
+  -- Type analyzes and compiles a map with a declared signature.
+  -- creates a local modemap and puts it into the environment
+  $localVars: local := nil
+  $freeVars: local := nil
+  $env:local:= [[NIL]]
+  parms:=[var for var in $FormalMapVariableList for m in CDR sig]
+  for m in CDR sig for var in parms repeat
+    $env:= put(var,'mode,m,$env)
+  body:= getMapBody(op,mapDef)
+  for lvar in parms repeat mkLocalVar($mapName,lvar)
+  for lvar in getLocalVars(op,body) repeat mkLocalVar($mapName,lvar)
+  name := makeLocalModemap(op,sig)
+  val  := compileBody(body,CAR sig)
+  isRecursive := (depthOfRecursion(op,body) > 0)
+  putMapCode(op,objVal val,sig,name,parms,isRecursive)
+  genMapCode(op,objVal val,sig,name,parms,isRecursive)
+  CAR sig
+
+putMapCode(op,code,sig,name,parms,isRecursive) ==
+  -- saves the generated code and some other information about the
+  -- function
+  codeInfo := VECTOR(op,code,sig,name,parms,isRecursive)
+  allCode := [codeInfo,:get(op,'generatedCode,$e)]
+  $e := putHist(op,'generatedCode,allCode,$e)
+  op
+
+makeLocalModemap(op,sig) ==
+  -- create a local modemap for op with sig, and put it into $e
+  if (currentMms := get(op,'localModemap,$e)) then
+    untraceMapSubNames [CADAR currentMms]
+  newName := makeInternalMapName(op,#sig-1,1+#currentMms,NIL)
+  newMm := [['local,:sig],newName,nil]
+  mms := [newMm,:currentMms]
+  $e := putHist(op,'localModemap,mms,$e)
+  newName
+
+genMapCode(op,body,sig,fnName,parms,isRecursive) ==
+  -- calls the lisp compiler on the body of a map
+  if lmm:= get(op,'localModemap,$InteractiveFrame) then
+    untraceMapSubNames [CADAR lmm]
+  op0 :=
+    ( n := isSharpVarWithNum op ) => STRCONC('"<argument ",object2String n,'">")
+    op
+  if get(op,'isInterpreterRule,$e) then
+    sayKeyedMsg("S2IM0014",[op0,(PAIRP sig =>prefix2String CAR sig;'"?")])
+  else sayKeyedMsg("S2IM0015",[op0,formatSignature sig])
+  $whereCacheList := [op,:$whereCacheList]
+
+  -- RSS: 6-21-94
+  -- The following code ensures that local variables really are local
+  -- to a function. We will unnecessarily generate preliminary LETs for
+  -- loop variables and variables that do have LET expressions, but that
+  -- can be finessed later.
+
+  locals := SETDIFFERENCE(COPY $localVars, parms)
+  if locals then
+    lets := [['LET, l, ''UNINITIALIZED__VARIABLE, op] for l in locals]
+    body := ['PROGN, :lets, body]
+
+  reportFunctionCompilation(op,fnName,parms,
+    wrapMapBodyWithCatch flattenCOND body,isRecursive)
+
+compileBody(body,target) ==
+  -- recursively calls the interpreter on the map body
+  --  returns a triple with the LISP code for body in the value cell
+  $insideCompileBodyIfTrue: local := true
+  $genValue: local := false
+  $declaredMode:local := target
+  $eval:local:= true
+  r := interpret1(body,target,nil)
+
+compileCoerceMap(op,argTypes,mm) ==
+  -- compiles call to user-declared map where the arguments need
+  --  to be coerced. mm is the modemap for the declared map.
+  $insideCompileBodyIfTrue: local := true
+  $genValue: local := false
+  [[.,:sig],imp,.]:= mm
+  parms:= [var for var in $FormalMapVariableList for t in CDR sig]
+  name:= makeLocalModemap(op,[CAR sig,:argTypes])
+  argCode := [objVal(coerceInteractive(objNew(arg,t1),t2) or
+    throwKeyedMsg("S2IC0001",[arg,$mapName,t1,t2]))
+      for t1 in argTypes for t2 in CDR sig for arg in parms]
+  $insideCompileBodyIfTrue := false
+  parms:= [:parms,'envArg]
+  body := ['SPADCALL,:argCode,['LIST,['function,imp]]]
+  minivectorName := makeInternalMapMinivectorName(name)
+  $minivectorNames := [[op,:minivectorName],:$minivectorNames]
+  body := SUBST(minivectorName,"$$$",body)
+  if $compilingInputFile then
+    $minivectorCode := [:$minivectorCode,minivectorName]
+  SET(minivectorName,LIST2REFVEC $minivector)
+  compileInteractive [name,['LAMBDA,parms,body]]
+  CAR sig
+
+depthOfRecursion(opName,body) ==
+  -- returns the "depth" of recursive calls of opName in body
+  mapRecurDepth(opName,nil,body)
+
+mapRecurDepth(opName,opList,body) ==
+  -- walks over the map body counting depth of recursive calls
+  --  expanding the bodies of maps called in body
+  atom body => 0
+  body is [op,:argl] =>
+    argc:=
+      atom argl => 0
+      argl => "MAX"/[mapRecurDepth(opName,opList,x) for x in argl]
+      0
+    op in opList => argc
+    op=opName => 1 + argc
+    (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] =>
+      mapRecurDepth(opName,[op,:opList],getMapBody(op,mapDef))
+        + argc
+    argc
+  keyedSystemError("S2GE0016",['"mapRecurDepth",
+    '"unknown function form"])
+
+analyzeUndeclaredMap(op,argTypes,mapDef,$mapList) ==
+  -- Computes the signature of the map named op, and compiles the body
+  $freeVars:local := NIL
+  $localVars: local := NIL
+  $env:local:= [[NIL]]
+  $mapList := [op,:$mapList]
+  parms:=[var for var in $FormalMapVariableList for m in argTypes]
+  for m in argTypes for var in parms repeat
+    put(var,'autoDeclare,'T,$env)
+    put(var,'mode,m,$env)
+  body:= getMapBody(op,mapDef)
+  for lvar in parms repeat mkLocalVar($mapName,lvar)
+  for lvar in getLocalVars(op,body) repeat mkLocalVar($mapName,lvar)
+  (n:= depthOfRecursion(op,body)) = 0 =>
+    analyzeNonRecursiveMap(op,argTypes,body,parms)
+  analyzeRecursiveMap(op,argTypes,body,parms,n)
+
+analyzeNonRecursiveMap(op,argTypes,body,parms) ==
+  -- analyze and compile a non-recursive map definition
+  T := compileBody(body,$mapTarget)
+  if $mapThrowCount > 0 then
+    t := objMode T
+    b := and/[(t = rt) for rt in $mapReturnTypes]
+    not b =>
+      t := resolveTypeListAny [t,:$mapReturnTypes]
+      if not $mapTarget then $mapTarget := t
+      T := compileBody(body,$mapTarget)
+  sig := [objMode T,:argTypes]
+  name:= makeLocalModemap(op,sig)
+  putMapCode(op,objVal T,sig,name,parms,false)
+  genMapCode(op,objVal T,sig,name,parms,false)
+  objMode(T)
+
+analyzeRecursiveMap(op,argTypes,body,parms,n) ==
+  -- analyze and compile a non-recursive map definition
+  --  makes guess at signature by analyzing non-recursive part of body
+  --  then re-analyzes the entire body until the signature doesn't change
+  localMapInfo := saveDependentMapInfo(op, CDR $mapList)
+  tar := CATCH('interpreter,analyzeNonRecur(op,body,$localVars))
+  for i in 0..n until not sigChanged repeat
+    sigChanged:= false
+    name := makeLocalModemap(op,sig:=[tar,:argTypes])
+    code := compileBody(body,$mapTarget)
+    objMode(code) ^= tar =>
+      sigChanged:= true
+      tar := objMode(code)
+      restoreDependentMapInfo(op, CDR $mapList, localMapInfo)
+  sigChanged => throwKeyedMsg("S2IM0011",[op])
+  putMapCode(op,objVal code,sig,name,parms,true)
+  genMapCode(op,objVal code,sig,name,parms,true)
+  tar
+
+saveDependentMapInfo(op,opList) ==
+  not (op in opList) =>
+    lmml := [[op, :get(op, 'localModemap, $e)]]
+    gcl := [[op, :get(op, 'generatedCode, $e)]]
+    for [dep1,dep2] in getFlag("$dependencies") | dep1=op repeat
+      [lmml', :gcl'] := saveDependentMapInfo(dep2, [op, :opList])
+      lmms := nconc(lmml', lmml)
+      gcl := nconc(gcl', gcl)
+    [lmms, :gcl]
+  nil
+
+restoreDependentMapInfo(op, opList, [lmml,:gcl]) ==
+  not (op in opList) =>
+    clearDependentMaps(op,opList)
+    for [op, :lmm] in lmml repeat
+      $e := putHist(op,'localModemap,lmm,$e)
+    for [op, :gc] in gcl repeat
+      $e := putHist(op,'generatedCode,gc,$e)
+
+clearDependentMaps(op,opList) ==
+  -- clears the local modemaps of all the maps that depend on op
+  not (op in opList) =>
+    $e := putHist(op,'localModemap,nil,$e)
+    $e := putHist(op,'generatedCode,nil,$e)
+    for [dep1,dep2] in getFlag("$dependencies") | dep1=op repeat
+      clearDependentMaps(dep2,[op,:opList])
+
+analyzeNonRecur(op,body,$localVars) ==
+  -- type analyze the non-recursive part of a map body
+  nrp := nonRecursivePart(op,body)
+  for lvar in findLocalVars(op,nrp) repeat mkLocalVar($mapName,lvar)
+  objMode(compileBody(nrp,$mapTarget))
+
+nonRecursivePart(opName, funBody) ==
+  -- takes funBody, which is the parse tree of the definition of
+  --  a function, and returns a list of the parts
+  --  of the function which are not recursive in the name opName
+  body:= expandRecursiveBody([opName], funBody)
+  ((nrp:=nonRecursivePart1(opName, body)) ^= 'noMapVal) => nrp
+  throwKeyedMsg("S2IM0012",[opName])
+
+expandRecursiveBody(alreadyExpanded, body) ==
+  -- replaces calls to other maps with their bodies
+  atom body =>
+    (obj := get(body,'value,$e)) and objVal obj is ['MAP,:mapDef] and
+      ((numMapArgs mapDef) = 0) => getMapBody(body,mapDef)
+    body
+  body is [op,:argl] =>
+    not (op in alreadyExpanded) =>
+      (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] =>
+        newBody:= getMapBody(op,mapDef)
+        for arg in argl for var in $FormalMapVariableList repeat
+          newBody:=MSUBST(arg,var,newBody)
+        expandRecursiveBody([op,:alreadyExpanded],newBody)
+      [op,:[expandRecursiveBody(alreadyExpanded,arg) for arg in argl]]
+    [op,:[expandRecursiveBody(alreadyExpanded,arg) for arg in argl]]
+  keyedSystemError("S2GE0016",['"expandRecursiveBody",
+    '"unknown form of function body"])
+
+nonRecursivePart1(opName, funBody) ==
+  -- returns a function body which contains only the parts of funBody
+  --  which do not call the function opName
+  funBody is ['IF,a,b,c] =>
+    nra:=nonRecursivePart1(opName,a)
+    nra = 'noMapVal => 'noMapVal
+    nrb:=nonRecursivePart1(opName,b)
+    nrc:=nonRecursivePart1(opName,c)
+    not (nrb in '(noMapVal noBranch)) => ['IF,nra,nrb,nrc]
+    not (nrc in '(noMapVal noBranch)) => ['IF,['not,nra],nrc,nrb]
+    'noMapVal
+  not containsOp(funBody,'IF) =>
+    notCalled(opName,funBody) => funBody
+    'noMapVal
+  funBody is [op,:argl] =>
+    op=opName => 'noMapVal
+    args:= [nonRecursivePart1(opName,arg) for arg in argl]
+    MEMQ('noMapVal,args) => 'noMapVal
+    [op,:args]
+  funBody
+
+containsOp(body,op) ==
+  -- true IFF body contains an op statement
+  body is [ =op,:.] => true
+  body is [.,:argl] => or/[containsOp(arg,op) for arg in argl]
+  false
+
+notCalled(opName,form) ==
+  -- returns true if opName is not called in the form
+  atom form => true
+  form is [op,:argl] =>
+    op=opName => false
+    and/[notCalled(opName,x) for x in argl]
+  keyedSystemError("S2GE0016",['"notCalled",
+    '"unknown form of function body"])
+
+mapDefsWithCorrectArgCount(n, mapDef) ==
+  [def for def in mapDef | (numArgs CAR def) = n]
+
+numMapArgs(mapDef is [[args,:.],:.]) ==
+  -- returns the number of arguemnts to the map whose body is mapDef
+  numArgs args
+
+numArgs args ==
+  args is ['_|,a,:.] => numArgs a
+  args is ['Tuple,:argl] => #argl
+  null args => 0
+  1
+
+combineMapParts(mapTail) ==
+  -- transforms a piece-wise function definition into an if-then-else
+  --  statement.  Uses noBranch to indicate undefined branch
+  null mapTail => 'noMapVal
+  mapTail is [[cond,:part],:restMap] =>
+    isSharpVarWithNum cond or (cond is ['Tuple,:args] and
+      and/[isSharpVarWithNum arg for arg in args]) or (null cond) => part
+    ['IF,mkMapPred cond,part,combineMapParts restMap]
+  keyedSystemError("S2GE0016",['"combineMapParts",
+    '"unknown function form"])
+
+mkMapPred cond ==
+  -- create the predicate on map arguments, derived from "when" clauses
+  cond is ['_|,args,pred] => mapPredTran pred
+  cond is ['Tuple,:vals] =>
+    mkValueCheck(vals,1)
+  mkValCheck(cond,1)
+
+mkValueCheck(vals,i) ==
+  -- creates predicate for specific value check (i.e f 1 == 1)
+  vals is [val] => mkValCheck(val,i)
+  ['and,mkValCheck(first vals,i),mkValueCheck(rest vals,i+1)]
+
+mkValCheck(val,i) ==
+  -- create equality check for map predicates
+  isSharpVarWithNum val => 'true
+  ['_=,mkSharpVar i,val]
+
+mkSharpVar i ==
+  -- create #i
+  INTERN CONCAT('"#",STRINGIMAGE i)
+
+mapPredTran pred ==
+  -- transforms "x in i..j" to "x>=i and x<=j"
+  pred is ['in,var,['SEGMENT,lb]] => mkLessOrEqual(lb,var)
+  pred is ['in,var,['SEGMENT,lb,ub]] =>
+    null ub => mkLessOrEqual(lb,var)
+    ['and,mkLessOrEqual(lb,var),mkLessOrEqual(var,ub)]
+  pred
+
+findLocalVars(op,form) ==
+  -- analyzes form for local and free variables, and returns the list
+  --  of locals
+  findLocalVars1(op,form)
+  $localVars
+
+findLocalVars1(op,form) ==
+  -- sets the two lists $localVars and $freeVars
+  atom form =>
+    not IDENTP form or isSharpVarWithNum form => nil
+    isLocalVar(form) or isFreeVar(form) => nil
+    mkFreeVar($mapName,form)
+  form is ['local, :vars] =>
+    for x in vars repeat
+      ATOM x => mkLocalVar(op, x)
+  form is ['free, :vars] =>
+    for x in vars repeat
+      ATOM x => mkFreeVar(op, x)
+  form is ['LET,a,b] =>
+    (a is ['Tuple,:vars]) and (b is ['Tuple,:vals]) =>
+      for var in vars for val in vals repeat
+        findLocalVars1(op,['LET,var,val])
+    a is ['construct,:pat] =>
+      for var in listOfVariables pat repeat mkLocalVar(op,var)
+      findLocalVars1(op,b)
+    (atom a) or (a is ['_:,a,.]) =>
+      mkLocalVar(op,a)
+      findLocalVars1(op,b)
+    findLocalVars(op,b)
+    for x in a repeat findLocalVars1(op,x)
+  form is ['_:,a,.] =>
+    mkLocalVar(op,a)
+  form is ['is,l,pattern] =>
+    findLocalVars1(op,l)
+    for var in listOfVariables CDR pattern repeat mkLocalVar(op,var)
+  form is [oper,:itrl,body] and MEMQ(oper,'(REPEAT COLLECT)) =>
+    findLocalsInLoop(op,itrl,body)
+  form is [y,:argl] =>
+    y is 'Record => nil
+    for x in argl repeat findLocalVars1(op,x)
+  keyedSystemError("S2IM0020",[op])
+
+findLocalsInLoop(op,itrl,body) ==
+  for it in itrl repeat
+    it is ['STEP,index,lower,step,:upperList] =>
+      mkLocalVar(op,index)
+      findLocalVars1(op,lower)
+      for up in upperList repeat findLocalVars1(op,up)
+    it is ['IN,index,s] =>
+      mkLocalVar(op,index) ; findLocalVars1(op,s)
+    it is ['WHILE,b] =>
+      findLocalVars1(op,b)
+    it is ['_|,pred] =>
+      findLocalVars1(op,pred)
+  findLocalVars1(op,body)
+  for it in itrl repeat
+    it is [op,b] and (op in '(UNTIL)) =>
+      findLocalVars1(op,b)
+
+isLocalVar(var) == member(var,$localVars)
+
+mkLocalVar(op,var) ==
+  -- add var to the local variable list
+  isFreeVar(var) => $localVars
+  $localVars:= insert(var,$localVars)
+
+isFreeVar(var) == member(var,$freeVars)
+
+mkFreeVar(op,var) ==
+  -- op here for symmetry with mkLocalVar
+  $freeVars:= insert(var,$freeVars)
+
+listOfVariables pat ==
+  -- return a list of the variables in pat, which is an "is" pattern
+  IDENTP pat => (pat='_. => nil ; [pat])
+  pat is ['_:,var] or pat is ['_=,var] =>
+    (var='_. => NIL ; [var])
+  PAIRP pat => REMDUP [:listOfVariables p for p in pat]
+  nil
+
+getMapBody(op,mapDef) ==
+  -- looks in $e for a map body; if not found it computes then stores it
+  get(op,'mapBody,$e) or
+    combineMapParts mapDef
+--    $e:= putHist(op,'mapBody,body:= combineMapParts mapDef,$e)
+--    body
+
+getLocalVars(op,body) ==
+  -- looks in $e for local vars; if not found, computes then stores them
+  get(op,'localVars,$e) or
+    $e:= putHist(op,'localVars,lv:=findLocalVars(op,body),$e)
+    lv
+
+--  DO NOT BELIEVE ALL OF THE FOLLOWING (IT IS OLD)
+
+--  VARIABLES.  Variables may or may not have a mode property.  If
+--  present, any value which is assigned or generated by that variable
+--  is first coerced to that mode before being assigned or returned.
+--
+--
+--  Variables are given a triple [val,m,e] as a "value" property on
+--  its property list in the environment.  The expression val has the
+--  forms:
+--
+--        (WRAPPED . y)       --value of x is y (don't re-evaluate)
+--        y --anything else   --value of x is obtained by evaluating y
+--
+--  A wrapped expression is created by an assignment.  In the second
+--  case, y can never contain embedded wrapped expressions.  The mode
+--  part m of the triple is the type of y in the wrapped case and is
+--  consistent with the declared mode if given.  The mode part of an
+--  unwrapped value is always $EmptyMode.  The e part is usually NIL
+--  but may be used to hold a partial closure.
+--
+--  Effect of changes.  A rule can be built up for a variable by
+--  successive rules involving conditional expressions.  However, once
+--  a value is assigned to the variable or an unconditional definition
+--  is given, any existing value is replaced by the new entry.  When
+--  the mode of a variable is declared, an wrapped value is coerced to
+--  the new mode; if this is not possible, the user is notified that
+--  the current value is discarded and why.  When the mode is
+--  redeclared and an upwrapped value is present, the value is
+--  retained; the only other effect is to coerce any cached values
+--  from the old mode to the new one.
+--
+--  Caches.  When a variable x is evaluated and re-evaluation occurs,
+--  the triple produced by that evaluation is stored under "cache" on
+--  the property list of x. This cached triple is cleared whenever any
+--  of the variables which x's value depend upon change.  Dependencies
+--  are stored on $dependencies whose value has the form [[a b ..] ..]
+--  to indicate that when a is changed, b .. must have all cached
+--  values destroyed.  In the case of parameterized forms which are
+--  represented by maps, we currently can cache values only when the
+--  compiler option is turned on by )on c s meaning "on compiler with
+--  the save option".  When f is compiled as f;1, it then has an alist
+--  f;1;AL which records these values.  If f depends globally on a's
+--  value, all cached values of all local functions defined for f have
+--  to be declared.  If a's mode should change, then all compilations
+--  of f must be thrown away.
+--
+--  PARAMETERIZED FORMS.  These always have values [val,m,e] where val
+--  are "maps".
+--
+--  The structure of maps:
+--   (MAP (pattern . rewrite) ...)   where
+--     pattern has forms:  arg-pattern
+--                         (Tuple arg-pattern ...)
+--     rewrite has forms:  (WRAPPED . value)      --don't re-evaluate
+--                         computational object   --don't (bother to)
+--                                                  re-evaluate
+--                         anything else          --yes, re-evaluate
+--
+--  When assigning values to a map, each new value must have a type
+--  which is consistent with those already assigned.  Initially, type
+--  of MAP is $EmptyMode.  When the map is first assigned a value, the
+--  type of the MAP is RPLACDed to be (Mapping target source ..).
+--  When the map is next assigned, the type of both source and target
+--  is upgraded to be consistent with those values already computed.
+--  Of course, if new and old source and target are identical, nothing
+--  need happen to existing entries.  However, if the new and old are
+--  different, all existing entries of the map are coerce to the new
+--  data type.
+--
+--  Mode analysis.  This is done on the bottomUp phase of the process.
+--  If a function has been given a mapping declaration, this map is
+--  placed in as the mode of the map under the "value" property of the
+--  variable.  Of course, these modes may be partial types in case a
+--  mode analysis is still necessary.  If no mapping declaration, a
+--  total mode analysis of the function, given its input arguments, is
+--  done.  This will result a signature involving types only.
+--
+--  If the compiler is on, the function is then compiled given this
+--  signature involving types.  If the map is value of a variable f, a
+--  function is given name f;1, f is given a "localModemap" property
+--  with modemap ((dummy target source ..) (T f;1)) so that the next
+--  time f is applied to arguments which coerce to the source
+--  arguments of this local modemap, f;1 will be invoked.
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-output.boot.pamphlet b/src/interp/i-output.boot.pamphlet
new file mode 100644
index 00000000..bb0d87b1
--- /dev/null
+++ b/src/interp/i-output.boot.pamphlet
@@ -0,0 +1,2467 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-output.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{GCL\_log10\_bug}
+
+In some versions of GCL the LOG10 function returns improperly rounded values.
+The symptom is:
+\begin{verbatim}
+(24) -> [1000]
+   (24)  [100]
+\end{verbatim}
+The common lisp failure can be shown with:
+\begin{verbatim}
+(25) -> )lisp (log10 1000)
+Value = 2.9999999999999996
+\end{verbatim}
+This previous boot code was:
+\begin{verbatim}
+    u < MOST_-POSITIVE_-LONG_-FLOAT => 1+negative+FLOOR LOG10 u
+\end{verbatim}
+and should be restored when the GCL bug is fixed.
+<<GCLlog10bug>>=
+    u < MOST_-POSITIVE_-LONG_-FLOAT => 1+negative+FLOOR ((LOG10 u) + 0.0000001)
+@ 
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--Modified JHD February 1993: see files miscout.input for some tests of this
+-- General principle is that maprin0 is the top-level routine,
+-- which calls maprinChk to print the object (placing certain large
+-- matrices on a look-aside list), then calls maprinRows to print these.
+-- These prints call maprinChk recursively, and maprinChk has to ensure that
+-- we do not end up in an infinite recursion: matrix1 = matrix2 ...
+
+--% Output display routines
+
+SETANDFILEQ($defaultSpecialCharacters,[
+    EBCDIC( 28),      -- upper left corner
+    EBCDIC( 27),      -- upper right corner
+    EBCDIC( 30),      -- lower left corner
+    EBCDIC( 31),      -- lower right corner
+    EBCDIC( 79),      -- vertical bar
+    EBCDIC( 45),      -- horizontal bar
+    EBCDIC(144),      -- APL quad
+    EBCDIC(173),      -- left bracket
+    EBCDIC(189),      -- right bracket
+    EBCDIC(192),      -- left brace
+    EBCDIC(208),      -- right brace
+    EBCDIC( 59),      -- top    box tee
+    EBCDIC( 62),      -- bottom box tee
+    EBCDIC( 63),      -- right  box tee
+    EBCDIC( 61),      -- left   box tee
+    EBCDIC( 44),      -- center box tee
+    EBCDIC(224)       -- back slash
+     ])
+
+SETANDFILEQ($plainSpecialCharacters0,[
+    EBCDIC( 78),      -- upper left corner   (+)
+    EBCDIC( 78),      -- upper right corner  (+)
+    EBCDIC( 78),      -- lower left corner   (+)
+    EBCDIC( 78),      -- lower right corner  (+)
+    EBCDIC( 79),      -- vertical bar
+    EBCDIC( 96),      -- horizontal bar      (-)
+    EBCDIC(111),      -- APL quad            (?)
+    EBCDIC(173),      -- left bracket
+    EBCDIC(189),      -- right bracket
+    EBCDIC(192),      -- left brace
+    EBCDIC(208),      -- right brace
+    EBCDIC( 78),      -- top    box tee      (+)
+    EBCDIC( 78),      -- bottom box tee      (+)
+    EBCDIC( 78),      -- right  box tee      (+)
+    EBCDIC( 78),      -- left   box tee      (+)
+    EBCDIC( 78),      -- center box tee      (+)
+    EBCDIC(224)       -- back slash
+     ])
+
+SETANDFILEQ($plainSpecialCharacters1,[
+    EBCDIC(107),      -- upper left corner   (,)
+    EBCDIC(107),      -- upper right corner  (,)
+    EBCDIC(125),      -- lower left corner   (')
+    EBCDIC(125),      -- lower right corner  (')
+    EBCDIC( 79),      -- vertical bar
+    EBCDIC( 96),      -- horizontal bar      (-)
+    EBCDIC(111),      -- APL quad            (?)
+    EBCDIC(173),      -- left bracket
+    EBCDIC(189),      -- right bracket
+    EBCDIC(192),      -- left brace
+    EBCDIC(208),      -- right brace
+    EBCDIC( 78),      -- top    box tee      (+)
+    EBCDIC( 78),      -- bottom box tee      (+)
+    EBCDIC( 78),      -- right  box tee      (+)
+    EBCDIC( 78),      -- left   box tee      (+)
+    EBCDIC( 78),      -- center box tee      (+)
+    EBCDIC(224)       -- back slash
+     ])
+
+SETANDFILEQ($plainSpecialCharacters2,[
+    EBCDIC( 79),      -- upper left corner   (|)
+    EBCDIC( 79),      -- upper right corner  (|)
+    EBCDIC( 79),      -- lower left corner   (|)
+    EBCDIC( 79),      -- lower right corner  (|)
+    EBCDIC( 79),      -- vertical bar
+    EBCDIC( 96),      -- horizontal bar      (-)
+    EBCDIC(111),      -- APL quad            (?)
+    EBCDIC(173),      -- left bracket
+    EBCDIC(189),      -- right bracket
+    EBCDIC(192),      -- left brace
+    EBCDIC(208),      -- right brace
+    EBCDIC( 78),      -- top    box tee      (+)
+    EBCDIC( 78),      -- bottom box tee      (+)
+    EBCDIC( 78),      -- right  box tee      (+)
+    EBCDIC( 78),      -- left   box tee      (+)
+    EBCDIC( 78),      -- center box tee      (+)
+    EBCDIC(224)       -- back slash
+     ])
+
+SETANDFILEQ($plainSpecialCharacters3,[
+    EBCDIC( 96),      -- upper left corner   (-)
+    EBCDIC( 96),      -- upper right corner  (-)
+    EBCDIC( 96),      -- lower left corner   (-)
+    EBCDIC( 96),      -- lower right corner  (-)
+    EBCDIC( 79),      -- vertical bar
+    EBCDIC( 96),      -- horizontal bar      (-)
+    EBCDIC(111),      -- APL quad            (?)
+    EBCDIC(173),      -- left bracket
+    EBCDIC(189),      -- right bracket
+    EBCDIC(192),      -- left brace
+    EBCDIC(208),      -- right brace
+    EBCDIC( 78),      -- top    box tee      (+)
+    EBCDIC( 78),      -- bottom box tee      (+)
+    EBCDIC( 78),      -- right  box tee      (+)
+    EBCDIC( 78),      -- left   box tee      (+)
+    EBCDIC( 78),      -- center box tee      (+)
+    EBCDIC(224)       -- back slash
+     ])
+
+SETANDFILEQ($plainRTspecialCharacters,[
+    '_+,      -- upper left corner   (+)
+    '_+,      -- upper right corner  (+)
+    '_+,      -- lower left corner   (+)
+    '_+,      -- lower right corner  (+)
+    '_|,      -- vertical bar
+    '_-,      -- horizontal bar      (-)
+    '_?,      -- APL quad            (?)
+    '_[,      -- left bracket
+    '_],      -- right bracket
+    '_{,      -- left brace
+    '_},      -- right brace
+    '_+,      -- top    box tee      (+)
+    '_+,      -- bottom box tee      (+)
+    '_+,      -- right  box tee      (+)
+    '_+,      -- left   box tee      (+)
+    '_+,      -- center box tee      (+)
+    '_\       -- back slash
+     ])
+
+makeCharacter n == INTERN(STRING(CODE_-CHAR n))
+
+SETANDFILEQ($RTspecialCharacters,[
+    makeCharacter 218,      -- upper left corner   (+)
+    makeCharacter 191,      -- upper right corner  (+)
+    makeCharacter 192,      -- lower left corner   (+)
+    makeCharacter 217,      -- lower right corner  (+)
+    makeCharacter 179,      -- vertical bar
+    makeCharacter 196,      -- horizontal bar      (-)
+    $quadSymbol,      -- APL quad            (?)
+    '_[,      -- left bracket
+    '_],      -- right bracket
+    '_{,      -- left brace
+    '_},      -- right brace
+    makeCharacter 194,      -- top    box tee      (+)
+    makeCharacter 193,      -- bottom box tee      (+)
+    makeCharacter 180,      -- right  box tee      (+)
+    makeCharacter 195,      -- left   box tee      (+)
+    makeCharacter 197,      -- center box tee      (+)
+    '_\       -- back slash
+     ])
+
+SETANDFILEQ($specialCharacters,$RTspecialCharacters)
+
+SETANDFILEQ($specialCharacterAlist, '(
+  (ulc  .  0)_
+  (urc  .  1)_
+  (llc  .  2)_
+  (lrc  .  3)_
+  (vbar .  4)_
+  (hbar .  5)_
+  (quad .  6)_
+  (lbrk .  7)_
+  (rbrk .  8)_
+  (lbrc .  9)_
+  (rbrc . 10)_
+  (ttee . 11)_
+  (btee . 12)_
+  (rtee . 13)_
+  (ltee . 14)_
+  (ctee . 15)_
+  (bslash . 16)_
+  ))
+
+$collectOutput := nil
+
+specialChar(symbol) ==
+  -- looks up symbol in $specialCharacterAlist, gets the index
+  -- into the EBCDIC table, and returns the appropriate character
+  null (code := IFCDR ASSQ(symbol,$specialCharacterAlist)) => '"?"
+  ELT($specialCharacters,code)
+
+rbrkSch() == PNAME specialChar 'rbrk
+lbrkSch() == PNAME specialChar 'lbrk
+quadSch() == PNAME specialChar 'quad
+
+isBinaryInfix x ==
+    x in '(_= _+ _- _* _/ _*_* _^ "=" "+" "-" "*" "/" "**" "^")
+
+stringApp([.,u],x,y,d) ==
+  appChar(STRCONC($DoubleQuote,atom2String u,$DoubleQuote),x,y,d)
+
+stringWidth u ==
+  u is [.,u] or THROW('outputFailure,'outputFailure)
+  2+#u
+
+obj2String o ==
+  atom o =>
+    STRINGP o => o
+    o = " " => '" "
+    o = ")" => '")"
+    o = "(" => '"("
+    STRINGIMAGE o
+  APPLY('STRCONC,[obj2String o' for o' in o])
+
+APP(u,x,y,d) ==
+  atom u => appChar(atom2String u,x,y,d)
+  u is [[op,:.],a] and (s:= GETL(op,'PREFIXOP)) =>
+    GETL(op,'isSuffix) => appChar(s,x+WIDTH a,y,APP(a,x,y,d))
+    APP(a,x+#s,y,appChar(s,x,y,d))
+  u is [[id,:.],:.] =>
+    fn := GETL(id,'APP) => FUNCALL(fn,u,x,y,d)
+    not NUMBERP id and (d':= appInfix(u,x,y,d))=> d'
+    appelse(u,x,y,d)
+  appelse(u,x,y,d)
+
+atom2String x ==
+  IDENTP x => PNAME x
+  STRINGP x => x
+  stringer x
+
+-- General convention in the "app..." functions:
+-- Added from an attempt to fix bugs by JHD: 2 Aug 89
+-- the first argument is what has to be printed
+-- the second - x - is the horizontal distance along the page
+--      at which to start
+-- the third - y - is some vertical hacking control
+-- the foruth - d - is the "layout" so far
+-- these functions return an updated "layout so far" in general
+
+appChar(string,x,y,d) ==
+  if CHARP string then string := PNAME string
+  line:= LASSOC(y,d) =>
+    if MAXINDEX string = 1 and char(string.0) = "%" then
+      string.1="b" =>
+        bumpDeltaIfTrue:= true
+        string.0:= EBCDIC 29
+        string.1:= EBCDIC 200
+      string.1="d" =>
+        bumpDeltaIfTrue:= true
+        string.0:= EBCDIC 29
+        string.1:= EBCDIC 65
+    shiftedX:= (y=0 => x+$highlightDelta; x)
+      --shift x for brightening characters -- presently only if y=0
+    RPLACSTR(line,shiftedX,n:=#string,string,0,n)
+    if bumpDeltaIfTrue=true then $highlightDelta:= $highlightDelta+1
+    d
+  appChar(string,x,y,nconc(d,[[y,:GETFULLSTR(10+$LINELENGTH+$MARGIN," ")]]))
+
+print(x,domain) ==
+  dom:= devaluate domain
+  $InteractiveMode: local:= true
+  $dontDisplayEquatnum: local:= true
+  output(x,dom)
+
+mathprintWithNumber x ==
+  x:= outputTran x
+  maprin
+    $IOindex => ['EQUATNUM,$IOindex,x]
+    x
+
+mathprint x == 
+   x := outputTran x
+   $saturn => texFormat1 x
+   maprin x
+
+sayMath u ==
+  for x in u repeat acc:= concat(acc,linearFormatName x)
+  sayALGEBRA acc
+
+--% Output transformations
+
+outputTran x ==
+  x in '("failed" "nil" "prime" "sqfr" "irred") =>
+    STRCONC('"_"",x,'"_"")
+  STRINGP x => x
+  VECP x =>
+    outputTran ['BRACKET,['AGGLST,:[x.i for i in 0..MAXINDEX x]]]
+  NUMBERP x =>
+    MINUSP x => ["-",MINUS x]
+    x
+  atom x =>
+    x=$EmptyMode => specialChar 'quad
+    x
+  x is [c,var,mode] and c in '(_pretend _: _:_: _@) =>
+    var := outputTran var
+    if PAIRP var then var := ['PAREN,var]
+    ['CONCATB,var,c,obj2String prefix2String mode]
+  x is ['ADEF,vars,.,.,body] =>
+    vars :=
+        vars is [x] => x
+        ['Tuple,:vars]
+    outputTran ["+->", vars, body]
+  x is ['MATRIX,:m] => outputTranMatrix m
+  x is ['matrix,['construct,c]] and
+    c is ['COLLECT,:m,d] and d is ['construct,e] and e is ['COLLECT,:.] =>
+      outputTran ['COLLECT,:m,e]
+  x is ['LIST,:l] => outputTran ['BRACKET,['AGGLST,:l]]
+  x is ['MAP,:l] => outputMapTran l
+  x is ['brace, :l]    =>
+    ['BRACE,  ['AGGLST,:[outputTran y for y in l]]]
+  x is ['return,l] => ['return,outputTran l]
+  x is ['return,.,:l] => ['return,:outputTran l]
+  x is ['construct,:l] =>
+    ['BRACKET,['AGGLST,:[outputTran y for y in l]]]
+
+  x is [["$elt",domain,"float"], x, y, z] and (domain = $DoubleFloat or
+    domain is ['Float]) and INTEGERP x and INTEGERP y and INTEGERP z and
+        z > 0  and (float := getFunctionFromDomain("float",domain,[$Integer,$Integer,$PositiveInteger])) =>
+            f := SPADCALL(x,y,z,float)
+            o := coerceInteractive(mkObjWrap(f, domain), '(OutputForm))
+            objValUnwrap o
+
+  [op,:l]:= flattenOps x
+  --needed since "op" is string in some spad code
+  if STRINGP op then (op := INTERN op; x:= [op,:l])
+  op = 'LAMBDA_-CLOSURE => 'Closure
+  x is ['break,:.] => 'break
+  x is ['SEGMENT,a] =>
+    a' := outputTran a
+    if LISTP a' then a' := ['PAREN,a']
+    ['SEGMENT,a']
+  x is ['SEGMENT,a,b] =>
+    a' := outputTran a
+    b' := outputTran b
+    if LISTP a' then a' := ['PAREN,a']
+    if LISTP b' then b' := ['PAREN,b']
+    ['SEGMENT,a',b']
+
+  op is ["$elt",targ,fun] or not $InteractiveMode and op is ["elt",targ,fun] =>
+    -- l has the args
+    targ' := obj2String prefix2String targ
+    if 2 = #targ then targ' := ['PAREN,targ']
+    ['CONCAT,outputTran [fun,:l],'"$",targ']
+  x is ["$elt",targ,c] or not $InteractiveMode and x is ["elt",targ,c] =>
+    targ' := obj2String prefix2String targ
+    if 2 = #targ then targ' := ['PAREN,targ']
+    ['CONCAT,outputTran c,'"$",targ']
+  x is ["-",a,b] =>
+    a := outputTran a
+    b := outputTran b
+    INTEGERP b =>
+      b < 0 => ["+",a,-b]
+      ["+",a,["-",b]]
+    b is ["-",c] => ["+",a,c]
+    ["+",a,["-",b]]
+
+  -- next stuff translates exp(log(foo4)/foo3) into ROOT(foo4,foo3)
+  (x is ["**", ='"%e",foo1]) and (foo1 is [ ='"/",foo2, foo3]) and
+    INTEGERP(foo3) and (foo2 is ['log,foo4]) =>
+       foo3 = 2 => ['ROOT,outputTran foo4]
+       ['ROOT,outputTran foo4,outputTran foo3]
+  (x is ["**", ='"%e",foo1]) and (foo1 is [op',foo2, foo3]) and
+    (op' = '"*") and ((foo3 is ['log,foo4]) or (foo2 is ['log,foo4])) =>
+       foo3 is ['log,foo4] =>
+         ["**", outputTran foo4, outputTran foo2]
+       foo4 := CADR foo2
+       ["**", outputTran foo4, outputTran foo3]
+  op = 'IF       => outputTranIf x
+  op = 'COLLECT  => outputTranCollect x
+  op = 'REDUCE   => outputTranReduce x
+  op = 'REPEAT   => outputTranRepeat x
+  op = 'SEQ      => outputTranSEQ x
+  op in '(cons nconc) => outputConstructTran x
+  l:= [outputTran y for y in l]
+  op = "*" =>
+     l is [a] => outputTran a
+     l is [["-",a],:b] =>
+       -- now this is tricky because we've already outputTran the list
+       -- expect trouble when outputTran hits b again 
+       -- some things object to being outputTran twice ,e.g.matrices
+       -- same thing a bit lower down for "/" 
+       a=1 => outputTran ["-",[op,:b]]
+       outputTran ["-",[op,a,:b]]
+     [op,:"append"/[(ss is ["*",:ll] => ll; [ss]) for ss in l]]
+  op = "+" =>
+     l is [a] => outputTran a
+     [op,:"append"/[(ss is ["+",:ll] => ll; [ss]) for ss in l]]
+  op = "/" =>
+    if $fractionDisplayType = 'horizontal then op := 'SLASH
+    else op := 'OVER
+    l is [["-",a],:b] => outputTran ["-",[op,a,:b]]
+    [outputTran op,:l]
+  op="|" and l is [["Tuple",:u],pred] =>
+    ['PAREN,["|",['AGGLST,:l],pred]]
+  op='Tuple  => ['PAREN,['AGGLST,:l]]
+  op='LISTOF => ['AGGLST,:l]
+  IDENTP op and ^(op in '(_* _*_*) ) and char("*") = (PNAME op).0 =>
+    mkSuperSub(op,l)
+  [outputTran op,:l]
+
+-- The next two functions are designed to replace successive instances of
+-- binary functions with the n-ary equivalent, cutting down on recursion
+-- in outputTran and in partciular allowing big polynomials to be printed
+-- without stack overflow.  MCD.
+flattenOps l ==
+  [op, :args ] := l
+  op in ['"+",'"*","+","*"] =>
+    [op,:checkArgs(op,args)]
+  l
+
+checkArgs(op,tail) ==
+  head := []
+  while tail repeat
+    term := first tail
+    atom term =>
+      head := [term,:head]
+      tail := rest tail
+    not LISTP term => -- never happens?
+      head := [term,:head]
+      tail := rest tail
+    op=first term =>
+      tail := [:rest term,:rest tail]
+    head := [term,:head]
+    tail := rest tail
+  REVERSE head
+   
+outputTranSEQ ['SEQ,:l,exitform] ==
+  if exitform is ['exit,.,a] then exitform := a
+  ['SC,:[outputTran x for x in l],outputTran exitform]
+
+outputTranIf ['IF,x,y,z] ==
+  y = 'noBranch =>
+    ['CONCATB,'if,['CONCATB,'not,outputTran x],'then,outputTran z]
+  z = 'noBranch =>
+    ['CONCATB,'if,outputTran x,'then,outputTran y]
+  y' := outputTran y
+  z' := outputTran z
+--y' is ['SC,:.] or z' is ['SC,:.] =>
+-- ['CONCATB,'if,outputTran x,
+--   ['SC,['CONCATB,'then,y'],['CONCATB,'else,z']]]
+--['CONCATB,'if,outputTran x,'then,outputTran y,'else,outputTran z]
+  ['CONCATB,'if,outputTran x,
+    ['SC,['CONCATB,'then,y'],['CONCATB,'else,z']]]
+
+outputMapTran l ==
+  null l => NIL         -- should not happen
+
+  -- display subscripts linearly
+  $linearFormatScripts : local := true
+
+  -- get the real names of the parameters
+  alias := get($op,'alias,$InteractiveFrame)
+
+  rest l =>             -- if multiple forms, call repeatedly
+    ['SC,:[outputMapTran0(ll,alias) for ll in l]]
+  outputMapTran0(first l,alias)
+
+outputMapTran0(argDef,alias) ==
+  arg := first argDef
+  def := rest  argDef
+  [arg',:def'] := simplifyMapPattern(argDef,alias)
+  arg' := outputTran arg'
+  if null arg' then arg' := '"()"
+  ['CONCATB,$op,outputTran arg',"==",outputTran def']
+
+outputTranReduce ['REDUCE,op,.,body] ==
+  ['CONCAT,op,"/",outputTran body]
+
+outputTranRepeat ["REPEAT",:itl,body] ==
+  body' := outputTran body
+  itl =>
+    itlist:= outputTranIteration itl
+    ['CONCATB,itlist,'repeat,body']
+  ['CONCATB,'repeat,body']
+
+outputTranCollect [.,:itl,body] ==
+  itlist:= outputTranIteration itl
+  ['BRACKET,['CONCATB,outputTran body,itlist]]
+
+outputTranIteration itl ==
+  null rest itl => outputTranIterate first itl
+  ['CONCATB,outputTranIterate first itl,outputTranIteration rest itl]
+
+outputTranIterate x ==
+  x is ['STEP,n,init,step,:final] =>
+    init' := outputTran init
+    if LISTP init then init' := ['PAREN,init']
+    final' :=
+      final =>
+        LISTP first final => [['PAREN,outputTran first final]]
+        [outputTran first final]
+      NIL
+    ['STEP,outputTran n,init',outputTran step,:final']
+  x is ["IN",n,s] => ["IN",outputTran n,outputTran s]
+  x is [op,p] and op in '(_| UNTIL WHILE) =>
+    op:= DOWNCASE op
+    ['CONCATB,op,outputTran p]
+  throwKeyedMsg("S2IX0008",['outputTranIterate,['"illegal iterate: ",x]])
+
+outputConstructTran x ==
+  x is [op,a,b] =>
+    a:= outputTran a
+    b:= outputTran b
+    op="cons" =>
+      b is ['construct,:l] => ['construct,a,:l]
+      ['BRACKET,['AGGLST,:[a,[":",b]]]]
+    op="nconc" =>
+      aPart :=
+        a is ['construct,c] and c is ['SEGMENT,:.] => c
+        [":",a]
+      b is ['construct,:l] => ['construct,aPart,:l]
+      ['BRACKET,['AGGLST,aPart,[":",b]]]
+    [op,a,b]
+  atom x => x
+  [outputTran first x,:outputConstructTran rest x]
+
+outputTranMatrix x ==
+  not VECP x =>
+    -- assume that the only reason is that we've been done before
+    ["MATRIX",:x]
+    --keyedSystemError("S2GE0016",['"outputTranMatrix",
+    -- '"improper internal form for matrix found in output routines"])
+  ["MATRIX",nil,:[outtranRow x.i for i in 0..MAXINDEX x]] where
+    outtranRow x ==
+      not VECP x =>
+        keyedSystemError("S2GE0016",['"outputTranMatrix",
+          '"improper internal form for matrix found in output routines"])
+      ["ROW",:[outputTran x.i for i in 0..MAXINDEX x]]
+
+mkSuperSub(op,argl) ==
+  $linearFormatScripts => linearFormatForm(op,argl)
+--  l := [(STRINGP f => f; STRINGIMAGE f)
+--    for f in linearFormatForm(op,argl)]
+--  "STRCONC"/l
+  s:= PNAME op
+  indexList:= [PARSE_-INTEGER PNAME d for i in 1.. while
+    (DIGITP (d:= s.(maxIndex:= i)))]
+  cleanOp:= INTERN ("STRCONC"/[PNAME s.i for i in maxIndex..MAXINDEX s])
+  -- if there is just a subscript use the SUB special form
+  #indexList=2 =>
+    subPart:= ['SUB,cleanOp,:take(indexList.1,argl)]
+    l:= drop(indexList.1,argl) => [subPart,:l]
+    subPart
+  -- otherwise use the SUPERSUB form
+  superSubPart := NIL
+  for i in rest indexList repeat
+    scripts :=
+      this:= take(i,argl)
+      argl:= drop(i,argl)
+      i=0 => ['AGGLST]
+      i=1 => first this
+      ['AGGLST,:this]
+    superSubPart := cons(scripts,superSubPart)
+  superSub := ['SUPERSUB,cleanOp,:reverse superSubPart]
+  argl => [superSub,:argl]
+  superSub
+
+timesApp(u,x,y,d) ==
+  rightPrec:= getOpBindingPower("*","Led","right")
+  firstTime:= true
+  for arg in rest u repeat
+    op:= keyp arg
+    if ^firstTime and (needBlankForRoot(lastOp,op,arg) or
+       needStar(wasSimple,wasQuotient,wasNumber,arg,op) or
+        wasNumber and op = 'ROOT and subspan arg = 1) then
+      d:= APP(BLANK,x,y,d)
+      x:= x+1
+    [d,x]:= appInfixArg(arg,x,y,d,rightPrec,"left",nil) --app in a right arg
+    wasSimple:= atom arg and not NUMBERP arg or isRationalNumber arg
+    wasQuotient:= isQuotient op
+    wasNumber:= NUMBERP arg
+    lastOp := op
+    firstTime:= nil
+  d
+
+needBlankForRoot(lastOp,op,arg) ==
+  lastOp ^= "^" and lastOp ^= "**" and not(subspan(arg)>0) => false
+  op = "**" and keyp CADR arg = 'ROOT => true
+  op = "^" and keyp CADR arg = 'ROOT => true
+  op = 'ROOT and CDDR arg => true
+  false
+
+stepApp([.,a,init,one,:optFinal],x,y,d) ==
+  d:= appChar('"for ",x,y,d)
+  d:= APP(a,w:=x+4,y,d)
+  d:= appChar('" in ",w:=w+WIDTH a,y,d)
+  d:= APP(init,w:=w+4,y,d)
+  d:= APP('"..",w:=w+WIDTH init,y,d)
+  if optFinal then d:= APP(first optFinal,w+2,y,d)
+  d
+
+stepSub [.,a,init,one,:optFinal] ==
+  m:= MAX(subspan a,subspan init)
+  optFinal => MAX(m,subspan first optFinal)
+  m
+
+stepSuper [.,a,init,one,:optFinal] ==
+  m:= MAX(superspan a,superspan init)
+  optFinal => MAX(m,superspan first optFinal)
+  m
+
+stepWidth [.,a,init,one,:optFinal] ==
+   10+WIDTH a+WIDTH init+(optFinal => WIDTH first optFinal; 0)
+
+inApp([.,a,s],x,y,d) ==  --for [IN,a,s]
+  d:= appChar('"for ",x,y,d)
+  d:= APP(a,x+4,y,d)
+  d:= appChar('" in ",x+WIDTH a+4,y,d)
+  APP(s,x+WIDTH a+8,y,d)
+
+inSub [.,a,s] == MAX(subspan a,subspan s)
+
+inSuper [.,a,s] == MAX(superspan a,superspan s)
+
+inWidth [.,a,s] == 8+WIDTH a+WIDTH s
+
+centerApp([.,u],x,y,d) ==
+  d := APP(u,x,y,d)
+
+concatApp([.,:l],x,y,d) == concatApp1(l,x,y,d,0)
+
+concatbApp([.,:l],x,y,d) == concatApp1(l,x,y,d,1)
+
+concatApp1(l,x,y,d,n) ==
+  for u in l repeat
+    d:= APP(u,x,y,d)
+    x:=x+WIDTH u+n
+  d
+
+concatSub [.,:l] == "MAX"/[subspan x for x in l]
+
+concatSuper [.,:l] == "MAX"/[superspan x for x in l]
+
+concatWidth [.,:l] == +/[WIDTH x for x in l]
+
+concatbWidth [.,:l] == +/[1+WIDTH x for x in l]-1
+
+exptApp([.,a,b],x,y,d) ==
+  pren:= exptNeedsPren a
+  d:=
+    pren => appparu(a,x,y,d)
+    APP(a,x,y,d)
+  x':= x+WIDTH a+(pren => 2;0)
+  y':= 1+y+superspan a+subspan b + (0=superspan a => 0; -1)
+  APP(b,x',y',d)
+
+exptNeedsPren a ==
+  atom a and null (INTEGERP a and a < 0)  => false
+  key:= keyp a
+  key = "OVER" => true  -- added JHD 2/Aug/90
+  (key="SUB") or (null GET(key,"Nud") and null GET(key,"Led")) => false
+  true
+
+exptSub u == subspan CADR u
+
+exptSuper [.,a,b] == superspan a+height b+(superspan a=0 => 0;-1)
+
+exptWidth [.,a,b] == WIDTH a+WIDTH b+(exptNeedsPren a => 2;0)
+
+needStar(wasSimple,wasQuotient,wasNumber,cur,op) ==
+  wasQuotient or isQuotient op => true
+  wasSimple =>
+    atom cur or keyp cur="SUB" or isRationalNumber cur or op="**" or op = "^" or
+      (atom op and ^NUMBERP op and ^GETL(op,"APP"))
+  wasNumber =>
+    NUMBERP(cur) or isRationalNumber cur or
+        ((op="**" or op ="^") and NUMBERP(CADR cur))
+
+isQuotient op ==
+  op="/" or op="OVER"
+
+timesWidth u ==
+  rightPrec:= getOpBindingPower("*","Led","right")
+  firstTime:= true
+  w:= 0
+  for arg in rest u repeat
+    op:= keyp arg
+    if ^firstTime and needStar(wasSimple,wasQuotient,wasNumber,arg,op) then
+      w:= w+1
+    if infixArgNeedsParens(arg, rightPrec, "left") then w:= w+2
+    w:= w+WIDTH arg
+    wasSimple:= atom arg and not NUMBERP arg --or isRationalNumber arg
+    wasQuotient:= isQuotient op
+    wasNumber:= NUMBERP arg
+    firstTime:= nil
+  w
+
+plusApp([.,frst,:rst],x,y,d) ==
+  appSum(rst,x+WIDTH frst,y,APP(frst,x,y,d))
+
+appSum(u,x,y,d) ==
+  for arg in u repeat
+    infixOp:=
+      syminusp arg => "-"
+      "+"
+    opString:= GETL(infixOp,"INFIXOP") or '","
+    d:= APP(opString,x,y,d)
+    x:= x+WIDTH opString
+    arg:= absym arg --negate a neg. number or remove leading "-"
+    rightPrec:= getOpBindingPower(infixOp,"Led","right")
+    if infixOp = "-" then rightPrec:=rightPrec  +1
+    -- that +1 added JHD 2 Aug 89 to prevent x-(y+z) printing as x-y+z
+    -- Sutor found the example:
+    -- )cl all
+    -- p : P[x] P I := x - y - z
+    -- p :: P[x] FR P I
+    -- trailingCoef %
+    [d,x]:= appInfixArg(arg,x,y,d,rightPrec,"left",nil) --app in a right arg
+  d
+
+appInfix(e,x,y,d) ==
+  op := keyp e
+  leftPrec:= getOpBindingPower(op,"Led","left")
+  leftPrec = 1000 => return nil --no infix operator is allowed default value
+  rightPrec:= getOpBindingPower(op,"Led","right")
+  #e < 2 => throwKeyedMsg("S2IX0008",['appInfix,
+      '"fewer than 2 arguments to an infix function"])
+  opString:= GETL(op,"INFIXOP") or '","
+  opWidth:= WIDTH opString
+  [.,frst,:rst]:= e
+  null rst =>
+    GETL(op,"isSuffix") =>
+      [d,x]:= appInfixArg(frst,x,y,d,leftPrec,"right",opString)
+      d:= appChar(opString,x,y,d)
+    THROW('outputFailure,'outputFailure)
+  [d,x]:= appInfixArg(frst,x,y,d,leftPrec,"right",opString) --app in left arg
+  for arg in rst repeat
+    d:= appChar(opString,x,y,d) --app in the infix operator
+    x:= x+opWidth
+    [d,x]:= appInfixArg(arg,x,y,d,rightPrec,"left",opString) --app in right arg
+  d
+
+appconc(d,x,y,w) == NCONC(d,[[[x,:y],:w]])
+
+infixArgNeedsParens(arg, prec, leftOrRight) ==
+  prec > getBindingPowerOf(leftOrRight, arg) + 1
+
+appInfixArg(u,x,y,d,prec,leftOrRight,string) ==
+  insertPrensIfTrue:= infixArgNeedsParens(u,prec,leftOrRight)
+  d:=
+    insertPrensIfTrue => appparu(u,x,y,d)
+    APP(u,x,y,d)
+  x:= x+WIDTH u
+  if string then d:= appconc(d,x,y,string)
+  [d,(insertPrensIfTrue => x+2; x)]
+
+getBindingPowerOf(key,x) ==
+  --binding powers can be found in file NEWAUX LISP
+  x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
+  x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
+  x is ["COND",:.] => (key="left" => 130; key="right" => 0)
+  x is [op,:argl] =>
+    if op is [a,:.] then op:= a
+    op = 'SLASH => getBindingPowerOf(key,["/",:argl]) - 1
+    op = 'OVER  => getBindingPowerOf(key,["/",:argl])
+    (n:= #argl)=1 =>
+      key="left" and (m:= getOpBindingPower(op,"Nud","left")) => m
+      key="right" and (m:= getOpBindingPower(op,"Nud","right")) => m
+      1000
+    n>1 =>
+      key="left" and (m:= getOpBindingPower(op,"Led","left")) => m
+      key="right" and (m:= getOpBindingPower(op,"Led","right")) => m
+      op="ELT" => 1002
+      1000
+    1000
+  1002
+
+getOpBindingPower(op,LedOrNud,leftOrRight) ==
+  if op in '(SLASH OVER) then op := "/"
+  exception:=
+    leftOrRight="left" => 0
+    105
+  bp:=
+    leftOrRight="left" => leftBindingPowerOf(op,LedOrNud)
+    rightBindingPowerOf(op,LedOrNud)
+  bp^=exception => bp
+  1000
+
+--% Brackets
+bracketApp(u,x,y,d) ==
+  u is [.,u] or THROW('outputFailure,'outputFailure)
+  d:= appChar(specialChar 'lbrk,x,y,d)
+  d:=APP(u,x+1,y,d)
+  appChar(specialChar 'rbrk,x+1+WIDTH u,y,d)
+
+--% Braces
+braceApp(u,x,y,d) ==
+  u is [.,u] or THROW('outputFailure,'outputFailure)
+  d:= appChar(specialChar 'lbrc,x,y,d)
+  d:=APP(u,x+1,y,d)
+  appChar(specialChar 'rbrc,x+1+WIDTH u,y,d)
+
+--% Aggregates
+aggWidth u ==
+  rest u is [a,:l] => WIDTH a + +/[1+WIDTH x for x in l]
+  0
+
+aggSub u == subspan rest u
+
+aggSuper u == superspan rest u
+
+aggApp(u,x,y,d) == aggregateApp(rest u,x,y,d,",")
+
+aggregateApp(u,x,y,d,s) ==
+  if u is [a,:l] then
+    d:= APP(a,x,y,d)
+    x:= x+WIDTH a
+    for b in l repeat
+      d:= APP(s,x,y,d)
+      d:= APP(b,x+1,y,d)
+      x:= x+1+WIDTH b
+  d
+
+--% Function to compute Width
+
+outformWidth u ==  --WIDTH as called from OUTFORM to do a COPY
+  STRINGP u =>
+    u = $EmptyString => 0
+    u.0="%" and ((u.1 = char 'b) or (u.1 = char 'd)) => 1
+    #u
+  atom u => # atom2String u
+  WIDTH COPY u
+
+WIDTH u ==
+  STRINGP u =>
+    u = $EmptyString => 0
+    u.0="%" and ((u.1 = char 'b) or (u.1 = char 'd)) => 1
+    #u
+  INTEGERP u => 
+    if (u < 1) then 
+      negative := 1
+      u := -u
+    else
+      negative := 0
+    -- Try and be fairly exact for smallish integers:
+    u = 0 => 1
+<<GCLlog10bug>>
+    -- Rough guess: integer-length returns log2 rounded up, so divide it by
+    -- roughly log2(10). This should return an over-estimate, but for objects
+    -- this big does it matter?
+    FLOOR(INTEGER_-LENGTH(u)/3.3)
+  atom u => # atom2String u
+  putWidth u is [[.,:n],:.] => n
+  THROW('outputFailure,'outputFailure)
+
+putWidth u ==
+  atom u or u is [[.,:n],:.] and NUMBERP n => u
+  op:= keyp u
+--NUMBERP op => nil
+  leftPrec:= getBindingPowerOf("left",u)
+  rightPrec:= getBindingPowerOf("right",u)
+  [firstEl,:l] := u
+  interSpace:=
+    SYMBOLP firstEl and GETL(firstEl,"INFIXOP") => 0
+    1
+  argsWidth:=
+    l is [firstArg,:restArg] =>
+      RPLACA(rest u,putWidth firstArg)
+      for y in tails restArg repeat RPLACA(y,putWidth first y)
+      widthFirstArg:=
+        0=interSpace and infixArgNeedsParens(firstArg,leftPrec,"right")=>
+          2+WIDTH firstArg
+        WIDTH firstArg
+      widthFirstArg + +/[interSpace+w for x in restArg] where w ==
+        0=interSpace and infixArgNeedsParens(x, rightPrec, "left") =>
+          2+WIDTH x
+        WIDTH x
+    0
+  newFirst:=
+    atom (oldFirst:= first u) =>
+      fn:= GET(oldFirst,"WIDTH") =>
+        [oldFirst,:FUNCALL(fn,[oldFirst,:l])]
+      if l then ll := rest l else ll := nil
+      [oldFirst,:opWidth(oldFirst,ll)+argsWidth]
+    [putWidth oldFirst,:2+WIDTH oldFirst+argsWidth]
+  RPLACA(u,newFirst)
+  u
+
+opWidth(op,has2Arguments) ==
+  op = "EQUATNUM" => 4
+  NUMBERP op => 2+SIZE STRINGIMAGE op
+  null has2Arguments =>
+    a:= GETL(op,"PREFIXOP") => SIZE a
+    2+SIZE PNAME op
+  a:= GETL(op,"INFIXOP") => SIZE a
+  2+SIZE PNAME op
+
+matrixBorder(x,y1,y2,d,leftOrRight) ==
+  y1 = y2 =>
+    c :=
+      leftOrRight = 'left => specialChar('lbrk)
+      specialChar('rbrk)
+    APP(c,x,y1,d)
+  for y in y1..y2 repeat
+    c :=
+      y = y1 =>
+        leftOrRight = 'left => specialChar('llc)
+        specialChar('lrc)
+      y = y2 =>
+        leftOrRight = 'left => specialChar('ulc)
+        specialChar('urc)
+      specialChar('vbar)
+    d := APP(c,x,y,d)
+  d
+
+isRationalNumber x == nil
+
+widthSC u == 10000
+
+--% The over-large matrix package
+
+maprinSpecial(x,$MARGIN,$LINELENGTH) == maprin0 x
+-- above line changed JHD 13/2/93 since it used to call maPrin
+
+maprin x ==
+  if $demoFlag=true then recordOrCompareDemoResult x
+  CATCH('output,maprin0 x)
+  nil
+
+maprin0 x ==
+  $MatrixCount:local :=0
+  $MatrixList:local :=nil
+  maprinChk x
+  if $MatrixList then maprinRows $MatrixList
+  -- above line moved JHD 28/2/93 to catch all routes through maprinChk
+
+maprinChk x ==
+  null $MatrixList => maPrin x
+  ATOM x and (u:= ASSOC(x,$MatrixList)) =>
+    $MatrixList := delete(u,$MatrixList)
+    maPrin deMatrix CDR u
+  x is ["=",arg,y]  =>     --case for tracing with )math and printing matrices
+    u:=ASSOC(y,$MatrixList) =>
+      -- we don't want to print matrix1 = matrix2 ...
+      $MatrixList := delete(u,$MatrixList)
+      maPrin ["=",arg, deMatrix CDR u]
+    maPrin x
+  x is ['EQUATNUM,n,y] =>
+    $MatrixList is [[name,:value]] and y=name =>
+      $MatrixList:=[]   -- we are pulling this one off
+      maPrin ['EQUATNUM,n, deMatrix value]
+    IDENTP y => --------this part is never called
+      -- Not true: JHD 28/2/93
+      -- m:=[[1,2,3],[4,5,6],[7,8,9]]
+      -- mm:=[[m,1,0],[0,m,1],[0,1,m]]
+      -- and try to print mm**5
+      u := ASSOC(y,$MatrixList)
+      --$MatrixList := deleteAssoc(first u,$MatrixList)
+      -- deleteAssoc no longer exists
+      $MatrixList := delete(u,$MatrixList)
+      maPrin ['EQUATNUM,n,rest u]
+      if ^$collectOutput then TERPRI $algebraOutputStream
+    maPrin x
+  maPrin x
+  -- above line added JHD 13/2/93 since otherwise x gets lost
+
+maprinRows matrixList ==
+  if ^$collectOutput then TERPRI($algebraOutputStream)
+  while matrixList repeat
+    y:=NREVERSE matrixList
+    --Makes the matrices come out in order, since CONSed on backwards
+    matrixList:=nil
+    firstName := first first y
+    for [name,:m] in y for n in 0.. repeat
+      if ^$collectOutput then TERPRI($algebraOutputStream)
+      andWhere := (name = firstName => '"where "; '"and ")
+      line := STRCONC(andWhere, PNAME name)
+      maprinChk ["=",line,m]
+      -- note that this could place a new element on $MatrixList, hence the loop
+
+deMatrix m ==
+    ['BRACKET,['AGGLST,
+        :[['BRACKET,['AGGLST,:rest row]] for row in CDDR m]]]
+
+LargeMatrixp(u,width, dist) ==
+  --  sees if there is a matrix wider than 'width' in the next 'dist'
+  --  part of u, a sized charybdis structure.
+  --  NIL if not, first such matrix if there is one
+  ATOM u => nil
+  CDAR u <= width => nil
+       --CDAR is the width of a charybdis structure
+  op:=CAAR u
+  op = 'MATRIX => largeMatrixAlist u
+         --We already know the structure is more than 'width' wide
+  MEMQ(op,'(LET RARROW SEGMENT _- CONCAT CONCATB PAREN BRACKET BRACE)) =>
+      --Each of these prints the arguments in a width 3 smaller
+    dist:=dist-3
+    width:=width-3
+    ans:=
+      for v in CDR u repeat
+        (ans:=LargeMatrixp(v,width,dist)) => return largeMatrixAlist ans
+        dist:=dist - WIDTH v
+        dist<0 => return nil
+    ans
+      --Relying that falling out of a loop gives nil
+  MEMQ(op,'(_+ _* )) =>
+      --Each of these prints the first argument in a width 3 smaller
+    (ans:=LargeMatrixp(CADR u,width-3,dist)) => largeMatrixAlist ans
+    n:=3+WIDTH CADR u
+    dist:=dist-n
+    ans:=
+      for v in CDDR u repeat
+        (ans:=LargeMatrixp(v,width,dist)) => return largeMatrixAlist ans
+        dist:=dist - WIDTH v
+        dist<0 => return nil
+    ans
+      --Relying that falling out of a loop gives nil
+  ans:=
+    for v in CDR u repeat
+      (ans:=LargeMatrixp(v,width,dist)) => return largeMatrixAlist ans
+      dist:=dist - WIDTH v
+      dist<0 => return nil
+  ans
+    --Relying that falling out of a loop gives nil
+
+largeMatrixAlist u ==
+  u is [op,:r] =>
+    op is ['MATRIX,:.] => deMatrix u
+    largeMatrixAlist op or largeMatrixAlist r
+  nil
+
+PushMatrix m ==
+    --Adds the matrix to the look-aside list, and returns a name for it
+  name:=
+    for v in $MatrixList repeat
+        EQUAL(m,CDR v) => return CAR v
+  name => name
+  name:=INTERNL('"matrix",STRINGIMAGE($MatrixCount:=$MatrixCount+1))
+  $MatrixList:=[[name,:m],:$MatrixList]
+  name
+
+quoteApp([.,a],x,y,d) == APP(a,x+1,y,appChar(PNAME "'",x,y,d))
+
+quoteSub [.,a] == subspan a
+
+quoteSuper [.,a] == superspan a
+
+quoteWidth [.,a] == 1 + WIDTH a
+
+SubstWhileDesizing(u,m) ==
+    -- arg. m is always nil (historical: EU directive to increase argument lists 1991/XGII)	
+    --Replaces all occurrences of matrix m by name in u
+    --Taking out any outdated size information as it goes
+  ATOM u => u
+  [[op,:n],:l]:=u
+  --name := RASSOC(u,$MatrixList) => name
+  -- doesn't work since RASSOC seems to use an EQ test, and returns the
+  -- pair anyway. JHD 28/2/93
+  op = 'MATRIX =>
+    l':=SubstWhileDesizingList(CDR l,m)
+    u :=
+      -- CDR l=l' => u
+      -- this was a CONS-saving optimisation, but it doesn't work JHD 28/2/93
+      [op,nil,:l']
+    PushMatrix u
+  l':=SubstWhileDesizingList(l,m)
+  -- [op,:l']
+  ATOM op => [op,:l']
+  [SubstWhileDesizing(op,m),:l']
+
+--;SubstWhileDesizingList(u,m) ==
+--;  -- m is always nil (historical)
+--;  u is [a,:b] =>
+--;    a':=SubstWhileDesizing(a,m)
+--;    b':=SubstWhileDesizingList(b,m)
+--;-- MCD & TTT think that this test is unnecessary and expensive
+--;--    a=a' and b=b' => u
+--;    [a',:b']
+--;  u
+
+SubstWhileDesizingList(u,m) ==
+   u is [a,:b] =>
+     res:= 
+       ATOM a => [a] 
+       [SubstWhileDesizing(a,m)] 
+     tail:=res
+     for i in b repeat
+	if ATOM i then  RPLACD(tail,[i]) else RPLACD(tail,[SubstWhileDesizing(i,m)])
+        tail:=CDR tail
+     res   
+   u  
+
+--% Printing of Sigmas , Pis and Intsigns
+
+sigmaSub u ==
+       --The depth function for sigmas with lower limit only
+  MAX(1 + height CADR u, subspan CADDR u)
+
+sigmaSup u ==
+       --The height function for sigmas with lower limit only
+  MAX(1, superspan CADDR u)
+
+sigmaApp(u,x,y,d) ==
+  u is [.,bot,arg] or THROW('outputFailure,'outputFailure)
+  bigopAppAux(bot,nil,arg,x,y,d,'sigma)
+
+sigma2App(u,x,y,d) ==
+  [.,bot,top,arg]:=u
+  bigopAppAux(bot,top,arg,x,y,d,'sigma)
+
+bigopWidth(bot,top,arg,kind) ==
+  kindWidth := (kind = 'pi => 5; 3)
+  MAX(kindWidth,WIDTH bot,(top => WIDTH top; 0)) + 2 + WIDTH arg
+
+bigopAppAux(bot,top,arg,x,y,d,kind) ==
+  botWidth := (bot => WIDTH bot; 0)
+  topWidth := WIDTH top
+  opWidth :=
+    kind = 'pi => 5
+    3
+  maxWidth := MAX(opWidth,botWidth,topWidth)
+  xCenter := (maxWidth-1)/ 2 + x
+  d:=APP(arg,x+2+maxWidth,y,d)
+  d:=
+      atom bot and SIZE atom2String bot = 1 => APP(bot,xCenter,y-2,d)
+      APP(bot,x + (maxWidth - botWidth)/2,y-2-superspan bot,d)
+  if top then
+    d:=
+      atom top and SIZE atom2String top = 1 => APP(top,xCenter,y+2,d)
+      APP(top,x + (maxWidth - topWidth)/2,y+2+subspan top,d)
+  delta := (kind = 'pi => 2; 1)
+  opCode :=
+    kind = 'sigma =>
+      [['(0 .  0),:'">"],_
+       ['(0 .  1),:specialChar('hbar)],_
+       ['(0 . -1),:specialChar('hbar)],_
+       ['(1 .  1),:specialChar('hbar)],_
+       ['(1 . -1),:specialChar('hbar)],_
+       ['(2 .  1),:specialChar('urc )],_
+       ['(2 . -1),:specialChar('lrc )]]
+    kind = 'pi =>
+      [['(0 .  1),:specialChar('ulc )],_
+       ['(1 .  0),:specialChar('vbar)],_
+       ['(1 .  1),:specialChar('ttee)],_
+       ['(1 . -1),:specialChar('vbar)],_
+       ['(2 .  1),:specialChar('hbar)],_
+       ['(3 .  0),:specialChar('vbar)],_
+       ['(3 .  1),:specialChar('ttee)],_
+       ['(3 . -1),:specialChar('vbar)],_
+       ['(4 .  1),:specialChar('urc )]]
+    THROW('outputFailure,'outputFailure)
+  xLate(opCode,xCenter - delta,y,d)
+
+sigmaWidth [.,bot,arg] == bigopWidth(bot,nil,arg,'sigma)
+sigma2Width [.,bot,top,arg] == bigopWidth(bot,top,arg,'sigma)
+
+sigma2Sub u ==
+       --The depth function for sigmas with 2 limits
+  MAX(1 + height CADR u, subspan CADDDR u)
+
+sigma2Sup u ==
+       --The depth function for sigmas with 2 limits
+  MAX(1 + height CADDR u, superspan CADDDR u)
+
+piSub u ==
+       --The depth function for pi's (products)
+  MAX(1 + height CADR u, subspan CADDR u)
+
+piSup u ==
+       --The height function for pi's (products)
+  MAX(1, superspan CADDR u)
+
+piApp(u,x,y,d) ==
+  u is [.,bot,arg] or THROW('outputFailure,'outputFailure)
+  bigopAppAux(bot,nil,arg,x,y,d,'pi)
+
+piWidth [.,bot,arg] == bigopWidth(bot,nil,arg,'pi)
+pi2Width [.,bot,top,arg] == bigopWidth(bot,top,arg,'pi)
+
+pi2Sub u ==
+       --The depth function for pi's with 2 limits
+  MAX(1 + height CADR u, subspan CADDDR u)
+
+pi2Sup u ==
+       --The depth function for pi's with 2 limits
+  MAX(1 + height CADDR u, superspan CADDDR u)
+
+pi2App(u,x,y,d) ==
+  [.,bot,top,arg]:=u
+  bigopAppAux(bot,top,arg,x,y,d,'pi)
+
+overlabelSuper [.,a,b] == 1 + height a + superspan b
+
+overlabelWidth [.,a,b] == WIDTH b
+
+overlabelApp([.,a,b], x, y, d) ==
+  underApp:= APP(b,x,y,d)
+  endPoint := x + WIDTH b - 1
+  middle := QUOTIENT(x + endPoint,2)
+  h := y + superspan b + 1
+  d := APP(a,middle,h + 1,d)
+  apphor(x,x+WIDTH b-1,y+superspan b+1,d,"|")
+
+overbarSuper u == 1 + superspan u.1
+
+overbarWidth u == WIDTH u.1
+
+overbarApp(u,x,y,d) ==
+  underApp:= APP(u.1,x,y,d)
+  apphor(x,x+WIDTH u.1-1,y+superspan u.1+1,d,UNDERBAR)
+
+indefIntegralSub u ==
+   -- form is INDEFINTEGRAL(expr,dx)
+   MAX(1,subspan u.1,subspan u.2)
+
+indefIntegralSup u ==
+   -- form is INDEFINTEGRAL(expr,dx)
+   MAX(1,superspan u.1,superspan u.2)
+
+indefIntegralApp(u,x,y,d) ==
+   -- form is INDEFINTEGRAL(expr,dx)
+  [.,expr,dx]:=u
+  d := APP(expr,x+4,y,d)
+  d := APP(dx,x+5+WIDTH expr,y,d)
+  xLate( [['(0 . -1),:specialChar('llc) ],_
+          ['(1 . -1),:specialChar('lrc) ],_
+          ['(1 .  0),:specialChar('vbar)],_
+          ['(1 .  1),:specialChar('ulc) ],_
+          ['(2 .  1),:specialChar('urc) ]], x,y,d)
+
+indefIntegralWidth u ==
+  -- form is INDEFINTEGRAL(expr,dx)
+  # u ^= 3 => THROW('outputFailure,'outputFailure)
+  5 + WIDTH u.1 + WIDTH u.2
+
+intSub u ==
+   MAX(1 + height u.1, subspan u.3)
+
+intSup u ==
+   MAX(1 + height u.2, superspan u.3)
+
+intApp(u,x,y,d) ==
+  [.,bot,top,arg]:=u
+  d:=APP(arg,x+4+MAX(-4 + WIDTH bot, WIDTH top),y,d)
+  d:=APP(bot,x,y-2-superspan bot,d)
+  d:=APP(top,x+3,y+2+subspan top,d)
+  xLate( [['(0 . -1),:specialChar('llc) ],_
+          ['(1 . -1),:specialChar('lrc) ],_
+          ['(1 .  0),:specialChar('vbar)],_
+          ['(1 .  1),:specialChar('ulc) ],_
+          ['(2 .  1),:specialChar('urc) ]], x,y,d)
+
+intWidth u ==
+  # u < 4 => THROW('outputFailure,'outputFailure)
+  MAX(-4 + WIDTH u.1, WIDTH u.2) + WIDTH u.3 + 5
+
+xLate(l,x,y,d) ==
+  for [[a,:b],:c] in l repeat
+    d:= appChar(c,x+a,y+b,d)
+  d
+
+concatTrouble(u,d,start,lineLength,$addBlankIfTrue) ==
+  [x,:l] := splitConcat(u,lineLength,true)
+  null l =>
+    sayALGEBRA ['%l,'%b,'"  Too wide to Print",'%d]
+    THROW('output,nil)
+  charybdis(fixUp x,start,lineLength)
+  for y in l repeat
+    if d then prnd(start,d)
+    if lineLength > 2 then
+       charybdis(fixUp y,start+2,lineLength-2) -- JHD needs this to avoid lunacy
+      else charybdis(fixUp y,start,1) -- JHD needs this to avoid lunacy
+  BLANK
+ where
+  fixUp x ==
+    rest x =>
+      $addBlankIfTrue => ['CONCATB,:x]
+      ["CONCAT",:x]
+    first x
+
+splitConcat(list,maxWidth,firstTimeIfTrue) ==
+  null list => nil
+  -- split list l into a list of n lists, each of which
+  -- has width < maxWidth
+  totalWidth:= 0
+  oneOrZero := ($addBlankIfTrue => 1; 0)
+  l := list
+  maxW:= (firstTimeIfTrue => maxWidth; maxWidth-2)
+  maxW < 1 => [[x] for x in l] -- JHD 22.8.95, otherwise things can break
+  for x in tails l
+    while (width := oneOrZero + WIDTH first x + totalWidth) < maxW repeat
+      l:= x
+      totalWidth:= width
+  x:= rest l
+  RPLAC(rest l,nil)
+  [list,:splitConcat(x,maxWidth,nil)]
+
+spadPrint(x,m) ==
+  m = $NoValueMode => x
+  if ^$collectOutput then TERPRI $algebraOutputStream
+  output(x,m)
+  if ^$collectOutput then TERPRI $algebraOutputStream
+
+formulaFormat expr ==
+  sff := '(ScriptFormulaFormat)
+  formatFn := getFunctionFromDomain("coerce",sff,[$OutputForm])
+  displayFn := getFunctionFromDomain("display",sff,[sff])
+  SPADCALL(SPADCALL(expr,formatFn),displayFn)
+  if ^$collectOutput then
+    TERPRI $algebraOutputStream
+    FORCE_-OUTPUT $formulaOutputStream
+  NIL
+
+texFormat expr ==
+  tf := '(TexFormat)
+  formatFn := 
+    getFunctionFromDomain("convert",tf,[$OutputForm,$Integer])
+  displayFn := getFunctionFromDomain("display",tf,[tf])
+  SPADCALL(SPADCALL(expr,$IOindex,formatFn),displayFn)
+  TERPRI $texOutputStream
+  FORCE_-OUTPUT $texOutputStream
+  NIL
+
+texFormat1 expr ==
+  tf := '(TexFormat)
+  formatFn := getFunctionFromDomain("coerce",tf, [$OutputForm])
+  displayFn := getFunctionFromDomain("display",tf,[tf])
+  SPADCALL(SPADCALL(expr,formatFn),displayFn)
+  TERPRI $texOutputStream
+  FORCE_-OUTPUT $texOutputStream
+  NIL
+
+output(expr,domain) ==
+  if isWrapped expr then expr := unwrap expr
+  isMapExpr expr =>
+    if $formulaFormat then formulaFormat expr
+    if $texFormat     then texFormat expr
+    if $algebraFormat then mathprintWithNumber expr
+  categoryForm? domain or domain in '((Mode) (Domain) (SubDomain (Domain))) =>
+    if $algebraFormat then
+      mathprintWithNumber outputDomainConstructor expr
+    if $texFormat     then
+      texFormat outputDomainConstructor expr
+  T := coerceInteractive(objNewWrap(expr,domain),$OutputForm) =>
+    x := objValUnwrap T
+    if $formulaFormat then formulaFormat x
+    if $fortranFormat then
+      dispfortexp x
+      if ^$collectOutput then TERPRI $fortranOutputStream
+      FORCE_-OUTPUT $fortranOutputStream
+    if $algebraFormat then
+      mathprintWithNumber x
+    if $texFormat     then texFormat x
+  (FUNCTIONP(opOf domain)) and
+    (printfun := compiledLookup("<<",'(TextWriter TextWriter $), evalDomain domain))
+       and (textwrit := compiledLookup("print", '($), TextWriter())) =>
+     sayMSGNT [:bright '"AXIOM-XL",'"output:   "]
+     SPADCALL(SPADCALL textwrit, expr, printfun)
+     sayMSGNT '%l
+
+  -- big hack for tuples for new compiler
+  domain is ['Tuple, S] => output(asTupleAsList expr, ['List, S])
+
+  sayALGEBRA [:bright '"LISP",'"output:",'%l,expr or '"NIL"]
+
+outputNumber(start,linelength,num) ==
+  if start > 1 then blnks := fillerSpaces(start-1,'" ")
+  else blnks := '""
+  under:='"__"
+  firsttime:=(linelength>3)
+  if linelength>2 then
+     linelength:=linelength-1 
+  while SIZE(num) > linelength repeat
+    if $collectOutput then
+       $outputLines := [CONCAT(blnks, SUBSTRING(num,0,linelength),under),
+                        :$outputLines]
+    else
+      sayALGEBRA [blnks,
+                  SUBSTRING(num,0,linelength),under]
+    num := SUBSTRING(num,linelength,NIL)
+    if firsttime then 
+         blnks:=CONCAT(blnks,'" ")
+         linelength:=linelength-1
+         firsttime:=NIL
+  if $collectOutput then
+    $outputLines := [CONCAT(blnks, num), :$outputLines]
+  else
+    sayALGEBRA [blnks, num]
+
+outputString(start,linelength,str) ==
+  if start > 1 then blnks := fillerSpaces(start-1,'" ")
+  else blnks := '""
+  while SIZE(str) > linelength repeat
+    if $collectOutput then
+       $outputLines := [CONCAT(blnks, SUBSTRING(str,0,linelength)),
+                        :$outputLines]
+    else
+      sayALGEBRA [blnks, SUBSTRING(str,0,linelength)]
+    str := SUBSTRING(str,linelength,NIL)
+  if $collectOutput then
+    $outputLines := [CONCAT(blnks, str), :$outputLines]
+  else
+    sayALGEBRA [blnks, str]
+
+outputDomainConstructor form ==
+  if VECTORP CAR form then form := devaluate form
+  atom (u:= prefix2String form) => u
+  v:= [object2String(x) for x in u]
+  return INTERNL eval ['STRCONC,:v]
+
+getOutputAbbreviatedForm form ==
+  form is [op,:argl] =>
+    op in '(Union Record) => outputDomainConstructor form
+    op is "Mapping" => formatMapping argl
+    u:= constructor? op or op
+    null argl => u
+    ml:= getPartialConstructorModemapSig(op)
+    argl:= [fn for x in argl for m in ml] where fn ==
+      categoryForm?(m) => outputDomainConstructor x
+      x' := coerceInteractive(objNewWrap(x,m),$OutputForm)
+      x' => objValUnwrap x'
+      '"unprintableObject"
+    [u,:argl]
+  form
+
+outputOp x ==
+  x is [op,:args] and (GETL(op,"LED") or GETL(op,"NUD")) =>
+    n:=
+      GETL(op,"NARY") => 2
+      #args
+    newop:= INTERN STRCONC("*",STRINGIMAGE n,PNAME op)
+    [newop,:[outputOp y for y in args]]
+  x
+
+--% MAP PRINTER (FROM EV BOOT)
+
+printMap u ==
+  printBasic specialChar 'lbrk
+  initialFlag:= isInitialMap u
+  if u is [x,:l] then
+    printMap1(x,initialFlag and x is [[n],:.] and n=1)
+    for y in l repeat (printBasic " , "; printMap1(y,initialFlag))
+  printBasic specialChar 'rbrk
+  if ^$collectOutput then TERPRI $algebraOutputStream
+
+isInitialMap u ==
+  u is [[[n],.],:l] and INTEGERP n and
+    (and/[x is [[ =i],.] for x in l for i in n+1..])
+
+printMap1(x,initialFlag) ==
+  initialFlag => printBasic CADR x
+  if CDAR x then printBasic first x else printBasic CAAR x
+  printBasic " E "
+  printBasic CADR x
+
+printBasic x ==
+  x='(One) => PRIN1(1,$algebraOutputStream)
+  x='(Zero) => PRIN1(0,$algebraOutputStream)
+  IDENTP x => PRINTEXP(PNAME x,$algebraOutputStream)
+  atom x => PRIN1(x,$algebraOutputStream)
+  PRIN0(x,$algebraOutputStream)
+
+charybdis(u,start,linelength) ==
+  EQ(keyp u,'EQUATNUM) and ^(CDDR u) =>
+    charybdis(['PAREN,u.1],start,linelength)
+  charyTop(u,start,linelength)
+
+charyTop(u,start,linelength) ==
+  u is ['SC,:l] or u is [['SC,:.],:l] =>
+    for a in l repeat charyTop(a,start,linelength)
+    '" "
+  u is [['CONCATB,:.],:m,[['SC,:.],:l]] =>
+    charyTop(['CONCATB,:m],start,linelength)
+    charyTop(['SC,:l],start+2,linelength-2)
+  u is ['CENTER,a] =>
+    b := charyTopWidth a
+    (w := WIDTH(b)) > linelength-start => charyTop(a,start,linelength)
+    charyTop(b,(linelength-start-w)/2,linelength)
+  v := charyTopWidth u
+  EQ(keyp u,'ELSE) => charyElse(u,v,start,linelength)
+  WIDTH(v) > linelength => charyTrouble(u,v,start,linelength)
+  d := APP(v,start,0,nil)
+  n := superspan v
+  m := - subspan v
+-->
+  $testOutputLineFlag =>
+    $testOutputLineList :=
+      [:ASSOCRIGHT SORTBY('CAR,d),:$testOutputLineList]
+  until n < m repeat
+    scylla(n,d)
+    n := n - 1
+  '" "
+
+charyTopWidth u ==
+    atom u => u
+    atom first u => putWidth u
+    NUMBERP CDAR u => u
+    putWidth u
+
+charyTrouble(u,v,start,linelength) ==
+  al:= LargeMatrixp(u,linelength,2*linelength) =>
+    --$MatrixList =>
+      --[[m,:m1]] := al
+      --maPrin sublisMatAlist(m,m1,u)
+      --above three lines commented out JHD 25/2/93 since don't work
+    --u := SubstWhileDesizing(u,first first al)
+    u := SubstWhileDesizing(u,nil)
+    maprinChk u
+  charyTrouble1(u,v,start,linelength)
+
+sublisMatAlist(m,m1,u) ==
+  u is [op,:r] =>
+    op is ['MATRIX,:.] and u=m => m1
+    op1 := sublisMatAlist(m,m1,op)
+    r1 := [sublisMatAlist(m,m1,s) for s in r]
+    op = op1 and r1 = r => u
+    [op1,:r1]
+  u
+
+charyTrouble1(u,v,start,linelength) ==
+  NUMBERP u => outputNumber(start,linelength,atom2String u)
+  atom u => outputString(start,linelength,atom2String u)
+  EQ(x:= keyp u,'_-) => charyMinus(u,v,start,linelength)
+  MEMQ(x,'(_+ _* AGGLST)) => charySplit(u,v,start,linelength)
+  EQ(x,'EQUATNUM) => charyEquatnum(u,v,start,linelength)
+  d := GETL(x,'INFIXOP) => charyBinary(d,u,v,start,linelength)
+  x = 'OVER  =>
+    charyBinary(GETL("/",'INFIXOP),u,v,start,linelength)
+  EQ(3,LENGTH u) and GET(x,'Led) =>
+    d:= PNAME first GET(x,'Led)
+    charyBinary(d,u,v,start,linelength)
+  EQ(x,'CONCAT) =>
+    concatTrouble(rest v,d,start,linelength,nil)
+  EQ(x,'CONCATB) =>
+    (rest v) is [loop, 'repeat, body] =>
+      charyTop(['CONCATB,loop,'repeat],start,linelength)
+      charyTop(body,start+2,linelength-2)
+    (rest v) is [wu, loop, 'repeat, body] and
+      (keyp wu) is ['CONCATB,wu',.] and wu' in '(while until) =>
+        charyTop(['CONCATB,wu,loop,'repeat],start,linelength)
+        charyTop(body,start+2,linelength-2)
+    concatTrouble(rest v,d,start,linelength,true)
+  GETL(x,'INFIXOP) => charySplit(u,v,start,linelength)
+  EQ(x,'PAREN) and
+    (EQ(keyp u.1,'AGGLST) and (v:= ",") or EQ(keyp u.1,'AGGSET) and
+      (v:= ";")) => bracketagglist(rest u.1,start,linelength,v,"_(","_)")
+  EQ(x,'PAREN) and EQ(keyp u.1,'CONCATB) =>
+    bracketagglist(rest u.1,start,linelength," ","_(","_)")
+  EQ(x,'BRACKET) and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+    bracketagglist(rest u.1,start,linelength,v,
+                   specialChar 'lbrk, specialChar 'rbrk)
+  EQ(x,'BRACE) and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+    bracketagglist(rest u.1,start,linelength,v,
+                   specialChar 'lbrc, specialChar 'rbrc)
+  EQ(x,'EXT) => longext(u,start,linelength)
+  EQ(x,'MATRIX) => MATUNWND()
+  EQ(x,'ELSE) => charyElse(u,v,start,linelength)
+  EQ(x,'SC) => charySemiColon(u,v,start,linelength)
+  charybdis(x,start,linelength)
+  if rest u then charybdis(['ELSE,:rest u],start,linelength)
+  -- changed from charybdis(...) by JHD 2 Aug 89, since rest u might be null
+  '" "
+
+charySemiColon(u,v,start,linelength) ==
+  for a in rest u repeat
+    charyTop(a,start,linelength)
+  nil
+
+charyMinus(u,v,start,linelength) ==
+  charybdis('"-",start,linelength)
+  charybdis(v.1,start+3,linelength-3)
+  '" "
+
+charyBinary(d,u,v,start,linelength) ==
+  d in '(" := " "= ") =>
+    charybdis(['CONCATB,v.1,d],start,linelength)
+    charybdis(v.2,start+2,linelength-2)
+    '" "
+  charybdis(v.1,start+2,linelength-2)
+  if d then prnd(start,d)
+  charybdis(v.2,start+2,linelength-2)
+  '" "
+
+charyEquatnum(u,v,start,linelength) ==
+  charybdis(['PAREN,u.1],start,linelength)
+  charybdis(u.2,start,linelength)
+  '" "
+
+charySplit(u,v,start,linelength) ==
+  v:= [first v.0,:rest v]
+  m:= rest v
+  WIDTH v.1 > linelength-2 =>
+    charybdis(v.1,start+2,linelength-2)
+    ^(CDDR v) => '" "
+    dm:= CDDR v
+    ddm:= rest dm
+    split2(u,dm,ddm,start,linelength)
+  for i in 0.. repeat
+    dm := rest m
+    ddm := rest dm
+    RPLACD(dm,nil)
+    WIDTH v > linelength - 2 => return nil
+    RPLAC(first v, first v.0)
+    RPLACD(dm,ddm)
+    m := rest m
+  RPLAC(first v,first v.0)
+  RPLACD(m,nil)
+  charybdis(v,start + 2,linelength - 2)
+  split2(u,dm,ddm,start,linelength)
+
+split2(u,dm,ddm,start,linelength) ==
+--prnd(start,(d:= GETL(keyp u,'INFIXOP) => d; opSrch(keyp u,OPLIST)))
+  prnd(start,(d:= GETL(keyp u,'INFIXOP) => d; '","))
+  RPLACD(dm,ddm)
+  m:= WIDTH [keyp u,:dm]<linelength-2
+  charybdis([keyp u,:dm],(m => start+2; start),(m => linelength-2; linelength))
+  '" "
+
+charyElse(u,v,start,linelength) ==
+  charybdis(v.1,start+3,linelength-3)
+  ^(CDDR u) => '" "
+  prnd(start,'",")
+  charybdis(['ELSE,:CDDR v],start,linelength)
+  '" "
+
+scylla(n,v) ==
+  y := LASSOC(n,v)
+  null y => nil
+  if STRINGP(y) then y := DROPTRAILINGBLANKS COPY y
+  if $collectOutput then
+    $outputLines := [y, :$outputLines]
+  else
+    PRINTEXP(y,$algebraOutputStream)
+    TERPRI $algebraOutputStream
+  nil
+
+keyp(u) ==
+  atom u => nil
+  atom first u => first u
+  CAAR u
+
+absym x ==
+  (NUMBERP x) and (MINUSP x) => -x
+  ^(atom x) and (keyp(x) = '_-) => CADR x
+  x
+
+agg(n,u) ==
+  (n = 1) => CADR u
+  agg(n - 1, rest u)
+
+aggwidth u ==
+  null u => 0
+  null rest u => WIDTH first u
+  1 + (WIDTH first u) + (aggwidth rest u)
+
+argsapp(u,x,y,d) == appargs(rest u,x,y,d)
+
+subspan u ==
+  atom u => 0
+  NUMBERP rest u => subspan first u
+  (not atom first u             and_
+   atom CAAR u           and_
+   not NUMBERP CAAR u    and_
+   GETL(CAAR u, 'SUBSPAN)    )    =>
+   APPLX(GETL(CAAR u, 'SUBSPAN), LIST u)
+  MAX(subspan first u, subspan rest u)
+
+agggsub u == subspan rest u
+
+superspan u ==
+  atom u => 0
+  NUMBERP rest u => superspan first u
+  (not atom first u               and_
+   atom CAAR u             and_
+   not NUMBERP CAAR u      and_
+   GETL(CAAR u, 'SUPERSPAN)    )    =>
+   APPLX(GETL(CAAR u, 'SUPERSPAN), LIST u)
+  MAX(superspan first u, superspan rest u)
+
+agggsuper u == superspan rest u
+
+agggwidth u == aggwidth rest u
+
+appagg(u,x,y,d) == appagg1(u,x,y,d,'",")
+
+appagg1(u,x,y,d,s) ==
+  null u => d
+  null rest u => APP(first u,x,y,d)
+  temp := x + WIDTH first u
+  temparg1 := APP(first u,x,y,d)
+  temparg2 := APP(s,temp,y,temparg1)
+  appagg1(rest u, 1 + temp, y, temparg2,s)
+
+--Note the similarity between the definition below of appargs and above
+--of appagg. (why?)
+
+appargs(u,x,y,d) == appargs1(u,x,y,d,'";")
+
+--Note that the definition of appargs1 below is identical to that of
+--appagg1 above except that the former calls appargs and the latter
+--calls appagg.
+
+appargs1(u,x,y,d,s) ==
+  null u => d
+  null rest u => APP(first u,x,y,d)
+  temp := x + WIDTH first u
+  temparg1 := APP(first u,x,y,d)
+  temparg2 := APP(s,temp,y,temparg1)
+  true => appargs(rest u, 1 + temp, y, temparg2)
+
+apprpar(x, y, y1, y2, d) ==
+  (^(_*TALLPAR) or (y2 - y1 < 2)) => APP('")", x, y, d)
+  true => APP('")", x, y2, apprpar1(x, y, y1, y2 - 1, d))
+
+apprpar1(x, y, y1, y2, d) ==
+  (y1 = y2) => APP('")", x, y2, d)
+  true => APP('")", x, y2, apprpar1(x, y, y1, y2 - 1, d))
+
+applpar(x, y, y1, y2, d) ==
+  (^(_*TALLPAR) or (y2 - y1 < 2)) => APP('"(", x, y, d)
+  true => APP('"(", x, y2, applpar1(x, y, y1, y2 - 1, d))
+
+applpar1(x, y, y1, y2, d) ==
+  (y1 = y2) => APP('"(", x, y2, d)
+  true => APP('"(", x, y2, applpar1(x, y, y1, y2 - 1, d))
+
+--The body of the function appelse assigns 6 local variables.
+--It then finishes by calling apprpar.
+
+appelse(u,x,y,d) ==
+  w := WIDTH CAAR u
+  b := y - subspan rest u
+  p := y + superspan rest u
+  temparg1 := APP(keyp u, x, y, d)
+  temparg2 := applpar(x + w, y, b, p, temparg1)
+  temparg3 := appagg(rest u, x + 1 + w, y, temparg2)
+  apprpar(x + 1 + w + aggwidth rest u, y, b, p, temparg3)
+
+appext(u,x,y,d) ==
+  xptr := x
+  yptr := y - (subspan CADR u + superspan agg(3,u) + 1)
+  d := APP(CADR u,x,y,d)
+  d := APP(agg(2,u),xptr,yptr,d)
+  xptr := xptr + WIDTH agg(2,u)
+  d := APP('"=", xptr, yptr,d)
+  d := APP(agg(3,u), 1 + xptr, yptr, d)
+  yptr := y + 1 + superspan CADR u + SUBSPAD agg(4,u)
+  d := APP(agg(4,u), x, yptr, d)
+  temp := 1 + WIDTH agg(2,u) +  WIDTH agg(3,u)
+  n := MAX(WIDTH CADR u, WIDTH agg(4,u), temp)
+  if EQCAR(first(z := agg(5,u)), 'EXT) and
+   (EQ(n,3) or (n > 3 and ^(atom z)) ) then
+     n := 1 + n
+  d := APP(z, x + n, y, d)
+
+apphor(x1,x2,y,d,char) ==
+  temp := (x1 = x2 => d; apphor(x1, x2 - 1, y, d,char))
+  APP(char, x2, y, temp)
+
+syminusp x ==
+  NUMBERP x => MINUSP x
+  ^(atom x) and EQ(keyp x,'_-)
+
+appsum(u, x, y, d) ==
+  null u => d
+  ac := absym first u
+  sc :=
+    syminusp first u => '"-"
+    true => '"+"
+  dp := member(keyp absym first u, '(_+ _-))
+  tempx := x + WIDTH ac + (dp => 5; true => 3)
+  tempdblock :=
+    temparg1 := APP(sc, x + 1, y, d)
+    dp =>
+      bot := y - subspan ac
+      top := y + superspan ac
+      temparg2 := applpar(x + 3, y, bot, top, temparg1)
+      temparg3 := APP(ac, x + 4, y, temparg2)
+      apprpar(x + 4 + WIDTH ac, y, bot, top, temparg3)
+    true => APP(ac, x + 3, y, temparg1)
+  appsum(rest u, tempx, y, tempdblock)
+
+appneg(u, x, y, d) ==
+  appsum(LIST u, x - 1, y, d)
+
+appparu(u, x, y, d) ==
+  bot := y - subspan u
+  top := y + superspan u
+  temparg1 := applpar(x, y, bot, top, d)
+  temparg2 := APP(u, x + 1, y, temparg1)
+  apprpar(x + 1 + WIDTH u, y, bot, top, temparg2)
+
+appparu1(u, x, y, d) ==
+  appparu(CADR u, x, y, d)
+
+appsc(u, x, y, d) ==
+  appagg1(rest u, x, y, d, '";")
+
+appsetq(u, x, y, d) ==
+  w := WIDTH first u
+  temparg1 := APP(CADR u, x, y, d)
+  temparg2 := APP('":", x + w, y, temparg1)
+  APP(CADR rest u, x + 2 + w, y, temparg2)
+
+appsub(u, x, y, d) ==
+  temparg1 := x + WIDTH CADR u
+  temparg2 := y - 1 - superspan CDDR u
+  temparg3 := APP(CADR u, x, y, d)
+  appagg(CDDR u, temparg1, temparg2, temparg3)
+
+starstarcond(l, iforwhen) ==
+    null l => l
+    EQ((a := CAAR l), 1) =>
+       LIST('CONCAT, CADR first l, '" OTHERWISE")
+    EQCAR(a, 'COMPARG) =>
+      starstarcond(CONS(transcomparg(CADR a),  rest l), iforwhen)
+    null rest l =>
+      LIST('CONCAT, CADR first l,
+           LIST('CONCAT, iforwhen, CAAR l))
+    true => LIST('VCONCAT,
+                 starstarcond(CONS(first l, nil), iforwhen),
+                 LIST('VCONCAT, '"  ",
+                      starstarcond(rest l, iforwhen)))
+
+eq0(u) == 0
+
+height(u) ==
+  superspan(u) + 1 + subspan(u)
+
+extsub(u) ==
+  MAX(subspan agg(5, u), height(agg(3, u)), subspan CADR u  )
+
+extsuper(u) ==
+  MAX(superspan CADR u + height agg(4, u), superspan agg(5, u) )
+
+extwidth(u) ==
+  n := MAX(WIDTH CADR u,
+           WIDTH agg(4, u),
+           1 + WIDTH agg(2, u) + WIDTH agg(3, u) )
+  nil or
+         (EQCAR(first(z := agg(5, u)), 'EXT) and _
+          (EQ(n, 3) or ((n > 3) and null atom z) )  =>
+          n := 1 + n)
+  true => n + WIDTH agg(5, u)
+
+appfrac(u, x, y, d) ==
+  -- Added "1+" to both QUOTIENT statements so that when exact centering is
+  -- not possible, expressions are offset to the right rather than left.
+  -- MCD 16-8-95
+  w := WIDTH u
+  tempx := x + QUOTIENT(1+w - WIDTH CADR rest u, 2)
+  tempy := y - superspan CADR rest u - 1
+  temparg3 := APP(CADR rest u, tempx, tempy, d)
+  temparg4 := apphor(x, x + w - 1, y, temparg3,specialChar('hbar))
+  APP(CADR u,
+        x + QUOTIENT(1+w - WIDTH CADR u, 2),
+          y + 1 + subspan CADR u,
+            temparg4)
+
+fracsub(u) == height CADR rest u
+
+fracsuper(u) == height CADR u
+
+fracwidth(u) ==
+  numw := WIDTH (num := CADR u)
+  denw := WIDTH (den := CADDR u)
+  if num is [[op,:.],:.] and op = 'OVER then numw := numw + 2
+  if den is [[op,:.],:.] and op = 'OVER then denw := denw + 2
+  MAX(numw,denw)
+
+slashSub u ==
+  MAX(1,subspan(CADR u),subspan(CADR rest u))
+
+slashSuper u ==
+  MAX(1,superspan(CADR u),superspan(CADR rest u))
+
+slashApp(u, x, y, d) ==
+  -- to print things as a/b as opposed to
+  --      a
+  --      -
+  --      b
+  temparg1 := APP(CADR u, x, y, d)
+  temparg2 := APP('"/", x + WIDTH CADR u, y, temparg1)
+  APP(CADR rest u,
+     x + 1 + WIDTH CADR u, y, temparg2)
+
+slashWidth(u) ==
+  -- to print things as a/b as opposed to
+  --      a
+  --      -
+  --      b
+  1 + WIDTH CADR u + WIDTH CADR rest u
+
+longext(u, i, n) ==
+  x := REVERSE u
+  y := first x
+  u := remWidth(REVERSEWOC(CONS('" ", rest x)))
+  charybdis(u, i, n)
+  if ^$collectOutput then TERPRI $algebraOutputStream
+  charybdis(CONS('ELSE, LIST y), i, n)
+  '" "
+
+appvertline(char, x, yl, yu, d) ==
+  yu < yl => d
+  temparg :=  appvertline(char, x, yl, yu - 1, d)
+  true => APP(char, x, yu, temparg)
+
+appHorizLine(xl, xu, y, d) ==
+  xu < xl => d
+  temparg :=  appHorizLine(xl, xu - 1, y, d)
+  true => APP(MATBORCH, xu, y, temparg)
+
+rootApp(u, x, y, d) ==
+  widB := WIDTH u.1
+  supB := superspan u.1
+  subB := subspan u.1
+  if #u > 2 then
+    widR := WIDTH u.2
+    subR := subspan u.2
+    d    := APP(u.2,  x, y - subB + 1 + subR, d)
+  else
+    widR := 1
+  d := APP(u.1, x + widR + 1, y, d)
+  d := apphor(x+widR+1, x+widR+widB, y+supB+1, d, specialChar('hbar))
+  d := appvertline(specialChar('vbar), x+widR, y - subB, y + supB, d)
+  d := APP(specialChar('ulc), x+widR, y + supB+1, d)
+  d := APP(specialChar('urc), x + widR + widB + 1, y + supB+1, d)
+  d := APP(specialChar('bslash), x + widR - 1, y - subB, d)
+
+boxApp(u, x, y, d) ==
+  CDDR u => boxLApp(u, x, y, d)
+  a := 1 + superspan u.1
+  b := 1 + subspan u.1
+  w := 2 + WIDTH u.1
+  d := appvertline(specialChar('vbar), x,y - b + 1, y + a - 1, d)
+  d := appvertline(specialChar('vbar), x + w + 1, y - b,y + a,d)
+  d := apphor(x + 1, x + w, y - b, d, specialChar('hbar))
+  d := apphor(x + 1, x + w, y + a, d, specialChar('hbar))
+  d := APP(specialChar('ulc), x,         y + a, d)
+  d := APP(specialChar('urc), x + w + 1, y + a, d)
+  d := APP(specialChar('llc), x,         y - b, d)
+  d := APP(specialChar('lrc), x + w + 1, y - b, d)
+  d := APP(u.1, 2 + x, y, d)
+
+boxLApp(u, x, y, d) ==
+  la := superspan u.2
+  lb := subspan u.2
+  lw := 2 + WIDTH u.2
+  lh := 2 + la + lb
+  a := superspan u.1+1
+  b := subspan u.1+1
+  w := MAX(lw, 2 + WIDTH u.1)
+  -- next line used to have h instead of lh
+  top := y + a + lh
+  d := appvertline(MATBORCH, x, y - b, top, d)
+  d := appHorizLine(x + 1, x + w, top, d)
+  d := APP(u.2, 2 + x, y + a + lb + 1, d)
+  d := appHorizLine(x + 1, x + lw, y + a, d)
+  nil or
+     lw < w => d := appvertline(MATBORCH, x + lw + 1, y + a, top - 1, d)
+  d := APP(u.1, 2 + x, y, d)
+  d := appHorizLine(x + 1, x + w, y - b, top, d)
+  d := appvertline(MATBORCH, x + w + 1, y - b, top, d)
+
+boxSub(x) ==
+  subspan x.1+1
+
+boxSuper(x) ==
+  null CDR x => 0
+  hl :=
+    null CDDR x => 0
+    true => 2 + subspan x.2 + superspan x.2
+  true => hl+1 + superspan x.1
+
+boxWidth(x) ==
+  null CDR x => 0
+  wl :=
+    null CDDR x => 0
+    true => WIDTH x.2
+  true => 4 + MAX(wl, WIDTH x.1)
+
+nothingWidth x ==
+    0
+nothingSuper x ==
+    0
+nothingSub x ==
+    0
+nothingApp(u, x, y, d) ==
+    d
+
+zagApp(u, x, y, d) ==
+    w := WIDTH u
+    denx := x + QUOTIENT(w - WIDTH CADR rest u, 2)
+    deny := y - superspan CADR rest u - 1
+    d    := APP(CADR rest u, denx, deny, d)
+    numx := x + QUOTIENT(w - WIDTH CADR u, 2)
+    numy := y+1 + subspan CADR u
+    d    := APP(CADR u, numx, numy, d)
+    a := 1 + zagSuper u
+    b := 1 + zagSub u
+    d := appvertline(specialChar('vbar), x,         y - b, y - 1, d)
+    d := appvertline(specialChar('vbar), x + w - 1, y + 1, y + a, d)
+    d := apphor(x, x + w - 2, y, d, specialChar('hbar))
+    d := APP(specialChar('ulc), x, y, d)
+    d := APP(specialChar('lrc), x + w - 1, y, d)
+
+zagSub(u) ==
+    height CADR rest u
+
+zagSuper(u) ==
+    height CADR u
+
+zagWidth(x) ==
+   #x = 1 => 0
+   #x = 2 => 4 + WIDTH x.1
+   4 + MAX(WIDTH x.1, WIDTH x.2)
+
+rootWidth(x) ==
+   #x <= 2 => 3 + WIDTH x.1
+   2 + WIDTH x.1 + WIDTH x.2
+
+rootSub(x) ==
+   subspan x.1
+
+rootSuper(x) ==
+   normal := 1 + superspan x.1
+   #x <= 2 => normal
+   (radOver := height x.2 - height x.1) < 0 => normal
+   normal + radOver
+
+appmat(u, x, y, d) ==
+   rows := CDDR u
+   p := matSuper u
+   q := matSub u
+   d := matrixBorder(x, y - q, y + p, d, 'left)
+   x := 1 + x
+   yc := 1 + y + p
+   w := CADR u
+   wl := CDAR w
+   subl := rest CADR w
+   superl := rest CADR rest w
+   repeat
+      null rows => return(matrixBorder(x + WIDTH u - 2,
+                                       y - q,
+                                       y + p,
+                                       d,
+                                       'right))
+      xc := x
+      yc := yc - 1 - first superl
+      w := wl
+      row := CDAR rows
+      repeat
+            if flag = '"ON" then
+               flag := '"OFF"
+               return(nil)
+            null row =>
+                  repeat
+                     yc := yc - 1 - first subl
+                     subl := rest subl
+                     superl := rest superl
+                     rows := rest rows
+                     return(flag  := '"ON"; nil)
+            d := APP(first row,
+                     xc + QUOTIENT(first w - WIDTH first row, 2),
+                     yc,
+                     d)
+            xc := xc + 2 + first w
+            row := rest row
+            w := rest w
+
+matSuper(x) ==
+  (x := x.1) => -1 + QUOTIENT(first x.1 + first x.2, 2)
+  true => ERROR('MAT)
+
+matSub(x) ==
+  (x := x.1) => QUOTIENT(-1 + first x.1 + first x.2, 2)
+  true => ERROR('MAT)
+
+matWidth(x) ==
+  y := CDDR x  -- list of rows, each of form ((ROW . w) element element ...)
+  numOfColumns := LENGTH CDAR y
+  widthList := matLSum2 matWList(y, NLIST(numOfColumns, 0))
+    --returns ["max width of entries in column i" for i in 1..numberOfRows]
+  subspanList := matLSum matSubList y
+  superspanList := matLSum matSuperList y
+  RPLAC(x.1,[widthList, subspanList, superspanList])
+  CAAR x.1
+
+matLSum(x) ==
+  CONS(sumoverlist x + LENGTH x, x)
+
+matLSum2(x) ==
+  CONS(sumoverlist x + 2*(LENGTH x), x)
+
+matWList(x, y) ==
+  null x => y
+  true => matWList(rest x, matWList1(CDAR x, y) )
+
+matWList1(x, y) ==
+  null x => nil
+  true => CONS(MAX(WIDTH first x, first y), matWList1(rest x, rest y) )
+
+matSubList(x) ==  --computes the max/[subspan(e) for e in "row named x"]
+  null x => nil
+  true => CONS(matSubList1(CDAR x, 0), matSubList(rest x) )
+
+matSubList1(x, y) ==
+  null x => y
+  true => matSubList1(rest x, MAX(y, subspan first x) )
+
+matSuperList(x) ==  --computes the max/[superspan(e) for e in "row named x"]
+  null x => nil
+  true => CONS(matSuperList1(CDAR x, 0), matSuperList(rest x) )
+
+matSuperList1(x, y) ==
+  null x => y
+  true => matSuperList1(rest x, MAX(y, superspan first x) )
+
+minusWidth(u) ==
+  -1 + sumWidthA rest u
+
+-- opSrch(name, x) ==
+--   LASSOC(name, x) or '","
+
+bracketagglist(u, start, linelength, tchr, open, close) ==
+  u := CONS(LIST('CONCAT, open, first u),
+            [LIST('CONCAT, '" ", y) for y in rest u] )
+  repeat
+    s := 0
+    for x in tails u repeat
+             lastx := x
+             ((s := s + WIDTH first x + 1) >= linelength) => return(s)
+             null rest x => return(s := -1)
+    nil or
+       EQ(s, -1) => (nextu := nil)
+       EQ(lastx, u) => ((nextu := rest u); RPLACD(u, nil) )
+       true => ((nextu := lastx); RPLACD(PREDECESSOR(lastx, u), nil))
+    for x in tails u repeat
+           RPLACA(x, LIST('CONCAT, first x, tchr))
+    if null nextu then RPLACA(CDDR LAST u, close)
+    x := ASSOCIATER('CONCAT, CONS(ichr, u))
+    charybdis(ASSOCIATER('CONCAT, u), start, linelength)
+    if $collectOutput then TERPRI $algebraOutputStream
+    ichr := '" "
+    u := nextu
+    null u => return(nil)
+
+prnd(start, op) ==
+-->
+  $testOutputLineFlag =>
+    string := STRCONC(fillerSpaces MAX(0,start - 1),op)
+    $testOutputLineList := [string,:$testOutputLineList]
+  PRINTEXP(fillerSpaces MAX(0,start - 1),$algebraOutputStream)
+  $collectOutput =>
+    string := STRCONC(fillerSpaces MAX(0,start - 1),op)
+    $outputLines := [string, :$outputLines]
+  PRINTEXP(op,$algebraOutputStream)
+  TERPRI $algebraOutputStream
+
+qTSub(u) ==
+  subspan CADR u
+
+qTSuper(u) ==
+  superspan CADR u
+
+qTWidth(u) ==
+  2 + WIDTH CADR u
+
+remWidth(x) ==
+  atom x => x
+  true => CONS( (atom first x => first x; true => CAAR x),
+                MMAPCAR(remWidth, rest x) )
+
+subSub(u) ==
+  height CDDR u
+
+subSuper u ==
+  superspan u.1
+
+letWidth u ==
+  5 + WIDTH u.1 + WIDTH u.2
+
+sumoverlist(u) == +/[x for x in u]
+
+sumWidth u ==
+  WIDTH u.1 + sumWidthA CDDR u
+
+sumWidthA u ==
+  ^u => 0
+  ( member(keyp absym first u,'(_+ _-)) => 5; true => 3) +
+    WIDTH absym first u +
+      sumWidthA rest u
+
+superSubApp(u, x, y, di) ==
+  a := first (u := rest u)
+  b := first (u := rest u)
+  c := first (u := KDR u) or '((NOTHING . 0))
+  d := KAR   (u := KDR u) or '((NOTHING . 0))
+  e := KADR  u            or '((NOTHING . 0))
+  aox := MAX(wd := WIDTH d, we := WIDTH e)
+  ar := superspan a
+  ab := subspan a
+  aw := WIDTH a
+  di := APP(d, x + (aox - wd), 1 + ar + y + subspan d, di)
+  di := APP(a, x + aox, y, di)
+  di := APP(c, aox + aw + x, 1 + y + ar + subspan c, di)
+  di := APP(e, x + (aox - we), y - 1 - MAX(superspan e, ab), di)
+  di := APP(b, aox + aw + x, y - 1 - MAX(ab, superspan b), di)
+  return di
+
+stringer x ==
+  STRINGP x => x
+  EQ('_|, FETCHCHAR(s:= STRINGIMAGE x, 0)) =>
+    RPLACSTR(s, 0, 1, "", nil, nil)
+  s
+
+superSubSub u ==
+  a:= first (u:= rest u)
+  b:= KAR (u := KDR u)
+  e:= KAR KDR KDR KDR u
+  return subspan a + MAX(height b, height e)
+
+binomApp(u,x,y,d) ==
+  [num,den] := rest u
+  ysub := y - 1 - superspan den
+  ysup := y + 1 + subspan num
+  wden := WIDTH den
+  wnum := WIDTH num
+  w := MAX(wden,wnum)
+  d := APP(den,x+1+(w - wden)/2,ysub,d)
+  d := APP(num,x+1+(w - wnum)/2,ysup,d)
+  hnum := height num
+  hden := height den
+  w := 1 + w
+  for j in 0..(hnum - 1) repeat
+    d := appChar(specialChar 'vbar,x,y + j,d)
+    d := appChar(specialChar 'vbar,x + w,y + j,d)
+  for j in 1..(hden - 1) repeat
+    d := appChar(specialChar 'vbar,x,y - j,d)
+    d := appChar(specialChar 'vbar,x + w,y - j,d)
+  d := appChar(specialChar 'ulc,x,y + hnum,d)
+  d := appChar(specialChar 'urc,x + w,y + hnum,d)
+  d := appChar(specialChar 'llc,x,y - hden,d)
+  d := appChar(specialChar 'lrc,x + w,y - hden,d)
+
+binomSub u == height CADDR u
+binomSuper u == height CADR u
+binomWidth u == 2 + MAX(WIDTH CADR u, WIDTH CADDR u)
+
+altSuperSubApp(u, x, y, di) ==
+  a  := first (u := rest u)
+  ar := superspan a
+  ab := subspan a
+  aw := WIDTH a
+  di := APP(a, x, y, di)
+  x  := x + aw
+
+  sublist := everyNth(u := rest u, 2)
+  suplist := everyNth(IFCDR u, 2)
+
+  ysub := y - 1 - APPLY('MAX, [ab, :[superspan s for s in sublist]])
+  ysup := y + 1 + APPLY('MAX, [ar, :[subspan   s for s in sublist]])
+  for sub in sublist for sup in suplist repeat
+      wsub := WIDTH sub
+      wsup := WIDTH sup
+      di := APP(sub, x, ysub, di)
+      di := APP(sup, x, ysup, di)
+      x := x + 1 + MAX(wsub, wsup)
+  di
+
+everyNth(l, n) ==
+    [(e := l.0; for i in 1..n while l repeat l := rest l; e) while l]
+
+
+altSuperSubSub u ==
+  span := subspan CADR u
+  sublist := everyNth(CDDR u, 2)
+  for sub in sublist repeat
+      h := height sub
+      if h > span then span := h
+  span
+
+altSuperSubSuper u ==
+  span := superspan CADR u
+  suplist := everyNth(IFCDR CDDR u, 2)
+  for sup in suplist repeat
+      h := height sup
+      if h > span then span := h
+  span
+
+altSuperSubWidth u ==
+  w := WIDTH CADR u
+  suplist := everyNth(IFCDR CDDR u, 2)
+  sublist := everyNth(CDDR u, 2)
+  for sup in suplist for sub in sublist repeat
+      wsup := WIDTH sup
+      wsub := WIDTH sub
+      w := w + 1 + MAX(wsup, wsub)
+  w
+
+superSubWidth u ==
+  a := first (u := rest u)
+  b := first (u := rest u)
+  c := first (u := KDR u) or '((NOTHING . 0))
+  d := KAR   (u := KDR u) or '((NOTHING . 0))
+  e := KADR  u            or '((NOTHING . 0))
+  return MAX(WIDTH d, WIDTH e) + MAX(WIDTH b, WIDTH c) + WIDTH a
+
+superSubSuper u ==
+  a:= first (u := rest u)
+  c:= KAR (u := KDR KDR u)
+  d:= KADR u
+  return superspan a + MAX(height c, height d)
+
+suScWidth u ==
+  WIDTH u.1 + aggwidth CDDR u
+
+transcomparg(x) ==
+  y := first x
+  args := first _*NTH(STANDARGLIST, 1 + LENGTH y)
+  repeat
+    if true then
+       null y => return(nil)
+       (atom first y) and member(first y, FRLIS_*) =>
+            conds := CONS(LIST('EQUAL1, first args, first y), conds)
+            y := SUBST(first args, first y, y)
+            x := SUBST(first args, first y, x)
+       (first y = first args) => nil
+       true => conds := CONS(LIST('EQUAL1, first args, first y), conds)
+    y := rest y
+    args := rest args
+  conds :=
+       null conds => rest CADR x
+       ANDSIMP(CONS('AND, APPEND(REVERSEWOC conds,
+                                         LIST(rest CADR x) ) ) )
+  LIST((conds => conds; true => 1), CADR rest x)
+
+vconcatapp(u, x, y, d) ==
+  w := vConcatWidth u
+  y := y + superspan u.1 + 1
+  for a in rest u repeat
+      y := y - superspan a - 1
+      xoff := QUOTIENT(w - WIDTH a, 2)
+      d := APP(a, x + xoff, y, d)
+      y := y - subspan a
+  d
+
+binomialApp(u, x, y, d) ==
+  [.,b,a] := u
+  w := vConcatWidth u
+  d := APP('"(",x,y,d)
+  x := x + 1
+  y1 := y - height a
+  xoff := QUOTIENT(w - WIDTH a, 2)
+  d := APP(a, x + xoff, y1, d)
+  y2 := y + height b
+  xoff := QUOTIENT(w - WIDTH b, 2)
+  d := APP(b, x + xoff, y2, d)
+  x := x + w
+  APP('")",x,y,d)
+
+vConcatSub u ==
+  subspan u.1 + +/[height a for a in CDDR u]
+vConcatSuper u ==
+  superspan u.1
+vConcatWidth u ==
+  w := 0
+  for a in rest u repeat if (wa := WIDTH a) > w then w := wa
+  w
+binomialSub u ==  height u.2 + 1
+
+binomialSuper u == height u.1 + 1
+
+binomialWidth u == 2 + MAX(WIDTH u.1, WIDTH u.2)
+
+mathPrint u ==
+  if ^$collectOutput then TERPRI $algebraOutputStream
+  (u := STRINGP mathPrint1(mathPrintTran u, nil) =>
+   PSTRING u; nil)
+
+mathPrintTran u ==
+  atom u => u
+  true =>
+    for x in tails u repeat
+          RPLAC(first x, mathPrintTran first x)
+    u
+
+mathPrint1(x,fg) ==
+  if fg and ^$collectOutput then TERPRI $algebraOutputStream
+  maPrin x
+  if fg and ^$collectOutput then TERPRI $algebraOutputStream
+
+maPrin u ==
+  null u => nil
+-->
+  if $runTestFlag or $mkTestFlag then
+    $mkTestOutputStack := [COPY u, :$mkTestOutputStack]
+  $highlightDelta := 0
+  c := CATCH('outputFailure,charybdis(u, $MARGIN, $LINELENGTH))
+  c ^= 'outputFailure => c
+  sayKeyedMsg("S2IX0009",NIL)
+  u is ['EQUATNUM,num,form] or u is [['EQUATNUM,:.],num,form] =>
+    charybdis(['EQUATNUM,num], $MARGIN, $LINELENGTH)
+    if ^$collectOutput then
+      TERPRI $algebraOutputStream
+      PRETTYPRINT(form,$algebraOutputStream)
+    form
+  if ^$collectOutput then PRETTYPRINT(u,$algebraOutputStream)
+  nil
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-resolv.boot.pamphlet b/src/interp/i-resolv.boot.pamphlet
new file mode 100644
index 00000000..fd46a0e6
--- /dev/null
+++ b/src/interp/i-resolv.boot.pamphlet
@@ -0,0 +1,860 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-resolv.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+new resolution: types and modes
+
+a type is any term (structure) which can be regarded as a
+  functor call
+a basic type is the call of a nullary functor (e.g. (Integer)),
+  otherwise it is a structured type (e.g. (Polynomial (Integer)))
+a functor together with its non-type arguments is called a
+  type constructor
+
+a mode is a type which can be partially specified, i.e. a term
+  containing term variables
+a term variable (denoted by control-L) stands for any nullary or unary function
+  which was build from type constructors
+this means, a term variable can be:
+  a function LAMBDA ().T, where T is a type
+  a function LAMBDA (X).T(X), where X is a variable for a type and
+    T a type containing this variable
+  a function LAMBDA X.X ("control-L can be disregarded")
+examples:
+  P(control-L) can stand for (Polynomial (RationalFunction (Integer)))
+  G(control-L(I)) can stand for (Gaussian (Polynomial (Integer))), but also
+    for (Gaussian (Integer))
+
+
+Resolution of Two Types
+
+this symmetric resolution is done the following way:
+1. if the same type constructor occurs in both terms, then the
+   type tower is built around this constructor (resolveTTEq)
+2. the next step is to look for two constructors which have an
+   "algebraic relationship", this means, a rewrite rule is
+   applicable (e.g. UP(x,I) and MP([x,y],I))
+   this is done by resolveTTRed
+3. if none of this is true, then a tower of types is built
+   e.g. resolve P I and G I to P G I
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+resolveTypeList u ==
+  u is [a,:tail] =>
+
+    -- if the list consists entirely of variables then keep it explicit
+    allVars :=
+      a is ['Variable,v] => [v]
+      nil
+    while allVars for b in tail repeat
+        allVars :=
+            b is ['Variable,v] => insert(v, allVars)
+            nil
+    allVars =>
+        null rest allVars => ['Variable, first allVars]
+        ['OrderedVariableList,nreverse allVars]
+
+    for md in tail repeat
+      a := resolveTT(md,a)
+      null a => return nil
+    a
+  throwKeyedMsg("S2IR0002",NIL)
+
+-- resolveTT is in CLAMMED BOOT
+
+resolveTypeListAny tl ==
+  rt := resolveTypeList tl
+  null rt => $Any
+  rt
+
+resolveTTAny(t1,t2) ==
+  (t3 := resolveTT(t1, t2)) => t3
+  $Any
+
+resolveTT1(t1,t2) ==
+  -- this is the main symmetric resolve
+  -- first it looks for equal constructors on both sides
+  -- then it tries to use a rewrite rule
+  -- and finally it builds up a tower
+  t1=t2 => t1
+  (t1 = '$NoValueMode) or (t2 = '$NoValueMode) => NIL
+  (t1 = $Void) or (t2 = $Void) => $Void
+  (t1 = $Any) or (t2 = $Any) => $Any
+  t1 = '(Exit) => t2
+  t2 = '(Exit) => t1
+  t1 is ['Union,:.] => resolveTTUnion(t1,t2)
+  t2 is ['Union,:.] => resolveTTUnion(t2,t1)
+  STRINGP(t1) =>
+    t2 = $String => t2
+    NIL
+  STRINGP(t2) =>
+    t1 = $String => t1
+    NIL
+  null acceptableTypesToResolve(t1,t2) => NIL
+  if compareTT(t1,t2) then
+     t := t1
+     t1 := t2
+     t2 := t
+  (t := resolveTTSpecial(t1,t2)) and isValidType t => t
+  (t := resolveTTSpecial(t2,t1)) and isValidType t => t
+  isSubTowerOf(t1,t2) and canCoerceFrom(t1,t2) => t2
+  isSubTowerOf(t2,t1) and canCoerceFrom(t2,t1) => t1
+  t := resolveTTRed(t1,t2) => t
+  t := resolveTTCC(t1,t2) => t
+  (t := resolveTTEq(t1,t2)) and isValidType t => t
+  [c1,:arg1] := deconstructT t1
+  arg1 and
+    [c2,:arg2] := deconstructT t2
+    arg2 and
+      t := resolveTT1(last arg1,last arg2)
+      t and ( resolveTT2(c1,c2,arg1,arg2,t) or
+        resolveTT2(c2,c1,arg2,arg1,t) )
+
+acceptableTypesToResolve(t1,t2) ==
+  -- this is temporary. It ensures that two types that have coerces
+  -- that really should be converts don't automatically resolve.
+  -- when the coerces go away, so will this.
+  acceptableTypesToResolve1(t1,t2) and
+    acceptableTypesToResolve1(t2,t1)
+
+acceptableTypesToResolve1(t1,t2) ==
+  t1 = $Integer =>
+    t2 = $String => NIL
+    true
+  t1 = $DoubleFloat or t1 = $Float =>
+    t2 = $String => NIL
+    t2 = '(RationalNumber) => NIL
+    t2 = [$QuotientField, $Integer] => NIL
+    true
+  true
+
+resolveTT2(c1,c2,arg1,arg2,t) ==
+  -- builds a tower and tests for all the necessary coercions
+  t0 := constructM(c2,replaceLast(arg2,t))
+  canCoerceFrom(t,t0) and
+    t1 := constructM(c1,replaceLast(arg1,t0))
+    canCoerceFrom(t0,t1) and t1
+
+resolveTTUnion(t1 is ['Union,:doms],t2) ==
+  unionDoms1 :=
+    doms and first doms is [":",:.] =>
+      tagged := true
+      [t for [.,.,t] in doms]
+    tagged := false
+    doms
+  member(t2,unionDoms1) => t1
+  tagged => NIL
+  t2 isnt ['Union,:doms2] =>
+    ud := nil
+    bad := nil
+    for d in doms while ^bad repeat
+      d = '"failed" => ud := [d,:ud]
+      null (d' := resolveTT(d,t2)) => bad := true
+      ud := [d',:ud]
+    bad => NIL
+    ['Union,:REMDUP reverse ud]
+  ud := nil
+  bad := nil
+  for d in doms2 while ^bad repeat
+    d = '"failed" => ud := append(ud,[d])
+    null (d' := resolveTTUnion(t1,d)) => bad := true
+    ud := append(ud,CDR d')
+  bad => NIL
+  ['Union,:REMDUP ud]
+
+resolveTTSpecial(t1,t2) ==
+  -- tries to resolve things that would otherwise get mangled in the
+  -- rest of the resolve world. I'll leave it for Albi to fix those
+  -- things. (RSS 1/-86)
+
+  -- following is just an efficiency hack
+  (t1 = '(Symbol) or t1 is ['OrderedVariableList,.]) and PAIRP(t2) and
+    CAR(t2) in '(Polynomial RationalFunction) => t2
+
+  (t1 = '(Symbol)) and ofCategory(t2, '(IntegerNumberSystem)) =>
+    resolveTT1(['Polynomial, t2], t2)
+
+  t1 = '(AlgebraicNumber) and (t2 = $Float or t2 = $DoubleFloat) =>
+    ['Expression, t2]
+  t1 = '(AlgebraicNumber) and (t2 = ['Complex, $Float] or t2 = ['Complex, $DoubleFloat]) =>
+    ['Expression, CADR t2]
+
+  t1 = '(AlgebraicNumber) and t2 is ['Complex,.] =>
+    resolveTT1('(Expression (Integer)), t2)
+
+  t1 is ['SimpleAlgebraicExtension,F,Rep,poly] =>
+    t2 = Rep => t1
+    t2 is ['UnivariatePolynomial,x,R] and (t3 := resolveTT(t1, R)) =>
+      ['UnivariatePolynomial,x,t3]
+    t2 is ['Variable,x] and (t3 := resolveTT(t1, F)) =>
+      ['UnivariatePolynomial,x,t3]
+    t2 is ['Polynomial,R] and (R' := resolveTT(Rep, t2)) =>
+      R' = Rep => t1
+      ['Polynomial,t1]
+    canCoerceFrom(t2,F) => t1
+    nil
+  t1 = $PositiveInteger and ofCategory(t2,'(Ring)) =>
+    resolveTT1($Integer,t2)
+  t1 = $NonNegativeInteger and ofCategory(t2,'(Ring)) =>
+    resolveTT1($Integer,t2)
+  t1 is ['OrderedVariableList,[x]] => resolveTTSpecial(['Variable, x], t2)
+  t1 is ['OrderedVariableList,vl] =>
+    ofCategory(t2,'(Ring)) => resolveTT(['Polynomial,'(Integer)],t2)
+    resolveTT($Symbol,t2)
+  t1 is ['Variable,x] =>
+    EQCAR(t2,'SimpleAlgebraicExtension) => resolveTTSpecial(t2,t1)
+    t2 is ['UnivariatePolynomial,y,S] =>
+      x = y => t2
+      resolveTT1(['UnivariatePolynomial,x,'(Integer)],t2)
+    t2 is ['Variable,y] =>
+      x = y => t1
+--    ['OrderedVariableList, MSORT [x,y]]
+      $Symbol
+    t2 = '(Symbol) => t2
+    t2 is ['Polynomial,.] => t2
+    t2 is ['OrderedVariableList, vl] and member(x,vl) => t2
+    isPolynomialMode t2 => nil
+    ofCategory(t2, '(IntegerNumberSystem)) => resolveTT(['Polynomial, t2], t2)
+    resolveTT(['Polynomial,'(Integer)],t2)
+  t1 is ['FunctionCalled,f] and t2 is ['FunctionCalled,g] =>
+    null (mf := get(f,'mode,$e)) => NIL
+    null (mg := get(g,'mode,$e)) => NIL
+    mf ^= mg => NIL
+    mf
+  t1 is ['UnivariatePolynomial,x,S] =>
+    EQCAR(t2,'Variable) =>
+      resolveTTSpecial(t2,t1)
+    EQCAR(t2,'SimpleAlgebraicExtension) =>
+      resolveTTSpecial(t2,t1)
+    t2 is ['UnivariatePolynomial,y,T] =>
+      (x = y) and (U := resolveTT1(S,T)) and ['UnivariatePolynomial,x,U]
+    nil
+  t1 = '(Pi) =>
+    t2 is ['Complex,d] => defaultTargetFE t2
+    t2 is ['AlgebraicNumber] => defaultTargetFE t2
+    EQCAR(t2, 'Variable) or t2 = $Symbol =>
+      defaultTargetFE($Symbol)
+    t2 is ['Polynomial, .] or t2 is ['Fraction, ['Polynomial, .]] =>
+      defaultTargetFE(t2)
+    nil
+  t1 is ['Polynomial,['Complex,u1]] and t2 is ['Complex,u2] =>
+    resolveTT1(t1,u2)
+  t1 is ['Polynomial,R] and t2 is ['Complex,S] =>
+    containsPolynomial(S) => resolveTT1(['Polynomial,['Complex,R]],t2)
+    ['Polynomial,['Complex,resolveTT1(R,S)]]
+  t1 is ['Expression, R] and t2 is ['Complex,S] =>
+    dom' := resolveTT(R, t2)
+    null dom' => nil
+    ['Expression, dom']
+  t1 is ['Segment, dom] and t2 isnt ['Segment,.] =>
+    dom' := resolveTT(dom, t2)
+    null dom' => nil
+    ['Segment, dom']
+  nil
+
+resolveTTCC(t1,t2) ==
+  -- tries to use canCoerceFrom information to see if types can be
+  -- coerced to one another
+  gt21 := GGREATERP(t2,t1)
+  (c12 := canCoerceFrom(t1,t2)) and gt21 => t2
+  c21 := canCoerceFrom(t2,t1)
+  null (c12 or c21) => NIL
+  c12 and not c21 => t2
+  c21 and not c12 => t1
+  -- both are coerceable to each other
+  if gt21 then t1 else t2
+
+resolveTTEq(t1,t2) ==
+  -- tries to find the constructor of t1 somewhere in t2 (or vice versa)
+  -- and move the other guy to the top
+  [c1,:arg1] := deconstructT t1
+  [c2,:arg2] := deconstructT t2
+  t := resolveTTEq1(c1,arg1,[c2,arg2]) => t
+  t := ( arg1 and resolveTTEq2(c2,arg2,[c1,arg1]) ) => t
+  arg2 and resolveTTEq2(c1,arg1,[c2,arg2])
+
+resolveTTEq1(c1,arg1,TL is [c2,arg2,:.]) ==
+  -- takes care of basic types and of types with the same constructor
+  -- calls resolveTT1 on the arguments in the second case
+  null arg1 and null arg2 =>
+    canCoerceFrom(c1,c2) => constructTowerT(c2,CDDR TL)
+    canCoerceFrom(c2,c1) and constructTowerT(c1,CDDR TL)
+  c1=c2 and
+    [c2,arg2,:TL] := bubbleType TL
+    until null arg1 or null arg2 or not t repeat
+      t := resolveTT1(CAR arg1,CAR arg2) =>
+        arg := CONS(t,arg)
+        arg1 := CDR arg1
+        arg2 := CDR arg2
+    t and null arg1 and null arg2 and
+      t0 := constructM(c1,nreverse arg)
+      constructTowerT(t0,TL)
+
+resolveTTEq2(c1,arg1,TL is [c,arg,:.]) ==
+  -- tries to resolveTTEq the type [c1,arg1] with the last argument
+  -- of the type represented by TL
+  [c2,:arg2] := deconstructT last arg
+  TL := [c2,arg2,:TL]
+  t := resolveTTEq1(c1,arg1,TL) => t
+  arg2 and resolveTTEq2(c1,arg1,TL)
+
+resolveTTRed(t1,t2) ==
+  -- the same function as resolveTTEq, but instead of testing for
+  -- constructor equality, it looks whether a rewrite rule can be applied
+  t := resolveTTRed1(t1,t2,NIL) => t
+  [c1,:arg1] := deconstructT t1
+  t := arg1 and resolveTTRed2(t2,last arg1,[c1,arg1]) => t
+  [c2,:arg2] := deconstructT t2
+  arg2 and resolveTTRed2(t1,last arg2,[c2,arg2])
+
+resolveTTRed1(t1,t2,TL) ==
+  -- tries to apply a reduction rule on (Resolve t1 t2)
+  -- then it creates a type using the result and TL
+  EQ(t,term1RW(t := ['Resolve,t1,t2],$Res)) and
+    EQ(t,term1RW(t := ['Resolve,t2,t1],$Res)) => NIL
+  [c2,:arg2] := deconstructT t2
+  [c2,arg2,:TL] := bubbleType [c2,arg2,:TL]
+  t2 := constructM(c2,arg2)
+  l := term1RWall(['Resolve,t1,t2],$Res)
+  for t0 in l until t repeat t := resolveTTRed3 t0
+  l and t => constructTowerT(t,TL)
+  l := term1RWall(['Resolve,t2,t1],$Res)
+  for t0 in l until t repeat t := resolveTTRed3 t0
+  l and t and constructTowerT(t,TL)
+
+resolveTTRed2(t1,t2,TL) ==
+  -- tries to resolveTTRed t1 and t2 and build a type using TL
+  t := resolveTTRed1(t1,t2,TL) => t
+  [c2,:arg2] := deconstructT t2
+  arg2 and resolveTTRed2(t1,last arg2,[c2,arg2,:TL])
+
+resolveTTRed3(t) ==
+  -- recursive resolveTTRed which handles all subterms of the form
+  -- (Resolve t1 t2) or subterms which have to be interpreted
+  atom t => t
+  t is ['Resolve,a,b] =>
+    ( t1 := resolveTTRed3 a ) and ( t2 := resolveTTRed3 b ) and
+      resolveTT1(t1,t2)
+  t is ['Incl,a,b] => member(a,b) and b
+  t is ['SetDiff,a,b] => intersection(a,b) and SETDIFFERENCE(a,b)
+  t is ['SetComp,a,b] =>
+    and/[member(x,a) for x in b] and SETDIFFERENCE(a,b)
+  t is ['SetInter,a,b] => intersection(a,b)
+  t is ['SetUnion,a,b] => union(a,b)
+  t is ['VarEqual,a,b] => (a = b) and a
+  t is ['SetEqual,a,b] =>
+    (and/[member(x,a) for x in b] and and/[member(x,b) for x in a]) and a
+  [( atom x and x ) or ((not cs and x and not interpOp? x and x)
+    or resolveTTRed3 x) or return NIL
+      for x in t for cs in GETDATABASE(CAR t, 'COSIG) ]
+
+interpOp?(op) ==
+  PAIRP(op) and
+    CAR(op) in '(Incl SetDiff SetComp SetInter SetUnion VarEqual SetEqual)
+
+--% Resolve Type with Category
+
+resolveTCat(t,c) ==
+  -- this function attempts to find a type tc of category c such that
+  -- t can be coerced to tc. NIL returned for failure.
+  -- Example:  t = Integer, c = Field ==> tc = RationalNumber
+
+  -- first check whether t already belongs to c
+  ofCategory(t,c) => t
+
+  -- if t is built by a parametrized constructor and there is a
+  -- condition on the parameter that matches the category, try to
+  -- recurse. An example of this is (G I, Field) -> G RN
+
+  rest(t) and (tc := resolveTCat1(t,c)) => tc
+
+  -- now check some specific niladic categories
+  c in '((Field) (EuclideanDomain)) and ofCategory(t,'(IntegralDomain))=>
+    eqType [$QuotientField, t]
+
+  c = '(Field) and t = $Symbol => ['RationalFunction,$Integer]
+
+  c = '(Ring) and t is ['FactoredForm,t0] => ['FactoredRing,t0]
+
+  (t is [t0]) and (sd := getImmediateSuperDomain(t0)) and sd ^= t0 =>
+    resolveTCat(sd,c)
+
+  SIZE(td := deconstructT t) ^= 2=> NIL
+  SIZE(tc := deconstructT c) ^= 2 => NIL
+  ut := underDomainOf t
+  null isValidType(uc := last tc) => NIL
+  null canCoerceFrom(ut,uc) => NIL
+  nt := constructT(first td,[uc])
+  ofCategory(nt,c) => nt
+  NIL
+
+resolveTCat1(t,c) ==
+  -- does the hard work of looking at conditions on under domains
+  -- if null (ut := getUnderModeOf(t)) then ut := last dt
+  null (conds := getConditionsForCategoryOnType(t,c)) => NIL
+--rest(conds) => NIL   -- will handle later
+  cond := first conds
+  cond isnt [.,['has, pat, c1],:.] => NIL
+  rest(c1) => NIL      -- make it simple
+
+  argN := 0
+  t1 := nil
+
+  for ut in rest t for i in 1.. while (argN = 0) repeat
+    sharp := INTERNL('"#",STRINGIMAGE i)
+    sharp = pat =>
+      argN := i
+      t1 := ut
+
+  null t1 => NIL
+  null (t1' := resolveTCat(t1,c1)) => NIL
+  t' := copy t
+  t'.argN := t1'
+  t'
+
+getConditionsForCategoryOnType(t,cat) ==
+  getConditionalCategoryOfType(t,[NIL],['ATTRIBUTE,cat])
+
+getConditionalCategoryOfType(t,conditions,match) ==
+  if PAIRP t then t := first t
+  t in '(Union Mapping Record) => NIL
+  conCat := GETDATABASE(t,'CONSTRUCTORCATEGORY)
+  REMDUP CDR getConditionalCategoryOfType1(conCat,conditions,match,[NIL])
+
+getConditionalCategoryOfType1(cat,conditions,match,seen) ==
+  cat is ['Join,:cs] or cat is ['CATEGORY,:cs] =>
+    null cs => conditions
+    getConditionalCategoryOfType1([first cat,:rest cs],
+     getConditionalCategoryOfType1(first cs,conditions,match,seen),
+       match,seen)
+  cat is ['IF,., cond,.] =>
+    matchUpToPatternVars(cond,match,NIL) =>
+      RPLACD(conditions,CONS(cat,CDR conditions))
+      conditions
+    conditions
+  cat is [catName,:.] and (GETDATABASE(catName,'CONSTRUCTORKIND) = 'category) =>
+    cat in CDR seen => conditions
+    RPLACD(seen,[cat,:CDR seen])
+    subCat := GETDATABASE(catName,'CONSTRUCTORCATEGORY)
+    -- substitute vars of cat into category
+    for v in rest cat for vv in $TriangleVariableList repeat
+      subCat := SUBST(v,vv,subCat)
+    getConditionalCategoryOfType1(subCat,conditions,match,seen)
+  conditions
+
+matchUpToPatternVars(pat,form,patAlist) ==
+  -- tries to match pattern variables (of the # form) in pat
+  -- against expressions in form. If one is found, it is checked
+  -- against the patAlist to make sure we are using the same expression
+  -- each time.
+  EQUAL(pat,form) => true
+  isSharpVarWithNum(pat) =>
+    -- see is pattern variable is in alist
+    (p := ASSOC(pat,patAlist)) => EQUAL(form,CDR p)
+    patAlist := [[pat,:form],:patAlist]
+    true
+  PAIRP(pat) =>
+    not (PAIRP form) => NIL
+    matchUpToPatternVars(CAR pat, CAR form,patAlist) and
+      matchUpToPatternVars(CDR pat, CDR form,patAlist)
+  NIL
+
+--% Resolve Type with Mode
+
+-- only implemented for nullary control-L's (which stand for types)
+
+resolveTMOrCroak(t,m) ==
+  resolveTM(t,m) or throwKeyedMsg("S2IR0004",[t,m])
+
+resolveTM(t,m) ==
+  -- resolves a type with a mode which may be partially specified
+  startTimingProcess 'resolve
+  $Subst : local := NIL
+  $Coerce : local := 'T
+  t := eqType t
+  m := eqType SUBSTQ("**",$EmptyMode,m)
+  tt := resolveTM1(t,m)
+  result := tt and isValidType tt and eqType tt
+  stopTimingProcess 'resolve
+  result
+
+resolveTM1(t,m) ==
+  -- general resolveTM, which looks for a term variable
+  -- otherwise it looks whether the type has the same top level
+  -- constructor as the mode, looks for a rewrite rule, or builds up
+  -- a tower
+  t=m => t
+  m is ['Union,:.] => resolveTMUnion(t,m)
+  m = '(Void) => m
+  m = '(Any) => m
+  m = '(Exit) => t
+  containsVars m =>
+    isPatternVar m =>
+      p := ASSQ(m,$Subst) =>
+        $Coerce =>
+          tt := resolveTT1(t,CDR p) => RPLACD(p,tt) and tt
+          NIL
+        t=CDR p and t
+      $Subst := CONS(CONS(m,t),$Subst)
+      t
+    atom(t) or atom(m) => NIL
+    (t is ['Record,:tr]) and (m is ['Record,:mr]) and
+      (tt := resolveTMRecord(tr,mr)) => tt
+    t is ['Record,:.] or m is ['Record,:.] => NIL
+    t is ['Variable, .] and m is ['Mapping, :.] => m
+    t is ['FunctionCalled, .] and m is ['Mapping, :.] => m
+    if isEqualOrSubDomain(t, $Integer) then
+      t := $Integer
+    tt := resolveTMEq(t,m) => tt
+    $Coerce and
+      tt := resolveTMRed(t,m) => tt
+      resolveTM2(t,m)
+  $Coerce and canCoerceFrom(t,m) and m
+
+resolveTMRecord(tr,mr) ==
+  #tr ^= #mr => NIL
+  ok := true
+  tt := NIL
+  for ta in tr for ma in mr while ok repeat
+    -- element is [':,tag,mode]
+    CADR(ta) ^= CADR(ma) => ok := NIL      -- match tags
+    ra := resolveTM1(CADDR ta, CADDR ma)   -- resolve modes
+    null ra => ok := NIL
+    tt := CONS([CAR ta,CADR ta,ra],tt)
+  null ok => NIL
+  ['Record,nreverse tt]
+
+resolveTMUnion(t, m is ['Union,:ums]) ==
+  isTaggedUnion m => resolveTMTaggedUnion(t,m)
+  -- resolves t with a Union type
+  t isnt ['Union,:uts] =>
+    ums := REMDUP spliceTypeListForEmptyMode([t],ums)
+    ums' := nil
+    success := nil
+    for um in ums repeat
+      (um' := resolveTM1(t,um)) =>
+        success := true
+        um' in '(T TRUE) => ums' := [um,:ums']
+        ums' := [um',:ums']
+      ums' := [um,:ums']
+    -- remove any duplicate domains that might have been created
+    m' := ['Union,:REMDUP reverse ums']
+    success =>
+      null CONTAINED('_*_*,m') => m'
+      t = $Integer => NIL
+      resolveTM1($Integer,m')
+    NIL
+  -- t is actually a Union if we got here
+  ums := REMDUP spliceTypeListForEmptyMode(uts,ums)
+  bad := nil
+  doms := nil
+  for ut in uts while ^bad repeat
+    (m' := resolveTMUnion(ut,['Union,:ums])) =>
+      doms := append(CDR m',doms)
+    bad := true
+  bad => NIL
+  ['Union,:REMDUP doms]
+
+resolveTMTaggedUnion(t, m is ['Union,:ums]) ==
+  NIL
+
+spliceTypeListForEmptyMode(tl,ml) ==
+  -- splice in tl for occurrence of ** in ml
+  null ml => nil
+  ml is [m,:ml'] =>
+    m = "**" => append(tl,spliceTypeListForEmptyMode(tl,ml'))
+    [m,:spliceTypeListForEmptyMode(tl,ml')]
+
+resolveTM2(t,m) ==
+  -- resolves t with the last argument of m and builds up a tower
+  [cm,:argm] := deconstructT m
+  argm and
+    tt := resolveTM1(t,last argm)
+    tt and
+      ttt := constructM(cm,replaceLast(argm,tt))
+      ttt and canCoerceFrom(tt,ttt) and ttt
+
+resolveTMEq(t,m) ==
+  -- tests whether t and m have the same top level constructor, which,
+  -- in the case of t, could be bubbled up
+  (res := resolveTMSpecial(t,m)) => res
+  [cm,:argm] := deconstructT m
+  c := containsVars cm
+  TL := NIL
+  until b or not t repeat
+    [ct,:argt] := deconstructT t
+    b :=
+      c =>
+        SL := resolveTMEq1(ct,cm)
+        not EQ(SL,'failed)
+      ct=cm
+    not b =>
+      TL := [ct,argt,:TL]
+      t := argt and last argt
+  b and
+    t := resolveTMEq2(cm,argm,[ct,argt,:TL])
+    if t then for p in SL repeat $Subst := augmentSub(CAR p,CDR p,$Subst)
+    t
+
+resolveTMSpecial(t,m) ==
+  -- a few special cases
+  t = $AnonymousFunction and m is ['Mapping,:.] => m
+  t is ['Variable,x] and m is ['OrderedVariableList,le] =>
+    isPatternVar le => ['OrderedVariableList,[x]]
+    PAIRP(le) and member(x,le) => le
+    NIL
+  t is ['Fraction, ['Complex, t1]] and m is ['Complex, m1] =>
+    resolveTM1(['Complex, ['Fraction, t1]], m)
+  t is ['Fraction, ['Polynomial, ['Complex, t1]]] and m is ['Complex, m1] =>
+    resolveTM1(['Complex, ['Fraction, ['Polynomial, t1]]], m)
+  t is ['Mapping,:lt] and m is ['Mapping,:lm] =>
+    #lt ^= #lm => NIL
+    l := NIL
+    ok := true
+    for at in lt for am in lm while ok repeat
+      (ok := resolveTM1(at,am)) => l := [ok,:l]
+    ok and ['Mapping,:reverse l]
+  t is ['Segment,u] and m is ['UniversalSegment,.] =>
+    resolveTM1(['UniversalSegment, u], m)
+  NIL
+
+resolveTMEq1(ct,cm) ==
+  -- ct and cm are type constructors
+  -- tests for a match from cm to ct
+  -- the result is a substitution or 'failed
+  not (CAR ct=CAR cm) => 'failed
+  SL := NIL
+  ct := CDR ct
+  cm := CDR cm
+  b := 'T
+  while ct and cm and b repeat
+    xt := CAR ct
+    ct := CDR ct
+    xm := CAR cm
+    cm := CDR cm
+    if not (atom xm) and CAR xm = ":"  --  i.e. Record
+      and CAR xt = ":" and CADR xm = CADR xt then
+        xm := CADDR xm
+        xt := CADDR xt
+    b :=
+      xt=xm => 'T
+      isPatternVar(xm) and
+        p := ASSQ(xm,$Subst) => xt=CDR p
+        p := ASSQ(xm,SL) => xt=CDR p
+        SL := augmentSub(xm,xt,SL)
+  b => SL
+  'failed
+
+resolveTMEq2(cm,argm,TL) ==
+  -- [cm,argm] is a deconstructed mode,
+  -- TL is a deconstructed type t
+  [ct,argt,:TL] :=
+    $Coerce => bubbleType TL
+    TL
+  null TL and
+    null argm => constructM(ct,argt)
+--  null argm => NIL
+    arg := NIL
+    while argt and argm until not tt repeat
+      x1 := CAR argt
+      argt := CDR argt
+      x2 := CAR argm
+      argm := CDR argm
+      tt := resolveTM1(x1,x2) =>
+        arg := CONS(tt,arg)
+    null argt and null argm and tt and constructM(ct,nreverse arg)
+
+resolveTMRed(t,m) ==
+  -- looks for an applicable rewrite rule at any level of t and tries
+  --   to bubble this constructor up to the top to t
+  TL := NIL
+  until b or not t repeat
+    [ct,:argt] := deconstructT t
+    b := not EQ(t,term1RW(['Resolve,t,m],$ResMode)) and
+      [c0,arg0,:TL0] := bubbleType [ct,argt,:TL]
+      null TL0 and
+        l := term1RWall(['Resolve,constructM(c0,arg0),m],$ResMode)
+        for t0 in l until t repeat t := resolveTMRed1 t0
+        l and t
+    b or
+      TL := [ct,argt,:TL]
+      t := argt and last argt
+  b and t
+
+resolveTMRed1(t) ==
+  -- recursive resolveTMRed which handles all subterms of the form
+  -- (Resolve a b)
+  atom t => t
+  t is ['Resolve,a,b] =>
+    ( a := resolveTMRed1 a ) and ( b := resolveTMRed1 b ) and
+      resolveTM1(a,b)
+  t is ['Incl,a,b] => PAIRP b and member(a,b) and b
+  t is ['Diff,a,b] => PAIRP a and member(b,a) and SETDIFFERENCE(a,[b])
+  t is ['SetIncl,a,b] => PAIRP b and and/[member(x,b) for x in a] and b
+  t is ['SetDiff,a,b] => PAIRP b and PAIRP b and
+                         intersection(a,b) and SETDIFFERENCE(a,b)
+  t is ['VarEqual,a,b] => (a = b) and b
+  t is ['SetComp,a,b] => PAIRP a and PAIRP b and
+    and/[member(x,a) for x in b] and SETDIFFERENCE(a,b)
+  t is ['SimpleAlgebraicExtension,a,b,p] =>  -- this is a hack. RSS
+    ['SimpleAlgebraicExtension, resolveTMRed1 a, resolveTMRed1 b,p]
+  [( atom x and x ) or resolveTMRed1 x or return NIL for x in t]
+
+--% Type and Mode Representation
+
+eqType(t) ==
+  -- looks for an equivalent but more simple type
+  -- eg, eqType QF I = RN
+  -- the new algebra orginization no longer uses these sorts of types
+--  termRW(t,$TypeEQ)
+  t
+
+equiType(t) ==
+  -- looks for an equivalent but expanded type
+  -- eg, equiType RN == QF I
+  -- the new algebra orginization no longer uses these sorts of types
+--  termRW(t,$TypeEqui)
+  t
+
+getUnderModeOf d ==
+  not PAIRP d => NIL
+--  n := LASSOC(first d,$underDomainAlist) => d.n ----> $underDomainAlist NOW always NIL
+  for a in rest d for m in rest destructT d repeat
+    if m then return a
+
+--deconstructM(t) ==
+--  -- M is a type, which may contain type variables
+--  -- results in a pair (type constructor . mode arguments)
+--  CDR t and constructor? CAR t =>
+--    dt := destructT CAR t
+--    args := [ x for d in dt for y in t | ( x := d and y ) ]
+--    c := [ x for d in dt for y in t | ( x := not d and y ) ]
+--    CONS(c,args)
+--  CONS(t,NIL)
+
+deconstructT(t) ==
+  -- M is a type, which may contain type variables
+  -- results in a pair (type constructor . mode arguments)
+  KDR t and constructor? CAR t =>
+    dt := destructT CAR t
+    args := [ x for d in dt for y in t | ( x := d and y ) ]
+    c := [ x for d in dt for y in t | ( x := not d and y ) ]
+    CONS(c,args)
+  CONS(t,NIL)
+
+constructT(c,A) ==
+  -- c is a type constructor, A a list of argument types
+  A => [if d then POP A else POP c for d in destructT CAR c]
+  c
+
+constructM(c,A) ==
+  -- replaces top level RE's or QF's by equivalent types, if possible
+  containsVars(c) or containsVars(A) => NIL
+  -- collapses illegal FE's
+  CAR(c) = $FunctionalExpression => eqType defaultTargetFE CAR A
+  eqType constructT(c,A)
+
+replaceLast(A,t) ==
+  -- replaces the last element of the nonempty list A by t (constructively
+  nreverse RPLACA(reverse A,t)
+
+destructT(functor)==
+  -- provides a list of booleans, which indicate whether the arguments
+  -- to the functor are category forms or not
+  GETDATABASE(opOf functor,'COSIG)
+
+constructTowerT(t,TL) ==
+  -- t is a type, TL a list of constructors and argument lists
+  -- t is embedded into TL
+  while TL and t repeat
+    [c,arg,:TL] := TL
+    t0 := constructM(c,replaceLast(arg,t))
+    t := canCoerceFrom(t,t0) and t0
+  t
+
+bubbleType(TL) ==
+  -- tries to move the last constructor in TL upwards
+  -- uses canCoerceFrom to test whether two constructors can be bubbled
+  [c1,arg1,:T1] := TL
+  null T1 or null arg1 => TL
+  [c2,arg2,:T2] := T1
+  t := last arg1
+  t2 := constructM(c2,replaceLast(arg2,t))
+  arg1 := replaceLast(arg1,t2)
+  newCanCoerceCommute(c2,c1) or canCoerceCommute(c2, c1) =>
+    bubbleType [c1,arg1,:T2]
+  TL
+
+bubbleConstructor(TL) ==
+  -- TL is a nonempty list of type constructors and nonempty argument
+  -- lists representing a deconstructed type
+  -- then the lowest constructor is bubbled to the top
+  [c,arg,:T1] := TL
+  t := last arg
+  until null T1 repeat
+    [c1,arg1,:T1] := T1
+    arg1 := replaceLast(arg1,t)
+    t := constructT(c1,arg1)
+  constructT(c,replaceLast(arg,t))
+
+compareTT(t1,t2) ==
+  -- 'T if type t1 is more nested than t2
+  -- otherwise 'T if t1 is lexicographically greater than t2
+  EQCAR(t1,$QuotientField) or
+    MEMQ(opOf t2,[$QuotientField, 'SimpleAlgebraicExtension]) => NIL
+    CGREATERP(PRIN2CVEC opOf t1,PRIN2CVEC opOf t2)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-spec1.boot.pamphlet b/src/interp/i-spec1.boot.pamphlet
new file mode 100644
index 00000000..3b4427cd
--- /dev/null
+++ b/src/interp/i-spec1.boot.pamphlet
@@ -0,0 +1,1300 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-spec1.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+Handlers for Special Forms (1 of 2)
+
+This file contains the functions which do type analysis and
+evaluation of special functions in the interpreter.
+Special functions are ones which are not defined in the algebra
+code, such as assignment, construct, COLLECT and declaration.
+
+Operators which require special handlers all have a LISP "up"
+property which is the name of the special handler, which is
+always the word "up" followed by the operator name.
+If an operator has this "up" property the handler is called
+automatically from bottomUp instead of general modemap selection.
+
+The up handlers are usually split into two pieces, the first is
+the up function itself, which performs the type analysis, and an
+"eval" function, which generates (and executes, if required) the
+code for the function.
+The up functions always take a single argument, which is the
+entire attributed tree for the operation, and return the modeSet
+of the node, which is a singleton list containing the type
+computed for the node.
+The eval functions can take any arguments deemed necessary.
+Actual evaluation is done if $genValue is true, otherwise code is
+generated.
+(See the function analyzeMap for other things that may affect
+what is generated in these functions.)
+
+These functions are required to do two things:
+  1) do a putValue on the operator vector with the computed value
+     of the node, which is a triple.  This is usually done in the
+     eval functions.
+  2) do a putModeSet on the operator vector with a list of the
+     computed type of the node.  This is usually done in the
+     up functions.
+
+There are several special modes used in these functions:
+  1) Void is the mode that should be used for all statements
+     that do not otherwise return values, such as declarations,
+     loops, IF-THEN's without ELSE's, etc..
+  2) $NoValueMode and $ThrowAwayMode used to be used in situations
+     where Void is now used, and are being phased out completely.
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+
+-- Functions which require special handlers (also see end of file)
+
+SETANDFILEQ($repeatLabel, NIL)
+SETANDFILEQ($breakCount, 0)
+SETANDFILEQ($anonymousMapCounter, 0)
+
+SETANDFILEQ($specialOps, '(
+  ADEF AlgExtension and case COERCE COLLECT construct Declare DEF Dollar
+   equation error free has IF is isnt iterate break LET local MDEF or
+    pretend QUOTE REDUCE REPEAT return SEQ TARGET Tuple typeOf where ))
+
+--% Void stuff
+
+voidValue() == '"()"
+
+--% Handlers for Anonymous Function Definitions
+
+upADEF t ==
+  t isnt [.,[vars,types,.,body],pred,.] => NIL
+  -- do some checking on what we got
+  for var in vars repeat
+    if not IDENTP(var) then throwKeyedMsg("S2IS0057",[var])
+  -- unabbreviate types
+  types := [(if t then evaluateType unabbrev t else NIL) for t in types]
+  -- we do not allow partial types
+  if isPartialMode(m := first types) then throwKeyedMsg("S2IS0058",[m])
+
+  -- we want everything to be declared or nothing. The exception is that
+  -- we do not require a target type since we will compute one anyway.
+  if null(m) and rest types then
+    m := first rest types
+    types' := rest rest types
+  else
+    types' := rest types
+  for type in types' repeat
+    if (type and null m) or (m and null type) then
+      throwKeyedMsg("S2IS0059",NIL)
+    if isPartialMode type  then throwKeyedMsg("S2IS0058",[type])
+
+--  $localVars: local := nil
+--  $freeVars:  local := nil
+--  $env:       local := [[NIL]]
+  $compilingMap : local := true
+
+  -- if there is a predicate, merge it in with the body
+  if pred ^= true then body := ['IF,pred,body,'noMapVal]
+
+  tar := getTarget t
+  null m and tar is ['Mapping,.,:argTypes] and (#vars = #argTypes) =>
+    if isPartialMode tar then throwKeyedMsg("S2IS0058",[tar])
+    evalTargetedADEF(t,vars,rest tar,body)
+  null m => evalUntargetedADEF(t,vars,types,body)
+  evalTargetedADEF(t,vars,types,body)
+
+evalUntargetedADEF(t,vars,types,body) ==
+  -- recreate a parse form
+  if vars is [var]
+    then vars := var
+    else vars := ['Tuple,:vars]
+  val := objNewWrap(["+->",vars,body],$AnonymousFunction)
+  putValue(t,val)
+  putModeSet(t,[objMode val])
+
+evalTargetedADEF(t,vars,types,body) ==
+  $mapName : local := makeInternalMapName('"anonymousFunction",
+    #vars,$anonymousMapCounter,'"internal")
+  $anonymousMapCounter := 1 + $anonymousMapCounter
+  $compilingMap   : local := true  -- state that we are trying to compile
+  $mapThrowCount  : local := 0     -- number of "return"s encountered
+  $mapReturnTypes : local := nil   -- list of types from returns
+  $repeatLabel    : local := nil   -- for loops; see upREPEAT
+  $breakCount     : local := 0     -- breaks from loops; ditto
+
+  -- now substitute formal names for the parm variables
+  -- this is used in the interpret-code case, but isn't so bad any way
+  -- since it makes the bodies look more like regular map bodies
+
+  sublist := [[var,:GENSYM()] for var in vars]
+  body := sublisNQ(sublist,body)
+  vars := [CDR v for v in sublist]
+
+  for m in CDR types for var in vars repeat
+    $env:= put(var,'mode,m,$env)
+    mkLocalVar($mapName,var)
+  for lvar in getLocalVars($mapName,body) repeat
+    mkLocalVar($mapName,lvar)
+  -- set up catch point for interpret-code mode
+  x := CATCH('mapCompiler,compileTargetedADEF(t,vars,types,body))
+  x = 'tryInterpOnly => mkInterpTargetedADEF(t,vars,types,body)
+  x
+
+mkInterpTargetedADEF(t,vars,types,oldBody) ==
+  null first types =>
+    throwKeyedMsg("S2IS0056",NIL)
+    throwMessage '"   map result type needed but not present."
+  arglCode := ['LIST,:[argCode for type in rest types for var in vars]]
+    where argCode == ['putValueValue,['mkAtreeNode,MKQ var],
+      objNewCode(['wrap,var],type)]
+  put($mapName,'mapBody,oldBody,$e)
+  body := ['rewriteMap1,MKQ $mapName,arglCode,MKQ types]
+  compileADEFBody(t,vars,types,body,first types)
+
+compileTargetedADEF(t,vars,types,body) ==
+  val := compileBody(body,CAR types)
+  computedResultType := objMode val
+  body := wrapMapBodyWithCatch flattenCOND objVal val
+  compileADEFBody(t,vars,types,body,computedResultType)
+
+compileADEFBody(t,vars,types,body,computedResultType) ==
+--+
+  $compiledOpNameList := [$mapName]
+  minivectorName := makeInternalMapMinivectorName(PNAME $mapName)
+  $minivectorNames := [[$mapName,:minivectorName],:$minivectorNames]
+  body := SUBST(minivectorName,"$$$",body)
+  if $compilingInputFile then
+    $minivectorCode := [:$minivectorCode,minivectorName]
+  SET(minivectorName,LIST2REFVEC $minivector)
+
+  -- The use of the three variables $definingMap, $genValue and $compilingMap
+  -- is to cover the following cases:
+  --
+  -- $definingMap: This is set in analyzeMap and covers examples like:
+  --  addx x == ((y: Integer): Integer +-> x + y)
+  --  g := addx 10
+  --  g 3
+  -- i.e. we are storing the mapping as an object.
+  --
+  -- $compilingMap: This covers mappings which are created and applied "on the
+  -- "fly", for example:
+  --  [map(h +-> D(h, t), v) for v in [t]]
+  --
+  -- $genValue: This seems to be needed when we create a map as an argument 
+  -- for a constructor, e.g.:
+  --  Dx: LODO(EXPR INT, f +-> D(f, x)) := D()
+  --
+  -- MCD 13/3/96
+  if not $definingMap and ($genValue or $compilingMap) then
+    fun := ['function,['LAMBDA,[:vars,'envArg],body]]
+    code :=  wrap timedEVALFUN ['LIST,fun]
+  else
+    $freeVariables := []
+    $boundVariables := [minivectorName,:vars]
+    -- CCL does not support upwards funargs, so we check for any free variables
+    -- and pass them into the lambda as part of envArg.
+    body := checkForFreeVariables(body,"ALL")
+    fun := ['function,['LAMBDA,[:vars,'envArg],body]]
+    code := ['CONS, fun, ["VECTOR", :reverse $freeVariables]]
+
+  val := objNew(code,rt := ['Mapping,computedResultType,:rest types])
+  putValue(t,val)
+  putModeSet(t,[rt])
+
+--% Handler for Algebraic Extensions
+
+upAlgExtension t ==
+  -- handler for algebraic extension declaration.  These are of
+  --  the form "a | a**2+1", and have the effect that "a" is declared
+  --  to be a simple algebraic extension, with respect to the given
+  --  polynomial, and given the value "a" in this type.
+  t isnt [op,var,eq] => nil
+  null $genValue => throwKeyedMsg("S2IS0001",NIL)
+  a := getUnname var
+  clearCmdParts ['propert,a]  --clear properties of a
+  algExtension:= eq2AlgExtension eq
+  upmode := ['UnivariatePolynomial,a,$EmptyMode]
+  $declaredMode : local := upmode
+  putTarget(algExtension,upmode)
+  ms:= bottomUp algExtension
+  triple:= getValue algExtension
+  upmode:= resolveTMOrCroak(objMode(triple),upmode)
+  null (T:= coerceInteractive(triple,upmode)) =>
+    throwKeyedMsgCannotCoerceWithValue(objVal(triple),
+      objMode(triple),upmode)
+  newmode := objMode T
+  (field := resolveTCat(CADDR newmode,'(Field))) or
+    throwKeyedMsg("S2IS0002",[eq])
+  pd:= ['UnivariatePolynomial,a,field]
+  null (canonicalAE:= coerceInteractive(T,pd)) =>
+    throwKeyedMsgCannotCoerceWithValue(objVal T,objMode T,pd)
+  sae:= ['SimpleAlgebraicExtension,field,pd,objValUnwrap canonicalAE]
+  saeTypeSynonym := INTERN STRCONC('"SAE",STRINGIMAGE a)
+  saeTypeSynonymValue := objNew(sae,'(Domain))
+  fun := getFunctionFromDomain('generator,sae,NIL)
+  expr:= wrap SPADCALL(fun)
+  putHist(saeTypeSynonym,'value,saeTypeSynonymValue,$e)
+  putHist(a,'mode,sae,$e)
+  putHist(a,'value,T2:= objNew(expr,sae),$e)
+  clearDependencies(a,true)
+  if $printTypeIfTrue then
+    sayKeyedMsg("S2IS0003",NIL)
+    sayMSG concat ['%l,'"   ",saeTypeSynonym,'" := ",
+      :prefix2String objVal saeTypeSynonymValue]
+    sayMSG concat ['"   ",a,'" : ",saeTypeSynonym,'" := ",a]
+  putValue(op,T2)
+  putModeSet(op,[sae])
+
+eq2AlgExtension eq ==
+  -- transforms "a=b" to a-b for processing
+  eq is [op,:l] and VECP op and (getUnname op='equation) =>
+    [mkAtreeNode "-",:l]
+  eq
+
+--% Handlers for booleans
+
+upand x ==
+  -- generates code for  and  forms. The second argument is only
+  -- evaluated if the first argument is true.
+  x isnt [op,term1,term2] => NIL
+  putTarget(term1,$Boolean)
+  putTarget(term2,$Boolean)
+  ms := bottomUp term1
+  ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[1,'"_"and_""],term1)
+  $genValue =>
+    BooleanEquality(objValUnwrap(getValue term1),
+      getConstantFromDomain('(false),$Boolean)) =>
+        putValue(x,getValue term1)
+        putModeSet(x,ms)
+    -- first term is true, so look at the second one
+    ms := bottomUp term2
+    ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[2,'"_"and_""],term2)
+    putValue(x,getValue term2)
+    putModeSet(x,ms)
+
+  ms := bottomUp term2
+  ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[2,'"_"and_""],term2)
+  -- generate an IF expression and let the rest of the code handle it
+  cond := [mkAtreeNode "=",mkAtree 'false,term1]
+  putTarget(cond,$Boolean)
+  code := [mkAtreeNode 'IF,cond,mkAtree 'false,term2]
+  putTarget(code,$Boolean)
+  bottomUp code
+  putValue(x,getValue code)
+  putModeSet(x,ms)
+
+upor x ==
+  -- generates code for  or  forms. The second argument is only
+  -- evaluated if the first argument is false.
+  x isnt [op,term1,term2] => NIL
+  putTarget(term1,$Boolean)
+  putTarget(term2,$Boolean)
+  ms := bottomUp term1
+  ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[1,'"_"or_""],term1)
+  $genValue =>
+    BooleanEquality(objValUnwrap(getValue term1),
+      getConstantFromDomain('(true),$Boolean)) =>
+        putValue(x,getValue term1)
+        putModeSet(x,ms)
+    -- first term is false, so look at the second one
+    ms := bottomUp term2
+    ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[2,'"_"or_""],term2)
+    putValue(x,getValue term2)
+    putModeSet(x,ms)
+
+  ms := bottomUp term2
+  ms isnt [=$Boolean] => throwKeyedMsgSP("S2IS0054",[2,'"_"or_""],term2)
+  -- generate an IF expression and let the rest of the code handle it
+  cond := [mkAtreeNode "=",mkAtree 'true,term1]
+  putTarget(cond,$Boolean)
+  code := [mkAtreeNode 'IF,cond,mkAtree 'true,term2]
+  putTarget(code,$Boolean)
+  bottomUp code
+  putValue(x,getValue code)
+  putModeSet(x,ms)
+
+--% Handlers for case
+
+upcase t ==
+  t isnt [op,lhs,rhs] => nil
+  bottomUp lhs
+  triple := getValue lhs
+  objMode(triple) isnt ['Union,:unionDoms] =>
+    throwKeyedMsg("S2IS0004",NIL)
+  if (rhs' := isDomainValuedVariable(rhs)) then rhs := rhs'
+  if first unionDoms is ['_:,.,.] then
+     for i in 0.. for d in unionDoms repeat
+        if d is ['_:,=rhs,.] then rhstag := i
+     if NULL rhstag then error "upcase: bad Union form"
+     $genValue =>
+        rhstag = first unwrap objVal triple => code := wrap 'TRUE
+        code := wrap NIL
+     code :=
+        ['COND,
+          [['EQL,rhstag,['CAR,['unwrap,objVal triple]]],
+            ''TRUE],
+              [''T,NIL]]
+  else
+    $genValue =>
+        t' := coerceUnion2Branch triple
+        rhs = objMode t' => code := wrap 'TRUE
+        code := wrap NIL
+    triple' := objNewCode(['wrap,objVal triple],objMode triple)
+    code :=
+        ['COND,
+          [['EQUAL,MKQ rhs,['objMode,['coerceUnion2Branch,triple']]],
+            ''TRUE],
+              [''T,NIL]]
+  putValue(op,objNew(code,$Boolean))
+  putModeSet(op,[$Boolean])
+
+--% Handlers for TARGET
+
+upTARGET t ==
+  -- Evaluates the rhs to a mode,which is used as the target type for
+  -- the lhs.
+  t isnt [op,lhs,rhs] => nil
+  -- do not (yet) support local variables on the rhs
+  (not $genValue) and or/[CONTAINED(var,rhs) for var in $localVars] =>
+    keyedMsgCompFailure("S2IC0010",[rhs])
+  $declaredMode: local := NIL
+  m:= evaluateType unabbrev rhs
+  not isLegitimateMode(m,NIL,NIL) => throwKeyedMsg("S2IE0004",[m])
+  categoryForm?(m) => throwKeyedMsg("S2IE0014",[m])
+  $declaredMode:= m
+  not atom(lhs) and putTarget(lhs,m)
+  ms := bottomUp lhs
+  first ms ^= m =>
+    throwKeyedMsg("S2IC0011",[first ms,m])
+  putValue(op,getValue lhs)
+  putModeSet(op,ms)
+
+--% Handlers for COERCE
+
+upCOERCE t ==
+  -- evaluate the lhs and then tries to coerce the result to the
+  -- mode which is the rhs.
+  -- previous to 5/16/89, this had the same semantics as
+  --    (lhs@rhs) :: rhs
+  -- this must be made explicit now.
+  t isnt [op,lhs,rhs] => nil
+  $useConvertForCoercions : local := true
+  -- do not (yet) support local variables on the rhs
+  (not $genValue) and or/[CONTAINED(var,rhs) for var in $localVars] =>
+    keyedMsgCompFailure("S2IC0006",[rhs])
+  $declaredMode: local := NIL
+  m := evaluateType unabbrev rhs
+  not isLegitimateMode(m,NIL,NIL) => throwKeyedMsg("S2IE0004",[m])
+  categoryForm?(m) => throwKeyedMsg("S2IE0014",[m])
+  $declaredMode:= m
+  -- 05/16/89 (RSS) following line commented out to give correct
+  -- semantic difference between :: and @
+  bottomUp lhs
+  type:=evalCOERCE(op,lhs,m)
+  putModeSet(op,[type])
+
+evalCOERCE(op,tree,m) ==
+  -- the value of tree is coerced to mode m
+  -- this is not necessary, if the target property of tree was used
+  v  := getValue tree
+  t1 := objMode(v)
+  if $genValue and t1 is ['Union,:.] then
+    v := coerceUnion2Branch v
+    t1 := objMode(v)
+  e  := objVal(v)
+  value:=
+    t1=m => v
+    t2 :=
+      if isPartialMode m
+        then
+          $genValue and (t1 = '(Symbol)) and containsPolynomial m =>
+            resolveTM(['UnivariatePolynomial,objValUnwrap(v),'(Integer)],m)
+          resolveTM(t1,m)
+        else m
+    null t2 => throwKeyedMsgCannotCoerceWithValue(e,t1,m)
+    $genValue => coerceOrRetract(v,t2)
+    objNew(getArgValue(tree,t2),t2)
+  val:= value or throwKeyedMsgCannotCoerceWithValue(e,t1,m)
+  putValue(op,val)
+  objMode(val)
+
+--% Handlers for COLLECT
+
+transformCollect [:itrl,body] ==
+  -- syntactic transformation for COLLECT form, called from mkAtree1
+  iterList:=[:iterTran1 for it in itrl] where iterTran1 ==
+    it is ['STEP,index,lower,step,:upperList] =>
+      [['STEP,index,mkAtree1 lower,mkAtree1 step,:[mkAtree1 upper
+        for upper in upperList]]]
+    it is ['IN,index,s] =>
+      [['IN,index,mkAtree1 s]]
+    it is ['ON,index,s] =>
+      [['IN,index,mkAtree1 ['tails,s]]]
+    it is ['WHILE,b] =>
+      [['WHILE,mkAtree1 b]]
+    it is ['_|,pred] =>
+      [['SUCHTHAT,mkAtree1 pred]]
+    it is [op,:.] and (op in '(VALUE UNTIL)) => nil
+  bodyTree:=mkAtree1 body
+  iterList:=NCONC(iterList,[:iterTran2 for it in itrl]) where
+    iterTran2 ==
+      it is ['STEP,:.] => nil
+      it is ['IN,:.] => nil
+      it is ['ON,:.] => nil
+      it is ['WHILE,:.] => nil
+      it is [op,b] and (op in '(UNTIL)) =>
+        [[op,mkAtree1 b]]
+      it is ['_|,pred] => nil
+      keyedSystemError("S2GE0016",
+        ['"transformCollect",'"Unknown type of iterator"])
+  [:iterList,bodyTree]
+
+upCOLLECT t ==
+  -- $compilingLoop variable insures that throw to interp-only mode
+  --   goes to the outermost loop.
+  $compilingLoop => upCOLLECT1 t
+  upCOLLECT0 t
+
+upCOLLECT0 t ==
+  -- sets up catch point for interpret-code mode
+  $compilingLoop: local := true
+  ms:=CATCH('loopCompiler,upCOLLECT1 t)
+  ms = 'tryInterpOnly => interpOnlyCOLLECT t
+  ms
+
+upCOLLECT1 t ==
+  t isnt [op,:itrl,body] => nil
+  -- upCOLLECT with compiled body
+  if (target := getTarget t) and not getTarget(body) then
+    if target is [agg,S] and agg in '(List Vector Stream InfiniteTuple) then
+      putTarget(body,S)
+  $interpOnly => interpCOLLECT(op,itrl,body)
+  isStreamCollect itrl => collectStream(t,op,itrl,body)
+  upLoopIters itrl
+  ms:= bottomUpCompile body
+  [m]:= ms
+  for itr in itrl repeat
+    itr is ['UNTIL, pred] => bottomUpCompilePredicate(pred,'"until")
+  mode:= ['Tuple,m]
+  evalCOLLECT(op,rest t,mode)
+  putModeSet(op,[mode])
+
+upLoopIters itrl ==
+  -- type analyze iterator loop iterators
+  for iter in itrl repeat
+    iter is ['WHILE,pred] =>
+      bottomUpCompilePredicate(pred,'"while")
+    iter is ['SUCHTHAT,pred] =>
+      bottomUpCompilePredicate(pred,'"|")
+    iter is ['UNTIL,:.] =>
+      NIL      -- handle after body is analyzed
+    iter is ['IN,index,s] =>
+      upLoopIterIN(iter,index,s)
+    iter is ['STEP,index,lower,step,:upperList] =>
+      upLoopIterSTEP(index,lower,step,upperList)
+      -- following is an optimization
+      typeIsASmallInteger(get(index,'mode,$env)) =>
+        RPLACA(iter,'ISTEP)
+    NIL       -- should have error msg here?
+
+upLoopIterIN(iter,index,s) ==
+  iterMs := bottomUp s
+
+  null IDENTP index =>  throwKeyedMsg("S2IS0005",[index])
+
+  if $genValue and first iterMs is ['Union,:.] then
+    v := coerceUnion2Branch getValue s
+    m := objMode v
+    putValue(s,v)
+    putMode(s,m)
+    iterMs := [m]
+    putModeSet(s,iterMs)
+
+  -- transform segment variable into STEP
+  iterMs is [['Segment,.]] or iterMs is [['UniversalSegment,.]] =>
+    lower := [mkAtreeNode 'lo,s]
+    step := [mkAtreeNode 'incr, s]
+    upperList :=
+      CAAR(iterMs) = 'Segment => [[mkAtreeNode 'hi,s]]
+      NIL
+    upLoopIterSTEP(index,lower,step,upperList)
+    newIter := ['STEP,index,lower,step,:upperList]
+    RPLACA(iter,CAR newIter)
+    RPLACD(iter,CDR newIter)
+
+  iterMs isnt [['List,ud]] => throwKeyedMsg("S2IS0006",[index])
+  put(index,'mode,ud,$env)
+  mkLocalVar('"the iterator expression",index)
+
+upLoopIterSTEP(index,lower,step,upperList) ==
+  null IDENTP index => throwKeyedMsg("S2IS0005",[index])
+  ltype := IFCAR bottomUpUseSubdomain(lower)
+  not (typeIsASmallInteger(ltype) or isEqualOrSubDomain(ltype,$Integer))=>
+    throwKeyedMsg("S2IS0007",['"lower"])
+  stype := IFCAR bottomUpUseSubdomain(step)
+  not (typeIsASmallInteger(stype) or isEqualOrSubDomain(stype,$Integer))=>
+    throwKeyedMsg("S2IS0008",NIL)
+  types := [ltype]
+  utype := nil
+  for upper in upperList repeat
+    utype := IFCAR bottomUpUseSubdomain(upper)
+    not (typeIsASmallInteger(utype) or isEqualOrSubDomain(utype,$Integer))=>
+      throwKeyedMsg("S2IS0007",['"upper"])
+  if utype then types := [utype, :types]
+  else types := [stype, :types]
+  type := resolveTypeListAny REMDUP types
+  put(index,'mode,type,$env)
+  mkLocalVar('"the iterator expression",index)
+
+evalCOLLECT(op,[:itrl,body],m) ==
+  iters := [evalLoopIter itr for itr in itrl]
+  bod := getArgValue(body,computedMode body)
+  if bod isnt ['SPADCALL,:.] then bode := ['unwrap,bod]
+  code := timedOptimization asTupleNewCode0 ['COLLECT,:iters,bod]
+  if $genValue then code := wrap timedEVALFUN code
+  putValue(op,objNew(code,m))
+
+falseFun(x) == nil
+
+evalLoopIter itr ==
+  -- generate code for loop iterator
+  itr is ['STEP,index,lower,step,:upperList] =>
+    ['STEP,getUnname index,getArgValue(lower,$Integer),
+      getArgValue(step,$Integer),
+        :[getArgValue(upper,$Integer) for upper in upperList]]
+  itr is ['ISTEP,index,lower,step,:upperList] =>
+    ['ISTEP,getUnname index,getArgValue(lower,$SmallInteger),
+      getArgValue(step,$SmallInteger),
+        :[getArgValue(upper,$SmallInteger) for upper in upperList]]
+  itr is ['IN,index,s] =>
+    ['IN,getUnname index,getArgValue(s,['List,get(index,'mode,$env)])]
+  (itr is [x,pred]) and (x in '(WHILE UNTIL SUCHTHAT)) =>
+    [x,getArgValue(pred,$Boolean)]
+
+interpCOLLECT(op,itrl,body) ==
+  -- interpret-code mode COLLECT handler
+  $collectTypeList: local := NIL
+  $indexVars: local := NIL
+  $indexTypes: local := NIL
+  emptyAtree op
+  emptyAtree itrl
+  emptyAtree body
+  code := ['COLLECT,:[interpIter itr for itr in itrl],
+    interpCOLLECTbody(body,$indexVars,$indexTypes)]
+  value := timedEVALFUN code
+  t :=
+    null value => '(None)
+    last $collectTypeList
+  rm := ['Tuple,t]
+  value := [objValUnwrap coerceInteractive(objNewWrap(v,m),t)
+    for v in value for m in $collectTypeList]
+  putValue(op,objNewWrap(asTupleNew(#value, value),rm))
+  putModeSet(op,[rm])
+
+interpIter itr ==
+  -- interpret loop iterator
+  itr is ['STEP,index,lower,step,:upperList] =>
+    $indexVars:= [getUnname index,:$indexVars]
+    [m]:= bottomUp lower
+    $indexTypes:= [m,:$indexTypes]
+    for up in upperList repeat bottomUp up
+    ['STEP,getUnname index,getArgValue(lower,$Integer),
+      getArgValue(step,$Integer),
+        :[getArgValue(upper,$Integer) for upper in upperList]]
+  itr is ['ISTEP,index,lower,step,:upperList] =>
+    $indexVars:= [getUnname index,:$indexVars]
+    [m]:= bottomUp lower
+    $indexTypes:= [m,:$indexTypes]
+    for up in upperList repeat bottomUp up
+    ['ISTEP,getUnname index,getArgValue(lower,$SmallInteger),
+      getArgValue(step,$SmallInteger),
+        :[getArgValue(upper,$SmallInteger) for upper in upperList]]
+  itr is ['IN,index,s] =>
+    $indexVars:=[getUnname index,:$indexVars]
+    [m]:= bottomUp s
+    m isnt ['List,um] => throwKeyedMsg("S2IS0009",[m])
+    $indexTypes:=[um,:$indexTypes]
+    ['IN,getUnname index,getArgValue(s,m)]
+  (itr is [x,pred]) and (x in '(WHILE UNTIL SUCHTHAT)) =>
+    [x,interpLoop(pred,$indexVars,$indexTypes,$Boolean)]
+
+interpOnlyCOLLECT t ==
+  -- called when compilation failed in COLLECT body, not in compiling map
+  $genValue: local := true
+  $interpOnly: local := true
+  upCOLLECT t
+
+interpCOLLECTbody(expr,indexList,indexTypes) ==
+  -- generate code for interpret-code collect
+  ['interpCOLLECTbodyIter,MKQ expr,MKQ indexList,['LIST,:indexList],
+    MKQ indexTypes]
+
+interpCOLLECTbodyIter(exp,indexList,indexVals,indexTypes) ==
+  -- execute interpret-code collect body.  keeps list of type of
+  --  elements in list in $collectTypeList.
+  emptyAtree exp
+  for i in indexList for val in indexVals for type in indexTypes repeat
+    put(i,'value,objNewWrap(val,type),$env)
+  [m]:=bottomUp exp
+  $collectTypeList:=
+    null $collectTypeList => [rm:=m]
+    [:$collectTypeList,rm:=resolveTT(m,last $collectTypeList)]
+  null rm => throwKeyedMsg("S2IS0010",NIL)
+  value:=
+    rm ^= m => coerceInteractive(getValue exp,rm)
+    getValue exp
+  objValUnwrap(value)
+
+--% Stream Collect functions
+
+isStreamCollect itrl ==
+  -- calls bottomUp on iterators and if any of them are streams
+  -- then whole shebang is a stream
+  isStream := false
+  for itr in itrl until isStream repeat
+    itr is ['IN,.,s] =>
+      iterMs := bottomUp s
+      iterMs is [['Stream,:.]] => isStream := true
+      iterMs is [['InfiniteTuple,:.]] => isStream := true
+      iterMs is [['UniversalSegment,:.]] => isStream := true
+    itr is ['STEP,.,.,.] => isStream := true
+  isStream
+
+collectStream(t,op,itrl,body) ==
+  v := CATCH('loopCompiler,collectStream1(t,op,itrl,body))
+  v = 'tryInterpOnly => throwKeyedMsg("S2IS0011",NIL)
+  v
+
+collectStream1(t,op,itrl,body) ==
+  $indexVars:local := NIL
+  upStreamIters itrl
+  if #$indexVars = 1 then mode:=collectOneStream(t,op,itrl,body)
+  else mode:=collectSeveralStreams(t,op,itrl,body)
+  putModeSet(op,[mode])
+
+upStreamIters itrl ==
+  -- type analyze stream collect loop iterators
+  for iter in itrl repeat
+    iter is ['IN,index,s] =>
+      upStreamIterIN(iter,index,s)
+    iter is ['STEP,index,lower,step,:upperList] =>
+      upStreamIterSTEP(index,lower,step,upperList)
+
+upStreamIterIN(iter,index,s) ==
+  iterMs := bottomUp s
+
+  -- transform segment variable into STEP
+  iterMs is [['Segment,.]] or iterMs is [['UniversalSegment,.]] =>
+    lower := [mkAtreeNode 'lo, s]
+    step := [mkAtreeNode 'incr, s]
+    upperList :=
+      CAAR(iterMs) = 'Segment => [[mkAtreeNode 'hi,s]]
+      NIL
+    upStreamIterSTEP(index,lower,step,upperList)
+    newIter := ['STEP,index,lower,step,:upperList]
+    RPLACA(iter,CAR newIter)
+    RPLACD(iter,CDR newIter)
+
+  (iterMs isnt [['List,ud]]) and (iterMs isnt [['Stream,ud]])
+    and (iterMs isnt [['InfinitTuple, ud]]) =>
+      throwKeyedMsg("S2IS0006",[index])
+  put(index,'mode,ud,$env)
+  mkLocalVar('"the iterator expression",index)
+  s :=
+    iterMs is [['List,ud],:.] =>
+      form:=[mkAtreeNode 'pretend, [mkAtreeNode 'COERCE,s,['Stream,ud]],
+             ['InfiniteTuple, ud]]
+      bottomUp form
+      form
+    s
+  $indexVars:= [[index,:s],:$indexVars]
+
+upStreamIterSTEP(index,lower,step,upperList) ==
+  null isEqualOrSubDomain(ltype := IFCAR bottomUpUseSubdomain(lower),
+    $Integer) => throwKeyedMsg("S2IS0007",['"lower"])
+  null isEqualOrSubDomain(stype := IFCAR bottomUpUseSubdomain(step),
+    $Integer) => throwKeyedMsg("S2IS0008",NIL)
+  for upper in upperList repeat
+    null isEqualOrSubDomain(IFCAR bottomUpUseSubdomain(upper),
+      $Integer) => throwKeyedMsg("S2IS0007",['"upper"])
+
+  put(index,'mode,type := resolveTT(ltype,stype),$env)
+  null type => throwKeyedMsg("S2IS0010", nil)
+  mkLocalVar('"the iterator expression",index)
+
+  s :=
+    null upperList =>
+      -- create the function that does the appropriate incrementing
+      genFun := 'generate
+      form := [mkAtreeNode genFun,
+        [[mkAtreeNode 'Dollar, ['IncrementingMaps,type],
+          mkAtreeNode 'incrementBy],step],lower]
+      bottomUp form
+      form
+    form := [mkAtreeNode 'SEGMENT,lower,first upperList]
+    putTarget(form,['Segment,type])
+    form := [mkAtreeNode 'construct,form]
+    putTarget(form,['List,['Segment,type]])
+    form := [mkAtreeNode 'expand,form]
+    putTarget(form,'(List (Integer)))
+    form:=[mkAtreeNode 'pretend, [mkAtreeNode 'COERCE,form,['Stream,$Integer]],
+           ['InfiniteTuple, $Integer]]
+    bottomUp form
+    form
+  $indexVars:= [[index,:s],:$indexVars]
+
+collectOneStream(t,op,itrl,body) ==
+  -- build stream collect for case of iterating over a single stream
+  --  In this case we don't need to build records
+  form := mkAndApplyPredicates itrl
+  bodyVec := mkIterFun(CAR $indexVars,body,$localVars)
+  form := [mkAtreeNode 'map,bodyVec,form]
+  bottomUp form
+  val := getValue form
+  m := objMode val
+  m isnt ['Stream, ud] and m isnt ['InfiniteTuple, ud] =>
+    systemError '"Not a Stream"
+  newVal := objNew(objVal val, ['InfiniteTuple, ud])
+  putValue(op,newVal)
+  objMode newVal
+
+mkAndApplyPredicates itrl ==
+  -- for one index variable case for now.  may generalize later
+  [indSet] := $indexVars
+  [.,:s] := indSet
+  for iter in itrl repeat
+    iter is ['WHILE,pred] =>
+      fun := 'filterWhile
+      predVec := mkIterFun(indSet,pred,$localVars)
+      s := [mkAtreeNode fun,predVec,s]
+    iter is ['UNTIL,pred] =>
+      fun := 'filterUntil
+      predVec := mkIterFun(indSet,pred,$localVars)
+      s := [mkAtreeNode fun,predVec,s]
+    iter is ['SUCHTHAT,pred] =>
+      fun := 'select
+      putTarget(pred,$Boolean)
+      predVec := mkIterFun(indSet,pred,$localVars)
+      s := [mkAtreeNode fun,predVec,s]
+  s
+
+mkIterFun([index,:s],funBody,$localVars) ==
+  -- transform funBody into a lambda with index as the parameter
+  mode := objMode getValue s
+  mode isnt ['Stream, indMode] and mode isnt ['InfiniteTuple, indMode] =>
+    keyedSystemError('"S2GE0016", '("mkIterFun" "bad stream index type"))
+  put(index,'mode,indMode,$env)
+  mkLocalVar($mapName,index)
+  [m]:=bottomUpCompile funBody
+  mapMode := ['Mapping,m,indMode]
+  $freeVariables := []
+  $boundVariables := [index]
+  -- CCL does not support upwards funargs, so we check for any free variables
+  -- and pass them into the lambda as part of envArg.
+  body := checkForFreeVariables(getValue funBody,$localVars)
+  val:=['function,['LAMBDA,[index,'envArg],objVal body]]
+  vec := mkAtreeNode GENSYM()
+  putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
+  vec
+
+checkForFreeVariables(v,locals) ==
+  -- v is the body of a lambda expression.  The list $boundVariables is all the
+  -- bound variables, the parameter locals contains local variables which might
+  -- be free, or the token ALL, which means that any parameter is a candidate
+  -- to be free.
+  NULL v => v
+  SYMBOLP v =>
+    v="$$$" => v -- Placeholder for mini-vector
+    MEMQ(v,$boundVariables) => v
+    p := POSITION(v,$freeVariables) =>
+      ["ELT","envArg",positionInVec(p,#($freeVariables))]
+    (locals = "ALL") or MEMQ(v,locals) =>
+      $freeVariables := [v,:$freeVariables]
+      ["ELT","envArg",positionInVec(0,#($freeVariables))]
+    v
+  LISTP v =>
+    CDR(LASTTAIL v) => -- Must be a better way to check for a genuine list?
+      v
+    [op,:args] := v
+    LISTP op => 
+      -- Might have a mode at the front of a list, or be calling a function
+      -- which returns a function.
+      [checkForFreeVariables(op,locals),:[checkForFreeVariables(a,locals) for a in args]]
+    op = "LETT" => -- Expands to a SETQ.
+      ["SETF",:[checkForFreeVariables(a,locals) for a in args]]
+    op = "COLLECT" => -- Introduces a new bound variable?
+      first(args) is ["STEP",var,:.] =>
+       $boundVariables := [var,:$boundVariables]
+       r := ["COLLECT",:[checkForFreeVariables(a,locals) for a in args]]
+       $boundVariables := delete(var,$boundVariables)
+       r
+      ["COLLECT",:[checkForFreeVariables(a,locals) for a in args]]
+    op = "REPEAT" => -- Introduces a new bound variable?
+      first(args) is ["STEP",var,:.] =>
+       $boundVariables := [var,:$boundVariables]
+       r := ["REPEAT",:[checkForFreeVariables(a,locals) for a in args]]
+       $boundVariables := delete(var,$boundVariables)
+       r
+      ["REPEAT",:[checkForFreeVariables(a,locals) for a in args]]
+    op = "LET" =>
+      args is [var,form,name] =>
+        -- This is some bizarre LET, not what one would expect in Common Lisp!
+        -- Treat var as a free variable, since it may be bound out of scope
+        -- if we are in a lambda within another lambda.
+        newvar := 
+          p := POSITION(var,$freeVariables) =>
+            ["ELT","envArg",positionInVec(p,#($freeVariables))]
+          $freeVariables := [var,:$freeVariables]
+          ["ELT","envArg",positionInVec(0,#($freeVariables))]
+        ["SETF",newvar,checkForFreeVariables(form,locals)]
+      error "Non-simple variable bindings are not currently supported"
+    op = "PROG" =>
+      error "Non-simple variable bindings are not currently supported"
+    op = "LAMBDA" => v
+    op = "QUOTE" => v
+    op = "getValueFromEnvironment" => v
+    [op,:[checkForFreeVariables(a,locals) for a in args]]
+  v
+
+positionInVec(p,l) ==
+  -- We cons up the free list, but need to keep positions consistent so
+  -- count from the end of the list.
+  l-p-1
+
+collectSeveralStreams(t,op,itrl,body) ==
+  -- performs collects over several streams in parallel
+  $index: local := nil
+  [form,:zipType] := mkZipCode $indexVars
+  form := mkAndApplyZippedPredicates(form,zipType,itrl)
+  vec := mkIterZippedFun($indexVars,body,zipType,$localVars)
+  form := [mkAtreeNode 'map, vec, form]
+  bottomUp form
+  val := getValue form
+  m := objMode val
+  m isnt ['Stream, ud] and m isnt ['InfiniteTuple, ud] =>
+    systemError '"Not a Stream"
+  newVal := objNew(objVal val, ['InfiniteTuple, ud])
+  putValue(op,newVal)
+  objMode newVal
+
+mkZipCode indexList ==
+  -- create interpreter form for turning a list of parallel streams
+  -- into a stream of nested record types.  returns [form,:recordType]
+  #indexList = 2 =>
+    [[.,:s2],[.,:s1]] := indexList
+    t1 := CADR objMode getValue s1
+    t2 := CADR objMode getValue s2
+    zipType := ['Record,['_:,'part1,t1], ['_:,'part2,t2] ]
+    zipFun := [mkAtreeNode 'Dollar, ['MakeRecord,mkEvalable t1,
+                                     mkEvalable t2],
+               mkAtreeNode 'makeRecord]
+    form := [mkAtreeNode 'map,zipFun,s1,s2]
+    [form,:zipType]
+  [form,:zipType] := mkZipCode CDR indexList
+  [[.,:s],:.] := indexList
+  t := CADR objMode getValue s
+  zipFun := [mkAtreeNode 'Dollar, ['MakeRecord,mkEvalable t,
+                                   mkEvalable zipType],
+             mkAtreeNode 'makeRecord]
+  form := [mkAtreeNode 'map,zipFun,s,form]
+  zipType := ['Record,['_:,'part1,t],['_:,'part2,zipType]]
+  [form,:zipType]
+
+mkAndApplyZippedPredicates (s,zipType,itrl) ==
+  -- for one index variable case for now.  may generalize later
+  for iter in itrl repeat
+    iter is ['WHILE,pred] =>
+      predVec := mkIterZippedFun($indexList,pred,zipType,$localVars)
+      s := [mkAtreeNode 'swhile,predVec,s]
+    iter is ['UNTIL,pred] =>
+      predVec := mkIterZippedFun($indexList,pred,zipType,$localVars)
+      s := [mkAtreeNode 'suntil,predVec,s]
+    iter is ['SUCHTHAT,pred] =>
+      putTarget(pred,$Boolean)
+      predVec := mkIterZippedFun($indexList,pred,zipType,$localVars)
+      s := [mkAtreeNode 'select,predVec,s]
+  s
+
+mkIterZippedFun(indexList,funBody,zipType,$localVars) ==
+  -- transform funBody into a lamda with $index as the parameter
+  numVars:= #$indexVars
+  for [var,:.] in $indexVars repeat
+    funBody := subVecNodes(mkIterVarSub(var,numVars),var,funBody)
+  put($index,'mode,zipType,$env)
+  mkLocalVar($mapName,$index)
+  [m]:=bottomUpCompile funBody
+  mapMode := ['Mapping,m,zipType]
+  $freeVariables := []
+  $boundVariables := [$index]
+  -- CCL does not support upwards funargs, so we check for any free variables
+  -- and pass them into the lambda as part of envArg.
+  body :=
+   [checkForFreeVariables(form,$localVars) for form in getValue funBody]
+  val:=['function,['LAMBDA,[$index,'envArg],objVal body]]
+  vec := mkAtreeNode GENSYM()
+  putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
+  vec
+
+subVecNodes(new,old,form) ==
+  ATOM form =>
+    (VECP form) and (form.0 = old) => new
+    form
+  [subVecNodes(new,old,CAR form), :subVecNodes(new,old,CDR form)]
+
+mkIterVarSub(var,numVars) ==
+  n := iterVarPos var
+  n=2 =>
+    [mkAtreeNode 'elt,mkNestedElts(numVars-2),mkAtreeNode 'part2]
+  n=1 =>
+    [mkAtreeNode 'elt,mkNestedElts(numVars-2),mkAtreeNode 'part1]
+  [mkAtreeNode 'elt,mkNestedElts(numVars-n),mkAtreeNode 'part1]
+
+iterVarPos var ==
+  for [index,:.] in reverse $indexVars for i in 1.. repeat
+    index=var => return(i)
+
+mkNestedElts n ==
+  n=0 => mkAtreeNode($index or ($index:= GENSYM()))
+  [mkAtreeNode 'elt, mkNestedElts(n-1), mkAtreeNode 'part2]
+
+--% Handlers for construct
+
+upconstruct t ==
+  --Computes the common mode set of the construct by resolving across
+  --the argument list, and evaluating
+  t isnt [op,:l] => nil
+  dol := getAtree(op,'dollar)
+  tar := getTarget(op) or dol
+  null l => upNullList(op,l,tar)
+  tar is ['Record,:types] => upRecordConstruct(op,l,tar)
+  isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar)
+  aggs := '(List)
+  if tar and PAIRP(tar) and ^isPartialMode(tar) then
+    CAR(tar) in aggs =>
+      ud :=
+        (l is [[realOp, :.]]) and (getUnname(realOp) = 'COLLECT) => tar
+        CADR tar
+      for x in l repeat if not getTarget(x) then putTarget(x,ud)
+    CAR(tar) in '(Matrix SquareMatrix RectangularMatrix) =>
+      vec := ['List,underDomainOf tar]
+      for x in l repeat if not getTarget(x) then putTarget(x,vec)
+  argModeSetList:= [bottomUp x for x in l]
+  dol and dol is [topType,:.] and not (topType in aggs) =>
+    (mmS:= selectMms(op,l,tar)) and (mS:= evalForm(op,getUnname op,l,mmS)) =>
+      putModeSet(op,mS)
+    NIL
+  (tar and tar is [topType,:.] and not (topType in aggs)) and
+    (mmS:= modemapsHavingTarget(selectMms(op,l,tar),tar)) and
+        (mS:= evalForm(op,getUnname op,l,mmS)) =>
+          putModeSet(op,mS)
+  eltTypes := replaceSymbols([first x for x in argModeSetList],l)
+  eltTypes is [['Tuple, td]] =>
+    mode := ['List, td]
+    evalTupleConstruct(op, l, mode, tar)
+  eltTypes is [['InfiniteTuple, td]] =>
+    mode := ['Stream, td]
+    evalInfiniteTupleConstruct(op, l, mode, tar)
+  if not isPartialMode(tar) and tar is ['List,ud] then
+    mode := ['List, resolveTypeListAny cons(ud,eltTypes)]
+  else mode := ['List, resolveTypeListAny eltTypes]
+  if isPartialMode tar then tar:=resolveTM(mode,tar)
+  evalconstruct(op,l,mode,tar)
+
+modemapsHavingTarget(mmS,target) ==
+  -- returns those modemaps have the signature result matching the
+  -- given target
+  [mm for mm in mmS | ([[.,res,:.],:.] := mm) and res = target]
+
+evalTupleConstruct(op,l,m,tar) ==
+  ['List, ud] := m
+  code := ['APPEND,
+    :([["asTupleAsList", getArgValueOrThrow(x,['Tuple, ud])] for x in l])]
+  val :=
+    $genValue => objNewWrap(timedEVALFUN code,m)
+    objNew(code,m)
+
+  (val1 := coerceInteractive(val,tar or m)) =>
+    putValue(op,val1)
+    putModeSet(op,[tar or m])
+  putValue(op,val)
+  putModeSet(op,[m])
+
+evalInfiniteTupleConstruct(op,l,m,tar) ==
+  ['Stream, ud] := m
+  code := first [(getArgValue(x,['InfiniteTuple, ud]) or
+    throwKeyedMsg("S2IC0007",[['InifinteTuple, ud]])) for x in l]
+  val :=
+    $genValue => objNewWrap(timedEVALFUN code,m)
+    objNew(code,m)
+  if tar then val1 := coerceInteractive(val,tar) else val1 := val
+
+  val1 =>
+    putValue(op,val1)
+    putModeSet(op,[tar or m])
+  putValue(op,val)
+  putModeSet(op,[m])
+
+evalconstruct(op,l,m,tar) ==
+  [agg,:.,underMode]:= m
+  code := ['LIST, :(argCode:=[(getArgValue(x,underMode) or
+    throwKeyedMsg("S2IC0007",[underMode])) for x in l])]
+  val :=
+    $genValue => objNewWrap(timedEVALFUN code,m)
+    objNew(code,m)
+  if tar then val1 := coerceInteractive(val,tar) else val1 := val
+
+  val1 =>
+    putValue(op,val1)
+    putModeSet(op,[tar or m])
+  putValue(op,val)
+  putModeSet(op,[m])
+
+replaceSymbols(modeList,l) ==
+  -- replaces symbol types with their corresponding polynomial types
+  --  if not all type are symbols
+  not ($Symbol in modeList) => modeList
+  modeList is [a,:b] and and/[a=x for x in b] => modeList
+  [if m=$Symbol then getMinimalVarMode(objValUnwrap(getValue arg),
+    $declaredMode) else m for m in modeList for arg in l]
+
+upNullList(op,l,tar) ==
+  -- handler for [] (empty list)
+  defMode :=
+    tar and tar is [a,b] and (a in '(Stream Vector List)) and
+      not isPartialMode(b) => ['List,b]
+    '(List (None))
+  val := objNewWrap(NIL,defMode)
+  tar and not isPartialMode(tar) =>
+    null (val' := coerceInteractive(val,tar)) =>
+      throwKeyedMsg("S2IS0013",[tar])
+    putValue(op,val')
+    putModeSet(op,[tar])
+  putValue(op,val)
+  putModeSet(op,[defMode])
+
+upTaggedUnionConstruct(op,l,tar) ==
+  -- special handler for tagged union constructors
+  tar isnt [.,:types] => nil
+  #l ^= 1 => throwKeyedMsg("S2IS0051",[#l,tar])
+  bottomUp first l
+  obj := getValue first l
+  (code := coerceInteractive(getValue first l,tar)) or
+    throwKeyedMsgCannotCoerceWithValue(objVal obj, objMode obj,tar)
+  putValue(op,code)
+  putModeSet(op,[tar])
+
+upRecordConstruct(op,l,tar) ==
+  -- special handler for record constructors
+  tar isnt [.,:types] => nil
+  argModes := nil
+  for arg in l repeat bottomUp arg
+  argCode :=
+    [(getArgValue(arg,type) or throwKeyedMsgCannotCoerceWithValue(
+      objVal getValue arg,objMode getValue arg,type))
+        for arg in l for ['_:,.,type] in types]
+  len := #l
+  code :=
+    (len = 1) => ['CONS, :argCode, '()]
+    (len = 2) => ['CONS,:argCode]
+    ['VECTOR,:argCode]
+  if $genValue then code :=  wrap timedEVALFUN code
+  putValue(op,objNew(code,tar))
+  putModeSet(op,[tar])
+
+--% Handlers for declarations
+
+upDeclare t ==
+  t isnt  [op,lhs,rhs] => nil
+  (not $genValue) and or/[CONTAINED(var,rhs) for var in $localVars] =>
+    keyedMsgCompFailure("S2IS0014",[lhs])
+  mode := evaluateType unabbrev rhs
+  mode = $Void => throwKeyedMsgSP("S2IS0015",NIL,op)
+  not isLegitimateMode(mode,nil,nil) => throwKeyedMsgSP("S2IE0004",[mode],op)
+  categoryForm?(mode) => throwKeyedMsgSP("S2IE0011",[mode, 'category],op)
+  packageForm?(mode) => throwKeyedMsgSP("S2IE0011",[mode, 'package],op)
+  junk :=
+    lhs is ['free,['Tuple,:vars]] or lhs is ['free,['LISTOF,:vars]] or
+      lhs is ['free,:vars] =>
+        for var in vars repeat declare(['free,var],mode)
+    lhs is ['local,['Tuple,:vars]] or lhs is ['local,['LISTOF,:vars]] or
+      lhs is ['local,:vars] =>
+        for var in vars repeat declare(['local,var],mode)
+    lhs is ['Tuple,:vars] or lhs is ['LISTOF,:vars] =>
+      for var in vars repeat declare(var,mode)
+    declare(lhs,mode)
+  putValue(op,objNewWrap(voidValue(), $Void))
+  putModeSet(op,[$Void])
+
+declare(var,mode) ==
+  -- performs declaration.
+  -- 10/31/89: no longer coerces value to new declared type
+  if var is ['local,v] then
+    uplocalWithType(v,mode)
+    var := v
+  if var is ['free,v] then
+    upfreeWithType(v,mode)
+    var := v
+  not IDENTP(var) =>
+    throwKeyedMsg("S2IS0016",[STRINGIMAGE var])
+  var in '(% %%) => throwKeyedMsg("S2IS0050",[var])
+  if get(var,'isInterpreterFunction,$e) then
+    mode isnt ['Mapping,.,:args] =>
+      throwKeyedMsg("S2IS0017",[var,mode])
+    -- validate that the new declaration has the defined # of args
+    mapval := objVal get(var,'value,$e)
+    -- mapval looks like '(MAP (args . defn))
+    margs := CAADR mapval
+    -- if one args, margs is not a pair, just #1 or NIL
+    -- otherwise it looks like (Tuple #1 #2 ...)
+    nargs :=
+      null margs => 0
+      PAIRP margs => -1 + #margs
+      1
+    nargs ^= #args => throwKeyedMsg("S2IM0008",[var])
+  if $compilingMap then mkLocalVar($mapName,var)
+  else clearDependencies(var,true)
+  isLocalVar(var) => put(var,'mode,mode,$env)
+  mode is ['Mapping,:.] => declareMap(var,mode)
+  v := get(var,'value,$e) =>
+    -- only allow this if either
+    --   - value already has given type
+    --   - new mode is same as old declared mode
+    objMode(v) = mode => putHist(var,'mode,mode,$e)
+    mode = get(var,'mode,$e) => NIL   -- nothing to do
+    throwKeyedMsg("S2IS0052",[var,mode])
+  putHist(var,'mode,mode,$e)
+
+declareMap(var,mode) ==
+  -- declare a Mapping property
+  (v:=get(var,'value,$e)) and objVal(v) isnt ['MAP,:.] =>
+    throwKeyedMsg("S2IS0019",[var])
+  isPartialMode mode => throwKeyedMsg("S2IM0004",NIL)
+  putHist(var,'mode,mode,$e)
+
+getAndEvalConstructorArgument tree ==
+  triple := getValue tree
+  objMode triple = '(Domain) => triple
+  isWrapped objVal(triple) => triple
+  isLocalVar objVal triple => compFailure('"   Local variable or parameter used in type")
+  objNewWrap(timedEVALFUN objVal(triple), objMode(triple))
+
+replaceSharps(x,d) ==
+  -- replaces all sharps in x by the arguments of domain d
+  -- all replaces the triangle variables
+  SL:= NIL
+  for e in CDR d for var in $FormalMapVariableList repeat
+    SL:= CONS(CONS(var,e),SL)
+  x := subCopy(x,SL)
+  SL:= NIL
+  for e in CDR d for var in $TriangleVariableList repeat
+    SL:= CONS(CONS(var,e),SL)
+  subCopy(x,SL)
+
+isDomainValuedVariable form ==
+  -- returns the value of form if form is a variable with a type value
+  IDENTP form and (val := (
+    get(form,'value,$InteractiveFrame) or _
+    (PAIRP($env) and get(form,'value,$env)) or _
+    (PAIRP($e) and get(form,'value,$e)))) and
+      objMode(val) in '((Domain) (SubDomain (Domain))) =>
+        objValUnwrap(val)
+  nil
+
+evalCategory(d,c) ==
+  -- tests whether domain d has category c
+  isPartialMode d or ofCategory(d,c)
+
+isOkInterpMode m ==
+  isPartialMode(m) => isLegitimateMode(m,nil,nil)
+  isValidType(m) and isLegitimateMode(m,nil,nil)
+
+isLegitimateRecordOrTaggedUnion u ==
+  and/[x is [":",.,d] and isLegitimateMode(d,nil,nil) for x in u]
+
+isPolynomialMode m ==
+  -- If m is a polynomial type this function returns a list of its
+  --  variables, and nil otherwise
+  m is [op,a,:rargs] =>
+    a := removeQuote a
+    MEMQ(op,'(Polynomial RationalFunction AlgebraicFunction Expression
+      ElementaryFunction LiouvillianFunction FunctionalExpression
+        CombinatorialFunction ))=> 'all
+    op = 'UnivariatePolynomial => LIST a
+    op = 'Variable       => LIST a
+    MEMQ(op,'(MultivariatePolynomial DistributedMultivariatePolynomial
+      HomogeneousDistributedMultivariatePolynomial)) => a
+    NIL
+  NIL
+
+containsPolynomial m ==
+  not PAIRP(m) => NIL
+  [d,:.] := m
+  d in $univariateDomains or d in $multivariateDomains or
+    d in '(Polynomial RationalFunction) => true
+  (m' := underDomainOf m) and containsPolynomial m'
+
+containsVariables m ==
+  not PAIRP(m) => NIL
+  [d,:.] := m
+  d in $univariateDomains or d in $multivariateDomains => true
+  (m' := underDomainOf m) and containsVariables m'
+
+listOfDuplicates l ==
+  l is [x,:l'] =>
+    x in l' => [x,:listOfDuplicates deleteAll(x,l')]
+    listOfDuplicates l'
+
+-- The following function removes all occurrences of x from the list l
+
+deleteAll(x,l) ==
+  null l => nil
+  x = CAR(l) => deleteAll(x,CDR l)
+  [first l,:deleteAll(x,rest l)]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-spec2.boot.pamphlet b/src/interp/i-spec2.boot.pamphlet
new file mode 100644
index 00000000..8b16f053
--- /dev/null
+++ b/src/interp/i-spec2.boot.pamphlet
@@ -0,0 +1,1202 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-spec2.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+Handlers for Special Forms (2 of 2)
+
+This file contains the functions which do type analysis and
+evaluation of special functions in the interpreter.
+Special functions are ones which are not defined in the algebra
+code, such as assignment, construct, COLLECT and declaration.
+
+Operators which require special handlers all have a LISP "up"
+property which is the name of the special handler, which is
+always the word "up" followed by the operator name.
+If an operator has this "up" property the handler is called
+automatically from bottomUp instead of general modemap selection.
+
+The up handlers are usually split into two pieces, the first is
+the up function itself, which performs the type analysis, and an
+"eval" function, which generates (and executes, if required) the
+code for the function.
+The up functions always take a single argument, which is the
+entire attributed tree for the operation, and return the modeSet
+of the node, which is a singleton list containing the type
+computed for the node.
+The eval functions can take any arguments deemed necessary.
+Actual evaluation is done if $genValue is true, otherwise code is
+generated.
+(See the function analyzeMap for other things that may affect
+what is generated in these functions.)
+
+These functions are required to do two things:
+  1) do a putValue on the operator vector with the computed value
+     of the node, which is a triple.  This is usually done in the
+     eval functions.
+  2) do a putModeSet on the operator vector with a list of the
+     computed type of the node.  This is usually done in the
+     up functions.
+
+There are several special modes used in these functions:
+  1) Void is the mode that should be used for all statements
+     that do not otherwise return values, such as declarations,
+     loops, IF-THEN's without ELSE's, etc..
+  2) $NoValueMode and $ThrowAwayMode used to be used in situations
+     where Void is now used, and are being phased out completely.
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- Functions which require special handlers (also see end of file)
+
+--% Handlers for map definitions
+
+upDEF t ==
+  -- performs map definitions.  value is thrown away
+  t isnt [op,def,pred,.] => nil
+  v:=addDefMap(['DEF,:def],pred)
+  null(LISTP(def)) or null(def) =>
+    keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
+  mapOp := first def
+  if LISTP(mapOp) then
+    null mapOp =>
+      keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
+    mapOp := first mapOp
+  put(mapOp,'value,v,$e)
+  putValue(op,objNew(voidValue(), $Void))
+  putModeSet(op,[$Void])
+
+--% Handler for package calling and $ constants
+
+upDollar t ==
+  -- Puts "dollar" property in atree node, and calls bottom up
+  t isnt [op,D,form] => nil
+  t2 := t
+  (not $genValue) and or/[CONTAINED(var,D) for var in $localVars] =>
+    keyedMsgCompFailure("S2IS0032",NIL)
+  EQ(D,'Lisp) => upLispCall(op,form)
+  if VECP D and (SIZE(D) > 0) then D := D.0
+  t := evaluateType unabbrev D
+  categoryForm? t =>
+    throwKeyedMsg("S2IE0012", [t])
+  f := getUnname form
+  if f = $immediateDataSymbol then
+    f := objValUnwrap coerceInteractive(getValue form,$OutputForm)
+    if f = '(construct) then f := "nil"
+  ATOM(form) and (f ^= $immediateDataSymbol) and
+    (u := findUniqueOpInDomain(op,f,t)) => u
+  f in '(One Zero true false nil) and constantInDomain?([f],t) =>
+    isPartialMode t => throwKeyedMsg("S2IS0020",NIL)
+    if $genValue then
+      val := wrap getConstantFromDomain([f],t)
+    else val := ['getConstantFromDomain,['LIST,MKQ f],MKQ t]
+    putValue(op,objNew(val,t))
+    putModeSet(op,[t])
+
+  nargs := #rest form
+
+  (ms := upDollarTuple(op, f, t, t2, rest form, nargs)) => ms
+
+  f ^= 'construct and null isOpInDomain(f,t,nargs) =>
+    throwKeyedMsg("S2IS0023",[f,t])
+  if (sig := findCommonSigInDomain(f,t,nargs)) then
+    for x in sig for y in form repeat
+      if x then putTarget(y,x)
+  putAtree(first form,'dollar,t)
+  ms := bottomUp form
+  f in '(One Zero) and PAIRP(ms) and CAR(ms) = $OutputForm =>
+    throwKeyedMsg("S2IS0021",[f,t])
+  putValue(op,getValue first form)
+  putModeSet(op,ms)
+
+
+upDollarTuple(op, f, t, t2, args, nargs) ==
+  -- this function tries to find a tuple function to use
+  nargs = 1 and getUnname first args = "Tuple" => NIL
+  nargs = 1 and (ms := bottomUp first args) and ms is [["Tuple",.]] => NIL
+  null (singles := isOpInDomain(f,t,1)) => NIL
+  tuple := NIL
+  for [[.,arg], :.] in singles while null tuple repeat
+    if arg is ['Tuple,.] then tuple := arg
+  null tuple => NIL
+  [.,D,form] := t2
+  newArg := [mkAtreeNode "Tuple",:args]
+  putTarget(newArg, tuple)
+  ms := bottomUp newArg
+  first ms ^= tuple => NIL
+  form := [first form, newArg]
+  putAtree(first form,'dollar,t)
+  ms := bottomUp form
+  putValue(op,getValue first form)
+  putModeSet(op,ms)
+
+upLispCall(op,t) ==
+  -- process $Lisp calls
+  if atom t then code:=getUnname t else
+    [lispOp,:argl]:= t
+    null functionp lispOp.0 =>
+      throwKeyedMsg("S2IS0024",[lispOp.0])
+    for arg in argl repeat bottomUp arg
+    code:=[getUnname lispOp,
+      :[getArgValue(arg,computedMode arg) for arg in argl]]
+  code :=
+    $genValue => wrap timedEVALFUN code
+    code
+  rt := '(SExpression)
+  putValue(op,objNew(code,rt))
+  putModeSet(op,[rt])
+
+--% Handlers for equation
+
+upequation tree ==
+  -- only handle this if there is a target of Boolean
+  -- this should speed things up a bit
+  tree isnt [op,lhs,rhs] => NIL
+  $Boolean ^= getTarget(op) => NIL
+  null VECP op => NIL
+  -- change equation into '='
+  op.0 := "="
+  bottomUp tree
+
+--% Handler for error
+
+uperror t ==
+  -- when compiling a function, this merely inserts another argument
+  -- which is the name of the function.
+  not $compilingMap => NIL
+  t isnt [op,msg] => NIL
+  msgMs := bottomUp msg
+  msgMs isnt [=$String] => NIL
+  RPLACD(t,[mkAtree object2String $mapName,msg])
+  bottomUp t
+
+--% Handlers for free and local
+
+upfree t ==
+  putValue(t,objNew('(voidValue),$Void))
+  putModeSet(t,[$Void])
+
+uplocal t ==
+  putValue(t,objNew('(voidValue),$Void))
+  putModeSet(t,[$Void])
+
+upfreeWithType(var,type) ==
+  sayKeyedMsg("S2IS0055",['"free",var])
+  var
+
+uplocalWithType(var,type) ==
+  sayKeyedMsg("S2IS0055",['"local",var])
+  var
+
+--% Handlers for has
+
+uphas t ==
+  t isnt [op,type,prop] => nil
+  -- handler for category and attribute queries
+  type :=
+    isLocalVar(type) => ['unabbrev, type]
+    MKQ unabbrev type
+  catCode :=
+    prop := unabbrev prop
+    evaluateType0 prop => ['evaluateType, MKQ prop]
+    MKQ prop
+  code:=['newHasTest,['evaluateType, type], catCode]
+  if $genValue then code := wrap timedEVALFUN code
+  putValue(op,objNew(code,$Boolean))
+  putModeSet(op,[$Boolean])
+
+--hasTest(a,b) ==
+--  newHasTest(a,b)  --see NRUNFAST BOOT
+
+--% Handlers for IF
+
+upIF t ==
+  t isnt [op,cond,a,b] => nil
+  bottomUpPredicate(cond,'"if/when")
+  $genValue => interpIF(op,cond,a,b)
+  compileIF(op,cond,a,b,t)
+
+compileIF(op,cond,a,b,t) ==
+  -- type analyzer for compiled case where types of both branches of
+  --  IF are resolved.
+  ms1 := bottomUp a
+  [m1] := ms1
+  b = 'noBranch =>
+    evalIF(op,rest t,$Void)
+    putModeSet(op,[$Void])
+  b = 'noMapVal =>
+    -- if this was a return statement, we take the mode to be that
+    -- of what is being returned.
+    if getUnname a = 'return then
+      ms1 := bottomUp CADR a
+      [m1] := ms1
+    evalIF(op,rest t,m1)
+    putModeSet(op,ms1)
+  ms2 := bottomUp b
+  [m2] := ms2
+  m:=
+    m2=m1 => m1
+    m2 = $Exit => m1
+    m1 = $Exit => m2
+    if EQCAR(m1,'Symbol) then
+      m1:=getMinimalVarMode(getUnname a,$declaredMode)
+    if EQCAR(m2,'Symbol) then
+      m2:=getMinimalVarMode(getUnname b,$declaredMode)
+    (r := resolveTTAny(m2,m1)) => r
+    rempropI($mapName,'localModemap)
+    rempropI($mapName,'localVars)
+    rempropI($mapName,'mapBody)
+    throwKeyedMsg("S2IS0026",[m2,m1])
+  evalIF(op,rest t,m)
+  putModeSet(op,[m])
+
+evalIF(op,[cond,a,b],m) ==
+  -- generate code form compiled IF
+  elseCode:=
+    b='noMapVal =>
+      [[MKQ true, ['throwKeyedMsg,MKQ "S2IM0018",
+        ['CONS,MKQ object2Identifier $mapName,NIL]]]]
+    b='noBranch =>
+      $lastLineInSEQ => [[MKQ true,['voidValue]]]
+      NIL
+    [[MKQ true,genIFvalCode(b,m)]]
+  code:=['COND,[getArgValue(cond,$Boolean),
+    genIFvalCode(a,m)],:elseCode]
+  triple:= objNew(code,m)
+  putValue(op,triple)
+
+genIFvalCode(t,m) ==
+  -- passes type information down braches of IF statement
+  --  So that coercions can be performed on data at branches of IF.
+  m1 := computedMode t
+  m1=m => getArgValue(t,m)
+  code:=objVal getValue t
+  IFcodeTran(code,m,m1)
+
+IFcodeTran(code,m,m1) ==
+  -- coerces values at branches of IF
+  null code => code
+  code is ['spadThrowBrightly,:.] => code
+  m1 = $Exit => code
+  code isnt ['COND,[p1,a1],[''T,a2]] =>
+    m = $Void => code
+    code' := coerceInteractive(objNew(quote2Wrapped code,m1),m) =>
+      wrapped2Quote objVal code'
+    throwKeyedMsgCannotCoerceWithValue(quote2Wrapped code,m1,m)
+  a1:=IFcodeTran(a1,m,m1)
+  a2:=IFcodeTran(a2,m,m1)
+  ['COND,[p1,a1],[''T,a2]]
+
+interpIF(op,cond,a,b) ==
+  -- non-compiled version of IF type analyzer.  Doesn't resolve accross
+  --  branches of the IF.
+  val:= getValue cond
+  val:= coerceInteractive(val,$Boolean) =>
+    objValUnwrap(val) => upIFgenValue(op,a)
+    EQ(b,'noBranch) =>
+      putValue(op,objNew(voidValue(), $Void))
+      putModeSet(op,[$Void])
+    upIFgenValue(op,b)
+  throwKeyedMsg("S2IS0031",NIL)
+
+upIFgenValue(op,tree) ==
+  -- evaluates tree and transfers the results to op
+  ms:=bottomUp tree
+  val:= getValue tree
+  putValue(op,val)
+  putModeSet(op,ms)
+
+--% Handlers for is
+
+upis t ==
+  t isnt [op,a,pattern] => nil
+  $opIsIs : local := true
+  upisAndIsnt t
+
+upisnt t ==
+  t isnt [op,a,pattern] => nil
+  $opIsIs : local := nil
+  upisAndIsnt t
+
+upisAndIsnt(t:=[op,a,pattern]) ==
+  -- handler for "is" pattern matching
+  mS:= bottomUp a
+  mS isnt [m] =>
+    keyedSystemError("S2GE0016",['"upisAndIsnt",'"non-unique modeset"])
+  putPvarModes(removeConstruct pattern,m)
+  evalis(op,rest t,m)
+  putModeSet(op,[$Boolean])
+
+putPvarModes(pattern,m) ==
+  -- Puts the modes for the pattern variables into $env
+  m isnt ['List,um] => throwKeyedMsg("S2IS0030",NIL)
+  for pvar in pattern repeat
+    IDENTP pvar => (null (pvar=$quadSymbol)) and put(pvar,'mode,um,$env)
+    pvar is ['_:,var] =>
+      null (var=$quadSymbol) and put(var,'mode,m,$env)
+    pvar is ['_=,var] =>
+      null (var=$quadSymbol) and put(var,'mode,um,$env)
+    putPvarModes(pvar,um)
+
+evalis(op,[a,pattern],mode) ==
+  -- actually handles is and isnt
+  if $opIsIs
+    then fun := 'evalIsPredicate
+    else fun := 'evalIsntPredicate
+  if isLocalPred pattern then
+    code:= compileIs(a,pattern)
+  else code:=[fun,getArgValue(a,mode),
+    MKQ pattern,MKQ mode]
+  triple:=
+    $genValue => objNewWrap(timedEVALFUN code,$Boolean)
+    objNew(code,$Boolean)
+  putValue(op,triple)
+
+isLocalPred pattern ==
+  -- returns true if the is predicate is to be compiled
+  for pat in pattern repeat
+    IDENTP pat and isLocalVar(pat) => return true
+    pat is ['_:,var] and isLocalVar(var) => return true
+    pat is ['_=,var] and isLocalVar(var) => return true
+
+compileIs(val,pattern) ==
+  -- produce code for compiled "is" predicate.  makes pattern variables
+  --  into local variables of the function
+  vars:= NIL
+  for pat in CDR pattern repeat
+    IDENTP(pat) and isLocalVar(pat) => vars:=[pat,:vars]
+    pat is ['_:,var] => vars:= [var,:vars]
+    pat is ['_=,var] => vars:= [var,:vars]
+  predCode:=['LET,g:=GENSYM(),['isPatternMatch,
+    getArgValue(val,computedMode val),MKQ removeConstruct pattern]]
+  for var in REMDUP vars repeat
+    assignCode:=[['LET,var,['CDR,['ASSQ,MKQ var,g]]],:assignCode]
+  null $opIsIs =>
+    ['COND,[['EQ,predCode,MKQ 'failed],['SEQ,:assignCode,MKQ 'T]]]
+  ['COND,[['NOT,['EQ,predCode,MKQ 'failed]],['SEQ,:assignCode,MKQ 'T]]]
+
+evalIsPredicate(value,pattern,mode) ==
+  --This function pattern matches value to pattern, and returns
+  --true if it matches, and false otherwise.  As a side effect
+  --if the pattern matches then the bindings given in the pattern
+  --are made
+  pattern:= removeConstruct pattern
+  ^((valueAlist:=isPatternMatch(value,pattern))='failed) =>
+    for [id,:value] in valueAlist repeat
+      evalLETchangeValue(id,objNewWrap(value,get(id,'mode,$env)))
+    true
+  false
+
+evalIsntPredicate(value,pattern,mode) ==
+  evalIsPredicate(value,pattern,mode) => NIL
+  'TRUE
+
+removeConstruct pat ==
+  -- removes the "construct" from the beginning of patterns
+  if pat is ['construct,:p] then pat:=p
+  if pat is ['cons, a, b] then pat := [a, ['_:, b]]
+  atom pat => pat
+  RPLACA(pat,removeConstruct CAR pat)
+  RPLACD(pat,removeConstruct CDR pat)
+  pat
+
+isPatternMatch(l,pats) ==
+  -- perform the actual pattern match
+  $subs: local := NIL
+  isPatMatch(l,pats)
+  $subs
+
+isPatMatch(l,pats) ==
+  null pats =>
+    null l => $subs
+    $subs:='failed
+  null l =>
+    null pats => $subs
+    pats is [['_:,var]] =>
+      $subs := [[var],:$subs]
+    $subs:='failed
+  pats is [pat,:restPats] =>
+    IDENTP pat =>
+      $subs:=[[pat,:first l],:$subs]
+      isPatMatch(rest l,restPats)
+    pat is ['_=,var] =>
+      p:=ASSQ(var,$subs) =>
+        CAR l = CDR p => isPatMatch(rest l, restPats)
+        $subs:='failed
+      $subs:='failed
+    pat is ['_:,var] =>
+      n:=#restPats
+      m:=#l-n
+      m<0 => $subs:='failed
+      ZEROP n => $subs:=[[var,:l],:$subs]
+      $subs:=[[var,:[x for x in l for i in 1..m]],:$subs]
+      isPatMatch(DROP(m,l),restPats)
+    isPatMatch(first l,pat) = 'failed => 'failed
+    isPatMatch(rest l,restPats)
+  keyedSystemError("S2GE0016",['"isPatMatch",
+     '"unknown form of is predicate"])
+
+--% Handler for iterate
+
+upiterate t ==
+  null $repeatBodyLabel => throwKeyedMsg("S2IS0029",['"iterate"])
+  $iterateCount := $iterateCount + 1
+  code := ['THROW,$repeatBodyLabel,'(voidValue)]
+  $genValue => THROW(eval $repeatBodyLabel,voidValue())
+  putValue(t,objNew(code,$Void))
+  putModeSet(t,[$Void])
+
+--% Handler for break
+
+upbreak t ==
+  t isnt [op,.] => nil
+  null $repeatLabel => throwKeyedMsg("S2IS0029",['"break"])
+  $breakCount := $breakCount + 1
+  code := ['THROW,$repeatLabel,'(voidValue)]
+  $genValue => THROW(eval $repeatLabel,voidValue())
+  putValue(op,objNew(code,$Void))
+  putModeSet(op,[$Void])
+
+--% Handlers for LET
+
+upLET t ==
+  -- analyzes and evaluates the righthand side, and does the variable
+  -- binding
+  t isnt [op,lhs,rhs] => nil
+  $declaredMode: local := NIL
+  PAIRP lhs =>
+    var:= getUnname first lhs
+    var = 'construct => upLETWithPatternOnLhs t
+    var = 'QUOTE => throwKeyedMsg("S2IS0027",['"A quoted form"])
+    upLETWithFormOnLhs(op,lhs,rhs)
+  var:= getUnname lhs
+  var = $immediateDataSymbol =>
+    -- following will be immediate data, so probably ok to not
+    -- specially format it
+    obj := objValUnwrap coerceInteractive(getValue lhs,$OutputForm)
+    throwKeyedMsg("S2IS0027",[obj])
+  var in '(% %%) =>               -- for history
+    throwKeyedMsg("S2IS0027",[var])
+  (IDENTP var) and not (var in '(true false elt QUOTE)) =>
+    var ^= (var' := unabbrev(var)) =>  -- constructor abbreviation
+      throwKeyedMsg("S2IS0028",[var,var'])
+    if get(var,'isInterpreterFunction,$e) then
+      putHist(var,'isInterpreterFunction,false,$e)
+      sayKeyedMsg("S2IS0049",['"Function",var])
+    else if get(var,'isInterpreterRule,$e) then
+      putHist(var,'isInterpreterRule,false,$e)
+      sayKeyedMsg("S2IS0049",['"Rule",var])
+    not isTupleForm(rhs) and (m := isType rhs) => upLETtype(op,lhs,m)
+    transferPropsToNode(var,lhs)
+    if ( m:= getMode(lhs) ) then
+      $declaredMode := m
+      putTarget(rhs,m)
+    if (val := getValue lhs) and (objMode val = $Boolean) and
+      getUnname(rhs) = 'equation then putTarget(rhs,$Boolean)
+    (rhsMs:= bottomUp rhs) = [$Void] =>
+      throwKeyedMsg("S2IS0034",[var])
+    val:=evalLET(lhs,rhs)
+    putValue(op,val)
+    putModeSet(op,[objMode(val)])
+  throwKeyedMsg("S2IS0027",[var])
+
+isTupleForm f ==
+    -- have to do following since "Tuple" is an internal form name
+    getUnname f ^= "Tuple" => false
+    f is [op,:args] and VECP(op) and getUnname(op) = "Tuple" =>
+        #args ^= 1 => true
+        isTupleForm first args => true
+        isType first args => false
+        true
+    false
+
+evalLET(lhs,rhs) ==
+  -- lhs is a vector for a variable, and rhs is the evaluated atree
+  --  for the value which is coerced to the mode of lhs
+  $useConvertForCoercions: local := true
+  v' := (v:= getValue rhs)
+  ((not getMode lhs) and (getModeSet rhs is [.])) or
+    get(getUnname lhs,'autoDeclare,$env) =>
+      v:=
+        $genValue => v
+        objNew(wrapped2Quote objVal v,objMode v)
+      evalLETput(lhs,v)
+  t1:= objMode v
+  t2' := (t2 := getMode lhs)
+  value:=
+    t1 = t2 =>
+      $genValue => v
+      objNew(wrapped2Quote objVal v,objMode v)
+    if isPartialMode t2 then
+      if EQCAR(t1,'Symbol) and $declaredMode then
+        t1:= getMinimalVarMode(objValUnwrap v,$declaredMode)
+      t' := t2
+      null (t2 := resolveTM(t1,t2)) =>
+        if not t2 then t2 := t'
+        throwKeyedMsg("S2IS0035",[t1,t2])
+    null (v := getArgValue(rhs,t2)) =>
+      isWrapped(objVal v') and (v2:=coerceInteractive(v',$OutputForm)) =>
+        throwKeyedMsg("S2IS0036",[objValUnwrap v2,t2])
+      throwKeyedMsg("S2IS0037",[t2])
+    t2 and objNew(($genValue => wrap timedEVALFUN v ; v),t2)
+  value => evalLETput(lhs,value)
+  throwKeyedMsgCannotCoerceWithValue(objVal v,t1,getMode lhs)
+
+evalLETput(lhs,value) ==
+  -- put value into the cell for lhs
+  name:= getUnname lhs
+  if not $genValue then
+    code:=
+      isLocalVar(name) =>
+        om := objMode(value)
+        dm := get(name,'mode,$env)
+        dm and not ((om = dm) or isSubDomain(om,dm) or
+          isSubDomain(dm,om)) =>
+            compFailure ['"   The type of the local variable",
+              :bright name,'"has changed in the computation."]
+        if dm and isSubDomain(dm,om) then put(name,'mode,om,$env)
+        ['LET,name,objVal value,$mapName]
+               -- $mapName is set in analyzeMap
+      om := objMode value
+      dm := get(name, 'mode, $env) or objMode(get(name, 'value, $e))
+      dm and (null $compilingMap) and not(om = dm) and not(isSubDomain(om, dm)) =>
+        THROW('loopCompiler,'tryInterpOnly)
+      ['unwrap,['evalLETchangeValue,MKQ name,
+        objNewCode(['wrap,objVal value],objMode value)]]
+    value:= objNew(code,objMode value)
+    isLocalVar(name) =>
+      if not get(name,'mode,$env) then put(name,'autoDeclare,'T,$env)
+      put(name,'mode,objMode(value),$env)
+    put(name,'automode,objMode(value),$env)
+  $genValue and evalLETchangeValue(name,value)
+  putValue(lhs,value)
+
+upLETWithPatternOnLhs(t := [op,pattern,a]) ==
+  $opIsIs : local := true
+  [m] := bottomUp a
+  putPvarModes(pattern,m)
+  object := evalis(op,[a,pattern],m)
+  -- have to change code to return value of a
+  failCode :=
+    ['spadThrowBrightly,['concat,
+      '"   Pattern",['QUOTE,bright form2String pattern],
+        '"is not matched in assignment to right-hand side."]]
+  if $genValue
+    then
+      null objValUnwrap object => eval failCode
+      putValue(op,getValue a)
+    else
+      code := ['COND,[objVal object,objVal getValue a],[''T,failCode]]
+      putValue(op,objNew(code,m))
+  putModeSet(op,[m])
+
+evalLETchangeValue(name,value) ==
+  -- write the value of name into the environment, clearing dependent
+  --  maps if its type changes from its last value
+  localEnv := PAIRP $env
+  clearCompilationsFlag :=
+    val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e)
+    null val =>
+      not ((localEnv and get(name,'mode,$env)) or get(name,'mode,$e))
+    objMode val ^= objMode(value)
+  if clearCompilationsFlag then
+    clearDependencies(name,true)
+  if localEnv and isLocalVar(name)
+    then $env:= putHist(name,'value,value,$env)
+    else putIntSymTab(name,'value,value,$e)
+  objVal value
+
+upLETWithFormOnLhs(op,lhs,rhs) ==
+  -- bottomUp for assignment to forms (setelt, table or tuple)
+  lhs' := getUnnameIfCan lhs
+  rhs' := getUnnameIfCan rhs
+  lhs' = 'Tuple =>
+    rhs' ^= 'Tuple => throwKeyedMsg("S2IS0039",NIL)
+    #(lhs) ^= #(rhs) => throwKeyedMsg("S2IS0038",NIL)
+    -- generate a sequence of assignments, using local variables
+    -- to first hold the assignments so that things like
+    -- (t1,t2) := (t2,t1) will work.
+    seq := []
+    temps := [GENSYM() for l in rest lhs]
+    for lvar in temps repeat mkLocalVar($mapName,lvar)
+    for l in reverse rest lhs for t in temps repeat
+      transferPropsToNode(getUnname l,l)
+      let := mkAtreeNode 'LET
+      t'  := mkAtreeNode t
+      if m := getMode(l) then putMode(t',m)
+      seq := cons([let,l,t'],seq)
+    for t in temps for r in reverse rest rhs
+      for l in reverse rest lhs repeat
+        let := mkAtreeNode 'LET
+        t'  := mkAtreeNode t
+        if m := getMode(l) then putMode(t',m)
+        seq := cons([let,t',r],seq)
+    seq := cons(mkAtreeNode 'SEQ,seq)
+    ms := bottomUp seq
+    putValue(op,getValue seq)
+    putModeSet(op,ms)
+  rhs' = 'Tuple => throwKeyedMsg("S2IS0039",NIL)
+  tree:= seteltable(lhs,rhs) => upSetelt(op,lhs,tree)
+  throwKeyedMsg("S2IS0060", NIL)
+--  upTableSetelt(op,lhs,rhs)
+
+seteltable(lhs is [f,:argl],rhs) ==
+  -- produces the setelt form for trees such as "l.2:= 3"
+  null (g := getUnnameIfCan f) => NIL
+  EQ(g,'elt) => altSeteltable [:argl, rhs]
+  get(g,'value,$e) is [expr,:.] and isMapExpr expr => NIL
+  transferPropsToNode(g,f)
+  getValue(lhs) or getMode(lhs) =>
+    f is [f',:argl'] => altSeteltable [f',:argl',:argl,rhs]
+    altSeteltable [:lhs,rhs]
+  NIL
+
+altSeteltable args ==
+    for x in args repeat bottomUp x
+    newOps := [mkAtreeNode "setelt", mkAtreeNode "set!"]
+    form := NIL
+
+    -- first look for exact matches for any of the possibilities
+    while ^form for newOp in newOps  repeat
+        if selectMms(newOp, args, NIL) then form := [newOp, :args]
+
+    -- now try retracting arguments after the first
+    while ^form and ( "and"/[retractAtree(a) for a in rest args] ) repeat
+        while ^form for newOp in newOps  repeat
+            if selectMms(newOp, args, NIL) then form := [newOp, :args]
+
+    form
+
+
+upSetelt(op,lhs,tree) ==
+  -- type analyzes implicit setelt forms
+  var:=opOf lhs
+  transferPropsToNode(getUnname var,var)
+  if (m1:=getMode var) then $declaredMode:= m1
+  if m1 or ((v1 := getValue var) and (m1 := objMode v1)) then
+    putModeSet(var,[m1])
+  ms := bottomUp tree
+  putValue(op,getValue tree)
+  putModeSet(op,ms)
+
+upTableSetelt(op,lhs is [htOp,:args],rhs) ==
+  -- called only for undeclared, uninitialized table setelts
+  ("*" = (PNAME getUnname htOp).0) and (1 ^= # args) =>
+    throwKeyedMsg("S2IS0040",NIL)
+  # args ^= 1 =>
+    throwKeyedMsg("S2IS0041",[[getUnname htOp,'".[",
+      getUnname first args,
+        ['",",getUnname arg for arg in rest args],'"]"]])
+  keyMode := '(Any)
+  putMode (htOp,['Table,keyMode,'(Any)])
+  -- if we are to use a new table, we must call the "table"
+  -- function to give it an initial value.
+  bottomUp [mkAtreeNode 'LET,htOp,[mkAtreeNode 'table]]
+  tableCode := objVal getValue htOp
+  r := upSetelt(op, lhs, [mkAtreeNode 'setelt,:lhs,rhs])
+  $genValue => r
+  -- construct code
+  t := getValue op
+  putValue(op,objNew(['PROGN,tableCode,objVal t],objMode t))
+  r
+
+isType t ==
+  -- Returns the evaluated type if t is a tree representing a type,
+  -- and NIL otherwise
+   op:=opOf t
+   VECP op =>
+     isMap(op:= getUnname op) => NIL
+     op = 'Mapping =>
+       argTypes := [isType type for type in rest t]
+       "or"/[null type for type in argTypes] => nil
+       ['Mapping, :argTypes]
+     isLocalVar(op) => NIL
+     d := isDomainValuedVariable op => d
+     type:=
+       -- next line handles subscripted vars
+         (abbreviation?(op) or (op = 'typeOf) or
+           constructor?(op) or (op in '(Record Union Enumeration))) and
+             unabbrev unVectorize t
+     type and evaluateType type
+   d := isDomainValuedVariable op => d
+   NIL
+
+upLETtype(op,lhs,type) ==
+  -- performs type assignment
+  opName:= getUnname lhs
+  (not $genValue) and or/[CONTAINED(var,type) for var in $localVars] =>
+    compFailure ['"   Cannot compile type assignment to",:bright opName]
+  mode :=
+    if isPartialMode type then '(Mode)
+    else if categoryForm?(type) then '(SubDomain (Domain))
+         else '(Domain)
+  val:= objNew(type,mode)
+  if isLocalVar(opName) then put(opName,'value,val,$env)
+  else putHist(opName,'value,val,$e)
+  putValue(op,val)
+  -- have to fix the following
+  putModeSet(op,[mode])
+
+assignSymbol(symbol, value, domain) ==
+-- Special function for binding an interpreter variable from within algebra
+-- code.  Does not do the assignment and returns nil, if the variable is
+-- already assigned
+  val := get(symbol, 'value, $e) => nil
+  obj := objNew(wrap value, devaluate domain)
+  put(symbol, 'value, obj, $e)
+  true
+
+--% Handler for Interpreter Macros
+
+getInterpMacroNames() ==
+  names := [n for [n,:.] in $InterpreterMacroAlist]
+  if (e := CAAR $InteractiveFrame) and (m := ASSOC("--macros--",e)) then
+    names := append(names,[n for [n,:.] in CDR m])
+  MSORT names
+
+isInterpMacro name ==
+  -- look in local and then global environment for a macro
+  null IDENTP name => NIL
+  name in $specialOps => NIL
+  (m := get("--macros--",name,$env)) => m
+  (m := get("--macros--",name,$e))   => m
+  (m := get("--macros--",name,$InteractiveFrame))   => m
+  -- $InterpreterMacroAlist will probably be phased out soon
+  (sv := ASSOC(name,$InterpreterMacroAlist)) => CONS(NIL,CDR sv)
+  NIL
+
+--% Handlers for prefix QUOTE
+
+upQUOTE t ==
+  t isnt [op,expr] => NIL
+  ms:= list
+    m:= getBasicMode expr => m
+    IDENTP expr =>
+--    $useSymbolNotVariable => $Symbol
+      ['Variable,expr]
+    $OutputForm
+  evalQUOTE(op,[expr],ms)
+  putModeSet(op,ms)
+
+evalQUOTE(op,[expr],[m]) ==
+  triple:=
+    $genValue => objNewWrap(expr,m)
+    objNew(['QUOTE,expr],m)
+  putValue(op,triple)
+
+--% Handler for pretend
+
+uppretend t ==
+  t isnt [op,expr,type] => NIL
+  mode := evaluateType unabbrev type
+  not isValidType(mode) => throwKeyedMsg("S2IE0004",[mode])
+  bottomUp expr
+  putValue(op,objNew(objVal getValue expr,mode))
+  putModeSet(op,[mode])
+
+--% Handlers for REDUCE
+
+getReduceFunction(op,type,result, locale) ==
+  -- return the function cell for operation with the signature
+  --  (type,type) -> type, possible from locale
+  if type is ['Variable,var] then
+    args := [arg := mkAtreeNode var,arg]
+    putValue(arg,objNewWrap(var,type))
+  else
+    args := [arg := mkAtreeNode "%1",arg]
+    if type=$Symbol then putValue(arg,objNewWrap("%1",$Symbol))
+  putModeSet(arg,[type])
+  vecOp:=mkAtreeNode op
+  transferPropsToNode(op,vecOp)
+  if locale then putAtree(vecOp,'dollar,locale)
+  mmS:= selectMms(vecOp,args,result)
+  mm:= or/[mm for (mm:=[[.,:sig],fun,cond]) in mmS |
+    (isHomogeneousArgs sig) and and/[null c for c in cond]]
+  null mm => 'failed
+  [[dc,:sig],fun,:.]:=mm
+  dc='local => [MKQ [fun,:'local],:CAR sig]
+  dcVector := evalDomain dc
+  $compilingMap =>
+    k := NRTgetMinivectorIndex(
+      NRTcompiledLookup(op,sig,dcVector),op,sig,dcVector)
+    ['ELT,"$$$",k]  --$$$ denotes minivector
+  env:=
+    NRTcompiledLookup(op,sig,dcVector)
+  MKQ env
+
+isHomogeneous sig ==
+  --return true if sig describes a homogeneous binary operation
+  sig.0=sig.1 and sig.1=sig.2
+
+isHomogeneousArgs sig ==
+  --return true if sig describes a homogeneous binary operation
+  sig.1=sig.2
+
+--% Handlers for REPEAT
+
+transformREPEAT [:itrl,body] ==
+  -- syntactic transformation of repeat iterators, called from mkAtree2
+  iterList:=[:iterTran1 for it in itrl] where iterTran1 ==
+    it is ['STEP,index,lower,step,:upperList] =>
+      [['STEP,index,mkAtree1 lower,mkAtree1 step,:[mkAtree1 upper
+        for upper in upperList]]]
+    it is ['IN,index,s] =>
+      [['IN,index,mkAtree1 s]]
+    it is ['ON,index,s] =>
+      [['IN,index,mkAtree1 ['tails,s]]]
+    it is ['WHILE,b] =>
+      [['WHILE,mkAtree1 b]]
+    it is ['_|,pred] =>
+      [['SUCHTHAT,mkAtree1 pred]]
+    it is [op,:.] and (op in '(VALUE UNTIL)) => nil
+  bodyTree:=mkAtree1 body
+  iterList:=NCONC(iterList,[:iterTran2 for it in itrl]) where iterTran2 ==
+    it is ['STEP,:.] => nil
+    it is ['IN,:.] => nil
+    it is ['ON,:.] => nil
+    it is ['WHILE,:.] => nil
+    it is [op,b] and (op in '(UNTIL VALUE)) =>
+      [[op,mkAtree1 b]]
+    it is ['_|,pred] => nil
+    keyedSystemError("S2GE0016",
+      ['"transformREPEAT",'"Unknown type of iterator"])
+  [:iterList,bodyTree]
+
+upREPEAT t ==
+  -- REPEATS always return void() of Void
+  -- assures throw to interpret-code mode goes to outermost loop
+  $repeatLabel : local := MKQ GENSYM()
+  $breakCount  : local := 0
+  $repeatBodyLabel : local := MKQ GENSYM()
+  $iterateCount    : local := 0
+  $compilingLoop => upREPEAT1 t
+  upREPEAT0 t
+
+upREPEAT0 t ==
+  -- sets up catch point for interp-only mode
+  $compilingLoop: local := true
+  ms := CATCH('loopCompiler,upREPEAT1 t)
+  ms = 'tryInterpOnly => interpOnlyREPEAT t
+  ms
+
+upREPEAT1 t ==
+  -- repeat loop handler with compiled body
+  -- see if it has the expected form
+  t isnt [op,:itrl,body] => NIL
+  -- determine the mode of the repeat loop. At the moment, if there
+  -- there are no iterators and there are no "break" statements, then
+  -- the return type is Exit, otherwise Void.
+  repeatMode :=
+    null(itrl) and ($breakCount=0) => $Void
+    $Void
+
+  -- if interpreting, go do that
+  $interpOnly => interpREPEAT(op,itrl,body,repeatMode)
+
+  -- analyze iterators and loop body
+  upLoopIters itrl
+  bottomUpCompile body
+
+  -- now that the body is analyzed, we should know everything that
+  -- is in the UNTIL clause
+  for itr in itrl repeat
+    itr is ['UNTIL, pred] => bottomUpCompilePredicate(pred,'"until")
+
+  -- now go do it
+  evalREPEAT(op,rest t,repeatMode)
+  putModeSet(op,[repeatMode])
+
+evalREPEAT(op,[:itrl,body],repeatMode) ==
+  -- generate code for loop
+  bodyMode := computedMode body
+  bodyCode := getArgValue(body,bodyMode)
+  if $iterateCount > 0 then
+    bodyCode := ['CATCH,$repeatBodyLabel,bodyCode]
+  code := ['REPEAT,:[evalLoopIter itr for itr in itrl], bodyCode]
+  if repeatMode = $Void then code := ['OR,code,'(voidValue)]
+  code := timedOptimization code
+  if $breakCount > 0 then code := ['CATCH,$repeatLabel,code]
+  val:=
+    $genValue =>
+      timedEVALFUN code
+      objNewWrap(voidValue(),repeatMode)
+    objNew(code,repeatMode)
+  putValue(op,val)
+
+interpOnlyREPEAT t ==
+  -- interpret-code mode call to upREPEAT
+  $genValue: local := true
+  $interpOnly: local := true
+  upREPEAT1 t
+
+interpREPEAT(op,itrl,body,repeatMode) ==
+  -- performs interpret-code repeat
+  $indexVars: local := NIL
+  $indexTypes: local := NIL
+  code :=
+      -- we must insert a CATCH for the iterate clause
+      ['REPEAT,:[interpIter itr for itr in itrl],
+        ['CATCH,$repeatBodyLabel,interpLoop(body,$indexVars,
+          $indexTypes,nil)]]
+  SPADCATCH(eval $repeatLabel,timedEVALFUN code)
+  val:= objNewWrap(voidValue(),repeatMode)
+  putValue(op,val)
+  putModeSet(op,[repeatMode])
+
+interpLoop(expr,indexList,indexTypes,requiredType) ==
+  -- generates code for interp-only repeat body
+  ['interpLoopIter,MKQ expr,MKQ indexList,['LIST,:indexList],
+    MKQ indexTypes, MKQ requiredType]
+
+interpLoopIter(exp,indexList,indexVals,indexTypes,requiredType) ==
+  -- call interpreter on exp with loop vars in indexList with given
+  --  values and types, requiredType is used from interpCOLLECT
+  --  to indicate the required type of the result
+  emptyAtree exp
+  for i in indexList for val in indexVals for type in indexTypes repeat
+    put(i,'value,objNewWrap(val,type),$env)
+  bottomUp exp
+  v:= getValue exp
+  val :=
+    null requiredType => v
+    coerceInteractive(v,requiredType)
+  null val =>
+    throwKeyedMsgCannotCoerceWithValue(objVal v,objMode v,requiredType)
+  objValUnwrap val
+
+--% Handler for return
+
+upreturn t ==
+  -- make sure we are in a user function
+  t isnt [op,val] => NIL
+  (null $compilingMap) and (null $interpOnly) =>
+    throwKeyedMsg("S2IS0047",NIL)
+  if $mapTarget then putTarget(val,$mapTarget)
+  bottomUp val
+  if $mapTarget
+    then
+      val' := getArgValue(val, $mapTarget)
+      m := $mapTarget
+    else
+      val' := wrapped2Quote objVal getValue val
+      m := computedMode val
+  cn := mapCatchName $mapName
+  $mapReturnTypes := insert(m, $mapReturnTypes)
+  $mapThrowCount := $mapThrowCount + 1
+  -- if $genValue then we are interpreting the map
+  $genValue => THROW(cn,objNewWrap(removeQuote val',m))
+  putValue(op,objNew(['THROW,MKQ cn,val'],m))
+  putModeSet(op,[$Exit])
+
+--% Handler for SEQ
+
+upSEQ u ==
+  -- assumes that exits were translated into if-then-elses
+  -- handles flat SEQs and embedded returns
+  u isnt [op,:args] => NIL
+  if (target := getTarget(op)) then putTarget(last args, target)
+  for x in args repeat bottomUp x
+  null (m := computedMode last args) =>
+    keyedSystemError("S2GE0016",['"upSEQ",
+      '"last line of SEQ has no mode"])
+  evalSEQ(op,args,m)
+  putModeSet(op,[m])
+
+evalSEQ(op,args,m) ==
+  -- generate code for SEQ
+  [:argl,last] := args
+  val:=
+    $genValue => getValue last
+    bodyCode := nil
+    for x in args repeat
+      (m1 := computedMode x) and (m1 ^= '$ThrowAwayMode) =>
+        (av := getArgValue(x,m1)) ^= voidValue() =>
+          bodyCode := [av,:bodyCode]
+    code:=
+      bodyCode is [c] => c
+      ['PROGN,:reverse bodyCode]
+    objNew(code,m)
+  putValue(op,val)
+
+--% Handlers for Tuple
+
+upTuple t ==
+  --Computes the common mode set of the construct by resolving across
+  --the argument list, and evaluating
+  t isnt [op,:l] => nil
+  dol := getAtree(op,'dollar)
+  tar := getTarget(op) or dol
+  null l => upNullTuple(op,l,tar)
+  isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar)
+  aggs := '(List)
+  if tar and PAIRP(tar) and ^isPartialMode(tar) then
+    CAR(tar) in aggs =>
+      ud := CADR tar
+      for x in l repeat if not getTarget(x) then putTarget(x,ud)
+    CAR(tar) in '(Matrix SquareMatrix RectangularMatrix) =>
+      vec := ['List,underDomainOf tar]
+      for x in l repeat if not getTarget(x) then putTarget(x,vec)
+  argModeSetList:= [bottomUp x for x in l]
+  eltTypes := replaceSymbols([first x for x in argModeSetList],l)
+  if not isPartialMode(tar) and tar is ['Tuple,ud] then
+    mode := ['Tuple, resolveTypeListAny cons(ud,eltTypes)]
+  else mode := ['Tuple, resolveTypeListAny eltTypes]
+  if isPartialMode tar then tar:=resolveTM(mode,tar)
+  evalTuple(op,l,mode,tar)
+
+evalTuple(op,l,m,tar) ==
+  [agg,:.,underMode]:= m
+  code := asTupleNewCode(#l,
+    [(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l])
+  val :=
+    $genValue => objNewWrap(timedEVALFUN code,m)
+    objNew(code,m)
+  if tar then val1 := coerceInteractive(val,tar) else val1 := val
+
+  val1 =>
+    putValue(op,val1)
+    putModeSet(op,[tar or m])
+  putValue(op,val)
+  putModeSet(op,[m])
+
+upNullTuple(op,l,tar) ==
+  -- handler for the empty tuple
+  defMode :=
+    tar and tar is [a,b] and (a in '(Stream Vector List)) and
+      not isPartialMode(b) => ['Tuple,b]
+    '(Tuple (None))
+  val := objNewWrap(asTupleNew(0,NIL), defMode)
+  tar and not isPartialMode(tar) =>
+    null (val' := coerceInteractive(val,tar)) =>
+      throwKeyedMsg("S2IS0013",[tar])
+    putValue(op,val')
+    putModeSet(op,[tar])
+  putValue(op,val)
+  putModeSet(op,[defMode])
+
+--% Handler for typeOf
+
+uptypeOf form ==
+  form isnt [op, arg] => NIL
+  if VECP arg then transferPropsToNode(getUnname arg,arg)
+  if m := isType(arg) then
+    m :=
+      categoryForm?(m) => '(SubDomain (Domain))
+      isPartialMode m  => '(Mode)
+      '(Domain)
+  else if not (m := getMode arg) then [m] := bottomUp arg
+  t := typeOfType m
+  putValue(op, objNew(m,t))
+  putModeSet(op,[t])
+
+typeOfType type ==
+  type in '((Mode) (Domain)) => '(SubDomain (Domain))
+  '(Domain)
+
+--% Handler for where
+
+upwhere t ==
+  -- upwhere does the puts in where into a local environment
+  t isnt [op,tree,clause] => NIL
+  -- since the "clause" might be a local macro, we now call mkAtree
+  -- on the "tree" part (it is not yet a vat)
+  not $genValue =>
+    compFailure [:bright '"  where",
+      '"for compiled code is not yet implemented."]
+  $whereCacheList : local := nil
+  [env,:e] := upwhereClause(clause,$env,$e)
+  tree := upwhereMkAtree(tree,env,e)
+  if x := getAtree(op,'dollar) then
+    atom tree => throwKeyedMsg("S2IS0048",NIL)
+    putAtree(CAR tree,'dollar,x)
+  upwhereMain(tree,env,e)
+  val := getValue tree
+  putValue(op,val)
+  result := putModeSet(op,getModeSet tree)
+  wcl := [op for op in $whereCacheList]
+  for op in wcl repeat clearDependencies(op,'T)
+  result
+
+upwhereClause(tree,env,e) ==
+  -- uses the variable bindings from env and e and returns an environment
+  -- of its own bindings
+  $env: local := copyHack env
+  $e: local := copyHack e
+  bottomUp tree
+  [$env,:$e]
+
+upwhereMkAtree(tree,$env,$e) == mkAtree tree
+
+upwhereMain(tree,$env,$e) ==
+  -- uses local copies of $env and $e while evaluating tree
+  bottomUp tree
+
+copyHack(env) ==
+  -- makes a copy of an environment with the exception of pairs
+  -- (localModemap . something)
+  c:= CAAR env
+  d:= [fn p for p in c] where fn(p) ==
+    CONS(CAR p,[(EQCAR(q,'localModemap) => q; copy q) for q in CDR p])
+  [[d]]
+
+-- Creates the function names of the special function handlers and puts
+--  them on the property list of the function name
+
+EVALANDFILEACTQ
+ (
+   for name in $specialOps repeat
+    (
+      functionName:=INTERNL('up,name) ;
+      MAKEPROP(name,'up,functionName) ;
+      CREATE_-SBC functionName
+     )
+  )
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-syscmd.boot.pamphlet b/src/interp/i-syscmd.boot.pamphlet
new file mode 100644
index 00000000..e846b570
--- /dev/null
+++ b/src/interp/i-syscmd.boot.pamphlet
@@ -0,0 +1,3103 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-syscmd.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+This file contains the BOOT code for the Axiom system command
+and synonym processing facility.  The code for )trace is in the file
+TRACE BOOT.  The list of system commands is $SYSCOMMANDS which is
+initialized in SETQ LISP.
+
+\end{verbatim}
+
+\section{Filenames change}
+
+It appears that probe-file is now case-sensitive. In order to get around
+this we include the file extensions in both upper and lower case in the
+search lists. Lower case names are preferred.
+
+\section{handleNoParseCommands}
+
+The system commands given by the global variable
+[[|$noParseCommands|]]\cite{1} require essentially no
+preprocessing/parsing of their arguments. Here we dispatch the
+functions which implement these commands.
+
+There are four standard commands which receive arguments -- [[lisp]],
+[[synonym]], [[system]] and [[boot]]. There are five standard commands
+which do not receive arguments -- [[quit]], [[fin]], [[pquit]],
+[[credits]] and [[copyright]]. As these commands do not necessarily
+exhaust those mentioned in [[|$noParseCommands|]], we provide a
+generic dispatch based on two conventions: commands which do not
+require an argument name themselves, those which do have their names
+prefixed by [[np]].
+
+<<handleNoParseCommands>>=
+handleNoParseCommands(unab, string) ==
+  string := stripSpaces string
+  spaceIndex := SEARCH('" ", string)
+  unab = "lisp" =>
+    if (null spaceIndex) then
+      sayKeyedMsg("S2IV0005", NIL)
+      nil
+    else nplisp(stripLisp string)
+  unab = "boot" =>
+    if (null spaceIndex) then
+      sayKeyedMsg("S2IV0005", NIL)
+      nil
+    else npboot(SUBSEQ(string, spaceIndex+1))
+  unab = "system" =>
+    if (null spaceIndex) then
+      sayKeyedMsg("S2IV0005", NIL)
+      nil
+    else npsystem(unab, string)
+  unab = "synonym" =>
+    npsynonym(unab, (null spaceIndex => '""; SUBSEQ(string, spaceIndex+1)))
+  null spaceIndex =>
+    FUNCALL unab
+  member(unab, '( quit     _
+                  fin      _
+		  pquit    _
+		  credits  _
+		  copyright )) => 
+    sayKeyedMsg("S2IV0005", NIL)
+    nil
+  funName := INTERN CONCAT('"np",STRING unab)
+  FUNCALL(funName, SUBSEQ(string, spaceIndex+1))
+
+@
+\section{TRUENAME change}
+This change was made to make the open source Axiom work with the 
+new aldor compiler.z
+This used to read:
+\begin{verbatim}
+     STRCONC(TRUENAME(STRCONC(GETENV('"AXIOM"),'"/compiler/bin/")),"axiomxl ", asharpArgs, '" ", namestring args)
+\end{verbatim}
+but now reads:
+<<remove TRUENAME>>=
+     STRCONC(STRCONC(GETENV('"ALDORROOT"),'"/bin/"),_
+               "aldor ", asharpArgs, '" ", namestring args)
+@
+Notice that we've introduced the [[ALDORROOT]] shell variable.
+This will have to be pushed down from the top level Makefile.
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Utility Variable Initializations
+
+SETANDFILEQ($cacheAlist,nil)
+SETANDFILEQ($reportCompilation,nil)
+SETANDFILEQ($compileRecurrence,true)
+SETANDFILEQ($errorReportLevel,'warning)
+SETANDFILEQ($sourceFileTypes,'(INPUT SPAD BOOT LISP LISP370 META))
+
+SETANDFILEQ($SYSCOMMANDS,[CAR x for x in $systemCommands])
+
+
+SETANDFILEQ($whatOptions, '( _
+    operations _
+    categories _
+    domains _
+    packages _
+    commands _
+    synonyms _
+    things _
+    ))
+
+SETANDFILEQ($clearOptions, '( _
+  modes _
+  operations _
+  properties _
+  types _
+  values  _
+  ))
+
+SETANDFILEQ($displayOptions, '( _
+  abbreviations _
+  all _
+  macros _
+  modes _
+  names _
+  operations  _
+  properties _
+  types _
+  values _
+  ))
+
+SETANDFILEQ($countAssoc,'( (cache countCache) ))
+
+--% Top level system command
+
+initializeSystemCommands() ==
+  l := $systemCommands
+  $SYSCOMMANDS := NIL
+  while l repeat
+    $SYSCOMMANDS := CONS(CAAR l, $SYSCOMMANDS)
+    l := CDR l
+  $SYSCOMMANDS := NREVERSE $SYSCOMMANDS
+
+systemCommand [[op,:argl],:options] ==
+  $options: local:= options
+  $e:local := $CategoryFrame
+  fun := selectOptionLC(op,$SYSCOMMANDS,'commandError)
+  argl and (argl.0 = '_?) and fun ^= 'synonym =>
+    helpSpad2Cmd [fun]
+  fun := selectOption(fun,commandsForUserLevel $systemCommands,
+    'commandUserLevelError)
+  FUNCALL(fun, argl)
+
+commandsForUserLevel l == --[a for [a,:b] in l | satisfiesUserLevel(a)]
+  c := nil
+  for [a,:b] in l repeat
+    satisfiesUserLevel b => c := [a,:c]
+  reverse c
+
+synonymsForUserLevel l ==
+  -- l is a list of synonyms, and this returns a sublist of applicable
+  -- synonyms at the current user level.
+  $UserLevel = 'development => l
+  nl := NIL
+  for syn in reverse l repeat
+    cmd := STRING2ID_-N(CDR syn,1)
+    null selectOptionLC(cmd,commandsForUserLevel
+      $systemCommands,NIL) => nil
+    nl := [syn,:nl]
+  nl
+
+satisfiesUserLevel x ==
+  x          = 'interpreter => true
+  $UserLevel = 'interpreter => false
+  x          = 'compiler    => true
+  $UserLevel = 'compiler    => false
+  true
+
+unAbbreviateKeyword x ==
+  x' :=selectOptionLC(x,$SYSCOMMANDS,'commandErrorIfAmbiguous)
+  if not x' then
+    x' := 'system
+    SETQ(LINE, CONCAT('")system ", SUBSTRING(LINE, 1, #LINE-1)))
+    $currentLine := LINE
+  selectOption(x',commandsForUserLevel $systemCommands,
+    'commandUserLevelError)
+
+hasOption(al,opt) ==
+  optPname:= PNAME opt
+  found := NIL
+  for pair in al while not found repeat
+    stringPrefix?(PNAME CAR pair,optPname) => found := pair
+  found
+
+selectOptionLC(x,l,errorFunction) ==
+  selectOption(DOWNCASE object2Identifier x,l,errorFunction)
+
+selectOption(x,l,errorFunction) ==
+  member(x,l) => x                   --exact spellings are always OK
+  null IDENTP x =>
+    errorFunction => FUNCALL(errorFunction,x,u)
+    nil
+  u := [y for y in l | stringPrefix?(PNAME x,PNAME y)]
+  u is [y] => y
+  errorFunction => FUNCALL(errorFunction,x,u)
+  nil
+
+terminateSystemCommand() == TERSYSCOMMAND()
+
+commandUserLevelError(x,u) == userLevelErrorMessage("command",x,u)
+
+optionUserLevelError(x,u) == userLevelErrorMessage("option",x,u)
+
+userLevelErrorMessage(kind,x,u) ==
+  null u =>
+    sayKeyedMsg("S2IZ0007",[$UserLevel,kind])
+    terminateSystemCommand()
+  commandAmbiguityError(kind,x,u)
+
+commandError(x,u) == commandErrorMessage("command",x,u)
+
+optionError(x,u) == commandErrorMessage("option",x,u)
+
+commandErrorIfAmbiguous(x, u) ==
+  null u => nil
+  SETQ($OLDLINE, LINE)
+  commandAmbiguityError("command", x, u)
+
+commandErrorMessage(kind,x,u) ==
+  SETQ ($OLDLINE,LINE)
+  null u =>
+    sayKeyedMsg("S2IZ0008",[kind,x])
+    terminateSystemCommand()
+  commandAmbiguityError(kind,x,u)
+
+commandAmbiguityError(kind,x,u) ==
+  sayKeyedMsg("S2IZ0009",[kind,x])
+  for a in u repeat sayMSG ['"     ",:bright a]
+  terminateSystemCommand()
+
+--% Utility for access to original command line
+
+getSystemCommandLine() ==
+  p := STRPOS('")",$currentLine,0,NIL)
+  line := if p then SUBSTRING($currentLine,p,NIL) else $currentLine
+  maxIndex:= MAXINDEX line
+  for i in 0..maxIndex while (line.i^=" ") repeat index:= i
+  if index=maxIndex then line := '""
+  else line := SUBSTRING(line,index+2,nil)
+  line
+
+------------ start of commands ------------------------------------------
+
+--% )abbreviations
+
+abbreviations l == abbreviationsSpad2Cmd l
+
+abbreviationsSpad2Cmd l ==
+  null l => helpSpad2Cmd '(abbreviations)
+  abopts := '(query domain category package remove)
+
+  quiet := nil
+  for [opt] in $options repeat
+    opt := selectOptionLC(opt,'(quiet),'optionError)
+    opt = 'quiet => quiet := true
+
+  l is [opt,:al] =>
+    key := opOf CAR al
+    type := selectOptionLC(opt,abopts,'optionError)
+    type is 'query =>
+      null al => listConstructorAbbreviations()
+      constructor := abbreviation?(key) => abbQuery(constructor)
+      abbQuery(key)
+    type is 'remove =>
+      DELDATABASE(key,'ABBREVIATION)
+    ODDP SIZE al => sayKeyedMsg("S2IZ0002",[type])
+    repeat
+      null al => return 'fromLoop
+      [a,b,:al] := al
+      mkUserConstructorAbbreviation(b,a,type)
+      SETDATABASE(b,'ABBREVIATION,a)
+      SETDATABASE(b,'CONSTRUCTORKIND,type)
+    null quiet =>
+      sayKeyedMsg("S2IZ0001",[a,type,opOf b])
+      nil
+  nil
+
+listConstructorAbbreviations() ==
+  x := UPCASE queryUserKeyedMsg("S2IZ0056",NIL)
+  MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
+    whatSpad2Cmd '(categories)
+    whatSpad2Cmd '(domains)
+    whatSpad2Cmd '(packages)
+  sayKeyedMsg("S2IZ0057",NIL)
+
+--% )clear
+
+clear l == clearSpad2Cmd l
+
+clearSpad2Cmd l ==
+  -- new version which changes the environment and updates history
+  $clearExcept: local := nil
+  if $options then $clearExcept :=
+    "and"/[selectOptionLC(opt,'(except),'optionError) =
+             'except for [opt,:.] in $options]
+  null l =>
+    optList:= "append"/[['%l,'"       ",x] for x in $clearOptions]
+    sayKeyedMsg("S2IZ0010",[optList])
+  arg := selectOptionLC(first l,'(all completely scaches),NIL)
+  arg = 'all          => clearCmdAll()
+  arg = 'completely   => clearCmdCompletely()
+  arg = 'scaches      => clearCmdSortedCaches()
+  $clearExcept => clearCmdExcept(l)
+  clearCmdParts(l)
+  updateCurrentInterpreterFrame()
+
+clearCmdSortedCaches() ==
+  $lookupDefaults: local := false
+  for [.,.,:domain] in HGET($ConstructorCache,'SortedCache) repeat
+    pair := compiledLookupCheck('clearCache,[$Void],domain)
+    SPADCALL pair
+
+clearCmdCompletely() ==
+  clearCmdAll()
+  $localExposureData := COPY_-SEQ $localExposureDataDefault
+  $xdatabase := NIL
+  $CatOfCatDatabase  := NIL
+  $DomOfCatDatabase  := NIL
+  $JoinOfCatDatabase := NIL
+  $JoinOfDomDatabase := NIL
+  $attributeDb := NIL
+  $functionTable := NIL
+  sayKeyedMsg("S2IZ0013",NIL)
+  clearClams()
+  clearConstructorCaches()
+  $existingFiles := MAKE_-HASHTABLE 'UEQUAL
+  sayKeyedMsg("S2IZ0014",NIL)
+  RECLAIM()
+  sayKeyedMsg("S2IZ0015",NIL)
+  NIL
+
+clearCmdAll() ==
+  clearCmdSortedCaches()
+  ------undo special variables------
+  $frameRecord := nil
+  $previousBindings := nil
+  $variableNumberAlist := nil
+  untraceMapSubNames _/TRACENAMES
+  $InteractiveFrame := LIST LIST NIL
+  resetInCoreHist()
+  if $useInternalHistoryTable
+    then $internalHistoryTable := NIL
+    else deleteFile histFileName()
+  $IOindex := 1
+  updateCurrentInterpreterFrame()
+  $currentLine := '")clear all"    --restored 3/94; needed for undo (RDJ)
+  clearMacroTable()
+  if $frameMessages then sayKeyedMsg("S2IZ0011",[$interpreterFrameName])
+  else sayKeyedMsg("S2IZ0012",NIL)
+
+clearCmdExcept(l is [opt,:vl]) ==
+  --clears elements of vl of all options EXCEPT opt
+  for option in $clearOptions |
+    ^stringPrefix?(object2String opt,object2String option)
+      repeat clearCmdParts [option,:vl]
+
+clearCmdParts(l is [opt,:vl]) ==
+  -- clears the bindings indicated by opt of all variables in vl
+
+  option:= selectOptionLC(opt,$clearOptions,'optionError)
+  option:= INTERN PNAME option
+
+  -- the option can be plural but the key in the alist is sometimes
+  -- singular
+
+  option :=
+    option = 'types =>  'mode
+    option = 'modes =>  'mode
+    option = 'values => 'value
+    option
+
+  null vl => sayKeyedMsg("S2IZ0055",NIL)
+  pmacs := getParserMacroNames()
+  imacs := getInterpMacroNames()
+  if vl='(all) then
+    vl := ASSOCLEFT CAAR $InteractiveFrame
+    vl := REMDUP(append(vl, pmacs))
+  $e : local := $InteractiveFrame
+  for x in vl repeat
+    clearDependencies(x,true)
+    if option='properties and x in pmacs then clearParserMacro(x)
+    if option='properties and x in imacs and ^(x in pmacs) then
+        sayMessage ['"   You cannot clear the definition of the system-defined macro ",
+            fixObjectForPrinting x,"."]
+    p1 := ASSOC(x,CAAR $InteractiveFrame) =>
+      option='properties =>
+        if isMap x then
+          (lm := get(x,'localModemap,$InteractiveFrame)) =>
+            PAIRP lm => untraceMapSubNames [CADAR lm]
+          NIL
+        for p2 in CDR p1 repeat
+          prop:= CAR p2
+          recordOldValue(x,prop,CDR p2)
+          recordNewValue(x,prop,NIL)
+        SETF(CAAR $InteractiveFrame,deleteAssoc(x,CAAR $InteractiveFrame))
+      p2:= ASSOC(option,CDR p1) =>
+        recordOldValue(x,option,CDR p2)
+        recordNewValue(x,option,NIL)
+        RPLACD(p2,NIL)
+  nil
+
+--% )close
+
+queryClients () ==
+  -- Returns the number of active scratchpad clients
+  sockSendInt($SessionManager, $QueryClients)
+  sockGetInt $SessionManager
+
+
+close args ==
+  $saturn => 
+    sayErrorly('"Obsolete system command", _
+      ['" The )close  system command is obsolete in this version of AXIOM.",
+       '" Please use Close from the File menu instead."])
+  quiet:local:= false
+  null $SpadServer =>
+    throwKeyedMsg('"S2IZ0071", [])
+  numClients := queryClients()
+  numClients > 1 =>
+    sockSendInt($SessionManager, $CloseClient)
+    sockSendInt($SessionManager, $currentFrameNum)
+    closeInterpreterFrame(NIL)
+  for [opt,:.] in $options repeat
+    fullopt := selectOptionLC(opt, '(quiet), 'optionError)
+    fullopt = 'quiet   =>
+           quiet:=true
+  quiet =>
+    sockSendInt($SessionManager, $CloseClient)
+    sockSendInt($SessionManager, $currentFrameNum)
+    closeInterpreterFrame(NIL)
+  x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil)
+  MEMQ(STRING2ID_-N(x,1), '(YES Y)) =>
+    BYE()
+  nil
+
+--% )constructor
+
+constructor args ==
+  sayMessage '"   Not implemented yet."
+  NIL
+
+--% )compiler
+
+compiler args ==
+    $newConlist: local := nil    --reset by compDefineLisplib and astran
+    null args and null $options and null _/EDITFILE => helpSpad2Cmd '(compiler)
+    if null args then args := [_/EDITFILE]
+
+    -- first see if the user has explicitly specified the compiler
+    -- to use.
+
+    optlist := '(new old translate constructor)
+    haveNew := nil
+    haveOld := nil
+    for opt in $options while ^(haveNew and haveOld) repeat
+        [optname,:optargs] := opt
+        fullopt := selectOptionLC(optname,optlist,nil)
+        fullopt = 'new => haveNew := true
+        fullopt = 'translate => haveOld := true
+        fullopt = 'constructor => haveOld := true
+        fullopt = 'old => haveOld := true
+
+    haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil)
+
+    af  := pathname args
+    aft := pathnameType af
+-- Whats this for? MCD/PAB 21-9-95
+--    if haveNew and (null(aft) or (aft = '"")) then
+--        af := pathname [af, '"as"]
+--        aft = '"as"
+--    if haveOld and (null(aft) or (aft = '"")) then
+--        af := pathname [af, '"spad"]
+--        aft = '"spad"
+
+    haveNew or (aft = '"as")   =>
+        not (af1 := $FINDFILE (af, '(as))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileAsharpCmd [af1]
+    haveOld or (aft = '"spad") =>
+        not (af1 := $FINDFILE (af, '(spad))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileSpad2Cmd  [af1]
+    aft = '"lsp"   =>
+        not (af1 := $FINDFILE (af, '(lsp))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileAsharpLispCmd [af1]
+    aft = '"NRLIB"  =>
+        not (af1 := $FINDFILE (af, '(NRLIB))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileSpadLispCmd [af1]
+    aft = '"ao"   =>
+        not (af1 := $FINDFILE (af, '(ao))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileAsharpCmd [af1]
+    aft = '"al"   =>    -- archive library of .ao files
+        not (af1 := $FINDFILE (af, '(al))) =>
+            throwKeyedMsg("S2IL0003",[NAMESTRING af])
+        compileAsharpArchiveCmd [af1]
+
+    -- see if we something with the appropriate file extension
+    -- lying around
+
+    af1 := $FINDFILE (af, '(as spad ao asy))
+
+    af1 and pathnameType(af1) = '"as"   => compileAsharpCmd [af1]
+    af1 and pathnameType(af1) = '"ao"  => compileAsharpCmd [af1]
+    af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd  [af1]
+    af1 and pathnameType(af1) = '"asy"  => compileAsharpArchiveCmd [af1]
+
+    -- maybe /EDITFILE has some stuff that can help us
+    ef := pathname _/EDITFILE
+    ef := mergePathnames(af,ef)
+
+    ef = af => throwKeyedMsg("S2IZ0039", nil)
+    af := ef
+
+    pathnameType(af) = '"as"   => compileAsharpCmd args
+    pathnameType(af) = '"ao"  => compileAsharpCmd args
+    pathnameType(af) = '"spad" => compileSpad2Cmd  args
+
+    -- see if we something with the appropriate file extension
+    -- lying around
+    af1 := $FINDFILE (af, '(as spad ao asy))
+
+    af1 and pathnameType(af1) = '"as"   => compileAsharpCmd [af1]
+    af1 and pathnameType(af1) = '"ao"  => compileAsharpCmd [af1]
+    af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd  [af1]
+    af1 and pathnameType(af1) = '"asy"  => compileAsharpArchiveCmd [af1]
+
+    throwKeyedMsg("S2IZ0039", nil)
+
+compileAsharpCmd args ==
+    compileAsharpCmd1 args
+    terminateSystemCommand()
+    spadPrompt()
+
+compileAsharpCmd1 args ==
+    -- Assume we entered from the "compiler" function, so args ^= nil
+    -- and is a file with file extension .as or .ao
+
+    path := pathname args
+    pathType := pathnameType path
+    (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083", nil)
+    ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+
+    SETQ(_/EDITFILE, path)
+    updateSourceFiles path
+
+    optList :=  '( _
+      new _
+      old _
+      translate _
+      onlyargs _
+      moreargs _
+      quiet _
+      nolispcompile _
+      noquiet _
+      library _
+      nolibrary _
+        )
+
+    beQuiet := false         -- be verbose here
+    doLibrary  := true       -- so a )library after compilation
+    doCompileLisp := true    -- do compile generated lisp code
+
+    moreArgs := NIL
+    onlyArgs := NIL
+
+    for opt in $options repeat
+        [optname,:optargs] := opt
+        fullopt := selectOptionLC(optname,optList,nil)
+
+        fullopt = 'new       => nil
+        fullopt = 'old       => error "Internal error: compileAsharpCmd got )old"
+        fullopt = 'translate => error "Internal error: compileAsharpCmd got )translate"
+
+        fullopt = 'quiet     => beQuiet := true
+        fullopt = 'noquiet   => beQuiet := false
+
+        fullopt = 'nolispcompile   => doCompileLisp := false
+
+        fullopt = 'moreargs  => moreArgs := optargs
+        fullopt = 'onlyargs  => onlyArgs := optargs
+
+        fullopt = 'library   => doLibrary  := true
+        fullopt = 'nolibrary => doLibrary  := false
+
+        throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+
+    tempArgs :=
+        pathType = '"ao" =>
+            -- want to strip out -Fao
+            (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) =>
+                p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL)
+                STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ",
+                    SUBSTRING($asharpCmdlineFlags, p+5, NIL))
+            $asharpCmdlineFlags
+        $asharpCmdlineFlags
+
+    asharpArgs :=
+        onlyArgs =>
+            s := ""
+            for a in onlyArgs repeat
+                s := STRCONC(s, '" ", object2String a)
+            s
+        moreArgs =>
+            s := tempArgs
+            for a in moreArgs repeat
+                s := STRCONC(s, '" ", object2String a)
+            s
+        tempArgs
+
+    if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs])
+
+    command :=
+<<remove TRUENAME>>
+    rc := OBEY command
+
+    if (rc = 0) and doCompileLisp then
+        lsp := fnameMake('".", pathnameName args, '"lsp")
+        if fnameReadable?(lsp) then
+            if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+            compileFileQuietly(lsp)
+        else
+            sayKeyedMsg("S2IL0003", [namestring lsp])
+
+    if rc = 0 and doLibrary then
+        -- do we need to worry about where the compilation output went?
+        if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+        withAsharpCmd [ pathnameName path ]
+    else if ^beQuiet then
+        sayKeyedMsg("S2IZ0084", nil)
+
+    extendLocalLibdb $newConlist
+
+compileAsharpArchiveCmd args ==
+    -- Assume we entered from the "compiler" function, so args ^= nil
+    -- and is a file with file extension .al. We also assume that
+    -- the name is fully qualified.
+
+    path := pathname args
+    ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+
+    -- here is the plan:
+    --   1. extract the file name and try to make a directory based
+    --      on that name.
+    --   2. cd to that directory and ar x the .al file
+    --   3. for each .ao file that shows up, compile it
+    --   4. delete the generated .ao files
+
+    -- First try to make the directory in the current directory
+
+    dir  := fnameMake('".", pathnameName path, '"axldir")
+    exists := PROBE_-FILE dir
+    isDir := directoryp namestring dir
+    exists and isDir ^= 1=>
+        throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
+
+    if isDir ^= 1 then
+        cmd  := STRCONC('"mkdir ", namestring dir)
+        rc   := OBEY cmd
+        rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
+
+    curDir := $CURRENT_-DIRECTORY
+
+    -- cd to that directory and try to unarchive the .al file
+
+    cd [ object2Identifier namestring dir ]
+
+    cmd := STRCONC( '"ar x ", namestring path )
+    rc := OBEY cmd
+    rc ^= 0 =>
+        cd [ object2Identifier namestring curDir ]
+        throwKeyedMsg("S2IL0028",[namestring dir, namestring args])
+
+    -- Look for .ao files
+
+    asos := DIRECTORY '"*.ao"
+    null asos =>
+        cd [ object2Identifier namestring curDir ]
+        throwKeyedMsg("S2IL0029",[namestring dir, namestring args])
+
+    -- Compile the .ao files
+
+    for aso in asos repeat
+        compileAsharpCmd1 [ namestring aso ]
+
+    -- Reset the current directory
+
+    cd [ object2Identifier namestring curDir ]
+
+    terminateSystemCommand()
+    spadPrompt()
+
+compileAsharpLispCmd args ==
+    -- Assume we entered from the "compiler" function, so args ^= nil
+    -- and is a file with file extension .lsp
+
+    path := pathname args
+    ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+
+    optList :=  '( _
+      quiet _
+      noquiet _
+      library _
+      nolibrary _
+        )
+
+    beQuiet := false         -- be verbose here
+    doLibrary  := true       -- so a )library after compilation
+
+    for opt in $options repeat
+        [optname,:optargs] := opt
+        fullopt := selectOptionLC(optname,optList,nil)
+
+        fullopt = 'quiet     => beQuiet := true
+        fullopt = 'noquiet   => beQuiet := false
+
+        fullopt = 'library   => doLibrary  := true
+        fullopt = 'nolibrary => doLibrary  := false
+
+        throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+
+    lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path)
+    if fnameReadable?(lsp) then
+        if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+        compileFileQuietly(lsp)
+    else
+        sayKeyedMsg("S2IL0003", [namestring lsp])
+
+    if doLibrary then
+        -- do we need to worry about where the compilation output went?
+        if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+        withAsharpCmd [ pathnameName path ]
+    else if ^beQuiet then
+        sayKeyedMsg("S2IZ0084", nil)
+    terminateSystemCommand()
+    spadPrompt()
+
+compileSpadLispCmd args ==
+    -- Assume we entered from the "compiler" function, so args ^= nil
+    -- and is a file with file extension .NRLIB
+
+    path := pathname fnameMake(first args, '"code", '"lsp")
+    ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+
+    optList :=  '( _
+      quiet _
+      noquiet _
+      library _
+      nolibrary _
+        )
+
+    beQuiet := false         -- be verbose here
+    doLibrary  := true       -- so a )library after compilation
+
+    for opt in $options repeat
+        [optname,:optargs] := opt
+        fullopt := selectOptionLC(optname,optList,nil)
+
+        fullopt = 'quiet     => beQuiet := true
+        fullopt = 'noquiet   => beQuiet := false
+
+        fullopt = 'library   => doLibrary  := true
+        fullopt = 'nolibrary => doLibrary  := false
+
+        throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+
+    lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path)
+    if fnameReadable?(lsp) then
+        if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+        --compileFileQuietly(lsp)
+        RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp
+    else
+        sayKeyedMsg("S2IL0003", [namestring lsp])
+
+    if doLibrary then
+        -- do we need to worry about where the compilation output went?
+        if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+        LOCALDATABASE([ pathnameName first args ],[])
+    else if ^beQuiet then
+        sayKeyedMsg("S2IZ0084", nil)
+    terminateSystemCommand()
+    spadPrompt()
+
+withAsharpCmd args ==
+    $options: local := nil
+    LOCALDATABASE(args, $options)
+
+--% )copyright -- display copyright notice
+
+summary l ==
+ OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/summary")
+copyright () ==
+ OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/copyright")
+
+--% )credits -- display credit list
+
+credits() ==
+ for i in CREDITS repeat
+  PRINC(i)
+  TERPRI()
+
+--% )display
+
+display l == displaySpad2Cmd l
+
+displaySpad2Cmd l ==
+  $e: local := $EmptyEnvironment
+  l is [opt,:vl] and opt ^= "?" =>
+    option := selectOptionLC(opt,$displayOptions,'optionError) =>
+
+      -- the option may be given in the plural but the property in
+      -- the alist is sometimes singular
+
+      option :=
+        option = 'all   =>
+            l := ['properties]
+            'properties
+        (option = 'modes) or (option = 'types) =>
+            l := ['type, :vl]
+            'type
+        option = 'values =>
+            l := ['value, :vl]
+            'value
+        option
+
+      option = 'abbreviations =>
+        null vl => listConstructorAbbreviations()
+        for v in vl repeat abbQuery(opOf v)
+
+      option = 'operations =>     displayOperations vl
+      option = 'macros =>         displayMacros vl
+      option = 'names =>          displayWorkspaceNames()
+      displayProperties(option,l)
+  optList:= [:['%l,'"        ",x] for x in $displayOptions]
+  msg := [:bright '"  )display",'"keyword arguments are",
+    :bright optList,'%l,'"   or abbreviations thereof."]
+  sayMessage msg
+
+displayMacros names ==
+  imacs := getInterpMacroNames()
+  pmacs := getParserMacroNames()
+  macros :=
+     null names => APPEND (imacs, pmacs)
+     names
+  macros := REMDUP macros
+
+  null macros => sayBrightly '"   There are no Axiom macros."
+
+  -- first do user defined ones
+
+  first := true
+  for macro in macros repeat
+    macro in pmacs =>
+        if first then
+            sayBrightly ['%l,'"User-defined macros:"]
+            first := NIL
+        displayParserMacro macro
+    macro in imacs => 'iterate
+    sayBrightly (["   ",'%b, macro, '%d, " is not a known Axiom macro."])
+
+  -- now system ones
+
+  first := true
+  for macro in macros repeat
+    macro in imacs =>
+        macro in pmacs => 'iterate
+        if first then
+            sayBrightly ['%l,'"System-defined macros:"]
+            first := NIL
+        displayMacro macro
+    macro in pmacs => 'iterate
+  NIL
+
+getParserMacroNames() ==
+  REMDUP [CAR mac for mac in getParserMacros()]
+
+--------------------> NEW DEFINITION (override in patches.lisp.pamphlet)
+clearParserMacro(macro) ==
+  -- first see if it is one
+  not IFCDR ASSOC(macro, ($pfMacros)) => NIL
+  $pfMacros := REMALIST($pfMacros, macro)
+
+displayMacro name ==
+  m := isInterpMacro name
+  null m =>
+    sayBrightly ['"  ",:bright name,'"is not an interpreter macro."]
+  -- $op is needed in the output routines.
+  $op : local := STRCONC('"macro ",object2String name)
+  [args,:body] := m
+  args :=
+    null args => nil
+    null rest args => first args
+    ['Tuple,:args]
+  mathprint ['MAP,[args,:body]]
+
+displayWorkspaceNames() ==
+  imacs := getInterpMacroNames()
+  pmacs := getParserMacroNames()
+  sayMessage '"Names of User-Defined Objects in the Workspace:"
+  names := MSORT append(getWorkspaceNames(),pmacs)
+  if null names
+    then sayBrightly "   * None *"
+    else sayAsManyPerLineAsPossible [object2String x for x in names]
+  imacs := SETDIFFERENCE(imacs,pmacs)
+  if imacs then
+    sayMessage '"Names of System-Defined Objects in the Workspace:"
+    sayAsManyPerLineAsPossible [object2String x for x in imacs]
+
+
+getWorkspaceNames() ==
+  NMSORT [n for [n,:.] in CAAR $InteractiveFrame |
+    (n ^= "--macros--" and n^= "--flags--")]
+
+displayOperations l ==
+  null l =>
+    x := UPCASE queryUserKeyedMsg("S2IZ0058",NIL)
+    if MEMQ(STRING2ID_-N(x,1),'(Y YES))
+      then for op in allOperations() repeat reportOpSymbol op
+      else sayKeyedMsg("S2IZ0059",NIL)
+    nil
+  for op in l repeat reportOpSymbol op
+
+interpFunctionDepAlists() ==
+  $e : local := $InteractiveFrame
+  deps := getFlag "$dependencies"
+  $dependentAlist := [[NIL,:NIL]]
+  $dependeeAlist := [[NIL,:NIL]]
+  for [dependee,dependent] in deps repeat
+    $dependentAlist := PUTALIST($dependentAlist,dependee,
+      CONS(dependent,GETALIST($dependentAlist,dependee)))
+    $dependeeAlist  := PUTALIST($dependeeAlist,dependent,
+      CONS(dependee,GETALIST($dependeeAlist,dependent)))
+
+fixObjectForPrinting(v) ==
+    v' := object2Identifier v
+    EQ(v',"%") => '"\%"
+    v' in $msgdbPrims => STRCONC('"\",PNAME v')
+    v
+
+displayProperties(option,l) ==
+  $dependentAlist : local
+  $dependeeAlist  : local
+  [opt,:vl]:= (l or ['properties])
+  imacs := getInterpMacroNames()
+  pmacs := getParserMacroNames()
+  macros := REMDUP append(imacs, pmacs)
+  if vl is ['all] or null vl then
+    vl := MSORT append(getWorkspaceNames(),macros)
+  if $frameMessages then sayKeyedMsg("S2IZ0065",[$interpreterFrameName])
+  null vl =>
+    null $frameMessages => sayKeyedMsg("S2IZ0066",NIL)
+    sayKeyedMsg("S2IZ0067",[$interpreterFrameName])
+  interpFunctionDepAlists()
+  for v in vl repeat
+    isInternalMapName(v) => 'iterate
+    pl := getIProplist(v)
+    option = 'flags =>     getAndSay(v,"flags")
+    option = 'value =>     displayValue(v,getI(v,'value),nil)
+    option = 'condition => displayCondition(v,getI(v,"condition"),nil)
+    option = 'mode =>      displayMode(v,getI(v,'mode),nil)
+    option = 'type =>      displayType(v,getI(v,'value),nil)
+    option = 'properties =>
+      v = "--flags--" => nil
+      pl is [['cacheInfo,:.],:.] => nil
+      v1 := fixObjectForPrinting(v)
+      sayMSG ['"Properties of",:bright prefix2String v1,'":"]
+      null pl =>
+        v in pmacs =>
+            sayMSG '"   This is a user-defined macro."
+            displayParserMacro v
+        isInterpMacro v =>
+            sayMSG '"   This is a system-defined macro."
+            displayMacro v
+        sayMSG '"   none"
+      propsSeen:= nil
+      for [prop,:val] in pl | ^MEMQ(prop,propsSeen) and val repeat
+        prop in '(alias generatedCode IS_-GENSYM mapBody localVars) =>
+          nil
+        prop = 'condition =>
+          displayCondition(prop,val,true)
+        prop = 'recursive =>
+          sayMSG '"   This is recursive."
+        prop = 'isInterpreterFunction =>
+          sayMSG '"   This is an interpreter function."
+          sayFunctionDeps v where
+            sayFunctionDeps x ==
+              if dependents := GETALIST($dependentAlist,x) then
+                null rest dependents =>
+                  sayMSG ['"   The following function or rule ",
+                    '"depends on this:",:bright first dependents]
+                sayMSG
+                  '"   The following functions or rules depend on this:"
+                msg := ["%b",'"     "]
+                for y in dependents repeat msg := ['" ",y,:msg]
+                sayMSG [:nreverse msg,"%d"]
+              if dependees := GETALIST($dependeeAlist,x) then
+                null rest dependees =>
+                  sayMSG ['"   This depends on the following function ",
+                    '"or rule:",:bright first dependees]
+                sayMSG
+                  '"   This depends on the following functions or rules:"
+                msg := ["%b",'"     "]
+                for y in dependees repeat msg := ['" ",y,:msg]
+                sayMSG [:nreverse msg,"%d"]
+        prop = 'isInterpreterRule =>
+          sayMSG '"   This is an interpreter rule."
+          sayFunctionDeps v
+        prop = 'localModemap =>
+          displayModemap(v,val,true)
+        prop = 'mode =>
+          displayMode(prop,val,true)
+        prop = 'value =>
+          val => displayValue(v,val,true)
+        sayMSG ['"   ",prop,'":  ",val]
+        propsSeen:= [prop,:propsSeen]
+    sayKeyedMsg("S2IZ0068",[option])
+  terminateSystemCommand()
+
+displayModemap(v,val,giveVariableIfNil) ==
+  for mm in val repeat g(v,mm,giveVariableIfNil) where
+    g(v,mm,giveVariableIfNil) ==
+      [[local,:signature],fn,:.]:= mm
+      local='interpOnly => nil
+      varPart:= (giveVariableIfNil => nil; ['" of",:bright v])
+      prefix:= ["   Compiled function type",:varPart,": "]
+      sayBrightly concat(prefix,formatSignature signature)
+
+displayMode(v,mode,giveVariableIfNil) ==
+  null mode => nil
+  varPart:= (giveVariableIfNil => nil; [" of",:bright fixObjectForPrinting v])
+  sayBrightly concat("   Declared type or mode",
+    varPart,":   ",prefix2String mode)
+
+displayCondition(v,condition,giveVariableIfNil) ==
+  varPart:= (giveVariableIfNil => nil; [" of",:bright v])
+  condPart:= condition or 'true
+  sayBrightly concat("   condition",varPart,":  ",pred2English condPart)
+
+getAndSay(v,prop) ==
+  val:= getI(v,prop) => sayMSG ["    ",val,'%l]
+  sayMSG ["    none",'%l]
+
+displayType($op,u,omitVariableNameIfTrue) ==
+  null u =>
+    sayMSG ['"   Type of value of ",
+        fixObjectForPrinting PNAME $op,'":  (none)"]
+  type := prefix2String objMode(u)
+  if ATOM type then type := [type]
+  sayMSG concat ['"   Type of value of ",fixObjectForPrinting PNAME $op,'": ",:type]
+  NIL
+
+displayValue($op,u,omitVariableNameIfTrue) ==
+  null u => sayMSG ["   Value of ",fixObjectForPrinting PNAME $op,'":  (none)"]
+  expr := objValUnwrap(u)
+  expr is [op,:.] and (op = 'MAP) or objMode(u) = $EmptyMode =>
+    displayRule($op,expr)
+  label:=
+    omitVariableNameIfTrue =>
+        rhs := '"):  "
+        '"Value (has type "
+    rhs := '":  "
+    STRCONC('"Value of ", PNAME $op,'": ")
+  labmode := prefix2String objMode(u)
+  if ATOM labmode then labmode := [labmode]
+  GETDATABASE(expr,'CONSTRUCTORKIND) = 'domain =>
+    sayMSG concat('"   ",label,labmode,rhs,form2String expr)
+  mathprint ['CONCAT,label,:labmode,rhs,
+    outputFormat(expr,objMode(u))]
+  NIL
+
+--% )edit
+
+edit l == editSpad2Cmd l
+
+editSpad2Cmd l ==
+  l:= 
+    null l => _/EDITFILE
+    CAR l
+  l := pathname l
+  oldDir := pathnameDirectory l
+  fileTypes :=
+    pathnameType l => [pathnameType l]
+    $UserLevel = 'interpreter => '("input" "INPUT" "spad" "SPAD")
+    $UserLevel = 'compiler    => '("input" "INPUT" "spad" "SPAD")
+    '("input" "INPUT" "spad" "SPAD" "boot" "BOOT" "lisp" "LISP" "meta" "META")
+  ll := 
+       oldDir = '"" => pathname $FINDFILE (pathnameName l, fileTypes)
+       l
+  l := pathname ll
+  SETQ(_/EDITFILE,l)
+  rc := editFile l
+  updateSourceFiles l
+  rc
+
+--% )help
+
+help l == helpSpad2Cmd l
+
+helpSpad2Cmd args ==
+  -- try to use new stuff first
+  if newHelpSpad2Cmd(args) then return nil
+
+  sayKeyedMsg("S2IZ0025",[args])
+  nil
+
+newHelpSpad2Cmd args ==
+  if null args then args := ["?"]
+  # args > 1 =>
+    sayKeyedMsg("S2IZ0026",NIL)
+    true
+  sarg := PNAME first args
+  if sarg = '"?" then args := ['help]
+  else if sarg = '"%" then args := ['history]
+       else if sarg = '"%%" then args := ['history]
+  arg := selectOptionLC(first args,$SYSCOMMANDS,nil)
+  if null arg then arg := first args
+  if arg = 'compiler then arg := 'compile
+
+  -- see if new help file exists
+
+  narg := PNAME arg
+  null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL
+
+  $useFullScreenHelp =>
+    OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile)
+    true
+
+  filestream := MAKE_-INSTREAM(helpFile)
+  repeat
+    line := read_-line(filestream,false)
+    NULL line =>
+      SHUT filestream
+      return true
+    SAY line
+  true
+
+--%
+--% )frame
+--%
+
+$frameRecord  := nil  --Initial setting for frame record
+$previousBindings := nil
+
+frame l == frameSpad2Cmd l
+
+frameName(frame) == CAR frame
+
+frameNames() == [frameName f for f in $interpreterFrameRing]
+
+frameEnvironment fname ==
+  -- extracts the environment portion of a frame
+  -- if fname is not a valid frame name then the empty environment
+  -- is returned
+  fname = frameName first $interpreterFrameRing => $InteractiveFrame
+  ifr := rest $interpreterFrameRing
+  e := LIST LIST NIL
+  while ifr repeat
+    [f,:ifr] := ifr
+    if fname = frameName f   then
+      e := CADR f
+      ifr := NIL
+  e
+
+frameSpad2Cmd args ==
+  frameArgs := '(drop import last names new next)
+  $options => throwKeyedMsg("S2IZ0016",['")frame"])
+  null(args) => helpSpad2Cmd ['frame]
+  arg  := selectOptionLC(first args,frameArgs,'optionError)
+  args := rest args
+  if args is [a] then args := a
+  if ATOM args then args := object2Identifier args
+  arg = 'drop  =>
+    args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
+    closeInterpreterFrame(args)
+  arg = 'import =>  importFromFrame args
+  arg = 'last  =>   previousInterpreterFrame()
+  arg = 'names =>   displayFrameNames()
+  arg = 'new   =>
+    args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
+    addNewInterpreterFrame(args)
+  arg = 'next  =>   nextInterpreterFrame()
+
+  NIL
+
+addNewInterpreterFrame(name) ==
+  null name => throwKeyedMsg("S2IZ0018",NIL)
+  updateCurrentInterpreterFrame()
+  -- see if we already have one by that name
+  for f in $interpreterFrameRing repeat
+    name = frameName(f) => throwKeyedMsg("S2IZ0019",[name])
+  initHistList()
+  $interpreterFrameRing := CONS(emptyInterpreterFrame(name),
+    $interpreterFrameRing)
+  updateFromCurrentInterpreterFrame()
+  _$ERASE histFileName()
+
+emptyInterpreterFrame(name) ==
+  LIST(name,                            -- frame name
+       LIST LIST NIL,                   -- environment
+       1,                               -- $IOindex
+       $HiFiAccess,                     -- $HiFiAccess
+       $HistList,                       -- $HistList
+       $HistListLen,                    -- $HistListLen
+       $HistListAct,                    -- $HistListAct
+       $HistRecord,                     -- $HistRecord
+       NIL,                             -- $internalHistoryTable
+       COPY_-SEQ $localExposureDataDefault        -- $localExposureData
+      )
+
+closeInterpreterFrame(name) ==
+  -- if name = NIL then it means the current frame
+  null rest $interpreterFrameRing =>
+    name and (name ^= $interpreterFrameName) =>
+      throwKeyedMsg("S2IZ0020",[$interpreterFrameName])
+    throwKeyedMsg("S2IZ0021",NIL)
+  if null name then $interpreterFrameRing := rest $interpreterFrameRing
+  else   -- find the frame
+    found := nil
+    ifr := NIL
+    for f in $interpreterFrameRing repeat
+      found or (name ^= frameName(f)) => ifr := CONS(f,ifr)
+      found := true
+    not found => throwKeyedMsg("S2IZ0022",[name])
+    _$ERASE makeHistFileName(name)
+    $interpreterFrameRing := nreverse ifr
+  updateFromCurrentInterpreterFrame()
+
+previousInterpreterFrame() ==
+  updateCurrentInterpreterFrame()
+  null rest $interpreterFrameRing => NIL  -- nothing to do
+  [:b,l] := $interpreterFrameRing
+  $interpreterFrameRing := NCONC2([l],b)
+  updateFromCurrentInterpreterFrame()
+
+nextInterpreterFrame() ==
+  updateCurrentInterpreterFrame()
+  null rest $interpreterFrameRing => NIL  -- nothing to do
+  $interpreterFrameRing :=
+    NCONC2(rest $interpreterFrameRing,[first $interpreterFrameRing])
+  updateFromCurrentInterpreterFrame()
+
+
+createCurrentInterpreterFrame() ==
+  LIST($interpreterFrameName,           -- frame name
+       $InteractiveFrame,               -- environment
+       $IOindex,                        -- $IOindex
+       $HiFiAccess,                     -- $HiFiAccess
+       $HistList,                       -- $HistList
+       $HistListLen,                    -- $HistListLen
+       $HistListAct,                    -- $HistListAct
+       $HistRecord,                     -- $HistRecord
+       $internalHistoryTable,           -- $internalHistoryTable
+       $localExposureData               -- $localExposureData
+      )
+
+
+updateFromCurrentInterpreterFrame() ==
+  [$interpreterFrameName,          _
+   $InteractiveFrame,              _
+   $IOindex,                       _
+   $HiFiAccess,                    _
+   $HistList,                      _
+   $HistListLen,                   _
+   $HistListAct,                   _
+   $HistRecord,                    _
+   $internalHistoryTable,          _
+   $localExposureData              _
+   ] := first $interpreterFrameRing
+  if $frameMessages then
+    sayMessage ['"   Current interpreter frame is called",:bright
+      $interpreterFrameName]
+  NIL
+
+
+updateCurrentInterpreterFrame() ==
+  RPLACA($interpreterFrameRing,createCurrentInterpreterFrame())
+  updateFromCurrentInterpreterFrame()
+  NIL
+
+initializeInterpreterFrameRing() ==
+  $interpreterFrameName := 'initial
+  $interpreterFrameRing := [emptyInterpreterFrame($interpreterFrameName)]
+  updateFromCurrentInterpreterFrame()
+  NIL
+
+
+changeToNamedInterpreterFrame(name) ==
+  updateCurrentInterpreterFrame()
+  frame := findFrameInRing(name)
+  null frame => NIL
+  $interpreterFrameRing := [frame,:NREMOVE($interpreterFrameRing, frame)]
+  updateFromCurrentInterpreterFrame()
+
+makeInitialModemapFrame() == COPY $InitialModemapFrame
+
+findFrameInRing(name) ==
+  val := NIL
+  for frame in $interpreterFrameRing repeat
+    CAR frame = name =>
+      val := frame
+      return frame
+  val
+
+displayFrameNames() ==
+  fs := "append"/[ ['%l,'"     ",:bright frameName f] for f in
+    $interpreterFrameRing]
+  sayKeyedMsg("S2IZ0024",[fs])
+
+importFromFrame args ==
+  -- args should have the form [frameName,:varNames]
+  if args and atom args then args := [args]
+  null args => throwKeyedMsg("S2IZ0073",NIL)
+  [fname,:args] := args
+  not member(fname,frameNames()) =>
+    throwKeyedMsg("S2IZ0074",[fname])
+  fname = frameName first $interpreterFrameRing =>
+    throwKeyedMsg("S2IZ0075",NIL)
+  fenv := frameEnvironment fname
+  null args =>
+    x := UPCASE queryUserKeyedMsg("S2IZ0076",[fname])
+    MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
+      vars := NIL
+      for [v,:props] in CAAR fenv repeat
+        v = "--macros" =>
+          for [m,:.] in props repeat vars := cons(m,vars)
+        vars := cons(v,vars)
+      importFromFrame [fname,:vars]
+    sayKeyedMsg("S2IZ0077",[fname])
+  for v in args repeat
+    plist := GETALIST(CAAR fenv,v)
+    plist =>
+      -- remove anything with the same name in the current frame
+      clearCmdParts ['propert,v]
+      for [prop,:val] in plist repeat
+        putHist(v,prop,val,$InteractiveFrame)
+    (m := get("--macros--",v,fenv)) =>
+      putHist("--macros--",v,m,$InteractiveFrame)
+    sayKeyedMsg("S2IZ0079",[v,fname])
+  sayKeyedMsg("S2IZ0078",[fname])
+
+
+
+--% )history
+
+++ vm/370 filename type component
+SETANDFILEQ($historyFileType,'axh)
+
+++ vm/370 filename name component
+SETANDFILEQ($oldHistoryFileName,'last)
+SETANDFILEQ($internalHistoryTable,NIL)
+
+++ t means keep history in core
+SETANDFILEQ($useInternalHistoryTable, true)
+
+history l ==
+  l or null $options => sayKeyedMsg("S2IH0006",NIL) 
+  historySpad2Cmd()
+
+
+makeHistFileName(fname) ==
+  makePathname(fname,$historyFileType,$historyDirectory)
+
+oldHistFileName() ==
+  makeHistFileName($oldHistoryFileName)
+
+histFileName() ==
+  makeHistFileName($interpreterFrameName)
+
+
+histInputFileName(fn) ==
+  null fn =>
+    makePathname($interpreterFrameName,'INPUT,$historyDirectory)
+  makePathname(fn,'INPUT,$historyDirectory)
+
+
+initHist() ==
+  $useInternalHistoryTable => initHistList()
+  oldFile := oldHistFileName()
+  newFile := histFileName()
+  -- see if history directory is writable
+  histFileErase oldFile
+  if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile)
+  $HiFiAccess:= 'T
+  initHistList()
+
+initHistList() ==
+  -- creates $HistList as a circular list of length $HistListLen
+  -- and $HistRecord
+  $HistListLen:= 20
+  $HistList:= LIST NIL
+  li:= $HistList
+  for i in 1..$HistListLen repeat li:= CONS(NIL,li)
+  RPLACD($HistList,li)
+  $HistListAct:= 0
+  $HistRecord:= NIL
+
+historySpad2Cmd() ==
+  -- history is a system command which can call resetInCoreHist
+  -- and changeHistListLen, and restore last session
+  histOptions:=
+    '(on off yes no change reset restore write save show file memory)
+  opts:= [ [selectOptionLC(opt,histOptions,'optionError),:optargs]
+    for [opt,:optargs] in $options]
+  for [opt,:optargs] in opts repeat
+    opt in '(on yes) =>
+      $HiFiAccess => sayKeyedMsg("S2IH0007",NIL) 
+      $IOindex = 1 =>       -- haven't done anything yet
+        $HiFiAccess:= 'T
+        initHistList()
+        sayKeyedMsg("S2IH0008",NIL) 
+      x := UPCASE queryUserKeyedMsg("S2IH0009",NIL) 
+      MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
+        histFileErase histFileName()
+        $HiFiAccess:= 'T
+        $options := nil
+        clearSpad2Cmd '(all)
+        sayKeyedMsg("S2IH0008",NIL)
+        initHistList()
+      sayKeyedMsg("S2IH0010",NIL)
+    opt in '(off no) =>
+      null $HiFiAccess => sayKeyedMsg("S2IH0011",NIL)
+      $HiFiAccess:= NIL
+      disableHist()
+      sayKeyedMsg("S2IH0012",NIL)
+    opt = 'file    => setHistoryCore NIL
+    opt = 'memory  => setHistoryCore true
+    opt = 'reset   => resetInCoreHist()
+    opt = 'save    => saveHistory optargs
+    opt = 'show    => showHistory optargs
+    opt = 'change  => changeHistListLen first optargs
+    opt = 'restore => restoreHistory optargs
+    opt = 'write   => writeInputLines(optargs,1)
+  'done
+
+
+setHistoryCore inCore ==
+  inCore = $useInternalHistoryTable =>
+    sayKeyedMsg((inCore => "S2IH0030"; "S2IH0029"),NIL) 
+  not $HiFiAccess =>
+    $useInternalHistoryTable := inCore
+    inCore => sayKeyedMsg("S2IH0032",NIL)
+    sayKeyedMsg("S2IH0031",NIL)
+  inCore =>
+    $internalHistoryTable := NIL
+    if $IOindex ^= 0 then
+      -- actually put something in there
+      l := LENGTH RKEYIDS histFileName()
+      for i in 1..l repeat
+        vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
+        $internalHistoryTable := CONS([i,:vec],$internalHistoryTable)
+      histFileErase histFileName()
+    $useInternalHistoryTable := true
+    sayKeyedMsg("S2IH0032",NIL)
+  $HiFiAccess:= 'NIL
+  histFileErase histFileName()
+  str := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
+  for [n,:rec] in reverse $internalHistoryTable repeat
+    SPADRWRITE(object2Identifier n,rec,str)
+  RSHUT str
+  $HiFiAccess:= 'T
+  $internalHistoryTable := NIL
+  $useInternalHistoryTable := NIL
+  sayKeyedMsg("S2IH0031",NIL)
+
+
+writeInputLines(fn,initial) == 
+  -- writes all input lines into file histInputFileName()
+  not $HiFiAccess => sayKeyedMsg("S2IH0013",NIL) -- history not on
+  null fn =>
+    throwKeyedMsg("S2IH0038", nil)          -- missing file name
+  maxn := 72
+  breakChars := [" ","+"]
+  for i in initial..$IOindex - 1 repeat
+    vecl := CAR readHiFi i
+    if STRINGP vecl then vecl := [vecl]
+    for vec in vecl repeat
+      n := SIZE vec
+      while n > maxn repeat
+        -- search backwards for a blank
+        done := nil
+        for j in 1..maxn while ^done repeat
+          k := 1 + maxn - j
+          MEMQ(vec.k,breakChars) =>
+            svec := STRCONC(SUBSTRING(vec,0,k+1),UNDERBAR)
+            lineList := [svec,:lineList]
+            done := true
+            vec := SUBSTRING(vec,k+1,NIL)
+            n := SIZE vec
+        -- in case we can't find a breaking point
+        if ^done then n := 0
+      lineList := [vec,:lineList]
+  file := histInputFileName(fn)
+  histFileErase file
+  inp:= DEFIOSTREAM(['(MODE . OUTPUT),['FILE,:file]],255,0)
+  for x in removeUndoLines NREVERSE lineList repeat WRITE_-LINE(x,inp)
+  -- see file "undo" for definition of removeUndoLines
+  if fn ^= 'redo then sayKeyedMsg("S2IH0014",[namestring file])
+  SHUT inp
+  NIL
+
+
+resetInCoreHist() ==
+  -- removes all pointers from $HistList
+  $HistListAct:= 0
+  for i in 1..$HistListLen repeat
+    $HistList:= CDR $HistList
+    RPLACA($HistList,NIL)
+
+changeHistListLen(n) ==
+  -- changes the length of $HistList.  n must be nonnegative
+  NULL INTEGERP n => sayKeyedMsg("S2IH0015",[n]) 
+  dif:= n-$HistListLen
+  $HistListLen:= n
+  l:= CDR $HistList
+  if dif > 0 then
+    for i in 1..dif repeat l:= CONS(NIL,l)
+  if dif < 0 then
+    for i in 1..-dif repeat l:= CDR l
+    if $HistListAct > n then $HistListAct:= n
+  RPLACD($HistList,l)
+  'done
+
+updateHist() ==
+  -- updates the history file and calls updateInCoreHist
+  null $IOindex => nil
+  startTimingProcess 'history
+  updateInCoreHist()
+  if $HiFiAccess then
+    UNWIND_-PROTECT(writeHiFi(),disableHist())
+    $HistRecord:= NIL
+  $IOindex:= $IOindex+1
+  updateCurrentInterpreterFrame()
+  $mkTestInputStack := nil
+  $currentLine := nil
+  stopTimingProcess 'history
+
+updateInCoreHist() ==
+  -- updates $HistList and $IOindex
+  $HistList:= CDR($HistList)
+  RPLACA($HistList,NIL)
+  if $HistListAct < $HistListLen then $HistListAct:= $HistListAct+1
+
+putHist(x,prop,val,e) ==
+  -- records new value to $HistRecord and old value to $HistList
+  -- then put is called with e
+  if not (x='%) then recordOldValue(x,prop,get(x,prop,e))
+  if $HiFiAccess then recordNewValue(x,prop,val)
+  putIntSymTab(x,prop,val,e)
+
+histFileErase file ==
+  --OBEY STRCONC('"rm -rf ", file)
+  PROBE_-FILE(file) and DELETE_-FILE(file)
+
+
+
+recordNewValue(x,prop,val) ==
+  startTimingProcess 'history
+  recordNewValue0(x,prop,val)
+  stopTimingProcess 'history
+
+recordNewValue0(x,prop,val) ==
+  -- writes (prop . val) into $HistRecord
+  -- updateHist writes this stuff out into the history file
+  p1:= ASSQ(x,$HistRecord) =>
+    p2:= ASSQ(prop,CDR p1) =>
+      RPLACD(p2,val)
+    RPLACD(p1,CONS(CONS(prop,val),CDR p1))
+  p:= CONS(x,list CONS(prop,val))
+  $HistRecord:= CONS(p,$HistRecord)
+
+recordOldValue(x,prop,val) ==
+  startTimingProcess 'history
+  recordOldValue0(x,prop,val)
+  stopTimingProcess 'history
+
+recordOldValue0(x,prop,val) ==
+  -- writes (prop . val) into $HistList
+  p1:= ASSQ(x,CAR $HistList) =>
+    not ASSQ(prop,CDR p1) =>
+      RPLACD(p1,CONS(CONS(prop,val),CDR p1))
+  p:= CONS(x,list CONS(prop,val))
+  RPLACA($HistList,CONS(p,CAR $HistList))
+
+undoInCore(n) ==
+  -- undoes the last n>0 steps using $HistList
+  -- resets $InteractiveFrame
+  li:= $HistList
+  for i in n..$HistListLen repeat li:= CDR li
+  undoChanges(li)
+  n:= $IOindex-n-1
+  n>0 and
+    $HiFiAccess =>
+      vec:= CDR UNWIND_-PROTECT(readHiFi(n),disableHist())
+      val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and
+        CDR p1
+    sayKeyedMsg("S2IH0019",[n])
+  $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
+  updateHist()
+
+undoChanges(li) ==
+  -- undoes all changes of list 'li'
+  if not CDR li = $HistList then undoChanges CDR li
+  for p1 in CAR li repeat
+    x:= CAR p1
+    for p2 in CDR p1 repeat
+      putHist(x,CAR p2,CDR p2,$InteractiveFrame)
+
+undoFromFile(n) ==
+  -- makes a clear and redoes all the assignments until step n
+  for [x,:varl] in CAAR $InteractiveFrame repeat
+    for p in varl repeat
+      [prop,:val]:= p
+      val =>
+        if not (x='%) then recordOldValue(x,prop,val)
+        if $HiFiAccess then recordNewValue(x,prop,val)
+        RPLACD(p,NIL)
+  for i in 1..n repeat
+    vec:= UNWIND_-PROTECT(CDR readHiFi(i),disableHist())
+    for p1 in vec repeat
+      x:= CAR p1
+      for p2 in CDR p1 repeat
+        $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
+  val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and CDR p1
+  $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
+  updateHist()
+
+saveHistory(fn) ==
+  $seen: local := MAKE_-HASHTABLE 'EQ
+  not $HiFiAccess => sayKeyedMsg("S2IH0016",NIL)
+  not $useInternalHistoryTable and
+    null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",NIL)
+  null fn => 
+    throwKeyedMsg("S2IH0037", nil)
+  savefile := makeHistFileName(fn)
+  inputfile := histInputFileName(fn)
+  writeInputLines(fn,1)
+  histFileErase savefile
+ 
+  if $useInternalHistoryTable
+    then
+      saveStr := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:savefile]]
+      for [n,:rec] in reverse $internalHistoryTable repeat
+        val := SPADRWRITE0(object2Identifier n,rec,saveStr)
+        val = 'writifyFailed =>
+          sayKeyedMsg("S2IH0035", [n, inputfile]) -- unable to save step
+      RSHUT saveStr
+  sayKeyedMsg("S2IH0018",[namestring(savefile)])  -- saved hist file named
+  nil
+
+restoreHistory(fn) ==
+  -- uses fn $historyFileType to recover an old session
+  -- if fn = NIL, then use $oldHistoryFileName
+  if null fn then fn' := $oldHistoryFileName
+  else if fn is [fn'] and IDENTP(fn') then fn' := fn'
+       else throwKeyedMsg("S2IH0023",[fn'])
+  restfile := makeHistFileName(fn')
+  null MAKE_-INPUT_-FILENAME restfile =>
+    sayKeyedMsg("S2IH0024",[namestring(restfile)]) -- no history file
+ 
+  -- if clear is changed to be undoable, this should be a reset-clear
+  $options: local := nil
+  clearSpad2Cmd '(all)
+ 
+  curfile := histFileName()
+  histFileErase curfile
+  _$FCOPY(restfile,curfile)
+ 
+  l:= LENGTH RKEYIDS curfile
+  $HiFiAccess:= 'T
+  oldInternal := $useInternalHistoryTable
+  $useInternalHistoryTable := NIL
+  if oldInternal then $internalHistoryTable := NIL
+  for i in 1..l repeat
+    vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
+    if oldInternal then $internalHistoryTable :=
+      CONS([i,:vec],$internalHistoryTable)
+    LINE:= CAR vec
+    for p1 in CDR vec repeat
+      x:= CAR p1
+      for p2 in CDR p1 repeat
+        $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
+    updateInCoreHist()
+  $e := $InteractiveFrame
+  for [a,:.] in CAAR $InteractiveFrame repeat
+    get(a,'localModemap,$InteractiveFrame) =>
+      rempropI(a,'localModemap)
+      rempropI(a,'localVars)
+      rempropI(a,'mapBody)
+  $IOindex:= l+1
+  $useInternalHistoryTable := oldInternal
+  sayKeyedMsg("S2IH0025",[namestring(restfile)]) 
+  clearCmdSortedCaches()
+  nil
+
+
+-- the following used to be the show command when that was used to
+-- show history.
+showHistory(arg) ==
+  -- arg can be of form
+  --    NIL          show at most last 20 input lines
+  --    (n)          show at most last n input lines
+  --    (lit)        where lit is an abbreviation for 'input or 'both
+  --                 if 'input, same as NIL
+  --                 if 'both, show last 5 input and outputs
+  --    (n lit)      show last n input lines + last n output lines
+  --                 if lit expands to 'both
+  $evalTimePrint: local:= 0
+  $printTimeSum: local:= 0
+  -- ugh!!! these are needed for timedEvaluateStream
+  -- displays the last n steps, default n=20
+  not $HiFiAccess => sayKeyedMsg("S2IH0026",['show])
+  showInputOrBoth := 'input
+  n := 20
+  nset := nil
+  if arg then
+    arg1 := CAR arg
+    if INTEGERP arg1 then
+      n := arg1
+      nset := true
+      KDR arg => arg1 := CADR arg
+      arg1 := NIL
+    arg1 =>
+      arg2 := selectOptionLC(arg1,'(input both),nil)
+      if arg2
+        then ((showInputOrBoth := arg2) = 'both) and (null nset) => n:= 5
+        else sayMSG
+          concat('"  ",bright arg1,'"is an invalid argument.")
+  if n >= $IOindex then n:= $IOindex-1
+  mini:= $IOindex-n
+  maxi:= $IOindex-1
+  showInputOrBoth = 'both =>
+    UNWIND_-PROTECT(showInOut(mini,maxi),setIOindex(maxi+1))
+  showInput(mini,maxi)
+
+setIOindex(n) ==
+  -- set $IOindex to n
+  $IOindex:= n
+
+showInput(mini,maxi) ==
+  -- displays all input lines from mini to maxi
+  for ind in mini..maxi repeat
+    vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
+    if ind<10 then TAB 2 else if ind<100 then TAB 1
+    l := CAR vec
+    STRINGP l =>
+      sayMSG ['"   [",ind,'"] ",CAR vec]
+    sayMSG ['"   [",ind,'"] " ]
+    for ln in l repeat
+      sayMSG ['"      ", ln]
+
+showInOut(mini,maxi) ==
+  -- displays all steps from mini to maxi
+  for ind in mini..maxi repeat
+    vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
+    sayMSG [CAR vec]
+    Alist:= ASSQ('%,CDR vec) =>
+      triple:= CDR ASSQ('value,CDR Alist)
+      $IOindex:= ind
+      spadPrint(objValUnwrap triple,objMode triple)
+
+fetchOutput(n) ==
+  -- result is the output of step n
+  (n = -1) and (val := getI("%",'value)) => val
+  $HiFiAccess =>
+    n:=
+      n < 0 => $IOindex+n
+      n
+    n >= $IOindex => throwKeyedMsg("S2IH0001",[n])
+    n < 1        => throwKeyedMsg("S2IH0002",[n])
+    vec:= UNWIND_-PROTECT(readHiFi(n),disableHist())
+    Alist:= ASSQ('%,CDR vec) =>
+      val:= CDR ASSQ('value,CDR Alist) => val
+      throwKeyedMsg("S2IH0003",[n])
+    throwKeyedMsg("S2IH0003",[n])
+  throwKeyedMsg("S2IH0004",NIL)
+
+readHiFi(n) ==
+  -- reads the file using index n
+  if $useInternalHistoryTable
+  then
+    pair := assoc(n,$internalHistoryTable)
+    ATOM pair => keyedSystemError("S2IH0034",NIL)
+    vec := QCDR pair
+  else
+    HiFi:= RDEFIOSTREAM ['(MODE . INPUT),['FILE,:histFileName()]]
+    vec:= SPADRREAD(object2Identifier n,HiFi)
+    RSHUT HiFi
+  vec
+
+writeHiFi() ==
+  -- writes the information of the current step out to history file
+  if $useInternalHistoryTable
+  then
+    $internalHistoryTable := CONS([$IOindex,$currentLine,:$HistRecord],
+      $internalHistoryTable)
+  else
+    HiFi:= RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
+    SPADRWRITE(object2Identifier $IOindex, CONS($currentLine,$HistRecord),HiFi)
+    RSHUT HiFi
+
+disableHist() ==
+  -- disables the history mechanism if an error occurred in the protected
+  -- piece of code
+  not $HiFiAccess => histFileErase histFileName()
+  NIL
+
+writeHistModesAndValues() ==
+  for [a,:.] in CAAR $InteractiveFrame repeat
+    x := get(a,'value,$InteractiveFrame) =>
+      putHist(a,'value,x,$InteractiveFrame)
+    x := get(a,'mode,$InteractiveFrame) =>
+      putHist(a,'mode,x,$InteractiveFrame)
+  NIL
+
+SPADRREAD(vec, stream) ==
+    dewritify rread(vec, stream, nil)
+
+--% Lisplib output transformations
+--  Some types of objects cannot be saved by LISP/VM in lisplibs.
+--  These functions transform an object to a writable form and back.
+--  SMW
+SPADRWRITE(vec, item, stream) ==
+  val := SPADRWRITE0(vec, item, stream) 
+  val = 'writifyFailed =>
+    throwKeyedMsg("S2IH0036", nil) ; cannot save value to file
+  item
+
+SPADRWRITE0(vec, item, stream) ==
+    val := safeWritify item
+    val = 'writifyFailed => val
+    rwrite(vec, val, stream)
+    item
+
+safeWritify ob ==
+  CATCH('writifyTag,  writify ob)
+
+writify ob ==
+    not ScanOrPairVec(function(unwritable?), ob) => ob
+    $seen:     local := MAKE_-HASHTABLE 'EQ
+    $writifyComplained: local := false
+ 
+    writifyInner ob where
+        writifyInner ob ==
+            null ob                => nil
+            (e := HGET($seen, ob)) => e
+ 
+            PAIRP ob =>
+                qcar := QCAR ob
+                qcdr := QCDR ob
+                (name := spadClosure? ob) =>
+                   d := writifyInner QCDR ob
+                   nob := ['WRITIFIED_!_!, 'SPADCLOSURE, d, name]
+                   HPUT($seen, ob, nob)
+                   HPUT($seen, nob, nob)
+                   nob
+                (ob is ['LAMBDA_-CLOSURE, ., ., x, :.]) and x =>
+                  THROW('writifyTag, 'writifyFailed)
+                nob := CONS(qcar, qcdr)
+                HPUT($seen, ob, nob)
+                HPUT($seen, nob, nob)
+                qcar := writifyInner qcar
+                qcdr := writifyInner qcdr
+                QRPLACA(nob, qcar)
+                QRPLACD(nob, qcdr)
+                nob
+            VECP ob =>
+                isDomainOrPackage ob =>
+                    d := mkEvalable devaluate ob
+                    nob := ['WRITIFIED_!_!, 'DEVALUATED, writifyInner d]
+                    HPUT($seen, ob, nob)
+                    HPUT($seen, nob, nob)
+                    nob
+                n   := QVMAXINDEX ob
+                nob := MAKE_-VEC(n+1)
+                HPUT($seen, ob, nob)
+                HPUT($seen, nob, nob)
+                for i in 0..n repeat
+                    QSETVELT(nob, i, writifyInner QVELT(ob,i))
+                nob
+            ob = 'WRITIFIED_!_! =>
+                ['WRITIFIED_!_!, 'SELF]
+            -- In CCL constructors are also compiled functions, so we 
+            -- need this line:
+            constructor? ob => ob
+            COMPILED_-FUNCTION_-P ob =>
+                THROW('writifyTag, 'writifyFailed)
+            HASHTABLEP ob =>
+                nob := ['WRITIFIED_!_!]
+                HPUT($seen, ob,  nob)
+                HPUT($seen, nob, nob)
+                keys := HKEYS ob
+                QRPLACD(nob,
+                        ['HASHTABLE,
+                          HASHTABLE_-CLASS ob,
+                            writifyInner keys,
+                              [writifyInner HGET(ob,k) for k in keys]])
+                nob
+            PLACEP ob =>
+                nob := ['WRITIFIED_!_!, 'PLACE]
+                HPUT($seen, ob,  nob)
+                HPUT($seen, nob, nob)
+                nob
+            -- The next three types cause an error on de-writifying.
+            -- Create an object of the right shape, nonetheless.
+            READTABLEP ob =>
+                THROW('writifyTag, 'writifyFailed)
+            -- Default case: return the object itself.
+            STRINGP ob =>
+                EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM]
+                EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM]
+                ob
+            FLOATP ob =>
+                ob = READ_-FROM_-STRING STRINGIMAGE ob => ob
+                ['WRITIFIED_!_!, 'FLOAT, ob,:
+                   MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob]
+            ob
+
+
+unwritable? ob ==
+    PAIRP  ob or VECP ob       => false   -- first for speed
+    COMPILED_-FUNCTION_-P   ob or HASHTABLEP ob => true
+    PLACEP ob or READTABLEP ob => true
+    FLOATP ob => true
+    false
+
+-- Create a full isomorphic object which can be saved in a lisplib.
+-- Note that  dewritify(writify(x))  preserves UEQUALity of hashtables.
+-- HASHTABLEs go both ways.
+-- READTABLEs cannot presently be transformed back.
+ 
+writifyComplain s ==
+   $writifyComplained  = true => nil
+   $writifyComplained := true
+   sayKeyedMsg("S2IH0027",[s]) 
+
+spadClosure? ob ==
+  fun := QCAR ob
+  not (name := BPINAME fun) => nil
+  vec := QCDR ob
+  not VECP vec => nil
+  name
+
+dewritify ob ==
+    (not ScanOrPairVec(function is?, ob)
+            where  is? a == a = 'WRITIFIED_!_!) => ob
+ 
+    $seen:     local := MAKE_-HASHTABLE 'EQ
+ 
+    dewritifyInner ob where
+        dewritifyInner ob ==
+            null ob => nil
+            e := HGET($seen, ob) => e
+ 
+            PAIRP ob and CAR ob = 'WRITIFIED_!_! =>
+                type := ob.1
+                type = 'SELF =>
+                    'WRITIFIED_!_!
+                type = 'BPI =>
+                    oname := ob.2
+                    f :=
+                        INTP oname => EVAL GENSYMMER oname
+                        SYMBOL_-FUNCTION oname
+                    not COMPILED_-FUNCTION_-P f =>
+                        error '"A required BPI does not exist."
+                    #ob > 3 and HASHEQ f ^= ob.3 =>
+                        error '"A required BPI has been redefined."
+                    HPUT($seen, ob, f)
+                    f
+                type = 'HASHTABLE =>
+                    nob := MAKE_-HASHTABLE ob.2
+                    HPUT($seen, ob, nob)
+                    HPUT($seen, nob, nob)
+                    for k in ob.3 for e in ob.4 repeat
+                        HPUT(nob, dewritifyInner k, dewritifyInner e)
+                    nob
+                type = 'DEVALUATED =>
+                    nob := EVAL dewritifyInner ob.2
+                    HPUT($seen, ob, nob)
+                    HPUT($seen, nob, nob)
+                    nob
+                type = 'SPADCLOSURE =>
+                    vec := dewritifyInner ob.2
+                    name := ob.3
+                    not FBOUNDP name => 
+                       error STRCONC('"undefined function: ", SYMBOL_-NAME name)
+                    nob := CONS(SYMBOL_-FUNCTION name, vec)
+                    HPUT($seen, ob, nob)
+                    HPUT($seen, nob, nob)
+                    nob
+                type = 'PLACE =>
+                    nob := READ MAKE_-INSTREAM NIL
+                    HPUT($seen, ob, nob)
+                    HPUT($seen, nob, nob)
+                    nob
+                type = 'READTABLE =>
+                    error '"Cannot de-writify a read table."
+                type = 'NULLSTREAM => $NullStream
+                type = 'NONNULLSTREAM => $NonNullStream
+                type = 'FLOAT =>
+	           [fval, signif, expon, sign] := CDDR ob
+                   fval := SCALE_-FLOAT( FLOAT(signif, fval), expon)
+                   sign<0 => -fval
+                   fval
+                error '"Unknown type to de-writify."
+ 
+            PAIRP ob =>
+                qcar := QCAR ob
+                qcdr := QCDR ob
+                nob  := CONS(qcar, qcdr)
+                HPUT($seen, ob, nob)
+                HPUT($seen, nob, nob)
+                QRPLACA(nob, dewritifyInner qcar)
+                QRPLACD(nob, dewritifyInner qcdr)
+                nob
+            VECP ob =>
+                n   := QVMAXINDEX ob
+                nob := MAKE_-VEC(n+1)
+                HPUT($seen, ob, nob)
+                HPUT($seen, nob, nob)
+                for i in 0..n repeat
+                    QSETVELT(nob, i, dewritifyInner QVELT(ob,i))
+                nob
+            -- Default case: return the object itself.
+            ob
+
+ScanOrPairVec(f, ob) ==
+    $seen:     local := MAKE_-HASHTABLE 'EQ
+ 
+    CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where
+        ScanOrInner(f, ob) ==
+            HGET($seen, ob) => nil
+            PAIRP ob =>
+                HPUT($seen, ob, true)
+                ScanOrInner(f, QCAR ob)
+                ScanOrInner(f, QCDR ob)
+                nil
+            VECP ob =>
+                HPUT($seen, ob, true)
+                for i in 0..#ob-1 repeat ScanOrInner(f, ob.i)
+                nil
+            FUNCALL(f, ob) =>
+                THROW('ScanOrPairVecAnswer, true)
+            nil
+
+
+
+
+
+--% )load
+
+load args == loadSpad2Cmd args
+
+loadSpad2Cmd args ==
+    sayKeyedMsg("S2IU0003", nil)
+    NIL
+--  load1(args,$forceDatabaseUpdate)
+
+--load1(args,$forceDatabaseUpdate) ==  -- $ var is now local
+--  null args => helpSpad2Cmd '(load)
+--  loadfun := 'loadLib
+--  justWondering := nil
+--  compiler := 'old
+--  doExpose := true
+--  $forceDatabaseUpdate := true  -- BMT request, 5/14/90
+--  for [opt,:.] in $options repeat
+--    fullopt := selectOptionLC(opt,
+--      '(cond update query new noexpose noupdate),
+--        'optionError)
+--    fullopt = 'cond     => loadfun := 'loadLibIfNotLoaded
+--    fullopt = 'query    => justWondering := true
+--    fullopt = 'update   => $forceDatabaseUpdate := true
+--    fullopt = 'noexpose => doExpose := false
+--    fullopt = 'noupdate => $forceDatabaseUpdate := false
+--  if $forceDatabaseUpdate then clearClams()
+--  for lib in args repeat
+--    lib := object2Identifier lib
+--    justWondering =>
+--      GETL(lib,'LOADED) => sayKeyedMsg("S2IZ0028",[lib])
+--      sayKeyedMsg("S2IZ0029",[lib])
+--    null GETDATABASE(lib,'OBJECT) and
+--     null (lib := GETDATABASE(lib,'CONSTRUCTOR)) =>
+--      sayKeyedMsg("S2IL0020", [namestring [lib,$spadLibFT,"*"]])
+--    null FUNCALL(loadfun,lib) =>
+--      sayKeyedMsg("S2IZ0029",[lib])
+--    sayKeyedMsg("S2IZ0028",[lib])
+--    if doExpose and
+--       not isExposedConstructor(lib) then
+--          setExposeAddConstr([lib])
+--  'EndOfLoad
+
+reportCount () ==
+  centerAndHighlight(" Current Count Settings ",$LINELENGTH,specialChar 'hbar)
+  SAY " "
+  sayBrightly [:bright " cache",fillerSpaces(30,'".")," ",$cacheCount]
+  if $cacheAlist then
+    for [a,:b] in $cacheAlist repeat
+      aPart:= linearFormatName a
+      n:= sayBrightlyLength aPart
+      sayBrightly concat("     ",aPart," ",fillerSpaces(32-n,'".")," ",b)
+  SAY " "
+  sayBrightly [:bright " stream",fillerSpaces(29,'".")," ",$streamCount]
+
+--% )quit
+
+pquit() == pquitSpad2Cmd()
+
+pquitSpad2Cmd() ==
+  $saturn =>
+    sayErrorly('"Obsolete system command", _
+      ['" The )pquit system command is obsolete in this version of AXIOM.",
+       '" Please select Exit from the File Menu instead."])
+  $quitCommandType :local := 'protected
+  quitSpad2Cmd()
+
+quit() == quitSpad2Cmd()
+
+quitSpad2Cmd() ==
+  $saturn =>
+    sayErrorly('"Obsolete system command", _
+      ['" The )quit system command is obsolete in this version of AXIOM.",
+       '" Please select Exit from the File Menu instead."])
+  $quitCommandType ^= 'protected => leaveScratchpad()
+  x := UPCASE queryUserKeyedMsg("S2IZ0031",NIL)
+  MEMQ(STRING2ID_-N(x,1),'(Y YES)) => leaveScratchpad()
+  sayKeyedMsg("S2IZ0032",NIL)
+  TERSYSCOMMAND ()
+
+leaveScratchpad () == BYE()
+
+--% )read
+
+read l == readSpad2Cmd l
+
+readSpad2Cmd l ==
+  ---$saturn =>
+  ---  sayErrorly('"Obsolete system command", _
+  ---    ['" The )read  system command is obsolete in this version of AXIOM.",
+  ---     '" Please use Open from the File menu instead."])
+  $InteractiveMode : local := true
+  quiet := nil
+  ifthere := nil
+  for [opt,:.] in $options repeat
+    fullopt := selectOptionLC(opt,'(quiet test ifthere),'optionError)
+    fullopt = 'ifthere => ifthere  := true
+    fullopt = 'quiet   => quiet := true
+
+  ef := pathname _/EDITFILE
+  if pathnameTypeId(ef) = 'SPAD then
+    ef := makePathname(pathnameName ef,'"*",'"*")
+  if l then
+    l := mergePathnames(pathname l,ef)
+  else
+    l := ef
+  devFTs := '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")
+  fileTypes :=
+    $UserLevel = 'interpreter => '("input" "INPUT")
+    $UserLevel = 'compiler    => '("input" "INPUT")
+    devFTs
+  ll := $FINDFILE (l, fileTypes)
+  if null ll then
+    ifthere => return nil    -- be quiet about it
+    throwKeyedMsg("S2IL0003",[namestring l])
+  ll := pathname ll
+  ft := pathnameType ll
+  upft := UPCASE ft
+  null member(upft,fileTypes) =>
+    fs := namestring l
+    member(upft,devFTs) => throwKeyedMsg("S2IZ0033",[fs])
+    throwKeyedMsg("S2IZ0034",[fs])
+  SETQ(_/EDITFILE,ll)
+  if upft = '"BOOT" then $InteractiveMode := nil
+  _/READ(ll,quiet)
+
+--% )savesystem
+savesystem l ==
+  #l ^= 1 or not(SYMBOLP CAR l) => helpSpad2Cmd '(savesystem)
+  SPAD_-SAVE SYMBOL_-NAME CAR l
+
+--% )show
+
+show l == showSpad2Cmd l
+
+showSpad2Cmd l ==
+  l = [NIL] => helpSpad2Cmd '(show)
+  $showOptions : local := '(attributes operations)
+  if null $options then $options := '((operations))
+  $e : local := $InteractiveFrame
+  $env : local := $InteractiveFrame
+  l is [constr] =>
+    constr in '(Union Record Mapping) =>
+      constr = 'Record =>
+        sayKeyedMsg("S2IZ0044R",[constr, '")show Record(a: Integer, b: String)"])
+      constr = 'Mapping =>
+        sayKeyedMsg("S2IZ0044M",NIL)
+      sayKeyedMsg("S2IZ0045T",[constr, '")show Union(a: Integer, b: String)"])
+      sayKeyedMsg("S2IZ0045U",[constr, '")show Union(Integer, String)"])
+    constr is ['Mapping, :.] =>
+      sayKeyedMsg("S2IZ0044M",NIL)
+    reportOperations(constr,constr)
+  reportOperations(l,l)
+
+reportOperations(oldArg,u) ==
+  -- u might be an uppercased version of oldArg
+  $env:local := [[NIL]]
+  $eval:local := true           --generate code-- don't just type analyze
+  $genValue:local := true       --evaluate all generated code
+  null u => nil
+  $doNotAddEmptyModeIfTrue: local:= true
+  u = $quadSymbol =>
+     sayBrightly ['"   mode denotes", :bright '"any", "type"]
+  u = "%" =>
+    sayKeyedMsg("S2IZ0063",NIL)
+    sayKeyedMsg("S2IZ0064",NIL)
+  u isnt ['Record,:.] and u isnt ['Union,:.] and
+    null(isNameOfType u) and u isnt ['typeOf,.] =>
+      if ATOM oldArg then oldArg := [oldArg]
+      sayKeyedMsg("S2IZ0063",NIL)
+      for op in oldArg repeat
+        sayKeyedMsg("S2IZ0062",[opOf op])
+  (v := isDomainValuedVariable u) =>  reportOpsFromUnitDirectly0 v
+  unitForm:=
+    atom u => opOf unabbrev u
+    unabbrev u
+  atom unitForm => reportOpsFromLisplib0(unitForm,u)
+  unitForm' := evaluateType unitForm
+  tree := mkAtree removeZeroOneDestructively unitForm
+  (unitForm' := isType tree) => reportOpsFromUnitDirectly0 unitForm'
+  sayKeyedMsg("S2IZ0041",[unitForm])
+
+reportOpsFromUnitDirectly0 D ==
+  $useEditorForShowOutput =>
+    reportOpsFromUnitDirectly1 D
+  reportOpsFromUnitDirectly D
+
+reportOpsFromUnitDirectly1 D ==
+  showFile := pathname ['SHOW,'LISTING,$listingDirectory]
+  _$ERASE showFile
+  $sayBrightlyStream : fluid :=
+    DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0)
+  sayShowWarning()
+  reportOpsFromUnitDirectly D
+  SHUT $sayBrightlyStream
+  editFile showFile
+
+sayShowWarning() ==
+  sayBrightly
+    '"Warning: this is a temporary file and will be deleted the next"
+  sayBrightly
+    '"         time you use )show. Rename it and FILE if you wish to"
+  sayBrightly
+    '"         save the contents."
+  sayBrightly '""
+
+reportOpsFromLisplib0(unitForm,u)  ==
+  $useEditorForShowOutput => reportOpsFromLisplib1(unitForm,u)
+  reportOpsFromLisplib(unitForm,u)
+
+reportOpsFromLisplib1(unitForm,u)  ==
+  showFile := pathname ['SHOW,'LISTING,$listingDirectory]
+  _$ERASE showFile
+  $sayBrightlyStream : fluid :=
+    DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0)
+  sayShowWarning()
+  reportOpsFromLisplib(unitForm,u)
+  SHUT $sayBrightlyStream
+  editFile showFile
+
+reportOpsFromUnitDirectly unitForm ==
+  isRecordOrUnion := unitForm is [a,:.] and a in '(Record Union)
+  unit:= evalDomain unitForm
+  top:= CAR unitForm
+  kind:= GETDATABASE(top,'CONSTRUCTORKIND)
+
+  sayBrightly concat('%b,formatOpType unitForm,
+    '%d,'"is a",'%b,kind,'%d, '"constructor.")
+  if not isRecordOrUnion then
+    abb := GETDATABASE(top,'ABBREVIATION)
+    sourceFile := GETDATABASE(top,'SOURCEFILE)
+    sayBrightly ['" Abbreviation for",:bright top,'"is",:bright abb]
+    verb :=
+      isExposedConstructor top => '"is"
+      '"is not"
+    sayBrightly ['" This constructor",:bright verb,
+      '"exposed in this frame."]
+    sayBrightly ['" Issue",:bright STRCONC('")edit ",
+      namestring sourceFile),'"to see algebra source code for",
+        :bright abb,'%l]
+
+  for [opt] in $options repeat
+    opt := selectOptionLC(opt,$showOptions,'optionError)
+    opt = 'attributes =>
+      centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar)
+      isRecordOrUnion =>
+        sayBrightly '"   Records and Unions have no attributes."
+      sayBrightly '""
+      attList:= REMDUP MSORT [x for [x,:.] in unit.2]
+      say2PerLine [formatAttribute x for x in attList]
+      NIL
+    opt = 'operations =>
+      $commentedOps: local := 0
+      --new form is (<op> <signature> <slotNumber> <condition> <kind>)
+      centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar)
+      sayBrightly '""
+      if isRecordOrUnion
+        then
+          constructorFunction:= GETL(top,"makeFunctionList") or
+            systemErrorHere '"reportOpsFromUnitDirectly"
+          [funlist,.]:= FUNCALL(constructorFunction,"$",unitForm,
+            $CategoryFrame)
+          sigList := REMDUP MSORT [[[a,b],true,[c,0,1]] for
+            [a,b,c] in funlist]
+        else
+          sigList:= REMDUP MSORT getOplistForConstructorForm unitForm
+      say2PerLine [formatOperation(x,unit) for x in sigList]
+      if $commentedOps ^= 0 then
+        sayBrightly
+          ['"Functions that are not yet implemented are preceded by",
+            :bright '"--"]
+      sayBrightly '""
+  NIL
+
+reportOpsFromLisplib(op,u) ==
+  null(fn:= constructor? op) => sayKeyedMsg("S2IZ0054",[u])
+  argml :=
+    (s := getConstructorSignature op) => KDR s
+    NIL
+  typ:= GETDATABASE(op,'CONSTRUCTORKIND)
+  nArgs:= #argml
+  argList:= KDR GETDATABASE(op,'CONSTRUCTORFORM)
+  functorForm:= [op,:argList]
+  argml:= EQSUBSTLIST(argList,$FormalMapVariableList,argml)
+  functorFormWithDecl:= [op,:[[":",a,m] for a in argList for m in argml]]
+  sayBrightly concat(bright form2StringWithWhere functorFormWithDecl,
+                     '" is a",bright typ,'"constructor")
+  sayBrightly ['" Abbreviation for",:bright op,'"is",:bright fn]
+  verb :=
+    isExposedConstructor op => '"is"
+    '"is not"
+  sayBrightly ['" This constructor",:bright verb,
+    '"exposed in this frame."]
+  sourceFile := GETDATABASE(op,'SOURCEFILE)
+  sayBrightly ['" Issue",:bright STRCONC('")edit ",
+    namestring sourceFile),
+      '"to see algebra source code for",:bright fn,'%l]
+
+  for [opt] in $options repeat
+    opt := selectOptionLC(opt,$showOptions,'optionError)
+    opt = 'layout =>
+      dc1 fn
+    opt = 'views => sayBrightly ['"To get",:bright '"views",
+      '"you must give parameters of constructor"]
+    opt = 'attributes =>
+      centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar)
+      sayBrightly '""
+      attList:= REMDUP MSORT [x for [x,:.] in
+        GETDATABASE(op,'ATTRIBUTES)]
+      null attList => sayBrightly
+        concat('%b,form2String functorForm,'%d,"has no attributes.",'%l)
+      say2PerLine [formatAttribute x for x in attList]
+      NIL
+    opt = 'operations => displayOperationsFromLisplib functorForm
+    nil
+
+displayOperationsFromLisplib form ==
+  [name,:argl] := form
+  kind := GETDATABASE(name,'CONSTRUCTORKIND)
+  centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar)
+  opList:= GETDATABASE(name,'OPERATIONALIST)
+  null opList => reportOpsFromUnitDirectly form
+  opl:=REMDUP MSORT EQSUBSTLIST(argl,$FormalMapVariableList,opList)
+  ops:= nil
+  for x in opl repeat
+    ops := [:ops,:formatOperationAlistEntry(x)]
+  say2PerLine ops
+  nil
+
+--% )synonym
+
+synonym(:l) == synonymSpad2Cmd()  -- always passed a null list
+
+synonymSpad2Cmd() ==
+  line := getSystemCommandLine()
+  if line = '"" then printSynonyms(NIL)
+  else
+    pair := processSynonymLine line
+    if $CommandSynonymAlist then
+      PUTALIST($CommandSynonymAlist,CAR pair, CDR pair)
+    else $CommandSynonymAlist := [pair]
+  terminateSystemCommand()
+
+processSynonymLine line ==
+  key := STRING2ID_-N (line, 1)
+  value := removeKeyFromLine line where
+    removeKeyFromLine line ==
+      line := dropLeadingBlanks line
+      mx := MAXINDEX line
+      for i in 0..mx repeat
+        line.i = " " =>
+          return (for j in (i+1)..mx repeat
+            line.j ^= " " => return (SUBSTRING (line, j, nil)))
+  [key, :value]
+
+
+--%
+--% )undo
+--%
+
+$undoFlag := true     --Default setting for undo is "on"
+
+
+undo(l) ==
+--undo takes one option ")redo" which simply reads "redo.input",
+--  a file created by every normal )undo command (see below)
+  undoWhen := 'after
+  if $options is [[key]] then
+    stringPrefix?(s := PNAME key,'"redo") =>
+      $options := nil           --clear $options so that "read" won't see them
+      read '(redo_.input)
+    not stringPrefix?(s,'"before") =>
+       userError '"only option to undo is _")redo_""
+    undoWhen := 'before
+  n :=
+    null l => -1
+    first l
+  if IDENTP n then
+    n := PARSE_-INTEGER PNAME n
+    if not FIXP n then userError '"undo argument must be an integer"
+  $InteractiveFrame := undoSteps(undoCount n,undoWhen)
+  nil
+
+recordFrame(systemNormal) ==
+  null $undoFlag => nil        --do nothing if facility is turned off
+  currentAlist := KAR $frameRecord
+  delta := diffAlist(CAAR $InteractiveFrame,$previousBindings)
+  if systemNormal = 'system then
+    null delta => return nil     --do not record
+    delta := ['systemCommand,:delta]
+  $frameRecord := [delta,:$frameRecord]
+  $previousBindings := --copy all but the individual properties
+    [CONS(CAR x,[CONS(CAR y,CDR y) for y in CDR x]) for x in CAAR $InteractiveFrame]
+  first $frameRecord
+
+diffAlist(new,old) ==
+--record only those properties which are different
+  for (pair := [name,:proplist]) in new repeat
+    -- name has an entry both in new and old world
+    -- (1) if the old world had no proplist for that variable, then
+    --     record NIL as the value of each new property
+    -- (2) if the old world does have a proplist for that variable, then
+    --     a) for each property with a value: give the old value
+    --     b) for each property missing:      give NIL as the old value
+    oldPair := ASSQ(name,old) =>
+      null (oldProplist := CDR oldPair) =>
+      --record old values of new properties as NIL
+        acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
+      deltas := nil
+      for (propval := [prop,:val]) in proplist repeat
+        null (oldPropval := ASSOC(prop,oldProplist)) => --missing property
+          deltas := [[prop],:deltas]
+        EQ(CDR oldPropval,val) => 'skip
+        deltas := [oldPropval,:deltas]
+      deltas => acc := [[name,:NREVERSE deltas],:acc]
+    acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
+--record properties absent on new list (say, from a )cl all)
+  for (oldPair := [name,:r]) in old repeat
+    r and null LASSQ(name,new) =>
+      acc := [oldPair,:acc]
+    -- name has an entry both in new and old world
+    -- (1) if the new world has no proplist for that variable
+    --     (a) if the old world does, record the old proplist
+    --     (b) if the old world does not, record nothing
+    -- (2) if the new world has a proplist for that variable, it has
+    --     been handled by the first loop.
+  res := NREVERSE acc
+  if BOUNDP '$reportUndo and $reportUndo then reportUndo res
+  res
+
+reportUndo acc ==
+  for [name,:proplist] in acc repeat
+    sayBrightly STRCONC("Properties of ",PNAME name,'" ::")
+    curproplist := LASSOC(name,CAAR $InteractiveFrame)
+    for [prop,:value] in proplist repeat
+      sayBrightlyNT ['"  ",prop,'" was: "]
+      pp value
+      sayBrightlyNT ['"  ",prop,'" is:  "]
+      pp LASSOC(prop,curproplist)
+
+clearFrame() ==
+  clearCmdAll()
+  $frameRecord := nil
+  $previousBindings := nil
+
+
+--=======================================================================
+--              Undoing previous m commands
+--=======================================================================
+undoCount(n) ==  --computes the number of undo's, given $IOindex
+--pp ["IOindex = ",$IOindex]
+  m :=
+    n >= 0 => $IOindex - n - 1
+    -n
+  m >= $IOindex => userError STRCONC('"Magnitude of undo argument must be less than step number (",STRINGIMAGE $IOindex,'").")
+  m
+
+
+undoSteps(m,beforeOrAfter) ==
+-- undoes m previous commands; if )before option, then undo one extra at end
+--Example: if $IOindex now is 6 and m = 2 then general layout of $frameRecord,
+--  after the call to recordFrame below will be:
+--  (<change for systemcommands>
+--  (<change for #5> <change for system commands>
+--  (<change for #4> <change for system commands>
+--  (<change for #3> <change for system commands>
+--   <change for #2> <change for system commands>
+--   <change for #1> <change for system commands>) where system
+--  command entries are optional and identified by (systemCommand . change).
+--  For a ")undo 3 )after", m = 2 and undoStep swill restore the environment
+--  up to, but not including <change for #3>.
+--  An "undo 3 )before" will additionally restore <change for #3>.
+--  Thus, the later requires one extra undo at the end.
+  writeInputLines('redo,$IOindex - m)
+  recordFrame('normal)  --do NOT mark this as a system command change
+                       --do this undo FIRST (i=0 case)
+  env := COPY CAAR $InteractiveFrame
+  for i in 0..m for framelist in tails $frameRecord repeat
+    env := undoSingleStep(first framelist,env)
+    framelist is [.,['systemCommand,:systemDelta],:.] =>
+--     pp '"===============> AHA <============="
+       framelist := rest framelist             --undoing system commands given
+       env := undoSingleStep(systemDelta,env)  --  before command line
+    lastTailSeen := framelist
+  if beforeOrAfter = 'before then  --do one additional undo for )before
+    env := undoSingleStep(first rest lastTailSeen,env)
+  $frameRecord := rest $frameRecord --flush the effect of extra recordFrame
+  $InteractiveFrame := LIST LIST env
+
+
+undoSingleStep(changes,env) ==
+--Each change is a name-proplist pair. For each change:
+--  (1) if there exists a proplist in env, then for each prop-value change:
+--      (a) if the prop exists in env, RPLAC in the change value
+--      (b) otherwise, CONS it onto the front of prop-values for that name
+--  (2) add change to the front of env
+--  pp '"----Undoing 1 step--------"
+--  pp changes
+  for (change := [name,:changeList]) in changes repeat
+    if LASSOC('localModemap,changeList) then
+      changeList := undoLocalModemapHack changeList
+    pairlist := ASSQ(name,env) =>
+      proplist := CDR pairlist =>
+        for (pair := [prop,:value]) in changeList repeat
+          node := ASSQ(prop,proplist) => RPLACD(node,value)
+          RPLACD(proplist,[CAR proplist,:CDR proplist])
+          RPLACA(proplist,pair)
+      RPLACD(pairlist,changeList)
+    env := [change,:env]
+  env
+
+undoLocalModemapHack changeList ==
+  [newPair for (pair := [name,:value]) in changeList | newPair] where newPair  ==
+     name = 'localModemap => [name]
+     pair
+
+removeUndoLines u == --called by writeInputLines
+  xtra :=
+    STRINGP $currentLine => [$currentLine]
+    REVERSE $currentLine
+  xtra := [x for x in xtra | not stringPrefix?('")history",x)]
+  u := [:u, :xtra]
+  not (or/[stringPrefix?('")undo",x) for x in u])  => u
+  --(1) reverse the list
+  --(2) walk down the (reversed) list: when >n appears remove:
+  --    (a) system commands
+  --    (b) if n > 0: (replace n by n-1; remove a command; repeat (a-b))
+  savedIOindex := $IOindex  --save value
+  $IOindex := 1
+  for y in tails u repeat
+    (x := first y).0 = char '_) =>
+      stringPrefix?('")undo",s := trimString x) => --parse "undo )option"
+        s1 := trimString SUBSTRING(s,5,nil)
+        if s1 ^= '")redo" then
+          m := charPosition(char '_),s1,0)
+          code :=
+            m < MAXINDEX s1 => s1.(m + 1)
+            char 'a
+          s2 := trimString SUBSTRING(s1,0,m)
+        n :=
+           s1 = '")redo" => 0
+           s2 ^= '"" => undoCount PARSE_-INTEGER s2
+           -1
+        RPLACA(y,CONCAT('">",code,STRINGIMAGE n))
+      nil
+    $IOindex := $IOindex + 1   --referenced by undoCount
+  acc := nil
+  for y in tails NREVERSE u repeat
+    (x := first y).0 = char '_> =>
+      code := x . 1                                 --code = a,b, or r
+      n := PARSE_-INTEGER SUBSTRING(x,2,nil)        --n = number of undo steps
+      y := rest y                                   --kill >n line
+      while y repeat
+        c := first y
+        c.0 = char '_) or c.0 = char '_> => y := rest y  --kill system commands
+        n = 0 => return nil                              --including undos
+        n := n - 1
+        y := rest y                                 --kill command
+      y and code^= char 'b => acc := [c,:acc]       --add last unless )before
+    acc := [x,:acc]
+  $IOindex := savedIOindex
+  acc
+
+
+
+
+--% )what
+
+
+what l == whatSpad2Cmd l
+
+whatSpad2Cmd l ==
+  $e:local := $EmptyEnvironment
+  null l => reportWhatOptions()
+  [key0,:args] := l
+  key := selectOptionLC(key0,$whatOptions,nil)
+  null key => sayKeyedMsg("S2IZ0043",NIL)
+  args := [fixpat p for p in args] where
+    fixpat x ==
+      x is [x',:.] => DOWNCASE x'
+      DOWNCASE x
+  key = 'things =>
+    for opt in $whatOptions repeat
+      not MEMQ(opt,'(things)) => whatSpad2Cmd [opt,:args]
+  key = 'categories =>
+    filterAndFormatConstructors('category,'"Categories",args)
+  key = 'commands =>
+    whatCommands(args)
+  key = 'domains =>
+    filterAndFormatConstructors('domain,'"Domains",args)
+  key = 'operations =>
+    apropos args
+  key = 'packages =>
+    filterAndFormatConstructors('package,'"Packages",args)
+  key = 'synonyms =>
+    printSynonyms(args)
+
+filterAndFormatConstructors(constrType,label,patterns) ==
+  centerAndHighlight(label,$LINELENGTH,specialChar 'hbar)
+  l := filterListOfStringsWithFn(patterns,whatConstructors constrType,
+        function CDR)
+  if patterns then
+    null l =>
+      sayMessage ['"   No ",label,'" with names matching patterns:",
+        '%l,'"   ",'%b,:blankList patterns,'%d]
+    sayMessage [label,'" with names matching patterns:",
+      '%l,'"   ",'%b,:blankList patterns,'%d]
+  l => pp2Cols l
+
+whatConstructors constrType ==
+  -- here constrType should be one of 'category, 'domain, 'package
+  MSORT [CONS(GETDATABASE(con,'ABBREVIATION), STRING(con))
+    for con in allConstructors()
+      | GETDATABASE(con,'CONSTRUCTORKIND) = constrType]
+
+apropos l ==
+  -- l is a list of operation name fragments
+  -- this displays all operation names containing these fragments
+  ops :=
+    null l => allOperations()
+    filterListOfStrings([(DOWNCASE STRINGIMAGE p) for p in l],allOperations())
+  ops =>
+    sayMessage '"Operations whose names satisfy the above pattern(s):"
+    sayAsManyPerLineAsPossible MSORT ops
+    sayKeyedMsg("S2IF0011",[first ops])
+  sayMessage '"   There are no operations containing those patterns"
+  NIL
+
+
+printSynonyms(patterns) ==
+  centerAndHighlight("System Command Synonyms",$LINELENGTH,specialChar 'hbar)
+  ls := filterListOfStringsWithFn(patterns, [[STRINGIMAGE a,:b]
+    for [a,:b] in synonymsForUserLevel $CommandSynonymAlist],
+      function CAR)
+  printLabelledList(ls,'"user",'"synonyms",'")",patterns)
+  nil
+
+printLabelledList(ls,label1,label2,prefix,patterns) ==
+  -- prefix goes before each element on each side of the list, eg,
+  --   ")"
+  null ls =>
+    null patterns =>
+      sayMessage ['"   No ",label1,'"-defined ",label2,'" in effect."]
+    sayMessage ['"   No ",label1,'"-defined ",label2,'" satisfying patterns:",
+     '%l,'"     ",'%b,:blankList patterns,'%d]
+  if patterns then
+    sayMessage [label1,'"-defined ",label2,'" satisfying patterns:",
+     '%l,'"   ",'%b,:blankList patterns,'%d]
+  for [syn,:comm] in ls repeat
+    if SUBSTRING(syn,0,1) = '"|" then syn := SUBSTRING(syn,1,NIL)
+    if syn = '"%i" then syn := '"%i "
+    wid := MAX(30 - (entryWidth syn),1)
+    sayBrightly concat('%b,prefix,syn,'%d,
+      fillerSpaces(wid,'"."),'" ",prefix,comm)
+  sayBrightly '""
+
+whatCommands(patterns) ==
+  label := STRCONC("System Commands for User Level: ",
+    STRINGIMAGE $UserLevel)
+  centerAndHighlight(label,$LINELENGTH,specialChar 'hbar)
+  l := filterListOfStrings(patterns,
+    [(STRINGIMAGE a) for a in commandsForUserLevel $systemCommands])
+  if patterns then
+    null l =>
+      sayMessage ['"No system commands at this level matching patterns:",
+        '%l,'"   ",'%b,:blankList patterns,'%d]
+    sayMessage ['"System commands at this level matching patterns:",
+      '%l,'"   ",'%b,:blankList patterns,'%d]
+  if l then
+    sayAsManyPerLineAsPossible l
+    SAY " "
+  patterns => nil  -- don't be so verbose
+  sayKeyedMsg("S2IZ0046",NIL)
+  nil
+
+reportWhatOptions() ==
+  optList1:= "append"/[['%l,'"        ",x] for x in $whatOptions]
+  sayBrightly
+    ['%b,'"  )what",'%d,'"argument keywords are",'%b,:optList1,'%d,'%l,
+      '"   or abbreviations thereof.",'%l,
+        '%l,'"   Issue",'%b,'")what ?",'%d,'"for more information."]
+
+filterListOfStrings(patterns,names) ==
+  -- names and patterns are lists of strings
+  -- returns: list of strings in names that contains any of the strings
+  -- in patterns
+  (null patterns) or (null names) => names
+  names' := NIL
+  for name in reverse names repeat
+    satisfiesRegularExpressions(name,patterns) =>
+      names' := [name,:names']
+  names'
+
+filterListOfStringsWithFn(patterns,names,fn) ==
+  -- names and patterns are lists of strings
+  -- fn is something like CAR or CADR
+  -- returns: list of strings in names that contains any of the strings
+  -- in patterns
+  (null patterns) or (null names) => names
+  names' := NIL
+  for name in reverse names repeat
+    satisfiesRegularExpressions(FUNCALL(fn,name),patterns) =>
+      names' := [name,:names']
+  names'
+
+satisfiesRegularExpressions(name,patterns) ==
+  -- this is a first cut
+  nf := true
+  dname := DOWNCASE COPY name
+  for pattern in patterns while nf repeat
+    -- use @ as a wildcard
+    STRPOS(pattern,dname,0,'"@") => nf := nil
+  null nf
+
+--% )with ... defined in daase.lisp (boot won't parse it)
+
+--% )workfiles
+
+workfiles l == workfilesSpad2Cmd l
+
+workfilesSpad2Cmd args ==
+  args => throwKeyedMsg("S2IZ0047",NIL)
+  deleteFlag := nil
+  for [type,:.] in $options repeat
+    type1 := selectOptionLC(type,'(boot lisp meta delete),nil)
+    null type1 => throwKeyedMsg("S2IZ0048",[type])
+    type1 = 'delete => deleteFlag := true
+  for [type,:flist] in $options repeat
+    type1 := selectOptionLC(type,'(boot lisp meta delete),nil)
+    type1 = 'delete => nil
+    for file in flist repeat
+      fl := pathname [file,type1,'"*"]
+      deleteFlag => SETQ($sourceFiles,delete(fl,$sourceFiles))
+      null (MAKE_-INPUT_-FILENAME fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
+      updateSourceFiles fl
+  SAY " "
+  centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
+  SAY " "
+  null $sourceFiles => SAY '"   no files specified"
+  SETQ($sourceFiles,SORTBY('pathnameType,$sourceFiles))
+  for fl in $sourceFiles repeat sayBrightly ["   " ,namestring fl]
+
+--% )zsystemdevelopment
+
+zsystemdevelopment l == zsystemDevelopmentSpad2Cmd l
+
+zsystemDevelopmentSpad2Cmd l == zsystemdevelopment1 (l,$InteractiveMode)
+
+zsystemdevelopment1(l,im) ==
+  $InteractiveMode : local := im
+  fromopt := nil
+  -- cycle through once to see if )from is mentioned
+  for [opt,:optargs] in $options repeat
+    opt1 := selectOptionLC(opt,'(from),nil)
+    opt1 = 'from => fromopt := [['FROM,:optargs]]
+  for [opt,:optargs] in $options repeat
+    if null optargs then optargs := l
+    newopt := APPEND(optargs,fromopt)
+    opt1 := selectOptionLC(opt,'(from),nil)
+    opt1 = 'from => nil
+    opt = "c"   => _/D_,1 (newopt ,_/COMP(),NIL,NIL)
+    opt = "d"   => _/D_,1 (newopt ,'DEFINE,NIL,NIL)
+    opt = "dt"  => _/D_,1 (newopt ,'DEFINE,NIL,true)
+    opt = "ct"  => _/D_,1 (newopt ,_/COMP(),NIL,true)
+    opt = "ctl"  => _/D_,1 (newopt ,_/COMP(),NIL,'TRACELET)
+    opt = "ec"  => _/D_,1 (newopt ,_/COMP(),true,NIL)
+    opt = "ect" => _/D_,1 (newopt ,_/COMP(),true,true)
+    opt = "e"   => _/D_,1 (newopt ,NIL,true,NIL)
+    opt = "version" => version()
+    opt = "pause" =>
+      conStream := DEFIOSTREAM ('((DEVICE . CONSOLE) (QUAL . V)),120,0)
+      NEXT conStream
+      SHUT conStream
+    opt = "update" or opt = "patch" =>
+      $InteractiveMode := nil
+      upf := [KAR optargs or _/VERSION, KADR optargs or _/WSNAME,
+              KADDR optargs or '_*]
+      fun := (opt = "patch" => '_/UPDATE_-LIB_-1; '_/UPDATE_-1)
+      CATCH('FILENAM, FUNCALL(fun, upf))
+      sayMessage '"   Update/patch is completed."
+    null optargs =>
+      sayBrightly ['"   An argument is required for",:bright opt]
+    sayMessage ['"   Unknown option:",:bright opt,"    ",'%l,
+      '"   Available options are", _
+      :bright '"c ct e ec ect cls pause update patch compare record"]
+
+--% Synonym File Reader
+
+--------------------> NEW DEFINITION (override in util.lisp.pamphlet)
+processSynonyms() ==
+  p := STRPOS('")",LINE,0,NIL)
+  fill := '""
+  if p
+    then
+      line := SUBSTRING(LINE,p,NIL)
+      if p > 0 then fill := SUBSTRING(LINE,0,p)
+    else
+      p := 0
+      line := LINE
+  to := STRPOS ('" ", line, 1, nil)
+  if to then to := to - 1
+  synstr := SUBSTRING (line, 1, to)
+  syn := STRING2ID_-N (synstr, 1)
+  null (fun := LASSOC (syn, $CommandSynonymAlist)) => NIL
+  to := STRPOS('")",fun,1,NIL)
+  if to and to ^= SIZE(fun)-1 then
+    opt := STRCONC('" ",SUBSTRING(fun,to,NIL))
+    fun := SUBSTRING(fun,0,to-1)
+  else opt := '" "
+  if (SIZE synstr) > (SIZE fun) then
+    for i in (SIZE fun)..(SIZE synstr) repeat
+      fun := CONCAT (fun, '" ")
+--  $currentLine := STRCONC(fill,RPLACSTR(line, 1, SIZE synstr, fun),opt)
+  cl := STRCONC(fill,RPLACSTR(line, 1, SIZE synstr, fun),opt)
+  SETQ(LINE,cl)
+  SETQ(CHR,LINE.(p+1))
+  processSynonyms ()
+
+-- functions for interfacing to system commands from algebra code
+-- common lisp dependent
+
+tabsToBlanks s ==
+   k := charPosition($charTab,s,0)
+   n := #s
+   k < n =>
+      k = 0 => tabsToBlanks SUBSTRING(s,1,nil)
+      STRCONC(SUBSTRING(s,0,k),$charBlank, tabsToBlanks SUBSTRING(s,k + 1,nil))
+   s
+
+doSystemCommand string ==
+   string := CONCAT('")", EXPAND_-TABS string)
+   LINE: fluid := string
+   processSynonyms()
+   string := LINE
+   string:=SUBSTRING(string,1,nil)
+   string = '"" => nil
+   tok:=getFirstWord(string)
+   tok =>
+        unab := unAbbreviateKeyword tok
+        member(unab, $noParseCommands) =>
+          handleNoParseCommands(unab, string)
+        optionList := splitIntoOptionBlocks string
+        member(unab, $tokenCommands) =>
+          handleTokensizeSystemCommands(unab, optionList)
+        handleParsedSystemCommands(unab, optionList)
+        nil
+   nil
+
+<<handleNoParseCommands>>
+
+npboot str ==
+  sex := string2BootTree str
+  FORMAT(true, '"~&~S~%", sex)
+  $ans := EVAL sex
+  FORMAT(true, '"~&Value = ~S~%", $ans)
+
+stripLisp str ==
+  found := false
+  strIndex := 0
+  lispStr := '"lisp"
+  for c0 in 0..#str-1 for c1 in 0..#lispStr-1 repeat
+    (char str.c0) ^= (char lispStr.c1) =>
+      return nil
+    strIndex := c0+1
+  SUBSEQ(str, strIndex)
+
+
+nplisp str ==
+  $ans := EVAL READ_-FROM_-STRING str
+  FORMAT(true, '"~&Value = ~S~%", $ans)
+
+npsystem(unab, str) ==
+  spaceIndex := SEARCH('" ", str)
+  null spaceIndex =>
+    sayKeyedMsg('"S2IZ0080", [str])
+  sysPart := SUBSEQ(str, 0, spaceIndex)
+  -- The following is a hack required by the fact that unAbbreviateKeyword
+  -- returns the word "system" for unknown words
+  null SEARCH(sysPart, STRING unab) =>
+    sayKeyedMsg('"S2IZ0080", [sysPart])
+  command := SUBSEQ(str, spaceIndex+1)
+  OBEY command
+
+npsynonym(unab, str) ==
+  npProcessSynonym(str)
+
+tokenSystemCommand(unabr, tokList) ==
+  systemCommand tokList
+
+tokTran tok ==
+  STRINGP tok =>
+    #tok = 0 => nil
+    isIntegerString tok => READ_-FROM_-STRING tok
+    STRING tok.0 = '"_"" =>
+      SUBSEQ(tok, 1, #tok-1)
+    INTERN tok
+  tok
+
+isIntegerString tok ==
+  for i in 0..#tok-1 repeat
+    val := DIGIT_-CHAR_-P tok.i
+    not val => return nil
+  val
+
+splitIntoOptionBlocks str ==
+  inString := false
+  optionBlocks := nil
+  blockStart := 0
+  parenCount := 0
+  for i in 0..#str-1 repeat
+    STRING str.i = '"_"" =>
+      inString := not inString
+    if STRING str.i = '"(" and not inString
+    then parenCount := parenCount + 1
+    if STRING str.i = '")" and not inString
+    then parenCount := parenCount - 1
+    STRING str.i = '")" and not inString and parenCount = -1 =>
+      block := stripSpaces SUBSEQ(str, blockStart, i)
+      blockList := [block, :blockList]
+      blockStart := i+1
+      parenCount := 0
+  blockList := [stripSpaces SUBSEQ(str, blockStart), :blockList]
+  nreverse blockList
+
+dumbTokenize str ==
+  -- split into tokens delimted by spaces, taking quoted strings into account
+  inString := false
+  tokenList := nil
+  tokenStart := 0
+  previousSpace := false
+  for i in 0..#str-1 repeat
+    STRING str.i = '"_"" =>
+      inString := not inString
+      previousSpace := false
+    STRING str.i = '" " and not inString =>
+      previousSpace => nil
+      token := stripSpaces SUBSEQ(str, tokenStart, i)
+      tokenList := [token, :tokenList]
+      tokenStart := i+1
+      previousSpace := true
+    previousSpace := false
+  tokenList := [stripSpaces SUBSEQ(str, tokenStart), :tokenList]
+  nreverse tokenList
+
+handleParsedSystemCommands(unabr, optionList) ==
+  restOptionList := [dumbTokenize opt for opt in CDR optionList]
+  parcmd := [parseSystemCmd CAR optionList,
+             :[[tokTran tok for tok in opt] for opt in restOptionList]]
+  systemCommand parcmd
+
+parseSystemCmd opt ==
+  spaceIndex := SEARCH('" ", opt)
+  spaceIndex =>
+    commandString := stripSpaces SUBSEQ(opt, 0, spaceIndex)
+    argString := stripSpaces SUBSEQ(opt, spaceIndex)
+    command := tokTran commandString
+    pform := parseFromString argString
+    [command, pform]
+  [tokTran tok for tok in dumbTokenize opt]
+
+--------------------> NEW DEFINITION (override in osyscmd.boot.pamphlet)
+parseFromString(s) ==
+  $useNewParser =>
+     ncParseFromString s
+  $InteractiveMode :local := true
+  $BOOT: local := NIL
+  $SPAD: local := true
+  $e:local := $InteractiveFrame
+  string2SpadTree s
+
+handleTokensizeSystemCommands(unabr, optionList) ==
+  optionList := [dumbTokenize opt for opt in optionList]
+  parcmd := [[tokTran tok for tok in opt] for opt in optionList]
+  parcmd => tokenSystemCommand(unabr, parcmd)
+
+getFirstWord string ==
+  spaceIndex := SEARCH('" ", string)
+  null spaceIndex => string
+  stripSpaces SUBSEQ(string, 0, spaceIndex)
+
+ltrace l == trace l
+
+--------------------> NEW DEFINITION (see intint.lisp.pamphlet)
+stripSpaces str ==
+  STRING_-TRIM([char '" "], str)
+
+npProcessSynonym(str) ==
+  if str = '"" then printSynonyms(NIL)
+  else
+    pair := processSynonymLine str
+    if $CommandSynonymAlist then
+      PUTALIST($CommandSynonymAlist,CAR pair, CDR pair)
+    else $CommandSynonymAlist := [pair]
+  terminateSystemCommand()
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} [[src/interp/setq.lisp.pamphlet]]
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-toplev.boot.pamphlet b/src/interp/i-toplev.boot.pamphlet
new file mode 100644
index 00000000..665c6371
--- /dev/null
+++ b/src/interp/i-toplev.boot.pamphlet
@@ -0,0 +1,360 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-toplev.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+This file contains the top-most code for receiving parser output,
+calling the analysis routines and printing the result output. It
+also contains several flavors of routines that start the interpreter
+from LISP.
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Top Level Interpreter Code
+
+-- When $QuiteCommand is true Spad will not produce any output from
+--  a top level command
+SETANDFILEQ($QuietCommand, NIL)
+-- When $ProcessInteractiveValue is true, we don't want the value printed
+-- or recorded.
+SETANDFILEQ($ProcessInteractiveValue, NIL)
+SETANDFILEQ($HTCompanionWindowID, NIL)
+
+--% Starting the interpreter from LISP
+
+spadpo() ==
+  -- starts the interpreter but only displays parsed input
+  $PrintOnly: local:= true
+  spad()
+
+start(:l) ==
+  -- The function  start  begins the interpreter process, reading in
+  -- the profile and printing start-up messages.
+  $PrintCompilerMessageIfTrue: local
+  $inLispVM : local := nil
+  if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"interpreter"])
+  initializeTimedNames($interpreterTimedNames,$interpreterTimedClasses)
+  statisticsInitialization()
+  $InteractiveFrame := makeInitialModemapFrame()
+  initializeSystemCommands()
+  initializeInterpreterFrameRing()
+  SETQ(ERROROUTSTREAM,
+    DEFIOSTREAM('((DEVICE . CONSOLE)(MODE . OUTPUT)),80,0))
+  setOutputAlgebra "%initialize%"
+  loadExposureGroupData()
+  if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"database"])
+  mkLowerCaseConTable()
+  if not $ruleSetsInitialized then initializeRuleSets()
+  if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"constructors"])
+  makeConstructorsAutoLoad()
+  GCMSG(NIL)
+  SETQ($IOindex,1)
+  if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"history"])
+  initHist()
+  if functionp 'addtopath then addtopath CONCAT($SPADROOT,'"bin")
+  SETQ($CURRENT_-DIRECTORY,_*DEFAULT_-PATHNAME_-DEFAULTS_*)
+  if null(l) then
+    if $displayStartMsgs then
+      sayKeyedMsg("S2IZ0053",[namestring ['_.axiom,'input]])
+    readSpadProfileIfThere()
+  if $displayStartMsgs then spadStartUpMsgs()
+  if $OLDLINE then
+    SAY fillerSpaces($LINELENGTH,'"=")
+    sayKeyedMsg("S2IZ0050",[namestring ['axiom,'input]])
+    if $OLDLINE ^= 'END__UNIT
+      then
+        centerAndHighlight($OLDLINE,$LINELENGTH,'" ")
+        sayKeyedMsg("S2IZ0051",NIL)
+      else sayKeyedMsg("S2IZ0052",NIL)
+    SAY fillerSpaces($LINELENGTH,'"=")
+    TERPRI()
+    $OLDLINE := NIL
+  $superHash := MAKE_-HASHTABLE('UEQUAL)
+  if null l then runspad()
+  'EndOfSpad
+
+readSpadProfileIfThere() ==
+  -- reads SPADPROF INPUT if it exists
+  file := ['_.axiom,'input]
+  MAKE_-INPUT_-FILENAME file =>
+    SETQ(_/EDITFILE,file)
+    _/RQ ()
+  NIL
+
+--% Parser Output --> Interpreter
+
+processInteractive(form, posnForm) ==
+  --  Top-level dispatcher for the interpreter.  It sets local variables
+  --  and then calls processInteractive1 to do most of the work.
+  --  This function receives the output from the parser.
+
+  initializeTimedNames($interpreterTimedNames,$interpreterTimedClasses)
+
+  $op: local:= (form is [op,:.] => op; form) --name of operator
+  $Coerce: local := NIL
+  $compErrorMessageStack:local
+  $freeVars : local := NIL
+  $mapList:local := NIL            --list of maps being type analyzed
+  $compilingMap:local:= NIL        --true when compiling a map
+  $compilingLoop:local:= NIL       --true when compiling a loop body
+  $interpOnly: local := NIL        --true when in interpret only mode
+  $whereCacheList: local := NIL    --maps compiled because of where
+  $timeGlobalName: local := '$compTimeSum  --see incrementTimeSum
+  $StreamFrame: local := nil       --used in printing streams
+  $declaredMode: local := NIL      --Weak type propagation for symbols
+  $localVars:local := NIL          --list of local variables in function
+  $analyzingMapList:local := NIL   --names of maps currently being
+                                   --analyzed
+  $lastLineInSEQ: local := true    --see evalIF and friends
+  $instantCoerceCount: local := 0
+  $instantCanCoerceCount: local := 0
+  $instantMmCondCount: local := 0
+  $defaultFortVar:= 'X             --default FORTRAN variable name
+  $fortVar : local :=              --variable name for FORTRAN output
+     $defaultFortVar
+  $minivector: local := NIL
+  $minivectorCode: local := NIL
+  $minivectorNames: local := NIL
+  $domPvar: local := NIL
+  $inRetract: local := NIL
+  object := processInteractive1(form, posnForm)
+  --object := ERRORSET(LIST('processInteractive1,LIST('QUOTE,form),LIST('QUOTE,posnForm)),'t,'t)
+  if not($ProcessInteractiveValue) then
+    if $reportInstantiations = true then
+      reportInstantiations()
+      CLRHASH $instantRecord
+    writeHistModesAndValues()
+    updateHist()
+  object
+
+processInteractive1(form, posnForm) ==
+  -- calls the analysis and output printing routines
+  $e : local := $InteractiveFrame
+  recordFrame 'system
+
+  startTimingProcess 'analysis
+  object   := interpretTopLevel(form, posnForm)
+  stopTimingProcess 'analysis
+
+  startTimingProcess 'print
+  if not($ProcessInteractiveValue) then
+    recordAndPrint(objValUnwrap object,objMode object)
+  recordFrame 'normal
+  stopTimingProcess 'print
+
+--spadtestValueHook(objValUnwrap object, objMode object)
+
+  object
+
+--% Result Output Printing
+
+recordAndPrint(x,md) ==
+  --  Prints out the value x which is of type m, and records the changes
+  --  in environment $e into $InteractiveFrame
+  --  $printAnyIfTrue  is documented in setvart.boot. controlled with )se me any
+  if md = '(Any) and $printAnyIfTrue  then
+    md' := first  x
+    x' := rest x
+  else
+    x' := x
+    md' := md
+  $outputMode: local := md   --used by DEMO BOOT
+  mode:= (md=$EmptyMode => quadSch(); md)
+  if (md ^= $Void) or $printVoidIfTrue then
+    if null $collectOutput then TERPRI $algebraOutputStream
+    if $QuietCommand = false then
+      output(x',md')
+  putHist('%,'value,objNewWrap(x,md),$e)
+  if $printTimeIfTrue or $printTypeIfTrue then printTypeAndTime(x',md')
+  if $printStorageIfTrue then printStorage()
+  if $printStatisticsSummaryIfTrue then printStatisticsSummary()
+  if FIXP $HTCompanionWindowID then mkCompanionPage md
+  $mkTestFlag = true => recordAndPrintTest md
+  $runTestFlag =>
+    $mkTestOutputType := md
+    'done
+  'done
+
+printTypeAndTime(x,m) ==  --m is the mode/type of the result
+  $saturn => printTypeAndTimeSaturn(x, m)
+  printTypeAndTimeNormal(x, m)
+
+printTypeAndTimeNormal(x,m) ==
+  -- called only if either type or time is to be displayed
+  if m is ['Union, :argl] then
+    x' := retract(objNewWrap(x,m))
+    m' := objMode x'
+    m := ['Union, :[arg for arg in argl | sameUnionBranch(arg, m')], '"..."]
+  if $printTimeIfTrue then
+    timeString := makeLongTimeString($interpreterTimedNames,
+      $interpreterTimedClasses)
+  $printTimeIfTrue and $printTypeIfTrue =>
+    $collectOutput =>
+      $outputLines := [msgText("S2GL0012", [m]), :$outputLines]
+    sayKeyedMsg("S2GL0014",[m,timeString])
+  $printTimeIfTrue =>
+    $collectOutput => nil
+    sayKeyedMsg("S2GL0013",[timeString])
+  $printTypeIfTrue =>
+    $collectOutput =>
+      $outputLines := [justifyMyType msgText("S2GL0012", [m]), :$outputLines]
+    sayKeyedMsg("S2GL0012",[m])
+
+printTypeAndTimeSaturn(x, m) ==
+  -- header
+  if $printTimeIfTrue then
+    timeString := makeLongTimeString($interpreterTimedNames,
+      $interpreterTimedClasses)
+  else
+    timeString := '""
+  if $printTypeIfTrue then
+    typeString := form2StringAsTeX devaluate m
+  else
+    typeString := '""
+  if $printTypeIfTrue then
+    printAsTeX('"\axPrintType{")
+    if CONSP typeString then
+      MAPC(FUNCTION printAsTeX, typeString)
+    else
+      printAsTeX(typeString)
+    printAsTeX('"}")
+  if $printTimeIfTrue then
+    printAsTeX('"\axPrintTime{")
+    printAsTeX(timeString)
+    printAsTeX('"}")
+
+printAsTeX(x) == PRINC(x, $texOutputStream)
+
+sameUnionBranch(uArg, m) ==
+  uArg is [":", ., t] => t = m
+  uArg = m
+
+msgText(key, args) ==
+  msg := segmentKeyedMsg getKeyedMsg key
+  msg := substituteSegmentedMsg(msg,args)
+  msg := flowSegmentedMsg(msg,$LINELENGTH,$MARGIN)
+  APPLY(function CONCAT, [STRINGIMAGE x for x in CDAR msg])
+
+justifyMyType(t) ==
+  len := #t
+  len > $LINELENGTH => t
+  CONCAT(fillerSpaces($LINELENGTH-len), t)
+
+typeTimePrin x ==
+  $highlightDelta: local:= 0
+  maprinSpecial(x,0,79)
+
+printStorage() ==
+  $collectOutput => nil
+  storeString :=
+    makeLongSpaceString($interpreterTimedNames, $interpreterTimedClasses)
+  sayKeyedMsg("S2GL0016",[storeString])
+
+printStatisticsSummary() ==
+  $collectOutput => nil
+  summary := statisticsSummary()
+  sayKeyedMsg("S2GL0017",[summary])
+
+--%  Interpreter Middle-Level Driver + Utilities
+
+interpretTopLevel(x, posnForm) ==
+  --  Top level entry point from processInteractive1.  Sets up catch
+  --  for a thrown result
+  savedTimerStack := COPY $timedNameStack
+  c := CATCH('interpreter,interpret(x, posnForm))
+  while savedTimerStack ^= $timedNameStack repeat
+    stopTimingProcess peekTimedName()
+  c = 'tryAgain => interpretTopLevel(x, posnForm)
+  c
+
+interpret(x, :restargs) ==
+  posnForm := if PAIRP restargs then CAR restargs else restargs
+  --type analyzes and evaluates expression x, returns object
+  $env:local := [[NIL]]
+  $eval:local := true           --generate code-- don't just type analyze
+  $genValue:local := true       --evaluate all generated code
+  interpret1(x,nil,posnForm)
+
+interpret1(x,rootMode,posnForm) ==
+  -- dispatcher for the type analysis routines.  type analyzes and
+  -- evaluates the expression x in the rootMode (if non-nil)
+  -- which may be $EmptyMode.  returns an object if evaluating, and a
+  -- modeset otherwise
+
+  -- create the attributed tree
+
+  node := mkAtreeWithSrcPos(x, posnForm)
+  if rootMode then putTarget(node,rootMode)
+
+  -- do type analysis and evaluation of expression.  The real guts
+
+  modeSet:= bottomUp node
+  not $eval => modeSet
+  newRootMode := (null rootMode => first modeSet ; rootMode)
+  argVal := getArgValue(node, newRootMode)
+  argVal and not $genValue => objNew(argVal, newRootMode)
+  argVal and (val:=getValue node) => interpret2(val,newRootMode,posnForm)
+  keyedSystemError("S2IS0053",[x])
+
+interpret2(object,m1,posnForm) ==
+  -- this is the late interpretCoerce. I removed the call to
+  -- coerceInteractive, so it only does the JENKS cases    ALBI
+  m1=$ThrowAwayMode => object
+  x := objVal object
+  m := objMode object
+  m=$EmptyMode =>
+    x is [op,:.]  and op in '(MAP STREAM) => objNew(x,m1)
+    m1 = $EmptyMode => objNew(x,m)
+    systemErrorHere '"interpret2"
+  m1 =>
+    if (ans := coerceInteractive(object,m1)) then ans
+    else throwKeyedMsgCannotCoerceWithValue(x,m,m1)
+  object
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/i-util.boot.pamphlet b/src/interp/i-util.boot.pamphlet
new file mode 100644
index 00000000..54cf2874
--- /dev/null
+++ b/src/interp/i-util.boot.pamphlet
@@ -0,0 +1,308 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-util.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+Wrapping and Unwrapping Values
+ 
+A wrapped value represents something that need not be evaluated
+when code is generated.  This includes objects from domains or things
+that just happed to evaluate to themselves.  Typically generated
+lisp code is unwrapped.
+ 
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Utility Functions Used Only by the Intepreter
+ 
+wrap x ==
+  isWrapped x => x
+  ['WRAPPED,:x]
+ 
+isWrapped x == x is ['WRAPPED,:.] or NUMBERP x or FLOATP x or CVECP x
+ 
+unwrap x ==
+  NUMBERP x or FLOATP x or CVECP x => x
+  x is ["WRAPPED",:y] => y
+  x
+ 
+wrapped2Quote x ==
+  x is ["WRAPPED",:y] => MKQ y
+  x
+ 
+quote2Wrapped x ==
+  x is ['QUOTE,y] => wrap y
+  x
+ 
+removeQuote x ==
+  x is ["QUOTE",y] => y
+  x
+ 
+-- addQuote x ==
+--   NUMBERP x => x
+--   ['QUOTE,x]
+ 
+--% The function for making prompts
+ 
+spadPrompt() ==
+  SAY '"   AXIOM"
+  sayNewLine()
+ 
+inputPrompt str ==
+  -- replaces older INPUT-PROMPT
+  atom (x := $SCREENSIZE()) => NIL
+  p := CAR(x) - 2
+  y := $OLDLINE
+  SETQ($OLDLINE,NIL)
+  y => _$SHOWLINE(STRCONC(str,EBCDIC 19,y),p)
+  0 = SIZE str => NIL
+  _$SHOWLINE(STRCONC(str,EBCDIC 19),p)
+ 
+protectedPrompt(:p) ==
+  [str,:br] := p
+  0 = SIZE str => inputPrompt str
+  msg := EBCDIC 29                       -- start of field
+  msg :=
+    if br then STRCONC(msg,EBCDIC 232)   -- bright write protect
+    else       STRCONC(msg,EBCDIC  96)   -- write protect
+  msg := STRCONC(msg,str,EBCDIC 29,EBCDIC 64)  -- unprotect again
+  inputPrompt msg
+ 
+MKPROMPT() ==
+  $inputPromptType = 'none    => '""
+  $inputPromptType = 'plain   => '"-> "
+  $inputPromptType = 'step    =>
+    STRCONC('"(",STRINGIMAGE $IOindex,'") -> ")
+  $inputPromptType = 'frame   =>
+    STRCONC(STRINGIMAGE $interpreterFrameName,
+      '" (",STRINGIMAGE $IOindex,'") -> ")
+  STRCONC(STRINGIMAGE $interpreterFrameName,
+   '" [", SUBSTRING(CURRENTTIME(),8,NIL),'"] [",
+    STRINGIMAGE $IOindex, '"] -> ")
+ 
+--% Miscellaneous
+ 
+Zeros n ==
+  BOUNDP '$ZeroVecCache and #$ZeroVecCache=n => $ZeroVecCache
+  $ZeroVecCache:= MAKE_-VEC n
+  for i in 0..n-1 repeat $ZeroVecCache.i:=0
+  $ZeroVecCache
+ 
+LZeros n ==
+  n < 1 => nil
+  l := [0]
+  for i in 2..n repeat l := [0, :l]
+  l
+ 
+-- bpi2FunctionName x ==
+--   s:= BPINAME x  => s
+--   x
+ 
+-- subrToName x == BPINAME x
+
+-- formerly in clammed.boot
+
+isSubDomain(d1,d2) ==
+  -- d1 and d2 are different domains
+  subDomainList := '(Integer NonNegativeInteger PositiveInteger)
+  ATOM d1 or ATOM d2 => nil
+  l := MEMQ(CAR d2, subDomainList) =>
+    MEMQ(CAR d1, CDR l)
+  nil
+
+$variableNumberAlist := nil
+
+variableNumber(x) ==
+  p := ASSQ(x, $variableNumberAlist)
+  null p => 
+    $variableNumberAlist := [[x,:0], :$variableNumberAlist]
+    0
+  RPLACD(p, 1+CDR p)
+  CDR p
+
+newType? t == nil
+
+
+-- functions used at run-time which were formerly in the compiler files
+
+Undef(:u) ==
+  u':= LAST u
+  [[domain,slot],op,sig]:= u'
+  domain':=eval mkEvalable domain
+  ^EQ(CAR ELT(domain',slot),Undef) =>
+-- OK - thefunction is now defined
+    [:u'',.]:=u
+    if $reportBottomUpFlag then
+      sayMessage concat ['"   Retrospective determination of slot",'%b,
+        slot,'%d,'"of",'%b,:prefix2String domain,'%d]
+    APPLY(CAR ELT(domain',slot),[:u'',CDR ELT(domain',slot)])
+  throwKeyedMsg("S2IF0008",[formatOpSignature(op,sig),domain])
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+devaluate d ==
+  not REFVECP d => d
+  QSGREATERP(QVSIZE d,5) and QREFELT(d,3) is ['Category] => QREFELT(d,0)
+  QSGREATERP(QVSIZE d,0) =>
+    d':=QREFELT(d,0)
+    isFunctor d' => d'
+    d
+  d
+ 
+devaluateList l == [devaluate d for d in l]
+ 
+--HasAttribute(domain,attrib) ==
+---->
+--  isNewWorldDomain domain => newHasAttribute(domain,attrib)
+----+
+--  (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
+ 
+HasSignature(domain,[op,sig]) ==
+  compiledLookup(op,sig,domain)
+ 
+--HasCategory(domain,catform') ==
+--  catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
+--  catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
+--  catform:= devaluate catform'
+--  domain0:=domain.0
+--  isNewWorldDomain domain => newHasCategory(domain,catform)
+--  slot4 := domain.4
+--  catlist := slot4.1
+--  member(catform,catlist) or
+--   MEMQ(opOf(catform),'(Object Type)) or  --temporary hack
+--    or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
+ 
+makeInitialModemapFrame() == COPY $InitialModemapFrame
+ 
+addModemap(op,mc,sig,pred,fn,$e) ==
+  $InteractiveMode => $e
+  if knownInfo pred then pred:=true
+  $insideCapsuleFunctionIfTrue=true =>
+    $CapsuleModemapFrame :=
+      addModemap0(op,mc,sig,pred,fn,$CapsuleModemapFrame)
+    $e
+  addModemap0(op,mc,sig,pred,fn,$e)
+ 
+isCapitalWord x ==
+  (y := PNAME x) and and/[UPPER_-CASE_-P y.i for i in 0..MAXINDEX y]
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+domainEqual(a,b) == VECP a and VECP b and a.0 = b.0
+ 
+lispize x == first optimize [x]
+ 
+$newCompilerUnionFlag := true
+
+orderUnionEntries l ==
+  $newCompilerUnionFlag => l
+  first l is [":",.,.] => l  -- new style Unions
+  [a,b]:=
+    split(l,nil,nil) where
+      split(l,a,b) ==
+        l is [x,:l'] =>
+          (STRINGP x => split(l',[x,:a],b); split(l',a,[x,:b]))
+        [a,b]
+  [:orderList a,:orderList b]
+ 
+mkPredList listOfEntries ==
+  $newCompilerUnionFlag =>
+     [['EQCAR,"#1",i] for arg in listOfEntries for i in 0..]
+  first listOfEntries is [":",.,.] =>   -- new Tagged Unions
+     [['EQCAR,"#1",MKQ tag] for [.,tag,.] in listOfEntries]
+  --1. generate list of type-predicate pairs from union specification
+  initTypePredList:=
+    [selTypePred for x in listOfEntries] where
+      selTypePred() ==
+        STRINGP x => [x,'EQUAL,"#1",x]
+        [x,:GETL(opOf x,"BasicPredicate")]
+  typeList:= ASSOCLEFT initTypePredList
+  initPredList:= ASSOCRIGHT initTypePredList
+  hasDuplicatePredicate:=
+    fn initPredList where
+      fn x ==
+        null x => false
+        first x and member(first x,rest x) => true
+        fn rest x
+                                 --if duplicate predicate, kill them all
+  if hasDuplicatePredicate then initPredList:= [nil for x in initPredList]
+  nonEmptyPredList:= [p for p in initPredList | p^=nil]
+  numberWithoutPredicate:= #listOfEntries-#nonEmptyPredList
+  predList:=
+    numberWithoutPredicate=0 and not hasDuplicatePredicate => initPredList
+    numberWithoutPredicate=1 and null LAST initPredList and
+      [STRINGP x for x in rest REVERSE listOfEntries] =>
+        allButLast:= rest REVERSE initPredList
+        NREVERSE [['NULL,MKPF(allButLast,"OR")],:allButLast]
+  --otherwise, generate a tagged-union
+  --we have made an even number of REVERSE operations, therefore
+  --the original order is preserved.  JHD 25.Sept.1983
+    tagPredList:= [["EQCAR","#1",i] for i in 1..numberWithoutPredicate]
+    [addPredIfNecessary for p in initPredList] where
+      addPredIfNecessary() ==
+        p => p
+        [u,:tagPredList]:= tagPredList
+        u
+  predList
+ 
+TruthP x ==
+    --True if x is a predicate that's always true
+  x is nil => nil
+  x=true => true
+  x is ['QUOTE,:.] => true
+  nil
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/incl.boot.pamphlet b/src/interp/incl.boot.pamphlet
new file mode 100644
index 00000000..5f729bb7
--- /dev/null
+++ b/src/interp/incl.boot.pamphlet
@@ -0,0 +1,447 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/incl.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+ 
+incStringStream s==
+   incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top])
+ 
+incFile fn==
+   incRenumber incLude(0,incRgen OPEN fn,0,[fn],[Top])
+ 
+incStream(st, fn) ==
+   incRenumber incLude(0,incRgen st,0,[fn],[Top])
+
+incFileInput    fn == incRgen  MAKE_-INSTREAM fn
+incConsoleInput () == incRgen  MAKE_-INSTREAM 0
+ 
+incLine(eb, str, gno, lno, ufo) ==
+            ln := lnCreate(eb,str,gno,lno,ufo)
+            CONS(CONS(ln,1), str)
+ 
+incPos f == CAR f
+ 
+incRenumberItem(f, i) ==
+            l := CAAR f
+            lnSetGlobalNum(l, i)
+            f
+ 
+incRenumberLine(xl, gno) ==
+            l := incRenumberItem(xl.0, gno)
+            incHandleMessage xl
+            l
+ 
+incRenumber ssx == incZip (function incRenumberLine, ssx, incIgen 0)
+ 
+incPrefix?(prefix, start, whole) ==
+            #prefix > #whole-start => false
+            good:=true
+            for i in 0..#prefix-1 for j in start.. while good repeat
+                good:= prefix.i = whole.j
+            good
+ 
+incCommand?(s) == #s > 0 and s.0 = char ")"
+ 
+incCommands :=
+            ['"say"    , _
+             '"include", _
+             '"console", _
+             '"fin"    , _
+             '"assert" , _
+             '"if"     , _
+             '"elseif" , _
+             '"else"   , _
+             '"endif" ]
+ 
+incClassify(s) ==
+            not incCommand? s => [false,0, '""]
+            i := 1; n := #s
+            while i < n and s.i = char " " repeat i := i + 1
+            i >= n => [true,0,'"other"]
+            eb := (i = 1 => 0; i)
+            bad:=true
+            for p in incCommands while bad repeat
+                incPrefix?(p, i, s) =>
+                    bad:=false
+                    p1 :=p
+            if bad then [true,0,'"other"] else [true,eb,p1]
+ 
+incCommandTail(s, info) ==
+            start := (info.1 = 0 => 1; info.1)
+            incDrop(start+#info.2+1, s)
+ 
+incDrop(n, b) ==
+            n >= #b => ""
+            SUBSTRING(b,n,nil)
+ 
+ 
+inclFname(s, info) == incFileName incCommandTail(s, info)
+ 
+incBiteOff x ==
+          n:=STRPOSL('" ",x,0,true)-- first nonspace
+          if null n
+          then false -- all spaces
+          else
+             n1:=STRPOSL ('" ",x,n,nil)
+             if null n1 -- all nonspaces
+             then [SUBSTRING(x,n,nil),'""]
+             else [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)]
+ 
+incTrunc (n,x)==
+     if #x>n
+     then SUBSTRING(x,0,n)
+     else x
+ 
+incFileName x == first incBiteOff x
+ 
+fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)]
+ 
+ifCond(s, info) ==
+    word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
+    ListMemberQ?(word, $inclAssertions)
+ 
+assertCond(s, info) ==
+    word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
+    if not ListMemberQ?(word, $inclAssertions) then
+        $inclAssertions := [word, :$inclAssertions]
+ 
+ 
+incActive?(fn,ufos)==member(fn,ufos)
+ 
+incNConsoles ufos==
+        a:=member('"console",ufos)
+        if a then 1+incNConsoles CDR a else 0
+ 
+Top            := 01
+IfSkipToEnd    := 10
+IfKeepPart     := 11
+IfSkipPart     := 12
+ElseifSkipToEnd:= 20
+ElseifKeepPart := 21
+ElseifSkipPart := 22
+ElseSkipToEnd  := 30
+ElseKeepPart   := 31
+ 
+Top?     (st) == QUOTIENT(st,10) = 0
+If?      (st) == QUOTIENT(st,10) = 1
+Elseif?  (st) == QUOTIENT(st,10) = 2
+Else?    (st) == QUOTIENT(st,10) = 3
+SkipEnd? (st) == REMAINDER(st,10) = 0
+KeepPart?(st) == REMAINDER(st,10) = 1
+SkipPart?(st) == REMAINDER(st,10) = 2
+Skipping?(st) == not KeepPart? st
+ 
+        --% Message Handling
+incHandleMessage(xl) ==
+          xl.1.1 = "none" =>
+              0
+          xl.1.1 = "error" =>
+              inclHandleError(incPos xl.0, xl.1.0)
+          xl.1.1 = "warning" =>
+              inclHandleWarning(incPos xl.0, xl.1.0)
+          xl.1.1 = "say" =>
+              inclHandleSay(incPos xl.0, xl.1.0)
+          inclHandleBug(incPos xl.0, xl.1.0)
+ 
+xlOK(eb, str, lno, ufo)  ==
+                [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
+ 
+xlOK1(eb, str,str1, lno, ufo)  ==
+                [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]]
+ 
+incLine1(eb, str,str1, gno, lno, ufo) ==
+            ln := lnCreate(eb,str,gno,lno,ufo)
+            CONS(CONS(ln,1), str1)
+xlSkip(eb, str, lno, ufo) ==
+        str := CONCAT('"-- Omitting:", str)
+        [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
+ 
+xlMsg(eb, str, lno, ufo, mess) ==
+                [incLine(eb, str, -1, lno, ufo), mess]
+ 
+xlPrematureEOF(eb, str, lno, ufos) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgPrematureEOF(ufos.0),"error"])
+ 
+xlPrematureFin(eb, str, lno, ufos) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgPrematureFin(ufos.0),"error"])
+ 
+xlFileCycle(eb, str, lno, ufos, fn) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgFileCycle(ufos,fn),"error"])
+ 
+xlNoSuchFile(eb, str, lno, ufos, fn) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgNoSuchFile(fn), "error"])
+ 
+xlCannotRead(eb, str, lno, ufos, fn) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgCannotRead(fn), "error"])
+ 
+xlConsole(eb, str, lno, ufos)  ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgConsole(),"say"])
+ 
+xlConActive(eb, str, lno, ufos, n) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgConActive(n),"warning"])
+ 
+xlConStill(eb, str, lno, ufos, n) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgConStill(n), "say"])
+ 
+xlSkippingFin(eb, str, lno, ufos) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgFinSkipped(),"warning"])
+ 
+xlIfBug(eb, str, lno, ufos) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgIfBug(), "bug"])
+ 
+xlCmdBug(eb, str, lno, ufos) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgCmdBug(), "bug"])
+ 
+xlSay(eb, str, lno, ufos, x) ==
+          xlMsg(eb, str, lno,ufos.0,
+              [inclmsgSay(x), "say"])
+ 
+xlIfSyntax(eb, str, lno,ufos,info,sts) ==
+          st := sts.0
+          found := info.2
+          context :=
+              Top? st  => "not in an )if...)endif"
+              Else? st => "after an )else"
+              "but can't figure out where"
+          xlMsg(eb, str, lno, ufos.0,
+               [inclmsgIfSyntax(ufos.0,found,context), "error"])
+ 
+        --% This is it
+ 
+incLude(eb, ss, ln, ufos, states) ==
+       Delay(function incLude1,[eb, ss, ln, ufos, states])
+ 
+Rest s==>incLude (eb,CDR ss,lno,ufos,states)
+ 
+incLude1 (:z) ==
+            [eb, ss, ln, ufos, states]:=z
+            lno       := ln+1
+            state     := states.0
+ 
+            StreamNull ss =>
+                not Top? state =>
+                    cons(xlPrematureEOF(eb,
+                     '")--premature end",  lno,ufos), StreamNil)
+                StreamNil
+ 
+            str  :=  EXPAND_-TABS CAR ss
+            info :=  incClassify str
+ 
+            not info.0 =>
+                Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s)
+                cons(xlOK(eb, str, lno, ufos.0),Rest s)
+ 
+            info.2 = '"other" =>
+                Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s)
+                cons(xlOK1(eb, str,CONCAT('")command",str), lno, ufos.0),
+                                          Rest s)
+ 
+            info.2 = '"say" =>
+                Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s)
+                str := incCommandTail(str, info)
+                cons(xlSay(eb, str, lno, ufos, str),
+                     cons(xlOK(eb,str,lno,ufos.0), Rest s))
+ 
+            info.2 = '"include" =>
+                Skipping? state =>
+                     cons(xlSkip(eb,str,lno,ufos.0), Rest s)
+                fn1 := inclFname(str, info)
+                not fn1 =>
+                    cons(xlNoSuchFile(eb, str, lno,ufos,fn),Rest s)
+                not PROBE_-FILE fn1 =>
+                    cons(xlCannotRead(eb, str, lno,ufos,fn1),Rest s)
+                incActive?(fn1,ufos) =>
+                    cons(xlFileCycle (eb, str, lno,ufos,fn1),Rest s)
+                Includee  :=
+                  incLude(eb+info.1,incFileInput fn1,0,
+                            cons(fn1,ufos), cons(Top,states))
+                cons(
+                    xlOK(eb,str,lno,ufos.0),
+                          incAppend(Includee, Rest s))
+ 
+            info.2 = '"console" =>
+                Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s)
+                Head :=
+                 incLude(eb+info.1,incConsoleInput(),0,
+                     cons('"console",ufos),cons(Top,states) )
+                Tail := Rest s
+ 
+                n := incNConsoles ufos
+                if n > 0 then
+                   Head := cons(xlConActive(eb, str, lno,ufos,n),Head)
+                   Tail :=
+                       cons(xlConStill (eb, str, lno,ufos,n),Tail)
+ 
+                Head := cons (xlConsole(eb, str, lno,ufos), Head)
+                cons(xlOK(eb,str,lno,ufos.0),incAppend(Head,Tail))
+ 
+            info.2 = '"fin" =>
+                Skipping? state =>
+                    cons(xlSkippingFin(eb, str, lno,ufos), Rest s)
+                not Top? state  =>
+                    cons(xlPrematureFin(eb, str, lno,ufos), StreamNil)
+                cons(xlOK(eb,str,lno,ufos.0), StreamNil)
+ 
+            info.2 = '"assert" =>
+                Skipping? state =>
+                    cons(xlSkippingFin(eb, str, lno,ufos), Rest s)
+                assertCond(str, info)
+                cons(xlOK(eb,str,lno,ufos.0), incAppend(Includee, Rest s))
+ 
+            info.2 = '"if" =>
+                s1 :=
+                    Skipping? state => IfSkipToEnd
+                    if ifCond(str,info) then IfKeepPart else IfSkipPart
+                cons(xlOK(eb,str,lno,ufos.0),
+                      incLude(eb,CDR ss,lno,ufos,cons(s1,states)))
+            info.2 = '"elseif" =>
+                not If? state and not Elseif? state =>
+                    cons(xlIfSyntax(eb, str,lno,ufos,info,states),
+                            StreamNil)
+ 
+                if SkipEnd? state or KeepPart? state or SkipPart? state
+                then
+                     s1:=if SkipPart? state
+                         then
+                            pred := ifCond(str,info)
+                            if pred
+                            then ElseifKeepPart
+                            else ElseifSkipPart
+                         else ElseifSkipToEnd
+                     cons(xlOK(eb,str,lno,ufos.0),
+                        incLude(eb,CDR ss,lno,ufos,cons(s1,rest states)))
+                else
+                    cons(xlIfBug(eb, str, lno,ufos), StreamNil)
+ 
+            info.2 = '"else" =>
+                not If? state and not Elseif? state =>
+                    cons(xlIfSyntax(eb, str,lno,ufos,info,states),
+                           StreamNil)
+                if SkipEnd? state or KeepPart? state or SkipPart? state
+                then
+                      s1 :=if SkipPart? state
+                           then ElseKeepPart
+                           else ElseSkipToEnd
+                      cons(xlOK(eb,str,lno,ufos.0),
+                        incLude(eb,CDR ss,lno,ufos,cons(s1,rest states)))
+                else
+                    cons(xlIfBug(eb, str, lno,ufos), StreamNil)
+ 
+            info.2 = '"endif" =>
+                Top? state =>
+                    cons(xlIfSyntax(eb, str,lno,ufos,info,states),
+                        StreamNil)
+                cons(xlOK(eb,str,lno,ufos.0),
+                         incLude(eb,CDR ss,lno,ufos,rest states))
+ 
+            cons(xlCmdBug(eb, str, lno,ufos), StreamNil)
+ 
+--% Message handling for the source includer
+--  SMW June 88
+ 
+inclHandleError(pos, [key, args]) ==
+    ncSoftError(pos, key, args)
+inclHandleWarning(pos, [key, args]) ==
+    ncSoftError(pos, key,args)
+inclHandleBug(pos, [key, args]) ==
+    ncBug(key, args)
+inclHandleSay(pos, [key, args]) ==
+    ncSoftError(pos, key, args)
+ 
+inclmsgSay str  ==
+    ['S2CI0001, [%id str]]
+inclmsgPrematureEOF ufo  ==
+    ['S2CI0002, [%origin ufo]]
+inclmsgPrematureFin ufo  ==
+    ['S2CI0003, [%origin ufo]]
+inclmsgFileCycle(ufos,fn) ==
+    flist := [porigin n for n in reverse ufos]
+    f1    := porigin fn
+    cycle := [:[:[n,'"==>"] for n in flist], f1]
+    ['S2CI0004, [%id cycle, %id f1]]
+inclmsgConsole   () ==
+    ['S2CI0005, []]
+inclmsgConActive n  ==
+    ['S2CI0006, [%id n]]
+inclmsgConStill  n  ==
+    ['S2CI0007, [%id n]]
+inclmsgFinSkipped() ==
+    ['S2CI0008, []]
+inclmsgIfSyntax(ufo,found,context) ==
+    found := CONCAT('")", found)
+    ['S2CI0009, [%id found, %id context, %origin ufo]]
+inclmsgNoSuchFile fn ==
+    ['S2CI0010, [%fname fn]]
+inclmsgCannotRead fn ==
+    ['S2CI0011, [%fname fn]]
+inclmsgIfBug() ==
+    ['S2CB0002, []]
+inclmsgCmdBug() ==
+    ['S2CB0003, []]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/info.boot.pamphlet b/src/interp/info.boot.pamphlet
new file mode 100644
index 00000000..ead9f3e1
--- /dev/null
+++ b/src/interp/info.boot.pamphlet
@@ -0,0 +1,305 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/info.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+ADDINFORMATION CODE
+This code adds various items to the special value of $Information,
+in order to keep track of all the compiler's information about
+various categories and similar objects
+An actual piece of (unconditional) information can have one of 3 forms:
+ (ATTRIBUTE domainname attribute)
+             --These are only stored here
+ (SIGNATURE domainname operator signature)
+             --These are also stored as 'modemap' properties
+ (has domainname categoryexpression)
+             --These are also stored as 'value' properties
+Conditional attributes are of the form
+ (COND
+ (condition info info ...)
+ ... )
+where the condition looks like a 'has' clause, or the 'and' of several
+'has' clauses:
+  (has name categoryexpression)
+  (has name (ATTRIBUTE attribute))
+  (has name (SIGNATURE operator signature))
+The use of two representations is admitted to be clumsy
+ 
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+printInfo $e ==
+  for u in get("$Information","special",$e) repeat PRETTYPRINT u
+  nil
+ 
+addInformation(m,$e) ==
+  $Information: local
+  --$Information:= nil: done by previous statement anyway
+  info m where
+    info m ==
+      --Processes information from a mode declaration in compCapsule
+      atom m => nil
+      m is ["CATEGORY",.,:stuff] => for u in stuff repeat addInfo u
+      m is ["Join",:stuff] => for u in stuff repeat info u
+      nil
+  $e:=
+    put("$Information","special",[:$Information,:
+      get("$Information","special",$e)],$e)
+  $e
+ 
+addInfo u == $Information:= [formatInfo u,:$Information]
+ 
+formatInfo u ==
+  atom u => u
+  u is ["SIGNATURE",:v] => ["SIGNATURE","$",:v]
+ --u is ("CATEGORY",junk,:l) => ("PROGN",:(formatInfo v for v in l))
+  u is ["PROGN",:l] => ["PROGN",:[formatInfo v for v in l]]
+  u is ["ATTRIBUTE",v] =>
+ 
+    -- The parser can't tell between those attributes that really
+    -- are attributes, and those that are category names
+    atom v and isCategoryForm([v],$e) => ["has","$",[v]]
+    atom v => ["ATTRIBUTE","$",v]
+    isCategoryForm(v,$e) => ["has","$",v]
+    ["ATTRIBUTE","$",v]
+  u is ["IF",a,b,c] =>
+    c="noBranch" => ["COND",:liftCond [formatPred a,formatInfo b]]
+    b="noBranch" => ["COND",:liftCond [["not",formatPred a],formatInfo c]]
+    ["COND",:liftCond [formatPred a,formatInfo b],:
+      liftCond [["not",formatPred a],formatInfo c]]
+  systemError '"formatInfo"
+ 
+liftCond (clause is [ante,conseq]) ==
+  conseq is ["COND",:l] =>
+    [[lcAnd(ante,a),:b] for [a,:b] in l] where
+      lcAnd(pred,conj) ==
+        conj is ["and",:ll] => ["and",pred,:ll]
+        ["and",pred,conj]
+  [clause]
+ 
+formatPred u ==
+         --Assumes that $e is set up to point to an environment
+  u is ["has",a,b] =>
+    atom b and isCategoryForm([b],$e) => ["has",a,[b]]
+    atom b => ["has",a,["ATTRIBUTE",b]]
+    isCategoryForm(b,$e) => u
+    b is ["ATTRIBUTE",.] => u
+    b is ["SIGNATURE",:.] => u
+    ["has",a,["ATTRIBUTE",b]]
+  atom u => u
+  u is ["and",:v] => ["and",:[formatPred w for w in v]]
+  systemError '"formatPred"
+ 
+chaseInferences(pred,$e) ==
+  foo hasToInfo pred where
+    foo pred ==
+      knownInfo pred => nil
+      $e:= actOnInfo(pred,$e)
+      pred:= infoToHas pred
+      for u in get("$Information","special",$e) repeat
+        u is ["COND",:l] =>
+          for [ante,:conseq] in l repeat
+            ante=pred => [foo w for w in conseq]
+            ante is ["and",:ante'] and member(pred,ante') =>
+              ante':= delete(pred,ante')
+              v':=
+                LENGTH ante'=1 => first ante'
+                ["and",:ante']
+              v':= ["COND",[v',:conseq]]
+              member(v',get("$Information","special",$e)) => nil
+              $e:=
+                put("$Information","special",[v',:
+                  get("$Information","special",$e)],$e)
+            nil
+  $e
+ 
+hasToInfo (pred is ["has",a,b]) ==
+  b is ["SIGNATURE",:data] => ["SIGNATURE",a,:data]
+  b is ["ATTRIBUTE",c] => ["ATTRIBUTE",a,c]
+  pred
+ 
+infoToHas a ==
+  a is ["SIGNATURE",b,:data] => ["has",b,["SIGNATURE",:data]]
+  a is ["ATTRIBUTE",b,c] => ["has",b,["ATTRIBUTE",c]]
+  a
+ 
+knownInfo pred ==
+               --true %if the information is already known
+  pred=true => true
+  --pred = "true" => true
+  member(pred,get("$Information","special",$e)) => true
+  pred is ["OR",:l] => or/[knownInfo u for u in l]
+  pred is ["AND",:l] => and/[knownInfo u for u in l]
+  pred is ["or",:l] => or/[knownInfo u for u in l]
+  pred is ["and",:l] => and/[knownInfo u for u in l]
+  pred is ["ATTRIBUTE",name,attr] =>
+    v:= compForMode(name,$EmptyMode,$e)
+    null v => stackSemanticError(["can't find category of ",name],nil)
+    [vv,.,.]:= compMakeCategoryObject(CADR v,$e)
+    null vv => stackSemanticError(["can't make category of ",name],nil)
+    member(attr,vv.2) => true
+    x:= ASSOC(attr,vv.2) => knownInfo CADR x
+          --format is a list of two elements: information, predicate
+    false
+  pred is ["has",name,cat] =>
+    cat is ["ATTRIBUTE",:a] => knownInfo ["ATTRIBUTE",name,:a]
+    cat is ["SIGNATURE",:a] => knownInfo ["SIGNATURE",name,:a]
+    name is ['Union,:.] => false
+    v:= compForMode(name,$EmptyMode,$e)
+    null v => stackSemanticError(["can't find category of ",name],nil)
+    vmode := CADR v
+    cat = vmode => true
+    vmode is ["Join",:l] and member(cat,l) => true
+    [vv,.,.]:= compMakeCategoryObject(vmode,$e)
+    catlist := vv.4
+    --catlist := SUBST(name,'$,vv.4)
+    null vv => stackSemanticError(["can't make category of ",name],nil)
+    member(cat,first catlist) => true  --checks princ. ancestors
+    (u:=ASSOC(cat,CADR catlist)) and knownInfo(CADR u) => true
+    -- previous line checks fundamental anscestors, we should check their
+    --   principal anscestors but this requires instantiating categories
+
+    -- This line caused recursion on predicates which are no use in deciding
+    -- whether a category was present.
+-- this is correct TPD feb, 19, 2003
+    or/[AncestorP(cat,LIST CAR u) for u in CADR catlist | knownInfo CADR u] => true
+-- this is wrong TPD feb, 19, 2003
+    -- or/[AncestorP(cat,LIST CAR u) and knownInfo CADR u for u in CADR catlist] => true
+    false
+  pred is ["SIGNATURE",name,op,sig,:.] =>
+    v:= get(op,"modemap",$e)
+    for w in v repeat
+      ww:= CDAR w
+          --the actual signature part
+      LENGTH ww=LENGTH sig and SourceLevelSubsume(ww,sig) =>
+        --NULL CAADR w => return false
+        CAADR w  = true => return true
+        --return false
+        --error '"knownInfo"
+  false
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+actOnInfo(u,$e) ==
+  null u => $e
+  u is ["PROGN",:l] => (for v in l repeat $e:= actOnInfo(v,$e); $e)
+  $e:=
+    put("$Information","special",Info:= [u,:get("$Information","special",$e)],$e
+      )
+  u is ["COND",:l] =>
+      --there is nowhere %else that this sort of thing exists
+    for [ante,:conseq] in l repeat
+      if member(hasToInfo ante,Info) then for v in conseq repeat
+        $e:= actOnInfo(v,$e)
+    $e
+  u is ["ATTRIBUTE",name,att] =>
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["ATTRIBUTE",att]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+      --there is nowhere %else that this sort of thing exists
+  u is ["SIGNATURE",name,operator,modemap] =>
+    implem:=
+      (implem:=ASSOC([name,:modemap],get(operator,'modemap,$e))) =>
+          CADADR implem
+      ['ELT,name,nil]
+    $e:= addModemap(operator,name,modemap,true,implem,$e)
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["SIGNATURE",operator,modemap]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+  u is ["has",name,cat] =>
+    [vval,vmode,venv]:= GetValue name
+    cat=vmode => $e --stating the already known
+    u:= compMakeCategoryObject(cat,$e) =>
+         --we are adding information about a category
+      [catvec,.,$e]:= u
+      [ocatvec,.,$e]:= compMakeCategoryObject(vmode,$e)
+      -- member(vmode,CAR catvec.4) =>
+      --    JHD 82/08/08 01:40 This does not mean that we can ignore the
+      --    extension, since this may not be compatible with the view we
+      --    were passed
+ 
+      --we are adding a principal descendant of what was already known
+      --    $e:= augModemapsFromCategory(name,name,nil,catvec,$e)
+      --    SAY("augmenting ",name,": ",cat)
+      --    put(name, "value", (vval, cat, venv), $e)
+      member(cat,first ocatvec.4) or
+         ASSOC(cat,CADR ocatvec.4) is [.,'T,.] => $e
+        --SAY("Category extension error:
+        --cat shouldn't be a join
+                      --what was being asserted is an ancestor of what was known
+      if name="$"
+        then $e:= augModemapsFromCategory(name,name,name,cat,$e)
+        else
+          viewName:=genDomainViewName(name,cat)
+          genDomainView(viewName,name,cat,"HasCategory")
+          if not MEMQ(viewName,$functorLocalParameters) then
+             $functorLocalParameters:=[:$functorLocalParameters,viewName]
+      SAY("augmenting ",name,": ",cat)
+      $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+    SAY("extension of ",vval," to ",cat," ignored")
+    $e
+  systemError '"knownInfo"
+ 
+mkJoin(cat,mode) ==
+  mode is ['Join,:cats] => ['Join,cat,:cats]
+  ['Join,cat,mode]
+ 
+GetValue name ==
+  u:= get(name,"value",$e) => u
+  u:= comp(name,$EmptyMode,$e) => u  --name may be a form
+  systemError [name,'" is not bound in the current environment"]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/int-top.boot.pamphlet b/src/interp/int-top.boot.pamphlet
new file mode 100644
index 00000000..77f36f8e
--- /dev/null
+++ b/src/interp/int-top.boot.pamphlet
@@ -0,0 +1,497 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp int-top.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{intloopReadConsole}
+
+This is the top level loop when reading from the input console.  This
+function calls itself after processing the current line.  Because of
+this it is important that the underlying common lisp supports
+tail-recursion.
+
+Normally we never really exit this function.
+
+We read a string from the input. The serverReadLine\cite{1} function
+is a special readline function that handles communication with the 
+session manager code, which is a separate process running in parallel.
+In the usual case it just returns the current string.
+
+If the user enters a blank line ([[#a=]]) then just put up another prompt
+and then tail-recursively call [[intloopReadConsole]].
+
+If the user has set [[$DALYMODE]] to true and the new line starts with
+an open parenthesis then the input is assumed to be a lisp expression
+and is evaluated by the underlying common lisp. This is useful if you
+are doing a lot of debugging. Commands can also be executed in the
+underlying common lisp by using the [[)lisp]] command. In either case we
+tail-recursively call [[intloopReadConsole]].
+
+If the user typed [[)fin]] then we exit the loop and drop into the
+underlying common lisp. You can use the [[(restart)]] function call
+to return to the top level loop.
+
+If the input line starts with a close parenthesis we parse the 
+input line as a command rather than an expression. We execute the command
+and then tail-recursively call [[intloopReadConsole]].
+
+If the input line contains a trailing underscore, which is the standard
+end-of-line escape character, then we continue to read the line by
+tail-recursively calling [[intloopReadConsole]].
+
+If none of the above conditions occur we simply evaluate the input line
+and then tail-recursively call [[intloopReadConsole]].
+
+However, there was a small bug in the test for the system command
+[[)fin]]. Originally, the test took the form:
+\begin{verbatim}
+   intloopPrefix?('")fin",a) => []
+\end{verbatim}
+This test was flawed in two ways. First, it would match {\sl any}
+command beginning with [[)fin]]. Second, it would {\sl only} match
+names beginning with [[)fin]], although [[)fi]] is an acceptable
+abbreviation for this command. The improved test takes the form:
+\begin{verbatim}
+    pfx := stripSpaces intloopPrefix?('")fi",a)
+    pfx and ((pfx = '")fi") or (pfx = '")fin")) => []
+\end{verbatim}
+
+\section{intloopPrefix?}
+The [[intloopPrefix?(prefix, whole)]] function simply tests if the string
+[[prefix]] is a prefix of the string [[whole]]. The original
+implementation discounts {\sl any} whitespace in [[whole]] in deciding a
+match, when a more sensible behavior would be to discount only leading
+whitespace.
+
+Moreover, the function SUBSTRING\cite{2} was being improperly called.
+The reason why this improper call had gone undetected is that
+generally [[intloopPrefix?]] is invoked with a prefix string of length
+one -- hence the start position for the substring would generally
+begin at index [[spaces]] (which is what we want).
+
+The original code read:
+\begin{verbatim}
+intloopPrefix?(prefix,whole) ==
+     #prefix > #whole => false
+     good:=true
+     spaces := 0
+     i := 0
+     len := #prefix
+     wlen := #whole
+     for j in 0.. while (good and i < len and j < wlen) repeat
+       good:= (prefix.i = whole.j) or (whole.j = char " ")
+       if prefix.i = whole.j then i := i+1
+       if whole.j = char " " then spaces := spaces + 1
+     spaces = wlen => nil
+     if good then SUBSTRING(whole,#prefix+spaces-1,nil) else good
+
+\end{verbatim}
+
+The improved version of [[inloopPrefix?(prefix, whole)]] returns the
+string [[whole]] sans leading whitespace if the match succeeds, else nil.
+
+<<intloopPrefix?>>=
+intloopPrefix?(prefix,whole) ==
+     #prefix > #whole => false
+     good := true
+     leading := true
+     spaces := 0
+     i := 0
+     len := #prefix
+     wlen := #whole
+     for j in 0.. while (good and i < len and j < wlen) repeat
+       good := (prefix.i = whole.j) or (leading and (whole.j = char " "))
+       if prefix.i = whole.j then i := i+1
+       if (whole.j = char " ") and leading then 
+         spaces := spaces + 1
+       else leading := false
+     spaces = wlen => nil
+     if good then SUBSTRING(whole,spaces,nil) else good
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% INTERPRETER TOP LEVEL
+
+spad() ==
+  -- starts the interpreter but does not read in profiles, etc.
+  $PrintCompilerMessageIfTrue: local
+  $inLispVM : local := nil
+  setOutputAlgebra "%initialize%"
+  runspad()
+  'EndOfSpad
+
+runspad() ==
+  mode:='restart
+  while mode='restart repeat
+    resetStackLimits()
+    CATCH($quitTag, CATCH('coerceFailure,
+                  mode:=CATCH('top__level, ncTopLevel())))
+
+ncTopLevel() ==
+-- Top-level read-parse-eval-print loop for the interpreter.  Uses
+-- the Bill Burge's parser.
+  IN_-STREAM: fluid := CURINSTREAM
+  _*EOF_*: fluid := NIL
+  $InteractiveMode :fluid := true
+  $BOOT: fluid := NIL
+  $NEWSPAD: fluid := true
+  $SPAD: fluid := true
+  $e:fluid := $InteractiveFrame
+  ncIntLoop()
+
+
+ncIntLoop() ==
+  CURINSTREAM : local := _*STANDARD_-OUTPUT_*
+  CUROUTSTREAM : local := _*STANDARD_-INPUT_*
+  intloop()
+
+
+intloop () ==
+    mode := $intRestart
+    while mode = $intRestart repeat
+      resetStackLimits()
+      mode := CATCH($intTopLevel,
+                    SpadInterpretStream(1, ["TIM", "DALY", "?"], true))
+
+
+SpadInterpretStream(str, source, interactive?) ==
+    $fn              : local := source
+    pile?                    := not interactive?
+    $libQuiet        : local := not interactive?
+    $newcompMode     : local := false
+--  following seems useless and causes ccl package problems
+--    $InteractiveMode : local := false
+ 
+    $newcompErrorCount: local := 0 -- SMW Feb 2/90.
+                                   -- Used in highComplete, ncHardError etc.
+ 
+    $okToExecuteMachineCode: local := true -- set false on error
+    $inclAssertions: local := ["AIX", "CommonLisp"] -- Jan 28/90
+ 
+ 
+    $lastPos               : local := $nopos   ------------>!!!
+    $erMsgToss             : local := false --------------->!!!
+    $ncMsgList             : local := nil
+ 
+    $systemCommandFunction : local := function InterpExecuteSpadSystemCommand
+    $shoeReadLineFunction  : local := function serverReadLine
+    $promptMsg             : local := 'S2CTP023
+ 
+    interactive? =>
+                PRINC(MKPROMPT())
+                intloopReadConsole('"", str)
+                []
+    intloopInclude (source,0)
+    []
+ 
+    -----------------------------------------------------------------
+
+intloopReadConsole(b, n)==
+    a:= serverReadLine(_*STANDARD_-INPUT_*)
+    not STRINGP a => leaveScratchpad()
+    #a=0 =>
+             PRINC(MKPROMPT())
+             intloopReadConsole('"", n)
+    $DALYMODE and intloopPrefix?('"(",a) =>
+            intnplisp(a)
+            PRINC(MKPROMPT())
+            intloopReadConsole('"",n)
+    pfx := stripSpaces intloopPrefix?('")fi",a)
+    pfx and ((pfx = '")fi") or (pfx = '")fin")) => []
+    b = '"" and (d := intloopPrefix?('")", a)) =>
+             setCurrentLine d
+             c := ncloopCommand(d,n)
+             PRINC(MKPROMPT())
+             intloopReadConsole('"", c)
+    a:=CONCAT(b,a)
+    ncloopEscaped a => intloopReadConsole(SUBSEQ(a, 0, (LENGTH a) - 1),n)
+    c := intloopProcessString(a, n)
+    PRINC(MKPROMPT())
+    intloopReadConsole('"", c)
+ 
+<<intloopPrefix?>> 
+ 
+intloopProcess(n,interactive,s)==
+     StreamNull s => n
+     [lines,ptree]:=CAR s
+     pfAbSynOp?(ptree,"command")=>
+            if interactive then setCurrentLine tokPart ptree
+            FUNCALL($systemCommandFunction, tokPart ptree)
+            intloopProcess(n ,interactive ,CDR s)
+     intloopProcess(intloopSpadProcess(n,lines,ptree,interactive)
+                 ,interactive ,CDR s)
+ 
+intloopEchoParse s==
+         [dq,stream]:=CAR s
+         [lines,rest]:=ncloopDQlines(dq,$lines)
+         setCurrentLine(mkLineList(lines))
+         if $EchoLines then ncloopPrintLines lines
+         $lines:=rest
+         cons([[lines,npParse dqToList dq]],CDR s)
+ 
+intloopInclude0(st, name, n) ==
+    $lines:local:=incStream(st,name)
+    intloopProcess(n,false,
+      next(function intloopEchoParse,
+        next(function insertpile,
+          next(function lineoftoks,$lines))))
+ 
+intloopInclude1(name,n) ==
+          a:=ncloopIncFileName name
+          a => intloopInclude(a,n)
+          n
+ 
+intloopProcessString(s,n) ==
+     setCurrentLine s
+     intloopProcess(n,true,
+         next(function ncloopParse,
+           next(function lineoftoks,incString s)))
+ 
+$pfMacros := []
+
+intloopSpadProcess(stepNo,lines,ptree,interactive?)==
+    $stepNo:local := stepNo
+    $currentCarrier := cc := ['carrier]
+    ncPutQ(cc, 'stepNumber, stepNo)
+    ncPutQ(cc, 'messages, $ncMsgList)
+    ncPutQ(cc, 'lines, lines)
+    $ncMsgList := nil
+    result := CatchAsCan(flung, Catch("SpadCompileItem",
+     CATCH($intCoerceFailure, CATCH($intSpadReader,
+       interp(cc, ptree, interactive?))))) where
+ 
+        interp(cc, ptree, interactive?) ==
+            ncConversationPhase(function phParse,            [cc, ptree])
+            ncConversationPhase(function phMacro,            [cc])
+            ncConversationPhase(function phIntReportMsgs,[cc, interactive?])
+            ncConversationPhase(function phInterpret,        [cc])
+ 
+            #ncEltQ(cc, 'messages) ^= 0 => ncError()
+ 
+    intSetNeedToSignalSessionManager()
+    $prevCarrier := $currentCarrier
+    result = 'ncEnd     => stepNo
+    result = 'ncError   => stepNo
+    result = 'ncEndItem => stepNo
+    stepNo+1
+ 
+phInterpret carrier ==
+  ptree := ncEltQ(carrier, 'ptree)
+  val := intInterpretPform(ptree)
+  ncPutQ(carrier, 'value, val)
+ 
+ 
+--% phReportMsgs: carrier[lines,messages,..]-> carrier[lines,messages,..]
+phIntReportMsgs(carrier, interactive?) ==
+    $erMsgToss => 'OK
+    lines := ncEltQ(carrier, 'lines)
+    msgs  := ncEltQ(carrier, 'messages)
+    nerr  := #msgs
+    ncPutQ(carrier, 'ok?, nerr = 0)
+    nerr = 0 => 'OK
+    processMsgList(msgs, lines)
+    intSayKeyedMsg ('S2CTP010,[nerr])
+    'OK
+ 
+mkLineList lines ==
+  l := [CDR line for line in lines | nonBlank CDR line]
+  #l = 1 => CAR l
+  l
+
+nonBlank str ==
+  value := false
+  for i in 0..MAXINDEX str repeat
+    str.i ^= char " " =>
+      value := true
+      return value
+  value
+      
+ncloopCommand (line,n) ==
+         a:=ncloopPrefix?('")include",line)=>
+                  ncloopInclude1( a,n)
+         FUNCALL($systemCommandFunction,line)
+         n
+
+ncloopEscaped x==
+     esc :=false
+     done:=false
+     for i in (# x) - 1 .. 0 by -1 while not done repeat
+         done:=
+              x.i='" ".0 =>false
+              x.i='"__".0=>
+                       esc:=true
+                       true
+              true
+     esc
+
+ncloopDQlines (dq,stream)==
+        StreamNull stream
+        a:= poGlobalLinePosn tokPosn CADR dq
+        b:= poGlobalLinePosn CAAR stream
+        streamChop (a-b+1,stream)
+ 
+streamChop(n,s)==
+    if StreamNull s
+    then [nil,nil]
+    else if EQL(n,0)
+         then [nil,s]
+         else
+            [a,b]:= streamChop(n-1,cdr s)
+            line:=car s
+            c:=ncloopPrefix?('")command",CDR line)
+            d:= cons(car line,if c then c else cdr line)
+            [cons(d,a),b]
+ 
+ncloopPrintLines lines ==
+        for line in lines repeat WRITE_-LINE CDR line
+        WRITE_-LINE '" "
+ 
+ncloopIncFileName string==
+                fn := incFileName string
+                not fn =>
+                    WRITE_-LINE (CONCAT(string, '" not found"))
+                    []
+                fn
+
+ncloopParse s==
+         [dq,stream]:=CAR s
+         [lines,rest]:=ncloopDQlines(dq,stream)
+         cons([[lines,npParse dqToList dq]],CDR s)
+ 
+ncloopInclude0(st, name, n) ==
+     $lines:local := incStream(st, name)
+     ncloopProcess(n,false,
+         next(function ncloopEchoParse,
+           next(function insertpile,
+            next(function lineoftoks,$lines))))
+ 
+ncloopInclude1(name,n) ==
+          a:=ncloopIncFileName name
+          a => ncloopInclude(a,n)
+          n
+
+incString s== incRenumber incLude(0,[s],0,['"strings"] ,[Top])
+
+ncError() ==
+    THROW("SpadCompileItem",'ncError)
+
+--% Compilation Carriers
+--  This data structure is used to carry information between phases.
+
+--% phParse: carrier[tokens,...] -> carrier[ptree, tokens,...]
+--)line (defun pretty (x) (boottran::reallyprettyprint x))
+--)line (defun packagetran (x) (boot::|packageTran|))
+phParse(carrier,ptree) ==
+    phBegin 'Parsing
+    if $ncmParse then
+           nothing
+           intSayKeyedMsg ('S2CTP003,[%pform ptree])
+    ncPutQ(carrier, 'ptree, ptree)
+    'OK
+ 
+
+--% phMacro: carrier[ptree,...] -> carrier[ptree, ptreePremacro,...]
+phMacro carrier ==
+    phBegin 'Macroing
+    ptree  := ncEltQ(carrier, 'ptree)
+    ncPutQ(carrier, 'ptreePremacro, ptree)
+ 
+    ptree  := macroExpanded ptree
+    if $ncmMacro then
+        intSayKeyedMsg ('S2CTP007,[%pform ptree] )
+ 
+    ncPutQ(carrier, 'ptree, ptree)
+    'OK
+ 
+--% phReportMsgs: carrier[lines,messages,..]-> carrier[lines,messages,..]
+phReportMsgs(carrier, interactive?) ==
+    $erMsgToss => 'OK
+    lines := ncEltQ(carrier, 'lines)
+    msgs  := ncEltQ(carrier, 'messages)
+    nerr  := #msgs
+    ncPutQ(carrier, 'ok?, nerr = 0)
+    interactive? and nerr = 0 => 'OK
+    processMsgList(msgs, lines)
+    intSayKeyedMsg ('S2CTP010,[nerr])
+    'OK
+ 
+ncConversationPhase(fn, args) ==
+    carrier := first args
+ 
+    $ncMsgList: local := []
+    $convPhase: local := 'NoPhase
+ 
+    UNWIND_-PROTECT( APPLY(fn, args), wrapup(carrier) ) where
+        wrapup(carrier) ==
+            for m in $ncMsgList repeat
+                ncPutQ(carrier, 'messages, [m, :ncEltQ(carrier, 'messages)])
+ 
+ncloopPrefix?(prefix,whole) ==
+     #prefix > #whole => false
+     good:=true
+     for i in 0..#prefix-1 for j in 0.. while good repeat
+                good:= prefix.i = whole.j
+     if good then SUBSTRING(whole,#prefix,nil) else good
+ 
+phBegin id ==
+    $convPhase := id
+    if $ncmPhase then intSayKeyedMsg('S2CTP021,[id])
+ 
+PullAndExecuteSpadSystemCommand stream ==
+    ExecuteSpadSystemCommand CAR stream
+    CDR stream
+
+ExecuteSpadSystemCommand string ==
+  FUNCALL($systemCommandFunction, string)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} [[src/interp/server.boot.pamphlet]]
+\bibitem{2} [[src/interp/vmlisp.lisp.pamphlet]]
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/interop.boot.pamphlet b/src/interp/interop.boot.pamphlet
new file mode 100644
index 00000000..4d346313
--- /dev/null
+++ b/src/interp/interop.boot.pamphlet
@@ -0,0 +1,933 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/interop.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- note domainObjects are now (dispatchVector hashCode . domainVector)
+-- lazy oldAxiomDomainObjects are (dispatchVector hashCode  (Call form) . backptr), 
+-- pre oldAxiomCategory is (dispatchVector . (cat form))
+-- oldAxiomCategory objects are (dispatchVector . ( (cat form)  hash defaultpack parentlist))
+
+hashCode? x == INTEGERP x
+
+$domainTypeTokens := ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory,
+           'oldAxiomCategory, 0]
+
+-- The name game.
+-- The compiler produces names that are of the form:
+-- a) cons(0, <string>)
+-- b) cons(1, type-name, arg-names...)
+-- c) cons(2, arg-names...)
+-- d) cons(3, value)
+-- NB: (c) is for tuple-ish constructors, 
+--     and (d) is for dependent types.
+
+DNameStringID := 0
+DNameApplyID  := 1
+DNameTupleID  := 2
+DNameOtherID  := 3
+
+DNameToSExpr1 dname ==
+  NULL dname => error "unexpected domain name"
+  CAR dname = DNameStringID => 
+    INTERN(CompStrToString CDR dname)
+  name0 := DNameToSExpr1 CAR CDR dname
+  args  := CDR CDR dname
+  name0 = '_-_> => 
+    froms := CAR args
+    froms := MAPCAR(function DNameToSExpr, CDR froms)
+    ret   := CAR CDR args -- a tuple
+    ret   := DNameToSExpr CAR CDR ret -- contents
+    CONS('Mapping, CONS(ret, froms))
+  name0 = 'Union or name0 = 'Record =>
+    sxs := MAPCAR(function DNameToSExpr, CDR CAR args)
+    CONS(name0, sxs)
+  name0 = 'Enumeration =>
+    CONS(name0, MAPCAR(function DNameFixEnum, CDR CAR args))
+  CONS(name0, MAPCAR(function DNameToSExpr, args))
+
+DNameToSExpr dname ==
+  CAR dname = DNameOtherID  =>
+	CDR dname
+  sx := DNameToSExpr1 dname
+  CONSP sx => sx
+  LIST sx
+
+DNameFixEnum arg == CompStrToString CDR arg
+  
+SExprToDName(sexpr, cosigVal) == 
+  -- is it a non-type valued object?
+  NOT cosigVal => [DNameOtherID, :sexpr]
+  if CAR sexpr = '_: then sexpr := CAR CDR CDR sexpr
+  CAR sexpr = 'Mapping =>
+    args := [ SExprToDName(sx, 'T) for sx in CDR sexpr]
+    [DNameApplyID,
+         [DNameStringID,: StringToCompStr '"->"],
+              [DNameTupleID, : CDR args],
+		 [DNameTupleID, CAR args]]
+  name0 :=   [DNameStringID, : StringToCompStr SYMBOL_-NAME CAR sexpr]
+  CAR sexpr = 'Union or CAR sexpr = 'Record =>
+    [DNameApplyID, name0, 
+        [DNameTupleID,: [ SExprToDName(sx, 'T) for sx in CDR sexpr]]]
+  newCosig := CDR GETDATABASE(CAR sexpr, QUOTE COSIG)
+  [DNameApplyID, name0,
+   : MAPCAR(function SExprToDName, CDR sexpr, newCosig)]
+
+-- local garbage because Compiler strings are null terminated
+StringToCompStr(str) == 
+   CONCATENATE(QUOTE STRING, str, STRING (CODE_-CHAR 0))
+
+CompStrToString(str) == 
+   SUBSTRING(str, 0, (LENGTH str - 1))
+-- local garbage ends
+
+runOldAxiomFunctor(:allArgs) ==
+  [:args,env] := allArgs
+  GETDATABASE(env, 'CONSTRUCTORKIND) = 'category =>
+      [$oldAxiomPreCategoryDispatch,: [env, :args]]
+  dom:=APPLY(env, args)
+  makeOldAxiomDispatchDomain dom
+
+makeLazyOldAxiomDispatchDomain domform ==
+  attribute? domform =>
+      [$attributeDispatch, domform, hashString(SYMBOL_-NAME domform)]
+  GETDATABASE(opOf domform, 'CONSTRUCTORKIND) = 'category =>
+      [$oldAxiomPreCategoryDispatch,: domform]
+  dd := [$lazyOldAxiomDomainDispatch, hashTypeForm(domform,0), domform]
+  NCONC(dd,dd) -- installs back pointer to head of domain.
+  dd
+
+makeOldAxiomDispatchDomain dom ==
+  PAIRP dom => dom
+  [$oldAxiomDomainDispatch,hashTypeForm(dom.0,0),:dom]
+
+closeOldAxiomFunctor(name) ==
+   [function runOldAxiomFunctor,:SYMBOL_-FUNCTION name]
+
+lazyOldAxiomDomainLookupExport(domenv, self, op, sig, box, skipdefaults, env) ==
+  dom := instantiate domenv
+  SPADCALL(CDR dom, self, op, sig, box, skipdefaults, CAR(dom).3)
+
+lazyOldAxiomDomainHashCode(domenv, env) == CAR domenv
+
+lazyOldAxiomDomainDevaluate(domenv, env) ==
+  dom := instantiate domenv
+  SPADCALL(CDR dom, CAR(dom).1)
+
+lazyOldAxiomAddChild(domenv, kid, env) ==
+  CONS($lazyOldAxiomDomainDispatch,domenv)
+
+$lazyOldAxiomDomainDispatch :=
+   VECTOR('lazyOldAxiomDomain,
+          [function lazyOldAxiomDomainDevaluate],
+          [nil],
+	  [function lazyOldAxiomDomainLookupExport],
+          [function lazyOldAxiomDomainHashCode],
+          [function lazyOldAxiomAddChild])
+
+-- old Axiom pre category objects are just (dispatch . catform)
+-- where catform is ('categoryname,: evaluated args)
+-- old Axiom category objects are  (dispatch . [catform, hashcode, defaulting package, parent vector, dom])
+oldAxiomPreCategoryBuild(catform, dom, env) ==
+   pack := oldAxiomCategoryDefaultPackage(catform, dom)
+   CONS($oldAxiomCategoryDispatch,
+       [catform, hashTypeForm(catform,0), pack, oldAxiomPreCategoryParents(catform,dom), dom])
+oldAxiomPreCategoryHashCode(catform, env) == hashTypeForm(catform,0)
+oldAxiomCategoryDefaultPackage(catform, dom) ==
+    hasDefaultPackage opOf catform 
+
+oldAxiomPreCategoryDevaluate([op,:args], env) ==
+   SExprToDName([op,:devaluateList args], T)
+
+$oldAxiomPreCategoryDispatch :=
+   VECTOR('oldAxiomPreCategory,
+          [function oldAxiomPreCategoryDevaluate],
+          [nil],
+          [nil],
+          [function oldAxiomPreCategoryHashCode],
+          [function oldAxiomPreCategoryBuild],
+          [nil])
+
+oldAxiomCategoryDevaluate([[op,:args],:.], env) ==
+   SExprToDName([op,:devaluateList args], T)
+
+oldAxiomPreCategoryParents(catform,dom) ==
+  vars := ["$",:rest GETDATABASE(opOf catform, 'CONSTRUCTORFORM)]
+  vals := [dom,:rest catform]
+  -- parents :=  GETDATABASE(opOf catform, 'PARENTS)
+  parents := parentsOf opOf catform
+  PROGV(vars, vals,
+    LIST2VEC
+      [EVAL quoteCatOp cat for [cat,:pred] in parents | EVAL pred])
+
+quoteCatOp cat == 
+   atom cat => MKQ cat
+   ['LIST, MKQ CAR cat,: CDR cat]
+
+
+oldAxiomCategoryLookupExport(catenv, self, op, sig, box, env) ==
+   [catform,hash, pack,:.] := catenv
+   opIsHasCat op => if EQL(sig, hash) then [self] else nil
+   NULL(pack) => nil
+   if not VECP pack then
+       pack:=apply(pack, CONS(self, rest catform))
+       RPLACA(CDDR catenv, pack)
+   fun := basicLookup(op, sig, pack, self) => [fun]
+   nil
+
+oldAxiomCategoryParentCount([.,.,.,parents,.], env) == LENGTH parents
+oldAxiomCategoryNthParent([.,.,.,parvec,dom], n, env) ==
+  catform := ELT(parvec, n-1)
+  VECTORP KAR catform => catform
+  newcat := oldAxiomPreCategoryBuild(catform,dom,nil)
+  SETELT(parvec, n-1, newcat)
+  newcat
+
+oldAxiomCategoryBuild([catform,:.], dom, env) ==
+  oldAxiomPreCategoryBuild(catform,dom, env)
+oldAxiomCategoryHashCode([.,hash,:.], env) == hash
+
+$oldAxiomCategoryDispatch :=
+   VECTOR('oldAxiomCategory,
+          [function oldAxiomCategoryDevaluate],
+          [nil],
+          [function oldAxiomCategoryLookupExport],
+          [function oldAxiomCategoryHashCode],
+          [function oldAxiomCategoryBuild], -- builder ??
+          [function oldAxiomCategoryParentCount],
+          [function oldAxiomCategoryNthParent]) -- 1 indexed
+
+attributeDevaluate(attrObj, env) ==
+   [name, hash] := attrObj
+   StringToCompStr SYMBOL_-NAME name
+
+attributeLookupExport(attrObj, self, op, sig, box, env) ==
+   [name, hash] := attrObj
+   opIsHasCat op => if EQL(hash, sig) then [self] else nil
+
+attributeHashCode(attrObj, env) ==
+   [name, hash] := attrObj
+   hash
+
+attributeCategoryBuild(attrObj, dom, env) ==
+   [name, hash] := attrObj
+   [$attributeDispatch, name, hash] 
+
+attributeCategoryParentCount(attrObj, env) == 0
+
+attributeNthParent(attrObj, env) == nil
+
+$attributeDispatch :=
+   VECTOR('attribute,
+          [function attributeDevaluate],
+          [nil],
+          [function attributeLookupExport],
+          [function attributeHashCode],
+          [function attributeCategoryBuild], -- builder ??
+          [function attributeCategoryParentCount],
+          [function attributeNthParent]) -- 1 indexed
+
+
+orderedDefaults(conform,domform) ==
+  $depthAssocCache : local := MAKE_-HASHTABLE 'ID
+  conList := [x for x in orderCatAnc (op := opOf conform) | hasDefaultPackage op]
+  acc := nil
+  ancestors := ancestorsOf(conform,domform)
+  for x in conList repeat
+    for y in ancestors | x = CAAR y repeat acc := [y,:acc]
+  NREVERSE acc
+
+instantiate domenv ==
+   -- following is a patch for a bug in runtime.as
+   -- has a lazy dispatch vector with an instantiated domenv
+  VECTORP CDR domenv => [$oldAxiomDomainDispatch ,: domenv]
+  callForm := CADR domenv
+  oldDom := CDDR domenv
+  [functor,:args] := callForm
+--  if null(fn := GETL(functor,'instantiate)) then
+--     ofn := SYMBOL_-FUNCTION functor
+--     loadFunctor functor
+--     fn := SYMBOL_-FUNCTION functor
+--     SETF(SYMBOL_-FUNCTION functor, ofn)
+--     PUT(functor, 'instantiate, fn)
+--  domvec := APPLY(fn, args)
+  domvec := APPLY(functor, args)
+  RPLACA(oldDom, $oldAxiomDomainDispatch)
+  RPLACD(oldDom, [CADR oldDom,: domvec])
+  oldDom
+
+hashTypeForm([fn,: args], percentHash) == 
+   hashType([fn,:devaluateList args], percentHash)
+
+--------------------> NEW DEFINITION (override in i-util.boot.pamphlet)
+devaluate(d) ==
+  isDomain d =>
+      -- ?need a shortcut for old domains
+      -- ELT(CAR d, 0) = 'oldAxiomDomain => ...
+      -- FIXP(ELT(CAR d,0)) => d
+      DNameToSExpr(SPADCALL(CDR d,CAR(d).1))
+  not REFVECP d => d
+  QSGREATERP(QVSIZE d,5) and QREFELT(d,3) is ['Category] => QREFELT(d,0)
+  QSGREATERP(QVSIZE d,0) =>
+    d':=QREFELT(d,0)
+    isFunctor d' => d'
+    d
+  d
+
+$hashOp1 := hashString '"1"
+$hashOp0 := hashString '"0"
+$hashOpApply := hashString '"apply"
+$hashOpSet := hashString '"set!"
+$hashSeg := hashString '".."
+$hashPercent := hashString '"%"
+
+oldAxiomDomainLookupExport _
+  (domenv, self, op, sig, box, skipdefaults, env) ==
+     domainVec := CDR domenv
+     if hashCode? op then
+         EQL(op, $hashOp1) => op := 'One
+         EQL(op, $hashOp0) => op := 'Zero
+         EQL(op, $hashOpApply) => op := 'elt
+         EQL(op, $hashOpSet) => op := 'setelt
+         EQL(op, $hashSeg) => op := 'SEGMENT
+     constant := nil
+     if hashCode? sig and self and EQL(sig, getDomainHash self) then
+       sig := '($)
+       constant := true
+     val :=
+       skipdefaults => 
+          oldCompLookupNoDefaults(op, sig, domainVec, self)
+       oldCompLookup(op, sig, domainVec, self)
+     null val => val
+     if constant then val := SPADCALL val
+     RPLACA(box, val)
+     box
+     
+oldAxiomDomainHashCode(domenv, env) == CAR domenv
+
+oldAxiomDomainHasCategory(domenv, cat, env) ==
+  HasAttribute(domvec := CDR domenv, cat) or
+    HasCategory(domvec, devaluate cat)
+
+oldAxiomDomainDevaluate(domenv, env) == 
+   SExprToDName(CDR(domenv).0, 'T)
+
+oldAxiomAddChild(domenv, child, env) == CONS($oldAxiomDomainDispatch, domenv)
+
+$oldAxiomDomainDispatch :=
+   VECTOR('oldAxiomDomain,
+          [function oldAxiomDomainDevaluate],
+          [nil],
+	  [function oldAxiomDomainLookupExport],
+	  [function oldAxiomDomainHashCode],
+          [function oldAxiomAddChild])
+
+--------------------> NEW DEFINITION (see g-util.boot.pamphlet)
+isDomain a ==
+  PAIRP a and VECP(CAR a) and
+    member(CAR(a).0, $domainTypeTokens)
+
+-- following is interpreter interfact to function lookup
+-- perhaps it should always work with hashcodes for signature?
+--------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
+NRTcompiledLookup(op,sig,dom) ==
+  if CONTAINED('_#,sig) then
+      sig := [NRTtypeHack t for t in sig]
+  hashCode? sig =>   compiledLookupCheck(op,sig,dom)
+  (fn := compiledLookup(op,sig,dom)) => fn
+  percentHash :=
+      VECP dom => hashType(dom.0, 0)
+      getDomainHash dom
+  compiledLookupCheck(op, hashType(['Mapping,:sig], percentHash), dom)
+
+--------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
+compiledLookup(op, sig, dollar) ==
+  if not isDomain dollar then dollar := NRTevalDomain dollar
+  basicLookup(op, sig, dollar, dollar)
+
+--------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
+basicLookup(op,sig,domain,dollar) ==
+   -- following case is for old domains like Record and Union
+   -- or for getting operations out of yourself
+  VECP domain =>
+     isNewWorldDomain domain => -- getting ops from yourself (or for defaults)
+        oldCompLookup(op, sig, domain, dollar)
+     -- getting ops from Record or Union
+     lookupInDomainVector(op,sig,domain,dollar)
+  hashPercent :=
+     VECP dollar => hashType(dollar.0,0)
+     hashType(dollar,0)
+  box := [nil]
+  not VECP(dispatch := CAR domain) => error "bad domain format"
+  lookupFun := dispatch.3
+  dispatch.0 = 0 =>  -- new compiler domain object
+       hashSig :=
+           hashCode? sig => sig
+	   opIsHasCat op => hashType(sig, hashPercent)
+           hashType(['Mapping,:sig], hashPercent)
+
+       if SYMBOLP op then
+          op = 'Zero => op := $hashOp0
+          op = 'One => op := $hashOp1
+          op = 'elt => op := $hashOpApply
+          op = 'setelt => op := $hashOpSet
+          op := hashString SYMBOL_-NAME op
+       val:=CAR SPADCALL(CDR domain, dollar, op, hashSig, box, false,
+                               lookupFun) => val
+       hashCode? sig => nil
+       #sig>1 or opIsHasCat op => nil
+       boxval := SPADCALL(CDR dollar, dollar, op, hashType(first sig, hashPercent),
+                     box, false, lookupFun) =>
+          [FUNCTION IDENTITY,: CAR boxval]
+       nil
+  opIsHasCat op =>
+      HasCategory(domain, sig)
+  if hashCode? op then
+     EQL(op, $hashOp1) => op := 'One
+     EQL(op, $hashOp0) => op := 'Zero
+     EQL(op, $hashOpApply) => op := 'elt
+     EQL(op, $hashOpSet) => op := 'setelt
+     EQL(op, $hashSeg) => op := 'SEGMENT
+  hashCode? sig and EQL(sig, hashPercent) =>
+      SPADCALL CAR SPADCALL(CDR dollar, dollar, op, '($), box, false, lookupFun)
+  CAR SPADCALL(CDR dollar, dollar, op, sig, box, false, lookupFun)
+
+basicLookupCheckDefaults(op,sig,domain,dollar) ==
+  box := [nil]
+  not VECP(dispatch := CAR dollar) => error "bad domain format"
+  lookupFun := dispatch.3
+  dispatch.0 = 0  =>  -- new compiler domain object
+       hashPercent :=
+          VECP dollar => hashType(dollar.0,0)
+          hashType(dollar,0)
+
+       hashSig :=
+         hashCode? sig => sig
+         hashType( ['Mapping,:sig], hashPercent)
+
+       if SYMBOLP op then op := hashString SYMBOL_-NAME op
+       CAR SPADCALL(CDR dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun)
+  CAR SPADCALL(CDR dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun)
+
+$hasCatOpHash := hashString '"%%"
+opIsHasCat op ==
+  hashCode? op => EQL(op, $hasCatOpHash)
+  EQ(op, "%%")
+
+-- has cat questions lookup up twice if false
+-- replace with following ?
+--  not(opIsHasCat op) and
+--     (u := lookupInDomainVector(op,sig,domvec,domvec)) => u
+
+oldCompLookup(op, sig, domvec, dollar) ==
+  $lookupDefaults:local := nil
+  u := lookupInDomainVector(op,sig,domvec,dollar) => u
+  $lookupDefaults := true
+  lookupInDomainVector(op,sig,domvec,dollar)
+
+oldCompLookupNoDefaults(op, sig, domvec, dollar) ==
+  $lookupDefaults:local := nil
+  lookupInDomainVector(op,sig,domvec,dollar)
+
+--------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
+lookupInDomainVector(op,sig,domain,dollar) ==
+  PAIRP domain => basicLookupCheckDefaults(op,sig,domain,domain)
+  slot1 := domain.1
+  SPADCALL(op,sig,dollar,slot1)
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lookupComplete(op,sig,dollar,env) ==
+   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,nil)
+   newLookupInTable(op,sig,dollar,env,nil)
+ 
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lookupIncomplete(op,sig,dollar,env) == 
+   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,true)
+   newLookupInTable(op,sig,dollar,env,true)
+ 
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lookupInCompactTable(op,sig,dollar,env) ==
+   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,true)
+   newLookupInTable(op,sig,dollar,env,true)
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
+  if s = '$ then
+--  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
+    s := devaluate dollar -- calls from HasCategory can have $s
+  INTEGERP a =>
+    not typeFlag => s = domain.a
+    a = 6 and $isDefaultingPackage => s = devaluate dollar
+    VECP (d := domainVal(dollar,domain,a)) =>
+      s = d.0 => true
+      domainArg := ($isDefaultingPackage => domain.6.0; domain.0)
+      KAR s = QCAR d.0 and lazyMatchArgDollarCheck(s,d.0,dollar.0,domainArg)
+    --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain)      --old style (erase)
+    isDomain d =>
+        dhash:=getDomainHash d
+        dhash =
+           (if hashCode? s then s else hashType(s, dhash))
+--      s = devaluate d
+    lazyMatch(s,d,dollar,domain)                         --new style
+  a = '$ => s = devaluate dollar
+  a = "$$" => s = devaluate domain
+  STRINGP a =>
+    STRINGP s => a = s
+    s is ['QUOTE,y] and PNAME y = a
+    IDENTP s and PNAME s = a
+  atom a =>  a = s
+  op := opOf a
+  op  = 'NRTEVAL => s = nrtEval(CADR a,domain)
+  op = 'QUOTE => s = CADR a
+  lazyMatch(s,a,dollar,domain)
+  --above line is temporarily necessary until system is compiled 8/15/90
+--s = a
+ 
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+getOpCode(op,vec,max) ==
+--search Op vector for "op" returning code if found, nil otherwise
+  res := nil
+  hashCode? op =>
+    for i in 0..max by 2 repeat
+      EQL(hashString PNAME QVELT(vec,i),op) => return (res := QSADD1 i)
+    res
+  for i in 0..max by 2 repeat
+    EQ(QVELT(vec,i),op) => return (res := QSADD1 i)
+  res
+
+hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
+  opIsHasCat op =>
+      HasCategory(domain, sig)
+  if hashCode? op and EQL(op, $hashOp1) then op := 'One
+  if hashCode? op and EQL(op, $hashOp0) then op := 'Zero
+  hashPercent :=
+    VECP dollar => hashType(dollar.0,0)
+    hashType(dollar,0)
+  if hashCode? sig and EQL(sig, hashPercent) then 
+         sig := hashType('(Mapping $), hashPercent)
+  dollar = nil => systemError()
+  $lookupDefaults = true =>
+    hashNewLookupInCategories(op,sig,domain,dollar)      --lookup first in my cats
+      or newLookupInAddChain(op,sig,domain,dollar)
+  --fast path when called from newGoGet
+  success := false
+  if $monitorNewWorld then
+    sayLooking(concat('"---->",form2String devaluate domain,
+      '"----> searching op table for:","%l","  "),op,sig,dollar)
+  someMatch := false
+  numvec := getDomainByteVector domain
+  predvec := domain.3
+  max := MAXINDEX opvec
+  k := getOpCode(op,opvec,max) or return
+    flag => newLookupInAddChain(op,sig,domain,dollar)
+    nil
+  maxIndex := MAXINDEX numvec
+  start := ELT(opvec,k)
+  finish :=
+    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    maxIndex
+  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
+  numArgs := if hashCode? sig then -1 else (#sig)-1
+  success := nil
+  $isDefaultingPackage: local :=
+    -- use special defaulting handler when dollar non-trivial
+    dollar ^= domain and isDefaultPackageForm? devaluate domain
+  while finish > start repeat
+    PROGN
+      i := start
+      numTableArgs :=numvec.i
+      predIndex := numvec.(i := QSADD1 i)
+      (predIndex ^= 0) and null testBitVector(predvec,predIndex) => nil
+      exportSig :=
+          [newExpandTypeSlot(numvec.(i + j + 1),
+            dollar,domain) for j in 0..numTableArgs]
+      sig ^= hashType(['Mapping,: exportSig],hashPercent) => nil --signifies no match
+      loc := numvec.(i + numTableArgs + 2)
+      loc = 1 => (someMatch := true)
+      loc = 0 =>
+        start := QSPLUS(start,QSPLUS(numTableArgs,4))
+        i := start + 2
+        someMatch := true --mark so that if subsumption fails, look for original
+        subsumptionSig :=
+          [newExpandTypeSlot(numvec.(QSPLUS(i,j)),
+            dollar,domain) for j in 0..numTableArgs]
+        if $monitorNewWorld then
+          sayBrightly [formatOpSignature(op,sig),'"--?-->",
+            formatOpSignature(op,subsumptionSig)]
+        nil
+      slot := domain.loc
+      null atom slot =>
+        EQ(QCAR slot,'newGoGet) => someMatch:=true
+                   --treat as if operation were not there
+        --if EQ(QCAR slot,'newGoGet) then
+        --  UNWIND_-PROTECT --break infinite recursion
+        --    ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot QCDR slot),
+        --      if domain.loc = 'skip then domain.loc := slot)
+        return (success := slot)
+      slot = 'skip =>       --recursive call from above 'replaceGoGetSlot
+        return (success := newLookupInAddChain(op,sig,domain,dollar))
+      systemError '"unexpected format"
+    start := QSPLUS(start,QSPLUS(numTableArgs,4))
+  (success ^= 'failed) and success =>
+    if $monitorNewWorld then
+      sayLooking1('"<----",uu) where uu ==
+        PAIRP success => [first success,:devaluate rest success]
+        success
+    success
+  subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u
+  flag or someMatch => newLookupInAddChain(op,sig,domain,dollar)
+  nil
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+newExpandLocalType(lazyt,dollar,domain) ==
+  VECP lazyt => lazyt.0
+  isDomain lazyt => devaluate lazyt
+  ATOM lazyt => lazyt
+  lazyt is [vec,.,:lazyForm] and VECP vec =>              --old style
+    newExpandLocalTypeForm(lazyForm,dollar,domain)
+  newExpandLocalTypeForm(lazyt,dollar,domain)             --new style
+
+hashNewLookupInCategories(op,sig,dom,dollar) ==
+  slot4 := dom.4
+  catVec := CADR slot4
+  SIZE catVec = 0 => nil                      --early exit if no categories
+  INTEGERP KDR catVec.0 =>
+    newLookupInCategories1(op,sig,dom,dollar) --old style
+  $lookupDefaults : local := nil
+  if $monitorNewWorld = true then sayBrightly concat('"----->",
+    form2String devaluate dom,'"-----> searching default packages for ",op)
+  predvec := dom.3
+  packageVec := QCAR slot4
+--the next three lines can go away with new category world
+  varList := ['$,:$FormalMapVariableList]
+  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+  valueList := [MKQ val for val in valueList]
+  nsig := MSUBST(dom.0,dollar.0,sig)
+  for i in 0..MAXINDEX packageVec |
+       (entry := packageVec.i) and entry ^= 'T repeat
+    package :=
+      VECP entry =>
+         if $monitorNewWorld then
+           sayLooking1('"already instantiated cat package",entry)
+         entry
+      IDENTP entry =>
+        cat := catVec.i
+        packageForm := nil
+        if not GETL(entry,'LOADED) then loadLib entry
+        infovec := GETL(entry,'infovec)
+        success :=
+          --VECP infovec =>  ----new world
+          true =>  ----new world
+            opvec := infovec.1
+            max := MAXINDEX opvec
+            code := getOpCode(op,opvec,max)
+            null code => nil
+            byteVector := CDDDR infovec.3
+            endPos :=
+              code+2 > max => SIZE byteVector
+              opvec.(code+2)
+            --not nrunNumArgCheck(#(QCDR sig),byteVector,opvec.code,endPos) => nil
+            --numOfArgs := byteVector.(opvec.code)
+            --numOfArgs ^= #(QCDR sig) => nil
+            packageForm := [entry,'$,:CDR cat]
+            package := evalSlotDomain(packageForm,dom)
+            packageVec.i := package
+            package
+                           ----old world
+          table := HGET($Slot1DataBase,entry) or systemError nil
+          (u := LASSQ(op,table))
+            and (v := or/[rest x for x in u]) =>
+              packageForm := [entry,'$,:CDR cat]
+              package := evalSlotDomain(packageForm,dom)
+              packageVec.i := package
+              package
+          nil
+        null success =>
+          if $monitorNewWorld = true then
+            sayBrightlyNT '"  not in: "
+            pp (packageForm and devaluate package or entry)
+          nil
+        if $monitorNewWorld then
+          sayLooking1('"candidate default package instantiated: ",success)
+        success
+      entry
+    null package => nil
+    if $monitorNewWorld then
+      sayLooking1('"Looking at instantiated package ",package)
+    res := basicLookup(op,sig,package,dollar) =>
+      if $monitorNewWorld = true then
+        sayBrightly '"candidate default package succeeds"
+      return res
+    if $monitorNewWorld = true then
+      sayBrightly '"candidate fails -- continuing to search categories"
+    nil
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+replaceGoGetSlot env ==
+  [thisDomain,index,:op] := env
+  thisDomainForm := devaluate thisDomain
+  bytevec := getDomainByteVector thisDomain
+  numOfArgs := bytevec.index
+  goGetDomainSlotIndex := bytevec.(index := QSADD1 index)
+  goGetDomain :=
+     goGetDomainSlotIndex = 0 => thisDomain
+     thisDomain.goGetDomainSlotIndex
+  if PAIRP goGetDomain and SYMBOLP CAR goGetDomain then
+     goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex)
+  sig :=
+    [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain)
+      for i in 0..numOfArgs]
+  thisSlot := bytevec.(QSADD1 index)
+  if $monitorNewWorld then
+    sayLooking(concat('"%l","..",form2String thisDomainForm,
+      '" wants",'"%l",'"  "),op,sig,goGetDomain)
+  slot :=  basicLookup(op,sig,goGetDomain,goGetDomain)
+  slot = nil =>
+    $returnNowhereFromGoGet = true =>
+      ['nowhere,:goGetDomain]  --see newGetDomainOpTable
+    sayBrightly concat('"Function: ",formatOpSignature(op,sig),
+      '" is missing from domain: ",form2String goGetDomain.0)
+    keyedSystemError("S2NR0001",[op,sig,goGetDomain.0])
+  if $monitorNewWorld then
+    sayLooking1(['"goget stuffing slot",:bright thisSlot,'"of "],thisDomain)
+  SETELT(thisDomain,thisSlot,slot)
+  if $monitorNewWorld then
+    sayLooking1('"<------",[CAR slot,:devaluate CDR slot])
+  slot
+
+HasAttribute(domain,attrib) ==
+  hashPercent :=
+       VECP domain => hashType(domain.0,0)
+       hashType(domain,0)
+  isDomain domain =>
+     FIXP((first domain).0) => 
+        -- following call to hashType was missing 2nd arg. 
+        -- getDomainHash domain added on 4/01/94 by RSS
+        basicLookup("%%",hashType(attrib, hashPercent),domain,domain)
+     HasAttribute(CDDR domain, attrib)
+-->
+  isNewWorldDomain domain => newHasAttribute(domain,attrib)
+--+
+  (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
+ 
+newHasAttribute(domain,attrib) ==
+  hashPercent :=
+       VECP domain => hashType(domain.0,0)
+       hashType(domain,0)
+  predIndex :=
+     hashCode? attrib =>
+        -- following call to hashType was missing 2nd arg. 
+        -- hashPercent added by PAB 15/4/94
+        or/[x for x in domain.2 | attrib = hashType(first x, hashPercent)]
+     LASSOC(attrib,domain.2)
+  predIndex =>
+    EQ(predIndex,0) => true
+    predvec := domain.3
+    testBitVector(predvec,predIndex)
+  false
+
+newHasCategory(domain,catform) ==
+  catform = '(Type) => true  
+  slot4 := domain.4
+  auxvec := CAR slot4
+  catvec := CADR slot4
+  $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain
+  #catvec > 0 and INTEGERP KDR catvec.0 =>              --old style
+    predIndex := lazyMatchAssocV1(catform,catvec,domain)
+    null predIndex => false
+    EQ(predIndex,0) => true
+    predvec := QVELT(domain,3)
+    testBitVector(predvec,predIndex)
+  lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
+  n : FIXNUM := MAXINDEX catvec
+  -- following call to hashType was missing 2nd arg. 0 added on 3/31/94 by RSS
+  hashCode? x =>
+    percentHash :=
+      VECP domain => hashType(domain.0, 0)
+      getDomainHash domain
+    or/[ELT(auxvec,i) for i in 0..n |
+        x = hashType(newExpandLocalType(QVELT(catvec,i),domain,domain), percentHash)]
+  xop := CAR x
+  or/[ELT(auxvec,i) for i in 0..n |
+    --xop = CAR (lazyt := QVELT(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
+    xop = CAR (lazyt := getCatForm(catvec,i,domain)) and lazyMatch(x,lazyt,domain,domain)]
+
+getCatForm(catvec, index, domain) ==
+   NUMBERP(form := QVELT(catvec,index)) => domain.form
+   form
+
+has(domain,catform') == HasCategory(domain,catform')
+
+HasCategory(domain,catform') ==
+  catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
+  catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
+  isDomain domain =>
+     FIXP((first domain).0) =>
+        catform' := devaluate catform'
+        basicLookup("%%",catform',domain,domain)
+     HasCategory(CDDR domain, catform')
+  catform:= devaluate catform'
+  isNewWorldDomain domain => newHasCategory(domain,catform)
+  domain0:=domain.0 -- handles old style domains, Record, Union etc.
+  slot4 := domain.4
+  catlist := slot4.1
+  member(catform,catlist) or
+   MEMQ(opOf(catform),'(Object Type)) or  --temporary hack
+    or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
+
+--systemDependentMkAutoload(fn,cnam) ==
+--    FBOUNDP(cnam) => "next"
+--    SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
+
+--------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
+lazyDomainSet(lazyForm,thisDomain,slot) ==
+  form :=
+    --lazyForm is [vec,.,:u] and VECP vec => u        --old style
+    lazyForm                                        --new style
+  slotDomain := evalSlotDomain(form,thisDomain)
+  if $monitorNewWorld then
+    sayLooking1(concat(form2String devaluate thisDomain,
+      '" activating lazy slot ",slot,'": "),slotDomain)
+-- name := CAR form
+--getInfovec name
+  SETELT(thisDomain,slot,slotDomain)
+
+
+--------------------> NEW DEFINITION (override in template.boot.pamphlet)
+evalSlotDomain(u,dollar) ==
+  $returnNowhereFromGoGet: local := false
+  $ : fluid := dollar
+  $lookupDefaults : local := nil -- new world
+  isDomain u => u
+  u = '$ => dollar
+  u = "$$" => dollar
+  FIXP u =>
+    VECP (y := dollar.u) => y
+    isDomain y => y
+    y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous?
+    y is [v,:.] => 
+      VECP v => lazyDomainSet(y,dollar,u)               --old style has [$,code,:lazyt]
+      constructor? v or MEMQ(v,'(Record Union Mapping)) => 
+        lazyDomainSet(y,dollar,u)                       --new style has lazyt
+      y
+    y
+  u is ['NRTEVAL,y] => 
+    y is ['ELT,:.] => evalSlotDomain(y,dollar)
+    eval  y
+  u is ['QUOTE,y] => y
+  u is ['Record,:argl] =>
+     FUNCALL('Record0,[[tag,:evalSlotDomain(dom,dollar)]
+                                 for [.,tag,dom] in argl])
+  u is ['Union,:argl] and first argl is ['_:,.,.] =>
+     APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
+                                 for [.,tag,dom] in argl])
+  u is ['spadConstant,d,n] =>
+    dom := evalSlotDomain(d,dollar)
+    SPADCALL(dom . n)
+  u is ['ELT,d,n] =>
+    dom := evalSlotDomain(d,dollar)
+    slot := dom . n
+    slot is ['newGoGet,:env] => replaceGoGetSlot env
+    slot
+  u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl])
+  systemErrorHere '"evalSlotDomain"
+ 
+--------------------> NEW DEFINITION (override in i-util.boot.pamphlet)
+domainEqual(a,b) ==
+  devaluate(a) = devaluate(b)
+
+--makeConstructorsAutoLoad()
+
+-- following changes should go back into xrun.boot
+-- patched version from xrun.boot
+--------------------> NEW DEFINITION (override in clammed.boot.pamphlet)
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+coerceConvertMmSelection(funName,m1,m2) ==
+  -- calls selectMms with $Coerce=NIL and tests for required
+  -- target type. funName is either 'coerce or 'convert.
+  $declaredMode : local:= NIL
+  $reportBottomUpFlag : local:= NIL
+  l := selectMms1(funName,m2,[m1],[m1],NIL)
+--  mmS := [[sig,[targ,arg],:pred] for x in l | x is [sig,[.,arg],:pred] and
+  mmS := [x for x in l | x is [sig,:.] and hasCorrectTarget(m2,sig) and
+      sig is [dc,targ,oarg] and isEqualOrSubDomain(m1,oarg)]
+  mmS and CAR mmS
+
+--------------------> NEW DEFINITION (see i-funsel.boot.pamphlet)
+getFunctionFromDomain(op,dc,args) ==
+  -- finds the function op with argument types args in dc
+  -- complains, if no function or ambiguous
+  $reportBottomUpFlag:local:= NIL
+  member(CAR dc,$nonLisplibDomains) =>
+    throwKeyedMsg("S2IF0002",[CAR dc])
+  not constructor? CAR dc =>
+    throwKeyedMsg("S2IF0003",[CAR dc])
+  p:= findFunctionInDomain(op,dc,NIL,args,args,NIL,NIL) =>
+--+
+    --sig := [NIL,:args]
+    domain := evalDomain dc
+    for mm in nreverse p until b repeat
+      [[.,:osig],nsig,:.] := mm
+      b := compiledLookup(op,nsig,domain)
+    b or  throwKeyedMsg("S2IS0023",[op,dc])
+  throwKeyedMsg("S2IF0004",[op,dc])
+
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/interp-fix.boot.pamphlet b/src/interp/interp-fix.boot.pamphlet
new file mode 100644
index 00000000..c0edc418
--- /dev/null
+++ b/src/interp/interp-fix.boot.pamphlet
@@ -0,0 +1,99 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp interp-fix.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- From newfort.boot:
+
+checkPrecision e ==
+  -- Do we have a string?
+  CHAR_-CODE(CHAR(e,0)) = 34 => e
+  e := delete(char " ",STRINGIMAGE e)
+  $fortranPrecision = "double" =>
+    iPart := SUBSEQ(e,0,(period:=POSITION(char ".",e))+1)
+    expt  := if ePos := POSITION(char "E",e) then SUBSEQ(e,ePos+1) else "0"
+    rPart :=
+      ePos => SUBSEQ(e,period+1,ePos)
+      period+1 < LENGTH e => SUBSEQ(e,period+1)
+      "0"
+    STRCONC(iPart,rPart,"D",expt)
+  e
+
+-- From i-eval.boot
+
+evaluateType1 form ==
+  --evaluates the arguments passed to a constructor
+  [op,:argl]:= form
+  constructor? op =>
+    null (sig := getConstructorSignature form) =>
+       throwEvalTypeMsg("S2IE0005",[form])
+    [.,:ml] := sig
+    ml := replaceSharps(ml,form)
+    # argl ^= #ml => throwEvalTypeMsg("S2IE0003",[form,form])
+    for x in argl for m in ml for argnum in 1.. repeat
+      typeList := [v,:typeList] where v ==
+        categoryForm?(m) =>
+          m := evaluateType MSUBSTQ(x,'_$,m)
+          evalCategory(x' := (evaluateType x), m) => x'
+          throwEvalTypeMsg("S2IE0004",[form])
+
+        m := evaluateType m
+        GETDATABASE(opOf m,'CONSTRUCTORKIND) = 'domain and
+          (tree := mkAtree x) and putTarget(tree,m) and
+           ((bottomUp tree) is [m1]) and
+            (v:= coerceInteractive(getAndEvalConstructorArgument tree,m))
+              => objValUnwrap v
+        if x = $EmptyMode then x := $quadSymbol
+        throwEvalTypeMsg("S2IE0006",[makeOrdinal argnum,m,form])
+    [op,:NREVERSE typeList]
+  throwEvalTypeMsg("S2IE0007",[op])
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp
new file mode 100644
index 00000000..30d61fc7
--- /dev/null
+++ b/src/interp/interp-proclaims.lisp
@@ -0,0 +1,3391 @@
+
+(IN-PACKAGE "USER") 
+(PROCLAIM '(FTYPE (FUNCTION (*) (VALUES T T)) BOOT:|ReadLine|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) FUNCTION) FOAM::FOAMPROGINFOSTRUCT-FUNCALL)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) FIXNUM) BOOT::LINE-NUMBER BOOT::|eq0|
+            VMLISP:CHAR2NUM BOOT::|nothingWidth| BOOT::|nothingSub|
+            BOOT::|nothingSuper| BOOT::LINE-LAST-INDEX
+            BOOT::LINE-CURRENT-INDEX FOAM:|ProgHashCode|
+            FOAM:|strLength| BOOT:|StringLength| BOOT::|widthSC|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) FOAM:|SInt|)
+            FOAM::FOAMPROGINFOSTRUCT-HASHVAL)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) (VALUES T T)) BOOT::|mkSharpVar|
+            BOOT::|makeCharacter| BOOT::|mapCatchName|
+            BOOT::|queryUser| BOOT:|LispKeyword| BOOT::MONITOR-INFO
+            BOOT::FILE-GETTER-NAME BOOT::|mkDomainCatName|
+            FOAM:AXIOMXL-FILE-INIT-NAME BOOT::|getKeyedMsg|
+            BOOT::|mkCacheName| BOOT::|mkAuxiliaryName|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION ((VECTOR T) (VECTOR T)) T) VMLISP::VGREATERP
+            VMLISP::LEXVGREATERP)) 
+(PROCLAIM '(FTYPE (FUNCTION ((VECTOR T)) T) BOOT:TRIMLZ)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) (*)) BOOT:|StringToInteger|
+            BOOT:|StringToFloat|)) 
+(PROCLAIM '(FTYPE (FUNCTION (T *) (VALUES T T)) VMLISP:|read-line|)) 
+(PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) T) BOOT::|subWord|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T) FIXNUM) VMLISP:QSQUOTIENT
+            VMLISP:QSREMAINDER VMLISP:QENUM FOAM:|SetProgHashCode|
+            BOOT:GETCHARN BOOT::|attributeCategoryParentCount|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T) (VALUES T T)) BOOT::|htMakeLabel|
+            BOOT::|fetchKeyedMsg|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T) *) BOOT::|applpar1| BOOT::|apprpar1|
+            BOOT::|appargs1| BOOT::|appagg1| BOOT::|matrixBorder|
+            BOOT::|e02befDefaultSolve| BOOT::|e02agfDefaultSolve|
+            BOOT::|e02dafDefaultSolve| BOOT::|htQueryPage|
+            BOOT::|compileAndLink| BOOT::|f04jgfDefaultSolve|
+            BOOT::|f02aefDefaultSolve| BOOT::|f02agfDefaultSolve|
+            BOOT::|apphor| BOOT::|appvertline| BOOT::|applpar|
+            BOOT::|e04jafDefaultSolve| BOOT::|f01brfDefaultSolve|
+            BOOT::|e04ycfDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T *) *) VMLISP:CONCAT
+            BOOT::LOCALDATABASE BOOT::FE BOOT::|ncBug|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T) *) BOOT::|replacePercentByDollar,fn|
+            BOOT::|getSlotFromDomain| BOOT::|ncGetFunction|
+            BOOT::|c02affDefaultSolve| BOOT::|c02agfDefaultSolve|
+            BOOT::|Qf2F| BOOT::|selectOptionLC| BOOT::|compUniquely|
+            BOOT::|compExpression| BOOT::|e02gafDefaultSolve|
+            BOOT::|e02aefDefaultSolve| BOOT::|e02bbfDefaultSolve|
+            BOOT::|asytranForm| BOOT::|asytranFormSpecial|
+            BOOT::|asytranApplySpecial| BOOT::SOCK-GET-STRING
+            BOOT::|sockGetString| BOOT::|showIt| BOOT::|pmPreparse,fn|
+            BOOT::|pmPreparse,gn| BOOT::|dbSearchAbbrev|
+            BOOT::|mkUpDownPattern,recurse| BOOT::|htMkPath|
+            BOOT::|getVal| BOOT::|htGlossPage| BOOT::|checkCondition|
+            BOOT::|compTopLevel| BOOT::GETOP
+            BOOT::|checkTransformFirsts| BOOT::|parseIf,ifTran|
+            BOOT::|dbShowOpAllDomains| BOOT::|templateVal|
+            BOOT::|dbChooseDomainOp| BOOT::|whoUsesOperation|
+            BOOT::|c05pbfDefaultSolve| BOOT::|c05nbfDefaultSolve|
+            BOOT::|c06frfDefaultSolve| BOOT::|c06ekfDefaultSolve|
+            BOOT::|NRTvectorCopy| BOOT::|c06fufDefaultSolve|
+            BOOT::|c06fpfDefaultSolve| BOOT::|c06fqfDefaultSolve|
+            BOOT::|applyInPackage| BOOT::|exp2FortSpecial|
+            BOOT::|f04mcfDefaultSolve| BOOT::|f04atfDefaultSolve|
+            BOOT::|f04fafDefaultSolve| BOOT::|f02affDefaultSolve|
+            BOOT::|dbShowCons1| BOOT::|f02aafDefaultSolve|
+            BOOT::|dbSelectCon| BOOT::|dbShowOperationsFromConform|
+            BOOT::|genSearch1| BOOT::|dbSearch|
+            BOOT::|constructorSearch| BOOT::|underscoreDollars,fn|
+            BOOT::|oSearchGrep| BOOT::|selectOption|
+            BOOT::|constructorSearchGrep| BOOT::|dbInfoChoose1|
+            BOOT::|bcDrawIt2| BOOT::|charybdis| BOOT::|bcMkFunction|
+            BOOT::|charyTop| BOOT::|bcDrawIt|
+            BOOT::|f01qcfDefaultSolve| BOOT::|e02zafDefaultSolve|
+            BOOT::|ncloopInclude0| VMLISP:$FCOPY)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T) *) BOOT::|e02befColdSolve|
+            BOOT::|e02ahfDefaultSolve| BOOT::|e02akfDefaultSolve|
+            BOOT::|d02bbfDefaultSolve| BOOT::|d02cjfDefaultSolve|
+            BOOT::|e01sefDefaultSolve| BOOT::|htSetLiterals|
+            BOOT::|f04mbfDefaultSolve| BOOT::|f02axfDefaultSolve|
+            BOOT::|f02akfDefaultSolve| BOOT::|kcaPage1|
+            BOOT::MAKE-DEPSYS BOOT::|makeLongStatStringByProperty|
+            BOOT::|f01rdfDefaultSolve| BOOT::|f01qdfDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T) *) BOOT::|compileConstructorLib|
+            BOOT::|quoteApp| BOOT::|argsapp| BOOT::|appargs|
+            BOOT::|inApp| BOOT::|appsc| BOOT::|appfrac| BOOT::|exptApp|
+            BOOT::|charyTrouble| BOOT::|overbarApp|
+            BOOT::|appHorizLine| BOOT::|overlabelApp| BOOT::/D-1
+            BOOT::|appmat| BOOT::|e01bhfDefaultSolve|
+            BOOT::|e02adfDefaultSolve| BOOT::|e02bcfDefaultSolve|
+            BOOT::|makeStream| BOOT::|newExpandLocalTypeArgs|
+            FOAM:|fputss| FOAM:|fgetss| BOOT::|f01mafDefaultSolve|
+            BOOT::|conform2StringList| BOOT::|f02abfDefaultSolve|
+            BOOT::|f02awfDefaultSolve| BOOT::|f02ajfDefaultSolve|
+            BOOT::|f02adfDefaultSolve| BOOT::|patternCheck,mknew|
+            BOOT::|kDomainName| BOOT::|koPageAux| BOOT::|dbShowOp1|
+            BOOT::APP BOOT::|appagg| BOOT::|binomialApp|
+            BOOT::|charyTrouble1| BOOT::|appsub| BOOT::|slashApp|
+            BOOT::|appsetq| BOOT::|makeStatString|
+            BOOT::|e02dffDefaultSolve| BOOT::|e04dgfDefaultSolve|
+            BOOT::|e04fdfDefaultSolve| BOOT::|e04gcfDefaultSolve|
+            BOOT::|f01refDefaultSolve| BOOT::|f01qefDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T T) *) BOOT::|makeFortranFun|
+            BOOT::|d03eefDefaultSolve| BOOT::|e04nafDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T) *) BOOT::|e02ajfDefaultSolve|
+            BOOT::|e02dcfDefaultSolve| BOOT::|e02ddfDefaultSolve|
+            BOOT::|d02ejfDefaultSolve| BOOT::|d02bhfDefaultSolve|
+            BOOT::|d01fcfDefaultSolve| BOOT::|d01gbfDefaultSolve|
+            BOOT::|f04qafDefaultSolve| BOOT::|f02bjfDefaultSolve|
+            BOOT::|f02bbfDefaultSolve| BOOT::|e04mbfDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T T T T T T) *)
+            BOOT::BUILD-INTERPSYS)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T) *) BOOT::|e02ddfColdSolve|
+            BOOT::|f02xefDefaultSolve| BOOT::|f02wefDefaultSolve|
+            BOOT::BUILD-DEPSYS)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T) *) BOOT::|e04ucfDefaultSolve|
+            BOOT::|e02dcfColdSolve| BOOT::|d02kefDefaultSolve|
+            BOOT::|d02gbfDefaultSolve| BOOT::|d02gafDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T T T T T) *)
+            BOOT::|d02rafDefaultSolve|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T) T) BOOT::|mapRecurDepth| BOOT::THETACHECK
+            BOOT::|flowSegmentedMsg| BOOT::|rewriteMap0|
+            BOOT::|restoreDependentMapInfo| BOOT::|dcSig|
+            BOOT::|analyzeNonRecur| BOOT::|addMap| BOOT::|fortCall|
+            BOOT::|axAddLiteral| BOOT::|writeStringLengths|
+            BOOT::|writeXDR| BOOT::|deleteMap| BOOT::|fnameNew|
+            BOOT::|axFormatDefaultOpSig| BOOT::|htpSetProperty|
+            BOOT::|rewriteMap1| BOOT::|displayMap|
+            BOOT::|compileDeclaredMap| BOOT::|compileCoerceMap|
+            BOOT::|displaySingleRule| BOOT::|hasAtt| BOOT::|hasAttSig|
+            BOOT::SPADRWRITE0 BOOT::SPADRWRITE BOOT::|recordNewValue|
+            BOOT::|recordOldValue| BOOT::|orderUnionEntries,split|
+            BOOT::|getSlotNumberFromOperationAlist|
+            BOOT::|isSuperDomain| BOOT::|recordOldValue0|
+            BOOT::|PARSE-getSemanticForm| BOOT::|recordNewValue0|
+            BOOT::|getSlotFromFunctor| BOOT::|addConstructorModemaps|
+            BOOT::|compDefWhereClause| BOOT::|get1| BOOT::|get2|
+            BOOT::|get0| BOOT::|throwListOfKeyedMsgs|
+            BOOT::|getConstructorOpsAndAtts|
+            BOOT::|mkExplicitCategoryFunction|
+            BOOT::|findDomainSlotNumber| BOOT::|addIntSymTabBinding|
+            BOOT::|sigsMatch| BOOT::|compDefineAddSignature|
+            BOOT::|hasFullSignature| BOOT:ELEMN BOOT::|mkAtree2|
+            BOOT::|mkAtree3| BOOT::|getValueFromSpecificEnvironment|
+            BOOT::|compForMode| BOOT::|transferPropsToNode,transfer|
+            BOOT::|genDomainOps| BOOT::|getOperationAlist|
+            BOOT::|remprop| BOOT::|setMsgForcedAttr| BOOT::|P2Uts|
+            BOOT::|Up2FR| BOOT::|mac0Define| BOOT::|getMappingArgValue|
+            BOOT::|compContained| BOOT::|getArgValueComp|
+            BOOT::|altTypeOf| BOOT::|mac0InfiniteExpansion|
+            BOOT::|setMsgUnforcedAttr| BOOT::|genDomainViewList|
+            BOOT::|compSubDomain| BOOT::|compCapsule|
+            BOOT::|sideEffectedArg?| BOOT::|evalFormMkValue|
+            BOOT::|doItIf| BOOT::|compSingleCapsuleItem|
+            BOOT::|compJoin| BOOT::|rewriteMap|
+            BOOT::|NRTgetLookupFunction| BOOT::|lisplibWrite|
+            BOOT::|getLocalMms| BOOT::|makeFunctorArgumentParameters|
+            BOOT::|selectMmsGen,exact?| BOOT::REDUCE-1
+            BOOT::|getLocalMms,f| BOOT::|isOpInDomain|
+            BOOT::|compDefine| BOOT::|compCategory|
+            BOOT::|getTargetFromRhs| BOOT::|unifyStructVar|
+            BOOT::|augmentSub| BOOT::|unifyStruct| BOOT::|compAdd|
+            BOOT::|filterModemapsFromPackages| BOOT::|constrArg|
+            BOOT::|evalMmCond0| BOOT::|maprinSpecial| BOOT::|hasCaty|
+            BOOT::|evalMmCond| BOOT:ADDASSOC BOOT::|hasCate|
+            BOOT::|matchTypes| BOOT::|findUniqueOpInDomain|
+            BOOT::|hasSigOr| BOOT::|hasSigAnd|
+            BOOT::|findCommonSigInDomain| BOOT::|evalMmCat1|
+            BOOT::|coerceTypeArgs| BOOT::|domArg2| BOOT::|L2Tuple|
+            BOOT::V2M BOOT::DEF-INNER BOOT::|OV2Sy| BOOT::|Qf2EF|
+            BOOT::|Sy2P| BOOT::I2NNI BOOT::|Rm2L| BOOT::|Var2OtherPS|
+            BOOT::|Var2UpS| BOOT::OV2SE BOOT::|NDmp2domain| VMLISP:PUT
+            BOOT::|Var2Up| BOOT::|Expr2Mp| BOOT::|Expr2Dmp|
+            BOOT::|Sy2NDmp| VMLISP:DEFIOSTREAM BOOT::|Dmp2P|
+            BOOT::|Sy2Mp| BOOT::|Var2SUP| BOOT::|Factored2Factored|
+            VMLISP:EQSUBSTLIST BOOT::I2PI BOOT::|P2Expr| BOOT::|P2Up|
+            BOOT::|P2Dmp| BOOT::|Var2FS| BOOT::|Sy2Dmp| BOOT::B-MDEF
+            BOOT::|Ker2Expr| BOOT::|Sy2OV| BOOT::|Var2QF| BOOT::|Sm2V|
+            BOOT::M2V BOOT::|Var2P| BOOT::I2OI BOOT::P2FR
+            BOOT::|makeEijSquareMatrix| BOOT::|Set2L| BOOT::|Sm2Rm|
+            BOOT::DEF BOOT::|Var2NDmp| BOOT::|Dmp2Dmp|
+            BOOT::|coerceDmp2| BOOT::|rread| BOOT::I2EI BOOT::|Var2Mp|
+            BOOT::|compCapsuleInner| BOOT::|Mp2FR| BOOT::|Qf2domain|
+            BOOT::|compCapsuleItems| BOOT::|L2Set| BOOT::|Var2Gdmp|
+            BOOT::COMP-ILAM BOOT::COMP-SPADSLAM BOOT::|L2Sm|
+            BOOT::|mkCategoryPackage| BOOT::COMP-SLAM BOOT::L2M
+            BOOT::|compDefine1| BOOT::|Mp2Expr| BOOT::|Ker2Ker|
+            BOOT::|Var2Dmp| VMLISP:MSUBST BOOT::|Dmp2NDmp|
+            BOOT::|Sm2PolyType| BOOT::|Var2OV|
+            BOOT::|orderPredicateItems| BOOT::|L2Rm| BOOT::|substVars|
+            BOOT::|OV2poly| BOOT::|Sm2M|
+            BOOT::|augmentLisplibModemapsFromFunctor| BOOT::OV2P
+            BOOT::|needBlankForRoot| BOOT::|Rn2F|
+            BOOT::|getInCoreModemaps| BOOT::|Sm2L| BOOT::|splitConcat|
+            BOOT::|Un2E| BOOT::|SUP2Up| BOOT::OV2OV
+            BOOT::|insertAlist,fn| BOOT::|replaceVars|
+            BOOT::|compFromIf| BOOT::|Scr2Scr| BOOT::|compBoolean|
+            BOOT::|L2Record| BOOT::|Rm2V| VMLISP:RPLNODE
+            BOOT::|domain2NDmp| BOOT::|Up2Up|
+            BOOT::|augLisplibModemapsFromCategory| BOOT::|P2Mp|
+            BOOT::|compWithMappingMode,FreeList| BOOT::|orderPredTran|
+            BOOT::|Rm2Sm| BOOT::|Rm2M| BOOT::|Up2SUP| BOOT::|Mp2Up|
+            BOOT::|Mp2Dmp| BOOT::|LargeMatrixp| BOOT::DP2DP
+            BOOT::|Dmp2Up| BOOT::|Up2P| BOOT::|Complex2Expr|
+            BOOT::|seteltModemapFilter| BOOT::/MONITORX BOOT::|P2Upxs|
+            BOOT::|coerceTraceFunValue2E| BOOT::|Complex2FR|
+            BOOT::|Up2Mp| BOOT::V2L BOOT::|P2Uls| BOOT::|M2Sm|
+            BOOT::|coerceTraceArgs2E| BOOT::|Complex2underDomain|
+            BOOT::|resolveTTRed2| BOOT::|Agg2L2Agg|
+            BOOT::|resolveTTRed1| BOOT::|fnameMake|
+            BOOT::MONITOR-PRINARGS VMLISP:HREMPROP
+            BOOT::|eltModemapFilter| BOOT::|coerceOrCroak|
+            BOOT::|resolveTTEq2| BOOT::|resolveTTEq1|
+            BOOT::|matchUpToPatternVars|
+            BOOT::|getConditionalCategoryOfType|
+            BOOT::|getSubDomainPredicate| BOOT::|resolveTMEq2|
+            BOOT::|coerceIntX| BOOT::|compSymbol|
+            BOOT::|coerceSubDomain| BOOT::|compExpressionList|
+            BOOT::|NRTcompileEvalForm| BOOT::|setqMultiple,decompose|
+            BOOT::|permuteToOrder| BOOT::|retractUnderDomain|
+            BOOT::|compList| BOOT::SMALL-ENOUGH-COUNT
+            BOOT::|isRectangularList| BOOT::|augModemapsFromDomain1|
+            BOOT::|canCoerceByFunction1|
+            BOOT::|sayFunctionSelectionResult| BOOT::|compForm|
+            BOOT::|compTypeOf| BOOT::|comp3| BOOT::|coerceOrFail|
+            BOOT::|computeTTTranspositions,compress| BOOT::|algEqual|
+            BOOT::|compiledLookupCheck| VMLISP:RWRITE
+            BOOT::|coerceOrThrowFailure| BOOT::|NRTcompiledLookup|
+            BOOT::|spad2BootCoerce| BOOT::|M2Rm| BOOT::M2M
+            VMLISP:MACRO-INVALIDARGS BOOT::L2V BOOT::|Mp2P|
+            BOOT::|Mp2Mp| BOOT::|coerceDmpCoeffs| BOOT::|Expr2Complex|
+            BOOT::|Dmp2Expr| BOOT::|coerceFFE| BOOT::M2L VMLISP:QESET
+            BOOT::|V2Sm| BOOT::|isRectangularVector| BOOT::V2DP
+            BOOT::L2DP BOOT::|Up2Expr| BOOT::|Qf2Qf| BOOT::|NDmp2NDmp|
+            BOOT::|V2Rm| BOOT::|Qf2PF| BOOT::|Dmp2Mp| BOOT::|Up2Dmp|
+            BOOT::|Sy2Var| BOOT::|Agg2Agg| BOOT::|Expr2Up|
+            BOOT::|Sy2Up| VMLISP:HPUT BOOT::|pvarCondList1|
+            VMLISP:SUBSTRING BOOT::|interpRewriteRule| BOOT::|putAtree|
+            BOOT::|isEltable| BOOT::|selectMms| BOOT::|throwKeyedMsgSP|
+            BOOT::|pushDownTargetInfo|
+            BOOT::|pushDownOnArithmeticVariables|
+            BOOT::|keyedMsgCompFailureSP| BOOT::|intCodeGenCoerce1|
+            BOOT::|throwKeyedMsgCannotCoerceWithValue|
+            BOOT::|asytranForm1| BOOT::|hput| BOOT::|asyCattranOp1|
+            BOOT::|asyMakeOperationAlist| BOOT::|setVector4|
+            BOOT::|SetDomainSlots124| BOOT::|asGetExports|
+            BOOT::|asySig1| BOOT::|ncPutQ|
+            BOOT::|putConstructorProperty| BOOT::|throwKeyedErrorMsg|
+            BOOT::|mkUserConstructorAbbreviation|
+            BOOT::|unabbrevSpecialForms| BOOT::|nAssocQ|
+            BOOT::|New,ENTRY,2| BOOT::READ-INPUT BOOT::READ-SPAD
+            BOOT::|errorSupervisor1| BOOT::|argumentDataError|
+            BOOT::|BesselasymptA| BOOT::|htpSetLabelSpadValue|
+            BOOT::|optPackageCall| BOOT::|from?| BOOT::|clngamma|
+            BOOT::|chebevalarr| BOOT::|PsiBack| BOOT::|logH|
+            BOOT::|PiMinusLogSinPi| BOOT::|besselIcheb|
+            BOOT::|chebstarevalarr| BOOT::|chebf01coefmake|
+            BOOT::|clngammacase23| BOOT::|PsiAsymptoticOrder|
+            BOOT::|grepf| BOOT::|clngammacase1| BOOT::|cotdiffeval|
+            BOOT::|BesselIAsympt| BOOT::|lffloat|
+            BOOT::|substringMatch| BOOT::|makeResultRecord|
+            BOOT::|makeCompilation| BOOT::|extractFileNameFromPath,fn|
+            BOOT::|makeAspGenerators| BOOT::|makeAspGenerators1|
+            BOOT::|mkNewUnionFunList| BOOT::|EnumEqual|
+            BOOT::|cleanUpAfterNagman| BOOT::|sySpecificErrorAtToken|
+            BOOT::|prepareResults,defaultValue|
+            BOOT::|setVector4Onecat| BOOT::|pfLambda| BOOT::|pfWIf|
+            BOOT::|SigSlotsMatch| BOOT::|DomainPrint1|
+            BOOT::|DescendCodeAdd1,update| BOOT::|CheckVector|
+            BOOT::|pfTLambda| BOOT::|htSystemVariables,fn|
+            BOOT::|postCollect,finish| VMLISP:|nsubst|
+            BOOT::|npBackTrack| BOOT::|bchtMakeButton|
+            BOOT::|compWhere| BOOT::|compVector| BOOT::|compAtom|
+            BOOT::|getUniqueModemap| BOOT::|modeIsAggregateOf|
+            BOOT::|compArgumentsAndTryAgain| VMLISP:MACRO-MISSINGARGS
+            BOOT::|compForm1| BOOT::|mergeModemap|
+            BOOT::|compSubsetCategory| BOOT::|compString|
+            BOOT::|augModemapsFromDomain| BOOT::|compWithMappingMode|
+            BOOT::|extractCodeAndConstructTriple| BOOT::|compCat|
+            BOOT::|pfWith| BOOT::|compMakeDeclaration|
+            BOOT::|extendsCategoryForm| BOOT::|compSeq|
+            BOOT::|compSeq1| BOOT::|compReturn| BOOT::|isSubset|
+            BOOT::|getModemapList| BOOT::|compCase1|
+            BOOT::|compCoerce1| BOOT::|compPretend| BOOT::|compMacro|
+            BOOT::|compConstructorCategory| BOOT::|compCoerce|
+            BOOT::|compColon| BOOT::|compSetq| BOOT::|compLeave|
+            BOOT::|npList| BOOT::|modeEqualSubst| BOOT::|compIf|
+            BOOT::|compIs| BOOT::|comp2| BOOT::|compImport|
+            BOOT::|coerce,fn| BOOT::|throwKeyedMsgFromDb|
+            BOOT::|sayKeyedMsgFromDb| BOOT::|compHas| BOOT::|compExit|
+            BOOT::|compElt| BOOT::|compConstruct| BOOT::|compCons|
+            BOOT::|compCons1| BOOT::|compSeqItem|
+            BOOT::|recordInstantiation1| BOOT::|compCase|
+            BOOT::|compQuote| BOOT::|recordInstantiation|
+            BOOT::|compAtSign| BOOT::|compSuchthat|
+            BOOT::|addToConstructorCache| BOOT::|loadLibNoUpdate|
+            BOOT::SETDATABASE BOOT::|lassocShiftWithFunction|
+            BOOT::|assocCache| BOOT::|assocCacheShift|
+            BOOT::|assocCacheShiftCount| BOOT::|pileForests|
+            BOOT::|isLegitimateMode;| BOOT::|hasFileProperty;|
+            BOOT::|coerceConvertMmSelection;|
+            BOOT::|hasFilePropertyNoCache| BOOT::|writeLib1|
+            BOOT::|rwrite| BOOT::|putModemapIntoDatabase|
+            BOOT::|getOplistWithUniqueSignatures|
+            BOOT::|checkSkipOpToken| BOOT::|checkSkipIdentifierToken|
+            BOOT::|readLib1| BOOT::|checkSkipBlanks|
+            BOOT::MAKE-PARSE-FUNC-FLATTEN-1 BOOT::|checkSkipToken|
+            BOOT::|getDocForCategory| BOOT::|newWordFrom|
+            BOOT::PRINT-XDR-STREAM BOOT::|getDocForDomain|
+            BOOT::|getDoc| BOOT::|htcharPosition|
+            BOOT::|PackageDescendCode| BOOT::|RecordEqual|
+            BOOT::|processPackage,replace| BOOT::|UnionEqual|
+            BOOT::|mkEnumerationFunList| BOOT::|mkMappingFunList|
+            BOOT::|mkUnionFunList| BOOT::|mkRecordFunList|
+            BOOT::|MappingEqual| BOOT::|CondAncestorP|
+            BOOT::|updateDatabase| BOOT::|compressSexpr|
+            BOOT::|parseTypeError| BOOT::|moreGeneralCategoryPredicate|
+            BOOT::|encodeUnion| BOOT::|makeCatPred|
+            BOOT::|lookupInDomainByName| BOOT::|simpHasAttribute|
+            BOOT::|domainHput| BOOT::|simpHasPred,simpHas|
+            BOOT::|substDollarArgs| BOOT::|NRTisRecurrenceRelation|
+            BOOT::|dbShowOpSigList| BOOT::|dbSelectData|
+            BOOT::|dbReduceOpAlist| BOOT::|listOfCategoryEntriesIf|
+            BOOT::|dbResetOpAlistCondition|
+            BOOT::|algCoerceInteractive| BOOT::|buildPredVector,fn|
+            BOOT::|extendsCategoryBasic| BOOT::|catExtendsCat?|
+            BOOT::|expandType| BOOT::|expandTypeArgs| BOOT::|stuffSlot|
+            BOOT::|dbPresentOpsSaturn| BOOT::|reduceOpAlistForDomain|
+            BOOT::|mungeAddGensyms,fn| BOOT::|dbReduceBySelection|
+            BOOT::|extendsCategoryBasic0| BOOT::|substSlotNumbers|
+            BOOT::|dbReduceBySignature| BOOT::|extendsCategory|
+            BOOT::|buildPredVector| BOOT::|dbParts|
+            BOOT::|NRTextendsCategory1| BOOT::|getSubstQualify|
+            BOOT::|fortFormatLabelledIfGoto| BOOT::|whoUsesMatch1?|
+            BOOT::|fullSubstitute| BOOT::|whoUsesMatch?|
+            BOOT::|getfortarrayexp| BOOT::|addWhereList|
+            BOOT::|dbGetDisplayFormForOp|
+            BOOT::|dbGetFormFromDocumentation| BOOT::|anySubstring?|
+            VMLISP::MAKE-ENTRY BOOT::|NRTsetVector4a|
+            BOOT::|NRTsetVector4Part1| BOOT::|NRTencode,encode|
+            BOOT::|consOpSig| BOOT::|genSlotSig| BOOT::|NRTsetVector4|
+            BOOT::|newExpandGoGetTypeSlot| BOOT::MAKEOP
+            BOOT::|insertEntry| BOOT::|nextown| BOOT::|mkFortFn|
+            BOOT::|exp2Fort2| BOOT::|evalQUOTE| BOOT::|evalSEQ|
+            BOOT::|IFcodeTran| BOOT::|exp2FortFn|
+            BOOT::|fortFormatHead| BOOT::|addContour,fn1|
+            BOOT::|traverse,traverseInner| BOOT::|upTableSetelt|
+            BOOT::|printSignature| BOOT::|addContour,fn3|
+            BOOT::|commandAmbiguityError| BOOT::|charPosition|
+            BOOT::|traverse| BOOT::|dbPart| BOOT::|commandErrorMessage|
+            BOOT::|substituteOp| BOOT::|displayModemap|
+            BOOT::|displayType| BOOT::|comp| BOOT::|displayMode|
+            BOOT::|numOfOccurencesOf,fn| VMLISP::QUOREM
+            BOOT::|pmatchWithSl| BOOT::|displayCondition|
+            BOOT::|displayValue|
+            BOOT::|intersectionContour,buildModeAssoc| BOOT::|get|
+            BOOT::|sigDomainVal| BOOT::GEQNSUBSTLIST
+            BOOT::|compNoStacking| BOOT::|transImplementation|
+            BOOT::GEQSUBSTLIST BOOT::|libConstructorSig,g|
+            BOOT::|coerceable| BOOT::|substituteIntoFunctorModemap|
+            BOOT::|adjExitLevel| BOOT::|getParentsFor|
+            BOOT::|asytranApply| BOOT::|explodeIfs,fn| BOOT::|dbSplit|
+            BOOT::|buildLibAttr| BOOT::|buildLibOp|
+            BOOT::|transKCatAlist| BOOT::|dbTickIndex|
+            BOOT::|insertShortAlist| BOOT::|sublisFormal,sublisFormal1|
+            BOOT::PUTALIST FOAM:|FormatNumber|
+            BOOT::|dbSetOpAlistCondition| BOOT::|compiledLookup|
+            BOOT::|insertAlist| BOOT::|reduceAlistForDomain|
+            BOOT:|StreamCopyChars| BOOT:|StreamCopyBytes|
+            BOOT::|dbXParts| BOOT::|kePageDisplay|
+            BOOT::|dbShowOpItems| BOOT::MKPFFLATTEN-1
+            BOOT::|dbSearchOrder| BOOT::CARCDRX1 BOOT::SETELTREST
+            BOOT::SETELTFIRST BOOT::AS-INSERT1 BOOT::AS-INSERT
+            BOOT::PROPERTY BOOT::|mkDomTypeForm| BOOT::|stringPosition|
+            BOOT:|StringFromTo| BOOT::|patternCheck,equal|
+            BOOT:|StringFromLong| BOOT::|rightCharPosition|
+            BOOT::|infix?| BOOT::|matchSegment?| BOOT::|stringMatch|
+            BOOT::|skipBlanks| BOOT::|dbPresentConsSaturn|
+            BOOT::MAKE-DEFUN BOOT::|compOrCroak| BOOT::|profileRecord|
+            BOOT::|getSignature| BOOT::|traceDomainLocalOps|
+            BOOT::|getArgumentModeOrMoan|
+            BOOT::|filterListOfStringsWithFn|
+            BOOT::|mkGrepPattern1,charPosition|
+            BOOT::|displayModemap,g|
+            BOOT::|filterAndFormatConstructors| BOOT::READ-BOOT
+            BOOT::|userLevelErrorMessage| BOOT::|addBinding|
+            BOOT::|dbShowConsDoc1| BOOT::|makePathname|
+            BOOT::|mkConform| BOOT::|dbInfoFindCat| BOOT::|compReduce|
+            BOOT::|dbShowInfoList| BOOT::|dbShowConditions|
+            BOOT::|compRepeatOrCollect| BOOT::|dbInfoOrigin|
+            BOOT::|dbConstructorDoc| BOOT::|interpret2|
+            BOOT::|htpSetLabelInputString| BOOT::|letPrint2|
+            BOOT::|letPrint| BOOT::|mapLetPrint|
+            BOOT::|htpAddInputAreaProp| BOOT::|getOpBindingPower|
+            BOOT::|infixArgNeedsParens| BOOT::|linearFinalRequest|
+            BOOT::|bcInputEquations,f| BOOT::|htpSetLabelErrorMsg|
+            BOOT::|isBreakSegment?| BOOT::|substring?|
+            BOOT::|sublisMatAlist| BOOT::MAKESPAD
+            BOOT::|reportCategory| BOOT::|longext|
+            BOOT::|npParenthesize| BOOT::|bcString2WordList,fn|
+            VMLISP::ECQGENEXP VMLISP::RCQGENEXP BOOT::|outputString|
+            BOOT::|outputNumber| VMLISP::DODSETQ
+            BOOT::|pfInfApplication| BOOT::|insertString|
+            BOOT::|npAndOr| BOOT::|npListofFun| BOOT::|optSpecialCall|
+            BOOT::|pfPushBody| BOOT::|pfIf| BOOT::|incZip|
+            BOOT::|augProplist| BOOT::|augProplistInteractive|
+            BOOT::|centerString| BOOT::|evalCOLLECT|
+            BOOT::|interpCOLLECTbody| BOOT::|upLoopIterIN|
+            BOOT::|position,posn| BOOT::|domainVal| BOOT::|subVecNodes|
+            BOOT::|addBindingInteractive| BOOT::|interpCOLLECT|
+            BOOT::|upTaggedUnionConstruct| BOOT::|upRecordConstruct|
+            BOOT::|newExpandTypeSlot| BOOT::|upNullList|
+            BOOT::|upStreamIterIN| BOOT::|getCatForm|
+            BOOT::|oldAxiomAddChild| BOOT::|evalCOERCE|
+            BOOT::|mkAndApplyZippedPredicates| BOOT::|lookupPred|
+            BOOT::|oldAxiomDomainHasCategory| BOOT::|mkIterFun|
+            BOOT::|attributeCategoryBuild|
+            BOOT::|oldAxiomCategoryBuild| BOOT::|upLETtype|
+            BOOT::|upLETWithFormOnLhs| BOOT::|lazyMatchAssocV1|
+            BOOT::|oldAxiomCategoryNthParent| BOOT::|assignSymbol|
+            BOOT::|evalIsntPredicate| BOOT::|evalIsPredicate|
+            BOOT::|SpadInterpretStream| BOOT::|upSetelt| BOOT:SUBLISLIS
+            BOOT::|upNullTuple| BOOT::|evalIF| BOOT::|intloopProcess|
+            BOOT::|evalis| BOOT::|evalREPEAT| BOOT::|upwhereMain|
+            BOOT::|upwhereMkAtree| BOOT::|upwhereClause|
+            BOOT::|intloopInclude0| BOOT::|intloopSpadProcess,interp|
+            BOOT::|incPrefix?| BOOT::|inclmsgIfSyntax|
+            BOOT::|renamePatternVariables1| BOOT::|newExpandLocalType|
+            BOOT::|newExpandLocalTypeForm|
+            BOOT::|oldAxiomPreCategoryBuild|
+            BOOT::|getFunctionFromDomain| BOOT::|lazyOldAxiomAddChild|
+            BOOT:SUBSTEQ BOOT::|getOpCode| BOOT::|lazyDomainSet|
+            BOOT::|application2String| BOOT::|putI| BOOT::|mkInterpFun|
+            BOOT::|interpret1| BOOT::|analyzeMap0|
+            BOOT::|reportOpSymbol,sayMms| BOOT::|findLocalsInLoop|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T) T) BOOT::|analyzeRecursiveMap|
+            BOOT::|augmentMap| BOOT::|reportFunctionCompilation|
+            BOOT::|putSrcPos| BOOT::|hasSigInTargetCategory,fn|
+            BOOT::|encodeFunctionName| BOOT::|getArgValueComp2|
+            BOOT::|augModemapsFromCategory| BOOT::|compDefineFunctor1|
+            BOOT::|augModemapsFromCategoryRep|
+            BOOT::|compDefineFunctor| BOOT::|processFunctor|
+            BOOT::|buildFunctor| BOOT::|selectMmsGen,matchMms|
+            BOOT::|makeConstrArg|
+            BOOT::|commuteSparseUnivariatePolynomial|
+            BOOT::|commuteUnivariatePolynomial|
+            BOOT::|commuteSquareMatrix| BOOT::|coerceDmp1|
+            BOOT::|aggregateApp| BOOT::|compDefineCategory1|
+            BOOT::|commuteFraction| BOOT::|compDefineCategory|
+            BOOT::|commuteQuaternion| BOOT::|commuteComplex|
+            BOOT::|resolveTT2| BOOT::|concatApp1|
+            BOOT::|compFormPartiallyBottomUp|
+            BOOT::|canReturn,findThrow| BOOT::|orderMms|
+            BOOT::|sayFunctionSelection| BOOT::MATCH-FUNCTION-DEF
+            BOOT::|commuteNewDistributedMultivariatePolynomial|
+            BOOT::|commuteMPolyCat|
+            BOOT::|commuteDistributedMultivariatePolynomial|
+            BOOT::|commuteMultivariatePolynomial|
+            BOOT::|commutePolynomial| BOOT::|bottomUpDefaultCompile|
+            BOOT::|bottomUpDefaultEval| BOOT::|bottomUpFormTuple|
+            BOOT::|bottomUpFormAnyUnionRetract| BOOT::|bottomUpForm|
+            BOOT::|bottomUpFormUntaggedUnionRetract|
+            BOOT::|bottomUpFormRetract| BOOT::|bottomUpForm2|
+            BOOT::|bottomUpForm0| BOOT::|bottomUpForm3|
+            BOOT::|coerceByTable| BOOT::|compileRecurrenceRelation|
+            BOOT::|logS| BOOT::|spadify| BOOT::|prepareResults|
+            BOOT::|DescendCodeAdd1|
+            BOOT::|htSystemVariables,displayOptions| BOOT::|evalAndSub|
+            BOOT::FINCOMBLOCK BOOT::|compIf,Env| BOOT::LOCALASY
+            BOOT::|mkCacheVec| BOOT::LOCALNRLIB BOOT::|selectMms1;|
+            BOOT::|selectMms2| BOOT::|processPackage|
+            BOOT::|mkCategory| BOOT::|newCompareSig|
+            BOOT::|lookupInDomain| BOOT::|fortFormatDo|
+            BOOT::|newLookupInDomain| BOOT::|getNewDefaultPackage|
+            BOOT::|printLabelledList| BOOT::|compApplication|
+            BOOT::|dbExpandOpAlistIfNecessary| BOOT::-REDUCE
+            BOOT::|compDefineCapsuleFunction| BOOT::|genSearchSay|
+            BOOT::|compRepeatOrCollect,fn| BOOT::|dbGetDocTable|
+            BOOT::|apprpar| BOOT::WRITE-TAG-LINE BOOT::|concatTrouble|
+            BOOT::|charyBinary| BOOT::|split2| BOOT::|needStar|
+            BOOT::|lazyMatchArg2| BOOT::|newLookupInTable|
+            BOOT::|hashNewLookupInTable| BOOT::|compileADEFBody|
+            BOOT::|interpLoopIter| BOOT::|compileIF|
+            BOOT::|xlCannotRead| BOOT::|xlMsg| BOOT::|xlNoSuchFile|
+            BOOT::|incLine| BOOT::|xlFileCycle| BOOT::|xlConStill|
+            BOOT::|xlConActive| BOOT::|xlSay| BOOT::|xlOK1|
+            BOOT::|incLude| BOOT::|analyzeDeclaredMap|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T) T) BOOT::|analyzeNonRecursiveMap|
+            BOOT::|makeInternalMapName| BOOT::|printCName|
+            BOOT::|clearDep1| BOOT::|domArg| BOOT::|mkDomPvar|
+            BOOT::|hasSig| BOOT::|putIntSymTab|
+            BOOT::|findConstructorSlotNumber| BOOT::MAKE-FLOAT
+            BOOT::|getFileProperty|
+            BOOT::|compDefWhereClause,fetchType| BOOT::|compSubDomain1|
+            BOOT::|putFileProperty| BOOT::|srcPosNew|
+            BOOT::|substNames| BOOT::|mac0MLambdaApply|
+            BOOT::|mac0ExpandBody| BOOT::|genDomainView|
+            BOOT::|getArgValue2| BOOT::|compFunctorBody|
+            BOOT::|analyzeMap| BOOT::|defaultTarget|
+            BOOT::|selectDollarMms| BOOT::|selectMmsGen|
+            BOOT::|allOrMatchingMms| BOOT::|evalMmCat|
+            BOOT::|matchMmSig| BOOT::/LOCATE BOOT::|hasCateSpecialNew|
+            BOOT::|evalMm| BOOT::|evalMmFreeFunction|
+            BOOT::|hasCateSpecial| BOOT::|hasCate1| BOOT::|boxApp|
+            BOOT::|concatApp| BOOT::|appsum| BOOT::|altSuperSubApp|
+            BOOT::|concatbApp| BOOT::|appSum| BOOT::|binomApp|
+            BOOT::|aggApp| BOOT::|fixUpPredicate| BOOT::|stepApp|
+            BOOT::|appneg| BOOT::|setqMultipleExplicit|
+            BOOT::|braceApp| BOOT::|compSetq1| BOOT::|timesApp|
+            BOOT::|rootApp| BOOT::|bracketApp| BOOT::|plusApp|
+            BOOT::|appparu1| BOOT::|bigopWidth| BOOT::|P2Us|
+            BOOT::|pi2App| BOOT::|boxLApp| VMLISP:STRPOSL
+            BOOT::|compOrCroak1| BOOT::|piApp| BOOT::|compForm2|
+            BOOT::|compForm3| BOOT::|getConditionalCategoryOfType1|
+            BOOT::|indefIntegralApp| BOOT::|nothingApp|
+            BOOT::|evalconstruct| BOOT::|evalInfiniteTupleConstruct|
+            BOOT::|setqSetelt| BOOT::|evalTupleConstruct|
+            BOOT::|consProplistOf| BOOT::|setqMultiple|
+            BOOT::|coerceImmediateSubDomain| BOOT::|intApp|
+            BOOT::|setqSingle| BOOT::|assignError| BOOT::|sigma2App|
+            BOOT::|canReturn| BOOT::|appext| BOOT::|centerApp|
+            BOOT::|sigmaApp| BOOT::|stringApp| BOOT::|MpP2P|
+            BOOT::|evalForm| BOOT::|selectLocalMms|
+            BOOT::|bottomUpDefault| BOOT::|canCoerceTopMatching|
+            BOOT::|catchCoerceFailure| BOOT::|asGetModemaps|
+            BOOT::|asytranCategory| BOOT::|asytranCategoryItem|
+            BOOT::|asytranDeclaration|
+            BOOT::|InvestigateConditions,flist| BOOT::|getTranslation|
+            BOOT::|condUnabbrev|
+            BOOT::|constructorAbbreviationErrorCheck| BOOT::READ-SPAD0
+            BOOT::|BesselasymptB| BOOT::|optCallSpecially|
+            BOOT::|getDocDomainForOpSig| BOOT::|reportFunctionCacheAll|
+            BOOT::|clngammacase2| BOOT::|constoken| BOOT::|writeMalloc|
+            BOOT::|printDec| BOOT::|htPred2English,gn|
+            BOOT::|prepareData| BOOT::|protectedNagCall|
+            BOOT::|axiomType| BOOT::|DescendCode|
+            BOOT::|SetFunctionSlots|
+            BOOT::|InvestigateConditions,update|
+            BOOT::|htSystemVariables,functionTail| VMLISP:STRPOS
+            BOOT::|replaceExitEtc,fn| BOOT::|compNoStacking1|
+            BOOT::|compClam| BOOT::|getModemapListFromDomain|
+            BOOT::|say2Split| BOOT::|compColonInside| BOOT::|haddProp|
+            BOOT::|npEnclosed| BOOT::|hputNewProp|
+            BOOT::ASHARPMKAUTOLOADFUNCTOR
+            BOOT::ASHARPMKAUTOLOADCATEGORY BOOT::|addCoreModemap|
+            BOOT::|getMatchingRightPren| BOOT::|checkHTargs|
+            BOOT::|mkOperatorEntry| BOOT::|catPairUnion|
+            BOOT::|lookupUF| BOOT::|newLookupInCategories|
+            BOOT::|lookupFF| BOOT::|simpHasSignature|
+            BOOT::|compareSig| BOOT::|lazyCompareSigEqual|
+            BOOT::|lookupInAddChain| BOOT::|lookupInCategories|
+            BOOT::|lookupInTable| BOOT::|lookupDisplay|
+            BOOT::|domainTableLookup| BOOT::|dbShowOpConditions|
+            BOOT::|dbShowOpParameterJump|
+            BOOT::|dbShowOpImplementations| BOOT::|dbShowOpParameters|
+            BOOT::|dbShowOpOrigins| BOOT::|dbShowOpSignatures|
+            BOOT::|getSigSubst| BOOT::|optDeltaEntry|
+            BOOT::|lazyMatchArg| BOOT::|nrunNumArgCheck|
+            BOOT::|nextown2| BOOT::|semchkProplist|
+            BOOT::|interpREPEAT| BOOT::|makeCommonEnvironment,fn|
+            BOOT::|compMapCondFun| BOOT::|compApplyModemap|
+            BOOT::|compMapCond| BOOT::|compMapCond'|
+            BOOT::|compToApply| BOOT::REDUCE-N BOOT::|applyMapping|
+            BOOT::|compFormWithModemap| BOOT::|compAtomWithModemap|
+            BOOT::|ancestorsRecur| BOOT::|checkCommentsForBraces|
+            BOOT::|dbShowOpDocumentation| BOOT::|dbShowOpNames|
+            BOOT::REDUCE-N-1 BOOT::|dbGatherData| BOOT::|dbConsHeading|
+            BOOT::REDUCE-N-2 BOOT::|termMatch| BOOT::|matchAnySegment?|
+            BOOT::|replaceExitEtc| BOOT::|put| BOOT::|checkAndDeclare|
+            BOOT::|hasSigInTargetCategory| BOOT::READ-SPAD1
+            BOOT::|mkDetailedGrepPattern| BOOT::|displayInfoOp|
+            BOOT::|dbShowInfoOp| BOOT::|compReduce1| BOOT::|letPrint3|
+            BOOT::|intloopSpadProcess| BOOT::|zagApp|
+            BOOT::|findBalancingBrace| BOOT::|appelse| BOOT::|appChar|
+            BOOT::|appInfix| BOOT::|htMakeButtonSaturn|
+            BOOT::|vconcatapp| BOOT::|superSubApp| BOOT::|xLate|
+            BOOT::|appconc| BOOT::MAKELIB BOOT::|appparu|
+            BOOT::|charySemiColon| BOOT::|charyElse|
+            BOOT::|charyEquatnum| BOOT::|bcFindString|
+            BOOT::|charySplit| BOOT::|charyMinus| VMLISP::DCQGENEXP
+            BOOT::|augProplistOf| BOOT::|putHist|
+            BOOT::|evalUntargetedADEF| BOOT::|evalTargetedADEF|
+            BOOT::|mergeInPlace| BOOT::|upLoopIterSTEP|
+            BOOT::|mergeSort| BOOT::|interpLoop| BOOT::|collectStream|
+            BOOT::|collectStream1| BOOT::|lazyMatch|
+            BOOT::|lazyMatchArgDollarCheck|
+            BOOT::|interpCOLLECTbodyIter| BOOT::|lookupInCompactTable|
+            BOOT::|sayLooking| BOOT::|upStreamIterSTEP|
+            BOOT::|lookupIncomplete| BOOT::|newLookupInAddChain|
+            BOOT::|hashNewLookupInCategories| BOOT::|lookupComplete|
+            BOOT::|newLookupInCategories1| BOOT::|lazyMatchAssocV|
+            BOOT::|collectSeveralStreams| BOOT::|mkIterZippedFun|
+            BOOT::|compareSigEqual| BOOT::|mkInterpTargetedADEF|
+            BOOT::|compileTargetedADEF| BOOT::|collectOneStream|
+            BOOT::|oldCompLookupNoDefaults| BOOT::|evalTuple|
+            BOOT::|interpIF| BOOT::|getReduceFunction|
+            BOOT::|NRTgetMinivectorIndex| BOOT::|xlPrematureFin|
+            BOOT::|xlPrematureEOF| BOOT::|xlCmdBug| BOOT::|xlIfBug|
+            BOOT::|xlSkippingFin| BOOT::|xlConsole| BOOT::|xlOK|
+            BOOT::|xlSkip| BOOT::|lookupInDomainVector|
+            BOOT::|basicLookupCheckDefaults| BOOT::|basicLookup|
+            BOOT::|oldCompLookup| BOOT::|analyzeUndeclaredMap|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T) T) BOOT::|compDefineLisplib|
+            BOOT::|compConLib1| BOOT::|addModemap| BOOT::|mmCost|
+            BOOT::|findFunctionInDomain1| BOOT::/WRITEUPDATE
+            BOOT::|mmCost0| BOOT::|/D,2,LIB|
+            BOOT::|processFunctorOrPackage| BOOT::|compOrCroak1,fn|
+            BOOT::/D-2 BOOT::|BesselIBackRecur| BOOT::|invokeFortran|
+            BOOT::|nagCall| BOOT::|makeFort| BOOT::|addModemapKnown|
+            BOOT::|addModemap1| BOOT::|addEltModemap| BOOT::|compHash|
+            BOOT::|compHashGlobal| BOOT::|compApply| BOOT::|kdPageInfo|
+            BOOT::|addModemap0| BOOT::|bracketagglist|
+            BOOT::|attributeLookupExport| BOOT::|upDollarTuple|
+            BOOT::|xlIfSyntax| BOOT::|incLine1|
+            BOOT::|oldAxiomCategoryLookupExport| BOOT::|genMapCode|
+            BOOT::|putMapCode|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T *) T) BOOT::|pfLeaf| BOOT::BPITRACE
+            VMLISP:|remove| VMLISP:RREAD VMLISP:REMOVEQ
+            BOOT::MATCH-LISP-TAG VMLISP:NREMOVE VMLISP:NREMOVEQ
+            BOOT::|tokConstruct| BOOT::|pfAdd|
+            BOOT:|ByteFileReadLineIntoString| BOOT:MATCH-TOKEN)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T *) T) BOOT::|ncHardError|
+            BOOT::TOKEN-INSTALL BOOT::|ncSoftError| BOOT::|lnCreate|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T) T) BOOT::|findFunctionInCategory|
+            BOOT::|Mp2MpAux1| BOOT::|Mp2MpAux0| BOOT::|Expr2Dmp1|
+            BOOT::|Mp2SimilarDmp| BOOT::|bigopAppAux|
+            BOOT::|findFunctionInDomain| BOOT::|abbreviationError|
+            BOOT::|lisplibError| BOOT::|invokeNagman|
+            BOOT::|mkNewModemapList| BOOT::|mkDiffAssoc|
+            BOOT::|dbGatherThenShow| BOOT::|appInfixArg|
+            BOOT::|lazyOldAxiomDomainLookupExport|
+            BOOT::|oldAxiomDomainLookupExport|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T T T) T)
+            BOOT::|displayDomainOp|)) 
+(PROCLAIM '(FTYPE (FUNCTION (T T T T *) T) VMLISP:RPLACSTR)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T T) T) BOOT::|P2DmpAux|
+            BOOT::|makeSpadFun|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T) T) BOOT::|compDefineCategory2|
+            BOOT::|P2MpAux| BOOT::|makeFort1|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T T T T T T T) T) BOOT::|writeCFile|
+            BOOT::|Mp2MpAux2|)) 
+(PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) BOOT::|msgCreate|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION NIL *) BOOT::|generateResultsName|
+            BOOT::|generateDataName| BOOT::|htShowPage|
+            BOOT::|PARSE-Label| BOOT::|bcMatrix| BOOT::|PARSE-Primary1|
+            BOOT::|PARSE-Enclosure| BOOT::|bcDraw2DSolve|
+            BOOT::|PARSE-Selector| BOOT::|PARSE-Category|
+            BOOT::|PARSE-Option| BOOT::|PARSE-TokenOption|
+            BOOT::|PARSE-Sexpr1| BOOT::|PARSE-Sexpr|
+            BOOT::|PARSE-Scripts| BOOT::|PARSE-SpecialCommand|
+            BOOT::|PARSE-FloatBasePart| BOOT::|PARSE-FloatBase|
+            BOOT::|PARSE-Leave| BOOT::|e02aef| BOOT::|e04ucfCopOut|
+            BOOT::|c02agf| BOOT::|c02aff| BOOT::|e02adf| BOOT::|c05pbf|
+            VMLISP:RECLAIM BOOT::MKPROMPT BOOT::|sendHTErrorSignal|
+            BOOT::|testPage| BOOT::|e01sef| BOOT::|e01saf|
+            BOOT::|e01daf| BOOT::|e01bhf| BOOT::|e01bgf| BOOT::|e01bff|
+            BOOT::|e01bef| BOOT::|e01baf| BOOT::|e02zaf| BOOT::|e02gaf|
+            BOOT::|e02dff| BOOT::|e02def| BOOT::|e02ddf| BOOT::|e02dcf|
+            BOOT::|e02daf| BOOT::|e02bef| BOOT::|e02bdf|
+            BOOT::|minusInfinity| BOOT::|plusInfinity|
+            BOOT::SERVER-SWITCH BOOT::CLEARDATABASE BOOT::NBOOT-LEXPR
+            BOOT::BOOT-LEXPR BOOT::|executeQuietCommand|
+            BOOT::|serverSwitch| BOOT::|scanS|
+            BOOT::|sendNagmanErrorSignal| BOOT::|d01gbf| BOOT::|d01gaf|
+            BOOT::|d01fcf| BOOT::|d01bbf| BOOT::|d01asf|
+            BOOT::|d02rafCopOut| BOOT::|d02raf| BOOT::|d02kef|
+            BOOT::|d02gbf| BOOT::|d02gaf| BOOT::|d02ejf| BOOT::|d02cjf|
+            BOOT::|d02bhf| BOOT::|d02bbf| BOOT::|e02ahf|
+            BOOT::|d03edfShort| BOOT::|d03edfLong| BOOT::|d03eefInput|
+            BOOT::|d03faf| BOOT::|d03eef| BOOT::|d03edf|
+            BOOT::|htSystemVariables| BOOT::|htSetVars|
+            BOOT::|mkSetTitle| BOOT::|npCategory|
+            BOOT::PARSE-CONS_SEXPR BOOT::PARSE-SEXPR
+            BOOT::PARSE-REF_SEXPR BOOT::PARSE-EXPR2 BOOT::PARSE-EXPR1
+            BOOT::|htsv| BOOT::|npDefinitionItem| BOOT::|npDefn|
+            BOOT::|npMacro| BOOT::|npMDEFinition| BOOT::|npRule|
+            BOOT::RESETHASHTABLES BOOT::READSPADEXPR
+            BOOT::|batchExecute| BOOT::|c05nbf| BOOT::|c05adf|
+            BOOT::|c06gsf| BOOT::|c06gqf| BOOT::|c06gcf| BOOT::|c06gbf|
+            BOOT::|c06fuf| BOOT::|c06frf| BOOT::|c06fqf| BOOT::|c06fpf|
+            BOOT::|c06ekf| BOOT::|c06ecf| BOOT::|c06ebf| BOOT::|c06eaf|
+            BOOT::|s17def| BOOT::|s17dcf| BOOT::|s17akf| BOOT::|s17ajf|
+            BOOT::|s17ahf| BOOT::|s17agf| BOOT::|s17aff| BOOT::|s17aef|
+            BOOT::|s17adf| BOOT::|s17acf| BOOT::|s15aef| BOOT::|s15adf|
+            BOOT::|s14baf| BOOT::|s14abf| BOOT::|s14aaf| BOOT::|s13adf|
+            BOOT::|s13acf| BOOT::|s13aaf| BOOT::|s01eaf| BOOT::|s21bdf|
+            BOOT::|s21bcf| BOOT::|s21bbf| BOOT::|s21baf| BOOT::|s20adf|
+            BOOT::|e02agf| BOOT::|s20acf| BOOT::|d01aqf| BOOT::|s19adf|
+            BOOT::|d01apf| BOOT::|s19acf| BOOT::|d01anf| BOOT::|d01amf|
+            BOOT::|d01alf| BOOT::|s19abf| BOOT::|d01akf| BOOT::|s19aaf|
+            BOOT::|d01ajf| BOOT::|s18def| BOOT::|s18dcf| BOOT::|s18aff|
+            BOOT::|s18aef| BOOT::|s18adf| BOOT::|s18acf| BOOT::|f04qaf|
+            BOOT::|f04mcf| BOOT::|f04mbf| BOOT::|f04maf| BOOT::|f04jgf|
+            BOOT::|f04faf| BOOT::|f04axf| BOOT::|f04atf| BOOT::|f04asf|
+            BOOT::|quit| BOOT::|f04arf| BOOT::|quitSpad2Cmd|
+            BOOT::|f04adf| BOOT::|pquit| BOOT::|pquitSpad2Cmd|
+            BOOT::CONTINUE BOOT::|continue| BOOT::|purgeLocalLibdb|
+            BOOT::|dbSplitLibdb| BOOT::|f07fef| BOOT::|f07fdf|
+            BOOT::|f07aef| BOOT::|f07adf| BOOT::|copyright|
+            BOOT::|s17dlf| BOOT::|s17dhf| BOOT::|s17dgf| BOOT::|f02xef|
+            BOOT::|f02wef| BOOT::|f02fjf| BOOT::|f02bjf| BOOT::|f02bbf|
+            BOOT::|f02axf| BOOT::|f02awf| BOOT::|f02akf| BOOT::|f02ajf|
+            BOOT::|f02agf| BOOT::|htShowPageNoScroll| BOOT::|f02aff|
+            BOOT::|f02aef| BOOT::|f02adf| BOOT::|f02abf| BOOT::|f02aaf|
+            BOOT::|measure| BOOT::|writeSaturnSuffix| BOOT::NEWRULE
+            BOOT::PARSE-LOCAL_VAR BOOT::|htErrorStar|
+            BOOT::|queryClients| BOOT::|onDisk| BOOT::|endHTPage|
+            BOOT::|readSpadProfileIfThere| BOOT::|bcDraw3Dpar1|
+            BOOT::|bcDraw3Dpar| BOOT::|htShowPageStarSaturn|
+            BOOT::|htShowPageStar| BOOT::|bcDraw3Dfun|
+            BOOT::|bcDraw2Dpar| BOOT::|bcSum| BOOT::|bcSeries|
+            BOOT::|bcProduct| BOOT::|bcLimit|
+            BOOT::|bcIndefiniteIntegrate| BOOT::|bcDraw|
+            BOOT::|bcDifferentiate| BOOT::|bcDefiniteIntegrate|
+            BOOT::|bcDraw2Dfun| BOOT::MAKE-TAGS-FILE BOOT::|bcSolve|
+            BOOT::|npPrimary1| BOOT::|e02bcf| BOOT::|e02bbf|
+            BOOT::|e02baf| BOOT::|e02akf| BOOT::|e02ajf| BOOT::|e04ycf|
+            BOOT::|e04ucf| BOOT::|e04naf| BOOT::|e04mbf| BOOT::|e04jaf|
+            BOOT::|e04gcf| BOOT::|e04fdf| BOOT::|e04dgf| BOOT::|f01ref|
+            BOOT::|f01rdf| BOOT::|f01rcf| BOOT::|f01qef| BOOT::|f01qdf|
+            BOOT::|f01qcf| BOOT::|f01mcf| BOOT::|f01maf| BOOT::|f01bsf|
+            BOOT::|f01brf|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION NIL T) BOOT::|getCodeVector|
+            BOOT:PARSE-IDENTIFIER BOOT::|axDoLiterals|
+            BOOT::|PARSE-Suffix| BOOT:CURRENT-TOKEN
+            BOOT::|PARSE-TokTail| BOOT::|PARSE-InfixWith|
+            BOOT::|PARSE-With| BOOT::|PARSE-Form|
+            BOOT::|PARSE-Reduction| BOOT::|PARSE-SemiColon|
+            BOOT::|PARSE-Iterator| BOOT::|PARSE-Primary|
+            BOOT::|PARSE-ElseClause| BOOT::|PARSE-Conditional|
+            BOOT::|PARSE-Name| BOOT::|PARSE-Sequence|
+            BOOT::|PARSE-Data| BOOT::|PARSE-FormalParameter|
+            BOOT::|PARSE-IntegerTok| BOOT::|PARSE-String|
+            BOOT::|PARSE-Quad| BOOT::|PARSE-VarForm|
+            BOOT::|PARSE-Qualification| BOOT::|PARSE-Prefix|
+            BOOT::|PARSE-Infix| BOOT::|PARSE-Application|
+            BOOT:CURRENT-SYMBOL BOOT::|clearCmdSortedCaches|
+            BOOT::|PARSE-Statement| BOOT::|PARSE-Command|
+            BOOT::|updateInCoreHist| BOOT::|processSynonyms|
+            BOOT::|disableHist| BOOT::|PARSE-IteratorTail|
+            BOOT::|histFileName| BOOT::|PARSE-OpenBrace|
+            BOOT::|PARSE-Sequence1| BOOT::|PARSE-OpenBracket|
+            BOOT::|PARSE-PrimaryNoFloat| BOOT:FAIL BOOT::|PARSE-Float|
+            BOOT::|PARSE-PrimaryOrQM| BOOT::|PARSE-TokenList|
+            BOOT::|PARSE-AnyId| BOOT::|resetInCoreHist|
+            BOOT::|PARSE-TokenCommandTail| BOOT::|isTokenDelimiter|
+            BOOT::|PARSE-ScriptItem| BOOT::|PARSE-CommandTail|
+            BOOT::|historySpad2Cmd| BOOT::|PARSE-FormalParameterTok|
+            BOOT::|PARSE-SpecialKeyWord|
+            BOOT::|writeHistModesAndValues| BOOT::|PARSE-FloatTok|
+            BOOT::|PARSE-FloatExponent| BOOT::|updateHist|
+            BOOT::|initHistList| BOOT::|initHist| BOOT::|PARSE-Exit|
+            BOOT::|oldHistFileName| BOOT:PARSE-NUMBER
+            BOOT::|PARSE-Return| BOOT::|PARSE-ReductionOp|
+            BOOT::|PARSE-LabelExpr| BOOT::|PARSE-Import|
+            BOOT::|writeHiFi| BOOT::|PARSE-Loop|
+            BOOT::|updateCurrentInterpreterFrame| BOOT::|PARSE-Seg|
+            BOOT:CURINPUTLINE BOOT::|profileWrite| BOOT:PARSE-BSTRING
+            BOOT:NEXT-TOKEN BOOT:IOSTAT BOOT::|isPackageFunction|
+            BOOT:UNGET-TOKENS BOOT::|setOptKeyBlanks|
+            BOOT::|getInfovecCode| BOOT::|NRTmakeSlot1Info|
+            BOOT::|reportOnFunctorCompilation| BOOT:BUMPCOMPERRORCOUNT
+            BOOT::|displayMissingFunctions| BOOT:PARSE-STRING
+            BOOT:ADVANCE-TOKEN BOOT::ERRHUH BOOT:CURRENT-CHAR
+            VMLISP:$TOTAL-ELAPSED-TIME BOOT::IS-GENSYM
+            BOOT::|getSpecialCaseAssoc|
+            BOOT::|makeConstructorsAutoLoad|
+            BOOT::|displayExposedGroups|
+            BOOT::|displayHiddenConstructors|
+            BOOT::|displaySemanticErrors| BOOT::|clock|
+            BOOT::|startTimer| BOOT::|spadPrompt| BOOT::|stopTimer|
+            BOOT::|quadSch| BOOT::/TRACEREPLY BOOT::TRACELETREPLY
+            BOOT::|voidValue| BOOT::/COMP BOOT::|getDateAndTime|
+            BOOT::|coercionFailure| VMLISP:EMBEDDED
+            BOOT::|printableArgModeSetList| BOOT::|asList|
+            BOOT::|boot2LispError| BOOT::|extendConstructorDataTable|
+            BOOT::|fin| BOOT::PARSERSTATE BOOT::|New,ENTRY,1|
+            BOOT::|mkLowerCaseConTable| BOOT::NEW-LEXPR-INTERACTIVE
+            BOOT::NEW-LEXPR BOOT::|spadThrow| BOOT::INITIALIZE
+            BOOT::NEW BOOT::|New,ENTRY| BOOT::|traceComp|
+            BOOT::|New,ENTRY1| BOOT::|New,ENTRY,SYS| BOOT::NEWPO
+            BOOT::|returnToReader| BOOT::|returnToTopLevel| BOOT::TOP
+            BOOT::|serverLoop| BOOT::|describeSetOutputTex|
+            BOOT::|describeSetOutputFortran|
+            BOOT::|describeSetLinkerArgs|
+            BOOT::|describeProtectSymbols|
+            BOOT::|describeOutputLibraryArgs|
+            BOOT::|describeSetFortDir| BOOT::|describeFortPersistence|
+            BOOT::|describeSetFortTmpDir|
+            BOOT::|describeProtectedSymbolsWarning|
+            BOOT::|describeSetStreamsCalculate|
+            BOOT::|describeSetOutputFormula|
+            BOOT::|describeInputLibraryArgs|
+            BOOT::|resetWorkspaceVariables| BOOT::|describeSetNagHost|
+            BOOT::|describeAsharpArgs| BOOT::|describeSetOutputAlgebra|
+            BOOT::|sayAllCacheCounts| BOOT::|describeSetFunctionsCache|
+            BOOT::|nangenericcomplex| BOOT::|createTypeEquivRules|
+            BOOT::|createResolveTTRules| BOOT::|createResolveTMRules|
+            BOOT::|bcBlankLine| BOOT::|browserAutoloadOnceTrigger|
+            BOOT::|scanKeyTableCons| BOOT::|scanToken| BOOT::|scanEsc|
+            BOOT::|scanError| BOOT::|scanEscape| BOOT::|scanNumber|
+            BOOT::|asharpConstructors| BOOT::|scanString|
+            BOOT::|scanSpace| BOOT::|scanPunct| BOOT::|scanNegComment|
+            BOOT::|startsNegComment?| BOOT::|scanComment|
+            BOOT::|startsComment?| BOOT::|scanPunCons|
+            BOOT::|scanDictCons| BOOT::|resetStackLimits|
+            BOOT::|npRecoverTrap| BOOT::|syGeneralErrorHere|
+            BOOT::|DPname| BOOT::|pfNoPosition| VMLISP:CURRENTTIME
+            BOOT::|buildHtMacroTable| BOOT::|checkWarningIndentation|
+            BOOT::|npDecl| BOOT::|npType| VMLISP:$SCREENSIZE
+            BOOT::|npAmpersand| BOOT::|npName| BOOT::|npFromdom|
+            BOOT::|npSCategory| BOOT::|npPrimary| BOOT::|npState|
+            BOOT::|npDefaultValue| BOOT::|npAssignVariableName|
+            BOOT::|npPDefinition| BOOT::|npDollar|
+            BOOT::|npSQualTypelist| BOOT::PARSE-NON_DEST_REF
+            BOOT::PARSE-OPT_EXPR BOOT::PARSE-REPEATOR
+            BOOT::|npCategoryL| BOOT::PARSE-SEXPR_STRING
+            BOOT::|npProduct| BOOT::PARSE-TEST BOOT::|npIterators|
+            BOOT::PARSE-EXPR BOOT::|npWhile|
+            BOOT::|displayPreCompilationErrors| BOOT::PARSE-N_TEST
+            BOOT::|npForIn| BOOT::PARSE-REP_TEST BOOT::|npGives|
+            BOOT::PARSE-FIL_TEST BOOT::|npLogical| BOOT::PARSE-SUBEXPR
+            BOOT::|npExpress| BOOT::PARSE-FID BOOT::PARSE-RULE
+            BOOT::|npExpress1| BOOT::PARSE-HEADER
+            BOOT::|npCommaBackSet| BOOT::PARSE-RULE1 BOOT::|npQualType|
+            VMLISP:$TOTAL-GC-TIME BOOT::|npADD|
+            BOOT::|npConditionalStatement|
+            BOOT::|npQualifiedDefinition| BOOT::|npPushId|
+            BOOT::|npVariable| BOOT::|npDefinitionOrStatement|
+            BOOT::|npAssignVariable| BOOT::|npColon|
+            BOOT::|npAssignment| BOOT::|profileDisplay|
+            BOOT:|TimeStampString| BOOT::|computeDomainVariableAlist|
+            BOOT::MONITOR-READINTERP BOOT::|npSingleRule|
+            BOOT::MONITOR-UNTESTED BOOT::|npDefTail| BOOT::|npQuiver|
+            BOOT::MONITOR-PERCENT BOOT::|npDef| BOOT::|npStatement|
+            BOOT::|npImport| BOOT::|npTyping| BOOT::|npItem|
+            BOOT::|npQualDef| BOOT::|npAssign| BOOT::MONITOR-AUTOLOAD
+            BOOT::|npDefinition| BOOT::MONITOR-RESULTS
+            BOOT::MONITOR-END BOOT::|npPop3| BOOT::MONITOR-INITTABLE
+            BOOT::|npAtom2| BOOT::|npInfixOperator| BOOT::|npPower|
+            BOOT::MONITOR-HELP BOOT::|npMatch| BOOT::MONITOR-REPORT
+            BOOT::|npMdef| BOOT::|reportInstantiations|
+            BOOT::|npPrimary2| BOOT::?DOMAINS BOOT::|?domains|
+            BOOT::|npSuch| BOOT::|npMDEF| BOOT::|npDisjand|
+            BOOT::|npInfixOp| BOOT::|npDiscrim|
+            BOOT::|clearConstructorAndLisplibCaches|
+            BOOT::|npVariableName| BOOT::|clearConstructorCaches|
+            BOOT::|clearClams| BOOT::|clearCategoryCaches|
+            BOOT::|cacheStats| BOOT::|reportAndClearClams|
+            BOOT::|traceDown| BOOT::|statRecordInstantiationEvent|
+            BOOT::|tc| BOOT::GET-CURRENT-DIRECTORY
+            BOOT::|removeAllClams| BOOT::|clamStats| BOOT::|npPop1|
+            BOOT::|npTrap| BOOT::|npApplication| BOOT::|npPop2|
+            BOOT::|npApplication2| BOOT::WRITE-WARMDATA
+            BOOT::WRITE-INTERPDB BOOT::|npAssignVariablelist|
+            BOOT::|clearHashReferenceCounts| BOOT::|npSignature|
+            BOOT::|pfNothing| BOOT::|npSigItemlist| BOOT::|npEncl|
+            BOOT::|npBDefinition| BOOT::|npPrefixColon| BOOT::|npNext|
+            BOOT::|allOperations| BOOT::WRITE-CATEGORYDB
+            BOOT::WRITE-OPERATIONDB BOOT::WRITE-BROWSEDB
+            BOOT::WRITE-COMPRESS BOOT::INITIAL-GETDATABASE
+            BOOT::CATEGORYOPEN BOOT::BROWSEOPEN BOOT::OPERATIONOPEN
+            BOOT::INTERPOPEN BOOT::COMPRESSOPEN
+            BOOT::CREATE-INITIALIZERS BOOT::|poNoPosition|
+            BOOT::|saveDependentsHashTable| BOOT::|saveUsersHashTable|
+            BOOT::|mkTopicHashTable| BOOT::TOKEN-STACK-SHOW
+            BOOT::|system| BOOT::|terminateSystemCommand|
+            BOOT::|getSystemCommandLine| BOOT::TERMCHR
+            BOOT::IOSTREAMS-SHOW BOOT::|displayExposedConstructors|
+            BOOT::|finalizeDocumentation| BOOT::REDUCE-STACK-SHOW
+            BOOT::CLEAR-HIGHLIGHT BOOT::RESET-HIGHLIGHT BOOT::RESTART0
+            START BOOT::|libraryFileLists| BOOT::|waitForViewport|
+            BOOT::|setViewportProcess|
+            BOOT::|installStandardTestPackages| BOOT::|printCopyright|
+            BOOT::AKCL-VERSION BOOT::SET-RESTART-HOOK
+            BOOT::|undoINITIALIZE| BOOT::|simpCategoryTable|
+            BOOT::|simpTempCategoryTable| BOOT::COMPFIN
+            BOOT::INPUT-CLEAR BOOT::|genTempCategoryTable| BOOT::|cc|
+            BOOT::|initNewWorld| BOOT::|genCategoryTable|
+            BOOT::|dbOpsExposureMessage| BOOT::|htSayUnexposed|
+            BOOT::|NRTmakeCategoryAlist|
+            BOOT::|NRTgenFinalAttributeAlist| BOOT::|dcSizeAll|
+            BOOT::|initialiseIntrinsicList| BOOT::|tempLen|
+            BOOT::|changeDirectoryInSlot1| BOOT::|NRTaddDeltaCode|
+            BOOT::|ncIntLoop| BOOT::SPECIALCASESYNTAX
+            BOOT::|newFortranTempVar| BOOT::|currentSP|
+            BOOT::|elapsedTime| BOOT::|traceUp|
+            BOOT::|getIntrinsicList| BOOT::|getInterpMacroNames|
+            BOOT::|synonymSpad2Cmd| BOOT::|interpFunctionDepAlists|
+            BOOT::NPPPG BOOT::|isFalse| BOOT::NPPPF BOOT::NPPPFF
+            BOOT::|printDashedLine| BOOT::|satBreak| BOOT::|up|
+            BOOT::|getWorkspaceNames| BOOT::|getParserMacroNames|
+            BOOT::|oldCompilerAutoloadOnceTrigger| BOOT::|TrimCF|
+            BOOT::|displayWorkspaceNames| BOOT::UP
+            BOOT::|displayWarnings| BOOT::|buildGloss|
+            BOOT::|nextInterpreterFrame| BOOT::|down|
+            BOOT::|displayFrameNames| BOOT::DOWN
+            BOOT::|previousInterpreterFrame| BOOT::SAME BOOT::|same|
+            BOOT::|mkUsersHashTable| BOOT::|allConstructors|
+            BOOT::|frameNames| BOOT::|sayShowWarning| BOOT::|credits|
+            BOOT::|mkDependentsHashTable|
+            BOOT::|buildDefaultPackageNamesHT|
+            BOOT::|dbAugmentConstructorDataTable| FOAM:|fiGetDebugVar|
+            BOOT::|menuButton| BOOT::|htSaturnBreak| BOOT::|random|
+            BOOT::|dbConsExposureMessage| BOOT::|mkSigPredVectors|
+            BOOT::FIRST-ERROR BOOT::|writeSaturnPrefix| BOOT::|on|
+            BOOT::|offDisk| BOOT::|htBigSkip| BOOT::PARSE-PROGRAM
+            BOOT::IN-META BOOT::|traceReply| BOOT::|?t|
+            BOOT::SKIP-BLANKS BOOT::|pspacers| BOOT::NEXT-LINES-SHOW
+            BOOT::|resetCounters| BOOT::PARSE-DEST_REF
+            BOOT::SPAD_SHORT_ERROR BOOT::|pcounters|
+            BOOT::SPAD_LONG_ERROR BOOT::INIT-BOOT/SPAD-READER
+            BOOT::NEXT-LINES-CLEAR BOOT::|resetTimers|
+            BOOT::|resetSpacers| BOOT::|ptimers|
+            BOOT::|PARSE-Expression|
+            BOOT::|oldParserAutoloadOnceTrigger| BOOT::|boot-LEXPR|
+            BOOT::|reportCount| BOOT::NEW-LEXPR1 BOOT::|spadReply|
+            BOOT::|listConstructorAbbreviations| BOOT::BOOT-SKIP-BLANKS
+            BOOT::|updateFromCurrentInterpreterFrame|
+            BOOT::PARSE-ARGUMENT-DESIGNATOR BOOT::PARSE-KEYWORD
+            BOOT::PARSE-SPADSTRING
+            BOOT::|initializeInterpreterFrameRing| BOOT::READ-SPAD-1
+            BOOT::READBOOT BOOT::|reportWhatOptions|
+            BOOT::TERSYSCOMMAND BOOT::|PARSE-NewExpr|
+            BOOT::|makeInitialModemapFrame|
+            BOOT::|createCurrentInterpreterFrame|
+            BOOT::|getParserMacros| BOOT::|clearCmdCompletely|
+            BOOT::|clearCmdAll| BOOT::|clearMacroTable|
+            BOOT::|initializeSystemCommands| BOOT::|htSayHrule|
+            BOOT::|htEndTable| BOOT::|mkMenuButton| BOOT::|runspad|
+            BOOT::|htBeginTable| BOOT::|ncTopLevel|
+            BOOT::|spadStartUpMsgs| BOOT::|initializeRuleSets|
+            BOOT::|loadExposureGroupData|
+            BOOT::|statisticsInitialization| BOOT::|ut|
+            BOOT::|printStatisticsSummary| BOOT::|printStorage|
+            BOOT::|prTraceNames| BOOT::|spad| BOOT::|spadpo|
+            BOOT::|intloop| BOOT::|off| BOOT::|htEndTabular|
+            BOOT::|htSaySaturnAmpersand| BOOT::|page|
+            BOOT::|clearFrame| BOOT::|getSaturnExampleList|
+            BOOT::|saturnTERPRI| BOOT::|bcSadFaces| BOOT::YEARWEEK
+            BOOT::|npBPileDefinition| BOOT::|npTypified|
+            BOOT::|npVariablelist| BOOT::|npTagged| BOOT::|bcvspace|
+            BOOT::|npTypeStyle| BOOT::|npColonQuery| BOOT::|npPretend|
+            BOOT::|npRestrict| BOOT::|npCoerceTo| BOOT::|npRelation|
+            BOOT::|npFirstTok| BOOT::|npVoid| BOOT::|npSLocalItem|
+            BOOT::NPPCG BOOT::|npLocalItemlist| BOOT::|npFix|
+            BOOT::NPPCFF BOOT::|npDefaultItemlist| BOOT::|npSynthetic|
+            BOOT::|npAmpersandFrom| BOOT::|npBy| BOOT::|npLet|
+            BOOT::|npTypeVariable| BOOT::|npSignatureDefinee|
+            BOOT::|npAtom1| BOOT::|npConstTok| BOOT::|npLocalItem|
+            BOOT::|npLocalDecl| BOOT::|npExport| BOOT::|npLocal|
+            BOOT::|npInline| BOOT::|npFree| BOOT::|npInterval|
+            BOOT::|npSegment| BOOT::|npArith| BOOT::|npBreak|
+            BOOT::|npDefaultItem| BOOT::|npDefaultDecl|
+            BOOT::|npReturn| BOOT::|npSemiBackSet|
+            BOOT::|npSDefaultItem| BOOT::|npTypeVariablelist|
+            BOOT::|npPileDefinitionlist| BOOT::|npDefinitionlist|
+            BOOT::|npComma| BOOT::|npSymbolVariable| BOOT::|npId|
+            BOOT::|npSum| BOOT::|npTerm| BOOT::|npRemainder|
+            BOOT::|npIterate| BOOT::|npLoop| BOOT::|npSuchThat|
+            BOOT::|npSelector| BOOT::|npIterator| BOOT::|npSigItem|
+            BOOT::|npSigDecl| BOOT::|statRecordLoadEvent|
+            BOOT::|computeElapsedTime| BOOT::|npLambda|
+            BOOT::|computeElapsedSpace| BOOT::|popTimedName|
+            BOOT::|npBacksetElse| BOOT::|peekTimedName|
+            BOOT::|npQualTypelist| BOOT::|npPileExit| BOOT::|npExit|
+            BOOT::|statisticsSummary| BOOT::|displayHeapStatsIfWanted|
+            BOOT::|update| BOOT:RESTART BOOT:|version| BOOT:/EMBEDREPLY
+            BOOT:NEXTINPUTLINE BOOT:|Category| BOOT::|intUnsetQuiet|
+            BOOT::|intSetQuiet| BOOT:POP-REDUCTION
+            BOOT::|intSetNeedToSignalSessionManager|
+            BOOT::|intNewFloat| BOOT::|leaveScratchpad| BOOT::|ncError|
+            BOOT::|incConsoleInput| BOOT:NEXT-CHAR
+            BOOT::|inclmsgCmdBug| BOOT::|inclmsgIfBug|
+            BOOT::|inclmsgFinSkipped| BOOT::|inclmsgConsole|
+            COMPILER::GAZONK-NAME HELP BOOT:ADVANCE-CHAR
+            BOOT::|rbrkSch| BOOT::|lbrkSch|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (*) *) BOOT::|makeSpadCommand| BOOT::/RF
+            BOOT::|/RQ,LIB| VMLISP:$ERASE BOOT::|mkGrepPattern1|
+            BOOT::|nothingFoundPage| BOOT::|dbNotAvailablePage|
+            BOOT::|htSetCache| BOOT::NEXT-LINE BOOT::/EF
+            BOOT::INIT-MEMORY-CONFIG BOOT::/RQ BOOT::|newGoGet|
+            BOOT::|goGet| BOOT::|dbShowOps| BOOT::|oPage| BOOT::|aPage|
+            BOOT::|buildLibdb| BOOT::|emptySearchPage|
+            BOOT::|conOpPage1| BOOT::|conPage| BOOT::|kPage|
+            BOOT::|genSearch| BOOT::|dbShowCons| BOOT::|form2HtString|
+            BOOT::|bcFinish| BOOT::|Undef| BOOT:META-SYNTAX-ERROR)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) *) BOOT::|numArgs|
+            BOOT::|formatSignatureArgs0| BOOT::|formatSignatureArgs|
+            BOOT::|sayWidth| BOOT::SRCABBREVS BOOT::|bcMatrixGen|
+            BOOT::|bcwords2liststring| BOOT::|bcGenExplicitMatrix|
+            BOOT::|bcGen| BOOT::|bcInputMatrixByFormulaGen|
+            BOOT::|bcReadMatrix| BOOT::|systemCommand|
+            BOOT::|safeWritify| BOOT::|unAbbreviateKeyword|
+            BOOT::|replacePercentByDollar| BOOT::|e04ucfSolve|
+            BOOT::|brightPrint0AsTeX| BOOT::|sayDisplayStringWidth|
+            BOOT:GET-TOKEN BOOT::|initializeLisplib| BOOT::|getMsgTag|
+            BOOT::|poFileName| BOOT::|mac0InfiniteExpansion,name|
+            BOOT::|NRTtypeHack| BOOT::|getMsgPos2| BOOT::|e02agfSolve|
+            BOOT::|c02agfGen| BOOT:NUMOFARGS BOOT::|c02affSolve|
+            BOOT::|c02affGen| BOOT::|c02agfSolve| BOOT::|c05adfGen|
+            BOOT::|outputTran| BOOT::|replaceSharpCalls|
+            BOOT::/UNTRACE-0 BOOT::|doReplaceSharpCalls| BOOT::DEFTRAN
+            BOOT::LIST2STRING BOOT::DEF-WHERECLAUSELIST BOOT::DEF-ISNT
+            BOOT::|quoteSuper| BOOT::|quoteSub| BOOT::MK_LEFORM
+            BOOT::MK_LEFORM-CONS BOOT::|aggSuper|
+            BOOT::|oldParseString| BOOT::|outformWidth| BOOT::|aggSub|
+            BOOT::|agggwidth| BOOT::|agggsuper| BOOT::|agggsub|
+            BOOT::|obj2String| BOOT::|compileFileQuietly|
+            BOOT::|exptSub| BOOT::|mathPrint| BOOT::|rootSub|
+            BOOT::|parseTransform| BOOT::|overbarWidth|
+            BOOT::MONITOR-EVALAFTER BOOT::|overlabelWidth|
+            BOOT::|object2String| BOOT::|e02aefGen| BOOT::/TRACE-0
+            BOOT::LENGTH2STR BOOT::|matSub| BOOT::/MKINFILENAM
+            BOOT::|qTSuper| BOOT::|qTSub| BOOT::|sayMSGNT|
+            VMLISP:BPINAME BOOT::|e01safSolve| BOOT::|e01befSolve|
+            BOOT::|linkToHTPage| BOOT::|killHTPage|
+            BOOT::|startReplaceHTPage| BOOT::|e01dafSolve|
+            BOOT::|startHTPopUpPage| BOOT::|e01bffSolve|
+            BOOT::|e01bafGen| BOOT::|e01sefGen| BOOT::|e01bhfGen|
+            BOOT::|e01bhfSolve| BOOT::|e01dafGen| BOOT::|e01bgfGen|
+            BOOT::|e01befGen| BOOT::|e02dcfColdGen| BOOT::|e02bafGen|
+            BOOT::|e02agfGen| BOOT::|e02befColdGen| BOOT::|e02ajfSolve|
+            BOOT::|e02ddfColdGen| BOOT::|numMapArgs|
+            BOOT::|e02befSolve| BOOT::|e02dcfSolve|
+            BOOT::|e02ddfWarmGen| BOOT::|e02adfSolve|
+            BOOT::|e02aefSolve| BOOT::|e02ddfSolve| BOOT::|e02bafSolve|
+            BOOT::|e02bcfSolve| BOOT::|e02ahfGen| BOOT::|e02gafSolve|
+            BOOT::|e02bbfGen| BOOT::|e02adfGen| BOOT::|e02defGen|
+            BOOT::|e02ahfSolve| BOOT::|e02bdfGen| BOOT::|e02akfGen|
+            BOOT::|e02dafGen| BOOT::|e02bdfSolve| BOOT::|e02dffGen|
+            BOOT::|e02akfSolve| BOOT::|asyJoinPart| BOOT::|printLine|
+            BOOT::|sockSendWakeup| BOOT::|sockGetFloat|
+            BOOT::PRINT-LINE BOOT::SOCK-SEND-WAKEUP
+            BOOT::SOCK-GET-FLOAT BOOT::|/tb| BOOT::|/ry| BOOT::|/rx|
+            BOOT::|/cxd| BOOT::/FOOBAR BOOT::/CX BOOT::NEWNAMTRANS
+            BOOT::|htMakeInputList| BOOT::SPAD-MODETRAN
+            BOOT::|popSatOutput| BOOT::|subrname| BOOT::SOCK-GET-INT
+            BOOT::OPEN-SERVER BOOT::|protectedEVAL|
+            BOOT::|setOutputTex| BOOT::|setOutputFortran| BOOT::|set|
+            BOOT::|setLinkerArgs| BOOT::|protectSymbols|
+            BOOT::|protectedSymbolsWarning| BOOT::|setStreamsCalculate|
+            BOOT::|setOutputFormula| BOOT::|setNagHost|
+            BOOT::|setFunctionsCache| BOOT::|spadType| BOOT::|spadSys|
+            BOOT::|mkGrepFile| BOOT::|mkGrepPattern1,addOptions|
+            BOOT::|mkGrepPattern1,remUnderscores|
+            BOOT::|mkUpDownPattern| BOOT::|mkUpDownPattern,fixchar|
+            BOOT::|cSearch| BOOT::|verbatimize|
+            BOOT::|pmParseFromString,flatten|
+            BOOT::|htCommandToInputLine| BOOT::|detailedSearch|
+            BOOT::|docSearch| BOOT::|form2HtString,fnTailTail|
+            BOOT::|form2HtString,fn| BOOT::|sexpr2HtString|
+            BOOT::|kInvalidTypePage| BOOT::|args2LispString,fnTailTail|
+            BOOT::|sexpr2LispString,fn| BOOT::|args2LispString|
+            BOOT::|sexpr2LispString| BOOT::|sexpr2HtString,fn|
+            BOOT::|spleI| BOOT::|dbComments| BOOT::|sockGetInt|
+            BOOT::|parseAndEvalStr| BOOT::|parseAndEvalStr1|
+            BOOT::|d01gafSolve| BOOT::|d01apfGen| BOOT::|d01fcfSolve|
+            BOOT::|d01asfGen| BOOT::|d02bbfSolve| BOOT::|d02rafGen|
+            BOOT::|d02kefGen| BOOT::|d02kefSolve| BOOT::|d02ejfGen|
+            BOOT::|d02gbfSolve| BOOT::|d02bbfGen| BOOT::|d02bhfGen|
+            BOOT::|d02rafSolve| BOOT::|d02ejfSolve| BOOT::|d02bhfSolve|
+            BOOT::|d02gafGen| BOOT::|d02gbfGen| BOOT::|d02gafSolve|
+            BOOT::|d02cjfGen| BOOT::|d02cjfSolve| BOOT::|d03edfControl|
+            BOOT::|d03edfSolve| BOOT::|d03eefSolve|
+            BOOT::|d03edfLongGen| BOOT::|d03eefGen|
+            BOOT::|d03edfShortGen| BOOT::|e01sefSolve|
+            BOOT::|lnFileName| BOOT::|e01bgfSolve| BOOT::|e01safGen|
+            BOOT::|e01bffGen| BOOT::|e01bafSolve|
+            BOOT::|pfGlobalLinePosn| BOOT::|quoteString|
+            BOOT::|postTran| BOOT::|decodeScripts| BOOT::|htGloss|
+            BOOT::|htTutorialSearch| BOOT::|postInSeq|
+            BOOT::|htTextSearch| BOOT::|htGreekSearch|
+            BOOT::|postMakeCons| BOOT::|postCategory,fn|
+            BOOT::|htShowFunctionPageContinued| BOOT::|htCacheSet|
+            BOOT::|htSetFunCommand| BOOT::|listOfStrings2String|
+            BOOT::|htCacheOne| BOOT::|htShowSetTree|
+            BOOT::|htShowSetTreeValue| BOOT::|postBigFloat|
+            BOOT::|htSetInteger| BOOT::|chkRange| BOOT::|postConstruct|
+            BOOT::|postSlash| BOOT::|htCacheAddChoice|
+            BOOT::|startHTPage| BOOT::|htSetLinkerArgs|
+            BOOT::|htSetOutputCharacters| BOOT::|htSetKernelWarn|
+            BOOT::|htSetKernelProtect| BOOT::|htSetExpose|
+            BOOT::|htSetInputLibrary| BOOT::|htSetOutputLibrary|
+            BOOT::|htSetHistory| SPAD-SAVE BOOT:|OsEnvGet|
+            BOOT:|LispCompile| BOOT:|LispCompileFile|
+            BOOT::|condErrorMsg| BOOT:|LispLoadFile|
+            BOOT:|LispLoadFileQuietly| BOOT::MONITOR-RESTORE
+            BOOT::|brightPrintCenterAsTeX| BOOT::|brightPrint0|
+            BOOT::|sayWidth,fn| BOOT::|brightPrintCenter|
+            BOOT::|clearClam| BOOT::|brightPrintHighlightAsTeX|
+            BOOT::|brightPrintHighlight| BOOT::|sayDisplayWidth,fn|
+            BOOT::|sayDisplayWidth| BOOT::INIT-LIB-FILE-GETTER
+            BOOT::INIT-FILE-GETTER BOOT::|entryWidth| BOOT::FILE-RUNNER
+            BOOT::|editFile| BOOT::|readForDoc| BOOT::|checkNumOfArgs|
+            BOOT::|openServer| BOOT::|removeBackslashes|
+            BOOT::|checkAddBackSlashes| BOOT::/RF-1 BOOT::|docreport|
+            BOOT::|ExecuteInterpSystemCommand| BOOT::|pfFileName|
+            BOOT::|InterpExecuteSpadSystemCommand| BOOT::|alistSize|
+            BOOT::|parseTranList| BOOT::|parseOr| BOOT::|parseIf|
+            BOOT::|parseImplies| BOOT::|parseEquivalence|
+            BOOT::|parseLhs| BOOT::|parseAnd| BOOT::|parseLeftArrow|
+            BOOT::|parseUpArrow| BOOT::|parseNotEqual| BOOT::|parseNot|
+            BOOT::|parseDollarNotEqual| BOOT::|parseDollarGreaterEqual|
+            BOOT::|parseDollarLessEqual| BOOT::|parseGreaterEqual|
+            BOOT::|parseLessEqual| BOOT::|scriptTranRow1|
+            BOOT::|scriptTran| BOOT::|scriptTranRow|
+            BOOT::|parseExclusiveOr| BOOT::QUOTE-IF-STRING
+            BOOT::|dbConformGenUnder| BOOT::|listOfEntries|
+            BOOT::|conformString| BOOT::|dbConformGen|
+            BOOT::|evalableConstructor2HtString| BOOT::|halfWordSize|
+            BOOT::|fortFormatCharacterTypes,mkCharName|
+            BOOT::|opPageFast|
+            BOOT::|fortFormatCharacterTypes,par2string| VMLISP::MAKEDIR
+            VMLISP::DELETE-DIRECTORY VMLISP::GET-IO-INDEX-STREAM
+            VMLISP::GET-INPUT-INDEX-STREAM VMLISP::DIRECTORY?
+            BOOT::|c05pbfGen| BOOT::|c05nbfGen| BOOT::|c05pbfSolve|
+            BOOT::|c05nbfSolve| BOOT::|e02dafSolve| BOOT::|c06ebfGen|
+            BOOT::|c06ebfSolve| BOOT::|c06gsfGen| BOOT::|c06gsfSolve|
+            BOOT::|c06ekfSolve| BOOT::|c06eafSolve| BOOT::|c06gqfGen|
+            BOOT::|c06ecfGen| BOOT::|c06fpfGen| BOOT::|c06frfSolve|
+            BOOT::|c06gbfSolve| BOOT::|c06fqfGen| BOOT::|c06gqfSolve|
+            BOOT::|c06eafGen| BOOT::|c06gcfGen| BOOT::|c06gcfSolve|
+            BOOT::|c06gbfGen| BOOT::|c06fufGen| BOOT::|s01eafGen|
+            BOOT::|s21bafGen| BOOT::|c06fpfSolve| BOOT::|s17dcfGen|
+            BOOT::|c06fqfSolve| BOOT::|s18defGen| BOOT::|c06frfGen|
+            BOOT::|s14bafGen| BOOT::|s18dcfGen| BOOT::|s17dhfGen|
+            BOOT::|c06ecfSolve| BOOT::|s21bdfGen| BOOT::|c06fufSolve|
+            BOOT::|c06ekfGen| BOOT::|s21bcfGen| BOOT::|sGen|
+            BOOT::|s17dgfGen| BOOT::|d01anfGen| BOOT::|d01ajfGen|
+            BOOT::|d01aqfGen| BOOT::|d01gafGen| BOOT::|d01bbfGen|
+            BOOT::|s21bbfGen| BOOT::|d01amfGen| BOOT::|s17dlfGen|
+            BOOT::|d01alfGen| BOOT::|d01fcfGen| BOOT::|d01akfGen|
+            BOOT::|d01gbfGen| BOOT::|d01gbfSolve| VMLISP::|npPC|
+            VMLISP::|npPP| BOOT::|exp2FortOptimizeArray|
+            BOOT::|fortError1| BOOT::|fortPre1| BOOT::|spadcall1|
+            BOOT::|fortPreRoot| BOOT::|checkPrecision|
+            BOOT::|fix2FortranFloat| BOOT::|normalizeStatAndStringify|
+            BOOT::|mkParameterList,par2string| BOOT::|f02wefSolve|
+            BOOT::|f02ajfGen| BOOT::|printAny| BOOT::|f02adfGen|
+            BOOT::|e02dffSolve| BOOT::|printString| BOOT::|f04jgfGen|
+            BOOT::|f04qafGen| BOOT::|f04asfGen| BOOT::|summary|
+            BOOT::|show| BOOT::|showSpad2Cmd| BOOT::|f04qafSolve|
+            BOOT::|f04mbfGen| BOOT::|f04fafGen| BOOT::|f04arfGen|
+            BOOT::|f04adfSolve| BOOT::|fixObjectForPrinting|
+            BOOT::|savesystem| BOOT::|escapeSpecialChars|
+            BOOT::|f04mcfSolve| BOOT::|encodeItem| BOOT::|f04atfGen|
+            BOOT::|form2LispString| BOOT::|f04adfGen|
+            BOOT::|concatWithBlanks| BOOT::|withAsharpCmd|
+            BOOT::|f04jgfSolve| BOOT::|extendLocalLibdb|
+            BOOT::|deleteFile| BOOT::|compileAsharpCmd1|
+            BOOT::|f04mcfGen| BOOT::|f04arfSolve| BOOT::|frame|
+            BOOT::|frameSpad2Cmd| BOOT::|addNewInterpreterFrame|
+            BOOT::|getEnv| BOOT::|f04asfSolve| BOOT::|f04fafSolve|
+            BOOT::|f04mbfSolve| BOOT::|f04atfSolve| BOOT::|f07fdfSolve|
+            BOOT::|obey| BOOT::|f07aefGen| BOOT::|buildLibdbString|
+            BOOT::|f07aefSolve| BOOT::|f07fefGen| BOOT::|f07adfSolve|
+            BOOT::|f07adfGen| BOOT::|dbReadComments|
+            BOOT::|f07fefSolve| BOOT::|f07fdfGen| BOOT::|s17defGen|
+            BOOT::|f01qdfSolve| BOOT::|f01rcfSolve| BOOT::|f01mafGen|
+            BOOT::|f01rdfGen| BOOT::|f01mafSolve| BOOT::|f01brfGen|
+            BOOT::|f01mcfGen| BOOT::|f02axfGen| BOOT::|f02aefSolve|
+            BOOT::|f02akfGen| BOOT::|f02abfSolve| BOOT::|f02bjfGen|
+            BOOT::|bcErrorPage| BOOT::|f02xefGen| BOOT::|form2String|
+            BOOT::|f02aafSolve| BOOT::|dbSourceFile|
+            BOOT::MAKE-REASONABLE BOOT::|f02ajfSolve|
+            BOOT::|f02axfSolve| BOOT::|f02affSolve| BOOT::|downlink|
+            BOOT::BRIGHTPRINT-0 BOOT::|f02wefGen|
+            BOOT::|conform2String| BOOT::|f02akfSolve|
+            BOOT::|f02adfSolve| BOOT::|f02aafGen|
+            BOOT::|dbSpecialExports| BOOT::|f02agfGen|
+            BOOT::|f02bjfSolve| BOOT::|buildLibdbConEntry|
+            BOOT::|f02agfSolve| BOOT::|dbSpecialDescription|
+            BOOT::|f02xefSolve| BOOT::|f02abfGen| BOOT::|f02bbfGen|
+            BOOT::|mkButtonBox| BOOT::|f02awfSolve|
+            BOOT::|assignSlotToPred| BOOT::|f02bbfSolve|
+            BOOT::|f02aefGen| BOOT::|f02awfGen| BOOT::|f02affGen|
+            BOOT::|dbMkEvalable| BOOT::|mkEvalable|
+            BOOT::|conPageChoose| BOOT::KILL-TRAILING-BLANKS
+            BOOT::|ySearch| BOOT::|aSearch| BOOT::|close|
+            BOOT::|kSearch| BOOT::|compileBoot| BOOT::|aokSearch|
+            BOOT::|showNamedConstruct|
+            BOOT::|reportOpsFromUnitDirectly1| BOOT::|oSearch|
+            BOOT::|tabsToBlanks| BOOT::|underscoreDollars|
+            BOOT::|mkGrepTextfile| BOOT::|reportOpsFromUnitDirectly0|
+            BOOT::|replaceGrepStar| BOOT::|grepSource| BOOT::|xSearch|
+            BOOT::|pSearch| BOOT::|dSearch| BOOT::|doSystemCommand|
+            BOOT::|standardizeSignature| BOOT::|conPageFastPath|
+            BOOT::|conPageConEntry| BOOT::|quickForm2HtString|
+            BOOT::|dbAttr| BOOT::|e02ajfGen| BOOT::|pluralize|
+            BOOT::|parseTran| BOOT::|e02defSolve|
+            BOOT::|dbSpecialOperations| BOOT::|issueHTStandard|
+            BOOT::|justifyMyType| BOOT::|getCallBackFn|
+            BOOT::|bcDifferentiateGen| BOOT::|bcIndefiniteIntegrateGen|
+            BOOT::|htMakeErrorPage| BOOT::|issueHT|
+            BOOT::|setOutputAlgebra| BOOT::|bcDraw2DparGen|
+            BOOT::|ExecuteSpadSystemCommand| BOOT::|bcDraw3Dpar1Gen|
+            BOOT::|bcProductGen| BOOT::|ts| BOOT::|bcRealLimitGen|
+            BOOT::|e02zafGen| BOOT::|bcSumGen| BOOT::|bcDraw3DparGen|
+            BOOT::|bcDraw3DfunGen| BOOT::|aggwidth| BOOT::WIDTH
+            BOOT::|bcDefiniteIntegrateGen| BOOT::|bcSeriesGen|
+            BOOT::|subspan| BOOT::|bcPuiseuxSeriesGen|
+            BOOT::|bcLaurentSeriesGen| BOOT::|superspan|
+            BOOT::|bcSeriesByFormulaGen| BOOT::|bcNotReady|
+            BOOT::|bcDraw2DfunGen| BOOT::|bcTaylorSeriesGen|
+            BOOT::|bcDraw2DSolveGen| BOOT::KCL-OS-ENV-GET
+            BOOT::|bcComplexLimitGen| BOOT::|saturnPRINTEXP|
+            BOOT::|bcSeriesExpansionGen| BOOT::COMPILE-BOOT-FILE
+            BOOT::|bcCreateVariableString| BOOT::|bcGenEquations|
+            BOOT::|vConcatSuper| BOOT::BOOT-LOAD
+            BOOT::|bcSolveNumerically1| BOOT::|bcLinearSolveEqnsGen|
+            BOOT::|bcMakeUnknowns| BOOT::|bcInputSolveInfo|
+            BOOT::|bcInputEquationsEnd| BOOT::|bcSystemSolveEqns1|
+            BOOT::|bcLinearSolveEqns1| BOOT::|bcVectorGen|
+            BOOT::|printBasic| BOOT::|subSuper| BOOT::|tr|
+            BOOT::|bcLinearSolveMatrix1| BOOT::|stringList2String|
+            BOOT::|bcString2HyString2| BOOT::|bcwords2liststring,fn|
+            BOOT::|linkGen| BOOT::|optCallEval| BOOT::|tokType|
+            BOOT::|timedEvaluate| BOOT::|roundStat|
+            BOOT::|bracketString| BOOT::|e02bcfGen| BOOT::|e02gafGen|
+            BOOT::|e02bbfSolve| VMLISP:OBEY BOOT::|e04ycfSolve|
+            BOOT::|e04nafSolve| BOOT::|e04dgfSolve| BOOT::|e04fdfGen|
+            BOOT::|e04gcfGen| BOOT::|NRTevalDomain| BOOT::|e04fdfSolve|
+            BOOT::|e04mbfSolve| BOOT::|e04nafGen| BOOT::|e04gcfSolve|
+            BOOT::|e04ucfGen| BOOT::|e04jafGen| BOOT::|e04mbfGen|
+            BOOT::|e04jafSolve| BOOT::|e04dgfGen| BOOT::|e04ycfGen|
+            BOOT::|f01rdfSolve| BOOT::|f01mcfSolve| BOOT::|f01qdfGen|
+            BOOT::|f01qcfGen| BOOT::|f01qefGen| BOOT::|f01rcfGen|
+            BOOT::|f01refSolve| BOOT::|f01qefSolve| BOOT::|e02zafSolve|
+            BOOT::|f01qcfSolve| BOOT::|f01refGen| BOOT::|f01brfSolve|
+            BOOT::|poGlobalLinePosn| BOOT:|sayString|
+            BOOT::|incHandleMessage| BOOT::|pred2English|
+            BOOT::|prefix2String0| BOOT::|form2StringLocal|
+            BOOT::|formatOpType| BOOT::|form2String1| BOOT::|ncTag|
+            BOOT::|ncAlist| BOOT::|tuple2String,f|
+            BOOT::|formatAttributeArg| BOOT::|formString|
+            BOOT::|form2StringWithPrens| BOOT::|prefix2String|
+            BOOT::|form2StringAsTeX| BOOT::|prefix2StringAsTeX|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (*) T) BOOT::|bcConform| BOOT:STREAM-EOF
+            BOOT::|categoryParts| BOOT:IOCLEAR BOOT:SAY BOOT:MOAN
+            BOOT::|centerNoHighlight| BOOT:CROAK BOOT::INTERRUPT
+            BOOT::LISP-BREAK-FROM-AXIOM BOOT:META VMLISP:NILFN
+            BOOT::MAKE-DATABASE BOOT::|defaultTargetFE| BOOT::/DUPDATE
+            BOOT::/UPDATE BOOT::/MONITOR VMLISP:$FILEP VMLISP:CALLBELOW
+            BOOT::|systemError| BOOT::|listSort|
+            BOOT::|asCategoryParts| BOOT::RDEFOUTSTREAM
+            BOOT::RDEFINSTREAM VMLISP::SETQERROR BOOT::|throwMessage|
+            BOOT::TOPLEVEL BOOT::|getDomainSigs|
+            BOOT::|getInheritanceByDoc| BOOT::|showImp|
+            BOOT::|showFrom| BOOT::|getDomainDocs| BOOT::|grepFile|
+            BOOT::|printRecordFile| BOOT::|wasIs|
+            BOOT::|htFile2RecordFile| BOOT::|inputFile2RecordFile|
+            BOOT::|htFile2InputFile| BOOT::|bcComments|
+            BOOT::|bcNameTable| BOOT::|dbSayItemsItalics|
+            BOOT::|htPred2English| BOOT::|interpret|
+            BOOT::|Enumeration,LAM| VMLISP:VMREAD VMLISP:RKEYIDS
+            BOOT::/RP BOOT::MONITOR-TESTED BOOT::MONITOR-RESET
+            BOOT::MONITOR-DISABLE BOOT::MONITOR-ENABLE
+            BOOT::|returnStLFromKey| BOOT::MAKE-MONITOR-DATA
+            BOOT::|level| BOOT::LEVEL BOOT::|resolveTT|
+            BOOT::|isLegitimateMode| BOOT::|hasFileProperty|
+            BOOT::|coerceConvertMmSelection| BOOT::|canCoerce|
+            BOOT::|selectMms1| BOOT::|canCoerceFrom| BOOT::MAKE-TOKEN
+            BOOT::MAKE-LINE BOOT::|centerAndHighlight| BOOT::|getOpDoc|
+            BOOT::MAKE-STACK BOOT::|firstNonBlankPosition|
+            BOOT::MAKE-XDR-STREAM BOOT::INITROOT
+            BOOT::|EnumerationCategory,LAM| BOOT::|Mapping|
+            BOOT::|RecordCategory,LAM| BOOT::|Union|
+            BOOT::|UnionCategory,LAM| BOOT::|displayCategoryTable|
+            BOOT::MAKE-REDUCTION BOOT::READ-A-LINE BOOT::|dbPresentOps|
+            BOOT::|buildBitTable| BOOT::|htBlank|
+            BOOT::|dbMakeContrivedForm| BOOT::|dcSize| BOOT::|sum|
+            BOOT::|args2HtString| BOOT::|dc| BOOT::|bcNameCountTable|
+            VMLISP::MAKE-LIBSTREAM BOOT::|nextown1| BOOT::|next1|
+            BOOT::|incAppend1| BOOT::|synonym| BOOT::|grepConstruct|
+            VMLISP::LOTSOF BOOT::|htBeginMenu| BOOT::|bcCon|
+            BOOT::|koOps| BOOT::|dbWriteLines| BOOT::|catsOf|
+            BOOT::|getDomainOpTable| BOOT:|PlainError|
+            BOOT:|PlainPrint| BOOT::|htInitPageNoScroll|
+            BOOT:|ReadLispExpr| BOOT::|conSpecialString?|
+            BOOT::|htSayStandard| BOOT:|StreamFlush| BOOT:|NewPathname|
+            BOOT:|SessionPathname| BOOT::|domainsOf|
+            BOOT::|dbPresentCons| READLINE BOOT:|StringConcat|
+            BOOT::|htBcLinks| BOOT::|pluralSay|
+            BOOT::|getConstructorExports| BOOT::|sublisFormal|
+            BOOT::NEXT-META-LINE BOOT::|htLispLinks|
+            BOOT::META-META-ERROR-HANDLER BOOT::|dbHeading|
+            BOOT::NEXT-BOOT-LINE BOOT::|concat| BOOT::SPAD_SYNTAX_ERROR
+            BOOT::BOOT BOOT::|htQuery| BOOT::SPAD
+            BOOT::|htSayIndentRel| BOOT::|bcConPredTable|
+            BOOT::|htSaySaturn| BOOT::|dbSayItems| BOOT::|simpHasPred|
+            BOOT::|start| BOOT::|protectedPrompt|
+            BOOT::|htpMakeEmptyPage| BOOT::|htMakeButton|
+            BOOT::|htSayIfStandard| BOOT::|htSay| BOOT::|incZip1|
+            BOOT::|incIgen1| BOOT::|incRgen1|
+            BOOT::|runOldAxiomFunctor| BOOT:|fillerSpaces|
+            BOOT::|incLude1| FOAM::MAKE-FOAMPROGINFOSTRUCT
+            BOOT::|bcPred| BOOT::|sayNewLine|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) CHARACTER) VMLISP:EBCDIC VMLISP:NUM2CHAR
+            BOOT::LINE-CURRENT-CHAR)) 
+(PROCLAIM '(FTYPE (FUNCTION (T T *) FIXNUM) BOOT::LINE-NEW-LINE)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T) FIXNUM) BOOT::|rwrite128|))
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) STRING) BOOT::|stripSpaces| BOOT::LINE-BUFFER
+            BOOT::DROPTRAILINGBLANKS)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T) T) BOOT::|form2FenceQuoteTail|
+            BOOT::|combineMapParts| BOOT::|form2FenceQuote|
+            BOOT::|mkMapPred| BOOT::|formatOpConstant|
+            BOOT::|formJoin2| BOOT::|axOpTran| BOOT::|axFormatOpList|
+            BOOT::|axFormatOp| BOOT::|optcomma|
+            BOOT::|displayTranModemap|
+            BOOT::|makeInternalMapMinivectorName|
+            BOOT::|cleanUpSegmentedMsg| BOOT::|makeDefaultDef|
+            BOOT::|getDefaultingOps| BOOT::|getOpSegment|
+            BOOT::|removeIsDomainD| BOOT::|formatSignatureAsTeX|
+            BOOT::|axFormatType| BOOT::|sayRemoveFunctionOrValue|
+            BOOT::|pvarCondList| BOOT::|makeTypeSequence|
+            BOOT::|makeArgumentIntoNumber| BOOT::|axFormatAttrib|
+            BOOT::|categoryForm?| BOOT::|axFormatCondOp| BOOT:OPTIONAL
+            BOOT::|axFormatPred| BOOT::|fileConstructors|
+            BOOT::SOURCEPATH BOOT::|untraceMapSubNames| BOOT:LASTELEM
+            BOOT::|mapPredTran| BOOT::|makeDefaultArgs|
+            BOOT::|stripType| BOOT::|dqUnitCopy| BOOT::|mkAliasList|
+            BOOT::|dqUnit| BOOT::|modemapToAx|
+            BOOT::|isDefaultPackageName| BOOT::|getEqualSublis|
+            BOOT::|myWritable?| BOOT::|getInfovec| BOOT::|predTran|
+            BOOT::|fnameReadable?| BOOT::|hasDefaultPackage|
+            BOOT::|compFailure| BOOT::|fnameType|
+            BOOT::|setExtendedDomains|
+            BOOT::|simplifyMapConstructorRefs| BOOT::|fnameName|
+            BOOT::|StringToDir|
+            BOOT::|spad2AxTranslatorAutoloadOnceTrigger|
+            BOOT::|fnameDirectory|
+            BOOT::|simplifyMapPattern,unTrivialize| BOOT::|DirToString|
+            BOOT::|isPatternArgument| BOOT::|htQuote|
+            BOOT::|isConstantArgument| BOOT::|frameName|
+            BOOT::|objValUnwrap| BOOT::|htMakePage|
+            BOOT::|PARSE-LedPart| BOOT::|htpPropertyList|
+            BOOT::|analyzeMap,f| BOOT::|PARSE-NudPart|
+            BOOT::|PARSE-Expr| BOOT::|bcHt| BOOT::|getIteratorIds|
+            BOOT::|getUserIdentifiersInIterators|
+            BOOT::|htpInputAreaAlist| BOOT::|getUserIdentifiersIn|
+            BOOT::|PARSE-GliphTok| BOOT::|kePageOpAlist|
+            BOOT::|fileNameStrings| BOOT::|inclmsgCannotRead|
+            BOOT::MAKE-SYMBOL-OF BOOT:MATCH-ADVANCE-STRING
+            BOOT::|removeUndoLines| BOOT::STACK-SIZE BOOT:NOTE
+            BOOT::|histFileErase| BOOT::|histInputFileName|
+            BOOT::STACK-STORE BOOT::|readHiFi| BOOT::|restoreHistory|
+            BOOT::STACK-UPDATED BOOT::|clearSpad2Cmd| BOOT::|getToken|
+            BOOT::|makeHistFileName| BOOT::|changeHistListLen|
+            BOOT::|showHistory| BOOT::|setIOindex| BOOT::|saveHistory|
+            BOOT::|PARSE-NBGliphTok| BOOT::|dewritify,dewritifyInner|
+            BOOT::|setHistoryCore| BOOT::|charDigitVal|
+            BOOT::|dewritify,is?| BOOT::|writify| BOOT::|history|
+            BOOT::|gensymInt| BOOT::|dewritify| BOOT::TOKEN-NONBLANK
+            BOOT::|undoFromFile| BOOT::FLOATEXPID
+            BOOT::|e02dffSolve,fy| BOOT::|spadClosure?|
+            BOOT::|bustUnion| BOOT::|writify,writifyInner|
+            BOOT::|undoChanges| BOOT::|undoInCore| BOOT::|getSlot1|
+            BOOT::|writifyComplain| BOOT::|unwritable?|
+            BOOT::|dbSpecialDisplayOpChar?| BOOT::|removeAttributes|
+            BOOT:|pathname| BOOT::|isLeaf| BOOT::|srcPosDisplay|
+            BOOT::|srcPosColumn| BOOT::|transformOperationAlist|
+            BOOT::|srcPosSource| BOOT::|sayNonUnique|
+            BOOT::|compDefWhereClause,removeSuchthat|
+            BOOT::|srcPosLine| BOOT::|compTuple2Record|
+            BOOT::|srcPosFile| BOOT::|mkAtreeValueOf1| BOOT::|center80|
+            BOOT::|loadFunctor|
+            BOOT::|compDefWhereClause,transformType|
+            BOOT::|mkCategoryPackage,gn|
+            BOOT::|updateCategoryFrameForConstructor| BOOT:|sayFORMULA|
+            BOOT::|convertOpAlist2compilerInfo|
+            BOOT::|getCategoryOpsAndAtts| BOOT::|lispize|
+            BOOT::|getSrcPos| BOOT::|mustInstantiate|
+            BOOT::|isSystemDirectory| BOOT:ASSOCRIGHT BOOT::|getFlag|
+            BOOT::|getMsgToWhere| BOOT::|mkExplicitCategoryFunction,fn|
+            BOOT::|updateCategoryFrameForCategory| BOOT:CURSTRMLINE
+            BOOT::|alreadyOpened?| BOOT::|msgImPr?| BOOT::|Operators|
+            BOOT::|mkAtree1| BOOT::|getLineText| BOOT::|pfSourceText|
+            BOOT::|toFile?| BOOT::|getMsgArgL| BOOT::|poGetLineObject|
+            BOOT:BRIGHTPRINT BOOT::|getLinePos|
+            BOOT::|loadIfNecessaryAndExists| BOOT::|lnPlaceOfOrigin|
+            BOOT::|makeLeaderMsg| BOOT::|putInLocalDomainReferences|
+            BOOT::|pfPosOrNopos| BOOT::|killNestedInstantiations|
+            BOOT::|NRTputInTail| BOOT::|quotifyCategoryArgument|
+            BOOT::|getLisplibVersion| BOOT::|getMsgPrefix|
+            BOOT::|unInstantiate| BOOT::|asTupleAsVector|
+            BOOT::|lisplibDoRename| BOOT::|asTupleSize|
+            BOOT::|finalizeLisplib| BOOT::|disallowNilAttribute|
+            BOOT::|asTupleNewCode0| BOOT::|processKeyedError|
+            BOOT::|toScreen?| BOOT::|compileConstructor1|
+            BOOT::|compileDocumentation| BOOT::|transformREPEAT|
+            BOOT::|line?| BOOT::|readLibPathFast|
+            BOOT::|modemap2Signature| BOOT::|transformCollect|
+            BOOT::|msgLeader?| BOOT::|compileConstructor|
+            BOOT::|initToWhere| BOOT::|initImPr|
+            BOOT::|putDatabaseStuff| BOOT::|e02defSolve,fxy|
+            BOOT::|getMsgPosTagOb| BOOT::|pfIdSymbol|
+            BOOT::|mkAtreeExpandMacros| BOOT::|getMsgPos|
+            BOOT::|macApplication| BOOT::|isInterpMacro|
+            BOOT::|getMsgFTTag?| BOOT::|leader?|
+            BOOT::|pf0ApplicationArgs| BOOT::|atree2EvaluatedTree|
+            BOOT::|remFile| BOOT::|pfMLambda?| BOOT::|whichCat|
+            BOOT::|pfApplicationOp| BOOT::|removeBindingI|
+            BOOT::|addArgumentConditions,fn| BOOT::|macId|
+            BOOT:STRMBLANKLINE BOOT::|getUnname1| BOOT:STRMSKIPTOBLANK
+            BOOT::|remLine| BOOT::|pfSourcePosition|
+            BOOT::|spadCompileOrSetq| BOOT::|getMsgKey?|
+            BOOT::|mac0Get| BOOT::|getMsgKey| BOOT::|compile|
+            BOOT::|evaluateType| BOOT::|constructMacro|
+            BOOT::|poPosImmediate?| BOOT::|pfMLambdaBody|
+            BOOT::|poNopos?| BOOT::|evaluateType1|
+            BOOT::|pf0MLambdaArgs| BOOT:NEXTSTRMLINE
+            BOOT::|evaluateSignature| BOOT::|macMacro|
+            BOOT::|poLinePosn| BOOT::|failCheck| BOOT::|pfNothing?|
+            BOOT::|compile,isLocalFunction| BOOT::|macSubstituteOuter|
+            BOOT::|erMsgSep| BOOT::|pfMacroRhs| BOOT::|mkConstructor|
+            BOOT::|showMsgPos?| BOOT::|pfMacroLhs| BOOT::|macExpand|
+            BOOT:IS_GENVAR BOOT::|mkEvalableMapping| BOOT::|macLambda|
+            BOOT::|getMsgInfoFromKey| BOOT::|evaluateType0|
+            BOOT::|getStFromMsg| BOOT::|getUnnameIfCan|
+            BOOT::|macWhere| BOOT::|tabbing| BOOT::|getMsgLitSym|
+            BOOT::|pfApplication?| BOOT::|getPosStL| BOOT::|pfMacro?|
+            BOOT::|doItIf,localExtras| BOOT::|getMsgText|
+            BOOT::|mkEvalableUnion| BOOT::|pfLambda?|
+            BOOT::|getMsgPrefix?| BOOT::|mkEvalableRecord|
+            BOOT::|pfWhere?| BOOT::|getPreStL| BOOT::|makeOrdinal|
+            BOOT::|mac0GetName| BOOT::|getAndEvalConstructorArgument|
+            BOOT::|msgOutputter| BOOT::|pfLeaf?|
+            BOOT::|mkEvalableCategoryForm| BOOT::|getMsgTag?|
+            BOOT::|devaluateDeeply| BOOT::|pfLeafPosition|
+            BOOT::|compDefineFunctor1,FindRep| BOOT::|pfAbSynOp|
+            BOOT::|listOutputter| BOOT::|pfTypedId|
+            BOOT::|processChPosesForOneLine| BOOT::|pf0LambdaArgs|
+            BOOT::|e02dffSolve,fx| BOOT::|getModeSetUseSubdomain|
+            BOOT::MKQSADD1 BOOT::|getModeSet| BOOT::|poCharPosn|
+            BOOT::|posPointers| BOOT::|NRTgenInitialAttributeAlist|
+            BOOT::|makeMsgFromLine| BOOT::THETA_ERROR
+            BOOT::|mkRationalFunction| BOOT::MACROEXPANDALL
+            BOOT::|isCategoryPackageName| BOOT::|erMsgSort|
+            BOOT::|isAVariableType| BOOT::|msgNoRep?|
+            BOOT::|getPrincipalView| BOOT::|To| BOOT::|hitListOfTarget|
+            BOOT::SUBANQ BOOT::|From| BOOT::|domainDepth|
+            BOOT::|NRTgetLocalIndexClear| BOOT::|constructSubst|
+            BOOT::|containsVars| BOOT::|evalMmDom|
+            BOOT::|abbreviationsSpad2Cmd|
+            BOOT::|formatUnabbreviatedSig| BOOT::|optFunctorBody|
+            BOOT::|optimize| BOOT::|emptyAtree| BOOT::|templateParts|
+            BOOT::|dqToList| BOOT::|dqConcat| BOOT::|isHomogeneousList|
+            BOOT::|isUncompiledMap| BOOT::|printMms|
+            BOOT::|getSymbolType| BOOT::/UNTRACE-REDUCE
+            BOOT::|matchMmCond| BOOT::|object2Identifier|
+            BOOT::|selectMostGeneralMm| BOOT::|fixUpTypeArgs|
+            BOOT::|handleLispBreakLoop| BOOT::TRACEOPTIONS BOOT:REMDUP
+            BOOT::|evalMmStack| BOOT::SHOWBIND BOOT::DROPENV
+            BOOT::UNVEC BOOT::|noSharpCallsHere|
+            BOOT::|untraceDomainConstructor| BOOT:CURMAXINDEX
+            BOOT::|isDomain| BOOT::|getFunctionSourceFile|
+            BOOT::|isMap| BOOT::HACKFORIS1 BOOT::HACKFORIS
+            BOOT::|containsVars1| BOOT::|orderMmCatStack|
+            BOOT::|evalMmStackInner| BOOT::DEF-IN2ON
+            BOOT::|new2OldTran| BOOT::|resolveTypeList|
+            BOOT::|newConstruct| BOOT::|newIf2Cond| BOOT::|newDef2Def|
+            BOOT::|asTupleNew0| BOOT::DEF-MESSAGE1 BOOT::LIST2STRING1
+            BOOT::DEF-WHERE BOOT::DEF-SEQ BOOT::SEQOPT BOOT::DEF-IS
+            BOOT::DEF-EQUAL BOOT::DEF-MESSAGE BOOT::DEF-CATEGORY
+            BOOT::DEF-REPEAT BOOT::DEF-COND BOOT::DEF-LESSP
+            BOOT::SMINT-ABLE BOOT::DEF-COLLECT BOOT::DEF-STRING
+            BOOT::|Zeros| BOOT::DEF-SETELT BOOT::DEF-RENAME1
+            BOOT::DEF-ELT BOOT::|DEF-:| BOOT::DEF-ADDLET
+            BOOT::|quoteWidth| BOOT::DEF-INSERT_LET1 BOOT::|boxSuper|
+            BOOT::DEF-WHERECLAUSE BOOT::DEF-STRINGTOQUOTE
+            BOOT::|boxSub| BOOT::DEF-INSERT_LET BOOT::LIST2CONS-1
+            BOOT::|bootTransform| BOOT::|concatWidth|
+            BOOT::DEF-IS-REMDUP1 BOOT::|altSuperSubWidth|
+            BOOT::|altSuperSubSuper| BOOT::|concatbWidth|
+            BOOT::LIST2CONS BOOT::|altSuperSubSub| BOOT::DEF-IS-REMDUP
+            BOOT::|concatSuper| BOOT::DEF-IS-EQLIST
+            VMLISP:RECOMPILE-DIRECTORY BOOT::|concatSub|
+            BOOT::|new2OldDefForm| BOOT::|binomWidth|
+            BOOT::|binomSuper| BOOT::DEF-SELECT BOOT::|binomSub|
+            BOOT::COMP-TRAN-1 BOOT::PUSHLOCVAR BOOT::COMP-EXPAND
+            BOOT::|canCacheLocalDomain,domargsglobal| VMLISP:MAKE-CVEC
+            BOOT::|inSuper| BOOT::COMP-NEWNAM BOOT::COMP-TRAN
+            BOOT::|inSub| BOOT::COMP-FLUIDIZE BOOT::|addInputLibrary|
+            BOOT::|inWidth| BOOT::|dropInputLibrary|
+            BOOT::|openOutputLibrary| BOOT::|moveORsOutside|
+            BOOT::|stepSuper| BOOT::|outputTranMatrix|
+            BOOT::|fracwidth| BOOT::|stepSub| BOOT::|compQuietly|
+            BOOT::|listOfPatternIds| BOOT::|fracsuper| BOOT::COMP-1
+            BOOT::|getOplistForConstructorForm| BOOT::|stepWidth|
+            BOOT::COMP-2 VMLISP:TRIMSTRING BOOT::|maprin0|
+            BOOT::|compAndDefine| BOOT::|abbreviate| BOOT::|fracsub|
+            BOOT::|exptSuper| BOOT::|mathPrintTran|
+            BOOT::|COMP,FLUIDIZE| VMLISP:COMP370 BOOT::|exptWidth|
+            BOOT::|rootWidth| BOOT::|with| BOOT::|exptNeedsPren|
+            BOOT::|minusWidth| VMLISP:|log| BOOT::|maprin|
+            BOOT::|loadDependents| BOOT::|concatTrouble,fixUp|
+            BOOT::|loadIfNecessary| VMLISP:MBPIP BOOT::|timesWidth|
+            BOOT::|rootSuper| BOOT::|interactiveModemapForm,fn|
+            BOOT::|largeMatrixAlist| VMLISP:QSORT BOOT::|sumWidth|
+            VMLISP:PLACEP BOOT::LOG10 BOOT::|aggWidth| BOOT::|zagWidth|
+            BOOT::|pi2Width| BOOT::|rebuildCDT| BOOT::|LZeros|
+            BOOT::|e02zafSolve,fmu| BOOT::|signatureTran|
+            BOOT::|destructT| BOOT::|userError| BOOT::|clearAllSlams|
+            BOOT::|displayComp| VMLISP:HKEYS BOOT::|mkErrorExpr|
+            BOOT::|pi2Sup| BOOT::|compOrCroak1,compactify|
+            BOOT::|pi2Sub| BOOT::|convertSpadToAsFile|
+            BOOT::|overbarSuper| BOOT::|outputOp| BOOT::|compiler|
+            BOOT::|resolveTMRed1| BOOT::|resolveTTRed3|
+            BOOT::|fnameWritable?| BOOT::MONITOR-EVALBEFORE
+            VMLISP:UPCASE BOOT::|interpOp?| BOOT::|pathnameName|
+            BOOT::|pathnameDirectory| BOOT::SPADSYSNAMEP VMLISP:STATEP
+            BOOT::|compileSpad2Cmd| BOOT::MONITOR-BLANKS
+            BOOT::|piWidth| BOOT::|newType?| BOOT::WHOCALLED
+            BOOT::|charyTopWidth| VMLISP:FBPIP BOOT::|bubbleType|
+            BOOT::|putWidth| BOOT::|piSup| BOOT::OPTIONS2UC
+            BOOT::|overlabelSuper| BOOT::|pathnameType|
+            BOOT::|spadThrowBrightly| BOOT::/OPTIONS BOOT::|piSub|
+            BOOT::/UNEMBED-Q BOOT::/UNEMBED-1
+            BOOT::|typeIsASmallInteger| BOOT::|indefIntegralWidth|
+            BOOT::|indefIntegralSup| BOOT::|isSimple| VMLISP:UNEMBED
+            BOOT::|indefIntegralSub| BOOT::|primitiveType|
+            BOOT::|mkAtree| BOOT::/UNTRACELET-2
+            BOOT::|outputTranIterate| BOOT::|errorRef|
+            VMLISP:RE-ENABLE-INT BOOT::/UNTRACELET-1 BOOT::|intWidth|
+            BOOT::|NRTgetLocalIndex| BOOT::|getOutputAbbreviatedForm|
+            BOOT::|isFluid| VMLISP:IVECP BOOT::|iterVarPos|
+            BOOT::|remWidth| VMLISP:LIST2VEC BOOT::|matWidth|
+            BOOT::|asTupleAsList| BOOT::|outputTranIteration|
+            VMLISP:LISTOFQUOTES BOOT::|upcase| BOOT::|intSup|
+            BOOT::|reassembleTowerIntoType| BOOT::|upor|
+            BOOT::|matSuper| BOOT::|hasFormalMapVariable,hasone?|
+            BOOT::|intSub| VMLISP:IS-CONSOLE BOOT::|coerceUnion2Branch|
+            BOOT::|PushMatrix| BOOT::MKPROGN BOOT::|uncons|
+            VMLISP:MAKE-ABSOLUTE-FILENAME
+            BOOT::|retract2Specialization| BOOT::|sigma2Width|
+            VMLISP:FUNARGP BOOT::|syminusp| BOOT::|NRTassocIndex|
+            BOOT::|resolveTypeListAny| BOOT::MONITOR-PRINTREST
+            BOOT::|extwidth| BOOT::|varsInPoly| BOOT::|sigma2Sup|
+            BOOT::|stackWarning| BOOT::SMALL-ENOUGH BOOT::|extsuper|
+            BOOT::|sigma2Sub| BOOT::|extsub| BOOT::|sigmaWidth|
+            BOOT::/INITUPDATES BOOT::|sigmaSup| BOOT::IS_SHARP_VAR
+            BOOT::|sigmaSub| BOOT::|retract1| BOOT::|qTWidth| VMLISP:LN
+            BOOT::|decomposeTypeIntoTower| BOOT::|transcomparg|
+            BOOT::FUNLOC BOOT::|stringWidth|
+            BOOT::|mathprintWithNumber| BOOT::COND-UCASE
+            VMLISP:PROPLIST BOOT::|texFormat| BOOT::|bubbleConstructor|
+            BOOT::|isSubForRedundantMapName| BOOT::|isDomainOrPackage|
+            BOOT::|dispfortexp| BOOT::|isInterpOnlyMap|
+            BOOT::|formulaFormat| BOOT::|boxWidth| BOOT::|sayMath|
+            BOOT::|domainZero| BOOT::|domainOne| VMLISP:COPY
+            VMLISP:DOWNCASE BOOT::|e04ucfSolve,fg| VMLISP:SHUT
+            BOOT::|unescapeStringsInForm|
+            BOOT::|executeInterpreterCommand| VMLISP:REROOT
+            BOOT::|parseAndInterpret| VMLISP:DIG2FIX
+            BOOT::|ncSetCurrentLine| BOOT::|pvarsOfPattern|
+            BOOT::|htEscapeString| BOOT::|e01safSolve,f|
+            BOOT::|e04ucfSolve,fe| BOOT::|e01befSolve,f|
+            BOOT::|e01bffSolve,g| VMLISP:LOG2 BOOT::|e01dafSolve,g|
+            BOOT::|e01dafSolve,f| VMLISP:SIZE VMLISP:EOFP
+            BOOT::|e01bffSolve,f| VMLISP:RSHUT BOOT::|e04ucfSolve,fd|
+            BOOT::|e01bhfSolve,f| BOOT::|objVal| BOOT::|getValue|
+            BOOT::|getMode| BOOT::|getUnname| VMLISP:DIGITP
+            BOOT::|bottomUp| BOOT::|mkAtreeNode| VMLISP:VEC2LIST
+            VMLISP:MAKE-VEC VMLISP:GCMSG BOOT::|retract|
+            BOOT::|getUnionOrRecordTags| BOOT::|e02dcfColdSolve,h|
+            BOOT::|e02ajfSolve,f| BOOT::|polyVarlist|
+            BOOT::|e02befColdSolve,f| BOOT::|removeQuote|
+            BOOT::|e02dcfColdSolve,g| BOOT::|e02dcfColdSolve,f|
+            BOOT::|isMapExpr| BOOT::|getTarget|
+            BOOT::|e02ddfColdSolve,f| BOOT::|isType|
+            BOOT::|bottomUpElt| BOOT::|e02adfSolve,f|
+            BOOT::|retractAtree| BOOT::|bottomUpPercent|
+            BOOT::|fetchOutput| BOOT::|e02aefSolve,f|
+            BOOT::|e02gafSolve,fb| BOOT::|bottomUpUseSubdomain|
+            BOOT::|getBasicObject| BOOT::|bottomUpCompile|
+            BOOT::|e02ddfSolve,h| BOOT::|e02ddfSolve,g|
+            BOOT::|e02bafSolve,g| BOOT::|e02bcfSolve,f|
+            BOOT::|getBasicMode| BOOT::|e02ddfSolve,f| BOOT::|unwrap|
+            BOOT::|isWrapped| BOOT::|e02bafSolve,f| BOOT::GETZEROVEC
+            BOOT::|containsPolynomial|
+            BOOT::|getModeOrFirstModeSetIfThere| BOOT::|e02ahfSolve,f|
+            BOOT::|e04ucfSolve,fc| BOOT::|wrapMapBodyWithCatch|
+            BOOT::|e02agfSolve,i| BOOT::|e02agfSolve,h|
+            BOOT::|e02bdfSolve,f| BOOT::|containsVariables|
+            BOOT::|e02bbfSolve,f| BOOT::|wrapped2Quote|
+            BOOT::|objCodeVal| BOOT::|objCodeMode|
+            BOOT::|e02akfSolve,f| BOOT::|asyUnTuple|
+            BOOT::|asyTypeUnitList| BOOT::|asyComma?|
+            BOOT::|interactiveModemapForm| BOOT::|isTaggedUnion|
+            BOOT::|asIsCategoryForm| BOOT::|opOf| BOOT::|e02agfSolve,g|
+            BOOT::|asySubstMapping| BOOT::|e02agfSolve,f|
+            BOOT::|asyTypeMapping| BOOT::|asyCATEGORY|
+            BOOT::|e02dafSolve,fp| BOOT::|asyShorten|
+            BOOT::|e02dafSolve,fmu| BOOT::|createAbbreviation|
+            BOOT::|astran| BOOT::|asMakeAlist| BOOT::|asyParents|
+            BOOT::|asyDocumentation| BOOT::|asyConstructorModemap|
+            BOOT::|asytran| BOOT::|asyPredTran| BOOT::|asyPredTran1|
+            BOOT::|as| BOOT::|asytranLiteral| BOOT::|asytranEnumItem|
+            BOOT::|constructor?| BOOT::|hackToRemoveAnd|
+            BOOT::|asyGetAbbrevFromComments| BOOT::|intern|
+            BOOT::|asyTypeJoinPartPred| BOOT::|zeroOneConversion|
+            BOOT::|asyArgs| BOOT::|asyArg| BOOT::|asyFindAttrs|
+            BOOT::|asyAncestors| BOOT::|asyAncestorList|
+            BOOT::|asyTypeJoinItem| BOOT::|isLowerCaseLetter|
+            BOOT::|abbreviation?| BOOT::|asAll| BOOT::|error|
+            BOOT::|asyTypeJoinPartIf| BOOT::|asyType|
+            BOOT::|asyTypeJoin| BOOT::|asyTypeJoinPartExport|
+            BOOT::|asyCattranOp| BOOT::|predicateBitRef|
+            BOOT::|asyMkpred| BOOT::|asyLooksLikeCatForm?|
+            BOOT::|asyCosigType| BOOT::|setVector12|
+            BOOT::|asMakeAlistForFunction| BOOT::|optFunctorPROGN|
+            BOOT::|getAttributesFromCATEGORY| BOOT::|worthlessCode|
+            BOOT::|mySort| BOOT::|optFunctorBody,CondClause|
+            BOOT::|mkDomainFormer| BOOT::|mkNiladics| BOOT::|optCall|
+            BOOT::|explodeIfs| BOOT::|folks| BOOT::|mkVector|
+            BOOT::|asyExtractDescription| BOOT::|asyCattran1|
+            BOOT::|simpCattran| BOOT::|asyCattran| BOOT::|asyCatItem|
+            BOOT::|asyExportAlist| BOOT::FOOBAR
+            BOOT::|bootAbsorbSEQsAndPROGNs| BOOT::|displayDatabase|
+            BOOT::|bootAbsorbSEQsAndPROGNs,flatten| BOOT::|bootTran|
+            BOOT::|asyConstructorArg| BOOT::|bootLabelsForGO|
+            BOOT::GP2COND BOOT::|bootPROGN| BOOT::|asyTypeMakePred|
+            BOOT::|bootSEQ| BOOT::|tryToRemoveSEQ| BOOT::|nakedEXIT?|
+            BOOT::|asyConstructorArgs| BOOT::|mergeCONDsWithEXITs|
+            BOOT::STREAM2UC BOOT::|asyTypeJoinStack| BOOT::|bootCOND|
+            BOOT::STRINGREST BOOT::|bootAND| BOOT::|boot2Lisp|
+            BOOT::|bootOR| BOOT::|asyTypeJoinPartWith| BOOT::|bootIF|
+            BOOT::|asyCosig| BOOT::|bootAND,flatten|
+            BOOT::|bootPushEXITintoCONDclause| BOOT::|asyIsCatForm|
+            BOOT::|bootOR,flatten| BOOT::|asCategoryParts,exportsOf|
+            BOOT::|removeEXITFromCOND| BOOT::|flattenCOND| BOOT::/FLAG
+            BOOT::|extractCONDClauses| BOOT::|hashable|
+            BOOT::|trimString| BOOT::|mergeableCOND|
+            BOOT::|knownEqualPred| BOOT::|removeEXITFromCOND?|
+            BOOT::CPSAY BOOT::|zeroOneConvert| BOOT::/EDIT
+            BOOT::|domainForm?| BOOT::|makeByteWordVec|
+            BOOT::DECIMAL-LENGTH BOOT::|unabbrevAndLoad| BOOT::READLISP
+            BOOT::|abbQuery| BOOT::SPAD-EVAL BOOT::/TRANSNBOOT
+            BOOT::SPAD-MDTR-2 BOOT::SPAD-MDTR-1 BOOT::/TRANSPAD
+            BOOT::|setAutoLoadProperty| BOOT::/TRANSMETA
+            BOOT::|getConstructorUnabbreviation| BOOT::|getLisplibName|
+            BOOT::OPTIMIZE&PRINT
+            BOOT::|getPartialConstructorModemapSig| BOOT::UNCONS
+            BOOT::|maximalSuperType| BOOT::|getImmediateSuperDomain|
+            BOOT::|augmentLowerCaseConTable| BOOT::|isNameOfType|
+            BOOT::|objMode| BOOT::|isDomainValuedVariable|
+            BOOT::|packageForm?| BOOT::|sayMSG2File| BOOT::|concatList|
+            BOOT::|mkMessage| BOOT::|clearCache| BOOT::|IdentityError|
+            BOOT::/TRANSBOOT BOOT::|process| BOOT::|mathprint|
+            BOOT::ISLOCALOP-1 BOOT::|pushSatOutput| BOOT::|fracpart|
+            BOOT::|negintp| BOOT::|intpart| BOOT::|optRECORDELT|
+            BOOT::|optIF2COND| BOOT::C-TO-R BOOT::C-TO-S BOOT::S-TO-C
+            BOOT::CGAMMA BOOT::RGAMMA BOOT::CLNGAMMA BOOT::RLNGAMMA
+            BOOT::|getDomainOps| BOOT::|showGoGet|
+            BOOT::|showAttributes| BOOT::|showPredicates|
+            BOOT::|showSummary| BOOT::|getExtensionsOfDomain|
+            BOOT::|getDomainSeteltForm| BOOT::|getCategoriesOfDomain|
+            BOOT::|getDomainExtensionsOfDomain| BOOT::|bnot|
+            BOOT::|notDnf| BOOT::|b2dnf| BOOT::|ordList| BOOT::|bor|
+            BOOT::|band| BOOT::|bassert| BOOT::|notCoaf| BOOT::|list3|
+            BOOT::|list2| BOOT::|list1| BOOT::|dnf2pf| BOOT::|be|
+            BOOT::|reduceDnf| BOOT::|bassertNot| BOOT::|prove|
+            BOOT::|testPredList| BOOT::|nodeCount|
+            BOOT::|mkCircularAlist| BOOT::|clearSlam,LAM|
+            BOOT::|getCacheCount| BOOT::|clearLocalModemaps|
+            BOOT::|hashCount| BOOT::|parseAndEvalToHypertex|
+            BOOT::|oldParseAndInterpret| BOOT::|parseAndInterpToString|
+            BOOT::|parseAndEvalToStringEqNum| BOOT::|setHistory|
+            BOOT::|setExposeAddGroup| BOOT::|setFortDir|
+            BOOT::|validateOutputDirectory| BOOT::|setOutputLibrary|
+            BOOT::|setFortPers| BOOT::|setExposeDropConstr|
+            BOOT::|setExposeDropGroup| BOOT::|setExposeDrop|
+            BOOT::|setFortTmpDir| BOOT::|setExposeAdd|
+            BOOT::|setExpose| BOOT::|setInputLibrary|
+            BOOT::|setAsharpArgs| BOOT::|countCache| BOOT::|cgamma|
+            BOOT::|rgamma| BOOT::|clngammacase3| BOOT::|cgammaBernsum|
+            BOOT::|cgammaAdjust| BOOT::|lnrgammaRatapprox|
+            BOOT::|phiRatapprox| BOOT::|lnrgamma|
+            BOOT::|gammaRatapprox| BOOT::|gammaRatkernel|
+            BOOT::|gammaStirling| BOOT::|PsiIntpart|
+            BOOT::|isFilterDelimiter?|
+            BOOT::|mkDetailedGrepPattern,simp| BOOT::|cgammat|
+            BOOT::|isDefaultOpAtt| BOOT::|replaceTicksBySpaces|
+            BOOT::COT BOOT::|conform2OutputForm| BOOT::|lncgamma|
+            BOOT::|dbGetName| BOOT::|pfTupleList| BOOT::|pfWIfElse|
+            BOOT::|pfWIfThen| BOOT::|mkGrepPattern1,addWilds|
+            BOOT::|pfWIfCond| BOOT::|pfWIf?| BOOT::|mkGrepPattern1,g|
+            BOOT::|organizeByName| BOOT::|pfAssignLhsItems|
+            BOOT::|pfRetractToType| BOOT::|getTempPath| BOOT::|pfSexpr|
+            BOOT::|looksLikeDomainForm| BOOT::|pfRetractToExpr|
+            BOOT::|pfRetractTo?| BOOT::|pfExpression?|
+            BOOT::|genSearchUniqueCount|
+            BOOT::|pf0FlattenSyntacticTuple| BOOT::|pfSexpr,strip|
+            BOOT::|pmPreparse| BOOT::|dbUnpatchLines|
+            BOOT::|evaluateLines| BOOT::|verifyRecordFile|
+            BOOT::|sayDocMessage| BOOT::|recordAndPrintTest,fn|
+            BOOT::|pmParseFromString|
+            BOOT::|conLowerCaseConTranTryHarder| BOOT::|fnameExists?|
+            BOOT::|htTrimAtBackSlash| BOOT::|setExposeAddConstr|
+            BOOT::|dbBasicConstructor?| BOOT::|lfnegcomment|
+            BOOT::|lfcomment| BOOT::|bcStarConform| BOOT::|lfstring|
+            BOOT::|bcStar| BOOT::|simpBool| BOOT::|scanKeyTr|
+            BOOT::|extractHasArgs,find| BOOT::|lfkey|
+            BOOT::|scanPossFloat| BOOT::|scanCloser?|
+            BOOT::|bcStarSpace| BOOT::|keyword|
+            BOOT::|loadLibIfNotLoaded| BOOT::|lineoftoks|
+            BOOT::|lisp2HT| BOOT::|getCType| BOOT::|lisp2HT,fn|
+            BOOT::|conform2HtString| BOOT::|nextline|
+            BOOT::|unMkEvalable| BOOT::|int2Bool| BOOT::|keyword?|
+            BOOT::|htSayList| BOOT::|scanW| BOOT::|isLoaded?|
+            BOOT::|mkQuote| BOOT::|lfinteger| BOOT::|mkQuote,addQuote|
+            BOOT::|functionAndJacobian| BOOT::|lferror|
+            BOOT::|scanWord| BOOT::|scanTransform|
+            BOOT::|htPred2English,fnAttr| BOOT::|dbConname|
+            BOOT::|digit?| BOOT::|addSpaces| BOOT::|dbKindString|
+            BOOT::|lfspaces| BOOT::|stripUnionTags| BOOT::|lfid|
+            BOOT::|mkPredList| BOOT::|spad2lisp|
+            BOOT::|orderUnionEntries| BOOT::|punctuation?|
+            BOOT::|Record0| BOOT::|makeFort,untangle|
+            BOOT::|makeFort,untangle2| BOOT::|makeOutputAsFortran|
+            BOOT::|rdigit?| BOOT::|vec2Lists| BOOT::|npMoveTo|
+            BOOT::|complexRows| BOOT::|makeLispList|
+            BOOT::|pfSourceStok| BOOT::|vec2Lists1|
+            BOOT::|multiToUnivariate| BOOT::|spadTypeTTT|
+            BOOT::|makeUnion| BOOT::|stripNil|
+            BOOT::|parseAndEvalToString|
+            BOOT::|parseAndEvalToStringForHypertex| BOOT::|XDRFun|
+            BOOT::|pair2list| BOOT::|pfStringConstString|
+            BOOT::|pfExportDef| BOOT::|prefix2Infix|
+            BOOT::|pfDefinitionSequenceArgs| BOOT::|lispType|
+            BOOT::|pfComDefinitionDef| BOOT::|checkForBoolean|
+            BOOT::|npTrapForm| BOOT::|pfTransformArg|
+            BOOT::|vectorOfFunctions| BOOT::|pfTaggedToTyped1|
+            BOOT::|pfFlattenApp| BOOT::|pfTaggedToTyped|
+            BOOT::|pfCollectVariable1|
+            BOOT::|InvestigateConditions,pessimise| BOOT::|pfCollect1?|
+            BOOT::|d01gafSolve,f| BOOT::|pfComDefinitionDoc|
+            BOOT::|PrepareConditional| BOOT::|pfLoopIterators|
+            BOOT::|TryGDC| BOOT::|d01fcfSolve,f| BOOT::|compCategories|
+            BOOT::|pfHidePart| BOOT::|makeMissingFunctionEntry,tran|
+            BOOT::|PacPrint| BOOT::|keyItem| BOOT::|pfHide?|
+            BOOT::|pfDocumentText| BOOT::|pfDocument?|
+            BOOT::|e02dafSolve,fxy| BOOT::|pfLambdaArgs|
+            BOOT::|ConstantCreator| BOOT::|pfDefinitionLhsItems|
+            BOOT::|pf0WithWithin| BOOT::|d02bbfSolve,fb|
+            BOOT::|pfWithWithin| BOOT::|d02bbfSolve,fa|
+            BOOT::|pf0WithBase| BOOT::|d02gbfSolve,fe|
+            BOOT::|pfWithBase| BOOT::|pfWithWithon| BOOT::|pfNot|
+            BOOT::|d02kefSolve,fc| BOOT::|pfId| BOOT::|pfTupleParts|
+            BOOT::|d02kefSolve,fb| BOOT::|pfWhereContext|
+            BOOT::|InvestigateConditions| BOOT::|pfCheckArg|
+            BOOT::|InvestigateConditions,reshape|
+            BOOT::|d02kefSolve,fa| BOOT::|pfCheckId|
+            BOOT::|getPossibleViews| BOOT::|pfQualTypeQual|
+            BOOT::|ICformat| BOOT::|pfTupleListOf|
+            BOOT::|InvestigateConditions,mkNilT| BOOT::|pfQualTypeType|
+            BOOT::|pfQualType?| BOOT::|getViewsConditions|
+            BOOT::|pfDWhereExpr| BOOT::|ICformat,Hasreduce|
+            BOOT::|pfForinLhs| BOOT::|ICformat,ORreduce|
+            BOOT::|d02gbfSolve,fi| BOOT::|d02gbfSolve,fh|
+            BOOT::|pfDWhereContext| BOOT::|CategoriesFromGDC|
+            BOOT::|pfSymbolVariable?| BOOT::|d02rafSolve,fc|
+            BOOT::|pfMLambdaArgs| BOOT::|optFunctorBodyRequote|
+            BOOT::|d02gafSolve,ff| BOOT::|pfInlineItems|
+            BOOT::|d02rafSolve,fb| BOOT::|pfSemiColonBody|
+            BOOT::|d02rafSolve,fa| BOOT::|pfSemiColon?|
+            BOOT::|optFunctorBodyQuotable| BOOT::|d02gafSolve,fd|
+            BOOT::|pfInline| BOOT::|pf0AddBase| BOOT::|pfAddBase|
+            BOOT::|d02ejfSolve,fb| BOOT::|pfSemiColon|
+            BOOT::|pfAddAddon| BOOT::|d02ejfSolve,fa|
+            BOOT::|pfAddAddin| BOOT::|d02bhfSolve,fb|
+            BOOT::|pf0ImportItems| BOOT::|d02bhfSolve,fa|
+            BOOT::|pfImportItems| BOOT::|pfInline?|
+            BOOT::|pfReturnFrom| BOOT::|pfImport|
+            BOOT::|d02gafSolve,fb| BOOT::|pfListOf?|
+            BOOT::|pfFreeItems| BOOT::|pf0TLambdaArgs|
+            BOOT::|d02gafSolve,fa| BOOT::|pfTLambdaArgs|
+            BOOT::|pfTLambdaBody| BOOT::|pfExitNoCond|
+            BOOT::|pf0WrongRubble| BOOT::|pfWrongRubble|
+            BOOT::|pfTLambdaRets| BOOT::|pfWrongWhy|
+            BOOT::|pfIterateFrom| BOOT::|pfLocalItems|
+            BOOT::|pfAttributeExpr| BOOT::|d02cjfSolve,fb|
+            BOOT::|pfAttribute?| BOOT::|pfLoop| BOOT::|d02cjfSolve,fa|
+            BOOT::|pfDo| BOOT::|pfWDeclareDoc| BOOT::|pfSecond|
+            BOOT::|pfWDeclareSignature| BOOT::|pfWDeclare?|
+            BOOT::|pfCheckInfop| BOOT::|d03edfSolve,fd|
+            BOOT::|pf0CollectIterators| BOOT::|pfExport?|
+            BOOT::|d03edfSolve,fc| BOOT::|pfDeclPart?|
+            BOOT::|d03edfSolve,fa| IDENTITY BOOT::|pfDWhere?|
+            BOOT::|pfImport?| BOOT::|pfTyping?| BOOT::|pfSuchthat|
+            BOOT::|pfComDefinition?| BOOT::|pfTLambda?| BOOT::|pfWhile|
+            BOOT::|pfAdd?| BOOT::|pf0ExportItems| BOOT::|pfExportItems|
+            BOOT::|pfExpr?| BOOT::|pfWith?| BOOT::|e01sefSolve,f|
+            BOOT::|pf0TypingItems| BOOT::|pfTypingItems|
+            BOOT::|pfGetLineObject| BOOT::|lnFileName?|
+            BOOT::|e01bgfSolve,g| BOOT::|e01bgfSolve,f|
+            BOOT::|pfNopos?| BOOT::|lnExtraBlanks|
+            BOOT::|pfPlaceOfOrigin| BOOT::|ravel|
+            BOOT::|poPlaceOfOrigin| BOOT::|e01bafSolve,f|
+            BOOT::|pfFileName?| BOOT::|poFileName?|
+            BOOT::|parseAndEval| BOOT::|getDomainHash| BOOT::|aplTran1|
+            BOOT::|hasAplExtension| BOOT::|htpDomainConditions|
+            BOOT::|aplTranList| BOOT::|postDefArgs|
+            BOOT::|postTranScripts| BOOT::|getHtMacroItem|
+            BOOT::|postTranScripts,fn| BOOT::|unTuple|
+            BOOT::|isPackageType| BOOT::|buttonNames|
+            BOOT::|postcheckTarget| BOOT::|postcheck|
+            BOOT::|dbNonEmptyPattern| BOOT::|postBlockItemList|
+            VMLISP:|last| BOOT::|postBlockItem| BOOT::|postQuote|
+            BOOT::|postSequence| BOOT::|postTranList|
+            BOOT::|checkWarning| VMLISP:HASHTABLE-CLASS
+            BOOT::|downlinkSaturn| BOOT::|decodeScripts,fn|
+            BOOT::|mkUnixPattern| BOOT::|tuple2List|
+            BOOT::|postCapsule| BOOT::|patternCheck| BOOT::|postElt|
+            BOOT::|postSEGMENT| BOOT::|e04nafSolve,ff|
+            BOOT::|postIteratorList| BOOT::|npEqPeek| BOOT::|postForm|
+            BOOT::|htAllOrNum| BOOT::|postOp| BOOT::|stringize|
+            VMLISP:LISTOFFREES BOOT::|postTuple| BOOT::|postExit|
+            BOOT::|parseWord| BOOT::|postMapping| VMLISP:GENSYMP
+            BOOT::|postMDef| BOOT::|pfAttribute| BOOT::|postDef|
+            BOOT::|npRestore| BOOT::|postCategory| BOOT::|aplTran|
+            BOOT::|containsBang| BOOT::|htMakePathKey| BOOT::|postJoin|
+            BOOT::|npWConditional| BOOT::|postTransformCheck|
+            BOOT::|npBraced| VMLISP:PAPPP
+            BOOT::|chkAllNonNegativeInteger| BOOT::|postIf|
+            BOOT::|chkNonNegativeInteger| BOOT::|postPretend|
+            BOOT::|pfId?| BOOT::|postAtSign| BOOT::|npBracketed|
+            BOOT::|postColon| BOOT::|chkDirectory|
+            BOOT::|postColonColon| BOOT::|postWhere|
+            BOOT::|npZeroOrMore| BOOT::|postSemiColon|
+            BOOT::|postBlock| BOOT::|pfParts| BOOT::|deepestExpression|
+            BOOT::|translateYesNo2TrueFalse| BOOT::|postComma|
+            BOOT::|pfEnSequence| BOOT::|comma2Tuple|
+            BOOT::|npParenthesized| BOOT::|chkOutputFileName|
+            BOOT::|postReduce| BOOT::|chkPosInteger| BOOT::|postAdd|
+            BOOT::|pfUnSequence| BOOT::|postTupleCollect|
+            BOOT::|postCollect| BOOT::|postRepeat| BOOT::|postIn|
+            BOOT::|htShowCount| BOOT::|satisfiesUserLevel|
+            BOOT::|postin| BOOT::|postQUOTE| BOOT::|pfListOf|
+            BOOT::|postScripts| BOOT::|translateTrueFalse2YesNo|
+            BOOT::|postWith| BOOT::|e02dffSolve,fp| VMLISP:CHARP
+            BOOT::|chkNameList| BOOT::|isSymbol| BOOT::INFIXTOK
+            BOOT::|npQualified| BOOT::SKIP-TO-ENDIF
+            BOOT::|npConditional| BOOT::|stackMessageIfNone|
+            BOOT::PREPARSEREADLINE BOOT::|npElse|
+            BOOT::|translateYesNoToTrueFalse| BOOT::|npMissing|
+            BOOT::PREPARSEREADLINE1 BOOT::|npDDInfKey| VMLISP:RPACKFILE
+            BOOT::SKIP-IFBLOCK BOOT::|tokPart| BOOT::|npInfKey|
+            VMLISP:RECOMPILE-LIB-FILE-IF-NECESSARY BOOT::|npWith|
+            BOOT::|optimizeFunctionDef| BOOT::PREPARSE-ECHO
+            BOOT::|npCompMissing| VMLISP::LIBSTREAM-DIRNAME
+            BOOT::ATENDOFUNIT BOOT::PARSEPRINT BOOT::|npAdd|
+            BOOT::PREPARSE1 BOOT::|e02defSolve,fp|
+            BOOT::|htpRadioButtonAlist| BOOT::MONITOR-DATA-COUNT
+            BOOT::MONITOR-DATA-NAME BOOT::|htpDomainPvarSubstList|
+            BOOT::MONITOR-DATA-SOURCEFILE BOOT::|profileTran|
+            BOOT::MONITOR-DELETE BOOT::|pfSequenceToList|
+            BOOT::MONITOR-DATA-MONITORP BOOT::|pfSequenceArgs|
+            BOOT::|renamePatternVariables| BOOT::|pfSequence?|
+            BOOT:|LispEval| BOOT::|pfNovalueExpr|
+            BOOT::MONITOR-EXPOSEDP BOOT::|pfNovalue?|
+            BOOT::|htpDomainVariableAlist| BOOT::|pfNotArg|
+            BOOT::MONITOR-APROPOS BOOT::|pfNot?| BOOT::MONITOR-DATA-P
+            BOOT::|pfOrRight| BOOT::|pfOrLeft| BOOT::MONITOR-LIBNAME
+            BOOT::|pfOr?| BOOT::MONITOR-FILE BOOT::|pfAndRight|
+            BOOT::|pfAndLeft| BOOT::|pfAnd?| BOOT::MONITOR-SPADFILE
+            BOOT::|getDomainsInScope| BOOT::|pfWrong?|
+            BOOT::MONITOR-PARSE BOOT::|pf0LocalItems|
+            BOOT::MONITOR-DECR BOOT::|pfLocal?| BOOT::|pfNovalue|
+            BOOT::|pf0FreeItems| BOOT::|npItem1| BOOT::|pfFree?|
+            BOOT::|pfRestrictType| BOOT::MONITOR-INCR
+            BOOT::|pfRestrictExpr| BOOT::|npLetQualified|
+            BOOT::|isConstructorForm| BOOT::|pfRestrict?|
+            BOOT::|library| BOOT::MONITOR-NRLIB BOOT::|pfDefinition?|
+            BOOT::|unknownTypeError| BOOT::|pfAssignRhs|
+            BOOT::|pf0AssignLhsItems| BOOT::|pfAssign?| BOOT::|quotify|
+            BOOT::|pfDoBody| BOOT::|reportHashCacheStats|
+            BOOT::MONITOR-DIRNAME BOOT::|pfDo?|
+            BOOT::|mkHashCountAlist| BOOT::|pfSuchthatCond|
+            BOOT::|displayCacheFrequency| BOOT::|pfSuchthat?|
+            BOOT::MONITOR-CHECKPOINT BOOT::|pfWhileCond|
+            BOOT::|pfWhile?| BOOT::|pfForinWhole|
+            BOOT::|outputDomainConstructor| BOOT::|e02dffSolve,fmu|
+            BOOT::|pf0ForinLhs| BOOT::|typeTimePrin|
+            BOOT::|pfCheckMacroOut| BOOT::|isSomeDomainVariable|
+            BOOT::|pfForin?| BOOT::|displayHashtable|
+            BOOT::|pfCollect?| BOOT::|removeZeroOne| BOOT::|npEncAp|
+            BOOT::|pf0LoopIterators| BOOT::|addBlanks|
+            BOOT::|compHasFormat| BOOT::|loopIters2Sex|
+            BOOT::|noBlankBeforeP| BOOT::|pfLoop?|
+            BOOT::|stopTimingProcess| BOOT::|noBlankAfterP|
+            BOOT::|?comp| BOOT::|pfExitExpr| BOOT::|pfExitCond|
+            BOOT::|compileQuietly| BOOT::|sayLongOperation|
+            BOOT::|isAlmostSimple,setAssignment| BOOT::|pfExit?|
+            BOOT::|compileInteractive| BOOT::|say2PerLineThatFit|
+            BOOT::?COMP BOOT::|npBracked| BOOT::|pfFromdomDomain|
+            BOOT::|startTimingProcess| BOOT::|prEnv|
+            BOOT::|pfFromdomWhat| BOOT::|operationLink| BOOT::|opTran|
+            BOOT::|pfFromdom?| BOOT::|hasType,fn| BOOT::|pfPretendType|
+            BOOT::|clearCategoryCache| BOOT::|pfTuple|
+            BOOT::|pfPretendExpr| BOOT::|clearConstructorCache|
+            BOOT::|qModemap| BOOT::|pfPretend?|
+            BOOT::|splitListSayBrightly| BOOT::|formatModemap|
+            BOOT::|pfCoercetoType| BOOT::|printEnv|
+            BOOT::|pfCoercetoExpr| BOOT::|tabber| BOOT::|pfCoerceto?|
+            BOOT::|decExitLevel| BOOT::|pfTaggedExpr|
+            BOOT::|splitSayBrightly| BOOT::|pfTaggedTag|
+            BOOT::|brightPrintRightJustify| BOOT::|pfTagged?|
+            BOOT::|pfIfElse| BOOT::|splitSayBrightlyArgument|
+            BOOT::DATABASE-ABBREVIATION BOOT::|pfIfThen|
+            BOOT::|mkDomainConstructor| BOOT::|pfIfCond|
+            BOOT::|brightPrint1| BOOT::SET-FILE-GETTER BOOT::|mkList|
+            BOOT::|pfIf?| BOOT::|brightPrint| BOOT::|pf0TupleParts|
+            BOOT::|pfTuple?| BOOT::DATABASE-SOURCEFILE
+            BOOT::|minimalise| BOOT::|minimalise,min|
+            BOOT::|pfLiteral?| BOOT::|mkDevaluate|
+            BOOT::|minimalise,HashCheck| BOOT::|pfSymbolSymbol|
+            BOOT::|numberOfEmptySlots| BOOT::|pfSymbol?|
+            BOOT::|sayBrightlyLength1| BOOT::|hasOptArgs?|
+            BOOT::|npFromdom1| BOOT::|pfSuchThat2Sex|
+            BOOT::|CDRwithIncrement| BOOT::|npPush|
+            BOOT::|segmentedMsgPreprocess| BOOT::|pfOp2Sex|
+            BOOT::SHOWDATABASE BOOT::|pmDontQuote?| BOOT::|initCache|
+            BOOT::|blankIndicator| BOOT::|pfDefinitionRhs|
+            BOOT::|npEqKey| BOOT::|pf0DefinitionLhsItems|
+            BOOT::|pfApplicationArg| BOOT::SQUEEZE
+            BOOT::|rulePredicateTran| BOOT::|pfRuleRhs| BOOT::UNSQUEEZE
+            BOOT::|npDotted| BOOT::|pfRuleLhsItems|
+            BOOT::|constructor2ConstructorForm| BOOT::|npAngleBared|
+            BOOT::|pfCollectBody| BOOT::DATABASE-SPARE
+            BOOT::|pfCollectIterators| BOOT::|remHashEntriesWith0Count|
+            BOOT::|float2Sex| BOOT::DATABASE-DEFAULTDOMAIN
+            BOOT::|npListing| BOOT::|pfLiteralString|
+            BOOT::DATABASE-NILADIC BOOT::|pfLeafToken|
+            BOOT::DATABASE-CONSTRUCTORCATEGORY BOOT::|pfLiteralClass|
+            BOOT::DATABASE-OBJECT BOOT::DATABASE-MODEMAPS
+            BOOT::DATABASE-OPERATIONALIST BOOT::DATABASE-DEPENDENTS
+            BOOT::DATABASE-USERS BOOT::DATABASE-PARENTS BOOT::|tokPosn|
+            BOOT::|pileColumn| BOOT::|underDomainOf|
+            BOOT::DATABASE-PREDICATES BOOT::|underDomainOf;|
+            BOOT::|pileCforest| BOOT::DATABASE-ATTRIBUTES
+            BOOT::|enPile| BOOT::|separatePiles|
+            BOOT::DATABASE-DOCUMENTATION BOOT::|pilePlusComments|
+            BOOT::|pilePlusComment| BOOT::|insertpile|
+            BOOT::|lastTokPosn| BOOT::|firstTokPosn|
+            BOOT::|pileComment| BOOT::|isValidType;|
+            BOOT::|lnGlobalNum| BOOT::|lnLocalNum|
+            BOOT::|pfSourcePositionlist| BOOT::|isPartialMode|
+            BOOT::|pfSourcePositions|
+            BOOT::|makeOldAxiomDispatchDomain| BOOT::|lnString|
+            BOOT::DATABASE-ANCESTORS BOOT::|poNoPosition?|
+            BOOT::|poImmediate?| BOOT::|poIsPos?| BOOT::|hashString|
+            BOOT::DATABASE-CONSTRUCTOR BOOT::|pfPosn|
+            BOOT::|isLegitimateRecordOrTaggedUnion|
+            BOOT::|lnImmediate?| BOOT::|listOfDuplicates|
+            BOOT::|pfPosImmediate?| BOOT::|isPolynomialMode|
+            BOOT::|pfSourceToken| BOOT::|equiType| BOOT::|pfFirst|
+            BOOT::|getUnderModeOf| FOAM::PROCESS-IMPORT-ENTRY
+            BOOT::|deconstructT| BOOT::|attribute?| BOOT::TRARGPRINT
+            BOOT::|makeLazyOldAxiomDispatchDomain| BOOT::|eqType|
+            BOOT::DATABASE-P BOOT::LINE-ADVANCE-CHAR
+            BOOT::DATABASE-COSIG BOOT::LINE-AT-END-P BOOT::TRBLANKS
+            BOOT::MAKE-STRING-ADJUSTABLE BOOT::|sayMessage|
+            BOOT::|dropPrefix| BOOT::TRMETA1 BOOT::|mkDatabasePred|
+            BOOT::TRY-GET-TOKEN BOOT::TRMETA BOOT::|namestring|
+            BOOT::|isFreeFunctionFromMmCond| BOOT::|isSharpVarWithNum|
+            BOOT::|isFreeFunctionFromMm|
+            BOOT::|mkAlistOfExplicitCategoryOps| BOOT::LINE-P
+            BOOT::|mkAlistOfExplicitCategoryOps,atomizeOp|
+            BOOT::|flattenSignatureList| BOOT::|collectAndDeleteAssoc|
+            BOOT::|checkSplitBrace| BOOT::|getFirstArgTypeFromMm|
+            BOOT::|checkSplitPunctuation| BOOT::|checkSplitOn|
+            BOOT::|checkSplitBackslash| BOOT::STACK-POP
+            BOOT::|checkAlphabetic| BOOT::|isDomainSubst|
+            BOOT::UNDERSCORE BOOT::|collectComBlock|
+            BOOT::|getDomainFromMm| BOOT::/MDEF BOOT::STACK-TOP
+            BOOT::|formal2Pattern| BOOT::|finalizeDocumentation,hn|
+            BOOT::STACK-P BOOT::LINE-NEXT-CHAR BOOT::REDUCTION-RULE
+            BOOT::|checkExtractItemList|
+            BOOT::|recordHeaderDocumentation| BOOT::|checkIeEgfun|
+            BOOT::|appendOver| BOOT::|rebuild| BOOT::|checkInteger|
+            BOOT::|spool| BOOT::|setOutputCharacters|
+            BOOT::/VERSIONCHECK BOOT::INTERP-MAKE-DIRECTORY
+            BOOT::CACHEKEYEDMSG BOOT::XDR-STREAM-HANDLE
+            BOOT::|normalizeArgFileName| BOOT::|checkTrim,trim|
+            BOOT::XDR-STREAM-P BOOT::|checkDocError| BOOT::|bootFind|
+            BOOT::|checkTrim,wherePP| BOOT::|checkDecorateForHt|
+            BOOT::XDR-STREAM-NAME BOOT::|checkRecordHash|
+            BOOT::|checkIsValidType| BOOT::|normalizeTimeAndStringify|
+            BOOT::SETLETPRINTFLAG BOOT::|checkGetParse|
+            BOOT::|checkGetStringBeforeRightBrace|
+            BOOT::|checkGetLispFunctionName| BOOT::MAKE-DIRECTORY
+            BOOT::|checkLookForRightBrace|
+            BOOT::|checkLookForLeftBrace| BOOT::|checkFixCommonProblem|
+            BOOT::|checkArguments| BOOT::SHAREDITEMS BOOT::|checkTexht|
+            BOOT::|isVowel| BOOT::|getOfCategoryArgument|
+            BOOT::|checkAddPeriod| BOOT::|newMKINFILENAM|
+            BOOT::|getFunctionSourceFile1| BOOT::|checkDecorate|
+            BOOT::|pathname?| BOOT::|hasNoVowels| BOOT::|checkBalance|
+            BOOT::|checkSayBracket| BOOT::|pfSequence2Sex|
+            BOOT::|checkBeginEnd| BOOT::|pf2Sex1| BOOT::|checkIeEg|
+            BOOT::|pfSequence2Sex0| BOOT::|checkDocError1|
+            BOOT::|ruleLhsTran| BOOT::|patternVarsOf|
+            BOOT::|checkAddMacros| BOOT::|pfLambdaTran|
+            BOOT::|pfLambdaBody| BOOT::|checkSplit2Words|
+            BOOT::|pfLambdaRets| BOOT::|checkAddSpaces|
+            BOOT::|pfTypedType| BOOT::|newString2Words|
+            BOOT::|pfCollectArgTran| BOOT::|checkGetArgs|
+            BOOT::|pfTyped?| BOOT::|pfRhsRule2Sex|
+            BOOT::|pfLhsRule2Sex| BOOT::|checkDocMessage|
+            BOOT::|checkRemoveComments| BOOT::|pfRule2Sex|
+            BOOT::|checkTrimCommented| BOOT::|pfLambda2Sex|
+            BOOT::|pfDefinition2Sex| BOOT::|leftTrim|
+            BOOT::|pfCollect2Sex| BOOT::|checkGetMargin|
+            BOOT::|pfApplication2Sex| BOOT::|whoOwns|
+            BOOT::|pfLiteral2Sex| BOOT::|pfWhereExpr|
+            BOOT::|pf0WhereContext| BOOT::|pfIterate?|
+            BOOT::|pfReturnExpr| BOOT::|pfReturn?| BOOT::|setOutStream|
+            BOOT::|pfBreakFrom| BOOT::|pfBreak?| BOOT::|pfRule?|
+            BOOT::DATABASE-CONSTRUCTORMODEMAP BOOT::|%key| BOOT::|ppos|
+            BOOT::|porigin| BOOT::|pfLinePosn| BOOT::|pfCharPosn|
+            BOOT::|pfImmediate?| BOOT::|pfNoPosition?| BOOT::|%pos|
+            BOOT::|processPackage,setPackageCode| BOOT::|%fname|
+            BOOT::|pfname| BOOT::|%origin| BOOT::|mkRepititionAssoc|
+            BOOT::|%id| BOOT::|pkey| BOOT::|getCaps|
+            BOOT::|constructorCategory| BOOT::|evalDomain|
+            BOOT::|parseAtom| BOOT::|systemErrorHere|
+            BOOT::|coerceMap2E| BOOT::|parseConstruct|
+            BOOT::|parseTran,g| BOOT::|parseWhere| BOOT::|parseVCONS|
+            BOOT::|parseSeq| BOOT::|transSeq| BOOT::|postError|
+            BOOT::|parseSegment| BOOT::|parseReturn|
+            BOOT::|parsePretend| BOOT::|parseType| BOOT::|RecordInner|
+            BOOT::|parseTypeEvaluate| BOOT::|isRecord|
+            BOOT::|parseMDEF| BOOT::|parseLETD| BOOT::|parseLET|
+            BOOT::|transIs| BOOT::|CatEval| BOOT::|transUnCons|
+            BOOT::|parseLeave| BOOT::|mkCategory,Prepare|
+            BOOT::|parseJoin| BOOT::|parseJoin,fn| BOOT::|parseIsnt|
+            BOOT::|parseBigelt| BOOT::|parseIs|
+            BOOT::|DropImplementations| BOOT::|parseInBy|
+            BOOT::|parseIn| BOOT::|FindFundAncs| BOOT::|parseHas|
+            BOOT::|parseHas,mkand| BOOT::|TruthP| BOOT::|parseHas,fn|
+            BOOT::|parseExit| BOOT::|isCategory| BOOT::|parseDEF|
+            BOOT::|setDefOp| BOOT::|mkCategory,Prepare2|
+            BOOT::|transIs1| BOOT::|isListConstructor|
+            BOOT::|parseCategory| BOOT::|parseDropAssertions|
+            BOOT::|parseAtSign| BOOT::|parseHasRhs| BOOT::|parseCoerce|
+            BOOT::|getCategoryExtensionAlist0| BOOT::|parseColon|
+            BOOT::|getCategoryExtensionAlist| BOOT::|sayMSG|
+            BOOT::|parseDollarGreaterThan| BOOT::|squeeze1|
+            BOOT::|squeezeList| BOOT::|parseGreaterThan|
+            BOOT::|categoryParts,exportsOf|
+            BOOT::|makeSimplePredicateOrNil| BOOT::|simpHasPred,eval|
+            BOOT::|simpHasPred,simp| BOOT::|specialModeTran|
+            BOOT::|compressHashTable| BOOT::|simpOrUnion|
+            BOOT::|clearCategoryTable| BOOT::|transCategoryItem|
+            BOOT::|parseCases| BOOT::TOKEN-PRINT BOOT::|getConstrCat|
+            BOOT::LINE-CURRENT-SEGMENT
+            BOOT::|mkCategoryExtensionAlistBasic| BOOT::STACK-CLEAR
+            BOOT::|macrop| BOOT::|showCategoryTable|
+            BOOT::|clearTempCategoryTable| BOOT::TOKEN-P
+            BOOT::|addToCategoryTable|
+            BOOT::|simpHasPred,simpDevaluate|
+            BOOT::|mkCategoryExtensionAlist|
+            BOOT::|updateCategoryTableForCategory|
+            BOOT::|isFormalArgumentList| BOOT::|defaultingFunction|
+            BOOT::|getOperationAlistFromLisplib|
+            BOOT::|getConstructorAbbreviation|
+            BOOT::|predicateBitIndex| BOOT::|encodeCatform|
+            BOOT::|evalableConstructor2HtString,unquote|
+            BOOT::|orderByContainment| BOOT::|stripOutNonDollarPreds|
+            BOOT::|isHasDollarPred| BOOT::|transHasCode|
+            BOOT::|removeAttributePredicates| BOOT::|getCatAncestors|
+            BOOT::|makeCompactDirect1,fn| BOOT::|depthAssoc|
+            BOOT::|depthAssocList| BOOT::|fromHeading|
+            BOOT::|htAddHeading| BOOT::|infovec| BOOT::|dcData1|
+            BOOT::|dbDoesOneOpHaveParameters?| BOOT::|ppTemplate|
+            BOOT::|dbOuttran| BOOT::|bitsOf| BOOT::|mathform2HtString|
+            BOOT::|conname2StringList| BOOT::|dcData|
+            BOOT::|predicateBitIndexRemop| BOOT::|form2StringList|
+            BOOT::|dbConform| BOOT::|dbMapping2StringList|
+            BOOT::|htTab| BOOT::|orderBySubsumption| BOOT::|dcCats|
+            BOOT::|dcCats1| BOOT::|getLookupFun|
+            BOOT::|listOfCategoryEntries| BOOT::|niladicHack|
+            BOOT::|dbGatherDataImplementation,fn| BOOT::|NRTcatCompare|
+            BOOT::|dbGatherDataImplementation,gn| BOOT::|template|
+            BOOT::|dcAtts| BOOT::|dcSlots| BOOT::|dcOpTable|
+            BOOT::|getConstructorArgs| BOOT::|dbNewConname|
+            BOOT::|escapeString| BOOT::|nodeSize| BOOT::|fortexp0|
+            BOOT::|vectorSize| BOOT::|myLastAtom|
+            BOOT::|isDefaultPackageForm?| BOOT::|numberOfNodes|
+            BOOT::|dcOps| BOOT::|removeAttributePredicates,fn|
+            BOOT::|removeAttributePredicates,fnl|
+            BOOT::DATABASE-CONSTRUCTORFORM BOOT::|makeCompactDirect|
+            BOOT::|htSayTuple| BOOT::|dcPreds| BOOT::|htSayArgument|
+            BOOT::|makeDomainTemplate| BOOT::|hashTable2Alist|
+            BOOT::|stuffDomainSlots| BOOT::|getExportCategory|
+            BOOT::|koCatOps1| BOOT::|simplifyAttributeAlist|
+            BOOT::|hasPatternVar| BOOT::|dcAll|
+            BOOT::|findSubstitutionOrder?| BOOT::|isInstantiated|
+            BOOT::|modemap2SigConds| BOOT::|getSubstCandidates|
+            BOOT::|htSayExplicitExports|
+            BOOT::|fortFormatCharacterTypes| BOOT::|opPageFastPath|
+            BOOT::|fortFormatCharacterTypes,mkParameterList2|
+            BOOT::|exp2FortOptimizeCS1,popCsStacks|
+            BOOT::|kFormatSlotDomain,fn|
+            BOOT::|fortFormatTypes,unravel| BOOT::|formatSlotDomain|
+            BOOT::|getSubstSignature| BOOT::|getfortexp1|
+            BOOT::|fortran2Lines1| BOOT::|koOps,trim|
+            BOOT::|isPatternVar| BOOT::|dispfortexp1|
+            BOOT::|displayBreakIntoAnds| VMLISP::LIBRARY-FILE
+            VMLISP::GET-DIRECTORY-LIST VMLISP::PROBE-NAME
+            VMLISP::SPAD-FIXED-ARG VMLISP::LIBSTREAM-INDEXSTREAM
+            VMLISP::LIBSTREAM-INDEXTABLE VMLISP::LIBSTREAM-MODE
+            VMLISP::GETINDEXTABLE VMLISP::GET-INDEX-TABLE-FROM-STREAM
+            VMLISP::LIBSTREAM-P BOOT::|NRTassocIndexAdd|
+            BOOT::|optDeltaEntry,quoteSelector| BOOT::|NRToptimizeHas|
+            BOOT::|listOfBoundVars| BOOT::|slot1Filter,fn|
+            BOOT::|reverseCondlist| BOOT::|c05pbfSolve,fb|
+            BOOT::|genDeltaSig| BOOT::|c05pbfSolve,fa|
+            BOOT::|c05nbfSolve,fb|
+            BOOT::|NRTsubstDelta,replaceSlotTypes|
+            BOOT::|c05nbfSolve,fa| BOOT::|slot1Filter|
+            BOOT::|NRTsubstDelta| BOOT::|c06ebfSolve,f|
+            BOOT::|catList2catPackageList,fn| BOOT::|addConsDB|
+            BOOT::|changeDirectoryInSlot1,fn|
+            BOOT::|changeDirectoryInSlot1,sigloc|
+            BOOT::|NRTreplaceAllLocalReferences| BOOT::|mkSlot1sublis|
+            BOOT::|NRTputInLocalReferences| BOOT::|NRTputInHead|
+            BOOT::|NRTcheckVector| BOOT::|NRTmakeSlot1|
+            BOOT::|NRTisExported?| BOOT::|makePredicateBitVector|
+            BOOT::|catList2catPackageList| BOOT::|c06eafSolve,f|
+            BOOT::|NRTgetAddForm| BOOT::|c06frfSolve,h|
+            BOOT::|NRTaddInner| BOOT::|c06ekfSolve,f|
+            BOOT::|updateSlot1DataBase| BOOT::|genDeltaSpecialSig|
+            BOOT::|c06gbfSolve,f| BOOT::|newHasTest,evalCond|
+            BOOT::|c06fufSolve,hn| BOOT::|c06gcfSolve,f|
+            BOOT::|c06fufSolve,hm| BOOT::|c06fpfSolve,h|
+            BOOT::|c06fqfSolve,h| BOOT::|c06ecfSolve,f| BOOT:|length1?|
+            BOOT:|ListRemoveDuplicatesQ| BOOT:|ListNReverse|
+            BOOT::|d01gbfSolve,f| BOOT:|TableKeys|
+            BOOT::|ncParseAndInterpretString| BOOT::|pfPrintSrcLines|
+            BOOT::TERMINATOR VMLISP::MAKE-BVEC
+            BOOT::|exp2FortOptimizeCS| BOOT::|exp2FortOptimizeCS1|
+            BOOT::|expression2Fortran| BOOT::|fortranCleanUp|
+            BOOT::|exp2FortOptimize| BOOT::|fortPre| BOOT::|incRgen|
+            BOOT::|segment| BOOT::|exp2Fort1| FOAM:|printNewLine|
+            FOAM:|formatDFloat| FOAM:|formatSFloat| FOAM:|formatBInt|
+            BOOT::|npNull| FOAM:|formatSInt| BOOT::|isFloat|
+            BOOT::|fortExpSize| BOOT::|parseAndEval1|
+            BOOT::|printStats| BOOT::|mkParameterList|
+            BOOT::|unStackWarning| BOOT::|fortFormatIntrinsics|
+            BOOT::?M BOOT::|displayLines| BOOT::|?m| BOOT::|addCommas|
+            BOOT::|unErrorRef| BOOT::|fortran2Lines| BOOT::|uppretend|
+            BOOT::|typeOfType| BOOT::|checkLines| BOOT::|uptypeOf|
+            BOOT::|statement2Fortran| BOOT::|displayLines1|
+            BOOT::|upQUOTE| BOOT::|dispStatement|
+            BOOT::|makeCommonEnvironment,interLocalE| BOOT::|upSEQ|
+            BOOT::|mkMat| BOOT::|makeCommonEnvironment,interC|
+            BOOT::|fortSize,elen| BOOT::|quote2Wrapped|
+            BOOT::|deltaContour,eliminateDuplicatePropertyLists|
+            BOOT::|fortSize| BOOT::|checkType| BOOT::|interpOnlyREPEAT|
+            BOOT::|upREPEAT1| BOOT::|old2NewModemaps| BOOT::|upREPEAT0|
+            BOOT::|displayModemaps| BOOT::|uplocal|
+            BOOT::|fortFormatElseIf| BOOT::|upfree|
+            BOOT::|indentFortLevel| FOAM:|Halt| BOOT::|upREPEAT|
+            BOOT::|?modemaps| BOOT::|fortFormatIf| BOOT::|upDEF|
+            BOOT::|upreturn| BOOT::|uperror| BOOT::|what|
+            BOOT::?MODEMAPS BOOT::|whatSpad2Cmd| BOOT::|stackAndThrow|
+            BOOT::|makeCommonEnvironment,interE| BOOT::|constructor|
+            BOOT::|alqlGetParams| BOOT::|makeNonAtomic|
+            BOOT::|alqlGetOrigin| BOOT::|alqlGetKindString|
+            BOOT::|npboot| BOOT::|compAndTrace| VMLISP::SIMPLE-ARGLIST
+            BOOT::|string2BootTree| VMLISP::REMOVE-FLUIDS
+            BOOT::|f04qafSolve,f| BOOT::|getBrowseDatabase|
+            BOOT::|wrapSEQExit| BOOT::|compileSpadLispCmd|
+            BOOT::|incExitLevel| BOOT::ASEC BOOT::|mkErrorExpr,bracket|
+            BOOT::|displayProperties,sayFunctionDeps| BOOT::ACOT
+            BOOT::|displayMacro| VMLISP::QUOTESOF BOOT::|genDeltaEntry|
+            BOOT::|displayParserMacro| VMLISP::DEQUOTE
+            BOOT::|compilerMessage| BOOT::MANEXP
+            BOOT::|asharpConstructorName?| VMLISP::ISQUOTEDP
+            BOOT::|f04mcfSolve,gj| BOOT::|f04arfSolve,h| VMLISP::VARP
+            BOOT::|f04mcfSolve,fd| BOOT::|dbpHasDefaultCategory?|
+            BOOT::|stackMessage| BOOT::|dbAddChainDomain|
+            BOOT::|listOfIdentifiersIn| BOOT::|knownInfo|
+            BOOT::|outerProduct| BOOT::|f04jgfSolve,h|
+            BOOT::|helpSpad2Cmd| BOOT::|f04mcfSolve,fal|
+            BOOT::|sayAsManyPerLineAsPossible| BOOT::|extractHasArgs|
+            BOOT::|read| BOOT::|readSpad2Cmd| BOOT::|displayMacros|
+            BOOT::|warnLiteral| BOOT::|getConstructorModemap|
+            BOOT::GCOPY BOOT::|koAttrs,fn| BOOT::|displayOperations|
+            BOOT::|libConstructorSig| BOOT::|f04asfSolve,h|
+            BOOT::|libConstructorSig,fn| BOOT::|npProcessSynonym|
+            BOOT::|listOfSharpVars| BOOT::|compileAsharpLispCmd|
+            BOOT::|isAlmostSimple| BOOT::|libdbTrim|
+            BOOT::|isAlmostSimple,fn| BOOT::|isFunctor|
+            BOOT::|stripLisp| BOOT::|parentsOfForm|
+            BOOT::|isSideEffectFree| BOOT::|ltrace| BOOT::|dbMkForm|
+            BOOT::|trace| BOOT::|compileAsharpCmd| BOOT::MSORT
+            BOOT::|displayProplist,fn| BOOT::|removeEnv| BOOT::|load|
+            BOOT::|loadSpad2Cmd| BOOT::|dbReadLines| BOOT::?VALUE
+            BOOT::|help| BOOT::|?value| BOOT::|trimComments|
+            BOOT::|f04atfSolve,h| BOOT::|f04fafSolve,h|
+            BOOT::|spreadGlossText| BOOT::?PROPERTIES
+            BOOT::|asyExtractAbbreviation| BOOT::|getGlossLines|
+            BOOT::|?properties| BOOT::|asyTypeUnit|
+            BOOT::|getParentsForDomain| BOOT::|f04fafSolve,g|
+            BOOT::|prModemaps| BOOT::|asyTypeItem|
+            BOOT::|f04fafSolve,f| BOOT::|importFromFrame|
+            BOOT::|decExitLevel,removeExit0|
+            BOOT::|closeInterpreterFrame| BOOT::|f04mbfSolve,f|
+            BOOT::|tokTran| BOOT::?MODE BOOT::|parseSystemCmd|
+            BOOT::|?mode| BOOT::|dumbTokenize| BOOT::|edit|
+            BOOT::|editSpad2Cmd| BOOT::|getDefaultPackageClients|
+            BOOT::|displayOperationsFromLisplib| BOOT::|say2PerLine|
+            BOOT::|getArgumentConstructors,fn|
+            BOOT::|getArgumentConstructors,gn| BOOT::|display|
+            BOOT::|displaySpad2Cmd| BOOT::|frameEnvironment|
+            BOOT::|getArgumentConstructors| BOOT::|buildLibAttrs|
+            BOOT::|buildLibOps| BOOT::|splitIntoOptionBlocks|
+            BOOT::|writedb| BOOT::|getFirstWord| BOOT::|f07aefSolve,fp|
+            BOOT::|isSharpVar| BOOT::HAS_SHARP_VAR
+            BOOT::|dbHasExamplePage| BOOT::|isExistingFile|
+            BOOT::|mkHasArgsPred| BOOT::|lefts| BOOT::|findEqualFun|
+            BOOT::|dbFromConstructor?| BOOT::|f01mafSolve,f|
+            BOOT::|dbShowKind| BOOT::|unAbbreviateIfNecessary|
+            BOOT:|DeepCopy| BOOT::|evalDomainOpPred,convertCatArg|
+            BOOT::|dbOpsForm| BOOT::|form2Fence| BOOT::|devaluateList|
+            BOOT::|dbConstructorDoc,fn| FOAM:|fiStrHash|
+            BOOT::|dbGetInputString| BOOT::|pmTransFilter|
+            BOOT::|dbExtractUnderlyingDomain| FOAM:|fiGetDebugger|
+            BOOT::|isValidType| BOOT:|ByteFileReadLine| BOOT::RENAME
+            BOOT::|isExposedConstructor| FOAM:|fiSetDebugVar|
+            BOOT:|InputStream?| BOOT::|ncParseFromString|
+            BOOT:|OutputStream?| BOOT:|StreamSize|
+            BOOT:|StreamGetPosition| BOOT:|StreamEnd?|
+            BOOT:|StreamClose| BOOT::|dbConstructorDoc,gn|
+            BOOT::|digits2Names| BOOT::|dbCompositeWithMap|
+            BOOT::|extractFileNameFromPath| BOOT:|ToPathname|
+            BOOT::IDENT-CHAR-LIT BOOT::IS-CONSOLE-NOT-XEDIT
+            BOOT::|dbAddChain| BOOT::MESSAGEPRINT
+            BOOT:|PathnameDirectory| BOOT::MESSAGEPRINT-2
+            BOOT::|kFormatSlotDomain| BOOT:|PathnameName|
+            BOOT::MESSAGEPRINT-1 BOOT::|devaluate| BOOT:|PathnameType|
+            BOOT::|simpCatPredicate| BOOT:|PathnameString|
+            BOOT::|dbInfovec| BOOT:|PathnameAbsolute?|
+            BOOT:|PathnameWithoutType| BOOT::|getImports|
+            BOOT:|PathnameWithoutDirectory| BOOT::|saySpadMsg|
+            BOOT::|mkConArgSublis| BOOT:|PathnameToUsualCase|
+            BOOT:|PathnameDirectoryOfDirectoryPathname| BOOT::|sayTeX|
+            BOOT::|getUsersOfConstructor| BOOT:|Bit?| BOOT::EQUABLE
+            BOOT::|makeTemplate| BOOT::|dbShowConsKinds|
+            BOOT::|makeOpDirect| BOOT:|Vector?| BOOT::|bcConTable|
+            BOOT::|makeOpDirect,fn| BOOT::|mkUniquePred|
+            BOOT::PARTCODET BOOT::|bcAbbTable| BOOT::|putPredHash|
+            BOOT::|bcNameConTable| BOOT::|NRTinnerGetLocalIndex|
+            BOOT::|breakIntoLines| BOOT::|dbConstructorKind|
+            BOOT::BLANKP BOOT::|setLoadTimeQ| BOOT:|CharDigit?|
+            BOOT::|dbConstructorDoc,hn| BOOT::|setLoadTime|
+            BOOT::NONBLANKLOC BOOT::|extendVectorSize|
+            BOOT::|markUnique| BOOT:|Cset| BOOT::INDENT-POS
+            BOOT::|addConsDB,min| BOOT::NEXT-TAB-LOC
+            BOOT:|CsetComplement| BOOT::|measureCommon|
+            BOOT:|CsetString| BOOT::|getDependentsOfConstructor|
+            BOOT::|htMakeSaturnFilterPage| BOOT::|writeSaturnLines|
+            BOOT::|hasIdent| BOOT::|addConsDB,HashCheck|
+            BOOT::|parseNoMacroFromString| BOOT::|mapConsDB|
+            BOOT::|pf2Sex| BOOT::|squeezeConsDB| BOOT::|StreamNull|
+            BOOT::|squeezeConsDB,fn| BOOT::|mkBold| BOOT::|incString|
+            BOOT::|postSignature| BOOT::|killColons| BOOT:|ToString|
+            BOOT::|e02dffSolve,flam| BOOT::|removeSuperfluousMapping|
+            BOOT:|StringImage| BOOT::|dbShowConstructorLines|
+            BOOT:|String?| BOOT::|postAtom| BOOT::|dbName|
+            BOOT::|makeSpadConstant| BOOT::|postType|
+            BOOT::|childrenOf| BOOT::|htBcLispLinks|
+            BOOT::|typeCheckInputAreas| BOOT::|kisValidType|
+            BOOT::|kCheckArgumentNumbers| BOOT:|StringUpperCase|
+            BOOT:|StringLowerCase| BOOT::|topicCode|
+            BOOT::|htMakePage1| BOOT::|string2OpAlist|
+            BOOT::|htProcessDoitButton| BOOT::|blankLine?|
+            BOOT::|htProcessDoneButton| BOOT::|e02defSolve,fmu|
+            BOOT::|topics| BOOT::|htProcessBcButtons|
+            BOOT::|topLevelInterpEval| BOOT::|tdPrint|
+            BOOT::|htProcessToggleButtons|
+            BOOT::|htProcessDomainConditions|
+            BOOT::|getConstructorSignature| BOOT::|getDefaultProps|
+            BOOT::|htInputStrings| BOOT::GET-A-LINE
+            BOOT::|getConstructorDocumentation|
+            BOOT::|htBcRadioButtons| BOOT::KILL-COMMENTS
+            BOOT::|topicCode,fn| BOOT::|htRadioButtons|
+            BOOT::|listOfTopics| BOOT::|htLispMemoLinks|
+            BOOT::PRINT-RULE BOOT::|code2Classes| BOOT::SET-PREFIX
+            BOOT::PRINT-FLUIDS BOOT::|td| BOOT::|unabbrev|
+            BOOT::|prTriple| BOOT::|htEndMenu| BOOT::GET-META-TOKEN
+            BOOT::|hasNewInfoAlist| BOOT::|addTraceItem|
+            BOOT::GET-BSTRING-TOKEN BOOT::|untraceAllDomainLocalOps|
+            BOOT::|bright| BOOT::GET-STRING-TOKEN
+            BOOT::|formatUnabbreviated| BOOT::GET-IDENTIFIER-TOKEN
+            BOOT::BVEC-NOT BOOT::TOKEN-LOOKAHEAD-TYPE
+            BOOT::|orderBySlotNumber| BOOT::|traceSpad2Cmd|
+            BOOT::|compArgumentConditions| BOOT::|e02defSolve,flam|
+            BOOT::|trace1| BOOT::LINE-PRINT BOOT::|saveMapSig|
+            BOOT::LINE-PAST-END-P BOOT::|untrace|
+            BOOT::|stripOffArgumentConditions|
+            BOOT::DATABASE-CONSTRUCTORKIND BOOT::SPAD_ERROR_LOC
+            BOOT::|getTraceOptions| BOOT::|transTraceItem|
+            BOOT::BOOT-PARSE-1 BOOT::|genSearchTran|
+            BOOT::REDUCTION-VALUE BOOT::|removeSurroundingStars|
+            BOOT::|getTraceOption| BOOT::|checkFilter| BOOT::PREPARSE
+            BOOT::|getMapSubNames| BOOT::|getPreviousMapSubNames|
+            BOOT::|coerceSpadArgs2E| BOOT::|clear|
+            BOOT::|whatConstructors| BOOT::|stupidIsSpadFunction|
+            BOOT::|sayBrightlyLength| BOOT::|stackTraceOptionError|
+            BOOT::GET-BOOT-TOKEN BOOT::|reportOpsFromUnitDirectly|
+            BOOT::|coerceSpadFunValue2E| BOOT::|searchCount|
+            BOOT::GET-SPECIAL-TOKEN BOOT::|domainToGenvar|
+            BOOT::|searchDropUnexposedLines| BOOT::GET-SPADSTRING-TOKEN
+            BOOT::|compileAsharpArchiveCmd| BOOT::|genDomainTraceName|
+            BOOT::GET-NUMBER-TOKEN BOOT::GET-ARGUMENT-DESIGNATOR-TOKEN
+            BOOT::|spadReply,printName| BOOT::|abbreviations|
+            BOOT::|getTraceOption,hn| BOOT::BOOT-TOKEN-LOOKAHEAD-TYPE
+            BOOT::|changeToNamedInterpreterFrame|
+            BOOT::|removeTracedMapSigs| BOOT::|findFrameInRing|
+            BOOT::|isListOfIdentifiers| BOOT::|string2Constructor|
+            BOOT::|isListOfIdentifiersOrStrings| BOOT::|dbString2Words|
+            BOOT::|conLowerCaseConTran| BOOT::|emptyInterpreterFrame|
+            BOOT::|string2Words| BOOT::|whatCommands|
+            BOOT::BUMPERRORCOUNT BOOT::|commandsForUserLevel|
+            BOOT::MAKE-ADJUSTABLE-STRING BOOT::|dnForm| BOOT::|pp2Cols|
+            BOOT::|dnForm,negate| BOOT::|dbGetCommentOrigin|
+            BOOT::|whatSpad2Cmd,fixpat| BOOT::DEF-PROCESS
+            BOOT::|synonymsForUserLevel| BOOT::DEF-RENAME
+            BOOT::|postTransform|
+            BOOT::|processSynonymLine,removeKeyFromLine|
+            BOOT::|pmPreparse,hn| BOOT::|new2OldLisp|
+            BOOT::|processSynonymLine| BOOT::PRINT-PACKAGE
+            BOOT::|printSynonyms| BOOT::INITIALIZE-PREPARSE
+            BOOT::|clearParserMacro|
+            BOOT::|dbScreenForDefaultFunctions| BOOT::S-PROCESS
+            BOOT::|newHelpSpad2Cmd| BOOT::|dbChooseOperandName|
+            BOOT::|zsystemDevelopmentSpad2Cmd| BOOT::|parseFromString|
+            BOOT::|checkPmParse,fn| BOOT::|dbRead|
+            BOOT::|string2SpadTree| BOOT::|checkPmParse| SYSTEM:PNAME
+            BOOT::|htCopyProplist| BOOT::|pathnameTypeId|
+            BOOT::|capitalize| BOOT::|htSayValue|
+            BOOT::|clearCmdExcept| BOOT::|getSubstSigIfPossible|
+            BOOT::|workfilesSpad2Cmd| BOOT::|isIntegerString|
+            BOOT::|cd| BOOT::|dbGetExpandedOpAlist|
+            BOOT::|dbAddDocTable| BOOT::|zsystemdevelopment|
+            BOOT::|getConstructorForm| BOOT::|workfiles|
+            BOOT::|originsInOrder| BOOT::|getInfoAlist|
+            BOOT::|parentsOf| BOOT::|listOrVectorElementMode|
+            BOOT::|zeroOneConvertAlist| BOOT::|dbInfoSig|
+            BOOT::|numberize| BOOT::|hasNewInfoText|
+            BOOT::|splitConTable| BOOT::|dbGetDocTable,gn|
+            BOOT::|string2Integer| BOOT::|recordFrame|
+            BOOT::|issueHTSaturn| BOOT::|kTestPred|
+            BOOT::|segmentKeyedMsg| BOOT::|htpPageDescription|
+            BOOT::|dbDocTable| BOOT::|saturnTran| BOOT::|bcUnixTable|
+            BOOT::|mkTabularItem| BOOT::|printAsTeX|
+            BOOT::|isAsharpFileName?| BOOT::|isMenuItemStyle?|
+            BOOT::|saturnTranText| BOOT::|bcError|
+            BOOT::|transOnlyOption| BOOT::|kPageContextMenu|
+            BOOT::|bcString2WordList| BOOT::|unTab1|
+            BOOT::|shortenForPrinting| BOOT::|getBpiNameIfTracedMap|
+            BOOT::|recordAndPrintTest| BOOT::|mkTabularItem,fn|
+            BOOT::|PullAndExecuteSpadSystemCommand| BOOT::|htNewPage|
+            BOOT::|htpName| BOOT::|prTraceNames,fn|
+            BOOT::|htMakePageSaturn| BOOT::|e02zafSolve,flam|
+            BOOT::|isCapitalWord| BOOT::|zagSuper| BOOT::|height|
+            BOOT::|zagSub| BOOT::|inputPrompt|
+            BOOT::|flattenOperationAlist| BOOT::|variableNumber|
+            BOOT::|spadTrace,g| BOOT::|mkPredList,fn|
+            BOOT::|isTraceGensym| BOOT::|htPopSaturn|
+            BOOT::|htMakePageStandard| BOOT::|undo| BOOT::|dbKind|
+            BOOT::|undoCount| BOOT::|stringer| BOOT::|outputTranIf|
+            BOOT::|htInitPageNoHeading| BOOT::|undoLocalModemapHack|
+            BOOT::|saturnHasExamplePage| BOOT::|reportUndo| BOOT::|iht|
+            BOOT::|bcIssueHt| BOOT::|bcConform1| BOOT::|keyp|
+            BOOT::|bcConform1,hd| BOOT::|binomialWidth|
+            BOOT::|htSaySourceFile| BOOT::|basicStringize|
+            BOOT::|mapStringize| BOOT::|binomialSuper|
+            BOOT::|bcConform1,mapping|
+            BOOT::|outputTranMatrix,outtranRow|
+            BOOT::PLAIN-PRINT-FORMAT-STRING BOOT::|bcConform1,tuple|
+            BOOT::|binomialSub| BOOT::|vConcatWidth| BOOTTRAN::BOOTTOCL
+            BOOT::|bcConform1,tl| BOOT::|deMatrix| BOOT::TRANSLIST
+            BOOT::|sumWidthA| BOOT::TRANSLATE BOOT::|htSayItalics|
+            BOOT::|dbGetDocTable,hn| BOOT::|absym|
+            BOOT::|dbEvalableConstructor?| BOOT::|getCallBack|
+            BOOT::|texFormat1| BOOT::|unTab|
+            BOOT::RETRANSLATE-DIRECTORY BOOT::|kPageContextMenuSaturn|
+            BOOT::|maPrin| BOOT::RETRANSLATE-FILE-IF-NECESSARY
+            BOOT::|saturnExampleLink| BOOT::|explainLinear|
+            BOOT::RECOMPILE-ALL-LIBS BOOT::|htSayCold|
+            BOOT::RECOMPILE-LIB-DIRECTORY
+            BOOT::RECOMPILE-NRLIB-IF-NECESSARY BOOT::|writeSaturnTable|
+            BOOT::|maprinRows| BOOT::RECOMPILE-ALL-FILES
+            BOOT::|writeSaturn| BOOT::|maprinChk|
+            BOOT::|writeSaturnPrint| BOOT::RECOMPILE-ALL-ALGEBRA-FILES
+            BOOT::|bcConform1,say| BOOT::|escapeSpecialIds|
+            BOOT::|vConcatSub| BOOT::LOAD-DIRECTORY
+            BOOT::|postDoubleSharp| BOOT::|sumoverlist|
+            BOOT::|htProcessBcStrings| BOOT::|matSuperList|
+            BOOT::|superSubWidth| BOOT::CHAPTER-NAME BOOT::|isQuotient|
+            BOOT::|matSubList| BOOT::|superSubSuper|
+            BOOT::|isRationalNumber| BOOT::|matLSum|
+            BOOT::|superSubSub| BOOT::BLANKCHARP
+            BOOT::SPADTAGS-FROM-FILE BOOT::|matLSum2|
+            BOOT::OUR-WRITE-DATE BOOT::LIFT-NRLIB-NAME
+            BOOT::RECOMPILE-FILE-IF-NECESSARY BOOT::|suScWidth|
+            BOOT::|bcLinearSolveMatrixInhomo,f| BOOT::LIBCHECK
+            BOOT::|bcLinearExtractMatrix| BOOT::|printMap|
+            BOOT::|isInitialMap| BOOT::SPAD-CLEAR-INPUT
+            BOOT::|bcString2HyString|
+            BOOT::|NeedAtLeastOneFunctionInThisFile| BOOT::|pfSequence|
+            BOOT::|npPileBracketed| BOOT::|npAnyNo| BOOT::|bcOptional|
+            VMLISP::EQUABLE VMLISP::*LAM BOOT::|subSub| VMLISP::RCQEXP
+            BOOT::|flattenOps| BOOT::|npInfGeneric| BOOT::|slashWidth|
+            BOOT::|slashSuper| VMLISP::COMPILE1 BOOT::|slashSub|
+            BOOT::|pfPile| BOOT::|npParened| BOOT::BVEC-COPY
+            BOOT::|letWidth| VMLISP::FLAT-BV-LIST BOOT::|sortCarString|
+            BOOT::|pfAppend| VMLISP::PLIST2ALIST BOOT::|pfFix|
+            BOOT::|outputConstructTran| BOOT::|pfTyping|
+            BOOT::|outputTranSEQ| BOOT::|outputTranRepeat|
+            BOOT::|outputTranReduce| BOOT::|outputTranCollect|
+            BOOT::|outputMapTran| BOOT::|npSemiListing|
+            BOOT::|pfExport| BOOT::|pfLocal|
+            BOOT::|optSEQ,getRidOfTemps| BOOT::|optSPADCALL|
+            BOOT::|pfFree| BOOT::|optXLAMCond| BOOT::|optCONDtail|
+            BOOT::|optPredicateIfTrue| BOOT::|optCons| BOOT::|optSEQ|
+            BOOT::|pfBreak| BOOT::|optSEQ,tryToRemoveSEQ|
+            BOOT::|optSEQ,SEQToCOND| BOOT::|optimize,opt|
+            BOOT::|optCond| BOOT::|pfReturnNoName| BOOT::|optMkRecord|
+            BOOT::|npListAndRecover| BOOT::|optCatch| BOOT::|npTuple|
+            BOOT::|pf0SequenceArgs| BOOT::|compileTimeBindingOf|
+            BOOT::|optimizeFunctionDef,removeTopLevelCatch|
+            BOOT::|optEQ| BOOT::|optLESSP| BOOT::|pfIterate|
+            BOOT::|opt-| BOOT::|optQSMINUS| BOOT::|pfLoop1|
+            BOOT::|optMINUS| BOOT::|optSuchthat| BOOT::|optRECORDCOPY|
+            BOOT::|optSETRECORDELT| BOOT::|npParse|
+            BOOT::|timedEVALFUN| BOOT::|pfDocument|
+            BOOT::|updateTimedName| BOOT::|pfTweakIf|
+            BOOT::|timedOptimization| BOOT::|pfCheckItOut|
+            BOOT::|timedAlgebraEvaluation| BOOT::|pushTimedName|
+            BOOT::|significantStat| BOOT::|printNamedStats|
+            BOOT::|htpDestroyPage| BOOT::|splitIntoBlocksOf200|
+            BOOT::|incIgen| BOOT::|e02dafSolve,flam|
+            BOOT::|e04nafSolve,fe| BOOT::|str2Tex|
+            BOOT::|e04nafSolve,fd| BOOT::|wrap| BOOT::|e04nafSolve,fc|
+            BOOT::|e04ycfSolve,fa| BOOT::|str2Outform|
+            BOOT::|parse2Outform| BOOT::|e04nafSolve,fj|
+            BOOT::|e04nafSolve,fg| BOOT::|e04dgfSolve,fb|
+            BOOT::|e04mbfSolve,fg| BOOT::|evalLoopIter|
+            BOOT::|formatUnabbreviatedTuple| BOOT::|e04mbfSolve,fe|
+            BOOT::|length2?| BOOT::|Identity| BOOT::|upADEF|
+            BOOT::|bool| BOOT::|e04mbfSolve,fd| BOOT::|orderList|
+            BOOT::|e04mbfSolve,fc| BOOT::|upLoopIters| BOOT::NMSORT
+            BOOT::|pr| BOOT::|e04fdfSolve,fb| BOOT::|interpIter|
+            BOOT::|functionp| BOOT::|quoteCatOp| BOOT::|e04fdfSolve,fa|
+            BOOT::|isLetter| BOOT::|mkNestedElts| BOOT::|charRangeTest|
+            BOOT::|instantiate| BOOT::|isUpperCaseLetter|
+            BOOT::|e04gcfSolve,fb| BOOT::|flattenSexpr|
+            BOOT::|e04gcfSolve,fa| BOOT::|isStreamCollect|
+            BOOT::|removeZeroOneDestructively| BOOT::|StringToCompStr|
+            BOOT::|boolODDP| BOOT::|rightTrim|
+            BOOT::|dropLeadingBlanks| BOOT::|getDomainByteVector|
+            BOOT::|interpOnlyCOLLECT| BOOT::|e04jafSolve,fc|
+            BOOT::|upCOLLECT| BOOT::|upAlgExtension|
+            BOOT::|e04jafSolve,fb| BOOT::|eq2AlgExtension|
+            BOOT::|e04jafSolve,fa| BOOT::|clearCmdParts|
+            BOOT::|upCOLLECT0| BOOT::|loadLib| BOOT::|upCOLLECT1|
+            BOOT::|upand| BOOT::|upDeclare| BOOT:|pp|
+            BOOT::|f01rdfSolve,fz| BOOT::|mkZipCode| BOOT:ATOM2STRING
+            BOOT::|orderCatAnc| BOOT::|f01mcfSolve,g|
+            BOOT::|isOkInterpMode| BOOT::|f01mcfSolve,f|
+            BOOT::|mkAndApplyPredicates| BOOT:MATCH-STRING
+            BOOT::|upCOERCE| BOOT::|upStreamIters| BOOT::|upconstruct|
+            BOOT::|upTARGET| BOOT::|falseFun| BOOT::|upLET|
+            BOOT::|closeOldAxiomFunctor| BOOT::|f01refSolve,fz|
+            BOOT::|upLETWithPatternOnLhs| BOOT::|isTupleForm|
+            BOOT::|f01qefSolve,fz| BOOT::|e02zafSolve,fxy|
+            BOOT::|shoeStrings| BOOT::|removeConstruct| BOOT:|break|
+            BOOT::|shoeIntern| BOOT::|isLocalPred|
+            BOOT::|shoeInternFile| BOOT::|upequation|
+            BOOT::|SpadInterpretFile| BOOT::|intInterpretPform|
+            BOOT::|altSeteltable| BOOT::|packageTran|
+            BOOT::|isHomogeneous| BOOT::|zeroOneTran|
+            BOOT::|intProcessSynonyms| BOOT::|upbreak|
+            BOOT::|f01brfSolve,f| BOOT::|intnplisp| BOOT::|upDollar|
+            BOOT::|nplisp| BOOT::|setCurrentLine|
+            BOOT::|f01qdfSolve,fz| BOOT::|copyHack| BOOT::|copyHack,fn|
+            BOOT:ADJCURMAXINDEX BOOT::|upTuple| BOOT::|ncloopParse|
+            BOOT::|ncloopIncFileName| BOOT::|phBegin|
+            BOOT::|ncloopEscaped| BOOT::|upiterate| BOOT::|upIF|
+            BOOT::|upisnt| BOOT::|upisAndIsnt| BOOT::|phInterpret|
+            BOOT::|isHomogeneousArgs| BOOT:LASTATOM BOOT::|uphas|
+            BOOT::|phMacro| BOOT::|macroExpanded| BOOT::|upis|
+            BOOT::|ncConversationPhase,wrapup| BOOT:CONSOLEINPUTP
+            BOOT::|upwhere| BOOT::|serverReadLine|
+            BOOT::|ncloopPrintLines| BOOT::|mkLineList|
+            BOOT::|nonBlank| BOOT:|MakeSymbol| BOOT::|intloopEchoParse|
+            BOOT::|incBiteOff| BOOT::|SkipEnd?| BOOT::|incFileName|
+            BOOT::|Else?| BOOT::|Elseif?| BOOT::|If?|
+            BOOT::|inclmsgNoSuchFile| BOOT::|inclmsgPrematureFin|
+            BOOT::|incFileInput| BOOT::|Top?|
+            BOOT::|inclmsgPrematureEOF| BOOT::|SkipPart?|
+            BOOT::|KeepPart?| BOOT:COMP BOOT:GETGENSYM
+            BOOT::|incNConsoles| BOOT::|Skipping?| BOOT::|incClassify|
+            BOOT::EXPAND-TABS BOOT::|incCommand?| BOOT::|incRenumber|
+            BOOT::|incFile| BOOT::|incPos|
+            BOOT:|initializeSetVariables| BOOT::|inclmsgSay|
+            BOOT::|inclmsgConStill| BOOT::|incStringStream|
+            BOOT::|inclmsgConActive| BOOT:NUMOFNODES FOAM::TYPE2INIT
+            BOOT:TRANSPGVAR FOAM::FOAM-FUNCTION-INFO BOOT::|GetValue|
+            BOOT::|hasToInfo| FOAM::INSERT-TYPES BOOT::|formatPred|
+            BOOT::|chaseInferences,foo| BOOT::|liftCond|
+            FOAM::FOAMPROGINFOSTRUCT-P BOOT::|formatInfo|
+            BOOT:TOKEN-TYPE BOOT::|addInformation,info|
+            BOOT:|updateSourceFiles| BOOT::|infoToHas| BOOT::|addInfo|
+            BOOT::|formatPredParts| BOOT::|printInfo|
+            BOOT::|linearFormat| BOOT::|formatOperationAlistEntry|
+            BOOT::|formatIf| BOOT:MKQ BOOT::|linearFormatName|
+            BOOT::|dollarPercentTran| BOOT::|string2Float|
+            BOOT::|specialChar| BOOT:TOKEN-SYMBOL BOOT::|hashCode?|
+            BOOT::|formatArgList| BOOT::|listOfPredOfTypePatternIds|
+            BOOT::|script2String| BOOT::|form2Fence1|
+            BOOT::|replaceGoGetSlot| BOOT::|constructorName|
+            BOOT::|sayModemap| BOOT:ACTION BOOT::|opIsHasCat|
+            BOOT::|isNewWorldDomain| BOOT::|formCollect2String|
+            BOOT::|DNameToSExpr1| BOOT::|tuple2String|
+            BOOT::|DNameFixEnum| BOOT::|formJoin2String| BOOT:ASSOCLEFT
+            BOOT::|DNameToSExpr| BOOT:|sayALGEBRA|
+            BOOT::|CompStrToString| BOOT::|record2String|
+            FOAM-USER::|AXL-spitSInt| BOOT::|computedMode|
+            BOOT::|formWrapId| BOOT::|getIProplist|
+            BOOT::|isBinaryInfix| BOOT::|mkAtreeValueOf|
+            BOOT::|collectDefTypesAndPreds| BOOT::|formatSignature|
+            BOOT::|freeOfSharpVars| BOOT::|unVectorize|
+            BOOT::|formatSignature0| BOOT::|isInternalFunctionName|
+            BOOT::|objEnv| BOOT:NREVERSE0 BOOT::|formatMapping|
+            BOOT::|canRemoveIsDomain?| BOOT:|sayFORTRAN|
+            BOOT::|formIterator2String| BOOT:|IS_#GENVAR|
+            BOOT::|removeIsDomains| BOOT:LISTOFATOMS
+            BOOT::|formatAttribute| BOOT::|formTuple2String|
+            BOOT::|numOfSpadArguments| BOOT::|args2Tuple|
+            BOOT::|blankList| BOOT::|removeBodyFromEnv|
+            BOOT::|form2StringWithWhere| BOOT::|reportOpSymbol|
+            BOOT::|apropos| BOOT::|formatModemap,fn|
+            BOOT::|listOfVariables| BOOT::|isFreeVar|
+            BOOT::|isLocalVar| BOOT::|expr2String|
+            BOOT::|isInternalMapName| BOOT::|atom2String|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T *) *) VMLISP:MAKE-APPENDSTREAM
+            VMLISP:MAKE-INSTREAM VMLISP:MAKE-OUTSTREAM
+            VMLISP:COMPILE-LIB-FILE BOOT:|OsRunProgram|
+            BOOT:|OsRunProgramToStream| BOOT::ASHARP
+            FOAM:COMPILE-AS-FILE BOOT:|Prompt| BOOT:|sayBrightlyNT|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T T) (VALUES T T)) BOOT::|getScriptName|
+            FOAM:AXIOMXL-GLOBAL-NAME BOOT::|spadTraceAlias|)) 
+(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) VMLISP:MDEF)) 
+(PROCLAIM '(FTYPE (FUNCTION (T *) STRING) VMLISP:MAKE-FULL-CVEC)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T) *) BOOT::|bcInputMatrixByFormula|
+            BOOT::|bcInputExplicitMatrix| BOOT::|htStringPad|
+            BOOT::|evalAndRwriteLispForm| BOOT::|mkAtreeWithSrcPos|
+            BOOT::|rwriteLispForm| BOOT::COMPILE-DEFUN BOOT::|doIt|
+            BOOT::BPIUNTRACE VMLISP:QUOTIENT BOOT::|print|
+            BOOT::|compilerDoitWithScreenedLisplib|
+            BOOT::|compilerDoit| BOOT::MONITOR-PRINVALUE BOOT::/TRACE-2
+            VMLISP:|LAM,FILEACTQ| BOOT::|hasFormalMapVariable|
+            BOOT::|ScanOrPairVec| VMLISP:SUFFIX BOOT::PRINMATHOR0
+            BOOT::|spadTrace| BOOT::|output| BOOT::|e01bffDefaultSolve|
+            BOOT::|e01safDefaultSolve| BOOT::|popUpNamedHTPage|
+            BOOT::|e01dafDefaultSolve| BOOT::|replaceNamedHTPage|
+            BOOT::|e02bafDefaultSolve| BOOT::|e02bdfDefaultSolve|
+            BOOT::|e02defDefaultSolve| BOOT::|sockSendFloat|
+            BOOT::SOCK-SEND-SIGNAL BOOT::SOCK-SEND-FLOAT
+            BOOT::SOCK-SEND-STRING BOOT::SOCK-SEND-INT BOOT::ERASE
+            BOOT::|sayErrorly| BOOT::|saturnSayErrorly| BOOT::|set1|
+            BOOT::|displaySetOptionInformation| BOOT::|mkGrepPattern|
+            BOOT::|showDoc| BOOT::|genSearchSayJump| BOOT::|oPageFrom|
+            BOOT::|showConstruct| BOOT::|htCommandToInputLine,fn|
+            BOOT::|grepConstructorSearch| BOOT::|showNamedDoc|
+            BOOT::|form2HtString,fnTail| BOOT::|xdrWrite|
+            BOOT::|spleI1| BOOT::|readData,xdrRead1| BOOT::|xdrRead|
+            BOOT::|sockSendSignal| BOOT::|htpLabelFilteredInputString|
+            BOOT::|e01bgfDefaultSolve| BOOT::|e01befDefaultSolve|
+            BOOT::|e01bafDefaultSolve| BOOT::|htGlossSearch|
+            BOOT::|htSetSystemVariable| BOOT::|htSetSystemVariableKind|
+            BOOT::|htSetNotAvailable| BOOT::|htShowLiteralsPage|
+            BOOT::|htCheck| BOOT::|htShowIntegerPage|
+            BOOT::|htShowFunctionPage| BOOT::|htSetFunCommandContinue|
+            BOOT::|htKill| BOOT::|htFunctionSetLiteral|
+            BOOT::|htShowSetPage| BOOT::ADDCLOSE BOOT::|htSetLiteral|
+            BOOT:|LispCompileFileQuietlyToObject|
+            ; BOOT::|findStringInFile| 
+	    BOOT::|ppPair|
+            BOOT::|getMinimalVarMode| BOOT::|checkAddSpaceSegments|
+            BOOT::|checkAddIndented| BOOT::|alistSize,count|
+            BOOT::|dbConformGen1| BOOT::|pickitForm|
+            BOOT::|koaPageFilterByCategory1| VMLISP::COPY-FILE
+            VMLISP::COPY-LIB-DIRECTORY BOOT::|c06ebfDefaultSolve|
+            BOOT::|c06gsfDefaultSolve| BOOT::|c06eafDefaultSolve|
+            BOOT::|c06gbfDefaultSolve| BOOT::|c06gqfDefaultSolve|
+            BOOT::|c06ecfDefaultSolve| BOOT::|c06gcfDefaultSolve|
+            BOOT::|d01gafDefaultSolve| BOOT::|spadcall2|
+            BOOT::|sublisV| BOOT::|sublisV,suba| BOOT::|fortError|
+            BOOT::|f04adfDefaultSolve| BOOT::|f04arfDefaultSolve|
+            BOOT::|koPageFromKKPage| BOOT::|kArgPage| BOOT::|npsystem|
+            BOOT::|f04asfDefaultSolve|
+            BOOT::|handleParsedSystemCommands|
+            BOOT::|handleTokensizeSystemCommands|
+            BOOT::|f07fdfDefaultSolve| BOOT::|tokenSystemCommand|
+            BOOT::|reportOpsFromLisplib1| BOOT::|handleNoParseCommands|
+            BOOT::|f07aefDefaultSolve| BOOT::|f07fefDefaultSolve|
+            BOOT::|f07adfDefaultSolve| BOOT::|addPatchesToLongLines|
+            BOOT::|kArgumentCheck| BOOT::COERCE-FAILURE-MSG
+            BOOT::|kxPage| BOOT::|kcnPage| BOOT::SAYBRIGHTLYNT1
+            BOOT::|kcuPage| BOOT::|ksPage| BOOT::|conOpPage|
+            BOOT::|kcdoPage| BOOT::|kcdePage| BOOT::|kcdPage|
+            BOOT::|kccPage| BOOT::|patternCheck,subWild|
+            BOOT::|kcaPage| BOOT::|kcpPage| BOOT::|htDoneButton|
+            BOOT::|sockSendInt| BOOT::|kePage| BOOT::|sockSendString|
+            BOOT::|koaPageFilterByName| BOOT::|koaPageFilterByCategory|
+            BOOT::|koPageAux1| BOOT::|kcPage| BOOT::|getmode|
+            BOOT::|docSearch1| BOOT::|grepSearchQuery|
+            BOOT::|repeatSearch| BOOT::|reportOpsFromLisplib0|
+            BOOT::|reportOperations| BOOT::|generalSearchDo|
+            BOOT::|grepSearchJump| BOOT::|mkDetailedGrepPattern,conc|
+            BOOT::|kiPage| BOOT::|errorPage|
+            BOOT::|dbShowConsKindsFilter| BOOT::|koPage|
+            BOOT::|dbInfoChoose| BOOT::|kciPage|
+            BOOT::|dbInfoChooseSingle| BOOT::|dbSort| BOOT::|msgText|
+            BOOT::|bcSeriesByFormula| BOOT::|bcRealLimitGen1|
+            BOOT::|bcSeriesExpansion| BOOT::|ncloopInclude|
+            BOOT::|bcComplexLimit| BOOT::|bcRealLimit|
+            BOOT::|htFilterPage| BOOT::|bcPuiseuxSeries|
+            BOOT::KCL-OS-RUN-PROGRAM-TO-STREAM BOOT::|bcLaurentSeries|
+            BOOT::KCL-OS-RUN-PROGRAM BOOT::|bcTaylorSeries|
+            BOOT::|bcLinearSolveMatrix| BOOT::|bcMakeEquations|
+            BOOT::|bcMakeLinearEquations| BOOT::|bcLinearSolveEqns|
+            BOOT::|bcSolveSingle| BOOT::|bcInputEquations| BOOT::FC
+            BOOT::|bcSystemSolve| BOOT::|bcSolveEquationsNumerically|
+            BOOT::|bcSolveEquations| BOOT::|bcLinearSolve|
+            BOOT::|bcLinearMatrixGen|
+            BOOT::|bcLinearSolveMatrixInhomoGen|
+            BOOT::|bcLinearSolveMatrixInhomo|
+            BOOT::|bcLinearSolveMatrixHomo| BOOT::|finalExactRequest|
+            BOOT::|printMap1| BOOT::|htMkName|
+            BOOT::|makeLongSpaceString| BOOT::|makeLongTimeString|
+            BOOT::|nrtEval| BOOT::|f01mcfDefaultSolve|
+            BOOT::|f01rcfDefaultSolve| BOOT::|ncloopCommand|
+            BOOT::|ncloopInclude1| BOOT::|ncConversationPhase|
+            BOOT:DEFSTREAM BOOT::|inclHandleBug| BOOT::|evalSlotDomain|
+            BOOT::|ncEltQ| BOOT::|formArguments2String,fn|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T *) T) BOOT:|sayBrightly| BOOT:BLANKS
+            BOOT:MATCH-NEXT-TOKEN BOOT::|desiredMsg|
+            BOOT:|sayBrightlyI| BOOT:MATCH-CURRENT-TOKEN
+            VMLISP:RDEFIOSTREAM VMLISP:CATCHALL VMLISP:TAB
+            VMLISP:|F,PRINT-ONE| VMLISP:VMPRINT BOOT::FINDTAG
+            VMLISP:MAKE-HASHTABLE VMLISP:MAKE-FILENAME VMLISP:MACERR
+            VMLISP:PRETTYPRINT BOOT::|pfExpression| BOOT::|pfSymbol|
+            VMLISP:|LAM,EVALANDFILEACTQ| VMLISP:PRETTYPRIN0
+            BOOT::|pfSymb| VMLISP::MAKE-INPUT-FILENAME
+            BOOT:|LispReadFromString| BOOT::MONITOR-ADD BOOT::|cpCms|
+            VMLISP::MAKE-FULL-NAMESTRING BOOT:|PrettyPrint|
+            BOOT:|PlainPrintOn| BOOT:|WriteLispExpr| BOOT:|WriteLine|
+            BOOT:|WriteString| BOOT:|ReadLineIntoString|
+            BOOT:|ReadBytesIntoVector| BOOT:|Pathname|
+            BOOT:|FullVector| BOOT:|FullBvec| BOOT:|FullString|
+            BOOT::PRINT-NEW-LINE BOOT::PRINT-FULL
+            BOOT::GET-BOOT-IDENTIFIER-TOKEN BOOT::COMPSPADFILES)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION (T T) T) BOOT::|mkAliasList,fn| BOOT:PREDECESSOR
+            BOOT::|depthOfRecursion| BOOT::|formatJoinKey|
+            BOOT::|putBodyInEnv| BOOT::|mapDefsWithCorrectArgCount|
+            BOOT::|sayModemapWithNumber| BOOT::|addDefaults| BOOT:NLIST
+            BOOT::|formatOperation| BOOT::|get1defaultOp|
+            BOOT::|compileBody| BOOT::|makeLocalModemap| BOOT:NSTRCONC
+            BOOT::|saveDependentMapInfo| BOOT:GETRULEFUNLISTS
+            BOOT::|axFormatDecl| BOOT::|mkMapAlias| BOOT::|readData|
+            BOOT::|axFormatConstantOp| BOOT::|axFormatOpSig|
+            BOOT::|mkFormalArg| BOOT::|writeData| BOOT:POINT
+            BOOT::|mkValCheck| BOOT::|mkValueCheck| BOOT::|isPointer?|
+            BOOT::|wt| BOOT::|dqAppend| BOOT::|makePattern|
+            BOOT::|makeAxFile| BOOT::|clearDependencies|
+            BOOT::|getEqualSublis,fn| BOOT::|sourceFilesToAxFile|
+            BOOT::|getLocalVars| BOOT::|simplifyMapPattern|
+            BOOT::|getMapBody| BOOT:GETTAIL BOOT::|htpLabelInputString|
+            BOOT::|htpLabelSpadValue| BOOT::|putDependencies|
+            BOOT::STACK-PUSH BOOT:COMPARE BOOT::|htMakeDoneButton|
+            BOOT::|putDependencies,removeObsoleteDependencies|
+            BOOT::|makeNewDependencies| BOOT::|PARSE-Operation|
+            BOOT::|htInitPage| BOOT::|notCalled| BOOT::|htpProperty|
+            BOOT::|containsOp| BOOT::|makeRuleForm|
+            BOOT::|nonRecursivePart| BOOT::|outputFormat|
+            BOOT::|sayDroppingFunctions| BOOT::|nonRecursivePart1|
+            BOOT::|expandRecursiveBody| BOOT::|addDefMap|
+            BOOT::|e04nafSolve,fh| BOOT:FLAG BOOT::|ifCond|
+            BOOT::|incCommandTail| BOOT::|incTrunc| BOOT::|dollarTran|
+            BOOT:PAIR BOOT::CHAR-EQ BOOT::|PARSE-rightBindingPowerOf|
+            BOOT::|e04nafSolve,fi| BOOT:SUBLISNQ
+            BOOT::|writeInputLines| BOOT::|rempropI| BOOT:DELASC
+            BOOT::|showInput| BOOT::|showInOut| BOOT::SPADRREAD
+            BOOT:LASSOC BOOT::|ScanOrPairVec,ScanOrInner| BOOT::|getI|
+            BOOT::|mergeSignatureAndLocalVarAlists| BOOT::CHAR-NE
+            BOOT:S+ BOOT::|convertOpAlist2compilerInfo,formatSig|
+            BOOT::|getLisplibNoCache| BOOT::|getLisplib|
+            BOOT::|PARSE-leftBindingPowerOf| BOOT:MAKE-PARSE-FUNCTION
+            BOOT::|spadPrint| BOOT::|getSlotFromCategoryForm|
+            BOOT::|systemDependentMkAutoload| BOOT:MKPF
+            BOOT::|mkAutoLoad| BOOT:STRM BOOT::|wordFrom|
+            FOAM::|magicEq1| BOOT::|throwKeyedMsg1|
+            BOOT::|saturnThrowKeyedMsg| BOOT::|center|
+            BOOT::|substituteCategoryArguments|
+            BOOT::|isDomainConstructorForm| BOOT::|keyedSystemError1|
+            BOOT::|orderByDependency| BOOT::|saturnKeyedSystemError|
+            BOOT::|getFunctorOpsAndAtts| BOOT::|breakKeyedMsg|
+            BOOT::|fastSearchCurrentEnv| BOOT::|putMode|
+            BOOT::|splitListOn| BOOT::|putFlag|
+            BOOT::|mkAtreeNodeWithSrcPos| BOOT::|getMsgCatAttr|
+            BOOT::|DomainSubstitutionFunction|
+            BOOT::|transferSrcPosInfo| BOOT::|isNestedInstantiation|
+            BOOT::|DomainSubstitutionFunction,Subst|
+            BOOT::|mkAtree1WithSrcPos| BOOT::|wrapDomainSub|
+            BOOT::|listInitialSegment| BOOT::|compCategoryItem|
+            BOOT::|writeLib|
+            BOOT::|makeFunctorArgumentParameters,findExtrasP|
+            BOOT::|loadLibIfNecessary| BOOT::|rep|
+            BOOT::|collectDefTypesAndPreds,addPred|
+            BOOT::|setMsgPrefix| BOOT::|setMsgCatlessAttr|
+            BOOT::|getSignatureFromMode|
+            BOOT::|makeFunctorArgumentParameters,findExtras|
+            BOOT::|makeFunctorArgumentParameters,findExtras1|
+            BOOT::|autoLoad| BOOT::|isMacro| BOOT::|readLib|
+            BOOT::|getValueFromEnvironment|
+            BOOT::|unloadOneConstructor|
+            BOOT::|compileCases,FindNamesFor| BOOT::|asTupleNewCode|
+            BOOT::|macroExpandList| BOOT::|setMsgForcedAttrList|
+            BOOT::|macSubstituteId| BOOT::|atree2Tree1|
+            BOOT::|compileCases,isEltArgumentIn|
+            BOOT::|makeFunctorArgumentParameters,augmentSig|
+            BOOT::|mkAtree3,fn| BOOT::|macroExpandInPlace|
+            BOOT::|getErFromDbL| BOOT::|compJoin,getParms|
+            BOOT::|pfMapParts| BOOT::|erMsgCompare|
+            BOOT::|compareposns| BOOT::|pfCopyWithPos|
+            BOOT::|mkCategoryPackage,fn| BOOT::|getArgumentMode|
+            BOOT:REMFLAG BOOT::|listDecideHowMuch|
+            BOOT::|throwEvalTypeMsg| BOOT::|splitEncodedFunctionName|
+            BOOT:QLASSQ BOOT::|decideHowMuch| BOOT::|getArgValue1|
+            BOOT::|setMsgText| BOOT::|setMsgUnforcedAttrList|
+            BOOT::|genDomainViewList0| BOOT::|macLambda,mac|
+            BOOT::|macWhere,mac|
+            BOOT::|makeFunctorArgumentParameters,fn|
+            BOOT::|canCacheLocalDomain|
+            BOOT::|makeCategoryPredicates,fn|
+            BOOT::|makeCategoryPredicates,fnl|
+            BOOT::|getArgValueOrThrow| BOOT::|mac0SubstituteOuter|
+            BOOT::|insertPos| BOOT::|macLambdaParameterHandling|
+            BOOT::|genDomainViewName| BOOT::|isKeyQualityP|
+            BOOT::|queueUpErrors| BOOT::|thisPosIsEqual|
+            BOOT::|getOpArgTypes1| BOOT::|redundant|
+            BOOT::|argCouldBelongToSubdomain| BOOT::|thisPosIsLess|
+            BOOT::APPEND-N BOOT::|putFTText| BOOT::CONS-N
+            BOOT::|getModemap| BOOT::|sameMsg?| BOOT::EVAL-DEFUN
+            BOOT::|mkOpVec| BOOT::|resolveTCat|
+            BOOT::PRINT-AND-EVAL-DEFUN BOOT::|AssocBarGensym|
+            BOOT::|FromTo| BOOT::|compareMode2Arg|
+            BOOT::|c02affSolve,f| BOOT::|subCopy|
+            BOOT::|getOpArgTypes,f| BOOT::|isTowerWithSubdomain|
+            BOOT::|addEmptyCapsuleIfNecessary| BOOT::|constructM|
+            BOOT:|delete| BOOT::|c02agfSolve,f| BOOT::|bootStrapError|
+            BOOT::|getOpArgTypes| BOOT::|dqAddAppend| BOOT::|tracelet|
+            BOOT::/UNTRACE-2 BOOT:|rassoc| BOOT::|resolveTM1|
+            BOOT::|matchMmSigTar| BOOT::/UNTRACE-1 BOOT::|deepSubCopy|
+            BOOT::|CONTAINEDisDomain| BOOT::|hasCatExpression|
+            BOOT::PAIRTRACE BOOT::|spadUntrace| BOOT:LENGTHENVEC
+            BOOT::|defaultTypeForCategory| BOOT::DEF-IT BOOT:|breaklet|
+            BOOT::|mmCatComp| BOOT::|mergeSubs| BOOT::DEF-LET
+            BOOT::|hasCaty1| BOOT:STRINGPAD BOOT::|mkObjWrap|
+            BOOT:TRUNCLIST BOOT::|position1| BOOT::DEF-IS2
+            BOOT::|defLET| BOOT::|defLETdcq|
+            BOOT::|sortAndReorderDmpExponents| BOOT::WHDEF
+            BOOT::|removeListElt| BOOT::|everyNth| BOOT::LET_ERROR
+            BOOT::|defIS| BOOT::DEF-IS-REV VMLISP:SETDIFFERENCE
+            BOOT::DEF-SELECT2 BOOT::DEF-SELECT1 BOOT::|addInformation|
+            BOOT::|varIsOnlyVarInPoly| BOOT::|makeCategoryPredicates|
+            BOOT::|compDefWhereClause,addSuchthat| VMLISP:DIVIDE
+            BOOT::NOTEQUALLIBS VMLISP:GETL BOOT::|modemapPattern|
+            BOOT::|removeVectorElt| BOOT::GETALIST
+            BOOT::|buildDatabase| BOOT::|mathPrint1|
+            BOOT::|getInverseEnvironment| BOOT::|getSuccessEnvironment|
+            BOOT::|getSystemModemaps| BOOT::|insertWOC|
+            BOOT::|getModemapsFromDatabase| BOOT::|removeCoreModemaps|
+            BOOT::|SubstWhileDesizing| BOOT::|resolveTTUnion|
+            BOOT::|resolveTTEq| BOOT::|rightBindingPowerOf|
+            BOOT::/GETOPTION BOOT::|resolveTTCC|
+            BOOT::|leftBindingPowerOf| BOOT::|stackSemanticError|
+            BOOT::/GETTRACEOPTIONS BOOT::|resolveTTRed|
+            BOOT::/TRACELET-PRINT BOOT::|resolveTTSpecial|
+            BOOT::MONITOR-PRINT BOOT::|compareTT| BOOT::|opWidth|
+            BOOT::|isConstantId| BOOT::|acceptableTypesToResolve|
+            BOOT::|resolveTCat1| BOOT::|getConditionsForCategoryOnType|
+            BOOT::|resolveTTAny| BOOT::|resolveTMOrCroak|
+            BOOT::|outputMapTran0| BOOT::|spliceTypeListForEmptyMode|
+            BOOT::MONITOR-EVALTRAN BOOT::|constructTowerT|
+            BOOT::|throwKeyedMsg| BOOT::|canCoerceExplicit2Mapping|
+            BOOT::|term1RWall| BOOT::|absolutelyCannotCoerce|
+            BOOT::|rassocSub| BOOT::|coerceOrConvertOrRetract|
+            VMLISP:NCONC2 BOOT::|term1RW| BOOT::|coerceOrRetract|
+            BOOT::|resolveTMTaggedUnion| BOOT::|canCoerceUnion|
+            BOOT::|acceptableTypesToResolve1| BOOT::|canCoercePermute|
+            BOOT::|computeTTTranspositions| BOOT::|resolveTM2|
+            BOOT::|newCanCoerceCommute| BOOT::|coerceIntCommute|
+            BOOT::|resolveTMRed| BOOT::|coerceInt1| BOOT::|pmatch|
+            BOOT::/TRACE-1 BOOT::|resolveTMEq| BOOT::|getUnionMode|
+            BOOT::|resolveTMEq1| BOOT::|isUnionMode|
+            BOOT::|coerceInt2Union| BOOT::|resolveTMSpecial|
+            BOOT::|coerceIntFromUnion| VMLISP:REMAINDER
+            BOOT::|resolveTMRecord| BOOT::|resolveTMUnion|
+            BOOT::|isFunction| BOOT::|coerceIntAlgebraicConstant|
+            BOOT::|coerceIntTower| BOOT::|coerceRetract|
+            BOOT::|compareTypeLists| BOOT::|modifyModeStack|
+            BOOT::|replaceSymbols| BOOT::|coerceIntTableOrFunction|
+            BOOT::|isDomainForm| BOOT::|coerceIntSpecial|
+            BOOT::/TRACELET-2 BOOT::|SubstWhileDesizingList|
+            BOOT::|coerceIntPermute| BOOT::|getProplist|
+            BOOT::|coerceBranch2Union| BOOT::ASSOCIATER
+            BOOT::/TRACELET-1 BOOT::|retractByFunction|
+            BOOT::|constructT| BOOT::MONITOR-PRINARGS-1
+            BOOT::|outputComp| VMLISP:GGREATERP BOOT::|isDomainInScope|
+            BOOT::|canConvertByFunction| VMLISP:CGREATERP
+            BOOT::|canCoerceLocal| BOOT::|maxSuperType|
+            BOOT::|canCoerceTower| BOOT::/UPDATE-1 BOOT::|coerceInt0|
+            BOOT::|objSetMode| VMLISP:SORTBY BOOT::MONITOR-GETVALUE
+            VMLISP:|member| BOOT::MONITOR-EVALTRAN1
+            BOOT::|coerceIntByMapInner| BOOT::|getConstantFromDomain|
+            BOOT::|valueArgsEqual?| BOOT::|traceDomainConstructor|
+            BOOT::|coerceIntByMap| BOOT::|equalZero|
+            BOOT::|replaceLast| BOOT::|coerceIntTest| VMLISP:ADDOPTIONS
+            BOOT::|isSubTowerOf| BOOT::|starstarcond| BOOT::|equalOne|
+            VMLISP:|assoc| VMLISP:SETSIZE BOOT::|evalSharpOne|
+            VMLISP:EFFACE BOOT::|canCoerceCommute|
+            BOOT::|clearDependentMaps| BOOT::|constantInDomain?|
+            VMLISP:EMBED BOOT::|translateMpVars2PVars|
+            VMLISP:LEXGREATERP VMLISP:RPLPAIR
+            BOOT::|addDmpLikeTermsAsTarget| VMLISP:HPUT*
+            BOOT::|genMpFromDmpTerm| VMLISP:STRING2ID-N
+            BOOT::|htMakeTemplates,substLabel| BOOT::|doDoitButton|
+            VMLISP:$FINDFILE BOOT::|keyedMsgCompFailure| BOOT::|objNew|
+            BOOT::|putValue| BOOT::|getAtree| BOOT::|putModeSet|
+            VMLISP:$SHOWLINE VMLISP:RDROPITEMS BOOT::|bottomUpType|
+            BOOT::|bottomUpIdentifier| BOOT::|transferPropsToNode|
+            BOOT::|getArgValue| BOOT::|bottomUpCompilePredicate|
+            BOOT::|bottomUpPredicate| BOOT::|putTarget|
+            BOOT::|getMinimalVariableTower|
+            BOOT::|computeTypeWithVariablesTarget|
+            BOOT::|removeUnionsAtStart| BOOT::|pushDownOp?|
+            BOOT::|e02gafSolve,fc| BOOT::|e02gafSolve,fr|
+            BOOT::|sayIntelligentMessageAboutOpAvailability|
+            BOOT::|getBasicMode0| BOOT::|mkObjCode|
+            BOOT::|intCodeGenCOERCE| BOOT::|canCoerceByMap|
+            BOOT::|canCoerceByFunction| BOOT::|isSubDomain|
+            BOOT::|absolutelyCanCoerceByCheating|
+            BOOT::|e04ucfSolve,fa| BOOT::|coerceCommuteTest|
+            BOOT::|asyGetAbbrevFromComments,fn| BOOT::|asySplit|
+            BOOT::|asyWrap| BOOT::GETDATABASE
+            BOOT::|asyAbbreviation,chk| BOOT::|asyTypeJoinPart|
+            BOOT::|setVector4part3| BOOT::|sublisProp|
+            BOOT::|setVector12,freeof| BOOT::|setVector4Onecat,form|
+            BOOT::|asyDisplay| BOOT::ERROR-FORMAT
+            BOOT::|asyAbbreviation| BOOT::|asyCattranConstructors|
+            BOOT::|DomainPrint| BOOT::|makeSF| BOOT::|asySimpPred|
+            BOOT::|setVector0| BOOT::|setVector3| BOOT::DIVIDE2
+            BOOT::QUOTIENT2 BOOT::|htpSetName| BOOT::|sort|
+            BOOT::|defLET2| BOOT::|defLetForm| BOOT::|asyMapping|
+            BOOT::|defIS1| BOOT::|asySig| BOOT::|defISReverse|
+            BOOT::|addCARorCDR| BOOT::|defLET1|
+            BOOT::|asyExportAlist,fn| BOOT::|displayDatabase,fn|
+            BOOT::|quickAnd| BOOT::|asyCattranSig| BOOT::|asySigTarget|
+            BOOT::|asyMkSignature| BOOT::|asCategoryParts,build|
+            BOOT::/COMPINTERP BOOT::|unabbrevRecordComponent|
+            BOOT::|unabbrev1| BOOT::|makeByteWordVec2|
+            BOOT::|condAbbrev| BOOT::|unabbrevUnionComponent|
+            BOOT::|constructorNameConflict| BOOT::SPAD-PRINTTIME
+            BOOT::|htpLabelType| BOOT::|errorSupervisor|
+            BOOT::|sayErrorly1| BOOT::INTEGER-BIT BOOT::|chebeval|
+            BOOT::|rPsi| BOOT::|cpsireflect| BOOT::|cPsi|
+            BOOT::|BesselJRecur| BOOT::|substFromAlist|
+            BOOT::|BesselJAsymptOrder| BOOT::|BesselJAsympt|
+            BOOT::|PsiXotic| BOOT::|f01| BOOT::|brutef01|
+            BOOT::RBESSELJ BOOT::CPSI BOOT::RPSI BOOT::CHYPER0F1
+            BOOT::CBESSELI BOOT::RBESSELI BOOT::CBESSELJ
+            BOOT::|formatLazyDomainForm| BOOT::|formatLazyDomain|
+            BOOT::|getDomainSigs1| BOOT::|showDomainsOp1|
+            BOOT::|devaluateSlotDomain| BOOT::|getDomainRefName|
+            BOOT::|andDnf| BOOT::|ordUnion| BOOT::|coafAndDnf|
+            BOOT::|orDel| BOOT::|orDnf| BOOT::|dnfContains,fn|
+            BOOT::|andReduce| BOOT::|simpBoolGiven| BOOT::|dnfContains|
+            BOOT::|coafAndCoaf| BOOT::|ordIntersection|
+            BOOT::|ordSetDiff| BOOT::|coafOrDnf| BOOT::|predCircular|
+            BOOT::|clearAllSlams,fn| BOOT::|assocCircular|
+            BOOT::|recurrenceError| BOOT::|countCircularAlist|
+            BOOT::|displaySetVariableSettings| BOOT::|sayCacheCount|
+            BOOT::|chebstareval| BOOT::|BesselIAsymptOrder|
+            BOOT::|horner| BOOT::|BesselKAsymptOrder| BOOT::|cbeta|
+            BOOT::|PsiAsymptotic| BOOT::|PsiEps| BOOT::|FloatError|
+            BOOT::|cgammaG| BOOT::|besselIback| BOOT::|rPsiW|
+            BOOT::|firstNonDelim| BOOT::|chebf01| BOOT::|BesselJ|
+            BOOT::|BesselI| BOOT::|grepSplit| BOOT::|grepConstruct1|
+            BOOT::|grepConstructDo| BOOT::|mkGrepPattern1,h|
+            BOOT::|pfCoerceto| BOOT::|stripOffSegments|
+            BOOT::|pfFromdom| BOOT::|pfRetractTo| BOOT::|pfRestrict|
+            BOOT::|mkGrepPattern1,split| BOOT::|testInput2Output|
+            BOOT::|hyperize| BOOT::|testPrin| BOOT::|grepCombine|
+            BOOT::|subMatch| BOOT::|bcAbb| BOOT::|lfrinteger|
+            BOOT::|getFortranType| BOOT::|wl| BOOT::|scanIgnoreLine|
+            BOOT::|makeVector| BOOT::|htPred2English,fn| BOOT::|posend|
+            BOOT::|functionAndJacobian,DF| BOOT::|isString?|
+            BOOT::|bcOpTable| BOOT::|xdrOpen| BOOT::|scanExponent|
+            BOOT::|scanCheckRadix| BOOT::|coerceUn2E|
+            BOOT::|inFirstNotSecond| BOOT::|coerceVal2E|
+            BOOT::|EnumPrint| BOOT::|scanInsert| VMLISP::WRAP
+            BOOT::|RecordPrint| BOOT::|coerceRe2E|
+            BOOT::|syIgnoredFromTo| BOOT::|sySpecificErrorHere|
+            BOOT::|pfTree| BOOT::|makeList|
+            BOOT::|setVector4Onecat,Supplementaries| BOOT::|pfSuch|
+            BOOT::|compCategories1| BOOT::|pfParen| BOOT::|pfPretend|
+            BOOT::|pfComDefinition| BOOT::|pfMLambda|
+            BOOT::|resolvePatternVars| BOOT::|cons5|
+            BOOT::|makeMissingFunctionEntry| BOOT::|pfHide|
+            BOOT::|setVector5| BOOT::|d02kefSolve,fd|
+            BOOT::|mkVectorWithDeferral| BOOT::|d02kefSolve,fe|
+            BOOT::|d02gbfSolve,ff| BOOT::|pfBracketBar|
+            BOOT::|d02gbfSolve,fg| BOOT::|pfIdPos| BOOT::|ProcessCond|
+            BOOT::|DescendCodeAdd| BOOT::|LookUpSigSlots|
+            BOOT::|DomainPrintSubst| BOOT::|d02gbfSolve,fc|
+            BOOT::|partPessimise| BOOT::|d02gbfSolve,fd|
+            BOOT::|pfBraceBar| BOOT::|sublisProp,inspect|
+            BOOT::|pfTagged| BOOT::|HasCategory| BOOT::|d02gbfSolve,fa|
+            BOOT::|HasSignature| BOOT::|d02gbfSolve,fb|
+            BOOT::|HasAttribute| BOOT::|pfWDeclare|
+            BOOT::|InvestigateConditions,Conds| BOOT::|pfBracket|
+            BOOT::|pfDWhere| BOOT::|NewbFVectorCopy|
+            BOOT::|DescendCodeVarAdd| BOOT::|getDomainView|
+            BOOT::|pfBrace| BOOT::|d02gafSolve,fe|
+            BOOT::|d02gafSolve,fc| BOOT::|pfOr| BOOT::|pfAnd|
+            BOOT::|d03edfSolve,fb| BOOT::|pfTLam|
+            BOOT::|stringChar2Integer| BOOT::|reshape|
+            BOOT::|e01dafSolve,h| BOOT::|hashCombine|
+            BOOT::|e01dafSolve,k| BOOT::|hashType| VMLISP:$REPLACE
+            VMLISP:UNIONQ BOOT::|spadSysBranch|
+            BOOT::|htSystemVariables,gn| BOOT::|postFlatten|
+            BOOT::|gatherGlossLines| VMLISP:|intersection|
+            BOOT::|postFlattenLeft| BOOT::|postTranSegment|
+            VMLISP:DEFINE-FUNCTION BOOT::SEGMENT BOOT::|pfTyped|
+            BOOT::|postScriptsForm| BOOT::|htCheckList|
+            BOOT::|htSetvarDoneButton| BOOT::|htMakePathKey,fn|
+            BOOT::|npLeftAssoc| VMLISP:SETDIFFERENCEQ
+            BOOT::|htMarkTree| BOOT::|pfCollect| BOOT::|pfQualType|
+            BOOT::|deltaContour| BOOT::ADD-PARENS-AND-SEMIS-TO-LINE
+            BOOT::|getUniqueSignature| VMLISP:INTERSECTIONQ
+            BOOT::|AMFCR,redefinedList| BOOT::|putDomainsInScope|
+            BOOT::INITIAL-SUBSTRING BOOT::|compFormMatch,match|
+            BOOT::STOREBLANKS BOOT::|compFormMatch| BOOT::ESCAPED
+            BOOT::PARSEPILES BOOT::|addNewDomain| BOOT::|htDoNothing|
+            BOOT::|AMFCR,redefined| BOOT::|domainMember|
+            BOOT::|e04ycfSolve,fb| BOOT::MONITOR-WRITE
+            BOOT::|htpSetDomainPvarSubstList| BOOT::|coerceByModemap|
+            BOOT::|htpLabelFilter| BOOT::|profileDisplayOp|
+            BOOT::|htpLabelSpadType| BOOT::|pfAssign|
+            BOOT::|htpSetDomainVariableAlist| BOOT::|convertOrCroak|
+            BOOT::|htpSetDomainConditions|
+            BOOT::|intersectionEnvironment| BOOT::|pfRule|
+            BOOT::|coerceExit| BOOT::|resolveTM|
+            BOOT::|autoCoerceByModemap| BOOT::|coerceExtraHard|
+            BOOT::|hasType| BOOT::|getConstructorMode|
+            BOOT::|getConstructorFormOfMode| BOOT::|pfWhere|
+            BOOT::|coerceHard| BOOT::|npRightAssoc|
+            BOOT::|coerceSubset| BOOT::|reportCircularCacheStats|
+            BOOT::|mkCircularCountAlist| BOOT::|pfPushMacroBody|
+            BOOT::|pfMacro| BOOT::|coerceEasy| BOOT::|keyedSystemError|
+            BOOT::|chaseInferences| BOOT::|say2PerLineWidth|
+            BOOT::|getFormModemaps| BOOT::|prEnv,tran| BOOT::|qArg|
+            BOOT::|npMissingMate| BOOT::|canFit2ndEntry|
+            BOOT::|sayKeyedMsgLocal| BOOT::|mkUnion|
+            BOOT::|printEnv,tran| BOOT::|listTruncate|
+            BOOT::|newHasTest| BOOT::|makeCategoryForm|
+            BOOT::ADDOPERATIONS BOOT::ASHARPMKAUTOLOADFUNCTION
+            BOOT::|HGETandCount| BOOT::|consForHashLookup|
+            BOOT::|sayKeyedMsgAsTeX| BOOT::|SymMemQ| BOOT::|addToSlam|
+            BOOT::|throwPatternMsg| BOOT::DELDATABASE
+            BOOT::|sayPatternMsg| BOOT::|getKeyedMsgInDb|
+            BOOT::|lassocShift| BOOT::|htMakeTemplates|
+            BOOT::|isKeyedMsgInDb| BOOT::|patternVarsOf1|
+            BOOT::GETCONSTRUCTOR BOOT::|pfFromDom| BOOT::|symEqual|
+            BOOT::|domainEqualList| BOOT::SET-LIB-FILE-GETTER
+            BOOT::|pfApplication| BOOT::|rightJustifyString|
+            BOOT::|remHashEntriesWith0Count,fn|
+            BOOT::|globalHashtableStats| BOOT::|lassocShiftQ|
+            BOOT::|pfWDec| BOOT::|pileForest| BOOT::|canCoerce;|
+            BOOT::|pileForest1| BOOT::|canCoerce1| BOOT::DAASENAME
+            BOOT::|pileTree| BOOT::|eqpileTree| BOOT::|pileCtree|
+            BOOT::|resolveTT;| BOOT::WRAPDOMARGS BOOT::|evalCategory|
+            BOOT::|replaceSharps| BOOT::|ofCategory|
+            BOOT::|canCoerceFrom;| BOOT::|canCoerceFrom0|
+            BOOT::|isEqualOrSubDomain| BOOT::|hasCorrectTarget|
+            BOOT::MAKE-DATABASES BOOT::|resolveTT1|
+            BOOT::|applyWithOutputToString| BOOT::|isDomainSubst,fn|
+            BOOT::|isDomainSubst,findSub| BOOT::|insertModemap|
+            BOOT::|makeBigFloat| BOOT::REDUCTION-PRINT
+            BOOT::|mkAlistOfExplicitCategoryOps,fn| BOOT::REMOVER
+            BOOT::STACK-LOAD BOOT::ESCAPE-KEYWORDS BOOT::|allLASSOCs|
+            BOOT::MAKE-PARSE-FUNCTION1 BOOT::|pairList|
+            BOOT::INITIAL-SUBSTRING-P BOOT::|finalizeDocumentation,fn|
+            BOOT::|formatOpSignature| BOOT::|sayKeyedMsg|
+            BOOT::|transDocList| BOOT::MAKE-PARSE-FUNC-FLATTEN
+            BOOT::|recordAttributeDocumentation|
+            BOOT::|recordDocumentation|
+            BOOT::|recordSignatureDocumentation| BOOT::|macroExpand|
+            BOOT::|checkRewrite| BOOT::|checkComments|
+            BOOT::|checkExtract| BOOT::|checkTrim|
+            BOOT::|spadSysChoose| BOOT::|testError|
+            BOOT::|spadtestValueHook| BOOT::|checkIsValidType,fn|
+            BOOT::|transDoc| BOOT::|checkIndentedLines|
+            BOOT::SAYBRIGHTLY1 BOOT::|pvarPredTran| BOOT::|mkAbbrev|
+            BOOT::|addSuffix| BOOT::|processPackage,opt|
+            BOOT::|subTree| BOOT::|mkRepititionAssoc,mkRepfun|
+            BOOT::|setPackageLocals| BOOT::|UnionPrint|
+            BOOT::|JoinInner| BOOT::|objNewWrap|
+            BOOT::|coerceByFunction| BOOT::|MappingPrint|
+            BOOT::|parseTypeEvaluateArgs| BOOT::|createEnum|
+            BOOT::|parseTranCheckForRecord| BOOT::|installConstructor|
+            BOOT::|AncestorP| BOOT::|SourceLevelSubset|
+            BOOT::|JoinInner,AddPredicate| BOOT::|mkAnd| BOOT::|mkOr|
+            BOOT::|SigListUnion| BOOT::|PredImplies|
+            BOOT::|DescendantP| BOOT::|mkOr2| BOOT::|SigOpsubsume|
+            BOOT::|SourceLevelSubsume| BOOT::|compMakeCategoryObject|
+            BOOT::|MachineLevelSubset| BOOT::|MachineLevelSubsume|
+            BOOT::|SigListOpSubsume| BOOT::|SigEqual|
+            BOOT::|SigListMember| BOOT::|CategoryPrint| BOOT::|mkAnd2|
+            BOOT::|categoryParts,build|
+            BOOT::|catPairUnion,addConflict|
+            BOOT::|clearCategoryTable1| BOOT::|parseCases,casefn|
+            BOOT::|hasCat| BOOT::|superSub| BOOT::|encodeCategoryAlist|
+            BOOT::|simpCategoryOr| BOOT::|tempExtendsCat|
+            BOOT::CONVERSATION1 BOOT::|addDomainToTable|
+            BOOT::|mkCategoryOr| BOOT::/EMBED-Q
+            BOOT::|formalSubstitute|
+            BOOT::|updateCategoryTableForDomain|
+            BOOT::|simpCatHasAttribute| BOOT::|testExtend|
+            BOOT::|mergeOr| BOOT::|newHasTest,fn| BOOT::|simpOrUnion1|
+            BOOT::|updateCategoryTable| BOOT::|substDomainArgs|
+            BOOT::|NRTreplaceLocalTypes| BOOT::|dcOpPrint|
+            BOOT::|predicateBitIndex,pn| BOOT::|augmentPredCode|
+            BOOT::|mungeAddGensyms| BOOT::|htSayExpose|
+            BOOT::|makeCompactSigCode| BOOT::|evalDomainOpPred,process|
+            BOOT::|makeGoGetSlot| BOOT::|dbShowOpHeading|
+            BOOT::|makePrefixForm| BOOT::|dbShowOperationLines|
+            BOOT::|buildBitTable,fn| BOOT::|makeCompactDirect1|
+            BOOT::|augmentPredVector| BOOT::|simpOrDumb|
+            BOOT::|dbReduceByForm| BOOT::|dbContrivedForm|
+            BOOT::|dbReduceByOpSignature| BOOT::|dcOpLatchPrint|
+            BOOT::|reduceByGroup| BOOT::|dbGetCondition|
+            BOOT::|dbGetOrigin| BOOT::|koCatOps| BOOT::|modemap2Sig|
+            BOOT::|substInOrder| BOOT::|pairlis| BOOT::|getDcForm|
+            BOOT::|koCatAttrsAdd| BOOT::|getSubstInsert|
+            BOOT::|integerAssignment2Fortran1| BOOT::|koOps,fn|
+            BOOT::|getAllModemapsFromDatabase| BOOT::|koOps,merge|
+            BOOT::|exp2FortOptimizeCS1,pushCsStacks|
+            BOOT::|fortFormatTypes| BOOT::|segment2| BOOT::|whoUses|
+            BOOT::|fortranifyIntrinsicFunctionName|
+            BOOT::|expression2Fortran1| BOOT::|dispfortarrayexp|
+            BOOT::|fortFormatIfGoto| BOOT::|koCatAttrs|
+            BOOT::|dbGetContrivedForm| BOOT::|dispfortexpj|
+            BOOT::|assignment2Fortran1| BOOT::|beenHere|
+            BOOT::|dispfortexpf| BOOT::|htSayConstructor|
+            BOOT::|stringPrefix?| VMLISP::PUTINDEXTABLE
+            VMLISP::WRITE-INDEXTABLE BOOT::|NRTsetVector4Part2|
+            BOOT::|consDomainName| BOOT::|NRTencode|
+            BOOT::|consDomainForm| BOOT::|deltaTran| BOOT::|consSig|
+            BOOT::|NRTaddToSlam| BOOT::|deepChaseInferences|
+            BOOT::|c06gsfSolve,g| BOOT::|c06gsfSolve,f|
+            BOOT::|NRTdescendCodeTran| BOOT::|mergeAppend|
+            BOOT::|NRTgetLocalIndex1| BOOT::|vectorLocation|
+            BOOT::|c06frfSolve,fy| BOOT::|c06frfSolve,gy|
+            BOOT::|c06frfSolve,fx| BOOT::|c06frfSolve,gx|
+            BOOT::|c06gqfSolve,g| BOOT::|c06gqfSolve,f|
+            BOOT::|c06fpfSolve,f| BOOT::|c06fpfSolve,g|
+            BOOT::|c06fqfSolve,f| BOOT::|c06fqfSolve,g|
+            BOOT::|c06fufSolve,fy| BOOT::|c06fufSolve,gy|
+            BOOT::|c06fufSolve,fx| BOOT::|c06fufSolve,gx|
+            BOOT:|ListIsLength?| BOOT:|ListMemberQ?| BOOT:|ListMember?|
+            BOOT:|ListRemoveQ| BOOT:|ListNRemoveQ| BOOT:|ListUnion|
+            BOOT:|ListUnionQ| BOOT:|ListIntersection|
+            BOOT:|ListIntersectionQ| BOOT:|ListAdjoin|
+            BOOT:|ListAdjoinQ| BOOT:|AlistAssoc| BOOT:|AlistRemove|
+            BOOT:|AlistAssocQ| BOOT:|AlistRemoveQ| BOOT:|AlistAdjoinQ|
+            BOOT:|AlistUnionQ| BOOT::|rePackageTran|
+            BOOT::|ncINTERPFILE| BOOT:|TableUnset|
+            BOOT::|updateSymbolTable| FOAM:|printDFloat|
+            FOAM:|printSFloat| FOAM:|fputs| FOAM:|printBInt|
+            FOAM:|fputc| FOAM:|printSInt| FOAM:|printString|
+            FOAM:|printChar| BOOT::|incAppend| BOOT::|segment1|
+            BOOT::|intersectionContour,unifiable| BOOT::|getStatement|
+            BOOT::|deltaContour,contourDifference|
+            BOOT::|makeCommonEnvironment,makeSameLength| BOOT::DELLASOS
+            BOOT::|addContour,fn| BOOT::|fortranifyFunctionName|
+            BOOT::|displayOpModemaps| BOOT::|fortFormatTypes1|
+            BOOT::|f02aefSolve,l| FOAM:|PtrMagicEQ| BOOT::|hasOption|
+            BOOT::|intersectionContour| BOOT::|commandErrorIfAmbiguous|
+            BOOT::|intersectionContour,computeIntersection|
+            BOOT::|f04adfSolve,f| BOOT::|f04adfSolve,g|
+            BOOT::|makeCommonEnvironment| BOOT::|makeLiteral|
+            BOOT::|isLiteral| BOOT::|f04mcfSolve,f|
+            BOOT::|f04mcfSolve,g| BOOT::|f04qafSolve,h| BOOT::|mapInto|
+            BOOT::|f04qafSolve,k| BOOT::|stringMatches?|
+            BOOT::|basicMatch?| BOOT::|optionError|
+            BOOT::|displayProperties| BOOT::|mkErrorExpr,highlight|
+            BOOT::|f04adfSolve,fb| BOOT::|mkErrorExpr,highlight1|
+            BOOT::|coerce| BOOT::|numOfOccurencesOf| BOOT::|sublisR|
+            BOOT::|compMapCond''| BOOT::|getAndSay|
+            BOOT::|intersectionContour,interProplist| BOOT::|position|
+            BOOT::|satDownLink| BOOT::|getmodeOrMapping|
+            BOOT::|intersectionContour,compare|
+            BOOT::|intersectionContour,modeCompare|
+            BOOT::|getAbbreviation| BOOT::|koAttrs|
+            BOOT::|GEQNSUBSTLIST,GSUBSTinner| BOOT::|isCategoryForm|
+            BOOT::|resolve| BOOT::|convert| BOOT::|flatten|
+            BOOT::|f04jgfSolve,f| BOOT::|npsynonym|
+            BOOT::|f04jgfSolve,g| BOOT::|getImports,import|
+            BOOT::|f04arfSolve,f| BOOT::|f04arfSolve,g|
+            BOOT::|modeEqual| BOOT::|f04mbfSolve,l|
+            BOOT::|displayWarning| BOOT::|f04mbfSolve,o|
+            BOOT::|addContour| BOOT::|f04asfSolve,f|
+            BOOT::|f04asfSolve,g| BOOT::|deleteAssoc|
+            BOOT::|purgeNewConstructorLines|
+            BOOT::|filterListOfStrings| BOOT::|asyDocumentation,fn|
+            BOOT::|satisfiesRegularExpressions| BOOT::|displayProplist|
+            BOOT::|transformAndRecheckComments|
+            BOOT::|displaySemanticError| BOOT::|asySignature|
+            BOOT::|f04mbfSolve,h| BOOT::|asyTypeUnitDeclare|
+            BOOT::|f04mbfSolve,k| BOOT::|asyCatSignature|
+            BOOT::|dbSpreadComments| BOOT::|computeAncestorsOf|
+            BOOT::|descendantsOf| BOOT::|f04atfSolve,f|
+            BOOT::|f04atfSolve,g| BOOT::|f04adfSolve,gb|
+            BOOT::|reportOpsFromLisplib| BOOT::|f07fdfSolve,fa|
+            BOOT::|f07fdfSolve,fb| BOOT::|f07aefSolve,fa|
+            BOOT::|f07aefSolve,faa| BOOT::|f07adfSolve,fa|
+            BOOT::|f07adfSolve,fb| BOOT::|childArgCheck|
+            BOOT::|f07aefSolve,fb| BOOT::POSN1 BOOT::|assocCar|
+            BOOT::|childAssoc| BOOT::|f07fefSolve,fb|
+            BOOT::|f07fefSolve,fbb| BOOT::|ancestorsAdd|
+            BOOT::|f07fefSolve,fa| BOOT::|quickOr|
+            BOOT::|f07fefSolve,faa| BOOT::|f07aefSolve,fbb|
+            BOOT::|explodeIfs,gn| BOOT::|f01qdfSolve,fa|
+            BOOT::|f01qdfSolve,ga| BOOT::|dbGatherDataImplementation|
+            BOOT::|dbMakeSignature| BOOT::|dbExposed?|
+            BOOT::|getRegistry| BOOT::|opAlistCount|
+            BOOT::|f01rdfSolve,gb| BOOT::|bcStarSpaceOp|
+            BOOT::|evalDomainOpPred,convert| BOOT::|f02aefSolve,f|
+            BOOT:|Sort| BOOT::|f02aefSolve,g| BOOT:|SortInPlace|
+            BOOT::|evalDomainOpPred,evpred| BOOT::|f02aefSolve,h|
+            BOOT::|evalDomainOpPred,evpred1| BOOT::|f02abfSolve,f|
+            BOOT::|f02abfSolve,g| BOOT::|f02aafSolve,f|
+            BOOT::|f02aafSolve,g| BOOT::|evalDomainOpPred|
+            BOOT::|getDomainOpTable,memq| BOOT::|f02ajfSolve,h|
+            BOOT::|f02ajfSolve,l| BOOT::|superMatch?|
+            BOOT::|f02affSolve,f| BOOT::|f02affSolve,g|
+            BOOT:|ByteFileWriteLine| BOOT::NREVERSE-N
+            BOOT::|f02adfSolve,h| BOOT::|f02adfSolve,l|
+            FOAM:|fiSetDebugger| BOOT::TRUNCLIST-1
+            BOOT::|f02bjfSolve,h| BOOT::-REDUCE-OP
+            BOOT::|f02bjfSolve,l| BOOT::OR2 BOOT::|f02axfSolve,h|
+            BOOT::AND2 BOOT::|f02axfSolve,l| BOOT::|f02ajfSolve,f|
+            BOOT::REPEAT-TRAN BOOT::|f02ajfSolve,g| BOOT::MKPFFLATTEN
+            BOOT::|f02akfSolve,h| BOOT:|StreamSetPosition|
+            BOOT::|f02akfSolve,l| BOOT::MKPF1 BOOT::|f02axfSolve,f|
+            BOOT::|f02axfSolve,g| BOOT::-REPEAT BOOT::|f02xefSolve,fb|
+            BOOT::|CONTAINED,EQUAL| BOOT::|f02xefSolve,gb|
+            BOOT::|CONTAINED,EQ| BOOT::|f02awfSolve,h|
+            BOOT::|f02awfSolve,l| BOOT::|kPageArgs|
+            BOOT::|dbSubConform| BOOT::|f02akfSolve,f|
+            BOOT::|f02akfSolve,g| BOOT:|PathnameWithType|
+            BOOT::MARKHASH BOOT:|PathnameWithDirectory|
+            BOOT::|f02bjfSolve,f| BOOT::|f02bjfSolve,g|
+            BOOT::|f02adfSolve,f| BOOT::|f02adfSolve,g| BOOT::|,MIN|
+            BOOT:|PathnameWithinDirectory|
+            BOOT::|domainDescendantsOf,jfn|
+            BOOT::|domainDescendantsOf,catScreen| BOOT::|,MAX|
+            BOOT:|PathnameWithinOsEnvVar| BOOT::LEXLESSEQP
+            BOOT::|,DIFFERENCE| BOOT::GLESSEQP BOOT::MAKE-INIT-VECTOR
+            BOOT::|,TIMES| BOOT::|,PLUS| BOOT::|f02awfSolve,f|
+            BOOT::|f02awfSolve,g| BOOT::SUBB BOOT::|getCDTEntry|
+            BOOT::|f02xefSolve,fa| BOOT::|f02xefSolve,ga|
+            BOOT::|stuffSlots| BOOT::|domainDescendantsOf| BOOT::DO_LET
+            BOOT::|f02agfSolve,f| BOOT:|CsetMember?|
+            BOOT::|f02agfSolve,g| BOOT::|measureCommon,fn|
+            BOOT:|CsetUnion| BOOT::|f02wefSolve,fb|
+            BOOT::|f02wefSolve,gb| BOOT::|deleteWOC|
+            BOOT::|f02bbfSolve,f| BOOT::|next| BOOT::|f02bbfSolve,g|
+            BOOT::|suffix?| BOOT::|list2LongerVec|
+            BOOT::|f02wefSolve,fa| BOOT::|mkCurryFun|
+            BOOT::|f02wefSolve,ga| BOOT::|logicalMatch?|
+            BOOT::|subCopy0| BOOT::|patternCheck,wild|
+            BOOT:|StringFromToEnd| BOOT::|beforeAfter|
+            BOOT::|deepSubCopyOrNil| BOOT::|patternCheck,pos|
+            BOOT:|StringGreater?| BOOT::|deepSubCopy0| BOOT::|prefix?|
+            BOOT:|StringPrefix?| BOOT::|subCopyOrNil|
+            BOOT::|htpSetInputAreaAlist| BOOT::|termRW1|
+            BOOT::|processInteractive| BOOT::|termRW|
+            BOOT::|maskMatch?| BOOT::|tdAdd| BOOT::|filterByTopic|
+            BOOT::|addTopic2Documentation| BOOT::|addStats|
+            BOOT::|transferCodeCon| BOOT::|compileCases|
+            BOOT::|transferClassCodes| BOOT::|addArgumentConditions|
+            BOOT::|NRTassignCapsuleFunctionSlot|
+            BOOT::|reportSpadTrace| BOOT::BVEC-NOR BOOT::BVEC-NAND
+            BOOT::|addDomain| BOOT::|giveFormalParametersValues|
+            BOOT::PRINT-DEFUN BOOT::|augmentTraceNames|
+            BOOT::|stripOffSubdomainConditions|
+            BOOT::|untraceDomainLocalOps| BOOT::TRANSLABEL1
+            BOOT::|getOption| BOOT::TRANSLABEL BOOT::|traceOptionError|
+            BOOT::GET-GLIPH-TOKEN BOOT::|funfind,LAM|
+            BOOT::|mergePathnames| BOOT::|subTypes| BOOT::|lassocSub|
+            BOOT::|dbWordFrom| BOOT::|commandUserLevelError|
+            BOOT::|applyGrep| BOOT::|htButtonOn?|
+            BOOT::|generalSearchString| BOOT::|zsystemdevelopment1|
+            BOOT::|grepForAbbrev| BOOT::|match?| BOOT::|commandError|
+            BOOT::|optionUserLevelError| BOOT::|firstDelim| BOOT::/READ
+            BOOT::|kciReduceOpAlist| BOOT::|dbInfoTran|
+            BOOT::|koPageInputAreaUnchanged?| BOOT::|dbInfoWrapOrigin|
+            BOOT::|insert| BOOT::|dbInfoSigMatch| BOOT::|ancestorsOf|
+            BOOT::|compIterator| BOOT::|getIdentity|
+            BOOT::|augmentHasArgs| BOOT::|processInteractive1|
+            BOOT::|recordAndPrint| BOOT::|interpretTopLevel|
+            BOOT::|substituteSegmentedMsg|
+            BOOT::|dbSpecialExpandIfNecessary| BOOT::|sameUnionBranch|
+            BOOT::|htpSetPageDescription| BOOT::|testBitVector|
+            BOOT::|dbShowConsDoc| BOOT::|printTypeAndTimeNormal|
+            BOOT::|satTypeDownLink| BOOT::|printTypeAndTimeSaturn|
+            BOOT::|mkDocLink| BOOT::|addParameterTemplates|
+            BOOT::|hasPair| BOOT::|htpAddToPageDescription|
+            BOOT::|getAliasIfTracedMapParameter| BOOT::|pfAbSynOp?|
+            BOOT::|printTypeAndTime| BOOT::|phReportMsgs|
+            BOOT::|untraceDomainConstructor,keepTraced?|
+            BOOT::|htpButtonValue| BOOT::|htSayConstructorName|
+            BOOT::|getMapSig| BOOT::|spadTrace,isTraceable|
+            BOOT::|removeOption| BOOT::|screenLocalLine|
+            BOOT::|undoSteps| BOOT::|agg| BOOT::|diffAlist|
+            BOOT::|undoSingleStep| BOOT::|htSayBind|
+            BOOT::|bcConstructor| BOOT::|checkArgs|
+            BOOT::SPADTAGS-FROM-DIRECTORY BOOT::|matSuperList1|
+            BOOT::|getBindingPowerOf| BOOT::|matSubList1|
+            BOOT::|matWList1| BOOT::NAG-FILES BOOT::|htpLabelDefault|
+            BOOT::GET-NAG-CHAPTER BOOT::|setNAGBootAutloadProperties|
+            BOOT::|htpLabelErrorMsg| BOOT::|setBootAutloadProperties|
+            BOOT::|setUpDefault| BOOT::|setBootAutoLoadProperty|
+            BOOT::|mkBootAutoLoad| BOOT::|matWList| VMLISP::ECQEXP
+            BOOT::|npTypedForm1| BOOT::|htMakeDoitButton| BOOT::|prnd|
+            BOOT::|reportAO| BOOT::BVEC-XOR BOOT::BVEC-OR
+            VMLISP::DCQEXP BOOT::BVEC-AND BOOT::BVEC-GREATER
+            BOOT::BVEC-EQUAL BOOT::BVEC-CONCAT BOOT::|stringLE1|
+            BOOT::BVEC-MAKE-FULL BOOT::|scylla| BOOT::|mkSuperSub|
+            BOOT::|EqualBarGensym| BOOT::|pfReturn| BOOT::|pfSpread|
+            BOOT::|npTypedForm| BOOT::|after|
+            BOOT::|optCatch,changeThrowToGo|
+            BOOT::|optCatch,hasNoThrows|
+            BOOT::|optCatch,changeThrowToExit|
+            BOOT::|optimizeFunctionDef,replaceThrowByReturn|
+            BOOT::|optCallSpecially,lookup| BOOT::|EqualBarGensym,fn|
+            BOOT::|pfLp| BOOT::|optimizeFunctionDef,fn|
+            BOOT::|htpSetRadioButtonAlist| BOOT::|pfWrong|
+            BOOT::|pfForin| BOOT::|pfDefinition| BOOT::|pfReturnTyped|
+            BOOT::|pfLam| BOOT::|pfIfThenOnly| BOOT::|pfExit|
+            BOOT::|printNamedStatsByProperty| BOOT::|Delay|
+            BOOT::|initializeTimedNames| BOOT::|searchTailEnv|
+            BOOT::|searchCurrentEnv| BOOT::|search|
+            BOOT::|e04ycfSolve,fc| BOOT::|insertWOC,fn| BOOT::|mkObj|
+            VMLISP:|union| BOOT::|coerceInt| BOOT::|deleteAssocWOC|
+            BOOT::|e04nafSolve,fa| BOOT::|deleteAssocWOC,fn|
+            BOOT::|e04nafSolve,fb| BOOT::|deleteLassoc| BOOT::REMALIST
+            BOOT::|sublisNQ| BOOT::|BooleanEquality|
+            BOOT::|sublisNQ,fn| BOOT::|modemapsHavingTarget|
+            BOOT::|PPtoFile| BOOT::|positionInVec|
+            BOOT::|e04mbfSolve,fa| BOOT::|e04mbfSolve,fb|
+            BOOT::|mkIterVarSub| BOOT::|lazyOldAxiomDomainDevaluate|
+            BOOT::|lazyOldAxiomDomainHashCode| BOOT::|declare|
+            BOOT::|declareMap| BOOT::|concat1| BOOT::|upfreeWithType|
+            BOOT::|uplocalWithType| BOOT::|deleteAll|
+            BOOT::|oldAxiomCategoryDevaluate| BOOT::|SExprToDName|
+            BOOT::|oldAxiomPreCategoryDevaluate|
+            BOOT::|checkForFreeVariables| BOOT::|f01rdfSolve,fa|
+            BOOT::|f01rdfSolve,ga| BOOT::|oldAxiomDomainDevaluate|
+            BOOT::|newHasCategory| BOOT::|orderedDefaults|
+            BOOT::|f01rdfSolve,fb| BOOT::|attributeNthParent| BOOT:DROP
+            BOOT::|oldAxiomDomainHashCode| BOOT::|attributeHashCode|
+            BOOT::|oldAxiomPreCategoryHashCode|
+            BOOT::|attributeDevaluate| BOOT::|f01refSolve,fa|
+            BOOT::|f01refSolve,ga| BOOT::|oldAxiomCategoryHashCode|
+            BOOT:APPLYR BOOT::|f01qcfSolve,f| BOOT::|evalLET|
+            BOOT::|f01qcfSolve,g| BOOT::|domainEqual| BOOT:STRINGSUFFIX
+            BOOT::|f01qefSolve,fa| BOOT::|compileIs|
+            BOOT::|f01qefSolve,ga| BOOT::|f01rcfSolve,fa|
+            BOOT::|f01rcfSolve,ga| BOOT:CONVERSATION
+            BOOT::|evalLETchangeValue| BOOT::|isPatternMatch|
+            BOOT::|seteltable| BOOT::|intSayKeyedMsg|
+            BOOT::|upLispCall| BOOT::|genIFvalCode| BOOT::|evalLETput|
+            BOOT::|f01qdfSolve,fb| BOOT::|f01qdfSolve,gb|
+            BOOT::|intloopProcessString| BOOT::|ncloopDQlines|
+            BOOT::|intloopInclude1| BOOT::|intloopInclude|
+            BOOT::|upIFgenValue| BOOT::|putPvarModes|
+            BOOT::|ncloopPrefix?| BOOT::|intloopPrefix?|
+            BOOT::|phIntReportMsgs| BOOT::|processMsgList|
+            BOOT::|phParse| BOOT:TAKE BOOT::|isPatMatch|
+            BOOT::|intloopReadConsole| BOOT::|streamChop|
+            BOOT::|inclFname| BOOT::|incDrop| BOOT:SETANDFILE
+            BOOT:PUSH-REDUCTION BOOT::|inclmsgFileCycle|
+            BOOT::|assertCond| BOOT::|incActive?| BOOT:TAILFN
+            BOOT:RPLACW BOOT::|incStream| BOOT::|inclHandleSay|
+            BOOT::|inclHandleWarning| BOOT:FLAGP
+            BOOT::|inclHandleError| BOOT:?ORDER BOOT::|incRenumberLine|
+            BOOT::|incRenumberItem| BOOT::|lnSetGlobalNum| BOOT:S*
+            FOAM::ALLOC-PROG-INFO BOOT::|liftCond,lcAnd|
+            BOOT::|actOnInfo| BOOT::|mkJoin| BOOT::|plural|
+            BOOT::|e04ucfSolve,fb| BOOT:MAKENEWOP BOOT::|has|
+            BOOT::|containedRight| BOOT::|hashTypeForm| BOOT:CONTAINED
+            BOOT::|oldAxiomPreCategoryParents|
+            BOOT::|oldAxiomCategoryDefaultPackage| BOOT:POINTW
+            BOOT::|linearFormatForm| BOOT::|newHasAttribute|
+            BOOT::|oldAxiomCategoryParentCount|
+            BOOT::|findSubstitutionOrder?,fn| BOOT::|app2StringConcat0|
+            BOOT::|formDecl2String| BOOT::|sayLooking1|
+            BOOT::|formJoin1| BOOT::|app2StringWrap| BOOT:S-
+            BOOT::|mkLessOrEqual| BOOT::|formArguments2String|
+            BOOT::|putValueValue| BOOT::|asTupleNew| BOOT::|objSetVal|
+            BOOT::|objNewCode| FOAM-USER::H-ERROR BOOT::|displayRule|
+            BOOT::|coerceInteractive| BOOT::|canMakeTuple|
+            FOAM-USER::H-STRING BOOT:CARCDREXPAND
+            BOOT::|formatOpSymbol| FOAM-USER::H-INTEGER
+            BOOT::|addPatternPred| BOOT::|interpMap| BOOT::|mkLocalVar|
+            BOOT:/EMBED-1 BOOT::|findLocalVars1|
+            BOOT::|queryUserKeyedMsg| BOOT::|mkFreeVar|
+            BOOT::|findLocalVars|)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION NIL FIXNUM) BOOT::HEAPELAPSED
+            BOOT:|OsProcessNumber| BOOT::KCL-OS-PROCESS-NUMBER)) 
+(PROCLAIM
+    '(FTYPE (FUNCTION NIL (VALUES T T)) BOOT::MAKE-CLOSEDFN-NAME
+            BOOT::|genVariable| BOOT::|genSomeVariable|
+            BOOT::|genDomainVar| BOOT:GENVAR)) 
diff --git a/src/interp/intfile.boot.pamphlet b/src/interp/intfile.boot.pamphlet
new file mode 100644
index 00000000..1dcdcf2d
--- /dev/null
+++ b/src/interp/intfile.boot.pamphlet
@@ -0,0 +1,83 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp intfile.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+shoeInternFile(fn)==
+   a:=shoeInputFile fn
+   if null a
+   then WRITE_-LINE (CONCAT(fn,'" not found"),_*TERMINAL_-IO_*)
+   else shoeIntern incRgen a
+ 
+shoeIntern (s)==
+   StreamNull s => nil
+   f:=CAR s
+   # f < 8 => shoeIntern CDR s
+   f.0=char " " =>shoeIntern CDR s
+   a:=INTERN SUBSTRING (f,0,8)
+   [b,c]:= shoeStrings CDR s
+   SETF(GET (a,"MSGS"),b)
+   shoeIntern c
+ 
+shoeStrings (stream)==
+   StreamNull stream => ['"",stream]
+   a:=CAR stream
+   if a.0^=char " "
+   then ['"",stream]
+   else
+       [h,t]:=shoeStrings(cdr stream)
+       [CONCAT(a,h),t]
+ 
+--fetchKeyedMsg(key,b)== GET(key,"MSGS")
+--shoeInternFile '"/usr/local/scratchpad/cur/doc/msgs/co-eng.msgs"
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/intint.lisp.pamphlet b/src/interp/intint.lisp.pamphlet
new file mode 100644
index 00000000..d132ad87
--- /dev/null
+++ b/src/interp/intint.lisp.pamphlet
@@ -0,0 +1,168 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp intint.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+(defun |intSayKeyedMsg| (key args)
+  (|sayKeyedMsg| (|packageTran| key) (|packageTran| args)))
+
+;;(defun |intMakeFloat| (int frac len exp)
+;;  (MAKE-FLOAT int frac len exp))
+
+;;(defun |intSystemCommand| (command)
+;;  (catch 'SPAD_READER
+;;    (|systemCommand| (|packageTran| command))))
+
+;;(defun |intUnAbbreviateKeyword| (keyword)
+;;  (|unAbbreviateKeyword| (|packageTran| keyword)))
+
+(defun |intProcessSynonyms| (str)
+  (let ((LINE str))
+    (declare (special LINE))
+    (|processSynonyms|)
+    LINE))
+
+;; (defun |intNoParseCommands| ()
+;;   |$noParseCommands|)
+
+;;(defun |intTokenCommands| ()
+;; |$tokenCommands|)
+
+(defun |intInterpretPform| (pf)
+  (|processInteractive| (|zeroOneTran| (|packageTran| (|pf2Sex| pf))) pf))
+
+;;(defun |intSpadThrow| ()
+;;  (|spadThrow|))
+
+;;(defun |intMKPROMPT| (should? step)
+;;  (if should? (PRINC (MKPROMPT))))
+
+(defvar |$intCoerceFailure| '|coerceFailure|)
+(defvar |$intTopLevel| '|top_level|)
+(defvar |$intSpadReader| 'SPAD_READER)
+(defvar |$intRestart| '|restart|)
+
+;;(defun |intString2BootTree| (str)
+;;  (|string2BootTree| str))
+
+;;(defun |intPackageTran| (sex)
+;;  (|packageTran| sex))
+
+;;--------------------> NEW DEFINITION (override in i-syscmd.boot.pamphlet)
+(defun |stripSpaces| (str)
+  (string-trim '(#\Space) str))
+
+;;(defvar |$SessionManager| |$SessionManager|)
+;;(defvar |$EndOfOutput| |$EndOfOutput|)
+
+;;(defun |intServerReadLine| (foo)
+;;  (|serverReadLine| foo))
+
+;; (defun |intProcessSynonym| (str)
+;;   (|npProcessSynonym| str))
+
+(defun |SpadInterpretFile| (fn)
+      (|SpadInterpretStream| 1 fn nil) )
+
+(defun |intNewFloat| ()
+  (list '|Float|))
+
+;; (defun |intDoSystemCommand| (string)
+;;   (|doSystemCommand| string))
+
+(defun |intSetNeedToSignalSessionManager| ()
+  (setq |$NeedToSignalSessionManager| T))
+
+;; (defun |intKeyedSystemError| (msg args)
+;;   (|keyedSystemError| msg args))
+
+;;#-:CCL
+;;(defun |stashInputLines| (l)
+;;  (|stashInputLines| l))
+
+;;(defun |setCurrentLine| (s)
+;;  (setq |$currentLine| s))
+
+(defun |setCurrentLine| (s)
+  (setq |$currentLine|
+	(cond ((null |$currentLine|) s)
+	      ((stringp |$currentLine|)
+	       (cons |$currentLine|
+			 (if (stringp s) (cons s nil) s)))
+	      (t (rplacd (last |$currentLine|)
+			 (if (stringp s) (cons s nil) s))
+		 |$currentLine|))))
+
+(defun |intnplisp| (s)
+ (setq |$currentLine| s)
+ (|nplisp| |$currentLine|))
+
+;; (defun |intResetStackLimits| () (|resetStackLimits|))
+
+(defun |intSetQuiet| ()
+  (setq |$QuietCommand| T))
+
+(defun |intUnsetQuiet| ()
+  (setq |$QuietCommand| NIL))
+
+;; (defun |expandTabs| (s)
+;;   (expand-tabs s))
+
+;; #-:CCL
+;; (defun |leaveScratchpad| ()
+;;   (|leaveScratchpad|))
+
+;;(defun |readingFile?| ()
+;;  |$ReadingFile|)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/iterator.boot.pamphlet b/src/interp/iterator.boot.pamphlet
new file mode 100644
index 00000000..52dae4f7
--- /dev/null
+++ b/src/interp/iterator.boot.pamphlet
@@ -0,0 +1,319 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/iterator.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% ITERATORS
+ 
+compReduce(form,m,e) ==
+ compReduce1(form,m,e,$formalArgList)
+
+compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) ==
+  [collectOp,:itl,body]:= collectForm
+  if STRINGP op then op:= INTERN op
+  ^MEMQ(collectOp,'(COLLECT COLLECTV COLLECTVEC)) =>
+        systemError ["illegal reduction form:",form]
+  $sideEffectsList: local
+  $until: local
+  $initList: local
+  $endTestList: local
+  $e:= e
+  itl:= [([.,$e]:= compIterator(x,$e) or return "failed").(0) for x in itl]
+  itl="failed" => return nil
+  e:= $e
+  acc:= GENSYM()
+  afterFirst:= GENSYM()
+  bodyVal:= GENSYM()
+  [part1,m,e]:= comp(["LET",bodyVal,body],m,e) or return nil
+  [part2,.,e]:= comp(["LET",acc,bodyVal],m,e) or return nil
+  [part3,.,e]:= comp(["LET",acc,parseTran [op,acc,bodyVal]],m,e) or return nil
+  identityCode:=
+    id:= getIdentity(op,e) => u.expr where u() == comp(id,m,e) or return nil
+    ["IdentityError",MKQ op]
+  finalCode:=
+    ["PROGN",
+      ["LET",afterFirst,nil],
+       ["REPEAT",:itl,
+        ["PROGN",part1,
+          ["IF", afterFirst,part3,
+                   ["PROGN",part2,["LET",afterFirst,MKQ true]]]]],
+                    ["IF",afterFirst,acc,identityCode]]
+  if $until then
+    [untilCode,.,e]:= comp($until,$Boolean,e)
+    finalCode:= substitute(["UNTIL",untilCode],'$until,finalCode)
+  [finalCode,m,e]
+ 
+getIdentity(x,e) ==
+  GETL(x,"THETA") is [y] => y
+ 
+numberize x ==
+  x=$Zero => 0
+  x=$One => 1
+  atom x => x
+  [numberize first x,:numberize rest x]
+ 
+compRepeatOrCollect(form,m,e) ==
+  fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList
+    ,e) where
+      fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
+        $until: local
+        [repeatOrCollect,:itl,body]:= form
+        itl':=
+          [([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl]
+        itl'="failed" => nil
+        targetMode:= first $exitModeStack
+        bodyMode:=
+          repeatOrCollect="COLLECT" =>
+            targetMode = '$EmptyMode => '$EmptyMode
+            (u:=modeIsAggregateOf('List,targetMode,e)) =>
+              CADR u
+            (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) =>
+              repeatOrCollect:='COLLECTV
+              CADR u
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) =>
+              repeatOrCollect:='COLLECTVEC
+              CADR u
+            stackMessage('"Invalid collect bodytype")
+            return nil
+            -- If we're doing a collect, and the type isn't conformable
+            -- then we've boobed. JHD 26.July.1990
+          $NoValueMode
+        [body',m',e']:=
+          -- (m1:= listOrVectorElementMode targetMode) and comp(body,m1,e) or
+            compOrCroak(body,bodyMode,e) or return nil
+        if $until then
+          [untilCode,.,e']:= comp($until,$Boolean,e')
+          itl':= substitute(["UNTIL",untilCode],'$until,itl')
+        form':= [repeatOrCollect,:itl',body']
+        m'':=
+          repeatOrCollect="COLLECT" =>
+            (u:=modeIsAggregateOf('List,targetMode,e)) => CAR u
+            ["List",m']
+          repeatOrCollect="COLLECTV" =>
+            (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) => CAR u
+            ["PrimitiveArray",m']
+          repeatOrCollect="COLLECTVEC" =>
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) => CAR u
+            ["Vector",m']
+          m'
+        coerceExit([form',m'',e'],targetMode)
+ 
+--constructByModemap([x,source,e],target) ==
+--  u:=
+--    [cexpr
+--      for (modemap:= [map,cexpr]) in getModemapList("construct",1,e) | map is [
+--        .,t,s] and modeEqual(t,target) and modeEqual(s,source)] or return nil
+--  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+--  [["call",fn,x],target,e]
+ 
+listOrVectorElementMode x ==
+  x is [a,b,:.] and member(a,'(PrimitiveArray Vector List)) => b
+ 
+compIterator(it,e) ==
+  it is ["IN",x,y] =>
+    --these two lines must be in this order, to get "for f in list f"
+    --to give  an error message if f is undefined
+    [y',m,e]:= comp(y,$EmptyMode,e) or return nil
+    $formalArgList:= [x,:$formalArgList]
+    [mOver,mUnder]:=
+      modeIsAggregateOf("List",m,e) or return
+         stackMessage ["mode: ",m," must be a list of some mode"]
+    if null get(x,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",x,mUnder],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),mUnder,e],e)
+    [y'',m'',e] := coerce([y',m,e], mOver) or return nil
+    [["IN",x,y''],e]
+  it is ["ON",x,y] =>
+    $formalArgList:= [x,:$formalArgList]
+    [y',m,e]:= comp(y,$EmptyMode,e) or return nil
+    [mOver,mUnder]:=
+      modeIsAggregateOf("List",m,e) or return
+        stackMessage ["mode: ",m," must be a list of other modes"]
+    if null get(x,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",x,m],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),m,e],e)
+    [y'',m'',e] := coerce([y',m,e], mOver) or return nil
+    [["ON",x,y''],e]
+  it is ["STEP",index,start,inc,:optFinal] =>
+    $formalArgList:= [index,:$formalArgList]
+    --if all start/inc/end compile as small integers, then loop
+    --is compiled as a small integer loop
+    final':= nil
+    (start':= comp(start,$SmallInteger,e)) and
+      (inc':= comp(inc,$NonNegativeInteger,start'.env)) and
+        (not (optFinal is [final]) or
+          (final':= comp(final,$SmallInteger,inc'.env))) =>
+            indexmode:=
+              comp(start,$NonNegativeInteger,e) =>
+                      $NonNegativeInteger
+              $SmallInteger
+            if null get(index,"mode",e) then [.,.,e]:=
+              compMakeDeclaration([":",index,indexmode],$EmptyMode,
+                (final' => final'.env; inc'.env)) or return nil
+            e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+            if final' then optFinal:= [final'.expr]
+            [["ISTEP",index,start'.expr,inc'.expr,:optFinal],e]
+    [start,.,e]:=
+      comp(start,$Integer,e) or return
+        stackMessage ["start value of index: ",start," must be an integer"]
+    [inc,.,e]:=
+      comp(inc,$Integer,e) or return
+        stackMessage ["index increment:",inc," must be an integer"]
+    if optFinal is [final] then
+      [final,.,e]:=
+        comp(final,$Integer,e) or return
+          stackMessage ["final value of index: ",final," must be an integer"]
+      optFinal:= [final]
+    indexmode:=
+      comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger
+      $Integer
+    if null get(index,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil
+    e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+    [["STEP",index,start,inc,:optFinal],e]
+  it is ["WHILE",p] =>
+    [p',m,e]:=
+      comp(p,$Boolean,e) or return
+        stackMessage ["WHILE operand: ",p," is not Boolean valued"]
+    [["WHILE",p'],e]
+  it is ["UNTIL",p] => ($until:= p; ['$until,e])
+  it is ["|",x] =>
+    u:=
+      comp(x,$Boolean,e) or return
+        stackMessage ["SUCHTHAT operand: ",x," is not Boolean value"]
+    [["|",u.expr],u.env]
+  nil
+ 
+--isAggregateMode(m,e) ==
+--  m is [c,R] and MEMQ(c,'(Vector List)) => R
+--  name:=
+--    m is [fn,:.] => fn
+--    m="$" => "Rep"
+--    m
+--  get(name,"value",e) is [c,R] and MEMQ(c,'(Vector List)) => R
+ 
+modeIsAggregateOf(ListOrVector,m,e) ==
+  m is [ =ListOrVector,R] => [m,R]
+--m = '$EmptyMode => [m,m] I don't think this is correct, breaks POLY +
+  m is ["Union",:l] =>
+    mList:= [pair for m' in l | (pair:= modeIsAggregateOf(ListOrVector,m',e))]
+    1=#mList => first mList
+  name:=
+    m is [fn,:.] => fn
+    m="$" => "Rep"
+    m
+  get(name,"value",e) is [[ =ListOrVector,R],:.] => [m,R]
+ 
+--% VECTOR ITERATORS
+ 
+--the following 4 functions are not currently used
+ 
+--compCollectV(form,m,e) ==
+--  fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],e) where
+--    fn(form,$exitModeStack,$leaveLevelStack,e) ==
+--      [repeatOrCollect,it,body]:= form
+--      [it',e]:= compIteratorV(it,e) or return nil
+--      m:= first $exitModeStack
+--      [mOver,mUnder]:= modeIsAggregateOf("Vector",m,e) or $EmptyMode
+--      [body',m',e']:= compOrCroak(body,mUnder,e) or return nil
+--      form':= ["COLLECTV",it',body']
+--     {n:=
+--        it' is ("STEP",.,s,i,f) or it' is ("ISTEP",.,s,i,f) =>
+--              computeMaxIndex(s,f,i);
+--        return nil}
+--      coerce([form',mOver,e'],m)
+--
+--compIteratorV(it,e) ==
+--  it is ["STEP",index,start,inc,final] =>
+--    (start':= comp(start,$Integer,e)) and
+--      (inc':= comp(inc,$NonNegativeInteger,start'.env)) and
+--       (final':= comp(final,$Integer,inc'.env)) =>
+--        indexmode:=
+--          comp(start,$NonNegativeInteger,e) => $NonNegativeInteger
+--          $Integer
+--        if null get(index,"mode",e) then [.,.,e]:=
+--          compMakeDeclaration([":",index,indexmode],$EmptyMode,final'.env) or
+--            return nil
+--        e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+--        [["ISTEP",index,start'.expr,inc'.expr,final'.expr],e]
+--    [start,.,e]:=
+--      comp(start,$Integer,e) or return
+--        stackMessage ["start value of index: ",start," is not an integer"]
+--    [inc,.,e]:=
+--      comp(inc,$NonNegativeInteger,e) or return
+--        stackMessage ["index increment: ",inc," must be a non-negative integer"]
+--    [final,.,e]:=
+--      comp(final,$Integer,e) or return
+--        stackMessage ["final value of index: ",final," is not an integer"]
+--    indexmode:=
+--      comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger
+--      $Integer
+--    if null get(index,"mode",e) then [.,.,e]:=
+--      compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil
+--    e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+--    [["STEP",index,start,inc,final],e]
+--  nil
+--
+--computeMaxIndex(s,f,i) ==
+--  i^=1 => cannotDo()
+--  s=1 => f
+--  exprDifference(f,exprDifference(s,1))
+--
+--exprDifference(x,y) ==
+--  y=0 => x
+--  FIXP x and FIXP y => DIFFERENCE(x,y)
+--  ["DIFFERENCE",x,y]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/lisplib.boot.pamphlet b/src/interp/lisplib.boot.pamphlet
new file mode 100644
index 00000000..bffb777e
--- /dev/null
+++ b/src/interp/lisplib.boot.pamphlet
@@ -0,0 +1,712 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/lisplib.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Standard Library Creation Functions
+ 
+readLib(fn,ft) == readLib1(fn,ft,"*")
+ 
+readLib1(fn,ft,fm) ==
+  -- see if it exists first
+  p := pathname [fn,ft,fm]
+  readLibPathFast p
+ 
+readLibPathFast p ==
+  -- assumes 1) p is a valid pathname
+  --         2) file has already been checked for existence
+  RDEFIOSTREAM([['FILE,:p], '(MODE . INPUT)],false)
+ 
+writeLib(fn,ft) == writeLib1(fn,ft,"*")
+ 
+writeLib1(fn,ft,fm) == RDEFIOSTREAM [['FILE,fn,ft,fm],'(MODE . OUTPUT)]
+ 
+putFileProperty(fn,ft,id,val) ==
+  fnStream:= writeLib1(fn,ft,"*")
+  val:= rwrite( id,val,fnStream)
+  RSHUT fnStream
+  val
+ 
+lisplibWrite(prop,val,filename) ==
+  -- this may someday not write NIL keys, but it will now
+  if $LISPLIB then
+     rwrite128(prop,val,filename)
+ 
+rwrite128(key,value,stream) ==
+  rwrite(key,value,stream)
+ 
+evalAndRwriteLispForm(key,form) ==
+  eval form
+  rwriteLispForm(key,form)
+ 
+rwriteLispForm(key,form) ==
+  if $LISPLIB then
+    rwrite( key,form,$libFile)
+    LAM_,FILEACTQ(key,form)
+ 
+getLisplib(name,id) ==
+  -- this version does cache the returned value
+  getFileProperty(name,$spadLibFT,id,true)
+ 
+getLisplibNoCache(name,id) ==
+  -- this version does not cache the returned value
+  getFileProperty(name,$spadLibFT,id,false)
+ 
+getFileProperty(fn,ft,id,cache) ==
+  fn in '(DOMAIN SUBDOM MODE) => nil
+  p := pathname [fn,ft,'"*"]
+  cache => hasFileProperty(p,id,fn)
+  hasFilePropertyNoCache(p,id,fn)
+ 
+hasFilePropertyNoCache(p,id,abbrev) ==
+  -- it is assumed that the file exists and is a proper pathname
+  -- startTimingProcess 'diskread
+  fnStream:= readLibPathFast p
+  NULL fnStream => NIL
+  -- str:= object2String id
+  val:= rread(id,fnStream, nil)
+  RSHUT fnStream
+  -- stopTimingProcess 'diskread
+  val
+ 
+--% Uninstantiating
+ 
+unInstantiate(clist) ==
+  for c in clist repeat
+    clearConstructorCache(c)
+  killNestedInstantiations(clist)
+ 
+killNestedInstantiations(deps) ==
+  for key in HKEYS($ConstructorCache)
+    repeat
+      for [arg,count,:inst] in HGET($ConstructorCache,key) repeat
+        isNestedInstantiation(inst.0,deps) =>
+          HREMPROP($ConstructorCache,key,arg)
+ 
+isNestedInstantiation(form,deps) ==
+  form is [op,:argl] =>
+    op in deps => true
+    or/[isNestedInstantiation(x,deps) for x in argl]
+  false
+ 
+--% Loading
+ 
+loadLibIfNotLoaded libName ==
+  -- replaces old SpadCondLoad
+  -- loads is library is not already loaded
+  $PrintOnly = 'T => NIL
+  GETL(libName,'LOADED) => NIL
+  loadLib libName
+ 
+loadLib cname ==
+  startTimingProcess 'load
+  fullLibName := GETDATABASE(cname,'OBJECT) or return nil
+  systemdir? := isSystemDirectory(pathnameDirectory fullLibName)
+  update? := $forceDatabaseUpdate or not systemdir? 
+  not update? =>
+     loadLibNoUpdate(cname, cname, fullLibName)
+  kind := GETDATABASE(cname,'CONSTRUCTORKIND)
+  if $printLoadMsgs then
+    sayKeyedMsg("S2IL0002",[namestring fullLibName,kind,cname])
+  LOAD(fullLibName)
+  clearConstructorCache cname
+  updateDatabase(cname,cname,systemdir?)
+  installConstructor(cname,kind)
+  u := GETDATABASE(cname, 'CONSTRUCTORMODEMAP)
+  updateCategoryTable(cname,kind)
+  coSig :=
+      u =>
+          [[.,:sig],:.] := u
+          CONS(NIL,[categoryForm?(x) for x in CDR sig])
+      NIL
+  -- in following, add property value false or NIL to possibly clear
+  -- old value
+  if null CDR GETDATABASE(cname,'CONSTRUCTORFORM) then
+      MAKEPROP(cname,'NILADIC,'T)
+    else
+      REMPROP(cname,'NILADIC)
+  MAKEPROP(cname,'LOADED,fullLibName)
+  if $InteractiveMode then $CategoryFrame := [[nil]]
+  stopTimingProcess 'load
+  'T
+
+loadLibNoUpdate(cname, libName, fullLibName) ==
+  kind := GETDATABASE(cname,'CONSTRUCTORKIND)
+  if $printLoadMsgs then
+    sayKeyedMsg("S2IL0002",[namestring fullLibName,kind,cname])
+  if CATCH('VERSIONCHECK,LOAD(fullLibName)) = -1
+    then 
+      PRINC('"   wrong library version...recompile ")
+      PRINC(fullLibName)
+      TERPRI()
+      TOPLEVEL()
+    else
+     clearConstructorCache cname
+     installConstructor(cname,kind)
+     MAKEPROP(cname,'LOADED,fullLibName)
+     if $InteractiveMode then $CategoryFrame := [[nil]]
+     stopTimingProcess 'load
+  'T
+ 
+loadIfNecessary u == loadLibIfNecessary(u,true)
+ 
+loadIfNecessaryAndExists u == loadLibIfNecessary(u,nil)
+ 
+loadLibIfNecessary(u,mustExist) ==
+  u = '$EmptyMode => u
+  null atom u => loadLibIfNecessary(first u,mustExist)
+  value:=
+    functionp(u) or macrop(u) => u
+    GETL(u,'LOADED) => u
+    loadLib u => u
+  null $InteractiveMode and ((null (y:= getProplist(u,$CategoryFrame)))
+    or (null LASSOC('isFunctor,y)) and (null LASSOC('isCategory,y))) =>
+      y:= GETDATABASE(u,'CONSTRUCTORKIND) =>
+         y = 'category =>
+            updateCategoryFrameForCategory u
+         updateCategoryFrameForConstructor u
+      throwKeyedMsg("S2IL0005",[u])
+  value
+ 
+convertOpAlist2compilerInfo(opalist) ==
+   "append"/[[formatSig(op,sig) for sig in siglist]
+                for [op,:siglist] in opalist] where
+      formatSig(op, [typelist, slot,:stuff]) ==
+          pred := if stuff then first stuff else 'T
+          impl := if CDR stuff then CADR stuff else 'ELT -- handles 'CONST
+          [[op, typelist], pred, [impl, '$, slot]]
+   
+updateCategoryFrameForConstructor(constructor) ==
+   opAlist := GETDATABASE(constructor, 'OPERATIONALIST)
+   [[dc,:sig],[pred,impl]] := GETDATABASE(constructor, 'CONSTRUCTORMODEMAP) 
+   $CategoryFrame := put(constructor,'isFunctor,
+       convertOpAlist2compilerInfo(opAlist),
+       addModemap(constructor, dc, sig, pred, impl,
+           put(constructor, 'mode, ['Mapping,:sig], $CategoryFrame)))
+
+updateCategoryFrameForCategory(category) ==
+   [[dc,:sig],[pred,impl]] := GETDATABASE(category, 'CONSTRUCTORMODEMAP) 
+   $CategoryFrame :=
+     put(category, 'isCategory, 'T,
+         addModemap(category, dc, sig, pred, impl, $CategoryFrame))
+
+loadFunctor u ==
+  null atom u => loadFunctor first u
+  loadLibIfNotLoaded u
+  u
+ 
+makeConstructorsAutoLoad() ==
+  for cnam in allConstructors() repeat
+    REMPROP(cnam,'LOADED)
+--    fn:=GETDATABASE(cnam,'ABBREVIATION)
+    if GETDATABASE(cnam,'NILADIC)
+     then PUT(cnam,'NILADIC,'T)
+     else REMPROP(cnam,'NILADIC)
+    systemDependentMkAutoload(cnam,cnam)
+ 
+systemDependentMkAutoload(fn,cnam) ==
+    FBOUNDP(cnam) => "next"
+    asharpName := GETDATABASE(cnam, 'ASHARP?) =>
+         kind := GETDATABASE(cnam, 'CONSTRUCTORKIND)
+         cosig := GETDATABASE(cnam, 'COSIG)
+         file := GETDATABASE(cnam, 'OBJECT)
+	 SET_-LIB_-FILE_-GETTER(file, cnam)
+         kind = 'category =>
+              ASHARPMKAUTOLOADCATEGORY(file, cnam, asharpName, cosig)
+         ASHARPMKAUTOLOADFUNCTOR(file, cnam, asharpName, cosig)
+    SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
+ 
+autoLoad(abb,cname) ==
+  if not GETL(cname,'LOADED) then loadLib cname
+  SYMBOL_-FUNCTION cname
+ 
+setAutoLoadProperty(name) ==
+--  abb := constructor? name
+  REMPROP(name,'LOADED)
+  SETF(SYMBOL_-FUNCTION name,mkAutoLoad(name, name))
+ 
+--% Compilation
+ 
+compileConstructorLib(l,op,editFlag,traceFlag) ==
+  --this file corresponds to /C,1
+  MEMQ('_?,l) => return editFile '(_/C TELL _*)
+  optionList:= _/OPTIONS l
+  funList:= TRUNCLIST(l,optionList) or [_/FN]
+  options:= [[UPCASE CAR x,:CDR x] for x in optionList]
+  infile:=  _/MKINFILENAM _/GETOPTION(options,'FROM_=)
+  outfile:= _/MKINFILENAM _/GETOPTION(options,'TO_=)
+  res:= [compConLib1(fn,infile,outfile,op,editFlag,traceFlag)
+               for fn in funList]
+  SHUT INPUTSTREAM
+  res
+ 
+compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
+  $PRETTYPRINT: local := 'T
+  $LISPLIB: local := 'T
+  $lisplibAttributes: local := NIL
+  $lisplibPredicates: local := NIL
+  $lisplibForm: local := NIL
+  $lisplibAbbreviation: local := NIL
+  $lisplibParents: local := NIL
+  $lisplibAncestors: local := NIL
+  $lisplibKind: local := NIL
+  $lisplibModemap: local := NIL
+  $lisplibModemapAlist: local := NIL
+  $lisplibCategoriesExtended: local := NIL -- this is always nil. why? (tpd)
+  $lisplibSlot1 : local := NIL   --used by NRT mechanisms
+  $lisplibOperationAlist: local := NIL
+  $lisplibOpAlist: local:= NIL
+  $lisplibSuperDomain: local := NIL
+  $libFile: local := NIL
+  $lisplibVariableAlist: local := NIL
+  $lisplibSignatureAlist: local := NIL
+  if null atom fun and null CDR fun then fun:= CAR fun -- unwrap nullary
+  libName:= getConstructorAbbreviation fun
+  infile:= infileOrNil or getFunctionSourceFile fun or
+    throwKeyedMsg("S2IL0004",[fun])
+  SETQ(_/EDITFILE,infile)
+  outfile := outfileOrNil or
+    [libName,'OUTPUT,$listingDirectory]   --always QUIET
+  _$ERASE(libName,'OUTPUT,$listingDirectory)
+  outstream:= DEFSTREAM(outfile,'OUTPUT)
+  val:= _/D_,2_,LIB(fun,infile,outstream,auxOp,editFlag,traceFlag)
+  val
+ 
+compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
+  --fn= compDefineCategory OR compDefineFunctor
+  sayMSG fillerSpaces(72,'"-")
+  $LISPLIB: local := 'T
+  $op: local := op
+  $lisplibAttributes: local := NIL
+  $lisplibPredicates: local := NIL -- set by makePredicateBitVector
+  $lisplibCategoriesExtended: local := NIL -- this is always nil. why? (tpd)
+  $lisplibForm: local := NIL
+  $lisplibKind: local := NIL
+  $lisplibAbbreviation: local := NIL
+  $lisplibParents: local := NIL
+  $lisplibAncestors: local := NIL
+  $lisplibModemap: local := NIL
+  $lisplibModemapAlist: local := NIL
+  $lisplibSlot1 : local := NIL   -- used by NRT mechanisms
+  $lisplibOperationAlist: local := NIL
+  $lisplibSuperDomain: local := NIL
+  $libFile: local := NIL
+  $lisplibVariableAlist: local := NIL
+--  $lisplibRelatedDomains: local := NIL   --from ++ Related Domains: see c-doc
+  $lisplibCategory: local := nil	
+  --for categories, is rhs of definition; otherwise, is target of functor
+  --will eventually become the "constructorCategory" property in lisplib
+  --set in compDefineCategory1 if category, otherwise in finalizeLisplib
+  libName := getConstructorAbbreviation op
+  BOUNDP '$compileDocumentation and $compileDocumentation =>
+     compileDocumentation libName
+  sayMSG ['"   initializing ",$spadLibFT,:bright libName,
+    '"for",:bright op]
+  initializeLisplib libName
+  sayMSG ['"   compiling into ",$spadLibFT,:bright libName]
+  -- res:= FUNCALL(fn,df,m,e,prefix,fal)
+  -- sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
+  -- finalizeLisplib libName
+  -- following guarantee's compiler output files get closed.
+  ok := false;
+  UNWIND_-PROTECT(
+      PROGN(res:= FUNCALL(fn,df,m,e,prefix,fal),
+            sayMSG ['"   finalizing ",$spadLibFT,:bright libName],
+            finalizeLisplib libName,
+	    ok := true),
+      RSHUT $libFile)
+  if ok then lisplibDoRename(libName)
+  filearg := $FILEP(libName,$spadLibFT,$libraryDirectory)
+  RPACKFILE filearg
+  FRESH_-LINE $algebraOutputStream
+  sayMSG fillerSpaces(72,'"-")
+  unloadOneConstructor(op,libName)
+  LOCALDATABASE(LIST GETDATABASE(op,'ABBREVIATION),NIL)
+  $newConlist := [op, :$newConlist]  ---------->  bound in function "compiler"
+  if $lisplibKind = 'category
+    then updateCategoryFrameForCategory op
+     else updateCategoryFrameForConstructor op
+  res
+ 
+compileDocumentation libName ==
+  filename := MAKE_-INPUT_-FILENAME(libName,$spadLibFT)
+  $FCOPY(filename,[libName,'DOCLB])
+  stream := RDEFIOSTREAM [['FILE,libName,'DOCLB],['MODE, :'O]]
+  lisplibWrite('"documentation",finalizeDocumentation(),stream)
+--  if $lisplibRelatedDomains then 
+--    lisplibWrite('"relatedDomains",$lisplibRelatedDomains,stream)
+  RSHUT(stream)
+  RPACKFILE([libName,'DOCLB])
+  $REPLACE([libName,$spadLibFT],[libName,'DOCLB])
+  ['dummy, $EmptyMode, $e]
+
+getLisplibVersion libName ==
+  stream := RDEFIOSTREAM [['FILE,libName,$spadLibFT],['MODE, :'I]]
+  version:= CADR rread('VERSION, stream,nil)
+  RSHUT(stream)
+  version
+ 
+initializeLisplib libName ==
+  _$ERASE(libName,'ERRORLIB,$libraryDirectory)
+  SETQ(ERRORS,0) -- ERRORS is a fluid variable for the compiler
+  $libFile:= writeLib1(libName,'ERRORLIB,$libraryDirectory)
+  ADDOPTIONS('FILE,$libFile)
+  $lisplibForm := nil             --defining form for lisplib
+  $lisplibModemap := nil          --modemap for constructor form
+  $lisplibKind := nil             --category, domain, or package
+  $lisplibModemapAlist := nil  --changed in "augmentLisplibModemapsFromCategory"
+  $lisplibAbbreviation := nil
+  $lisplibAncestors := nil
+  $lisplibOpAlist := nil  --operations alist for new runtime system
+  $lisplibOperationAlist := nil   --old list of operations for functor/package
+  $lisplibSuperDomain:= nil
+  -- next var changed in "augmentLisplibDependents"
+  $lisplibVariableAlist := nil    --this and the next are used by "luke"
+  $lisplibSignatureAlist := nil
+  if pathnameTypeId(_/EDITFILE) = 'SPAD
+    then LAM_,FILEACTQ('VERSION,['_/VERSIONCHECK,_/MAJOR_-VERSION])
+ 
+finalizeLisplib libName ==
+  lisplibWrite('"constructorForm",removeZeroOne $lisplibForm,$libFile)
+  lisplibWrite('"constructorKind",kind:=removeZeroOne $lisplibKind,$libFile)
+  lisplibWrite('"constructorModemap",removeZeroOne $lisplibModemap,$libFile)
+  $lisplibCategory:= $lisplibCategory or $lisplibModemap.mmTarget
+  -- set to target of modemap for package/domain constructors;
+  -- to the right-hand sides (the definition) for category constructors
+  lisplibWrite('"constructorCategory",$lisplibCategory,$libFile)
+  lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
+  lisplibWrite('"modemaps",removeZeroOne $lisplibModemapAlist,$libFile)
+  opsAndAtts:= getConstructorOpsAndAtts(
+    $lisplibForm,kind,$lisplibModemap)
+  lisplibWrite('"operationAlist",removeZeroOne CAR opsAndAtts,$libFile)
+  --lisplibWrite('"attributes",CDR opsAndAtts,$libFile)
+  --if kind='category then NRTgenInitialAttributeAlist CDR opsAndAtts
+  if kind='category then
+     $pairlis : local := [[a,:v] for a in rest $lisplibForm
+                                 for v in $FormalMapVariableList]
+     $NRTslot1PredicateList : local := []
+     NRTgenInitialAttributeAlist CDR opsAndAtts
+  lisplibWrite('"superDomain",removeZeroOne $lisplibSuperDomain,$libFile)
+  lisplibWrite('"signaturesAndLocals",
+    removeZeroOne mergeSignatureAndLocalVarAlists($lisplibSignatureAlist,
+                                    $lisplibVariableAlist),$libFile)
+  lisplibWrite('"attributes",removeZeroOne $lisplibAttributes,$libFile)
+  lisplibWrite('"predicates",removeZeroOne  $lisplibPredicates,$libFile)
+  lisplibWrite('"abbreviation",$lisplibAbbreviation,$libFile)
+  lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile)
+  lisplibWrite('"ancestors",removeZeroOne $lisplibAncestors,$libFile)
+  lisplibWrite('"documentation",finalizeDocumentation(),$libFile)
+  lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
+  if $profileCompiler then profileWrite()
+  if $lisplibForm and null CDR $lisplibForm then
+    MAKEPROP(CAR $lisplibForm,'NILADIC,'T)
+  ERRORS ^=0 =>    -- ERRORS is a fluid variable for the compiler
+    sayMSG ['"   Errors in processing ",kind,'" ",:bright libName,'":"]
+    sayMSG ['"     not replacing ",$spadLibFT,'" for",:bright libName]
+
+lisplibDoRename(libName) ==
+  _$REPLACE([libName,$spadLibFT,$libraryDirectory],
+    [libName,'ERRORLIB,$libraryDirectory])
+ 
+lisplibError(cname,fname,type,cn,fn,typ,error) ==
+  sayMSG bright ['"  Illegal ",$spadLibFT]
+  error in '(duplicateAbb  wrongType) =>
+    sayKeyedMsg("S2IL0007",
+      [namestring [fname,$spadLibFT],type,cname,typ,cn])
+  error is 'abbIsName =>
+    throwKeyedMsg("S2IL0008",[fname,typ,namestring [fn,$spadLibFT]])
+ 
+getPartialConstructorModemapSig(c) ==
+  (s := getConstructorSignature c) => rest s
+  throwEvalTypeMsg("S2IL0015",[c])
+ 
+mergeSignatureAndLocalVarAlists(signatureAlist, localVarAlist) ==
+  -- this function makes a single Alist for both signatures
+  -- and local variable types, to be stored in the LISPLIB
+  -- for the function being compiled
+  [[funcName,:[signature,:LASSOC(funcName,localVarAlist)]] for
+    [funcName, :signature] in signatureAlist]
+ 
+Operators u ==
+  ATOM u => []
+  ATOM first u =>
+    answer:="union"/[Operators v for v in rest u]
+    MEMQ(first u,answer) => answer
+    [first u,:answer]
+  "union"/[Operators v for v in u]
+ 
+getConstructorOpsAndAtts(form,kind,modemap) ==
+  kind is 'category => getCategoryOpsAndAtts(form)
+  getFunctorOpsAndAtts(form,modemap)
+ 
+getCategoryOpsAndAtts(catForm) ==
+  -- returns [operations,:attributes] of CAR catForm
+  [transformOperationAlist getSlotFromCategoryForm(catForm,1),
+    :getSlotFromCategoryForm(catForm,2)]
+ 
+getFunctorOpsAndAtts(form,modemap) ==
+  [transformOperationAlist getSlotFromFunctor(form,1,modemap),
+    :getSlotFromFunctor(form,2,modemap)]
+ 
+getSlotFromFunctor([name,:args],slot,[[.,target,:argMml],:.]) ==
+  slot = 1 => $lisplibOperationAlist
+  t := compMakeCategoryObject(target,$e) or
+      systemErrorHere '"getSlotFromFunctor"
+  t.expr.slot
+ 
+getSlot1 domainName ==
+  $e: local:= $CategoryFrame
+  fn:= getLisplibName domainName
+  p := pathname [fn,$spadLibFT,'"*"]
+  not isExistingFile(p) =>
+    sayKeyedMsg("S2IL0003",[namestring p])
+    NIL
+  (sig := getConstructorSignature domainName) =>
+    [.,target,:argMml] := sig
+    for a in $FormalMapVariableList for m in argMml repeat
+      $e:= put(a,'mode,m,$e)
+    t := compMakeCategoryObject(target,$e) or
+      systemErrorHere '"getSlot1"
+    t.expr.1
+  sayKeyedMsg("S2IL0022",[namestring p,'"constructor modemap"])
+  NIL
+ 
+transformOperationAlist operationAlist ==
+  --  this transforms the operationAlist which is written out onto LISPLIBs.
+  --  The original form of this list is a list of items of the form:
+  --        ((<op> <signature>) (<condition> (ELT $ n)))
+  --  The new form is an op-Alist which has entries (<op> . signature-Alist)
+  --      where signature-Alist has entries (<signature> . item)
+  --        where item has form (<slotNumber> <condition> <kind>)
+  --          where <kind> =
+  --             NIL  => function
+  --             CONST => constant ... and others
+  newAlist:= nil
+  for [[op,sig,:.],condition,implementation] in operationAlist repeat
+    kind:=
+      implementation is [eltEtc,.,n] and eltEtc in '(CONST ELT) => eltEtc
+      implementation is [impOp,:.] =>
+        impOp = 'XLAM => implementation
+        impOp in '(CONST Subsumed) => impOp
+        keyedSystemError("S2IL0025",[impOp])
+      implementation = 'mkRecord => 'mkRecord
+      keyedSystemError("S2IL0025",[implementation])
+    signatureItem:=
+      if u:= ASSOC([op,sig],$functionLocations) then n := [n,:rest u]
+      kind = 'ELT =>
+        condition = 'T => [sig,n]
+        [sig,n,condition]
+      [sig,n,condition,kind]
+    itemList:= [signatureItem,:LASSQ(op,newAlist)]
+    newAlist:= insertAlist(op,itemList,newAlist)
+  newAlist
+ 
+sayNonUnique x ==
+  sayBrightlyNT '"Non-unique:"
+  pp x
+ 
+-- flattenOperationAlist operationAlist ==
+--   --new form is (<op> <signature> <slotNumber> <condition> <kind>)
+--   [:[[op,:x] for x in y] for [op,:y] in operationAlist]
+ 
+getSlotFromDomain(dom,op,oldSig) ==
+  --  returns the slot number in the domain where the function whose
+  --  signature is oldSig may be found in the domain dom
+  oldSig:= removeOPT oldSig
+  dom:= removeOPT dom
+  sig:= SUBST("$",dom,oldSig)
+  loadIfNecessary first dom
+  isPackageForm dom => getSlotFromPackage(dom,op,oldSig)
+  domain:= evalDomain dom
+  n:= findConstructorSlotNumber(dom,domain,op,sig) =>
+    (slot:= domain.n).0 = Undef =>
+      throwKeyedMsg("S2IL0023A",[op,formatSignature sig,dom])
+    slot
+  throwKeyedMsg("S2IL0024A",[op,formatSignature sig,dom])
+ 
+findConstructorSlotNumber(domainForm,domain,op,sig) ==
+  null domain.1 => getSlotNumberFromOperationAlist(domainForm,op,sig)
+  sayMSG ['"   using slot 1 of ",domainForm]
+  constructorArglist:= rest domainForm
+  nsig:=#sig
+  tail:= or/[r for [[op1,sig1],:r] in domain.1 | op=op1 and nsig=#sig1 and
+    and/[compare for a in sig for b in sig1]] where compare ==
+      a=b => true
+      FIXP b => a=constructorArglist.b
+      isSuperDomain(bustUnion b,bustUnion a,$CategoryFrame)
+  tail is [.,["ELT",.,n]] => n
+  systemErrorHere '"findSlotNumber"
+ 
+bustUnion d ==
+  d is ["Union",domain,utype] and utype='"failed" => domain
+  d
+ 
+getSlotNumberFromOperationAlist(domainForm,op,sig) ==
+  constructorName:= CAR domainForm
+  constructorArglist:= CDR domainForm
+  operationAlist:=
+    GETDATABASE(constructorName, 'OPERATIONALIST) or
+      keyedSystemError("S2IL0026",[constructorName])
+  entryList:= QLASSQ(op,operationAlist) or return nil
+  tail:= or/[r for [sig1,:r] in entryList | sigsMatch(sig,sig1,domainForm)] =>
+    first tail
+  nil
+ 
+sigsMatch(sig,sig1,domainForm) ==
+  --  does signature "sig" match "sig1", where integers 1,2,.. in
+  --  sig1 designate corresponding arguments of domainForm
+  while sig and sig1 repeat
+    partsMatch:=
+      (item:= CAR sig)=(item1:= CAR sig1) => true --ok, go to next iteration
+      FIXP item1 => item = domainForm.item1       --item1=n means nth arg
+      isSuperDomain(bustUnion item,bustUnion item1,$CategoryFrame)
+    null partsMatch => return nil
+    sig:= rest sig; sig1 := rest sig1
+  sig or sig1 => nil
+  true
+ 
+findDomainSlotNumber(domain,op,sig) == --using slot 1 of the domain
+  nsig:=#sig
+  tail:= or/[r for [[op1,sig1],:r] in domain.1 | op=op1 and nsig=#sig1 and
+    and/[a=b or isSuperDomain(bustUnion b,bustUnion a,$CategoryFrame)
+      for a in sig for b in sig1]]
+  tail is [.,["ELT",.,n]] => n
+  systemErrorHere '"findDomainSlotNumber"
+ 
+ 
+getConstructorModemap form ==
+  GETDATABASE(opOf form, 'CONSTRUCTORMODEMAP)
+ 
+getConstructorSignature form ==
+  (mm := GETDATABASE(opOf(form),'CONSTRUCTORMODEMAP)) =>
+    [[.,:sig],:.] := mm
+    sig
+  NIL
+ 
+--% from MODEMAP BOOT
+ 
+augModemapsFromDomain1(name,functorForm,e) ==
+  GETL(KAR functorForm,"makeFunctionList") =>
+    addConstructorModemaps(name,functorForm,e)
+  atom functorForm and (catform:= getmode(functorForm,e)) =>
+    augModemapsFromCategory(name,name,functorForm,catform,e)
+  mappingForm:= getmodeOrMapping(KAR functorForm,e) =>
+    ["Mapping",categoryForm,:functArgTypes]:= mappingForm
+    catform:= substituteCategoryArguments(rest functorForm,categoryForm)
+    augModemapsFromCategory(name,name,functorForm,catform,e)
+  stackMessage [functorForm," is an unknown mode"]
+  e
+ 
+getSlotFromCategoryForm ([op,:argl],index) ==
+  u:= eval [op,:MAPCAR('MKQ,TAKE(#argl,$FormalMapVariableList))]
+  null VECP u =>
+    systemErrorHere '"getSlotFromCategoryForm"
+  u . index
+ 
+ 
+--% constructor evaluation
+--  The following functions are used by the compiler but are modified
+--  here for use with new LISPLIB scheme
+ 
+mkEvalableCategoryForm c ==       --from DEFINE
+  c is [op,:argl] =>
+    op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]]
+    op is "DomainSubstitutionMacro" =>
+        --$extraParms :local
+        --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms
+        --mkEvalableCategoryForm sublisV($extraParms, catobj)
+        mkEvalableCategoryForm CADR argl
+    op is "mkCategory" => c
+    MEMQ(op,$CategoryNames) =>
+      ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x)
+    --loadIfNecessary op
+    GETDATABASE(op,'CONSTRUCTORKIND) = 'category or
+      get(op,"isCategory",$CategoryFrame) =>
+        [op,:[quotifyCategoryArgument x for x in argl]]
+    [x,m,$e]:= compOrCroak(c,$EmptyMode,$e)
+    m=$Category => x
+  MKQ c
+ 
+isDomainForm(D,e) ==
+  --added for MPOLY 3/83 by RDJ
+  MEMQ(KAR D,$SpecialDomainNames) or isFunctor D or
+    -- ((D is ['Mapping,target,:.]) and isCategoryForm(target,e)) or
+     ((getmode(D,e) is ['Mapping,target,:.]) and isCategoryForm(target,e)) or
+       isCategoryForm(getmode(D,e),e) or isDomainConstructorForm(D,e)
+ 
+isDomainConstructorForm(D,e) ==
+  D is [op,:argl] and (u:= get(op,"value",e)) and
+    u is [.,["Mapping",target,:.],:.] and
+      isCategoryForm(EQSUBSTLIST(argl,$FormalMapVariableList,target),e)
+ 
+isFunctor x ==
+  op:= opOf x
+  not IDENTP op => false
+  $InteractiveMode =>
+    MEMQ(op,'(Union SubDomain Mapping Record)) => true
+    MEMQ(GETDATABASE(op,'CONSTRUCTORKIND),'(domain package))
+  u:= get(op,'isFunctor,$CategoryFrame)
+    or MEMQ(op,'(SubDomain Union Record)) => u
+  constructor? op =>
+    prop := get(op,'isFunctor,$CategoryFrame) => prop
+    if GETDATABASE(op,'CONSTRUCTORKIND) = 'category
+      then updateCategoryFrameForCategory op
+      else updateCategoryFrameForConstructor op
+    get(op,'isFunctor,$CategoryFrame)
+  nil
+ 
+ 
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/macex.boot.pamphlet b/src/interp/macex.boot.pamphlet
new file mode 100644
index 00000000..a275c59b
--- /dev/null
+++ b/src/interp/macex.boot.pamphlet
@@ -0,0 +1,211 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp macex.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Macro expansion
+--  Functions to transform parse forms.
+--
+--  Global variables:
+--    $pfMacros is an alist [[id, state, body-pform], ...]
+--       (set in newcompInit).
+--       state is one of: mbody, mparam, mlambda
+--
+--    $macActive is a list of the bodies being expanded.
+--    $posActive is a list of the parse forms where the bodies came from.
+ 
+-- Beware: the name macroExpand is used by the old compiler.
+macroExpanded pf ==
+    $macActive: local := []
+    $posActive: local := []
+ 
+    macExpand pf
+ 
+macExpand pf ==
+    pfWhere?       pf => macWhere   pf
+    pfLambda?      pf => macLambda  pf
+    pfMacro?       pf => macMacro pf
+ 
+    pfId?          pf => macId pf
+    pfApplication? pf => macApplication pf
+    pfMapParts(function macExpand, pf)
+ 
+macWhere pf ==
+    mac(pf,$pfMacros) where
+        mac(pf,$pfMacros) ==
+            -- pfWhereContext is before pfWhereExpr
+            pfMapParts(function macExpand, pf)
+ 
+macLambda pf ==
+    mac(pf,$pfMacros) where
+        mac(pf,$pfMacros) ==
+            pfMapParts(function macExpand, pf)
+
+macLambdaParameterHandling( replist , pform )  ==
+    pfLeaf? pform => []
+    pfLambda? pform =>      -- remove ( identifier . replacement ) from assoclist
+        parlist := [ pfTypedId p for p in pf0LambdaArgs pform ] -- extract parameters
+        for par in [ pfIdSymbol par for par in parlist ] repeat
+                replist := AlistRemoveQ(par,replist)
+        replist
+    pfMLambda? pform =>     -- construct assoclist ( identifier . replacement )
+        parlist := pf0MLambdaArgs pform  -- extract parameter list
+        [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ]
+    for p in pfParts pform repeat macLambdaParameterHandling( replist , p )
+
+macSubstituteId( replist , pform ) ==
+    ex := AlistAssocQ( pfIdSymbol pform , replist )
+    ex => 
+        RPLPAIR(pform,CDR ex)
+        pform
+    pform 
+
+macSubstituteOuter( pform ) == 
+    mac0SubstituteOuter( macLambdaParameterHandling( [] , pform ) , pform ) 
+    
+mac0SubstituteOuter( replist , pform ) == 
+    pfId? pform => macSubstituteId( replist , pform )
+    pfLeaf? pform => pform
+    pfLambda? pform => 
+        tmplist := macLambdaParameterHandling( replist , pform )
+        for p in pfParts pform repeat mac0SubstituteOuter( tmplist , p )
+        pform
+    for p in pfParts pform repeat mac0SubstituteOuter( replist , p )
+    pform
+ 
+-- This function adds the appropriate definition and returns
+-- the original Macro pform.
+macMacro pf ==
+    lhs := pfMacroLhs pf
+    rhs := pfMacroRhs pf
+    not pfId? lhs =>
+        ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] )
+        pf
+    sy := pfIdSymbol lhs
+
+    mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs)
+ 
+    if pfNothing? rhs then pf else pfMacro(lhs, pfNothing())
+ 
+mac0Define(sy, state, body) ==
+    $pfMacros := cons([sy, state, body], $pfMacros)
+ 
+-- Returns [state, body] or NIL.
+mac0Get sy ==
+    IFCDR ASSOC(sy, $pfMacros)
+ 
+-- Returns [sy, state] or NIL.
+mac0GetName body ==
+    name := nil
+    for [sy,st,bd] in $pfMacros while not name repeat
+        if st = 'mlambda then
+            bd := pfMLambdaBody bd
+        EQ(bd, body) => name := [sy,st]
+    name
+ 
+macId pf ==
+    sy := pfIdSymbol pf
+    not (got := mac0Get sy) => pf
+    [state, body] := got
+ 
+    state = 'mparam     => body                                         -- expanded already
+    state = 'mlambda    => pfCopyWithPos( body , pfSourcePosition pf )  -- expanded later
+ 
+    pfCopyWithPos( mac0ExpandBody(body, pf, $macActive, $posActive) , pfSourcePosition pf )
+ 
+macApplication pf ==
+    pf := pfMapParts(function macExpand, pf)
+ 
+    op := pfApplicationOp pf
+    not pfMLambda? op => pf
+ 
+    args := pf0ApplicationArgs pf
+    mac0MLambdaApply(op, args, pf, $pfMacros)
+ 
+mac0MLambdaApply(mlambda, args, opf, $pfMacros) ==
+    params := pf0MLambdaArgs mlambda
+    body   := pfMLambdaBody  mlambda
+    #args ^= #params =>
+        pos := pfSourcePosition opf
+        ncHardError(pos,'S2CM0003, [#params,#args])
+    for p in params for a in args repeat
+        not pfId? p =>
+            pos := pfSourcePosition opf
+            ncHardError(pos, 'S2CM0004, [%pform p])
+        mac0Define(pfIdSymbol p, 'mparam, a)
+ 
+    mac0ExpandBody( body , opf, $macActive, $posActive)
+ 
+mac0ExpandBody(body, opf, $macActive, $posActive) ==
+    MEMQ(body,$macActive) =>
+        [.,pf] := $posActive
+        posn   := pfSourcePosition pf
+        mac0InfiniteExpansion(posn, body, $macActive)
+    $macActive := [body, :$macActive]
+    $posActive := [opf,  :$posActive]
+    macExpand body
+ 
+mac0InfiniteExpansion(posn, body, active) ==
+    blist := [body, :active]
+    [fname, :rnames] := [name b for b in blist] where
+        name b ==
+            got := mac0GetName b
+            not got => '"???"
+            [sy,st] := got
+            st = 'mlambda => CONCAT(PNAME sy, '"(...)")
+            PNAME sy
+    ncSoftError (posn, 'S2CM0005, _
+       [ [:[n,'"==>"] for n in reverse rnames], fname, %pform body ]  )
+ 
+    body
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet
new file mode 100644
index 00000000..743af743
--- /dev/null
+++ b/src/interp/macros.lisp.pamphlet
@@ -0,0 +1,1732 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/macros.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\begin{verbatim}
+PURPOSE: Provide generally useful macros and functions for MetaLanguage
+         and Boot code.  Contents are organized along Common Lisp datatype
+         lines, with sections numbered to match the section headings of the
+         Common Lisp Reference Manual, by Guy Steele, Digital Press, 1984,
+         Digital Press Order Number EY-00031-DP.  This way you can
+         look up the corresponding section in the manual and see if
+         there isn't a cleaner and non-VM-specific way of doing things.
+ 
+\end{verbatim}
+
+\section{Performance change}
+
+Camm has identified a performace problem during compiles. There is
+a loop that continually adds one element to a vector. This causes
+the vector to get extended by 1 and copied. These patches fix the 
+problem since vectors with fill pointers don't need to be copied.
+
+These cut out the lion's share of the gc problem
+on this compile.  30min {\tt ->} 7 min on my box.  There is still some gc
+churning in cons pages due to many calls to 'list' with small n.  One
+can likely improve things further with an appropriate (declare
+(:dynamic-extent ...)) in the right place -- gcl will allocate such
+lists on the C stack (very fast).
+
+\subsection{lengthenvec}
+
+The original code was:
+\begin{verbatim}
+(defun lengthenvec (v n)
+  (if (adjustable-array-p v) (adjust-array v n)
+    (replace (make-array n) v)))
+\end{verbatim}
+
+<<lengthenvec>>=
+(defun lengthenvec (v n)
+  (if 
+    (and (array-has-fill-pointer-p v) (adjustable-array-p v))
+    (if 
+      (>= n (array-total-size v)) 
+        (adjust-array v (* n 2) :fill-pointer n) 
+        (progn 
+          (setf (fill-pointer v) n) 
+          v))
+    (replace (make-array n :fill-pointer t) v)))
+
+@
+
+\subsection{make-init-vector}
+
+The original code was
+\begin{verbatim}
+(defun make-init-vector (n val) (make-array n :initial-element val))
+\end{verbatim}
+
+<<make-init-vector>>=
+(defun make-init-vector (n val) 
+  (make-array n :initial-element val :fill-pointer t))
+
+@
+
+\section{DEFUN CONTAINED}
+
+The [[CONTAINED]] predicate is used to walk internal structures
+such as modemaps to see if the $X$ object occurs within $Y$. One
+particular use is in a function called [[isPartialMode]] (see
+i-funsel.boot) to decide
+if a modemap is only partially complete. If this is true then the 
+modemap will contain the constant [[$EmptyMode]]. So the call 
+ends up being [[CONTAINED |$EmptyMode| Y]]. 
+<<DEFUN CONTAINED>>=
+#-:CCL
+(DEFUN CONTAINED (X Y)
+  (if (symbolp x)
+      (contained\,eq X Y)
+      (contained\,equal X Y)))
+ 
+(defun contained\,eq (x y)
+       (if (atom y) (eq x y)
+           (or (contained\,eq x (car y)) (contained\,eq x (cdr y)))))
+ 
+(defun contained\,equal (x y)
+   (cond ((atom y) (equal x y))
+         ((equal x y) 't)
+         ('t (or (contained\,equal x (car y)) (contained\,equal x (cdr y))))))
+ 
+@
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(provide 'Boot)
+ 
+(in-package "BOOT")
+ 
+(defvar |$compilingMap| ())
+(defvar |$definingMap| nil)
+ 
+(defmacro KAR (ARG) `(ifcar ,arg))
+(defmacro KDR (ARG) `(ifcdr ,arg))
+(defmacro KADR (ARG) `(ifcar (ifcdr ,arg)))
+(defmacro KADDR (ARG) `(ifcar (ifcdr (ifcdr ,arg))))
+
+; 5 PROGRAM STRUCTURE
+ 
+; 5.3 Top-Level Forms
+ 
+(defun SETANDFILE (x y) (LAM\,EVALANDFILEACTQ `(setq ,x ',y)))
+ 
+; 5.3.2 Declaring Global Variables and Named Constants
+ 
+(defmacro |function| (name) `(FUNCTION ,name))
+(defmacro |dispatchFunction| (name) `(FUNCTION ,name))
+ 
+(defun |functionp| (fn)
+   (if (identp fn) (and (fboundp fn) (not (macro-function fn))) (functionp fn)))
+(defun |macrop| (fn) (and (identp fn) (macro-function fn)))
+ 
+; 6 PREDICATES
+ 
+; 6.2 Data Type Predicates
+ 
+; 6.3 Equality Predicates
+ 
+;; qeqcar should be used when you know the first arg is a pair
+;; the second arg should either be a literal fixnum or a symbol
+;; the car of the first arg is always of the same type as the second
+;; use eql unless we are sure fixnums are represented canonically
+ 
+#-lucid
+(defmacro qeqcar (x y)
+  (if (integerp y) `(eql (the fixnum (qcar ,x)) (the fixnum ,y))
+      `(eq (qcar ,x) ,y)))
+ 
+#+lucid
+(defmacro qeqcar (x y) `(eq (qcar ,x) ,y))
+ 
+ 
+(defun COMPARE (X Y)
+  "True if X is an atom or X and Y are lists and X and Y are equal up to X."
+  (COND ((ATOM X) T)
+        ((ATOM Y) NIL)
+        ((EQUAL (CAR X) (CAR Y)) (COMPARE (CDR X) (CDR Y)))))
+ 
+ 
+(DEFUN ?ORDER (U V)  "Multiple-type ordering relation."
+  (COND ((NULL U))
+        ((NULL V) NIL)
+        ((ATOM U)
+         (if (ATOM V)
+             (COND ((NUMBERP U) (if (NUMBERP V) (> V U) T))
+                   ((NUMBERP V) NIL)
+                   ((IDENTP U) (AND (IDENTP V) (string> (SYMBOL-NAME V) (SYMBOL-NAME U))))
+                   ((IDENTP V) NIL)
+                   ((STRINGP U) (AND (STRINGP V) (string> V U)))
+                   ((STRINGP V) NIL)
+                   ((AND (VECP U) (VECP V))
+                    (AND (> (SIZE V) (SIZE U))
+                         (DO ((I 0 (1+ I)))
+                             ((GT I (MAXINDEX U)) 'T)
+                           (COND ((NOT (EQUAL (ELT U I) (ELT V I)))
+                                  (RETURN (?ORDER (ELT U I) (ELT V I))))))))
+                   ((croak "Do not understand")))
+               T))
+        ((ATOM V) NIL)
+        ((EQUAL U V))
+        ((NOT (string> (write-to-string U) (write-to-string V))))))
+ 
+(defmacro boot-equal (a b)
+   (cond ((ident-char-lit a)
+           `(or (eql ,a ,b) (eql (character ,a) ,b)))
+	 ((ident-char-lit b)
+           `(or (eql ,a ,b) (eql ,a (character ,b))))
+	 (t `(eqqual ,a ,b))))
+ 
+(defun ident-char-lit (x)
+   (and (eqcar x 'quote) (identp (cadr x)) (= (length (pname (cadr x))) 1)))
+ 
+(defmacro EQQUAL (a b)
+  (cond ((OR (EQUABLE a) (EQUABLE b)) `(eq ,a ,b))
+	((OR (numberp a) (numberp b)) `(eql ,a ,b))
+	(t  `(equal ,a ,b))))
+ 
+(defmacro NEQUAL (a b) `(not (BOOT-EQUAL ,a ,b)))
+ 
+(defun EQUABLE (X)
+  (OR (NULL X) (AND (EQCAR X 'QUOTE) (symbolp (CADR X)))))
+ 
+; 7 CONTROL STRUCTURE
+ 
+; 7.1 Constants and Variables
+ 
+; 7.1.1 Reference
+ 
+(DEFUN MKQ (X)
+  "Evaluates an object and returns it with QUOTE wrapped around it."
+  (if (NUMBERP X) X (LIST 'QUOTE X)))
+ 
+; 7.2 Generalized Variables
+ 
+(defmacro IS (x y) `(dcq ,y ,x))
+ 
+(defmacro LETT (var val &rest L)
+  (COND
+    (|$QuickLet| `(SETQ ,var ,val))
+    (|$compilingMap|
+   ;; map tracing
+     `(PROGN
+        (SETQ ,var ,val)
+        (COND (|$letAssoc|
+               (|mapLetPrint| ,(MKQ var)
+                              ,var
+                              (QUOTE ,(KAR L))))
+              ('T ,var))))
+     ;; used for LETs in SPAD code --- see devious trick in COMP,TRAN,1
+     ((ATOM var)
+      `(PROGN
+         (SETQ ,var ,val)
+         (IF |$letAssoc|
+             ,(cond ((null (cdr l))
+                     `(|letPrint| ,(MKQ var) ,var (QUOTE ,(KAR L))))
+                    ((and (eqcar (car l) 'SPADCALL) (= (length (car l)) 3))
+                     `(|letPrint3| ,(MKQ var) ,var ,(third (car l)) (QUOTE ,(KADR L))))
+                    (t `(|letPrint2| ,(MKQ var) ,(car l) (QUOTE ,(KADR L))))))
+         ,var))
+     ('T (ERROR "Cannot compileLET construct"))))
+ 
+(defmacro SPADLET (A B)
+  (if (ATOM A) `(SETQ ,A ,B)
+     `(OR (IS ,B ,A) (LET_ERROR ,(MK_LEFORM A) ,(MKQ B) ))))
+ 
+(defmacro RPLAC (&rest L)
+  (if (EQCAR (CAR L) 'ELT)
+      (LIST 'SETELT (CADAR L) (CADDR (CAR L)) (CADR L))
+      (let ((A (CARCDREXPAND (CAR L) NIL)) (B (CADR L)))
+        (COND ((CDDR L) (ERROR 'RPLAC))
+              ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
+              ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
+              ((ERROR 'RPLAC))))))
+ 
+(MAPC #'(LAMBDA (J) (MAKEPROP (CAR J) 'SELCODE (CADR J)))
+      '((CAR 2) (CDR 3) (CAAR 4) (CADR 5) (CDAR 6) (CDDR 7)
+        (CAAAR 8) (CAADR 9) (CADAR 10) (CADDR 11) (CDAAR 12)
+        (CDADR 13) (CDDAR 14) (CDDDR 15) (CAAAAR 16) (CAAADR 17)
+        (CAADAR 18) (CAADDR 19) (CADAAR 20) (CADADR 21) (CADDAR 22)
+        (CADDDR 23) (CDAAAR 24) (CDAADR 25) (CDADAR 26) (CDADDR 27)
+        (CDDAAR 28) (CDDADR 29) (CDDDAR 30) (CDDDDR 31)))
+ 
+(eval-when (compile eval load)
+(defun CARCDREXPAND (X FG)    ; FG = TRUE FOR CAR AND CDR
+    (let (n hx)
+      (COND ((ATOM X) X)
+            ((SETQ N (GET (RENAME (SETQ HX (CARCDREXPAND (CAR X) FG))) 'SELCODE))
+             (CARCDRX1 (CARCDREXPAND (CADR X) FG) N FG))
+            ((CONS HX (MAPCAR #'(LAMBDA (Y) (CARCDREXPAND Y FG)) (CDR X)))))))
+ 
+(DEFUN RENAME (U) 
+ (let (x)
+  (if (AND (IDENTP U) (SETQ X (GET U 'NEWNAM))) X U)))
+ 
+(defun CARCDRX1 (X N FG)      ; FG = TRUE FOR CAR AND CDR
+    (COND ((< N 1) (fail))
+          ((EQL N 1) X)
+          ((let ((D (DIVIDE N 2)))
+             (CARCDRX1 (LIST (if (EQL (CADR D) 0) (if FG 'CAR 'CAR) (if FG 'CDR 'CDR)) X)
+                       (CAR D)
+                       FG))))))
+ 
+ 
+; 7.3 Function Invocation
+ 
+(DEFUN APPLYR (L X) (if (not L) X  (LIST (CAR L) (APPLYR (CDR L) X))))
+ 
+; 7.8 Iteration
+ 
+; 7.8.2 General Iteration
+ 
+(defmacro REPEAT (&rest L)
+  (let ((U (REPEAT-TRAN L NIL))) (-REPEAT (CDR U) (CAR U))))
+ 
+(defun REPEAT-TRAN (L LP)
+  (COND ((ATOM L) (ERROR "REPEAT FORMAT ERROR"))
+        ((MEMBER (KAR (KAR L))
+                 '(EXIT RESET IN ON GSTEP ISTEP STEP GENERAL UNTIL WHILE SUCHTHAT EXIT))
+         (REPEAT-TRAN (CDR L) (CONS (CAR L) LP)))
+        ((CONS (NREVERSE LP) (MKPF L 'PROGN)))))
+ 
+(DEFUN MKPF (L OP)
+  (if (FLAGP OP 'NARY) (SETQ L (MKPFFLATTEN-1 L OP NIL)))
+  (MKPF1 L OP))
+ 
+(DEFUN MKPFFLATTEN (X OP)
+  (COND ((ATOM X) X)
+        ((EQL (CAR X) OP) (CONS OP (MKPFFLATTEN-1 (CDR X) OP NIL)))
+        ((CONS (MKPFFLATTEN (CAR X) OP) (MKPFFLATTEN (CDR X) OP)))))
+ 
+(DEFUN MKPFFLATTEN-1 (L OP R)
+  (let (X)
+    (if (NULL L)
+        R
+        (MKPFFLATTEN-1 (CDR L) OP
+           (APPEND R (if (EQCAR (SETQ X
+                                      (MKPFFLATTEN (CAR L) OP)) OP)
+                         (CDR X) (LIST X)))))))
+ 
+(DEFUN MKPF1 (L OP)
+  (let (X) (case OP (PLUS (COND ((EQL 0 (SETQ X (LENGTH
+                                                 (SETQ L (S- L '(0 (ZERO))))))) 0)
+                                ((EQL 1 X) (CAR L))
+                                ((CONS 'PLUS L)) ))
+                 (TIMES (COND ((S* L '(0 (ZERO))) 0)
+                              ((EQL 0 (SETQ X (LENGTH
+                                               (SETQ L (S- L '(1 (ONE))))))) 1)
+                              ((EQL 1 X) (CAR L))
+                              ((CONS 'TIMES L)) ))
+                 (QUOTIENT (COND ((GREATERP (LENGTH L) 2) (fail))
+                                 ((EQL 0 (CAR L)) 0)
+                                 ((EQL (CADR L) 1) (CAR L))
+                                 ((CONS 'QUOTIENT L)) ))
+                 (MINUS (COND ((CDR L) (FAIL))
+                              ((NUMBERP (SETQ X (CAR L))) (MINUS X))
+                              ((EQCAR X 'MINUS) (CADR X))
+                              ((CONS 'MINUS L))  ))
+                 (DIFFERENCE (COND ((GREATERP (LENGTH L) 2) (FAIL))
+                                   ((EQUAL (CAR L) (CADR L)) '(ZERO))
+                                   ((|member| (CAR L) '(0 (ZERO))) (MKPF (CDR L) 'MINUS))
+                                   ((|member| (CADR L) '(0 (ZERO))) (CAR L))
+                                   ((EQCAR (CADR L) 'MINUS)
+                                    (MKPF (LIST (CAR L) (CADADR L)) 'PLUS))
+                                   ((CONS 'DIFFERENCE L)) ))
+                 (EXPT (COND ((GREATERP (LENGTH L) 2) (FAIL))
+                             ((EQL 0 (CADR L)) 1)
+                             ((EQL 1 (CADR L)) (CAR L))
+                             ((|member| (CAR L) '(0 1 (ZERO) (ONE))) (CAR L))
+                             ((CONS 'EXPT L)) ))
+                 (OR (COND ((MEMBER 'T L) ''T)
+                           ((EQL 0 (SETQ X (LENGTH (SETQ L (REMOVE NIL L))))) NIL)
+                           ((EQL 1 X) (CAR L))
+                           ((CONS 'OR L)) ))
+                 (|or| (COND ((MEMBER 'T L) 'T)
+                             ((EQL 0 (SETQ X (LENGTH (SETQ L (REMOVE NIL L))))) NIL)
+                             ((EQL 1 X) (CAR L))
+                             ((CONS 'or L)) ))
+                 (NULL (COND ((CDR L) (FAIL))
+                             ((EQCAR (CAR L) 'NULL) (CADAR L))
+                             ((EQL (CAR L) 'T) NIL)
+                             ((NULL (CAR L)) ''T)
+                             ((CONS 'NULL L)) ))
+                 (|and| (COND ((EQL 0 (SETQ X (LENGTH
+                                               (SETQ L (REMOVE T (REMOVE '|true| L)))))) T)
+                              ((EQL 1 X) (CAR L))
+                              ((CONS '|and| L)) ))
+                 (AND (COND ((EQL 0 (SETQ X (LENGTH
+                                             (SETQ L (REMOVE T (REMOVE '|true| L)))))) ''T)
+                            ((EQL 1 X) (CAR L))
+                            ((CONS 'AND L)) ))
+                 (PROGN (COND ((AND (NOT (ATOM L)) (NULL (LAST L)))
+                               (if (CDR L) `(PROGN . ,L) (CAR L)))
+                              ((NULL (SETQ L (REMOVE NIL L))) NIL)
+                              ((CDR L) (CONS 'PROGN L))
+                              ((CAR L))))
+                 (SEQ (COND ((EQCAR (CAR L) 'EXIT) (CADAR L))
+                            ((CDR L) (CONS 'SEQ L))
+                            ((CAR L))))
+                 (LIST (if L (cons 'LIST L)))
+                 (CONS (if (cdr L) (cons 'CONS L) (car L)))
+                 (t (CONS OP L) ))))
+ 
+(defvar $TRACELETFLAG NIL "Also referred to in Comp.Lisp")
+ 
+(defmacro |Zero| (&rest L) 
+ (declare (ignore l)) 
+ "Needed by spadCompileOrSetq" 0)
+ 
+(defmacro |One| (&rest L)
+ (declare (ignore l))
+ "Needed by spadCompileOrSetq" 1)
+ 
+(defun -REPEAT (BD SPL)
+  (let (u g g1 inc final xcl xv il rsl tll funPLUS funGT fun? funIdent
+        funPLUSform funGTform)
+    (DO ((X SPL (CDR X)))
+        ((ATOM X)
+         (LIST 'spadDO (NREVERSE IL) (LIST (MKPF (NREVERSE XCL) 'OR) XV)
+               (SEQOPT (CONS 'SEQ (NCONC (NREVERSE RSL) (LIST (LIST 'EXIT BD)))))))
+      (COND ((ATOM (CAR X)) (FAIL)))
+      (COND ((AND (EQ (CAAR X) 'STEP)
+                  (|member| (CADDAR X) '(2 1 0 (|One|) (|Zero|)))
+                  (|member| (CADR (CDDAR X)) '(1 (|One|))))
+             (SETQ X (CONS (CONS 'ISTEP (CDAR X)) (CDR X))) ))
+                        ; A hack to increase the likelihood of small integers
+      (SETQ U (CDAR X))
+      (case (CAAR X)
+        (GENERAL (AND (CDDDR U) (PUSH (CADDDR U) XCL))
+                 (PUSH (LIST (CAR U) (CADR U) (CADDR U)) IL) )
+        (GSTEP
+          (SETQ tll (CDDDDR U))  ;tll is (+fun >fun type? ident)
+          (SETQ funPLUSform (CAR tll))
+          (SETQ funGTform   (CAR (SETQ tll (QCDR tll))))
+          (PUSH (LIST (SETQ funPLUS (GENSYM)) funPLUSform) IL)
+          (PUSH (LIST (SETQ funGT   (GENSYM)) funGTform) IL)
+          (COND ((SETQ tll (CDR tll)) 
+            (SETQ fun?     (CAR tll))
+            (SETQ funIdent (CAR (SETQ tll (QCDR tll))))))
+	  (IF (NOT (ATOM (SETQ inc (CADDR U)) ))
+	      (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL))
+	  (SETQ final (CADDDR U))
+          (COND (final
+	     (COND ((ATOM final))
+                   ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL)))
+		 ; If CADDDR U is not an atom, only compute the value once
+             (PUSH
+                (if fun? 
+                      (if (FUNCALL fun? INC)
+                          (if  (FUNCALL (EVAL funGTform) INC funIdent) 
+                               (LIST 'FUNCALL funGT (CAR U) FINAL)
+                               (LIST 'FUNCALL funGT FINAL (CAR U)))
+                           (LIST 'IF (LIST 'FUNCALL funGT INC funIdent)
+                                     (LIST 'FUNCALL funGT (CAR U) FINAL)
+                                     (LIST 'FUNCALL funGT FINAL  (CAR U))))
+                       (LIST 'FUNCALL funGT (CAR U) final))
+                     XCL)))
+	  (PUSH (LIST (CAR U) (CADR U) (LIST 'FUNCALL funPLUS (CAR U) INC)) IL))
+        (STEP
+	  (IF (NOT (ATOM (SETQ inc (CADDR U)) ))
+	      (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL))
+	  (COND ((CDDDR U)
+		 (COND ((ATOM (SETQ final (CADDDR U)) ))
+		       ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL)))
+		 ; If CADDDR U is not an atom, only compute the value once
+		 (PUSH
+		   (if (INTEGERP INC)
+		       (LIST (if  (MINUSP INC) '< '>) (CAR U) FINAL)
+		     `(if (MINUSP ,INC)
+			  (< ,(CAR U) ,FINAL)
+			(> ,(CAR U) ,FINAL)))
+		       XCL)))
+	  (PUSH (LIST (CAR U) (CADR U) (LIST '+ (CAR U) INC)) IL))
+        (ISTEP
+	  (IF (NOT (ATOM (SETQ inc (CADDR U)) ))
+	      (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL))
+          (COND ((CDDDR U)
+                 (COND ((ATOM (SETQ final (CADDDR U)) ))
+                       ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL)))
+                     ; If CADDDR U is not an atom, only compute the value once
+                 (PUSH
+		   (if (INTEGERP INC)
+		       (LIST (if  (QSMINUSP INC) 'QSLESSP 'QSGREATERP)
+			     (CAR U) FINAL)
+		     `(if (QSMINUSP ,INC)
+			  (QSLESSP ,(CAR U) ,FINAL)
+			(QSGREATERP ,(CAR U) ,FINAL)))
+                       XCL)))
+          (PUSH (LIST (CAR U) (CADR U)
+                      (COND ((|member| INC '(1 (|One|)))
+			     (MKQSADD1 (CAR U)))
+                            ((LIST 'QSPLUS (CAR U) INC)) ))
+                IL))
+        (ON (PUSH (LIST 'ATOM (CAR U)) XCL)
+            (PUSH (LIST (CAR U) (CADR U) (LIST 'CDR (CAR U))) IL))
+        (RESET (PUSH (LIST 'PROGN (CAR U) NIL) XCL))
+        (IN
+          (PUSH (LIST 'OR
+                      (LIST 'ATOM (SETQ G (GENSYM)))
+                      (CONS 'PROGN
+                            (CONS
+                              (LIST 'SETQ (CAR U) (LIST 'CAR G))
+                              (APPEND
+                                (COND ((AND (symbol-package (car U)) $TRACELETFLAG)
+                                       (LIST (LIST '/TRACELET-PRINT (CAR U)
+                                                   (CAR U))))
+                                      (NIL))
+                                (LIST NIL))))  ) XCL)
+          (PUSH (LIST G (CADR U) (LIST 'CDR G)) IL)
+          (PUSH (LIST (CAR U) NIL) IL))
+        (INDOM (SETQ G (GENSYM))
+               (SETQ G1 (GENSYM))
+               (PUSH (LIST 'ATOM G) XCL)
+               (PUSH (LIST G (LIST 'INDOM-FIRST (CADR U))
+                           (LIST 'INDOM-NEXT G1)) IL)
+               (PUSH (LIST (CAR U) NIL) IL)
+               (PUSH (LIST G1 NIL) IL)
+               (PUSH (LIST 'SETQ G1 (LIST 'CDR G)) RSL)
+               (PUSH (LIST 'SETQ (CAR U) (LIST 'CAR G)) RSL))
+        (UNTIL (SETQ G (GENSYM)) (PUSH (LIST G NIL (CAR U)) IL) (PUSH G XCL))
+        (WHILE (PUSH (LIST 'NULL (CAR U)) XCL))
+        (SUCHTHAT (SETQ BD (LIST 'SUCHTHATCLAUSE BD (CAR U))))
+        (EXIT (SETQ XV (CAR U))) (FAIL)))))
+ 
+
+(defun SEQOPT (U)
+  (if (AND (EQCAR U 'SEQ) (EQCAR (CADR U) 'EXIT) (EQCAR (CADADR U) 'SEQ))
+      (CADADR U)
+      U))
+ 
+(defmacro SUCHTHATCLAUSE  (&rest L) (LIST 'COND (LIST (CADR L) (CAR L))))
+ 
+(defvar $NEWSPAD NIL)
+(defvar $BOOT NIL)
+ 
+(defmacro spadDO (&rest OL)
+    (PROG (VARS L VL V U INITS U-VARS U-VALS ENDTEST EXITFORMS BODYFORMS)
+         (if (OR $BOOT (NOT $NEWSPAD)) (return (CONS 'DO OL)))
+         (SETQ L  (copy-list OL))
+         (if (OR (ATOM L) (ATOM (CDR L))) (GO BADO))
+         (setq vl (POP L))
+         (COND ((IDENTP VL)
+                (SETQ VARS (LIST VL))
+                (AND (OR (ATOM L)
+                         (ATOM (progn (setq inits (POP L)) L))
+                         (ATOM (progn (setq u-vals (pop L)) L)))
+                     (GO BADO))
+                (SETQ INITS (LIST INITS) U-VARS (LIST (CAR VARS)) U-VALS (LIST U-VALS))
+                (setq endtest (POP L)))
+               ((prog nil
+                        (COND ((NULL VL) (GO TG5)) ((ATOM VL) (GO BADO)))
+                 G180   (AND (NOT (PAIRP (SETQ V (CAR VL)))) (SETQ V (LIST V)))
+                        (AND (NOT (IDENTP (CAR V))) (GO BADO))
+                        (PUSH (CAR V) VARS)
+                        (PUSH (COND ((PAIRP (CDR V)) (CADR V))) INITS)
+                        (AND (PAIRP (CDR V))
+                             (PAIRP (CDDR V))
+                             (SEQ (PUSH (CAR V) U-VARS)
+                                  (PUSH (CADDR V) U-VALS)))
+                        (AND (PAIRP (progn (POP VL) VL)) (GO G180))
+                    TG5 (setq exitforms (POP L))
+                        (and (PAIRP EXITFORMS)
+                             (progn (setq endtest (POP EXITFORMS)) exitforms)))))
+         (AND L
+           (COND ((CDR L) (SETQ BODYFORMS (CONS 'SEQ L)))
+                 ((NULL (EQCAR (CAR L) 'SEQ)) (SETQ BODYFORMS (CONS 'SEQ L)))
+                 ((SETQ BODYFORMS (CAR L)))))
+         (SETQ EXITFORMS `(EXIT ,(MKPF EXITFORMS 'PROGN)))
+         (AND ENDTEST (SETQ ENDTEST (LIST 'COND (LIST ENDTEST '(GO G191)))))
+         (COND ((NULL U-VARS) (GO XT) )
+               ((NULL (CDR U-VARS))
+                (SEQ (SETQ U-VARS (LIST 'SETQ (CAR U-VARS) (CAR U-VALS)))
+                     (GO XT)) ))
+         (SETQ VL (LIST 'SETQ (CAR U-VARS) (CAR U-VALS)))
+         (SEQ (SETQ V (CDR U-VARS)) (SETQ U (CDR U-VALS)))
+     TG  (SETQ VL (LIST 'SETQ (CAR V) (LIST 'PROG1 (CAR U) VL)))
+         (POP U)
+         (AND (progn (POP V) V)  (GO TG))
+         (SETQ U-VARS VL)
+     XT  (RETURN (COND
+           ((AND $NEWSPAD (NULL $BOOT))
+             (CONS 'SEQ (NCONC (DO_LET VARS INITS)
+               (LIST 'G190 ENDTEST BODYFORMS U-VARS '(GO G190)
+                'G191 EXITFORMS))))
+           ((CONS `(LAMBDA ,(NRECONC VARS NIL)
+                     (SEQ G190 ,ENDTEST ,BODYFORMS ,U-VARS (GO G190) G191 ,EXITFORMS))
+                  (NRECONC INITS NIL)))))
+   BADO  (ERROR (FORMAT NIL "BAD DO FORMAT~%~A" OL))))
+ 
+(defun DO_LET (VARS INITS)
+  (if (OR (NULL VARS) (NULL INITS)) NIL
+      (CONS (LIST 'SPADLET (CAR VARS) (CAR INITS))
+           (DO_LET (CDR VARS) (CDR INITS)))))
+ 
+#-:CCL
+(defun NREVERSE0 (X) ; Already built-in to CCL
+  "Returns LST, reversed. The argument is modified.
+This version is needed so that (COLLECT (IN X Y) ... (RETURN 'JUNK))=>JUNK."
+ (if (ATOM X) X (NREVERSE X)))
+ 
+; 7.8.4 Mapping
+ 
+(defmacro COLLECT (&rest L)
+  (let ((U (REPEAT-TRAN L NIL)))
+    (CONS 'THETA (CONS '\, (NCONC (CAR U) (LIST (CDR U)))))))
+ 
+;; The following was changed to a macro for efficiency in CCL.  To change
+;; it back to a function would require recompilation of a large chunk of
+;; the library.
+(defmacro PRIMVEC2ARR (x) x) ;redefine to change Array rep
+
+(defmacro COLLECTVEC (&rest L)
+   `(PRIMVEC2ARR (COLLECTV ,@L)))
+
+(defmacro COLLECTV (&rest L)
+  (PROG (CONDS BODY ANS COUNTER X Y)
+         ;If we can work out how often we will go round
+         ;allocate a vector first
+    (SETQ CONDS NIL)
+    (SETQ BODY (REVERSE L))
+    (SETQ ANS (GENSYM))
+    (SETQ COUNTER NIL)
+    (SETQ X (CDR BODY))
+    (SETQ BODY (CAR BODY))
+LP  (COND ((NULL X)
+            (COND ((NULL COUNTER)
+                    (SETQ COUNTER (GENSYM))
+                    (SETQ L (CONS (LIST 'ISTEP COUNTER 0 1) L)) ))
+            (RETURN (LIST 'PROGN
+                          (LIST 'SPADLET ANS
+                                     (LIST 'GETREFV
+                                           (COND ((NULL CONDS) (fail))
+                                                 ((NULL (CDR CONDS))
+                                                   (CAR CONDS))
+                                                   ((CONS 'MIN CONDS)) ) ))
+                          (CONS 'REPEAT (NCONC (CDR (REVERSE L))
+                                        (LIST (LIST 'SETELT ANS COUNTER BODY))))
+                          ANS)) ))
+    (SETQ Y (CAR X))
+    (SETQ X (CDR X))
+    (COND ((MEMQ (CAR Y) '(SUCHTHAT WHILE UNTIL))
+                (RETURN (LIST 'LIST2VEC (CONS 'COLLECT L)) ))
+          ((member (CAR Y) '(IN ON) :test #'eq)
+            (SETQ CONDS (CONS (LIST 'SIZE (CADDR Y)) CONDS))
+            (GO LP))
+          ((member (CAR Y) '(STEP ISTEP) :test #'eq)
+            (if (AND (EQL (CADDR Y) 0) (EQL (CADDDR Y) 1))
+		(SETQ COUNTER (CADR Y)) )
+            (COND ((CDDDDR Y)    ; there may not be a limit
+                   (SETQ CONDS (CONS
+                                 (COND ((EQL 1 (CADDDR Y))
+                                        (COND ((EQL 1 (CADDR Y)) (CAR (CDDDDR Y)))
+                                              ((EQL 0 (CADDR Y)) (MKQSADD1 (CAR (CDDDDR Y))))
+                                              ((MKQSADD1 `(- ,(CAR (CDDDDR Y)) ,(CADDR Y))))))
+                                       ((EQL 1 (CADDR Y)) `(/ ,(CAR (CDDDDR Y)) ,(CADDR Y)))
+                                       ((EQL 0 (CADDR Y))
+                                        `(/ ,(MKQSADD1 (CAR (CDDDDR Y))) ,(CADDR Y)))
+                                       (`(/ (- ,(MKQSADD1 (CAR (CDDDDR Y))) ,(CADDR Y))
+                                            ,(CADDR Y))))
+                                 CONDS))))
+            (GO LP)))
+  (ERROR "Cannot handle macro expansion")))
+ 
+(defun MKQSADD1 (X)
+  (COND ((ATOM X) `(QSADD1 ,X))
+        ((AND (member (CAR X) '(-DIFFERENCE QSDIFFERENCE -) :test #'eq)
+	      (EQL 1 (CADDR X)))
+         (CADR X))
+        (`(QSADD1 ,X))))
+ 
+; 7.10 Dynamic Non-local Exits
+ 
+(defmacro yield (L)
+  (let ((g (gensym)))
+    `(let ((,g (state)))
+       (if (statep ,g) (throw 'yield (list 'pair ,L) ,g)))))
+ 
+; 10.1 The Property List
+ 
+(DEFUN FLAG (L KEY)
+  "Set the KEY property of every item in list L to T."
+  (mapc #'(lambda (item) (makeprop item KEY T)) L))
+ 
+(FLAG '(* + AND OR PROGN) 'NARY)                ; flag for MKPF
+ 
+(DEFUN REMFLAG (L KEY)
+  "Set the KEY property of every item in list L to NIL."
+  (OR (ATOM L) (SEQ (REMPROP (CAR L) KEY) (REMFLAG (CDR L) KEY))))
+ 
+(DEFUN FLAGP (X KEY)
+  "If X has a KEY property, then FLAGP is true."
+  (GET X KEY))
+ 
+(defun PROPERTY (X IND N)
+  "Returns the Nth element of X's IND property, if it exists."
+  (let (Y) (if (AND (INTEGERP N) (SETQ Y (GET X IND)) (>= (LENGTH Y) N)) (ELEM Y N))))
+ 
+; 10.3 Creating Symbols
+ 
+(defmacro INTERNL (a &rest b) (if (not b) `(intern ,a) `(intern (strconc ,a . ,b))))
+
+(defvar $GENNO 0)
+ 
+(DEFUN GENVAR () (INTERNL "$" (STRINGIMAGE (SETQ $GENNO (1+ $GENNO)))))
+ 
+(DEFUN IS_GENVAR (X)
+  (AND (IDENTP X)
+       (let ((y (symbol-name x)))
+         (and (char= #\$ (elt y 0)) (> (size y) 1) (digitp (elt y 1))))))
+ 
+(DEFUN IS_\#GENVAR (X)
+  (AND (IDENTP X)
+       (let ((y (symbol-name x)))
+         (and (char= #\# (ELT y 0)) (> (SIZE Y) 1) (DIGITP (ELT Y 1))))))
+ 
+; 10.7 CATCH and THROW
+ 
+(defmacro SPADCATCH (&rest form) (CONS 'CATCH form))
+ 
+(defmacro SPADTHROW (&rest form) (CONS 'THROW form))
+ 
+; 12 NUMBERS
+ 
+; 12.3 Comparisons on Numbers
+ 
+(defmacro IEQUAL (&rest L) `(eql . ,L))
+(defmacro GE (&rest L) `(>= . ,L))
+(defmacro GT (&rest L) `(> . ,L))
+(defmacro LE (&rest L) `(<= . ,L))
+(defmacro LT (&rest L) `(< . ,L))
+ 
+; 12.4 Arithmetic Operations
+ 
+(defmacro SPADDIFFERENCE (&rest x) `(- . ,x))
+ 
+; 12.5 Irrational and Transcendental Functions
+ 
+; 12.5.1 Exponential and Logarithmic Functions
+ 
+(define-function 'QSEXPT #'expt)
+ 
+; 12.6 Small Finite Field ops with vector trimming
+ 
+;; following macros assume 0 <= x,y < z
+
+(defmacro qsaddmod (x y z)
+  `(let* ((sum (qsplus ,x ,y))
+	  (rsum (qsdifference sum ,z)))
+     (if (qsminusp rsum) sum rsum)))
+ 
+(defmacro qsdifmod (x y z)
+  `(let ((dif (qsdifference ,x ,y)))
+     (if (qsminusp dif) (qsplus dif ,z) dif)))
+ 
+(defmacro qsmultmod (x y z)
+ `(rem (* ,x ,y) ,z))
+ 
+(defun TRIMLZ (vec)
+  (declare (simple-vector vec))
+  (let ((n (position 0 vec :from-end t :test-not #'eql)))
+     (cond ((null n) (vector))
+           ((eql n (qvmaxindex vec)) vec)
+           (t (subseq vec 0 (+ n 1))))))
+ 
+;; In CCL ASH assumes a 2's complement machine.  We use ASH in Integer and
+;; assume we have a sign and magnitude setup.
+#+:CCL (defmacro ash (u v) `(lisp::ash1 ,u ,v))
+
+; 14 SEQUENCES
+ 
+; 14.1 Simple Sequence Functions
+ 
+(DEFUN NLIST (N FN)
+  "Returns a list of N items, each initialized to the value of an
+ invocation of FN"
+  (if (LT N 1) NIL (CONS (EVAL FN) (NLIST (SUB1 N) FN))))
+ 
+(define-function 'getchar #'elt)
+ 
+(defun GETCHARN (A M) "Return the code of the Mth character of A"
+  (let ((a (if (identp a) (symbol-name a) a))) (char-code (elt A M))))
+ 
+; 14.2 Concatenating, Mapping, and Reducing Sequences
+ 
+(DEFUN STRINGPAD (STR N)
+  (let ((M (length STR)))
+    (if (>= M N)
+        STR
+        (concatenate 'string str (make-string (- N M) :initial-element #\Space)))))
+ 
+(DEFUN STRINGSUFFIX (TARGET SOURCE) "Suffix source to target if enough room else nil."
+  (concatenate 'string target source))
+ 
+(defun NSTRCONC (s1 s2) (concatenate 'string (string s1) (string s2)))
+ 
+(defmacro spadREDUCE (OP AXIS BOD) (REDUCE-1 OP AXIS BOD))
+ 
+(MAPC #'(LAMBDA (X) (MAKEPROP (CAR X) 'THETA (CDR X)))
+      '((PLUS 0) (+ (|Zero|)) (|lcm| (|One|)) (STRCONC "") (|strconc| "")
+        (MAX -999999) (MIN 999999) (TIMES 1) (* (|One|)) (CONS NIL)
+        (APPEND NIL) (|append| NIL) (UNION NIL) (UNIONQ NIL) (|gcd| (|Zero|))
+        (|union| NIL) (NCONC NIL) (|and| |true|) (|or| |false|) (AND 'T)
+        (OR NIL)))
+ 
+(define-function '|append| #'APPEND)
+ 
+;;(defun |delete| (item list)    ; renaming from DELETE is done in DEF
+;;   (cond ((atom list) list)
+;;         ((equalp item (qcar list)) (|delete| item (qcdr list)))
+;;         ('t (cons (qcar list) (|delete| item (qcdr list))))))
+ 
+(defun |delete| (item sequence)
+   (cond ((symbolp item) (remove item sequence :test #'eq))
+	 ((and (atom item) (not (arrayp item))) (remove item sequence))
+	 (T (remove item sequence :test #'equalp))))
+ 
+(MAPC #'(LAMBDA (J) (MAKEPROP (CAR J) 'UNMACRO (CADR J)))
+      '( (AND AND2) (OR OR2)))
+ 
+(defun and2 (x y) (and x y))
+ 
+(defun or2 (x y) (or x y))
+ 
+(MAKEPROP 'CONS 'RIGHT-ASSOCIATIVE T)
+ 
+(defun REDUCE-1 (OP AXIS BOD)
+  (let (u op1 tran iden)
+    (SEQ (SETQ OP1 (cond ((EQ OP '\,) 'CONS)
+                         ((EQCAR OP 'QUOTE) (CADR OP))
+                         (OP)))
+         (SETQ IDEN (if (SETQ U (GET OP1 'THETA)) (CAR U) 'NO_THETA_PROPERTY))
+         (SETQ TRAN (if (EQCAR BOD 'COLLECT)
+                        (PROG (L BOD1 ITL)
+                              (SETQ L (REVERSE (CDR BOD)))
+                              (SETQ BOD1 (CAR L))
+                              (SETQ ITL (NREVERSE (CDR L)))
+                              (RETURN (-REDUCE OP1 AXIS IDEN BOD1 ITL)) )
+                        (progn (SETQ U (-REDUCE-OP OP1 AXIS))
+                               (LIST 'REDUCE-N (MKQ (OR (GET U 'UNMACRO) U))
+                                     (GET OP1 'RIGHT-ASSOCIATIVE)
+                                     BOD IDEN))))
+         (if (EQ OP '\,) (LIST 'NREVERSE-N TRAN AXIS) TRAN))))
+ 
+(defun -REDUCE (OP AXIS Y BODY SPL)
+  (PROG (X G AUX EXIT VALUE PRESET CONSCODE RESETCODE)
+   (SETQ G (GENSYM))
+   ; create preset of accumulate
+   (SETQ PRESET (COND
+      ((EQ Y 'NO_THETA_PROPERTY) (LIST 'SPADLET G (MKQ G)))
+      ((LIST 'SPADLET G Y)) ))
+   (SETQ EXIT (COND
+      ((SETQ X (ASSOC 'EXIT SPL))(SETQ SPL (DELASC 'EXIT SPL)) (COND
+         ((MEMBER OP '(AND OR)) (LIST 'AND G (CADR X))) ((CADR X)) ))
+      ((EQ Y 'NO_THETA_PROPERTY) (LIST 'THETACHECK G (MKQ G)(MKQ OP)))
+      (G) ))
+   (COND ((EQ OP 'CONS) (SETQ EXIT (LIST 'NREVERSE0 EXIT))))
+   ; CONSCODE= code which conses a member onto the list
+   (SETQ VALUE (COND ((EQ Y 'NO_THETA_PROPERTY) (GENSYM))
+                     (BODY)))
+   (SETQ CONSCODE (CONS (-REDUCE-OP OP AXIS) (COND
+      ((FLAGP OP 'RIGHT-ASSOCIATIVE) (LIST VALUE G))
+      ((LIST G VALUE) ) ) ) )
+   ; next reset code which varies if THETA property is|/is not given
+   (SETQ RESETCODE (LIST 'SETQ G (COND
+      ((EQ Y 'NO_THETA_PROPERTY)
+         (LIST 'COND (LIST (LIST 'EQ G (MKQ G)) VALUE)
+                     (LIST ''T CONSCODE)) )
+      (CONSCODE) )))
+   ; create body
+   (SETQ BODY (COND ((EQ VALUE BODY) RESETCODE)
+                    ((LIST 'PROGN (LIST 'SPADLET VALUE BODY) RESETCODE)) ))
+   (SETQ AUX (CONS (LIST 'EXIT EXIT) (COND
+      ((EQ OP 'AND) (LIST (LIST 'UNTIL (LIST 'NULL G))))
+      ((EQ OP 'OR) (LIST (LIST 'UNTIL G)))
+      (NIL) )))
+   (RETURN (COND
+      ((AND $NEWSPAD (NULL $BOOT)) (LIST 'PROGN PRESET
+         (CONS 'REPEAT (APPEND AUX (APPEND SPL (LIST BODY))) )))
+      ((LIST 'PROG
+                (COND ((EQ RESETCODE BODY) (LIST G)) ((LIST G VALUE)))
+                PRESET (LIST 'RETURN
+         (CONS 'REPEAT (APPEND AUX (APPEND SPL (LIST BODY)))))))))))
+ 
+(defun -REDUCE-OP (OP AXIS)
+  (COND ((EQL AXIS 0) OP)
+        ((EQL AXIS 1)
+         (COND ((EQ OP 'CONS) 'CONS-N)
+               ((EQ OP 'APPEND) 'APPEND-N)
+               ((FAIL))))
+        ((FAIL))))
+ 
+(defun NREVERSE-N (X AXIS)
+  (COND ((EQL AXIS 0) (NREVERSE X))
+        ((MAPCAR #'(LAMBDA (Y) (NREVERSE-N Y (SUB1 AXIS))) X))))
+ 
+(defun CONS-N (X Y)
+  (COND ((NULL Y) (CONS-N X (NLIST (LENGTH X) NIL)))
+        ((MAPCAR #'CONS X Y))))
+ 
+(defun APPEND-N (X Y)
+  (COND ((NULL X) (APPEND-N (NLIST (LENGTH Y) NIL) Y))
+        ((MAPCAR #'APPEND X Y))))
+ 
+(defun REDUCE-N (OP RIGHT L ACC)
+  (COND (RIGHT (PROG (U L1)
+                     (SETQ L1 (NREVERSE L))
+                     (SETQ U (REDUCE-N-1 OP 'T L1 ACC))
+                     (NREVERSE L1)
+                     (RETURN U) ))
+        ((REDUCE-N-1 OP NIL L ACC))))
+ 
+(defun REDUCE-N-1 (OP RIGHT L ACC)
+  (COND ((EQ ACC 'NO_THETA_PROPERTY)
+         (COND ((NULL L) (THETA_ERROR OP))
+               ((REDUCE-N-2 OP RIGHT (CDR L) (CAR L))) ))
+        ((REDUCE-N-2 OP RIGHT L ACC))))
+ 
+(defun REDUCE-N-2 (OP RIGHT L ACC)
+  (COND ((NULL L) ACC)
+        (RIGHT (REDUCE-N-2 OP RIGHT (CDR L) (funcall (symbol-function OP) (CAR L) ACC)))
+        ((REDUCE-N-2 OP RIGHT (CDR L) (funcall (symbol-function OP) ACC (CAR L))))))
+ 
+(defmacro THETA (&rest LL)
+  (let (U (L (copy-list LL)))
+    (if (EQ (KAR L) '\,)  `(theta CONS . ,(CDR L))
+        (progn
+         (if (EQCAR (CAR L) 'QUOTE) (RPLAC (CAR L) (CADAR L)))
+         (-REDUCE (CAR L) 0
+                  (if (SETQ U (GET (CAR L) 'THETA)) (CAR U)
+                      (MOAN "NO THETA PROPERTY"))
+                  (CAR (SETQ L (NREVERSE (CDR L))))
+                  (NREVERSE (CDR L)))))))
+ 
+(defmacro THETA1 (&rest LL)
+  (let (U (L (copy-list LL)))
+    (if (EQ (KAR L) '\,)
+        (LIST 'NREVERSE-N (CONS 'THETA1 (CONS 'CONS (CDR L))) 1)
+        (-REDUCE (CAR L) 1
+                 (if (SETQ U (GET (CAR L) 'THETA)) (CAR U)
+                     (MOAN "NO THETA PROPERTY"))
+                 (CAR (SETQ L (NREVERSE (CDR L))))
+                 (NREVERSE (CDR L))))))
+ 
+ 
+(defun THETACHECK (VAL VAR OP) (if (EQL VAL VAR) (THETA_ERROR OP) val))
+ 
+(defun THETA_ERROR (OP)
+  (Boot::|userError|
+        (LIST "Sorry, do not know the identity element for " OP)))
+ 
+; 15 LISTS
+ 
+; 15.1 Conses
+ 
+ 
+(defmacro |SPADfirst| (l)
+  (let ((tem (gensym)))
+    `(let ((,tem ,l)) (if ,tem (car ,tem) (first-error)))))
+ 
+(defun first-error () (error "Cannot take first of an empty list"))
+ 
+; 15.2 Lists
+ 
+ 
+(defmacro ELEM (val &rest indices)
+   (if (null indices) val `(ELEM (nth (1- ,(car indices)) ,val) ,@(cdr indices))))
+ 
+(defun ELEMN (X N DEFAULT)
+  (COND ((NULL X) DEFAULT)
+        ((EQL N 1) (CAR X))
+        ((ELEMN (CDR X) (SUB1 N) DEFAULT))))
+ 
+(defmacro TAIL (&rest L)
+  (let ((x (car L)) (n (if (cdr L) (cadr L) 1)))
+    (COND ((EQL N 0) X)
+          ((EQL N 1) (LIST 'CDR X))
+          ((GT N 1) (APPLYR (PARTCODET N) X))
+          ((LIST 'TAILFN X N)))))
+ 
+(defun PARTCODET (N)
+  (COND ((OR (NULL (INTEGERP N)) (LT N 1)) (ERROR 'PARTCODET))
+        ((EQL N 1) '(CDR))
+        ((EQL N 2) '(CDDR))
+        ((EQL N 3) '(CDDDR))
+        ((EQL N 4) '(CDDDDR))
+        ((APPEND (PARTCODET (PLUS N -4)) '(CDDDDR)))))
+ 
+(defmacro TL (&rest L) `(tail . ,L))
+ 
+(defun TAILFN (X N) (if (LT N 1) X (TAILFN (CDR X) (SUB1 N))))
+ 
+(defmacro SPADCONST (&rest L) (cons 'qrefelt L))
+ 
+(defmacro SPADCALL (&rest L)
+   (let ((args (butlast l)) (fn (car (last l))) (gi (gensym)))
+     ;; (values t) indicates a single return value
+     `(let ((,gi ,fn)) (the (values t) (funcall (car ,gi) ,@args (cdr ,gi))))
+     ))
+ 
+(DEFUN LASTELEM (X) (car (last X)))
+ 
+(defun LISTOFATOMS (X)
+  (COND ((NULL X) NIL)
+        ((ATOM X) (LIST X))
+        ((NCONC (LISTOFATOMS (CAR X)) (LISTOFATOMS (CDR X))))))
+ 
+(DEFUN LASTATOM (L) (if (ATOM L) L (LASTATOM (CDR L))))
+ 
+(define-function 'LASTTAIL #'last)
+ 
+(define-function 'LISPELT #'ELT)
+ 
+(defun DROP (N X &aux m)
+  "Return a pointer to the Nth cons of X, counting 0 as the first cons."
+  (COND ((EQL N 0) X)
+        ((> N 0) (DROP (1- N) (CDR X)))
+        ((>= (setq m (+ (length x) N)) 0) (take m x))
+        ((CROAK (list "Bad args to DROP" N X)))))
+ 
+(DEFUN TAKE (N X &aux m)
+  "Returns a list of the first N elements of list X."
+  (COND ((EQL N 0) NIL)
+        ((> N 0) (CONS (CAR X) (TAKE (1- N) (CDR X))))
+	((>= (setq m (+ (length x) N)) 0) (drop m x))
+        ((CROAK (list "Bad args to DROP" N X)))))
+ 
+(DEFUN NUMOFNODES (X) (if (ATOM X) 0 (+ 1 (NUMOFNODES (CAR X)) (NUMOFNODES (CDR X)))))
+ 
+(DEFUN TRUNCLIST (L TL) "Truncate list L at the point marked by TL."
+  (let ((U L)) (TRUNCLIST-1 L TL) U))
+ 
+(DEFUN TRUNCLIST-1 (L TL)
+  (COND ((ATOM L) L)
+        ((EQL (CDR L) TL) (RPLACD L NIL))
+        ((TRUNCLIST-1 (CDR L) TL))))
+ 
+; 15.3 Alteration of List Structure
+ 
+(defun RPLACW (x w) (let (y z) (dsetq (Y . Z) w) (RPLACA X Y) (RPLACD X Z)  X))
+ 
+; 15.4 Substitution of Expressions
+ 
+(DEFUN SUBSTEQ (NEW OLD FORM)
+  "Version of SUBST that uses EQ rather than EQUAL on the world."
+  (PROG (NFORM HNFORM ITEM)
+        (SETQ HNFORM (SETQ NFORM (CONS () ())))
+     LP    (RPLACD NFORM
+                   (COND ((EQ FORM OLD) (SETQ FORM ()) NEW )
+                         ((NOT (PAIRP FORM)) FORM )
+                         ((EQ (SETQ ITEM (CAR FORM)) OLD) (CONS NEW ()) )
+                         ((PAIRP ITEM) (CONS (SUBSTEQ NEW OLD ITEM) ()) )
+                         ((CONS ITEM ()))))
+        (if (NOT (PAIRP FORM)) (RETURN (CDR HNFORM)))
+        (SETQ NFORM (CDR NFORM))
+        (SETQ FORM (CDR FORM))
+        (GO LP)))
+ 
+(DEFUN SUBLISNQ (KEY E) (declare (special KEY)) (if (NULL KEY) E (SUBANQ E)))
+ 
+(DEFUN SUBANQ (E)
+  (declare (special key))
+  (COND ((ATOM E) (SUBB KEY E))
+        ((EQCAR E (QUOTE QUOTE)) E)
+        ((MAPCAR #'(LAMBDA (J) (SUBANQ J)) E))))
+ 
+(DEFUN SUBB (X E)
+  (COND ((ATOM X) E)
+        ((EQ (CAAR X) E) (CDAR X))
+        ((SUBB (CDR X) E))))
+ 
+(defun SUBLISLIS (newl oldl form)
+   (sublis (mapcar #'cons oldl newl) form))
+
+; 15.5 Using Lists as Sets
+
+<<DEFUN CONTAINED>> 
+(DEFUN S+ (X Y)
+  (COND ((ATOM Y) X)
+        ((ATOM X) Y)
+        ((MEMBER (CAR X) Y :test #'equal) (S+ (CDR X) Y))
+        ((S+ (CDR X) (CONS (CAR X) Y)))))
+ 
+(defun S* (l1 l2) (INTERSECTION l1 l2 :test #'equal))
+(defun S- (l1 l2) (set-difference l1 l2 :test #'equal))
+ 
+(DEFUN PREDECESSOR (TL L)
+  "Returns the sublist of L whose CDR is EQ to TL."
+  (COND ((ATOM L) NIL)
+        ((EQ TL (CDR L)) L)
+        ((PREDECESSOR TL (CDR L)))))
+ 
+(defun remdup (l) (remove-duplicates l :test #'equalp))
+ 
+(DEFUN GETTAIL (X L) (member X L :test #'equal))
+ 
+; 15.6 Association Lists
+ 
+(defun DelAsc (u v) "Returns a copy of a-list V in which any pair with key U is deleted."
+   (cond ((atom v) nil)
+         ((or (atom (car v))(not (equal u (caar v))))
+          (cons (car v) (DelAsc u (cdr v))))
+         ((cdr v))))
+ 
+(DEFUN ADDASSOC (X Y L)
+  "Put the association list pair (X . Y) into L, erasing any previous association for X"
+  (COND ((ATOM L) (CONS (CONS X Y) L))
+        ((EQUAL X (CAAR L)) (CONS (CONS X Y) (CDR L)))
+        ((CONS (CAR L) (ADDASSOC X Y (CDR L))))))
+ 
+(DEFUN DELLASOS (U V)
+  "Remove any assocation pair (U . X) from list V."
+  (COND ((ATOM V) NIL)
+        ((EQUAL U (CAAR V)) (CDR V))
+        ((CONS (CAR V) (DELLASOS U (CDR V))))))
+ 
+(DEFUN ASSOCLEFT (X)
+  "Returns all the keys of association list X."
+  (if (ATOM X) X (mapcar #'car x)))
+ 
+(DEFUN ASSOCRIGHT (X)
+  "Returns all the datums of association list X."
+  (if (ATOM X) X (mapcar #'cdr x)))
+ 
+(DEFUN LASSOC (X Y)
+  "Return the datum associated with key X in association list Y."
+  (PROG NIL
+     A  (COND ((ATOM Y) (RETURN NIL))
+              ((EQUAL (CAAR Y) X) (RETURN (CDAR Y))) )
+        (SETQ Y (CDR Y))
+        (GO A)))
+ 
+(DEFUN |rassoc| (X Y)
+  "Return the datum associated with key X in association list Y."
+  (PROG NIL
+     A  (COND ((ATOM Y) (RETURN NIL))
+              ((EQUAL (CDAR Y) X) (RETURN (CAAR Y))) )
+        (SETQ Y (CDR Y))
+        (GO A)))
+ 
+; (defun QLASSQ (p a-list) (let ((y (assoc p a-list :test #'eq))) (if y (cdr y))))
+(defun QLASSQ (p a-list) (cdr (assq p a-list)))
+
+(define-function 'LASSQ #'QLASSQ)
+ 
+(defun pair (x y) (mapcar #'cons x y))
+ 
+;;; Operations on Association Sets (AS)
+ 
+(defun AS-INSERT (A B L)
+   ;; PF(item) x PF(item) x LIST(of pairs) -> LIST(of pairs with (A . B) added)
+   ;; destructive on L; if (A . C) appears already, C is replaced by B
+   (cond ((null l) (list (cons a b)))
+         ((equal a (caar l)) (rplac (cdar l) b) l)
+         ((?order a (caar l)) (cons (cons a b) l))
+         (t (as-insert1 a b l) l)))
+ 
+(defun as-insert1 (a b l)
+   (cond ((null (cdr l)) (rplac (cdr l) (list (cons a b))))
+         ((equal a (caadr l)) (rplac (cdadr l) b))
+         ((?order a (caadr l)) (rplac (cdr l) (cons (cons a b) (cdr l))))
+         (t (as-insert1 a b (cdr l)))))
+ 
+ 
+; 17 ARRAYS
+ 
+; 17.6 Changing the Dimensions of an Array
+ 
+
+<<lengthenvec>>
+<<make-init-vector>> 
+ 
+; 22 INPUT/OUTPUT
+ 
+; 22.2 Input Functions
+ 
+; 22.2.1 Input from Character Streams
+ 
+(DEFUN STREAM-EOF (&optional (STRM *terminal-io*))
+  "T if input stream STRM is at the end or saw a ~."
+  (not (peek-char nil STRM nil nil nil))     )
+ 
+(DEFUN CONSOLEINPUTP (STRM) (IS-CONSOLE STRM))
+ 
+(defvar $filelinenumber 0)
+(defvar $prompt "--->")
+(defvar stream-buffer nil)
+ 
+(DEFUN NEXTSTRMLINE (STRM) "Returns the next input line from stream STRM."
+  (let ((v (read-line strm nil -1 nil)))
+    (if (equal v -1) (throw 'spad_reader nil)
+        (progn (setq stream-buffer v) v))))
+ 
+(DEFUN CURSTRMLINE (STRM)
+  "Returns the current input line from the stream buffer of STRM (VM-specific!)."
+  (cond (stream-buffer)
+        ((stream-eof strm) (fail))
+        ((nextstrmline strm))))
+ 
+(defvar *EOF* NIL)
+ 
+(DEFUN CURMAXINDEX (STRM)
+"Something bizarre and VM-specific with respect to streams."
+  (if *EOF* (FAIL) (ELT (ELT (LASTATOM STRM) 1) 3)))
+ 
+(DEFUN ADJCURMAXINDEX (STRM)
+"Something unearthly and VM-specific with respect to streams."
+  (let (v) (if *eof* (fail)
+               (progn (SETQ V (ELT (LASTATOM STRM) 1))
+                      (SETELT V 3 (SIZE (ELT V 0)))))))
+ 
+(DEFUN STRMBLANKLINE (STRM)
+"Something diabolical and VM-specific with respect to streams."
+  (if *EOF* (FAIL) (AND (EQ '\  (CAR STRM)) (EQL 1 (CURMAXINDEX STRM)))))
+ 
+(DEFUN STRMSKIPTOBLANK (STRM)
+"Munch away on the stream until you get to a blank line."
+  (COND (*EOF* (FAIL))
+        ((PROGN (NEXTSTRMLINE STRM) (STRMBLANKLINE STRM)) STRM)
+        ((STRMSKIPTOBLANK STRM))))
+ 
+(DEFUN CURINPUTLINE () (CURSTRMLINE *standard-input*))
+ 
+(DEFUN NEXTINPUTLINE () (NEXTSTRMLINE *standard-input*))
+ 
+; 22.3 Output Functions
+ 
+; 22.3.1 Output to Character Streams
+ 
+(DEFUN ATOM2STRING (X)
+  "Give me the string which would be printed out to denote an atom."
+  (cond ((atom x) (symbol-name x))
+        ((stringp x) x)
+        ((write-to-string x))))
+ 
+(defvar |conOutStream| *terminal-io* "console output stream")
+ 
+(defun |sayTeX| (x) (if (null x) nil (sayBrightly1 x |$texOutputStream|)))
+ 
+(defun |sayNewLine| () (TERPRI))
+
+(defvar |$sayBrightlyStream| nil "if not nil, gives stream for sayBrightly output")
+ 
+(defun |sayBrightly| (x &optional (out-stream *standard-output*))
+  (COND ((NULL X) NIL)
+	(|$sayBrightlyStream| (sayBrightly1 X |$sayBrightlyStream|))
+        ((IS-CONSOLE out-stream) (sayBrightly1 X out-stream))
+        ((sayBrightly1 X out-stream) (sayBrightly1 X *terminal-io*))))
+ 
+(defun |sayBrightlyI| (x &optional (s *terminal-io*))
+    "Prints at console or output stream."
+  (if (NULL X) NIL (sayBrightly1 X S)))
+ 
+(defun |sayBrightlyNT| (x &optional (S *standard-output*))
+  (COND ((NULL X) NIL)
+	(|$sayBrightlyStream| (sayBrightlyNT1 X |$sayBrightlyStream|))
+        ((IS-CONSOLE S) (sayBrightlyNT1 X S))
+        ((sayBrightly1 X S) (sayBrightlyNT1 X *terminal-io*))))
+ 
+(defun sayBrightlyNT1 (X *standard-output*)
+  (if (ATOM X) (BRIGHTPRINT-0 X) (BRIGHTPRINT X)))
+ 
+(defun sayBrightly1 (X *standard-output*)
+    (if (ATOM X)
+	(progn (BRIGHTPRINT-0 X) (TERPRI) (force-output))
+      (progn (BRIGHTPRINT X) (TERPRI) (force-output))))
+ 
+(defvar |$algebraOutputStream| *standard-output*)
+ 
+(defun |saySpadMsg| (X)
+  (if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
+ 
+(defun |sayALGEBRA| (X) "Prints on Algebra output stream."
+  (if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
+ 
+(defun |sayMSG| (X)
+  (if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
+ 
+(defun |sayMSGNT| (X)
+  (if (NULL X) NIL (sayBrightlyNT1 X |$algebraOutputStream|)))
+ 
+(defun |sayMSG2File| (msg)
+  (PROG (file str)
+	(SETQ file (|makePathname| '|spadmsg| '|listing| |$listingDirectory|))
+	(SETQ str
+	      (DEFIOSTREAM
+	       (CONS '(MODE . OUTPUT) (CONS (CONS 'FILE file) NIL))
+	       255 0))
+	(sayBrightly1 msg str)
+	(SHUT str) ) )
+ 
+(defvar |$fortranOutputStream|)
+ 
+(defun |sayFORTRAN| (x) "Prints on Fortran output stream."
+  (if (NULL X) NIL (sayBrightly1 X |$fortranOutputStream|)))
+ 
+(defvar |$formulaOutputStream|)
+ 
+(defun |sayFORMULA| (X) "Prints on formula output stream."
+  (if (NULL X) NIL (sayBrightly1 X |$formulaOutputStream|)))
+ 
+(defvar |$highlightAllowed| nil "Used in BRIGHTPRINT and is a )set variable.")
+ 
+(defvar |$highlightFontOn| $boldstring "switch to highlight font")
+(defvar |$highlightFontOff| $normalstring "return to normal font")
+ 
+;; the following are redefined in MSGDB BOOT
+ 
+;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
+(DEFUN BRIGHTPRINT (X) (MESSAGEPRINT X))
+ 
+;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
+(DEFUN BRIGHTPRINT-0 (x) (MESSAGEPRINT-1 X))
+ 
+(defun SAY (&rest x) (progn (MESSAGEPRINT X) (TERPRI)))
+ 
+(DEFUN MESSAGEPRINT (X) (mapc #'messageprint-1 X))
+ 
+(DEFUN MESSAGEPRINT-1 (X)
+  (COND ((OR (EQ X '|%l|) (EQUAL X "%l")) (TERPRI))
+        ((STRINGP X) (PRINC X))
+        ((IDENTP X) (PRINC X))
+        ((ATOM X) (PRINC X))
+        ((PRINC "(") (MESSAGEPRINT-1 (CAR X))
+	 (MESSAGEPRINT-2 (CDR X)) (PRINC ")"))))
+ 
+(DEFUN MESSAGEPRINT-2 (X)
+  (if (ATOM X)
+      (if (NULL X) NIL (progn (PRINC " . ") (MESSAGEPRINT-1 X)))
+      (progn (PRINC " ") (MESSAGEPRINT-1 (CAR X)) (MESSAGEPRINT-2 (CDR X)))))
+ 
+(DEFUN BLANKS (N &optional (stream *standard-output*)) "Print N blanks."
+    (do ((i 1 (the fixnum(1+ i))))
+	((> i N))(declare (fixnum i n)) (princ " " stream)))
+ 
+; 23 FILE SYSTEM INTERFACE
+ 
+; 23.2 Opening and Closing Files
+ 
+(DEFUN DEFSTREAM (file MODE)
+       (if (member mode '(i input))
+	   (MAKE-INSTREAM file)
+	 (MAKE-OUTSTREAM file)))
+ 
+; 23.3 Renaming, Deleting and Other File Operations
+ 
+(DEFUN NOTE (STRM)
+"Attempts to return the current record number of a file stream.  This is 0 for
+terminals and empty or at-end files.  In Common Lisp, we must assume record sizes of 1!"
+   (COND ((STREAM-EOF STRM) 0)
+         ((IS-CONSOLE STRM) 0)
+         ((file-position STRM))))
+ 
+(DEFUN IS-CONSOLE-NOT-XEDIT (S) (not (OR (NULL (IS-CONSOLE S)))))
+ 
+(DEFUN POINTW (RECNO STRM)
+"Does something obscure and VM-specific with respect to streams."
+  (let (V)
+    (if (STREAM-EOF STRM) (FAIL))
+    (SETQ V (LASTATOM STRM))
+    (SETELT V 4 RECNO)
+    (SETQ *EOF* (STREAM-EOF STRM))
+    strm))
+ 
+(DEFUN POINT (RECNO STRM) (file-position strm recno))
+ 
+(DEFUN STRM (RECNO STRM)
+"Does something obscure and VM-specific with respect to streams."
+  (let (V)
+    (if (STREAM-EOF STRM) (FAIL))
+    (SETQ V (LASTATOM STRM))
+    (SETELT V 4 RECNO)
+    (read-char STRM)
+    (SETQ *EOF* (STREAM-EOF STRM))
+    strm))
+ 
+; 24 ERRORS
+ 
+; 24.2 Specialized Error-Signalling Forms and Macros
+ 
+(defun MOAN (&rest x) (|sayBrightly| `(|%l| "===> " ,@X |%l|)))
+ 
+(DEFUN FAIL () (|systemError| '"Antique error (FAIL ENTERED)"))
+ 
+(defun CROAK (&rest x) (|systemError| x))
+ 
+; 25 MISCELLANEOUS FEATURES
+ 
+;; range tests and assertions
+ 
+(defmacro |assert| (x y) `(IF (NULL ,x) (|error| ,y)))
+ 
+(defun coerce-failure-msg (val mode)
+   (STRCONC (MAKE-REASONABLE (STRINGIMAGE val))
+	    " cannot be coerced to mode "
+	    (STRINGIMAGE (|devaluate| mode))))
+ 
+(defmacro |check-subtype| (pred submode val)
+   `(|assert| ,pred (coerce-failure-msg ,val ,submode)))
+ 
+(defmacro |check-union| (pred branch val)
+   `(|assert| ,pred (coerce-failure-msg ,val ,branch )))
+ 
+(defun MAKE-REASONABLE (Z)
+   (if (> (length Z) 30) (CONCAT "expression beginning " (subseq Z 0 20)) Z))
+ 
+ 
+(defmacro |elapsedUserTime| () '(get-internal-run-time))
+ 
+#+IBCL
+(defmacro |elapsedGcTime| () '(system:gbc-time-report))
+#+AKCL
+(defmacro |elapsedGcTime| () '(system:gbc-time))
+#+:CCL
+(defmacro |elapsedGcTime| () '(lisp:gctime))
+#-(OR :CCL IBCL AKCL)
+(defmacro |elapsedGcTime| () '0)
+ 
+(defmacro |do| (&rest args) (CONS 'PROGN args))
+
+(defmacro |char| (arg)
+  (cond ((stringp arg) (character arg))
+        ((integerp arg) (code-char arg))
+	((and (consp arg) (eq (car arg) 'quote)) (character (cadr arg)))
+	(t `(character ,arg))))
+
+(defun DROPTRAILINGBLANKS  (LINE) (string-right-trim " " LINE))
+ 
+; # Gives the number of elements of a list, 0 for atoms.
+; If we quote it, then an interpreter trip is necessary every time
+; we call #, and this costs us - 4% in the RATINT DEMO."
+
+(define-function '\# #'SIZE)
+
+(defun print-and-eval-defun (name body)
+   (eval body)
+   (print-defun name body)
+  ;; (set name (symbol-function name)) ;; this should go away
+   )
+
+(defun eval-defun (name body) (eval (macroexpandall body)))
+
+; This function was modified by Greg Vanuxem on March 31, 2005
+; to handle the special case of #'(lambda ..... which expands
+; into (function (lambda .....
+; 
+; The extra if clause fixes bugs #196 and #114
+;
+; an example that used to cause the failure was:
+; )set func comp off
+; f(xl:LIST FRAC INT): LIST FRAC INT == map(x +-> x, xl)
+; f [1,2,3]
+;
+; which expanded into
+;
+; (defun |xl;f;1;initial| (|#1| |envArg|)
+;  (prog (#:G1420)
+;   (return 
+;    (progn
+;     (lett #:G1420 'uninitialized_variable |f| |#1;f;1:initial|)
+;      (spadcall 
+;       (cons (|function| (lambda (#:G1420 |envArg|) #:G1420)) (vector))
+;       |#1|
+;       (qrefelt |*1;f;1;initial;MV| 0))))))
+;
+; the (|function| (lambda form used to cause an infinite expansion loop
+;      
+(defun macroexpandall (sexpr)
+ (cond
+  ((atom sexpr) sexpr)
+  ((eq (car sexpr) 'quote) sexpr)
+  ((eq (car sexpr) 'defun)
+   (cons (car sexpr) (cons (cadr sexpr)
+       (mapcar #'macroexpandall (cddr sexpr)))))
+  ((and (symbolp (car sexpr)) (macro-function (car sexpr)))
+   (do ()
+       ((not (and (consp sexpr) (symbolp (car sexpr))
+		  (macro-function (car sexpr)))))
+     (setq sexpr (macroexpand sexpr)))
+   (if (consp sexpr) 
+     (let ((a (car sexpr)) (b (caadr sexpr)))
+       (if (and (eq a 'function) (eq b 'lambda))
+         (cons a (list (cons b (mapcar #'macroexpandall (cdadr sexpr)))))
+         (mapcar #'macroexpandall sexpr)))
+       sexpr))
+  ('else	
+    (mapcar #'macroexpandall sexpr))))
+
+
+(defun compile-defun (name body) (eval body) (compile name))
+
+(defmacro |Record| (&rest x)
+  `(|Record0| (LIST ,@(COLLECT (IN Y X)
+                         (list 'CONS (MKQ (CADR Y)) (CADDR Y))))))
+
+(defmacro |:| (tag expr) `(LIST '|:| ,(MKQ tag) ,expr))
+
+(defun |deleteWOC| (item list) (lisp::delete item list :test #'equal))
+
+(DEFUN |leftBindingPowerOf| (X IND &AUX (Y (GETL X IND)))
+   (IF Y (ELEMN Y 3 0) 0))
+
+(DEFUN |rightBindingPowerOf| (X IND &AUX (Y (GETL X IND)))
+   (IF Y (ELEMN Y 4 105) 105))
+
+(defmacro make-bf (MT EP) `(CONS |$BFtag| (CONS ,MT ,EP)))
+
+(defun MAKE-FLOAT (int frac fraclen exp)
+    (if (AND $SPAD |$useBFasDefault|)
+        (if (= frac 0)
+          (MAKE-BF int exp)
+          (MAKE-BF (+ (* int (expt 10 fraclen)) frac) (- exp fraclen)) )
+        (read-from-string
+          (format nil "~D.~v,'0De~D" int fraclen frac exp))) )
+
+;;---- Added by WFS.
+ 
+(proclaim '(ftype (function (t t) t) |subWord|)) ;hack for bug in akcl-478
+ 
+(DEFUN |subWord| (|str| N )
+  (declare (fixnum n ) (string |str|))
+  (PROG (|word| (|n| 0) |inWord|(|l| 0) )
+     (declare (fixnum |n| |l|))
+    (RETURN
+      (SEQ (COND
+             ((> 1 N) NIL)
+             ('T (SPADLET |l| (SPADDIFFERENCE (|#| |str|) 1))
+              (COND
+                ((EQL |l| 0) NIL)
+                ('T (SPADLET |n| 0) (SPADLET |word| '||)
+                 (SPADLET |inWord| NIL)
+                 (DO ((|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| |l|) NIL)
+               (declare (fixnum |i|))
+                   (SEQ (EXIT (COND
+                                ((eql (aref |str| |i|) #\space)
+                                 (COND
+                                   ((NULL |inWord|) NIL)
+                                   ((eql |n| N) (RETURN |word|))
+                                   ('T (SPADLET |inWord| NIL))))
+                                ('T
+                                 (COND
+                                   ((NULL |inWord|)
+                                    (SPADLET |inWord| 'T)
+                                    (SPADLET |n| (PLUS |n| 1))))
+                                 (COND
+                                   ((eql |n| N)
+                       (cond ((eq |word| '||)
+                           (setq |word|
+                           (make-array 10 :adjustable t
+                                    :element-type 'standard-char
+                                  :fill-pointer 0))))
+                       (or |word| (error "bad"))
+                       (vector-push-extend (aref |str| |i|)
+                                  (the string |word|)
+                                  )
+                       )
+                                   ('T NIL)))))))
+                 (COND ((> N |n|) NIL) ('T |word|))))))))))
+
+(defun print-full (expr &optional (stream *standard-output*))
+   (let ((*print-circle* t) (*print-array* t) *print-level* *print-length*)
+     (print expr stream)
+     (terpri stream)
+     (finish-output stream)))
+
+;; moved here from preparse.lisp
+
+(defun NEXT-TAB-LOC (i) (* (1+ (truncate i 8)) 8))
+ 
+(defun INDENT-POS (STR)
+  (do ((i 0 (1+ i))
+       (pos 0))
+      ((>= i (length str)) nil)
+      (case (char str i)
+            (#\space (incf pos))
+            (#\tab (setq pos (next-tab-loc pos)))
+            (otherwise (return pos)))))
+
+;;(defun expand-tabs (str)
+;;  (let ((bpos (nonblankloc str))
+;;	(tpos (indent-pos str)))
+;;    (if (eql bpos tpos) str
+;;      (concatenate 'string (make-string tpos :initial-element #\space)
+;;		   (subseq str bpos)))))
+(defun expand-tabs (str)
+   (if (and (stringp str) (> (length str) 0))
+      (let ((bpos (nonblankloc str))
+            (tpos (indent-pos str)))
+        (setq str 
+              (if (eql bpos tpos)
+                  str
+                  (concatenate 'string
+                               (make-string tpos :initial-element #\space)
+                               (subseq str bpos))))
+         ;; remove dos CR
+        (let ((lpos (maxindex str)))
+          (if (eq (char str lpos) #\Return) (subseq str 0 lpos) str)))
+    str))
+
+(defun blankp (char) (or (eq char #\Space) (eq char #\tab)))
+ 
+(defun nonblankloc (str) (position-if-not #'blankp str))
+ 
+;; stream handling for paste-in generation
+
+(defun |applyWithOutputToString| (func args)
+  ;; returns the cons of applying func to args and a string produced
+  ;; from standard-output while executing.
+  (let* ((*standard-output* (make-string-output-stream))
+	 (curoutstream *standard-output*)
+	 (*terminal-io* *standard-output*)
+	 (|$algebraOutputStream| *standard-output*)
+         (erroroutstream *standard-output*)
+	val)
+    (declare (special *standard-output* curoutstream
+		      *terminal-io* |$algebraOutputStream|))
+    (setq val (catch 'spad_reader
+		(catch 'TOP_LEVEL
+		  (apply (symbol-function func) args))))
+    (cons val (get-output-stream-string *standard-output*))))
+
+(defun |breakIntoLines| (str)
+  (let ((bol 0) (eol) (line-list nil))
+    (loop
+     (setq eol (position #\Newline str :start bol))
+     (if (null eol) (return))
+     (if (> eol bol) 
+	 (setq line-list (cons (subseq str bol eol) line-list)))
+     (setq bol (+ eol 1)))
+    (nreverse line-list)))
+
+; part of the old spad to new spad translator
+; these are here because they need to be in depsys
+; they were in nspadaux.lisp
+
+(defmacro wi (a b) b)
+
+(defmacro |try| (X)
+  `(LET ((|$autoLine|))
+	(declare (special |$autoLine|))
+	(|tryToFit| (|saveState|) ,X)))
+
+(defmacro |embrace| (X) `(|wrapBraces| (|saveC|) ,X (|restoreC|)))
+(defmacro |indentNB| (X) `(|wrapBraces| (|saveD|) ,X (|restoreD|)))
+
+(defmacro |tryBreak| (a b c d) 
+; Try to format <a b> by:
+; (1) with no line breaking ($autoLine = nil)
+; (2) with possible line breaks within a;
+; (3) otherwise use a brace
+  `(LET
+    ((state))
+    (setq state (|saveState| 't))
+    (or
+      (LET ((|$autoLine|))
+	 (declare (special |$autoLine|))
+         (and ,a (|formatRight| '|formatPreferPile| ,b ,c ,d)))
+      (|restoreState| state)
+      (and (eqcar ,b (quote seq))
+               (|embrace| (and 
+                  ,a
+                  (|formatLB|)
+                  (|formatRight| '|formatPreferPile| ,b ,c ,d))))
+      (|restoreState| state)
+      (|embrace| (and ,a 
+                  (|formatLB|)
+                  (|formatRight| '|formatPreferPile| ,b ,c ,d))))))
+
+(defmacro |tryBreakNB| (a b c d) 
+; Try to format <a b> by:
+; (1) with no line breaking ($autoLine = nil)
+; (2) with possible line breaks within a;
+; (3) otherwise display without a brace
+  `(LET
+    ((state))
+    (setq state (|saveState| 't))
+    (or
+      (markhash ,b 0)
+      (LET ((|$autoLine|))
+	 (declare (special |$autoLine|))
+         (and ,a (|formatRight| '|formatPreferPile| ,b ,c ,d)))
+      (|restoreState| state)
+      (markhash ,b 1)
+      (and (eqcar ,b (quote seq))
+               (|embrace| (and 
+                  ,a
+                  (|formatLB|)
+                  (|formatRight| '|formatPreferPile| ,b ,c ,d))))
+      (markhash ,b 2)
+      (|restoreState| state)
+      (|indentNB| (and ,a 
+                  (|formatRight| '|formatPreferPile| ,b ,c ,d)))
+      (markhash ,b 3)
+
+)))   
+
+(defun markhash (key n) (progn (cond
+  ((equal n 3) (remhash key ht))
+  ('t (hput ht key n)) ) nil))
+
+
+(defmacro |shoeConsole| (line)
+ `(write-line ,line *terminal-io*))
+
+(defmacro |shoeInputFile| (filespec)
+ `(open ,filespec :direction :input :if-does-not-exist nil))
+
+(defmacro |shoeread-line| (st)
+ `(read-line ,st nil nil))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/mark.boot.pamphlet b/src/interp/mark.boot.pamphlet
new file mode 100644
index 00000000..83f63d2a
--- /dev/null
+++ b/src/interp/mark.boot.pamphlet
@@ -0,0 +1,1520 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp mark.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+
+HOW THE TRANSLATOR WORKS
+
+Unit of code is markedUp as follows (unit= item in a capsule pile, e.g.)
+  (WI/.. a b)            means    source code a --> markedUpCode b
+  (REPPER/.. . . a)      means    source code for a ---> (rep a) or (per a)
+Source code is extracted, modified from markedUpCode, and stacked
+Entire constructor is then assembled and prettyprinted
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+REMPROP("and",'parseTran)
+REMPROP("or",'parseTran)
+REMPROP("not",'parseTran)
+MAKEPROP("and",'special,'compAnd)
+MAKEPROP("or",'special,'compOr)
+MAKEPROP("not",'special,'compNot)
+SETQ($monitorWI,nil)
+SETQ($monitorCoerce,nil)
+SETQ($markPrimitiveNumbers,nil)  -- '(Integer SmallInteger))
+SETQ($markNumberTypes,'(Integer SmallInteger PositiveInteger NonNegativeInteger))
+
+--======================================================================
+--              Master Markup Function
+--======================================================================
+ 
+
+WI(a,b) == b
+
+mkWi(fn,:r) ==            
+--  if $monitorWI and r isnt ['WI,:.] and not (r is ['AUTOSUBSET,p,.,y] and(MEMQ(KAR p,'(NonNegativeInteger PositiveInteger)) or y='_$fromCoerceable_$)) then
+--    if $monitorWI and r isnt ['WI,:.] then
+--    sayBrightlyNT ['"From ",fn,'": "]
+--    pp r
+  r is ['WI,a,b] =>
+    a = b => a            --don't bother
+    b is ['WI,=a,.] => b
+    r
+  r
+ 
+--======================================================================
+--        Capsule Function Transformations
+--======================================================================
+tcheck T == 
+  if T isnt [.,.,.] then systemError 'tcheck
+  T
+  
+markComp(x,T) ==                                         --for comp
+  tcheck T
+  x ^= CAR T => [mkWi('comp,'WI,x,CAR T),:CDR T]                  
+  T
+
+markAny(key,x,T) ==
+  tcheck T
+  x ^= CAR T => [mkWi(key,'WI,x,CAR T),:CDR T]
+  T
+
+markConstruct(x,T) == 
+  tcheck T
+  markComp(x,T)
+
+markParts(x,T) ==  --x is ['PART,n,y]                     --for compNoStacking
+  tcheck T
+  [mkWi('makeParts,'WI,x,CAR T),:CDR T]
+   
+yumyum kind == kind
+markCoerce(T,T',kind) ==                                 --for coerce
+  tcheck T
+  tcheck T'
+  if kind = 'AUTOSUBSET then yumyum(kind)
+  STRINGP T.mode and T'.mode = '(String) => T'
+  markKillAll T.mode = T'.mode => T'
+  -- reduce (AUTOSUBSET a b (WI c (AUTOSUBSET b a c))) ==> c
+  u :=
+    $partExpression is [.,.,y] and T.expr = y => ['WI,y,$partExpression]
+    T.expr
+  res := [markCoerceChk mkWi('coerce,kind,T.mode,T'.mode,
+           mkWi('coerce,'WI,u,T'.expr)),:CDR T']
+  res
+  
+markCoerceChk x ==
+  x is ['AUTOSUBSET,a,b,['WI,c,['AUTOSUBSET,=b, =a, =c]]] => c
+  x
+
+markMultipleExplicit(nameList, valList, T) ==
+  tcheck T
+  [mkWi('setqMultipleExplicit, 'WI,
+    ['LET, ['Tuple,:nameList], ['Tuple,:valList]],
+    T.expr), :CDR T]
+
+markRetract(x,T) ==
+  tcheck T
+  [mkWi('smallIntegerStep,'RETRACT,nil,['REPLACE,['retract,x]],T.expr),:CDR T]
+
+markSimpleReduce(x,T) ==
+  tcheck T
+  [mkWi('compreduce,'LAMBDA, nil, ["REPLACE",x], T.expr), :CDR T]
+
+markCompAtom(x,T) ==                                     --for compAtom
+  tcheck T
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler =>
+    [mkWi('compAtom,'ATOM,nil,['REPLACE,[x]],T.expr),:CDR T]
+  T
+
+markCase(x, tag, T) ==
+  tcheck T
+  [mkWi('compCase1, 'LAMBDA, nil, ["REPLACE",["case",x,tag]], T.expr), 
+    :CDR T]
+
+markCaseWas(x,T) == 
+  tcheck T
+  [mkWi('compCase1,'WI,x,T.expr),:CDR T]
+
+markAutoWas(x,T) == 
+  tcheck T
+  [mkWi('autoCoerce,'WI,x,T.expr),:CDR T]
+
+markCallCoerce(x,m,T) ==
+  tcheck T
+  [mkWi("call",'WI,["::",x,m], T.expr),: CDR T]
+
+markCoerceByModemap(x,source,target,T, killColonColon?) == 
+  tcheck T
+  source is ["Union",:l] and member(target,l) =>
+    tag := genCaseTag(target, l, 1) or return nil
+    markAutoCoerceDown(x, tag, markAutoWas(x,T), killColonColon?)
+  target is ["Union",:l] and member(source,l) =>
+    markAutoCoerceUp(x,markAutoWas(x, T))
+  [mkWi('markCoerceByModemap,'WI,x,T.expr),:CDR T]
+   
+markAutoCoerceDown(x,tag,T,killColonColon?) ==
+  tcheck T
+  patch := ["dot",getSourceWI x,tag]
+  if killColonColon? then patch := ["REPLACE",["UNCOERCE",patch]]
+  [mkWi('coerceExtraHard,'LAMBDA, nil,patch,T.expr), :CDR T]
+
+markAutoCoerceUp(x,T) ==
+--  y := getSourceWI x
+--  y := 
+--    STRINGP y => INTERN y
+--    y   
+  tcheck T  
+  [mkWi('coerceExtraHard,'LAMBDA, nil,["REPLACE",['construct, "##1"]],T.expr),
+     -----want to capture by ##1 what is there                ------11/2/94
+    :CDR T]
+
+markCompSymbol(x,T) ==                                   --for compSymbol
+  tcheck T
+  [mkWi('compSymbol,'ATOM,nil,['REPLACE,["@",x,$Symbol]],T.expr),:CDR T]
+
+markStepSI(ostep,nstep) ==                               --for compIterator
+  ['STEP,:r] := ostep
+  ['ISTEP,i,:s] := nstep
+--$localLoopVariables := insert(i,$localLoopVariables)
+  markImport 'SmallInteger
+  mkWi('markStepSI,'WI,ostep,['ISTEP,
+    mkWi('markStep,'FREESI,nil,['REPLACE,          ['PAREN,['free,i]]],i),:s])
+--                                    i],i),:s])
+markStep(i) == mkWi('markStep,'FREE,nil,['REPLACE, ['PAREN,['free,i]]],i)
+--                                    i],i)
+
+markPretend(T,T') ==
+  tcheck T
+  tcheck T'
+  [mkWi('pretend,'COLON,"pretend",T.mode,T.expr),:CDR T']
+
+markAt(T) == 
+  tcheck T
+  [mkWi('compAtom,'COLON,"@",T.mode,T.expr),:CDR T]
+
+markCompColonInside(op,T) ==                         --for compColonInside
+  tcheck T
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler =>
+    [mkWi('compColonInside,'COLON,op,T.mode,T.expr),:CDR T]
+  T
+
+markLisp(T,m) ==                                     --for compForm1
+  tcheck T
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler =>
+    [mkWi('compForm1,'COLON,'Lisp,T.mode,T.expr),:CDR T]
+  T
+
+markLambda(vl,body,mode,T) ==                       --for compWithMappingMode
+  tcheck T
+  if mode isnt ['Mapping,:ml] then error '"markLambda"
+  args := [[":",$PerCentVariableList.i,t] for i in 0.. for t in rest ml]
+  left := [":",['PAREN,:args],first ml]
+  fun := ['_+_-_>,left,SUBLISLIS($PerCentVariableList,vl,body)] 
+  [mkWi('compWithMappingMode,'LAMBDA,nil,['REPLACE,fun],T.expr),:CDR T]
+
+markMacro(before,after) ==                            --for compMacro
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+    if before is [x] then before := x
+    $def := ['MDEF,before,'(NIL),'(NIL),after]
+    if $insideFunctorIfTrue 
+      then $localMacroStack := [[before,:after],:$localMacroStack]
+      else $globalMacroStack:= [[before,:after],:$globalMacroStack]
+    mkWi('macroExpand,'MI,before,after) 
+  after
+
+markInValue(y ,e) ==
+  y1 := markKillAll y
+  [y', m, e] := T := comp(y1, $EmptyMode, e) or return nil
+  markImport m
+  m = "$" and LASSOC('value,getProplist('Rep,e)) is [a,:.] and 
+         MEMQ(opOf a,'(List Vector)) => [markRepper('rep, y'), 'Rep, e]
+  T
+
+markReduceIn(it, pr)       ==   markReduceIterator("in",it,pr)
+markReduceStep(it, pr)     ==   markReduceIterator("step", it, pr)
+markReduceWhile(it, pr)    ==   markReduceIterator("while", it, pr)
+markReduceUntil(it, pr)    ==   markReduceIterator("until", it, pr)
+markReduceSuchthat(it, pr) == markReduceIterator("suchthat", it, pr)
+markReduceIterator(kind, it, pr) == [mkWi(kind, 'WI, it, CAR pr), :CDR pr]
+markReduceBody(body,T)     ==  
+  tcheck T
+  [mkWi("reduceBody",'WI,body,CAR T), :CDR T]
+markReduce(form, T)        ==  
+  tcheck T
+  [SETQ($funk,mkWi("reduce", 'WI,form,CAR T)), :CDR T]
+
+markRepeatBody(body,T)     ==  
+  tcheck T
+  [mkWi("repeatBody",'WI,body,CAR T), :CDR T]
+
+markRepeat(form, T)        ==  
+  tcheck T
+  [mkWi("repeat", 'WI,form,CAR T), :CDR T]
+  
+markTran(form,form',[dc,:sig],env) ==  --from compElt/compFormWithModemap
+  dc ^= 'Rep or ^MEMQ('_$,sig) => mkWi('markTran,'WI,form,['call,:form'])
+  argl := [u for t in rest sig for arg in rest form'] where u ==
+    t='_$ => 
+      argSource := getSourceWI arg
+      IDENTP argSource and getmode(argSource,env) = 'Rep => arg
+      markRepper('rep,arg)
+    arg
+  form' := ['call,CAR form',:argl]
+  wi := mkWi('markTran,'WI,form,form')
+  CAR sig = '_$ => markRepper('per,wi)
+  wi
+ 
+markRepper(key,form) == ['REPPER,nil,key,form]
+ 
+markDeclaredImport d == markImport(d,true)
+
+markImport(d,:option) ==   --from compFormWithModemap/genDeltaEntry/compImport
+  if CONTAINED('PART,d) then pause d
+  declared? := IFCAR option
+  null d or d = $Representation => nil
+  d is [op,:.] and MEMQ(op,'(Boolean Mapping Void Segment UniversalSegment)) => nil
+  STRINGP d or (IDENTP d and (PNAME d).0 = char '_#) => nil
+  MEMQ(d,'(_$ _$NoValueMode _$EmptyMode Void)) => nil
+-------=======+> WHY DOESN'T THIS WORK????????????
+--if (d' := macroExpand(d,$e)) ^= d then markImport(d',declared?)
+  dom := markMacroTran d
+--if IDENTP dom and dom = d and not getmode(dom,$e) then dom := ['MyENUM, d]
+  categoryForm? dom => nil
+  $insideCapsuleFunctionIfTrue => 
+    $localImportStack := insert(dom,$localImportStack)
+    if IFCAR option then $localDeclareStack := insert(dom,$localDeclareStack)
+  if BOUNDP '$globalImportStack then
+    $globalImportStack := insert(dom,$globalImportStack)
+    if IFCAR option then $globalDeclareStack := insert(dom,$globalDeclareStack)
+
+markMacroTran name ==     --called by markImport
+  ATOM name => name
+  u := or/[x for [x,:y] in $globalMacroStack | y = name] => u
+  u := or/[x for [x,:y] in $localMacroStack  | y = name] => u
+  [op,:argl] := name
+  MEMQ(op,'(Record Union)) => 
+--  pp ['"Cannot find: ",name]
+    name
+  [op,:[markMacroTran x for x in argl]]
+   
+markSetq(originalLet,T) ==                                --for compSetq
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+    $coerceList : local := nil
+    ['LET,form,originalBody] := originalLet
+    id := markLhs form
+    not $insideCapsuleFunctionIfTrue =>
+      $from : local := '"Setq"
+      code := T.expr
+      markEncodeChanges(code,nil)
+      noriginalLet := markSpliceInChanges originalBody
+      if IDENTP id then $domainLevelVariableList := insert(id,$domainLevelVariableList) 
+      nlet := ['LET,id,noriginalLet]
+      entry := [originalLet,:nlet]
+      $importStack := [nil,:$importStack]
+      $freeStack   := [nil,:$freeStack]
+      capsuleStack('"Setq", entry)
+--    [markKillMI T.expr,:CDR T]
+      [code,:CDR T]
+    if MEMQ(id,$domainLevelVariableList) then 
+      $markFreeStack := insert(id,$markFreeStack)
+    T
+  T
+
+markCapsuleExpression(originalExpr, T) ==
+  $coerceList: local := nil
+  $from: local := '"Capsule expression"
+  code := T.expr
+  markEncodeChanges(code, nil)
+  noriginal := markSpliceInChanges originalExpr
+  nexpr := noriginal
+  entry := [originalExpr,:nexpr]
+  $importStack := [nil,:$importStack]
+  $freeStack   := [nil,:$freeStack]
+  capsuleStack('"capsuleExpression", entry)
+  [code,:CDR T]
+
+markLhs x ==
+  x is [":",a,.] => a
+  atom x => x
+  x                  --ignore
+
+capsuleStack(name,entry) ==
+--  if $monitorWI then
+--    sayBrightlyNT ['"Stacking ",name,'": "]
+--    pp entry
+  $capsuleStack := [COPY entry,:$capsuleStack] 
+  $predicateStack := [$predl, :$predicateStack]
+  signature := 
+    $insideCapsuleFunctionIfTrue => $signatureOfForm
+    nil
+  $signatureStack := [signature, :$signatureStack]
+ 
+foobar(x) == x 
+ 
+foobum(x) == x         --from doIT
+
+
+--======================================================================
+--        Capsule Function Transformations
+--======================================================================
+--called from compDefineCapsuleFunction
+markChanges(originalDef,T,sig) == 
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+    if $insideCategoryIfTrue and $insideFunctorIfTrue then
+      originalDef := markCatsub(originalDef)
+      T := [markCatsub(T.expr),
+             markCatsub(T.mode),T.env]
+      sig := markCatsub(sig)
+      $importStack := markCatsub($importStack)
+--  T := coerce(T,first sig)         ---> needed to wrap a "per" around a Rep type
+    code := T.expr
+    $e : local := T.env
+    $coerceList : local := nil
+    $hoho := code
+    ['DEF,form,.,.,originalBody] := originalDef
+    signature := markFindOriginalSignature(form,sig)
+    $from : local := '"compDefineFunctor1"
+    markEncodeChanges(code,nil)
+    frees := 
+      null $markFreeStack => nil
+      [['free,:mySort REMDUP $markFreeStack]]
+    noriginalBody := markSpliceInChanges originalBody
+    nbody := augmentBodyByLoopDecls noriginalBody
+    ndef := ['DEF,form,signature,[nil for x in form],nbody]
+    $freeStack   := [frees,:$freeStack]
+    --------------------> import code <------------------
+    imports      := $localImportStack
+    subtractions := union($localDeclareStack,union($globalDeclareStack,
+                      union($globalImportStack,signature)))
+    if $insideCategoryIfTrue and $insideFunctorIfTrue then
+      imports      := markCatsub imports
+      subtractions := markCatsub subtractions
+    imports      := [markMacroTran d for d in imports]
+    subtractions := [markMacroTran d for d in subtractions]
+    subtractions := union(subtractions, getImpliedImports imports)
+    $importStack := [reduceImports SETDIFFERENCE(imports,subtractions),:$importStack]
+    -------------------> import code <------------------
+    entry := [originalDef,:ndef]
+    capsuleStack('"Def",entry)
+  nil
+
+reduceImports x ==
+  [k, o] := reduceImports1 x
+  SETDIFFERENCE(o,k)
+
+reduceImports1 x ==
+  kills := nil
+  others:= nil
+  for y in x repeat 
+    y is ['List,a] =>
+      [k,o] := reduceImports1 [a]
+      kills := union(y,union(k,kills))
+      others:= union(o, others)
+    rassoc(y,$globalImportDefAlist) => kills := insert(y,kills)
+    others := insert(y, others)
+  [kills, others]
+
+getImpliedImports x ==
+  x is [[op,:r],:y] => 
+    MEMQ(op, '(List Enumeration)) => union(r, getImpliedImports y)
+    getImpliedImports y
+  nil  
+ 
+augmentBodyByLoopDecls body ==
+  null $localLoopVariables => body
+  lhs := 
+    $localLoopVariables is [.] => first $localLoopVariables
+    ['LISTOF,:$localLoopVariables]
+  form := [":",lhs,$SmallInteger]
+  body is ['SEQ,:r] => ['SEQ,form,:r]
+  ['SEQ,form,['exit,1,body]]
+    
+markFindOriginalSignature(form,sig) ==
+  target := $originalTarget
+  id     := opOf form
+  n      := #form
+  cat :=
+    target is ['Join,:.,u] => u
+    target
+  target isnt ['CATEGORY,.,:v] => sig
+  or/[sig' for x in v | x is ['SIGNATURE,=id,sig'] and #sig' = n 
+    and markFindCompare(sig',sig)] or sig
+
+markFindCompare(sig',sig) ==
+  macroExpand(sig',$e) = sig
+       
+--======================================================================
+--        Capsule Function: Encode Changes on $coerceList
+--======================================================================
+--(WI a b) mean Was a Is b
+--(WI c (WI d e) b) means Was d Is b
+--(AUTOxxx p q (WI a b))     means a::q for reason xxx=SUBSET or HARD
+--(ATOM nil (REPLACE (x)) y) means replace y by x
+--(COLON :: A B)             means rewrite as A :: B  (or A @ B or A : B)
+--(LAMBDA nil (REPLACE fn) y)means replace y by fn
+--(REPPER nil per form)      means replace form by per(form)
+--(FREESI nil (REPLACE decl) y) means replace y by fn
+
+markEncodeChanges(x,s) ==
+--x is a piece of target code
+--s is a stack [a, b, ..., c] such that a < b < ...
+--calls ..markPath.. to find the location of i in a in c (the orig expression),
+--  where i is derived from x (it is the source component of x);
+--  if markPath fails to find a path for i in c, then x is wrong!
+
+--first time only: put ORIGNAME on property list of operators with a ; in name
+  if null s then markOrigName x
+  x is [fn,a,b,c] and MEMQ(fn,$markChoices) =>
+    x is ['ATOM,.,['REPLACE,[y],:.],:.] and MEMQ(y,'(false true)) => 'skip
+    ---------------------------------------------------------------------- 
+    if c then   ----> special case: DON'T STACK A nil!!!!
+      i := getSourceWI c
+      t := getTargetWI c
+  --  sayBrightly ['"=> ",i,'" ---> "]
+  --  sayBrightly ['" from ",a,'" to ",b]
+      s := [i,:s]
+--    pp '"==========="
+--    pp x
+    markRecord(a,b,s)
+    markEncodeChanges(t,s)
+  x is ['WI,p,q] or x is ['MI,p,q] =>
+    i := getSourceWI p
+    r := getTargetWI q
+    r is [fn,a,b,c] and MEMQ(fn,$markChoices) =>
+      t := getTargetWI c
+--      sayBrightly ['"==> ",i,'" ---> "]
+--      sayBrightly ['" from ",a,'" to ",b]
+      s := [i,:s]
+      markRecord(a,b,s)
+      markEncodeChanges(t,s)
+    i is [fn,:.] and MEMQ(fn, '(REPEAT COLLECT)) => markEncodeLoop(i,r,s)
+    t := getTargetWI r
+    markEncodeChanges(t,[i,:s])
+  x is ['PROGN,a,:.] and s is [[op,:.],:.] and MEMQ(op,'(REPEAT COLLECT)) =>
+    markEncodeChanges(a,s)
+  x is ['TAGGEDreturn,a,[y,:.]] => markEncodeChanges(y,s)
+  x is ['CATCH,a,y] => markEncodeChanges(y,s)
+  atom x => nil
+--  CAR x = IFCAR IFCAR s =>
+--    for y in x for r in CAR s repeat markEncodeChanges(y,[r,:s])
+  for y in x repeat markEncodeChanges(y,s)
+
+markOrigName x ==
+  x is [op,:r] =>
+    op = 'TAGGEDreturn and x is [.,a,[y,:.]] => markOrigName y
+    for y in r repeat markOrigName y     
+    IDENTP op =>
+      s := PNAME op
+      k := charPosition(char '_;, s, 0)
+      k > MAXINDEX s => nil
+      origName := INTERN SUBSTRING(s, k + 1, nil)
+      MAKEPROP(op, 'ORIGNAME, origName)
+      REMPROP(op,'PNAME)
+    markOrigName op
+  nil
+
+markEncodeLoop(i, r, s) ==  
+  [.,:itl1, b1] := i   --op is REPEAT or COLLECT
+  if r is ['LET,.,a] then r := a
+  r is [op1,:itl2,b2] and MEMQ(op1, '(REPEAT COLLECT)) =>
+    for it1 in itl1 for it2 in itl2 repeat markEncodeChanges(it2,[it1,:s])
+    markEncodeChanges(b2, [b1,:s])
+  markEncodeChanges(r, [i,:s])
+  
+getSourceWI x ==
+--Subfunction of markEncodeChanges
+  x is ['WI,a,b] or x is ['MI,a,b] =>
+    a is ['WI,:.] or a is ['MI,:.] => getSourceWI a
+    markRemove a
+  markRemove x
+
+markRemove x ==
+  atom x => x
+  x is ['WI,a,b] or x is ['MI,a,b]  => markRemove a
+  x is [fn,a,b,c] and MEMQ(fn,$markChoices) => 
+    markRemove c
+--x is ['TAGGEDreturn,:.] => x
+  x is ['TAGGEDreturn,a,[x,m,t]] => ['TAGGEDreturn,a,[markRemove x,m,t]]
+  [markRemove y for y in x]
+ 
+getTargetWI x ==
+--Subfunction of markEncodeChanges
+  x is ['WI,a,b] or x is ['MI,a,b] => getTargetWI b
+  x is ['PART,.,a] => getTargetWI a
+  x
+  
+markRecord(source,target,u) ==
+--Record changes on $coerceList
+  if source='_$ and target='Rep then 
+    target := 'rep
+  if source='Rep and target='_$ then
+    target := 'per
+  item := first u
+  FIXP item or item = $One or item = $Zero => nil
+  item is ["-",a] and (FIXP a or a = $One or a = $Zero) => nil
+  STRINGP item => nil
+  item is [op,.,t] and MEMQ(op,'( _:_: _@ _pretend)) 
+    and macroExpand(t,$e) = target => nil
+  $source: local := source
+  $target: local := target
+  path := markPath u or return nil       -----> early exit
+  path := 
+    path = 0 => nil     --wrap the WHOLE thing
+    path
+  if BOUNDP '$shout2 and $shout2 then
+      pp '"========="
+      pp path
+      ipath := reverse path
+      for x in u repeat
+        pp x
+        ipath => 
+           pp first ipath
+           ipath := rest ipath
+  entry := [source,target,:path]
+  if $monitorCoerce then
+    sayBrightlyNT ['"From ",$from,'": "]
+    pp entry
+  $coerceList := [COPY entry,:$coerceList]
+
+--======================================================================
+--  Capsule Function: Find dewey decimal path across a list
+--======================================================================
+markPath u ==        --u has nested structure: u0 < u1 < u2 ...
+  whole := LAST u
+  part  := first u
+  $path := u
+  u is [.] => 0      --means THE WHOLE THING
+  v := REVERSE markPath1 u
+--  pp '"======mark path======"
+--  foobar v
+--  pp v
+--  pp markKillAll part
+--  pp markKillAll whole
+--  pp $source
+--  pp $target
+  null v => nil
+  $pathStack := [[v,:u],:$pathStack]
+--  pp '"----------------------------"
+--  ppFull v
+--  pp '"----------------------------"
+  v
+
+markPath1 u ==   
+-- u is a list [a, b, ... c]
+-- This function calls markGetPath(a,b) to find the location of a in b, etc.
+-- The result is the successful path from a to c
+-- A error printout occurs if no such path can be found
+  u is [a,b,:r] =>  -- a < b < ...
+    a = b => markPath1 CDR u       ---> allow duplicates on path
+    path := markGetPath(a,b) or return nil    -----> early exit
+    if BOUNDP '$shout1 and $shout1 then
+      pp '"========="
+      pp path
+      pp a
+      pp b
+    [:first path,:markPath1 CDR u]
+  nil
+
+markGetPath(x,y) ==    -- x < y  ---> find its location
+  u := markGetPaths(x,y) 
+  u is [w] => u
+  $amb := [u,x,y]
+  key :=
+    null u => '"no match"
+    '"ambiguous"
+  sayBrightly ['"-----",key,'"--------"]
+  if not BOUNDP '$pathErrorStack then SETQ($pathErrorStack,nil)
+  SETQ($pathErrorStack,[$path,:$pathErrorStack])
+  pp "CAUTION: this can cause RPLAC errors"
+  pp "Paths are: "
+  pp u
+  for p in $path for i in 1..3 repeat pp p
+  $x: local := x
+  $y: local := y
+  pp '"---------------------"
+  pp x
+  pp y
+  foobar key
+--  pp [key, $amb]
+  null u => [1729] --return something that will surely fail if no path
+  [first u]
+
+markTryPaths() == markGetPaths($x,$y)
+
+markPaths(x,y,s) ==    --x < y; find location s of x in y (initially s=nil)
+--NOTES: This location is what it will be in the source program with
+--  all PART information removed. 
+  if BOUNDP '$shout and $shout then
+    pp '"-----"
+    pp x
+    pp y
+    pp s
+  x = y => s         --found it!  exit
+  markPathsEqual(x,y) => s
+  y is [['elt,.,op],:r] and (u := markPaths(x,[op,:r],s)) => u
+  x is ['elt,:r] and (u := markPaths(r,y,s)) => u
+  y is ['elt,:r] and (u := markPaths(x,r,s)) => u
+  x is [op,:u] and MEMQ(op,'(LIST VECTOR)) and y is ['construct,:v] and
+    (p := markPaths(['construct,:u],y,s)) => p
+  atom y => nil
+  y is ['LET,a,b] and IDENTP a => 
+    markPaths(x,b,markCons(2,s)) --and IDENTP x
+  y is ['LET,a,b] and GENSYMP a => markPaths(x,b,s)     --for loops
+  y is ['IF,a,b,:.] and GENSYMP a => markPaths(x,b,s)   --for loops
+  y is ['IF,a,b,c] and (p := (markPathsEqual(x,b) => 2;
+                              markPathsEqual(x,c) => 3;
+                              nil)) => markCons(p,s)
+--  x is ['exit,a,b] and y is ['exit,a,c] and (p := mymy markPathsEqual(b,c)) =>
+--     markCons(p,s)
+  y is ['call,:r] => markPaths(x,r,s)                 --for loops
+  y is [fn,m,y1] and MEMQ(fn,'(PART CATCH THROW)) => markPaths(x,y1,s) or
+    "APPEND"/[markPaths(x,u,markCons(i,s)) for u in y1 for i in 0..]
+  "APPEND"/[markPaths(x,u,markCons(i,s)) for u in y for i in 0..]
+
+mymy x == x
+
+markCons(i,s) == [[i,:x] for x in s]
+
+markPathsEqual(x,y) ==
+  x = y => true
+  x is ["::",.,a] and y is ["::",.,b] and 
+    a = '(Integer) and b = '(NonNegativeInteger) => true
+  y is [fn,.,z] and MEMQ(fn,'(PART CATCH THROW)) and markPathsEqual(x,z) => true
+  y is ['LET,a,b] and GENSYMP a and markPathsEqual(x,b) => true
+  y is ['IF,a,b,:.] and GENSYMP a => markPathsEqual(x,b)  -------> ??? 
+  y is ['call,:r] => markPathsEqual(IFCDR x,r)
+  x is ['REDUCE,.,.,c,:.] and c is ['COLLECT,:u] and 
+    y is ['PROGN,.,repeet,:.] and repeet is ['REPEAT,:v] => markPathsEqual(u,v)
+  atom y or atom x => 
+    IDENTP y and IDENTP x and y = GETL(x,'ORIGNAME)  => true --> see 
+--  IDENTP y and IDENTP x and anySubstring?(PNAME y,PNAME x,0) => true
+    IDENTP y and (z := markPathsMacro y) => markPathsEqual(x,z)
+    false
+  "and"/[markPathsEqual(u,v) for u in x for v in y]
+
+markPathsMacro y ==
+  LASSOC(y,$localMacroStack) or LASSOC(y,$globalMacroStack)
+--======================================================================
+--      Capsule Function: DO the transformations
+--======================================================================
+--called by markChanges (inside capsule), markSetq (outside capsule)
+markSpliceInChanges body ==
+--  pp '"before---->"
+--  pp $coerceList
+  $coerceList := REVERSE SORTBY('CDDR,$coerceList)
+--  pp '"after----->"
+--  pp $coerceList
+  $cl := $coerceList
+--if CONTAINED('REPLACE,$cl) then hoho $cl
+  body :=
+    body is ['WI,:.] => 
+--      hehe body
+      markKillAll body
+    markKillAll body
+--NOTE!! Important that $coerceList be processed in this order
+--since it must operate from the inside out. For example, a progression
+--u --> u::Rep --> u :: Rep :: $ can only be correct. Here successive
+--entries can have duplicate codes
+  for [code,target,:loc] in $coerceList repeat
+    $data: local := [code, target, loc]
+    if BOUNDP '$hohum and $hohum then 
+      pp '"---------->>>>>"
+      pp $data
+      pp body
+      pp '"-------------------------->"
+    body := markInsertNextChange body
+  body
+
+--pause() == 12
+markInsertNextChange body ==
+--  if BOUNDP '$sayChanges and $sayChanges then 
+--    sayBrightlyNT '"Inserting change: "
+--    pp $data
+--    pp body
+--    pause()
+  [code, target, loc] := $data
+  markInsertChanges(code,body,target,loc)
+
+markInsertChanges(code,form,t,loc) ==
+--RePLACe x at location "loc" in form as follows:
+--  t is ['REPLACE,r]:   by r
+--  t is 'rep/per:       by (rep x) or (per x)
+--  code is @ : ::       by (@ x t) (: x t) (:: x t)
+--  code is Lisp         by (pretend form t)
+--  otherwise            by (:: form t)
+  loc is [i,:r] =>
+    x := form
+    for j in 0..(i-1) repeat 
+      if not atom x then x := CDR x
+    atom x => 
+        pp '"Translator RPLACA error"
+        pp $data
+        foobum form
+        form
+    if BOUNDP '$hohum and $hohum then pp [i, '" >>> ", x]
+    SETQ($CHANGE,COPY x)
+    if x is ['elt,:y] and r then x := y
+    RPLACA(x,markInsertChanges(code,CAR x,t,rest loc))
+    chk(x,100)
+    form
+--  pp ['"Making change: ",code,form,t]
+  t is ['REPLACE,r] => SUBST(form,"##1",r)
+  form is ['SEQ,:y,['exit,1,z]] => 
+    ['SEQ,:[markInsertSeq(code,x,t) for x in y],
+      ['exit,1,markInsertChanges(code,z,t,nil)]]
+  code = '_pretend or code = '_: => 
+    form is [op,a,.] and MEMQ(op,'(_@ _: _:_: _pretend)) => ['_pretend,a,t]
+    [code,form,t]
+  MEMQ(code,'(_@ _:_: _pretend)) =>  
+    form is [op,a,b] and MEMQ(op,'(_@ _: _:_: _pretend)) =>
+      MEMQ(op,'(_: _pretend)) => form
+      op = code and b = t => form
+      markNumCheck(code,form,t)
+    FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t]
+    [code,form,t]
+  MEMQ(code,'(_@ _:_: _:)) and form is [op,a] and 
+    (op='rep and t = 'Rep or op='per and t = "$") => form
+  code = 'Lisp => 
+    t = $EmptyMode => form
+    ["pretend",form,t]
+  MEMQ(t,'(rep per)) => 
+    t = 'rep and EQCAR(form,'per) => CADR form
+    t = 'per and EQCAR(form,'rep) => CADR form
+    [t,form]
+  code is [op,x,t1] and MEMQ(op,'(_@ _: _:_: _pretend)) and t1 = t => form
+  FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t]
+  markNumCheck("::",form,t)
+
+markNumCheck(op,form,t) ==
+  op = "::" and MEMQ(opOf t,'(Integer)) =>
+     s := form = $One and 1 or form = $Zero and 0 => ['DOLLAR, s , t]
+     FIXP form                   => ["@", form, t]
+     form is ["-", =$One]        => ['DOLLAR, -1,   t]
+     form is ["-", n] and FIXP n => ["@", MINUS n, t]
+     [op, form, t]
+  [op,form,t]
+
+markInsertSeq(code,x,t) ==
+  x is ['exit,y] => ['exit,markInsertChanges(code,y,t,nil)]
+  atom x => x
+  [markInsertSeq(code,y,t) for y in x]
+--======================================================================
+--               Prettyprint of translated program
+--======================================================================
+markFinish(body,T) ==
+--called by compDefineCategory2, compDefineFunctor1 (early jumpout)
+  SETQ($cs,$capsuleStack)
+  SETQ($ps,$predicateStack)
+  SETQ($ss,$signatureStack)
+  SETQ($os,$originalTarget)
+  SETQ($gis,$globalImportStack)
+  SETQ($gds,$globalDeclareStack)
+  SETQ($gms,$globalMacroStack)
+  SETQ($as, $abbreviationStack)
+  SETQ($lms,$localMacroStack)
+  SETQ($map,$macrosAlreadyPrinted)
+  SETQ($gs,$importStack)
+  SETQ($fs,$freeStack)
+  SETQ($b,body)
+  SETQ($t,T)
+  SETQ($e,T.env)
+--if $categoryTranForm then SETQ($t,$categoryTranForm . 1)
+  atom CDDR T => systemError()
+  RPLACA(CDDR T,$EmptyEnvironment)
+  chk(CDDR T,101)
+  markFinish1()
+  T
+
+reFinish() ==
+  $importStack := $gs
+  $freeStack := $fs
+  $capsuleStack := $cs
+  $predicateStack := $ps
+  $signatureStack := $ss
+  $originalTarget := $os
+  $globalMacroStack := $gms
+  $abbreviationStack:= $as
+  $globalImportStack := $gis
+  $globalDeclareStack := $gds
+  $localMacroStack := $lms
+  $macrosAlreadyPrinted := $map
+  $abbreviationsAlreadyPrinted := nil
+  markFinish1()
+ 
+markFinish1() ==
+  body := $b
+  T    := $t
+  $predGensymAlist: local := nil
+--$capsuleStack := $cs
+--$predicateStack := $ps
+  form := T. expr
+  ['Mapping,:sig] := T.mode
+  if $insideCategoryIfTrue and $insideFunctorIfTrue then
+     $importStack       := [delete($categoryNameForDollar,x) for x in $importStack]
+     $globalImportStack := delete($categoryNameForDollar,$globalImportStack)
+  $commonImports : local := getCommonImports()
+  globalImports := 
+    REVERSE orderByContainment REMDUP [:$commonImports,:$globalImportStack]
+  $finalImports: local := SETDIFFERENCE(globalImports,$globalDeclareStack)
+  $capsuleStack := 
+    [mkNewCapsuleItem(freepart,imports,x) for freepart in $freeStack 
+       for imports in $importStack for x in $capsuleStack] 
+  $extraDefinitions := combineDefinitions()
+  addDomain := nil
+  initbody :=
+    $b is ['add,a,b] => 
+      addDomain := a
+      b
+    $b is [op,:.] and constructor? op =>
+      addDomain := $b
+      nil
+    $b
+  body := markFinishBody initbody
+  importCode := [['import,x] for x in $finalImports]
+  leadingMacros := markExtractLeadingMacros(globalImports,body)
+  body := markRemImportsAndLeadingMacros(leadingMacros,body)
+  initcapsule := 
+    body => ['CAPSULE,:leadingMacros,:importCode,:body]
+    nil
+  capsule := 
+--  null initcapsule => addDomain
+    addDomain => ['add,addDomain,initcapsule]
+    initcapsule
+  nsig :=
+    $categoryPart => sig
+    ['Type,:rest sig]
+  for x in REVERSE $abbreviationStack |not member(x,$abbreviationsAlreadyPrinted) repeat 
+     markPrintAbbreviation x
+     $abbreviationsAlreadyPrinted := insert(x,$abbreviationsAlreadyPrinted)
+  for x in REVERSE $globalMacroStack|not member(x,$macrosAlreadyPrinted) repeat
+    $def := ['MDEF,first x,'(NIL),'(NIL),rest x]
+    markPrint(true)
+    $macrosAlreadyPrinted := insert(x,$macrosAlreadyPrinted)
+  if $insideCategoryIfTrue and not $insideFunctorIfTrue then
+    markPrintAttributes $b
+  $def := ['DEF,form,nsig,[nil for x in form],capsule]
+  markPrint()
+
+stop x == x
+
+getNumberTypesInScope() ==
+  union([y for x in $localImportStack | MEMQ(y := opOf x,$markNumberTypes)], 
+        [y for x in $globalImportStack| MEMQ(y := opOf x,$markNumberTypes)])
+
+getCommonImports() ==
+  importList := [x for x in $importStack for y in $capsuleStack |
+                   KAR KAR y = 'DEF]
+  hash := MAKE_-HASHTABLE 'EQUAL
+  for x in importList repeat
+    for y in x repeat HPUT(hash,y,1 + (HGET(hash,y) or 0))
+  threshold := FLOOR (.5 * #importList)
+  [x for x in HKEYS hash | HGET(hash,x) >= threshold]
+  
+markPrintAttributes addForm ==
+  capsule :=
+    addForm is ['add,a,:.] => 
+      a is ['CATEGORY,:.] => a
+      a is ['Join,:.] => CAR LASTNODE a
+      CAR LASTNODE addForm
+    addForm
+  if capsule is ['CAPSULE,:r] then
+    capsule := CAR LASTNODE r
+  capsule isnt ['CATEGORY,.,:lst] => nil
+  for x in lst | x is ['ATTRIBUTE,att] repeat
+    markSay(form2String att)
+    markSay('": Category == with")
+    markTerpri()
+    markTerpri()
+
+getCommons u ==
+  common := KAR u
+  while common and u is [x,:u] repeat common := intersection(x,common)
+  common
+
+markExtractLeadingMacros(globalImports,body) ==
+  [x for x in body | x is ['MDEF,[a],:.] and member(a,globalImports)]
+  
+markRemImportsAndLeadingMacros(leadingMacros,body) ==
+  [x for x in body | x isnt ['import,:.] and not member(x,leadingMacros)]
+
+mkNewCapsuleItem(frees,i,x) ==
+  [originalDef,:ndef] := x
+  imports := REVERSE orderByContainment REMDUP SETDIFFERENCE(i,$finalImports)
+  importPart := [['import,d] for d in imports]
+  nbody := 
+    ndef is ['LET,.,x] => x
+    ndef is ['DEF,.,.,.,x] => x
+    ndef
+  newerBody :=
+    newPart := [:frees,:importPart] =>
+      nbody is ['SEQ,:y] => ['SEQ,:newPart,:y]
+      ['SEQ,:newPart,['exit,1,nbody]]
+    nbody
+  newerDef := 
+    ndef is ['LET,a,x] => ['LET,a,newerBody]
+    ndef is ['DEF,a,b,c,x] => ['DEF,a,b,c,newerBody]
+    newerBody
+  entry := [originalDef,:newerDef]
+  entry
+
+markFinishBody capsuleBody ==
+  capsuleBody is ['CAPSULE,:itemlist] =>
+    if $insideCategoryIfTrue and $insideFunctorIfTrue then
+       itemlist := markCatsub itemlist
+    [:[markFinishItem x for x in itemlist],:$extraDefinitions]
+  nil
+
+markCatsub x == SUBST("$",$categoryNameForDollar,x)
+ 
+markFinishItem x ==
+  $macroAlist : local := [:$localMacroStack,:$globalMacroStack]
+  if $insideCategoryIfTrue and $insideFunctorIfTrue then
+    $macroAlist := [["$",:$categoryNameForDollar],:$macroAlist]
+  x is ['DEF,form,.,.,body] =>
+    "or"/[new for [old,:new] in $capsuleStack |
+        old is ['DEF,oform,.,.,obody] 
+          and markCompare(form,oform) and markCompare(body,obody)] or
+            pp '"------------MISSING----------------"
+            $f := form
+            $b := body
+            newform := "or"/[x for [old,:new] in $capsuleStack | 
+              old is ['DEF,oform,.,.,obody] and oform = $f]
+            $ob:= (newform => obody; nil)
+            pp $f
+            pp $b
+            pp $ob
+            foobum x
+            pp x
+            x
+  x is ['LET,lhs,rhs] =>
+    "or"/[new for [old,:new] in $capsuleStack |
+        old is ['LET,olhs,orhs]
+          and markCompare(lhs,olhs) and markCompare(rhs,orhs)]
+            or x
+  x is ['IF,p,a,b] => ['IF,p,markFinishItem a,markFinishItem b]
+  x is ['SEQ,:l,['exit,n,a]] =>
+    ['SEQ,:[markFinishItem y for y in l],['exit,n,markFinishItem a]]
+  "or"/[new for [old,:new] in $capsuleStack | markCompare(x,old)] =>
+    new
+  x
+ 
+markCompare(x,y) == 
+  markKillAll(SUBLIS($macroAlist,x)) = markKillAll(SUBLIS($macroAlist,y))
+
+diffCompare(x,y) == diff(SUBLIS($macroAlist,x),markKillAll(SUBLIS($macroAlist,y)))
+ 
+--======================================================================
+--               Print functions
+--======================================================================
+markPrint(:options) ==   --print $def 
+  noTrailingSemicolonIfTrue := IFCAR options
+--$insideCategoryIfTrue and $insideFunctorIfTrue => nil
+  $DEFdepth : local := 0
+  [op,form,sig,sclist,body] := markKillAll $def
+  if $insideCategoryIfTrue then
+    if op = 'DEF and $insideFunctorIfTrue then
+      T := $categoryTranForm . 1
+      form := T . expr
+      sig  := rest (T . mode)
+    form := SUBLISLIS(rest markConstructorForm opOf form,
+              $TriangleVariableList,form)
+    sig  := SUBLISLIS(rest markConstructorForm opOf form,
+              $TriangleVariableList,sig)
+  nbody := body
+  if $insideCategoryIfTrue then
+    if $insideFunctorIfTrue then
+      nbody := replaceCapsulePart body
+      nbody :=
+        $catAddForm => ['withDefault, $catAddForm, nbody]
+        nbody
+    else      
+      ['add,a,:r] := $originalBody
+      xtraLines := 
+        "append"/[[STRCONC(name,'": Category == with"),'""] 
+           for name in markCheckForAttributes a]
+      nbody :=
+        $originalBody is ['add,a,b] =>
+          b isnt ['CAPSULE,:c] => error(false)
+          [:l,x] := c
+          [:markTranCategory a,['default,['SEQ,:l,['exit,1,x]]]]
+        markTranCategory $originalBody      
+  signature :=
+    $insideFunctorIfTrue => [markTranJoin $originalTarget,:rest sig]
+    $insideCategoryIfTrue => ['Category,:rest sig]
+    '(NIL)
+  $bootForm:= 
+    op = 'MDEF => [op,form,signature,sclist,body]
+    [op,form,signature,sclist,nbody]
+  bootLines:= lisp2Boot $bootForm
+  $bootLines:= [:xtraLines,:bootLines]
+  moveAroundLines()
+  markSay $bootLines
+  markTerpri()
+  'done
+
+replaceCapsulePart body == 
+  body isnt ['add,['CAPSULE,:c]] => body
+  $categoryTranForm . 0 isnt ['add,exports,['CAPSULE,:.]] => error(false) 
+  [:l,x] := c
+  [:markTranCategory exports,['default,['SEQ,:l,['exit,1,x]]]]
+
+foo(:x) == 
+ arg := IFCAR x or $bootForm
+ markSay lisp2Boot arg
+
+markPrintAbbreviation [kind,a,:b] == 
+  markSay '"--)abbrev "
+  markSay kind
+  markSay '" "
+  markSay a
+  markSay '" "
+  markSay b
+  markTerpri()
+
+markSay s == 
+  null atom s =>
+    for x in s repeat
+      (markSay(lispStringList2String x); markTerpri())
+  PRINTEXP s
+  if $outStream then PRINTEXP(s,$outStream)
+
+markTerpri() ==
+  TERPRI()
+  if $outStream then TERPRI($outStream)
+
+markTranJoin u ==                      --subfunction of markPrint
+  u is ['Join,:.] => markTranCategory u
+  u
+
+markTranCategory cat ==               
+  cat is ['CATEGORY,:.] => cat
+  cat is ['Join,:r] =>
+    r is [:s,b] and b is ['CATEGORY,k,:t] => ['CATEGORY,k,:s,:markSigTran t] 
+    ['CATEGORY,'domain,:markSigTran r]
+  ['CATEGORY,'domain,cat]
+
+markSigTran t == [markElt2Apply x for x in t]
+
+markElt2Apply x ==
+  x is ["SIGNATURE", "elt", :r] => ['SIGNATURE, 'apply, :r]
+  x
+
+markCheckForAttributes cat ==          --subfunction of markPrint
+  cat is ['Join,:r] => markCheckForAttributes last r
+  cat is ['CATEGORY,.,:r] => [u for x in r | u := fn(x)] where fn(x) ==
+    x is ['ATTRIBUTE,form,:.] => 
+      name := opOf form
+      MEMQ(name,$knownAttributes) => nil
+      $knownAttributes := [name,:$knownAttributes]
+      name
+    nil
+  nil
+
+--======================================================================
+--        Put in PARTs in code
+--======================================================================
+$partChoices := '(construct IF)
+$partSkips   := '(CAPSULE with add)
+unpart x ==
+  x is ['PART,.,y] => y
+  x
+
+markInsertParts df ==
+  $partNumber := 0
+  ["DEF",form,a,b,body] := df
+--if form is [op,:r] and (u := LASSOC(op,$opRenameAlist)) 
+--  then form := [u,:r]
+  ['DEF,form,a,b,markInsertBodyParts body]
+  
+markInsertBodyParts u ==
+  u is ['Join,:.] or u is ['CATEGORY,:.] => u
+  u is ['DEF,f,a,b,body] => ['DEF,f,a,b,markInsertBodyParts body]
+  u is ['SEQ,:l,['exit,n,x]] =>
+    ['SEQ,:[markInsertBodyParts y for y in l],
+           ['exit,n,markInsertBodyParts x]]
+  u is [op,:l] and MEMQ(op,'(REPEAT COLLECT)) => markInsertRepeat u
+  u is ['LET,['Tuple,:s],b] =>
+    ['LET,['Tuple,:[markWrapPart x for x in s]],markInsertBodyParts b]
+--u is ['LET,a,b] and constructor? opOf b => u
+  u is ['LET,a,b] and a is [op,:.] =>
+    ['LET,[markWrapPart x for x in a],markInsertBodyParts b]
+  u is [op,a,b] and MEMQ(op,'(_add _with IN LET)) =>
+    [op,markInsertBodyParts a,markInsertBodyParts b]
+  u is [op,a,b] and MEMQ(op,'(_: _:_: _pretend _@)) =>
+    [op,markInsertBodyParts a,b]
+  u is [op,a,:x] and MEMQ(op,'(STEP return leave exit reduce)) => 
+    [op,a,:[markInsertBodyParts y for y in x]]
+  u is [op,:x] and markPartOp? op => [op,:[markWrapPart y for y in x]]
+  u is [op,:.] and constructor? op => u
+  atom u => markWrapPart u
+            ------------           <--------------94/10/11
+  [markInsertBodyParts x for x in u]
+
+markPartOp? op ==
+  MEMQ(op,$partChoices) => true
+  MEMQ(op,$partSkips)   => false
+  if op is ['elt,.,o] then op := o
+  GETL(op,'special) => false
+  true
+
+markWrapPart y ==
+----------------new definition----------94/10/11
+  atom y => 
+    y = 'noBranch => y
+    GETL(y, 'SPECIAL) => y 
+    $partNumber := $partNumber + 1
+    ['PART,$partNumber, y] 
+  ['PART,$partNumber := $partNumber + 1,markInsertBodyParts y]
+
+markInsertRepeat [op,:itl,body] ==
+  nitl := [markInsertIterator x for x in itl]
+  nbody := 
+--->IDENTP body => markWrapPart body
+----------------new definition----------94/10/11
+    markInsertBodyParts body
+  [op,:nitl,nbody]
+
+markInsertIterator x ==
+  x is ['STEP,k,:r]  => ['STEP,markWrapPart k,:[markWrapPart x for x in r]]
+  x is ['IN,p,q]     => ['IN,markWrapPart p,markWrapPart q]
+  x is ["|",p]       => ["|",markWrapPart p]
+  x is ['WHILE,p]    => ['WHILE,markWrapPart p]
+  x is ['UNTIL,p]    => ['UNTIL,markWrapPart p]
+  systemError()
+  
+--======================================================================
+--        Kill Function: MarkedUpCode --> Code
+--======================================================================
+
+markKillExpr m ==    --used to kill all but PART information for compilation
+  m is [op,:.] =>
+    MEMQ(op,'(MI WI)) => markKillExpr CADDR m
+    MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillExpr CADDDR m
+    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillExpr x,m,e]]
+    [markKillExpr x for x in m]
+  m
+ 
+markKillButIfs m ==    --used to kill all but PART information for compilation
+  m is [op,:.] =>
+    op = 'IF => m
+    op = 'PART        => markKillButIfs CADDR m
+    MEMQ(op,'(MI WI)) => markKillButIfs CADDR m
+    MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillButIfs CADDDR m
+    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillButIfs x,m,e]]
+    [markKillButIfs x for x in m]
+  m
+ 
+markKillAll m ==      --used to prepare code for compilation
+  m is [op,:.] =>
+    op = 'PART        => markKillAll CADDR m
+    MEMQ(op,'(MI WI)) => markKillAll CADDR m
+    MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillAll CADDDR m
+    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillAll x,m,e]]
+    [markKillAll x for x in m]
+  m
+ 
+--======================================================================
+--                Moving lines up/down 
+--======================================================================
+moveAroundLines() ==
+  changeToEqualEqual $bootLines
+  $bootLines := moveImportsAfterDefinitions $bootLines  
+
+changeToEqualEqual lines ==
+--rewrite A := B as A == B whenever A is an identifier and
+--                                  B is a constructor name (after macro exp.)
+  origLines := lines
+  while lines is [x, :lines] repeat
+    N := MAXINDEX x
+    (n := charPosition($blank, x, 8)) > N => nil
+    n = 0 => nil
+    not ALPHA_-CHAR_-P (x . (n - 1)) => nil
+    not substring?('":= ", x, n+1) => nil
+    m := n + 3
+    while (m := m + 1) <= N and ALPHA_-CHAR_-P (x . m) repeat nil
+    m = n + 2 => nil
+    not UPPER_-CASE_-P (x . (n + 4)) => nil
+    word := INTERN SUBSTRING(x, n + 4, m - n - 4)
+    expandedWord := macroExpand(word,$e)
+    not (MEMQ(word, '(Record Union Mapping)) 
+      or GETDATABASE(opOf expandedWord,'CONSTRUCTORFORM)) => nil
+    sayMessage '"Converting input line:"
+    sayMessage ['"WAS: ", x]
+    x . (n + 1) := char '_= ;
+    sayMessage ['"IS:  ", x]
+    TERPRI()
+  origLines
+    
+sayMessage x == 
+  u := 
+    ATOM x => ['">> ", x]
+    ['">> ",: x]
+  sayBrightly u
+  
+moveImportsAfterDefinitions lines ==
+  al := nil
+  for x in lines for i in 0.. repeat
+    N := MAXINDEX x
+    m := firstNonBlankPosition x
+    m < 0 => nil
+    ((n := charPosition($blank ,x,1 + m)) < N) and
+      substring?('"== ", x, n+1) => 
+        name := SUBSTRING(x, m, n - m)
+        defineAlist := [[name, :i], :defineAlist]
+    (k := leadingSubstring?('"import from ",x, 0)) =>
+      importAlist := [[SUBSTRING(x,k + 12,nil), :i], :importAlist]
+--  pp defineAlist
+--  pp importAlist
+  for [name, :i] in defineAlist repeat
+    or/[fn for [imp, :j] in importAlist] where fn ==
+      substring?(name,imp,0) =>
+        moveAlist := [[i,:j], :moveAlist]
+      nil
+  null moveAlist => lines
+  moveLinesAfter(mySort moveAlist, lines)
+
+leadingSubstring?(part, whole, :options) ==
+  after := IFCAR options or 0
+  substring?(part, whole, k := firstNonBlankPosition(whole, after)) => k
+  false
+
+stringIsWordOf?(s, t, startpos) ==
+  maxindex := MAXINDEX t
+  (n := stringPosition(s, t, startpos)) > maxindex => nil
+  wordDelimiter? t . (n - 1)
+  n = maxindex or wordDelimiter? t . (n + #s)
+
+wordDelimiter? c == or/[CHAR_=(c,('"() ,;").i) for i in 0..4]
+
+moveLinesAfter(alist, lines) ==
+  n := #lines
+  acc := nil
+  for i in 0..(n - 1) for x in lines repeat
+    (p :=  ASSOC(i, alist)) and STRINGP CDR p => acc := [CDR p, x, :acc]
+    (p :=  lookupRight(i, alist)) and (CAR p) > i => RPLACD(p, x)
+    acc := [x, :acc]
+  REVERSE acc  
+  
+lookupRight(x, al) == 
+  al is [p, :al] =>
+    x = CDR p => p
+    lookupRight(x, al)
+  nil
+
+--======================================================================
+--                Utility Functions
+--======================================================================
+  
+ppEnv [ce,:.] ==
+  for env in ce repeat
+    for contour in env repeat
+      pp contour
+    
+diff(x,y) ==
+  for [p,q] in (r := diff1(x,y)) repeat 
+    pp '"------------"
+    pp p
+    pp q
+  #r
+ 
+diff1(x,y) ==
+  x = y => nil
+  ATOM x or ATOM y => [[x,y]]
+  #x ^= #y => [x,y]
+  "APPEND"/[diff1(u,v) for u in x for v in y]
+    
+markConstructorForm name ==  --------> same as getConstructorForm
+  name = 'Union   => '(Union  (_: a A) (_: b B))
+  name = 'UntaggedUnion => '(Union A B)
+  name = 'Record  => '(Record (_: a A) (_: b B))
+  name = 'Mapping => '(Mapping T S)
+  GETDATABASE(name,'CONSTRUCTORFORM)
+
+--======================================================================
+--                new path functions
+--======================================================================
+  
+markGetPaths(x,y) == 
+  BOUNDP '$newPaths and $newPaths => 
+--  res := reverseDown mkGetPaths(x, y)
+    res := mkGetPaths(x, y)
+--    oldRes := markPaths(x,y,[nil])
+--    if res ^= oldRes then $badStack := [[x, :y], :$badStack]
+--    oldRes
+  markPaths(x,y,[nil])
+ 
+mkCheck() ==
+  for [x, :y] in REMDUP $badStack repeat
+    pp '"!!-------------------------------!!"
+    res := mkGetPaths(x, y)
+    oldRes := markPaths(x, y, [nil])
+    pp x
+    pp y
+    sayBrightlyNT '"new: "
+    pp res
+    sayBrightlyNT '"old: "
+    pp oldRes
+
+reverseDown u == [REVERSE x for x in u]
+
+mkCheckRun() ==
+  for [x, :y] in REMDUP $badStack repeat
+    pp mkGetPaths(x,y)
+
+mkGetPaths(x,y) ==
+  u := REMDUP mkPaths(x,y) => getLocationsOf(u,y,nil)
+  nil	
+
+mkPaths(x,y) ==   --x < y; find location s of x in y (initially s=nil)
+  markPathsEqual(x,y) => [y]
+  atom y => nil
+  x is [op, :u] and MEMQ(op,'(LIST VECTOR)) and y is ['construct,:v] 
+    and markPathsEqual(['construct,:u],y) => [y]
+  (y is ['LET,a,b] or y is ['IF,a,b,:.]) and GENSYMP a and markPathsEqual(x,b) => [y]
+  y is ['call,:r] => 
+--  markPathsEqual(x,y1) => [y]
+    mkPaths(x,r) => [y]
+  y is ['PART,.,y1] => mkPaths(x,y1)
+  y is [fn,.,y1] and MEMQ(fn,'(CATCH THROW)) =>
+--  markPathsEqual(x,y1) => [y]
+    mkPaths(x,y1) => [y]
+  y is [['elt,.,op],:r] and (u := mkPaths(x,[op,:r])) => u
+  x is ['elt,:r] and (u := mkPaths(r,y)) => u
+  y is ['elt,:r] and (u := mkPaths(x,r)) => u
+  "APPEND"/[u for z in y | u := mkPaths(x,z)]
+
+getLocationsOf(u,y,s) == [getLocOf(x,y,s) for x in u]
+
+getLocOf(x,y,s) ==
+  x = y or x is ['elt,:r] and r = y => s
+  y is ['PART,.,y1] => getLocOf(x,y1,s)
+  if y is ['elt,:r] then y := r
+  atom y => nil
+  or/[getLocOf(x,z,[i, :s]) for i in 0.. for z in y]
+
+  
+--======================================================================
+--           Combine Multiple Definitions Into One
+--======================================================================
+
+combineDefinitions() ==
+--$capsuleStack has form   (def1  def2  ..)
+--$signatureStack has form (sig1  sig2  ..) where sigI = nil if not a def
+--$predicateStack has form (pred1 pred2 ..)
+--record in $hash: alist of form [[sig, [predl, :body],...],...] under each op
+  $hash  := MAKE_-HASH_-TABLE()
+  for defs in $capsuleStack 
+    for sig in $signatureStack 
+      for predl in $predicateStack | sig repeat
+--      pp [defs, sig, predl]
+        [["DEF",form,:.],:.] := defs
+        item := [predl, :defs]
+        op := opOf form
+        oldAlist := HGET($hash,opOf form) 
+        pair := ASSOC(sig, oldAlist) => RPLACD(pair, [item,:CDR pair])
+        HPUT($hash, op, [[sig, item], :oldAlist])
+--extract and combine multiple definitions
+  Xdeflist := nil
+  for op in HKEYS $hash repeat
+    $acc: local := nil
+    for [sig,:items] in HGET($hash,op) | (k := #items) > 1 repeat
+      for i in 1.. for item in items repeat
+        [predl,.,:def]    := item
+        ['DEF, form, :.] := def
+        ops := PNAME op
+        opName := INTERN(STRCONC(ops,'"X",STRINGIMAGE i))
+        RPLACA(form, opName)
+--      rplacaSubst(op, opName, def)
+        $acc := [[form,:predl], :$acc]
+      Xdeflist := [buildNewDefinition(op,sig,$acc),:Xdeflist]
+  REVERSE Xdeflist
+               
+rplacaSubst(x, y, u) == (fn(x, y, u); u) where fn(x,y,u) ==
+  atom u => nil
+  while u is [p, :q] repeat
+    if EQ(p, x) then RPLACA(u, y)
+    if null atom p then fn(x, y, p)
+    u := q
+    
+buildNewDefinition(op,theSig,formPredAlist) ==
+  newAlist := [fn for item in formPredAlist] where fn ==
+    [form,:predl] := item
+    pred :=
+      null predl => 'T
+      boolBin simpHasPred markKillAll MKPF(predl,"and") 
+    [pred, :form]
+  --make sure that T comes as last predicate
+  outerPred := boolBin simpHasPred MKPF(ASSOCLEFT newAlist,"or")
+  theForm := CDAR newAlist
+  alist := moveTruePred2End newAlist
+  theArgl := CDR theForm
+  theAlist := [[pred, CAR form, :theArgl] for [pred,:form] in alist]
+  theNils := [nil for x in theForm]
+  thePred :=
+     member(outerPred, '(T (QUOTE T))) => nil
+     outerPred
+  def := ['DEF, theForm, theSig, theNils, ifize theAlist]
+  value :=
+    thePred => ['IF, thePred, def, 'noBranch]
+    def
+  stop value 
+  value
+
+boolBin x ==
+  x is [op,:argl] =>
+    MEMQ(op,'(AND OR)) and argl is [a, b, :c] and c => boolBin [op, boolBin [op, a, b], :c]
+    [boolBin y for y in x]
+  x
+
+ifize [[pred,:value],:r] ==
+  null r => value
+  ['IF, pred, value, ifize r]
+  
+moveTruePred2End alist ==
+  truthPair := or/[pair for pair in alist | pair is ["T",:.]] =>
+    [:delete(truthPair, alist), truthPair]      
+  [:a, [lastPair, lastValue]] := alist
+  [:a, ["T", lastValue]]
+
+PE e ==
+  for x in CAAR e for i in 1.. repeat
+    ppf [i, :x]
+
+ppf x ==
+  _*PRETTYPRINT_* : local := true
+  PRINT_-FULL x
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/match.boot.pamphlet b/src/interp/match.boot.pamphlet
new file mode 100644
index 00000000..132b99f9
--- /dev/null
+++ b/src/interp/match.boot.pamphlet
@@ -0,0 +1,242 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp match.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+SETANDFILEQ($wildCard,char "*")
+
+maskMatch?(mask,subject) ==
+  null mask => true
+  if null STRINGP subject then subject := PNAME subject
+  or/[match?(pattern,subject) for pattern in mask]
+
+substring?(part, whole, startpos) ==
+--This function should be replaced by STRING<
+  np := SIZE part
+  nw := SIZE whole
+  np > nw - startpos => false
+  and/[CHAR_-EQUAL(ELT(part, ip), ELT(whole, iw))
+      for ip in 0..np-1 for iw in startpos.. ]
+
+anySubstring?(part,whole,startpos) ==
+  np := SIZE part
+  nw := SIZE whole
+  or/[((k := i) and and/[CHAR_-EQUAL(ELT(part, ip),ELT(whole, iw))
+       for ip in 0..np - 1 for iw in i..]) for i in startpos..nw - np] => k
+
+charPosition(c,t,startpos) ==
+  n := SIZE t
+  startpos < 0 or startpos > n => n
+  k:= startpos
+  for i in startpos .. n-1 repeat
+    c = ELT(t,i) => return nil
+    k := k+1
+  k
+
+rightCharPosition(c,t,startpos) == --startpos often equals MAXINDEX t (rightmost)
+  k := startpos
+  for i in startpos..0 by -1 while c ^= ELT(t,i) repeat (k := k - 1)
+  k
+
+stringPosition(s,t,startpos) ==
+  n := SIZE t
+  if startpos < 0 or startpos > n then error "index out of range"
+  if SIZE s = 0 then return startpos -- bug in STRPOS
+  r := STRPOS(s,t,startpos,NIL)
+  if EQ(r,NIL) then n else r
+
+superMatch?(opattern,subject) ==  --subject assumed to be DOWNCASEd
+  $wildCard : local := char '_*
+  pattern := patternCheck opattern
+  logicalMatch?(pattern,subject)
+
+logicalMatch?(pattern,subject) ==  --subject assumed to be DOWNCASEd
+  pattern is [op,:argl] =>
+    op = "and" => and/[superMatch?(p,subject) for p in argl]
+    op = "or"  =>  or/[superMatch?(p,subject) for p in argl]
+    op = "not" =>  not superMatch?(first argl,subject)
+    systemError '"unknown pattern form"
+  basicMatch?(pattern,subject)
+
+patternCheck pattern == main where
+ --checks for escape characters, maybe new $wildCard
+  main ==
+--  pattern := pmTransFilter pattern   --should no longer need this (rdj:10/1/91)
+    u := pos(char '__,pattern)
+    null u => pattern
+    not(and/[equal(pattern,i + 1,$wildCard) for i in u]) =>
+      sayBrightly ['"Invalid use of underscores in pattern: ",pattern]
+      '"!!!!!!!!!!!!!!"
+    c := wild(pattern,'(_$ _# _% _& _@))
+--  sayBrightlyNT ['"Choosing new wild card"]
+--  pp c
+    $oldWild  :local := $wildCard
+    $wildCard := c
+    pattern := mknew(pattern,first u,rest u,SUBSTRING(pattern,0,first u))
+--  sayBrightlyNT ['"Replacing pattern by"]
+--  pp pattern
+    pattern
+  mknew(old,i,r,new) ==
+    new := STRCONC(new,old.(i + 1))  --add underscored character to string
+    null r => STRCONC(new,subWild(SUBSTRING(old,i + 2,nil),0))
+    mknew(old,first r,rest r,
+          STRCONC(new,subWild(SUBSTRING(old,i + 2,(first r) - i - 1),i + 1)))
+  subWild(s,i) ==
+    (k := charPosition($oldWild,s,i)) < #s =>
+      STRCONC(SUBSTRING(s,i,k - i),$wildCard,subWild(s,k + 1))
+    SUBSTRING(s,i,nil)
+  pos(c,s) ==
+    i := 0
+    n := MAXINDEX s
+    acc := nil
+    repeat
+      k := charPosition(c,s,i)
+      k > n => return NREVERSE acc
+      acc := [k,:acc]
+      i := k + 1
+  equal(p,n,c) ==
+    n > MAXINDEX p => false
+    p.n = c
+  wild(p,u) ==
+    for id in u repeat
+      c := char id
+      not(or/[p.i = c for i in 0..MAXINDEX(p)]) => return c
+
+match?(pattern,subject) ==  --returns index of first character that matches
+  basicMatch?(pattern,DOWNCASE subject)
+
+stringMatch(pattern,subject,wildcard) ==
+  not CHARP wildcard =>
+    systemError '"Wildcard must be a character"
+  $wildCard : local := wildcard
+  subject := DOWNCASE subject
+  k := basicMatch?(pattern,DOWNCASE subject) => k + 1
+  0
+
+basicMatch?(pattern,target) ==
+  n := #pattern
+  p := charPosition($wildCard,pattern,0)
+  p = n => (pattern = target) and 0
+  if p ^= 0 then
+     -- pattern does not begin with a wild card
+     ans := 0
+     s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1]
+     not substring?(s,target,0) => return false
+  else if n = 1 then return 0
+  i := p   -- starting position for searching the target
+  q := charPosition($wildCard,pattern,p+1)
+  ltarget := #target
+  while q ^= n repeat
+     s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+     i := stringPosition(s,target,i)
+     if null ans then ans := stringPosition(s,target,p)
+     -- for patterns beginning with wildcard, ans gives position of first match
+     if i = ltarget then return (returnFlag := true)
+     i := i + #s
+     p := q
+     q := charPosition($wildCard,pattern,q+1)
+  returnFlag => false
+  if p ^= q-1 then
+     -- pattern does not end with a wildcard
+     s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+     if not suffix?(s,target) then return false
+     if null ans then ans := 1  --pattern is a word preceded by a *
+  ans
+
+matchSegment?(pattern,subject,k) ==
+  matchAnySegment?(pattern,DOWNCASE subject,k,nil)
+
+matchAnySegment?(pattern,target,k,nc) ==  --k = start position; nc=#chars or NIL
+  n := #pattern
+  p := charPosition($wildCard,pattern,0)
+  p = n =>
+    m := stringPosition(pattern,target,k)
+    m = #target => nil
+    null nc => true
+    m <= k + nc - n
+  if k ^= 0 and nc then
+    target := SUBSTRING(target,k,nc)
+    k := 0
+  if p ^= 0 then
+     -- pattern does not begin with a wild card
+     ans := 0
+     s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1]
+     not substring?(s,target,k) => return false
+  else if n = 1 then return true
+  i := p + k  -- starting position for searching the target
+  q := charPosition($wildCard,pattern,p+1)
+  ltarget := #target
+  while q ^= n repeat
+     s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+     i := stringPosition(s,target,i)
+     if i = ltarget then return (returnFlag := true)
+     i := i + #s
+     p := q
+     q := charPosition($wildCard,pattern,q+1)
+  returnFlag => false
+  if p ^= q-1 then
+     -- pattern does not end with a '&
+     s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+     if not suffix?(s,target) then return false
+     if null ans then ans := 1  --pattern is a word preceded by a *
+  true
+
+infix?(s,t,x) == #s + #t >= #x and prefix?(s,x) and suffix?(t,x)
+
+prefix?(s,t) == substring?(s,t,0)
+
+suffix?(s,t) ==
+  m := #s; n := #t
+  if m > n then return false
+  substring?(s,t,(n-m))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/metalex.lisp.pamphlet b/src/interp/metalex.lisp.pamphlet
new file mode 100644
index 00000000..1af8f038
--- /dev/null
+++ b/src/interp/metalex.lisp.pamphlet
@@ -0,0 +1,332 @@
+%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp metalex.lisp}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; NAME:         MetaLex.lisp
+; PURPOSE:      Parsing support routines for Meta code
+; CONTENTS:
+;
+;               1. META File Handling
+;               2. META Line Handling
+;               3. META Token Handling
+;               4. META Token Parsing Actions
+;               5. META Error Handling
+ 
+(in-package "BOOT")
+ 
+; *** 1. META file handling
+ 
+(defun in-meta ()
+  (setq XTokenReader 'get-META-token)
+  (setq Line-Handler 'next-META-line)
+  (setq Meta_Error_Handler 'meta-meta-error-handler)
+  (setq $BOOT nil))
+ 
+(defun newrule ()
+  (in-meta)
+  (setq meta_prefix "PARSE-")
+  (test Rule1)
+  (eval (pop-stack-1))
+  (ioclear)
+  (in-boot))
+ 
+(defun meta (&optional (*meta-input-file* "/spad/meta.meta")
+                       (*meta-output-file* nil))
+  (ioclear)
+  (in-meta)
+  (with-open-stream
+    (in-stream (open *meta-input-file* :direction :input))
+    (with-open-stream
+      (out-stream (if *meta-output-file*
+               (open *meta-output-file* :direction :output)
+               *terminal-io*))
+      (format out-stream
+	      "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+      (parse-program)
+      (IOClear in-stream out-stream)))
+  T)
+ 
+; *** 2. META Line Handling
+ 
+(defun next-META-line (&optional (in-stream t))
+ 
+"Get next line, trimming trailing blanks and trailing comments.
+One trailing blank is added to a non-blank line to ease between-line
+processing for Next Token (i.e., blank takes place of return).  Returns T
+if it gets a non-blank line, and NIL at end of stream."
+ 
+  (prog (string)
+empty (if File-Closed (return nil))
+      (setq string (kill-trailing-blanks (kill-comments
+					  (get-a-line in-stream))))
+      (if (= (length string) 0) (go empty))
+      (Line-New-Line (suffix #\Space string) Current-Line)
+      (if Echo-Meta (Print-New-Line (Line-Buffer Current-Line) out-stream))
+      (return t)))
+ 
+(defparameter Comment-Character #\% "Delimiter of comments in Meta code.")
+ 
+(defun kill-comments (string)
+  "Deletes from comment character % to end of STRING."
+  (subseq string 0
+          (let ((mi (maxindex string)))
+            (do ((i 0 (1+ i)))
+                ((> i mi) i)
+              (if (and (char= (elt string i) Comment-Character)
+                       (or (eq i 0) (char/= (elt string (1- i)) #\\)))
+                  (return i))))))
+ 
+(defun kill-trailing-blanks (string)
+ 
+  "Remove white space from end of STRING."
+ 
+  ; Coding note: yes, I know, use string-trim --  but it is broken
+  ; in Symbolics Common Lisp for short strings
+ 
+  (let* ((sl (length string))
+         (right (if (= sl 0) -1
+                    (or
+                      (position-if-not
+                        #'(lambda (x)
+                            (member x '(#\Space #\Tab #\Newline) :test #'char=))
+                        string :from-end t)
+                      -1))))
+    (if (>= right 0) (subseq string 0 (1+ right)) (make-string 0))))
+ 
+; *** 3. META Token Handling
+ 
+; STRING: "'"  { Chars - "'" }* "'"
+; BSTRING: "[" ... "]*"
+; ID: letters, _ and then numbers
+; NUMBER: digits, ., digits, e, +-, digits
+ 
+(defun-parse-token STRING)
+(defun-parse-token BSTRING)
+(defun-parse-token IDENTIFIER)
+(defun-parse-token NUMBER)
+ 
+; Meta tokens fall into the following categories:
+;
+;               Number
+;               Identifier
+;               Dollar-sign
+;               Special character
+;
+; Special characters are represented as characters, numbers as numbers, and
+; identifiers as strings.  The reason identifiers are represented as strings is
+; that the full print-name of the intern of a string depends on the package you
+; are currently executing in; this can lead to very confusing results!
+ 
+(defun get-META-token (token)
+  (prog nil
+   loop (if (not (skip-blanks)) (return nil))
+        (case (token-lookahead-type (current-char))
+          (id           (return (get-identifier-token token)))
+          (num          (return (get-number-token token)))
+          (string       (return (get-string-token token)))
+          (bstring      (return (get-bstring-token token)))
+;         (dollar       (return (get-identifier-token token)))
+          (special-char (return (get-special-token token)))
+          (eof          (return nil)))))
+ 
+(defun skip-blanks ()
+  (loop (let ((cc (current-char)))
+          (if (not cc) (return nil))
+          (if (eq (token-lookahead-type cc) 'white)
+              (if (not (advance-char)) (return nil))
+              (return t)))))
+ 
+(defparameter Escape-Character #\\ "Superquoting character.")
+ 
+(defun token-lookahead-type (char)
+  "Predicts the kind of token to follow, based on the given initial character."
+  (cond ((not char)                                             'eof)
+        ((or (char= char Escape-Character) (alpha-char-p char)) 'id)
+        ((digitp char)                                          'num)
+        ((char= char #\')                                       'string)
+        ((char= char #\[)                                       'bstring)
+;       ((char= char #\$) (advance-char)                        'dollar)
+        ((member char '(#\Space #\Tab #\Return) :test #'char=)  'white)
+        (t                                                      'special-char)))
+ 
+(defun make-adjustable-string (n)
+  (make-array (list n) :element-type 'character :adjustable t))
+
+(defun get-identifier-token (token)
+  "Take an identifier off the input stream."
+  (prog ((buf (make-adjustable-string 0)))
+   id (let ((cur-char (current-char)))
+         (cond ((equal cur-char Escape-Character)
+                (if (not (advance-char)) (go bye))
+                (suffix (current-char) buf)
+                (if (not (advance-char)) (go bye))
+                (go id))
+               ((or (alpha-char-p cur-char)
+                    (char= cur-char #\-)
+                    (digitp cur-char)
+                    (char= cur-char #\_))
+                (suffix (current-char) buf)
+                (if (not (advance-char)) (go bye))
+                (go id))))
+  bye (return (token-install (intern buf) 'identifier token))))
+ 
+(defun get-string-token (token)
+  "With 'ABC' on IN-STREAM, extracts and stacks String 'ABC'."
+  (let ((buf (make-adjustable-string 0)))
+    (if (char= (current-char) #\')
+        (progn (advance-char)
+               (loop (case (current-char)
+                       (#\' (advance-char)
+                        (return (token-install buf 'string token)))
+                       (#\\ (advance-char)
+                        (suffix (current-char) buf)
+                        (advance-char))
+                       (#\Return
+                        (moan "String should fit on one line!")
+                        (advance-char)
+                        (meta-syntax-error)
+                        (return nil))
+                       (t (suffix (current-char) buf)
+                          (advance-char))))))))
+ 
+(defun get-bstring-token (token)
+  "With ABC]* on in-stream, extracts and stacks string ABC."
+  (let ((buf (make-adjustable-string 0)))
+    (if (char= (current-char) #\[)
+        (progn (advance-char)
+               (loop (case (current-char)
+                       (#\] (if (char= (next-char) #\*)
+                                (progn (advance-char)
+                                       (advance-char)
+                                       (return (token-install buf 'bstring token)))
+                                (progn (suffix (current-char) buf)
+                                       (advance-char))))
+                       (#\\ (advance-char)
+                        (suffix (current-char) buf)
+                        (advance-char))
+                       (#\Return
+                        (moan "String should fit on one line!")
+                        (advance-char)
+                        (meta-syntax-error)
+                        (return nil))
+                       (t (suffix (current-char) buf)
+                          (advance-char))))))))
+ 
+(defun get-special-token (token)
+  "Take a special character off the input stream.  We let the type name of each
+special character be the atom whose print name is the character itself."
+  (let ((symbol (current-char)))
+    (advance-char)
+    (token-install symbol 'special-char token)))
+ 
+(defun get-number-token (token)
+  "Take a number off the input stream."
+  (prog ((buf (make-adjustable-string 0)))
+    nu1 (suffix (current-char) buf)                     ; Integer part
+        (let ((next-chr (next-char)))
+          (cond ((digitp next-chr)
+                 (advance-char)
+                 (go nu1))))
+        (advance-char) 
+ formint(return (token-install
+		 (read-from-string buf)
+                  'number token
+		  (size buf) ;used to keep track of digit count
+		  ))))
+ 
+; *** 4. META Auxiliary Parsing Actions
+ 
+(defun make-defun (nametok vars body)
+  (let ((name (INTERN (STRCONC |META_PREFIX| nametok))))
+    (if vars
+        `(DEFUN ,name ,vars (declare (special . ,vars)) ,body)
+        `(DEFUN ,name ,vars ,body))))
+ 
+(defun print-fluids (fluids)
+  (terpri out-stream)
+  (mapcar #'(lambda (x) (format out-stream "~&(DEFPARAMETER ~S NIL)~%" x)) fluids)
+  (terpri out-stream))
+ 
+(defun print-package (package)
+  (format out-stream "~&~%(IN-PACKAGE ~S )~%~%" package))
+ 
+(defparameter Meta_Prefix nil)
+ 
+(defun set-prefix (prefix)  (setq META_PREFIX prefix))
+ 
+(defun print-rule (x)  (print x out-stream) (format out-stream "~%~%"))
+ 
+; *** 5. META Error Handling
+ 
+(defun meta-meta-error-handler (&optional (wanted nil) (parsing nil))
+  "Print syntax error indication, underline character, scrub line."
+  (format out-stream "~&% MetaLanguage syntax error: ")
+  (if (Line-Past-End-P Current-Line)
+      (cond ((and wanted parsing)
+             (format out-stream "wanted ~A while parsing ~A.~%"
+                     wanted parsing))
+            (wanted (format out-stream "wanted ~A.~%" wanted))
+            (parsing (format out-stream "while parsing ~A.~%" parsing)))
+      (progn (format out-stream "~:[here~;wanted ~A here~]" wanted wanted)
+             (format out-stream "~:[~; while parsing ~A~]:~%" parsing parsing)
+             (current-line-print)
+             (current-line-clear)
+             (current-token)
+             (incf $num_of_meta_errors)
+             (setq Meta_Errors_Occurred t)))
+   nil)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/metameta.lisp.pamphlet b/src/interp/metameta.lisp.pamphlet
new file mode 100644
index 00000000..47070f8d
--- /dev/null
+++ b/src/interp/metameta.lisp.pamphlet
@@ -0,0 +1,384 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp metameta.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; .META(META PROGRAM)
+; .PREFIX 'PARSE-'
+; .PACKAGE 'PARSING'
+; .DECLARE(METAPGVAR METAVARLST METAKEYLST METARULNAM TRAPFLAG)
+ 
+(IN-PACKAGE "BOOT")
+ 
+(DEFPARAMETER METAPGVAR NIL)
+(DEFPARAMETER METAVARLST NIL)
+(DEFPARAMETER METAKEYLST NIL)
+(DEFPARAMETER METARULNAM NIL)
+(DEFPARAMETER TRAPFLAG NIL)
+ 
+; PROGRAM:<HEADER*>! <RULE*>! ='.FIN' ;
+ 
+(DEFUN PARSE-PROGRAM NIL
+  (AND (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-HEADER))))
+       (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-RULE))))
+       (MATCH-STRING ".FIN")))
+ 
+; HEADER:       '.META' '(' IDENTIFIER IDENTIFIER <IDENTIFIER>! ')' .(SETQ XNAME ##3)
+; / '.DECLARE' '(' IDENTIFIER* ')' .(PRINT-FLUIDS #1)
+; / '.PREFIX' STRING .(SET-PREFIX #1)
+; / '.PACKAGE' STRING .(PRINT-PACKAGE #1) ;
+ 
+(DEFUN PARSE-HEADER NIL
+  (OR (AND (MATCH-ADVANCE-STRING ".META")
+           (MUST (MATCH-ADVANCE-STRING "("))
+           (MUST (PARSE-IDENTIFIER))
+           (MUST (PARSE-IDENTIFIER))
+           (BANG |FIL_TEST| (OPTIONAL (PARSE-IDENTIFIER)))
+           (MUST (MATCH-ADVANCE-STRING ")"))
+           (ACTION (SETQ XNAME (NTH-STACK 3))))
+      (AND (MATCH-ADVANCE-STRING ".DECLARE")
+           (MUST (MATCH-ADVANCE-STRING "("))
+           (MUST (STAR REPEATOR (PARSE-IDENTIFIER)))
+           (MUST (MATCH-ADVANCE-STRING ")"))
+           (ACTION (PRINT-FLUIDS (POP-STACK-1))))
+      (AND (MATCH-ADVANCE-STRING ".PREFIX")
+           (MUST (PARSE-STRING))
+           (ACTION (SET-PREFIX (POP-STACK-1))))
+      (AND (MATCH-ADVANCE-STRING ".PACKAGE")
+           (MUST (PARSE-STRING))
+           (ACTION (PRINT-PACKAGE (POP-STACK-1))))))
+ 
+; RULE:     RULE1 ';' .(PRINT-RULE #1) / ^='.FIN' .(META-SYNTAX-ERROR) ;
+ 
+(DEFUN PARSE-RULE NIL
+  (OR (AND (PARSE-RULE1)
+           (MUST (MATCH-ADVANCE-STRING ";"))
+           (ACTION (PRINT-RULE (POP-STACK-1))))
+      (AND (NOT (MATCH-STRING ".FIN"))
+           (ACTION (META-SYNTAX-ERROR)))))
+ 
+; RULE1: IDENTIFIER .(SETQ METARULNAM (INTERN (STRCONC META_PREFIX ##1)))
+; <'{' FID* '}'>! ':' EXPR =';'
+; < =$METAPGVAR +(PROG =(TRANSPGVAR METAPGVAR) (RETURN #1))
+; .(SETQ METAPGVAR NIL) >
+; +=(MAKE-DEFUN #3 #2 #1) ;
+ 
+(DEFUN PARSE-RULE1 NIL
+  (AND (PARSE-IDENTIFIER)
+       (ACTION (SETQ METARULNAM (INTERN (STRCONC |META_PREFIX| (NTH-STACK 1)))))
+       (BANG |FIL_TEST|
+             (OPTIONAL (AND (MATCH-ADVANCE-STRING "{")
+                            (MUST (STAR REPEATOR (PARSE-FID)))
+                            (MUST (MATCH-ADVANCE-STRING "}")))))
+       (MUST (MATCH-ADVANCE-STRING ":"))
+       (MUST (PARSE-EXPR))
+       (MUST (MATCH-STRING ";"))
+       (OPTIONAL (AND METAPGVAR
+                      (PUSH-REDUCTION 'PARSE-RULE1
+                                      (CONS 'PROG
+                                            (CONS (TRANSPGVAR METAPGVAR)
+                                                  (CONS (CONS
+                                                         'RETURN
+                                                         (CONS (POP-STACK-1) NIL))
+                                                        NIL))))
+                      (ACTION (SETQ METAPGVAR NIL))))
+       (PUSH-REDUCTION 'PARSE-RULE1
+                       (MAKE-DEFUN (POP-STACK-3) (POP-STACK-2) (POP-STACK-1)))))
+ 
+; FID:  IDENTIFIER +#1 ;
+ 
+(DEFUN PARSE-FID NIL
+  (AND (PARSE-IDENTIFIER)
+       (PUSH-REDUCTION 'PARSE-FID (POP-STACK-1))))
+ 
+; EXPR:   SUBEXPR
+; <   EXPR1* +(OR #2 -#1)
+; / EXPR2* +(OR #2 -#1) >  ;
+ 
+(DEFUN PARSE-EXPR NIL
+  (AND (PARSE-SUBEXPR)
+       (OPTIONAL (OR (AND (STAR REPEATOR (PARSE-EXPR1))
+                          (PUSH-REDUCTION 'PARSE-EXPR
+                                          (CONS 'OR
+                                                (CONS (POP-STACK-2)
+                                                      (APPEND (POP-STACK-1) NIL)))))
+                     (AND (STAR REPEATOR (PARSE-EXPR2))
+                          (PUSH-REDUCTION 'PARSE-EXPR
+                                          (CONS 'OR
+                                                (CONS (POP-STACK-2)
+                                                      (APPEND (POP-STACK-1) NIL)))))))))
+ 
+; EXPR1:  '/' <^'/'>  SUBEXPR   ;
+ 
+(DEFUN PARSE-EXPR1 NIL
+  (AND (MATCH-ADVANCE-STRING "/")
+       (OPTIONAL (NOT (MATCH-ADVANCE-STRING "/")))
+       (MUST (PARSE-SUBEXPR))))
+ 
+; EXPR2:  '\\' <^'\\'>  SUBEXPR  ;
+ 
+(DEFUN PARSE-EXPR2 NIL
+  (AND (MATCH-ADVANCE-STRING "\\")
+       (OPTIONAL (NOT (MATCH-ADVANCE-STRING "\\")))
+       (MUST (PARSE-SUBEXPR))))
+ 
+; SUBEXPR:FIL_TEST <^?$TRAPFLAG FIL_TEST>*!
+; <FIL_TEST <?$TRAPFLAG +(MUST #1)> >*!
+; +(#3 -#2 -#1) +=(MAKE-PARSE-FUNCTION #1 "AND) ;
+ 
+(DEFUN PARSE-SUBEXPR NIL
+  (AND (PARSE-FIL_TEST)
+       (BANG |FIL_TEST|
+             (OPTIONAL (STAR |OPT_EXPR|
+                             (AND (NOT TRAPFLAG)
+                                  (PARSE-FIL_TEST)))))
+       (BANG |FIL_TEST|
+             (OPTIONAL (STAR |OPT_EXPR|
+                             (AND (PARSE-FIL_TEST)
+                                  (OPTIONAL (AND TRAPFLAG
+                                                 (PUSH-REDUCTION 'PARSE-SUBEXPR
+                                                                 (CONS
+                                                                  'MUST
+                                                                  (CONS (POP-STACK-1) NIL))))))
+                             )))
+       (PUSH-REDUCTION 'PARSE-SUBEXPR
+                       (CONS (POP-STACK-3)
+                             (APPEND (POP-STACK-2) (APPEND (POP-STACK-1) NIL))))
+       (PUSH-REDUCTION 'PARSE-SUBEXPR (MAKE-PARSE-FUNCTION (POP-STACK-1) 'AND))))
+ 
+; FIL_TEST: REP_TEST <'!' +(BANG FIL_TEST #1)>      ;
+ 
+(DEFUN PARSE-FIL_TEST NIL
+  (AND (PARSE-REP_TEST)
+       (OPTIONAL (AND (MATCH-ADVANCE-STRING "!")
+                      (PUSH-REDUCTION 'PARSE-FIL_TEST
+                                      (CONS 'BANG
+                                            (CONS '|FIL_TEST| (CONS (POP-STACK-1) NIL))))))))
+ 
+; REP_TEST: N_TEST <REPEATOR>  ;
+ 
+(DEFUN PARSE-REP_TEST NIL
+  (AND (PARSE-N_TEST)
+       (OPTIONAL (PARSE-REPEATOR))))
+ 
+; N_TEST:   '^' TEST  +(NOT #1) / TEST  ;
+ 
+(DEFUN PARSE-N_TEST NIL
+  (OR (AND (MATCH-ADVANCE-STRING "^")
+           (MUST (PARSE-TEST))
+           (PUSH-REDUCTION 'PARSE-N_TEST (CONS 'NOT (CONS (POP-STACK-1) NIL))))
+      (PARSE-TEST)))
+ 
+; TEST:     IDENTIFIER (    '{' <SEXPR*>! '}'
+; +(=(INTERN (STRCONC META_PREFIX #2)) -#1)
+; / +(=(INTERN (STRCONC META_PREFIX #1))))        .(SETQ TRAPFLAG T)
+; / STRING  +(MATCH-ADVANCE-STRING #1)            .(SETQ TRAPFLAG T)
+; / '=' REF_SEXPR                                 .(SETQ TRAPFLAG T)
+; / '?' REF_SEXPR                                 .(SETQ TRAPFLAG NIL)
+; / '.' SEXPR         +(ACTION #1)                .(SETQ TRAPFLAG NIL)
+; / '+' CONS_SEXPR    +(PUSH-REDUCTION =(LIST "QUOTE METARULNAM) #1)
+; .(SETQ TRAPFLAG NIL)
+; / '(' EXPR ')'                                  .(SETQ TRAPFLAG T)
+; / '<' EXPR '>'      .(PARSE-OPT_EXPR)           .(SETQ TRAPFLAG NIL) ;
+ 
+(DEFUN PARSE-TEST NIL
+  (OR (AND (PARSE-IDENTIFIER)
+           (MUST (OR (AND (MATCH-ADVANCE-STRING "{")
+                          (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR))))
+                          (MUST (MATCH-ADVANCE-STRING "}"))
+                          (PUSH-REDUCTION 'PARSE-TEST
+                                          (CONS (INTERN (STRCONC
+                                                         |META_PREFIX|
+                                                         (POP-STACK-2)))
+                                                (APPEND (POP-STACK-1) NIL))))
+                     (PUSH-REDUCTION 'PARSE-TEST
+                                     (CONS (INTERN (STRCONC |META_PREFIX| (POP-STACK-1)))
+                                           NIL))))
+           (ACTION (SETQ TRAPFLAG T)))
+      (AND (PARSE-STRING)
+           (PUSH-REDUCTION 'PARSE-TEST
+                           (CONS 'MATCH-ADVANCE-STRING (CONS (POP-STACK-1) NIL)))
+           (ACTION (SETQ TRAPFLAG T)))
+      (AND (MATCH-ADVANCE-STRING "=")
+           (MUST (PARSE-REF_SEXPR))
+           (ACTION (SETQ TRAPFLAG T)))
+      (AND (MATCH-ADVANCE-STRING "?")
+           (MUST (PARSE-REF_SEXPR))
+           (ACTION (SETQ TRAPFLAG NIL)))
+      (AND (MATCH-ADVANCE-STRING ".")
+           (MUST (PARSE-SEXPR))
+           (PUSH-REDUCTION 'PARSE-TEST (CONS 'ACTION (CONS (POP-STACK-1) NIL)))
+           (ACTION (SETQ TRAPFLAG NIL)))
+      (AND (MATCH-ADVANCE-STRING "+")
+           (MUST (PARSE-CONS_SEXPR))
+           (PUSH-REDUCTION 'PARSE-TEST
+                           (CONS 'PUSH-REDUCTION
+                                 (CONS (LIST 'QUOTE METARULNAM) (CONS (POP-STACK-1) NIL))))
+           (ACTION (SETQ TRAPFLAG NIL)))
+      (AND (MATCH-ADVANCE-STRING "(")
+           (MUST (PARSE-EXPR))
+           (MUST (MATCH-ADVANCE-STRING ")"))
+           (ACTION (SETQ TRAPFLAG T)))
+      (AND (MATCH-ADVANCE-STRING "<")
+           (MUST (PARSE-EXPR))
+           (MUST (MATCH-ADVANCE-STRING ">"))
+           (ACTION (PARSE-OPT_EXPR))
+           (ACTION (SETQ TRAPFLAG NIL)))))
+ 
+; SEXPR:          IDENTIFIER / NUMBER / STRING / NON_DEST_REF / DEST_REF / LOCAL_VAR
+; / '"' SEXPR +(QUOTE #1) / '=' SEXPR / '(' <SEXPR*>! ')' ;
+ 
+(DEFUN PARSE-SEXPR NIL
+  (OR (PARSE-IDENTIFIER)
+      (PARSE-NUMBER)
+      (PARSE-STRING)
+      (PARSE-NON_DEST_REF)
+      (PARSE-DEST_REF)
+      (PARSE-LOCAL_VAR)
+      (AND (MATCH-ADVANCE-STRING "\"")
+           (MUST (PARSE-SEXPR))
+           (PUSH-REDUCTION 'PARSE-SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "=")
+           (MUST (PARSE-SEXPR)))
+      (AND (MATCH-ADVANCE-STRING "(")
+           (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR))))
+           (MUST (MATCH-ADVANCE-STRING ")")))))
+ 
+; REF_SEXPR: STRING +(MATCH-STRING #1) / SEXPR ;
+ 
+(DEFUN PARSE-REF_SEXPR NIL
+  (OR (AND (PARSE-STRING)
+           (PUSH-REDUCTION 'PARSE-REF_SEXPR (CONS 'MATCH-STRING (CONS (POP-STACK-1) NIL))))
+      (PARSE-SEXPR)))
+ 
+; CONS_SEXPR: IDENTIFIER <^=(MEMBER ##1 METAPGVAR) +(QUOTE #1)>
+; / LOCAL_VAR +(QUOTE #1)
+; / '(' <SEXPR_STRING>! ')'
+; / SEXPR ;
+ 
+(DEFUN PARSE-CONS_SEXPR NIL
+  (OR (AND (PARSE-IDENTIFIER)
+           (OPTIONAL (AND (NOT (MEMBER (NTH-STACK 1) METAPGVAR))
+                          (PUSH-REDUCTION 'PARSE-CONS_SEXPR
+                                          (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))))
+      (AND (PARSE-LOCAL_VAR)
+           (PUSH-REDUCTION 'PARSE-CONS_SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "(")
+           (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
+           (MUST (MATCH-ADVANCE-STRING ")")))
+      (PARSE-SEXPR)))
+ 
+; SEXPR_STRING: CONS_SEXPR <SEXPR_STRING>!    +(CONS #2 #1)
+; / '-' CONS_SEXPR <SEXPR_STRING>! +(APPEND #2 #1)      ;
+ 
+(DEFUN PARSE-SEXPR_STRING NIL
+  (OR (AND (PARSE-CONS_SEXPR)
+           (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
+           (PUSH-REDUCTION 'PARSE-SEXPR_STRING
+                           (CONS 'CONS (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+      (AND (MATCH-ADVANCE-STRING "-")
+           (MUST (PARSE-CONS_SEXPR))
+           (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
+           (PUSH-REDUCTION 'PARSE-SEXPR_STRING
+                           (CONS 'APPEND (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))
+ 
+; NON_DEST_REF: '##' NUMBER +(NTH-STACK #1) ;
+ 
+(DEFUN PARSE-NON_DEST_REF NIL
+  (AND (MATCH-ADVANCE-STRING "##")
+       (MUST (PARSE-NUMBER))
+       (PUSH-REDUCTION 'PARSE-NON_DEST_REF (CONS 'NTH-STACK (CONS (POP-STACK-1) NIL)))))
+ 
+; DEST_REF:     '#' NUMBER +=(LIST (INTERN (STRCONC 'POP-STACK-' (STRINGIMAGE #1)))) ;
+ 
+(DEFUN PARSE-DEST_REF NIL
+  (AND (MATCH-ADVANCE-STRING "#")
+       (MUST (PARSE-NUMBER))
+       (PUSH-REDUCTION 'PARSE-DEST_REF
+                       (LIST (INTERN (STRCONC "POP-STACK-" (STRINGIMAGE (POP-STACK-1))))))))
+ 
+; LOCAL_VAR:    '$' (   IDENTIFIER / NUMBER +=(GETGENSYM #1) .(PUSH ##1 METAPGVAR)) ;
+ 
+(DEFUN PARSE-LOCAL_VAR NIL
+  (AND (MATCH-ADVANCE-STRING "$")
+       (MUST (OR (PARSE-IDENTIFIER)
+                 (AND (PARSE-NUMBER)
+                      (PUSH-REDUCTION 'PARSE-LOCAL_VAR (GETGENSYM (POP-STACK-1)))
+                      (ACTION (PUSH (NTH-STACK 1) METAPGVAR)))))))
+ 
+; OPT_EXPR:     <'*' +(STAR OPT_EXPR #1) / REPEATOR> +(OPTIONAL #1) ;
+ 
+(DEFUN PARSE-OPT_EXPR NIL
+  (AND (OPTIONAL (OR (AND (MATCH-ADVANCE-STRING "*")
+                          (PUSH-REDUCTION 'PARSE-OPT_EXPR
+                                          (CONS 'STAR
+                                                (CONS '|OPT_EXPR|
+                                                      (CONS (POP-STACK-1) NIL)))))
+                     (PARSE-REPEATOR)))
+       (PUSH-REDUCTION 'PARSE-OPT_EXPR (CONS 'OPTIONAL (CONS (POP-STACK-1) NIL)))))
+ 
+; REPEATOR:     ('*' / BSTRING +(AND (MATCH-ADVANCE-STRING #1) (MUST ##1)))
+; +(STAR REPEATOR #1) ;
+ 
+(DEFUN PARSE-REPEATOR NIL
+  (AND (OR (MATCH-ADVANCE-STRING "*")
+           (AND (PARSE-BSTRING)
+                (PUSH-REDUCTION 'PARSE-REPEATOR
+                                (CONS 'AND
+                                      (CONS (CONS 'MATCH-ADVANCE-STRING
+                                                  (CONS (POP-STACK-1) NIL))
+                                            (CONS (CONS 'MUST (CONS (NTH-STACK 1) NIL))
+                                                  NIL))))))
+       (PUSH-REDUCTION 'PARSE-REPEATOR
+                       (CONS 'STAR (CONS 'REPEATOR (CONS (POP-STACK-1) NIL))))))
+ 
+; .FIN ;
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/modemap.boot.pamphlet b/src/interp/modemap.boot.pamphlet
new file mode 100644
index 00000000..e5af0fac
--- /dev/null
+++ b/src/interp/modemap.boot.pamphlet
@@ -0,0 +1,379 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp modemap.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% EXTERNAL ROUTINES
+ 
+--These functions are called from outside this file to add a domain
+--   or to get the current domains in scope;
+ 
+addDomain(domain,e) ==
+  atom domain =>
+    EQ(domain,"$EmptyMode") => e
+    EQ(domain,"$NoValueMode") => e
+    not IDENTP domain or 2<#(s:= STRINGIMAGE domain) and
+      EQ(char "#",s.(0)) and EQ(char "#",s.(1)) => e
+    MEMQ(domain,getDomainsInScope e) => e
+    isLiteral(domain,e) => e
+    addNewDomain(domain,e)
+  (name:= first domain)='Category => e
+  domainMember(domain,getDomainsInScope e) => e
+  getmode(name,e) is ["Mapping",target,:.] and isCategoryForm(target,e)=>
+      addNewDomain(domain,e)
+    -- constructor? test needed for domains compiled with $bootStrapMode=true
+  isFunctor name or constructor? name => addNewDomain(domain,e)
+  if not isCategoryForm(domain,e) and
+    not member(name,'(Mapping CATEGORY)) then
+      unknownTypeError name
+  e        --is not a functor
+ 
+domainMember(dom,domList) == or/[modeEqual(dom,d) for d in domList]
+ 
+--% MODEMAP FUNCTIONS
+ 
+--getTargetMode(x is [op,:argl],e) ==
+--  CASES(#(mml:= getModemapList(op,#argl,e)),
+--    (1 =>
+--    ([[.,target,:.],:.]:= first mml; substituteForFormalArguments(argl,target))
+--      ; 0 => MOAN(x," has no modemap"); systemError [x," has duplicate modemaps"]))
+ 
+getModemap(x is [op,:.],e) ==
+  for modemap in get(op,'modemap,e) repeat
+    if u:= compApplyModemap(x,modemap,e,nil) then return
+      ([.,.,sl]:= u; SUBLIS(sl,modemap))
+ 
+getUniqueSignature(form,e) ==
+  [[.,:sig],:.]:= getUniqueModemap(first form,#rest form,e) or return nil
+  sig
+ 
+getUniqueModemap(op,numOfArgs,e) ==
+  1=#(mml:= getModemapList(op,numOfArgs,e)) => first mml
+  1<#mml =>
+    stackWarning [numOfArgs,'" argument form of: ",op,
+      '" has more than one modemap"]
+    first mml
+  nil
+ 
+getModemapList(op,numOfArgs,e) ==
+  op is ['elt,D,op'] => getModemapListFromDomain(op',numOfArgs,D,e)
+  [mm for
+    (mm:= [[.,.,:sigl],:.]) in get(op,'modemap,e) | numOfArgs=#sigl]
+ 
+getModemapListFromDomain(op,numOfArgs,D,e) ==
+  [mm
+    for (mm:= [[dc,:sig],:.]) in get(op,'modemap,e) | dc=D and #rest sig=
+      numOfArgs]
+ 
+addModemapKnown(op,mc,sig,pred,fn,$e) ==
+--  if knownInfo pred then pred:=true
+--  that line is handled elsewhere
+  $insideCapsuleFunctionIfTrue=true =>
+    $CapsuleModemapFrame :=
+      addModemap0(op,mc,sig,pred,fn,$CapsuleModemapFrame)
+    $e
+  addModemap0(op,mc,sig,pred,fn,$e)
+ 
+addModemap0(op,mc,sig,pred,fn,e) ==
+  --mc is the "mode of computation"; fn the "implementation"
+  $functorForm is ['CategoryDefaults,:.] and mc="$" => e
+    --don't put CD modemaps into environment
+  --fn is ['Subsumed,:.] => e  -- don't skip subsumed modemaps
+                               -- breaks -:($,$)->U($,failed) in DP
+  op='elt or op='setelt => addEltModemap(op,mc,sig,pred,fn,e)
+  addModemap1(op,mc,sig,pred,fn,e)
+ 
+addEltModemap(op,mc,sig,pred,fn,e) ==
+   --hack to change selectors from strings to identifiers; and to
+   --add flag identifiers as literals in the envir
+  op='elt and sig is [:lt,sel] =>
+    STRINGP sel =>
+      id:= INTERN sel
+      if $insideCapsuleFunctionIfTrue=true
+         then $e:= makeLiteral(id,$e)
+         else e:= makeLiteral(id,e)
+      addModemap1(op,mc,[:lt,id],pred,fn,e)
+    -- atom sel => systemErrorHere '"addEltModemap"
+    addModemap1(op,mc,sig,pred,fn,e)
+  op='setelt and sig is [:lt,sel,v] =>
+    STRINGP sel =>
+      id:= INTERN sel
+      if $insideCapsuleFunctionIfTrue=true
+         then $e:= makeLiteral(id,$e)
+         else e:= makeLiteral(id,e)
+      addModemap1(op,mc,[:lt,id,v],pred,fn,e)
+    -- atom sel => systemError '"addEltModemap"
+    addModemap1(op,mc,sig,pred,fn,e)
+  systemErrorHere '"addEltModemap"
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+addModemap1(op,mc,sig,pred,fn,e) ==
+   --mc is the "mode of computation"; fn the "implementation"
+  if mc='Rep then
+     if fn is [kind,'Rep,.] and
+               -- save old sig for NRUNTIME
+       (kind = 'ELT or kind = 'CONST) then fn:=[kind,'Rep,sig]
+     sig:= substitute("$",'Rep,sig)
+  currentProplist:= getProplist(op,e) or nil
+  newModemapList:=
+    mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil)
+  newProplist:= augProplist(currentProplist,'modemap,newModemapList)
+  newProplist':= augProplist(newProplist,"FLUID",true)
+  unErrorRef op
+        --There may have been a warning about op having no value
+  addBinding(op,newProplist',e)
+ 
+mkNewModemapList(mc,sig,pred,fn,curModemapList,e,filenameOrNil) ==
+  entry:= [map:= [mc,:sig],[pred,fn],:filenameOrNil]
+  member(entry,curModemapList) => curModemapList
+  (oldMap:= ASSOC(map,curModemapList)) and oldMap is [.,[opred, =fn],:.] =>
+    $forceAdd => mergeModemap(entry,curModemapList,e)
+    opred=true => curModemapList
+    if pred^=true and pred^=opred then pred:= ["OR",pred,opred]
+    [if x=oldMap then [map,[pred,fn],:filenameOrNil] else x
+ 
+  --if new modemap less general, put at end; otherwise, at front
+      for x in curModemapList]
+  $InteractiveMode => insertModemap(entry,curModemapList)
+  mergeModemap(entry,curModemapList,e)
+ 
+mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) ==
+  for (mmtail:= [[[mc',:sig'],[pred',:.],:.],:.]) in tails modemapList repeat
+    mc=mc' or isSuperDomain(mc',mc,e) =>
+      newmm:= nil
+      mm:= modemapList
+      while (not EQ(mm,mmtail)) repeat (newmm:= [first mm,:newmm]; mm:= rest mm)
+      if (mc=mc') and (sig=sig') then
+        --We only need one of these, unless the conditions are hairy
+        not $forceAdd and TruthP pred' =>
+          entry:=nil
+              --the new predicate buys us nothing
+          return modemapList
+        TruthP pred => mmtail:=rest mmtail
+          --the thing we matched against is useless, by comparison
+      modemapList:= NCONC(NREVERSE newmm,[entry,:mmtail])
+      entry:= nil
+      return modemapList
+  if entry then [:modemapList,entry] else modemapList
+ 
+-- next definition RPLACs, and hence causes problems.
+-- In ptic., SubResGcd in SparseUnivariatePolynomial is miscompiled
+--mergeModemap(entry:=((mc,:sig),:.),modemapList,e) ==
+--    for (mmtail:= (((mc',:sig'),:.),:.)) in tails modemapList do
+--       mc=mc' or isSuperDomain(mc',mc,e)  =>
+--         RPLACD(mmtail,(first mmtail,: rest mmtail))
+--         RPLACA(mmtail,entry)
+--         entry := nil
+--         return modemapList
+--     if entry then (:modemapList,entry) else modemapList
+ 
+isSuperDomain(domainForm,domainForm',e) ==
+  isSubset(domainForm',domainForm,e) => true
+  domainForm='Rep and domainForm'="$" => true --regard $ as a subdomain of Rep
+  LASSOC(opOf domainForm',get(domainForm,"SubDomain",e))
+ 
+--substituteForRep(entry is [[mc,:sig],:.],curModemapList) ==
+--  --change 'Rep to "$" unless the resulting signature is already in $
+--  member(entry':= substitute("$",'Rep,entry),curModemapList) =>
+--    [entry,:curModemapList]
+--  [entry,entry',:curModemapList]
+ 
+addNewDomain(domain,e) ==
+  augModemapsFromDomain(domain,domain,e)
+ 
+augModemapsFromDomain(name,functorForm,e) ==
+  member(KAR name or name,$DummyFunctorNames) => e
+  name=$Category or isCategoryForm(name,e) => e
+  member(name,curDomainsInScope:= getDomainsInScope e) => e
+  if u:= GETDATABASE(opOf functorForm,'SUPERDOMAIN) then
+    e:= addNewDomain(first u,e)
+    --need code to handle parameterized SuperDomains
+  if innerDom:= listOrVectorElementMode name then e:= addDomain(innerDom,e)
+  if name is ["Union",:dl] then for d in stripUnionTags dl
+                         repeat e:= addDomain(d,e)
+  augModemapsFromDomain1(name,functorForm,e)
+     --see LISPLIB BOOT
+ 
+substituteCategoryArguments(argl,catform) ==
+  argl:= substitute("$$","$",argl)
+  arglAssoc:= [[INTERNL("#",STRINGIMAGE i),:a] for i in 1.. for a in argl]
+  SUBLIS(arglAssoc,catform)
+ 
+         --Called, by compDefineFunctor, to add modemaps for $ that may
+         --be equivalent to those of Rep. We must check that these
+         --operations are not being redefined.
+augModemapsFromCategoryRep(domainName,repDefn,functorBody,categoryForm,e) ==
+  [fnAlist,e]:= evalAndSub(domainName,domainName,domainName,categoryForm,e)
+  [repFnAlist,e]:= evalAndSub('Rep,'Rep,repDefn,getmode(repDefn,e),e)
+  catform:= (isCategory categoryForm => categoryForm.(0); categoryForm)
+  compilerMessage ["Adding ",domainName," modemaps"]
+  e:= putDomainsInScope(domainName,e)
+  $base:= 4
+  for [lhs:=[op,sig,:.],cond,fnsel] in fnAlist repeat
+    u:=ASSOC(SUBST('Rep,domainName,lhs),repFnAlist)
+    u and not AMFCR_,redefinedList(op,functorBody) =>
+      fnsel':=CADDR u
+      e:= addModemap(op,domainName,sig,cond,fnsel',e)
+    e:= addModemap(op,domainName,sig,cond,fnsel,e)
+  e
+ 
+AMFCR_,redefinedList(op,l) == "OR"/[AMFCR_,redefined(op,u) for u in l]
+ 
+AMFCR_,redefined(opname,u) ==
+  not(u is [op,:l]) => nil
+  op = 'DEF => opname = CAAR l
+  MEMQ(op,'(PROGN SEQ)) => AMFCR_,redefinedList(opname,l)
+  op = 'COND => "OR"/[AMFCR_,redefinedList(opname,CDR u) for u in l]
+ 
+augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) ==
+  [fnAlist,e]:= evalAndSub(domainName,domainView,functorForm,categoryForm,e)
+  --  catform:= (isCategory categoryForm => categoryForm.(0); categoryForm)
+  -- catform appears not to be used, so why set it?
+  --if ^$InteractiveMode then
+  compilerMessage ["Adding ",domainName," modemaps"]
+  e:= putDomainsInScope(domainName,e)
+  $base:= 4
+  condlist:=[]
+  for [[op,sig,:.],cond,fnsel] in fnAlist repeat
+--  e:= addModemap(op,domainName,sig,cond,fnsel,e)
+---------next 5 lines commented out to avoid wasting time checking knownInfo on
+---------conditions attached to each modemap being added, takes a very long time
+---------instead conditions will be checked when maps are actually used
+  --v:=ASSOC(cond,condlist) =>
+  --  e:= addModemapKnown(op,domainName,sig,CDR v,fnsel,e)
+  --$e:local := e  -- $e is used by knownInfo
+  --if knownInfo cond then cond1:=true else cond1:=cond
+  --condlist:=[[cond,:cond1],:condlist]
+    e:= addModemapKnown(op,domainName,sig,cond,fnsel,e) -- cond was cond1
+--  for u in sig | (not member(u,$DomainsInScope)) and
+--                   (not atom u) and
+--                     (not isCategoryForm(u,e)) do
+--     e:= addNewDomain(u,e)
+  e
+ 
+--subCatParametersInto(domainForm,catForm,e) ==
+--  -- JHD 08/08/84 perhaps we are fortunate that it is not used
+--  --this is particularly dirty and should be cleaned up, say, by wrapping
+--  -- an appropriate lambda expression around mapping forms
+--  domainForm is [op,:l] and l =>
+--    get(op,'modemap,e) is [[[mc,:.],:.]] => SUBLIS(PAIR(rest mc,l),catForm)
+--  catForm
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+evalAndSub(domainName,viewName,functorForm,form,$e) ==
+  $lhsOfColon: local:= domainName
+  isCategory form => [substNames(domainName,viewName,functorForm,form.(1)),$e]
+  --next lines necessary-- see MPOLY for which $ is actual arg. --- RDJ 3/83
+  if CONTAINED("$$",form) then $e:= put("$$","mode",get("$","mode",$e),$e)
+  opAlist:= getOperationAlist(domainName,functorForm,form)
+  substAlist:= substNames(domainName,viewName,functorForm,opAlist)
+  [substitute("$","$$",substAlist),$e]
+ 
+getOperationAlist(name,functorForm,form) ==
+  if atom name and GETDATABASE(name,'NILADIC) then functorForm:= [functorForm]
+-- (null isConstructorForm functorForm) and (u:= isFunctor functorForm)
+  (u:= isFunctor functorForm) and not
+    ($insideFunctorIfTrue and first functorForm=first $functorForm) => u
+  $insideFunctorIfTrue and name="$" =>
+    ($domainShell => $domainShell.(1); systemError '"$ has no shell now")
+  T:= compMakeCategoryObject(form,$e) => ([.,.,$e]:= T; T.expr.(1))
+  stackMessage ["not a category form: ",form]
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+substNames(domainName,viewName,functorForm,catForm) ==
+  EQSUBSTLIST(KDR functorForm,$FormalMapVariableList,
+ -- [[[op,if KAR fnsel="PAC" then sig else SUBSTQ(domainName,"$",sig),:x],pred,
+ --   SUBSTQ(viewName,"$",fnsel)] for [[op,sig,:x],pred,fnsel] in catForm])
+       -- following calls to SUBSTQ must copy to save RPLAC's in
+       -- putInLocalDomainReferences
+    [[:SUBSTQ(domainName,"$",modemapform),SUBSTQ(viewName,"$",fnsel)]
+      for [:modemapform,fnsel] in catForm])
+ 
+compCat(form is [functorName,:argl],m,e) ==
+  fn:= GETL(functorName,"makeFunctionList") or return nil
+  [funList,e]:= FUNCALL(fn,form,form,e)
+  catForm:=
+    ["Join",'(SetCategory),["CATEGORY","domain",:
+      [["SIGNATURE",op,sig] for [op,sig,.] in funList | op^="="]]]
+  --RDJ: for coercion purposes, it necessary to know it's a Set; I'm not
+  --sure if it uses any of the other signatures(see extendsCategoryForm)
+  [form,catForm,e]
+ 
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+addConstructorModemaps(name,form is [functorName,:.],e) ==
+  $InteractiveMode: local:= nil
+  e:= putDomainsInScope(name,e) --frame
+  fn := GETL(functorName,"makeFunctionList")
+  [funList,e]:= FUNCALL(fn,name,form,e)
+  for [op,sig,opcode] in funList repeat
+    e:= addModemap(op,name,sig,true,opcode,e)
+  e
+ 
+ 
+--The way XLAMs work:
+--  ((XLAM ($1 $2 $3) (SETELT $1 0 $3)) X "c" V) ==> (SETELT X 0 V)
+ 
+getDomainsInScope e ==
+  $insideCapsuleFunctionIfTrue=true => $CapsuleDomainsInScope
+  get("$DomainsInScope","special",e)
+ 
+putDomainsInScope(x,e) ==
+  l:= getDomainsInScope e
+  if member(x,l) then SAY("****** Domain: ",x," already in scope")
+  newValue:= [x,:delete(x,l)]
+  $insideCapsuleFunctionIfTrue => ($CapsuleDomainsInScope:= newValue; e)
+  put("$DomainsInScope","special",newValue,e)
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/monitor.lisp.pamphlet b/src/interp/monitor.lisp.pamphlet
new file mode 100644
index 00000000..d303d34d
--- /dev/null
+++ b/src/interp/monitor.lisp.pamphlet
@@ -0,0 +1,806 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp monitor.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+MONITOR                                                                
+                                                                       
+This file contains a set of function for monitoring the execution      
+of the functions in a file. It constructs a hash table that contains   
+the function name as the key and monitor-data structures as the value  
+                                                                       
+The technique is to use a :cond parameter on trace to call the         
+monitor-incr function to incr the count every time a function is called
+                                                                       
+*monitor-table*                                HASH TABLE              
+   is the monitor table containing the hash entries                    
+*monitor-nrlibs*                               LIST of STRING
+   list of NRLIB filenames that are monitored
+*monitor-domains*                              LIST of STRING
+   list of domains to monitor-report (default is all exposed domains)
+monitor-data                                   STRUCTURE               
+   is the defstruct name of records in the table                       
+   name is the first field and is the name of the monitored function   
+   count contains a count of times the function was called             
+   monitorp is a flag that skips counting if nil, counts otherwise     
+   sourcefile is the name of the file that contains the source code    
+                                                                       
+ ***** SETUP, SHUTDOWN ****                                            
+                                                                       
+monitor-inittable ()                           FUNCTION                
+   creates the hashtable and sets *monitor-table*                      
+   note that it is called every time this file is loaded               
+monitor-end ()                                 FUNCTION                
+   unhooks all of the trace hooks                                      
+                                                                       
+ ***** TRACE, UNTRACE *****                                            
+                                                                       
+monitor-add (name &optional sourcefile)        FUNCTION                
+   sets up the trace and adds the function to the table                
+monitor-delete (fn)                            FUNCTION                
+   untraces a function and removes it from the table                   
+monitor-enable (&optional fn)                  FUNCTION                
+   starts tracing for all (or optionally one) functions that           
+   are in the table                                                    
+monitor-disable (&optional fn)                 FUNCTION                
+   stops tracing for all (or optionally one) functions that            
+   are in the table                                                    
+                                                                       
+***** COUNTING, RECORDING  *****                                       
+                                                                       
+monitor-reset (&optional fn)                   FUNCTION                
+   reset the table count for the table (or optionally, for a function) 
+monitor-incr (fn)                              FUNCTION                
+   increments the count information for a function                     
+   it is called by trace to increment the count                        
+monitor-decr (fn)                              FUNCTION                
+   decrements the count information for a function                     
+monitor-info (fn)                              FUNCTION                
+   returns the monitor-data structure for a function                   
+                                                                       
+***** FILE IO *****                                                    
+                                                                       
+monitor-write (items file)                     FUNCTION                
+   writes a list of symbols or structures to a file                    
+monitor-file (file)                            FUNCTION                
+   will read a file, scan for defuns, monitor each defun               
+   NOTE: monitor-file assumes that the file has been loaded            
+                                                                       
+***** RESULTS *****                                                    
+                                                                       
+monitor-results ()                             FUNCTION                
+   returns a list of the monitor-data structures                       
+monitor-untested ()                            FUNCTION                
+   returns a list of files that have zero counts                       
+monitor-tested (&optional delete)              FUNCTION                
+   returns a list of files that have nonzero counts                    
+   optionally calling monitor-delete on those functions
+
+***** CHECKPOINT/RESTORE *****
+monitor-checkpoint (file)                     FUNCTION
+   save the *monitor-table* in a loadable form
+monitor-restore (file)                        FUNCTION
+  restore a checkpointed file so that everything is monitored
+
+***** ALGEBRA *****
+monitor-autoload ()                           FUNCTION
+  traces autoload of algebra to monitor corresponding source files
+  NOTE: this requires the /spad/int/algebra directory
+monitor-dirname (args)                        FUNCTION
+  expects a list of 1 libstream (loadvol's arglist) and monitors the source
+  this is a function called by monitor-autoload 
+monitor-nrlib (nrlib)                         FUNCTION
+  takes an nrlib name as a string (eg POLY) and returns a list of 
+  monitor-data structures from that source file
+monitor-report ()                             FUNCTION
+  generate a report of the monitored activity for domains in 
+  *monitor-domains*
+monitor-spadfile (name)                       FUNCTION
+  given a spad file, report all NRLIBS it creates
+  this adds each NRLIB name to *monitor-domains* but does not
+  trace the functions from those domains
+monitor-percent ()                            FUNCTION
+  ratio of (functions executed)/(functions traced)
+monitor-apropos (str)                         FUNCTION
+  given a string, find all monitored symbols containing the string
+  the search is case-insensitive. returns a list of monitor-data items
+
+for example:
+ suppose we have a file "/u/daly/testmon.lisp" that contains:
+ (defun foo1 () (print 'foo1))
+ (defun foo2 () (print 'foo2))
+ (defun foo3 () (foo1) (foo2) (print 'foo3))
+ (defun foo4 () (print 'foo4))
+
+ an example session is:
+
+ ; FIRST WE LOAD THE FILE (WHICH INITS *monitor-table*)
+
+ >(load "/u/daly/monitor.lisp")
+ Loading /u/daly/monitor.lisp
+ Finished loading /u/daly/monitor.lisp
+ T
+
+ ; SECOND WE LOAD THE TESTMON FILE
+ >(load "/u/daly/testmon.lisp")
+ T
+
+ ; THIRD WE MONITOR THE FILE
+ >(monitor-file "/u/daly/testmon.lisp")
+ monitoring "/u/daly/testmon.lisp"
+ NIL
+ 
+ ; FOURTH WE CALL A FUNCTION FROM THE FILE (BUMP ITS COUNT)
+ >(foo1)
+ 
+ FOO1 
+ FOO1
+ 
+ ; AND ANOTHER FUNCTION (BUMP ITS COUNT)
+ >(foo2)
+ 
+ FOO2 
+ FOO2
+ 
+ ; AND A THIRD FUNCTION THAT CALLS THE OTHER TWO (BUMP ALL THREE)
+ >(foo3)
+
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+ 
+ ; CHECK THAT THE RESULTS ARE CORRECT
+
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 2 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 1 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+
+ ; STOP COUNTING CALLS TO FOO2
+ 
+ >(monitor-disable 'foo2)
+ NIL
+
+ ; INVOKE FOO2 THRU FOO3
+
+ >(foo3)
+ 
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+
+ ; NOTICE THAT FOO1 AND FOO3 WERE BUMPED BUT NOT FOO2 
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+ 
+ ; TEMPORARILY STOP ALL MONITORING
+
+ >(monitor-disable)
+ NIL
+
+ ; CHECK THAT NOTHING CHANGES
+ 
+ >(foo3)
+ 
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+
+ ; NO COUNT HAS CHANGED
+ 
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 3 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+
+ ; MONITOR ONLY CALLS TO FOO1
+ 
+ >(monitor-enable 'foo1)
+ T
+
+ ; FOO3 CALLS FOO1
+ 
+ >(foo3)
+ 
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+
+ ; FOO1 HAS CHANGED BUT NOT FOO2 OR FOO3
+ 
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 4 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 2 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 2 MONITORP NIL SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+ 
+ ; MONITOR EVERYBODY
+
+ >(monitor-enable)
+ NIL
+
+ ; CHECK THAT EVERYBODY CHANGES
+ 
+ >(foo3)
+ 
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+
+ ; EVERYBODY WAS BUMPED
+ 
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+
+ ; WHAT FUNCTIONS WERE TESTED?
+
+ >(monitor-tested)
+ (FOO1 FOO2 FOO3)
+
+ ; WHAT FUNCTIONS WERE NOT TESTED?
+
+ >(monitor-untested)
+ (FOO4)
+
+ ; UNTRACE THE WHOLE WORLD, MONITORING CANNOT RESTART
+ 
+ >(monitor-end)
+ NIL
+
+ ; CHECK THE RESULTS
+ 
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+
+ ; CHECK THAT THE FUNCTIONS STILL WORK
+ 
+ >(foo3)
+ 
+ FOO1 
+ FOO2 
+ FOO3 
+ FOO3
+ 
+ ; CHECK THAT MONITORING IS NOT OCCURING
+
+ >(monitor-results)
+ (#S(MONITOR-DATA NAME FOO1 COUNT 5 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO2 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp")
+  #S(MONITOR-DATA NAME FOO3 COUNT 3 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+  #S(MONITOR-DATA NAME FOO4 COUNT 0 MONITORP T SOURCEFILE
+        "/u/daly/testmon.lisp"))
+
+\end{verbatim}
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+(defun monitor-help ()
+ (format t "~%
+;;; MONITOR                                                                
+;;;                                                                        
+;;; This file contains a set of function for monitoring the execution      
+;;; of the functions in a file. It constructs a hash table that contains   
+;;; the function name as the key and monitor-data structures as the value  
+;;;                                                                        
+;;; The technique is to use a :cond parameter on trace to call the         
+;;; monitor-incr function to incr the count every time a function is called
+;;;                                                                        
+;;; *monitor-table*                                HASH TABLE              
+;;;    is the monitor table containing the hash entries                    
+;;; *monitor-nrlibs*                               LIST of STRING
+;;;    list of NRLIB filenames that are monitored
+;;; *monitor-domains*                              LIST of STRING
+;;;    list of domains to monitor-report (default is all exposed domains)
+;;; monitor-data                                   STRUCTURE               
+;;;    is the defstruct name of records in the table                       
+;;;    name is the first field and is the name of the monitored function   
+;;;    count contains a count of times the function was called             
+;;;    monitorp is a flag that skips counting if nil, counts otherwise     
+;;;    sourcefile is the name of the file that contains the source code    
+;;;                                                                        
+;;;  ***** SETUP, SHUTDOWN ****                                            
+;;;                                                                        
+;;; monitor-inittable ()                           FUNCTION                
+;;;    creates the hashtable and sets *monitor-table*                      
+;;;    note that it is called every time this file is loaded               
+;;; monitor-end ()                                 FUNCTION                
+;;;    unhooks all of the trace hooks                                      
+;;;                                                                        
+;;;  ***** TRACE, UNTRACE *****                                            
+;;;                                                                        
+;;; monitor-add (name &optional sourcefile)        FUNCTION                
+;;;    sets up the trace and adds the function to the table                
+;;; monitor-delete (fn)                            FUNCTION                
+;;;    untraces a function and removes it from the table                   
+;;; monitor-enable (&optional fn)                  FUNCTION                
+;;;    starts tracing for all (or optionally one) functions that           
+;;;    are in the table                                                    
+;;; monitor-disable (&optional fn)                 FUNCTION                
+;;;    stops tracing for all (or optionally one) functions that            
+;;;    are in the table                                                    
+;;;                                                                        
+;;; ***** COUNTING, RECORDING  *****                                       
+;;;                                                                        
+;;; monitor-reset (&optional fn)                   FUNCTION                
+;;;    reset the table count for the table (or optionally, for a function) 
+;;; monitor-incr (fn)                              FUNCTION                
+;;;    increments the count information for a function                     
+;;;    it is called by trace to increment the count                        
+;;; monitor-decr (fn)                              FUNCTION                
+;;;    decrements the count information for a function                     
+;;; monitor-info (fn)                              FUNCTION                
+;;;    returns the monitor-data structure for a function                   
+;;;                                                                        
+;;; ***** FILE IO *****                                                    
+;;;                                                                        
+;;; monitor-write (items file)                     FUNCTION                
+;;;    writes a list of symbols or structures to a file                    
+;;; monitor-file (file)                            FUNCTION                
+;;;    will read a file, scan for defuns, monitor each defun               
+;;;    NOTE: monitor-file assumes that the file has been loaded            
+;;;                                                                        
+;;; ***** RESULTS *****                                                    
+;;;                                                                        
+;;; monitor-results ()                             FUNCTION                
+;;;    returns a list of the monitor-data structures                       
+;;; monitor-untested ()                            FUNCTION                
+;;;    returns a list of files that have zero counts                       
+;;; monitor-tested (&optional delete)              FUNCTION                
+;;;    returns a list of files that have nonzero counts                    
+;;;    optionally calling monitor-delete on those functions
+;;;
+;;; ***** CHECKPOINT/RESTORE *****
+;;;
+;;; monitor-checkpoint (file)                     FUNCTION
+;;;    save the *monitor-table* in a loadable form
+;;; monitor-restore (file)                        FUNCTION
+;;;   restore a checkpointed file so that everything is monitored
+;;;
+;;; ***** ALGEBRA *****
+;;;
+;;; monitor-autoload ()                           FUNCTION
+;;;   traces autoload of algebra to monitor corresponding source files
+;;;   NOTE: this requires the /spad/int/algebra directory
+;;; monitor-dirname (args)                        FUNCTION
+;;;   expects a list of 1 libstream (loadvol's arglist) and monitors the source
+;;;   this is a function called by monitor-autoload 
+;;; monitor-nrlib (nrlib)                         FUNCTION
+;;;   takes an nrlib name as a string (eg POLY) and returns a list of 
+;;;   monitor-data structures from that source file
+;;; monitor-report ()                             FUNCTION
+;;;   generate a report of the monitored activity for domains in 
+;;;   *monitor-domains*
+;;; monitor-spadfile (name)                       FUNCTION
+;;;   given a spad file, report all NRLIBS it creates
+;;;   this adds each NRLIB name to *monitor-domains* but does not
+;;;   trace the functions from those domains
+;;; monitor-percent ()                            FUNCTION
+;;;   ratio of (functions executed)/(functions traced)
+;;; monitor-apropos (str)                         FUNCTION
+;;;   given a string, find all monitored symbols containing the string
+;;;   the search is case-insensitive. returns a list of monitor-data items
+") nil)
+
+(defvar *monitor-domains* nil "a list of domains to report")
+
+(defvar *monitor-nrlibs* nil "a list of nrlibs that have been traced")
+
+(defvar *monitor-table* nil "a table of all of the monitored data")
+
+(defstruct monitor-data name count monitorp sourcefile)
+
+(unless (fboundp 'libstream-dirname)
+ (defstruct libstream  mode dirname (indextable nil)  (indexstream nil)))
+
+(defun monitor-inittable ()
+ "initialize the table"
+ (setq *monitor-table* (make-hash-table)))
+
+(eval-when (eval load) 
+ (unless *monitor-table* (monitor-inittable)))
+
+(defun monitor-end ()
+ "stop the whole monitoring process. we cannot restart"
+ (maphash 
+  #'(lambda (key value)
+     (declare (ignore value))
+     (eval `(untrace ,key)))
+   *monitor-table*))
+
+(defun monitor-results ()
+ "return a list of the monitor-data structures"
+ (let (result)
+  (maphash 
+  #'(lambda (key value)
+     (declare (ignore key))
+     (push value result))
+   *monitor-table*)
+  result))
+
+(defun monitor-add (name &optional sourcefile)
+ "add a function to the hash table"
+ (unless (fboundp name) (load sourcefile))
+ (when (gethash name *monitor-table*) 
+  (monitor-delete name))
+ (eval `(trace (,name :cond (progn (monitor-incr ',name) nil))))
+ (setf (gethash name *monitor-table*)
+  (make-monitor-data 
+     :name name :count 0 :monitorp t :sourcefile sourcefile)))))
+
+(defun monitor-delete (fn)
+ "delete a function from the monitor table"
+ (eval `(untrace ,fn))
+ (remhash fn *monitor-table*))
+
+(defun monitor-enable (&optional fn)
+ "enable all (or optionally one) function for monitoring"
+ (if fn 
+  (progn
+   (eval `(trace (,fn :cond (progn (monitor-incr ',fn) nil))))
+   (setf (monitor-data-monitorp (gethash fn *monitor-table*)) t))
+  (maphash 
+   #'(lambda (key value)
+      (declare (ignore value))
+      (eval `(trace (,fn :cond (progn (monitor-incr ',fn) nil))))
+      (setf (monitor-data-monitorp (gethash key *monitor-table*)) t))
+   *monitor-table*)))
+
+(defun monitor-disable (&optional fn)
+ "disable all (or optionally one) function for monitoring"
+ (if fn
+  (progn
+   (eval `(untrace ,fn))   
+   (setf (monitor-data-monitorp (gethash fn *monitor-table*)) nil))
+  (maphash 
+   #'(lambda (key value)
+      (declare (ignore value))
+      (eval `(untrace ,fn))
+      (setf (monitor-data-monitorp (gethash key *monitor-table*)) nil))
+   *monitor-table*)))
+
+(defun monitor-reset (&optional fn)
+ "reset the table count for the table (or optionally, for a function)"
+ (if fn
+  (setf (monitor-data-count (gethash fn *monitor-table*)) 0)
+  (maphash 
+   #'(lambda (key value)
+      (declare (ignore value))
+      (setf (monitor-data-count (gethash key *monitor-table*)) 0))
+   *monitor-table*)))
+
+(defun monitor-incr (fn)
+ "incr the count of fn by 1"
+ (let (data)
+  (setq data (gethash fn *monitor-table*))
+  (if data 
+   (incf (monitor-data-count data))  ;; change table entry by side-effect
+   (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn))))
+
+(defun monitor-decr (fn)
+ "decr the count of fn by 1"
+ (let (data)
+  (setq data (gethash fn *monitor-table*))
+  (if data 
+   (decf (monitor-data-count data))  ;; change table entry by side-effect
+   (warn "~s is monitored but not in table..do (untrace ~s)~%" fn fn))))
+
+(defun monitor-info (fn)
+ "return the information for a function"
+ (gethash fn *monitor-table*))
+
+(defun monitor-file (file)
+ "hang a monitor call on all of the defuns in a file"
+ (let (expr (package "BOOT"))
+  (format t "monitoring ~s~%" file)
+  (with-open-file (in file)
+   (catch 'done
+    (loop
+     (setq expr (read in nil 'done))
+     (when (eq expr 'done) (throw 'done nil))
+     (if (and (consp expr) (eq (car expr) 'in-package))
+      (if (and (consp (second expr)) (eq (first (second expr)) 'quote))
+       (setq package (string (second (second expr))))
+       (setq package (second expr)))
+      (when (and (consp expr) (eq (car expr) 'defun))
+       (monitor-add (intern (string (second expr)) package) file))))))))
+
+(defun monitor-untested ()
+ "return a list of the functions with zero count fields"
+ (let (result)
+  (maphash 
+   #'(lambda (key value)
+      (if (and (monitor-data-monitorp value) (= (monitor-data-count value) 0))
+       (push key result)))
+    *monitor-table*)
+ result))
+
+(defun monitor-tested (&optional delete)
+ "return a list of the functions with non-zero count fields, optionally deleting them"
+ (let (result)
+  (maphash 
+   #'(lambda (key value)
+      (when (and (monitor-data-monitorp value) (> (monitor-data-count value) 0))
+       (when delete (monitor-delete key))
+       (push key result)))
+    *monitor-table*)
+ result))
+
+(defun monitor-write (items file)
+ "write out a list of symbols or structures to a file"
+ (with-open-file (out file :direction :output)
+  (dolist (item items)
+    (if (symbolp item)
+     (format out "~s~%" item)
+     (format out "~s~50t~s~100t~s~%"
+       (monitor-data-sourcefile item)
+       (monitor-data-name item)
+       (monitor-data-count item))))))
+
+(defun monitor-checkpoint (file)
+ "save the *monitor-table* in loadable form"
+ (let ((*print-package* t))
+  (declare (special *print-package*))
+  (with-open-file (out file :direction :output)
+   (format out "(in-package \"BOOT\")~%")
+   (format out "(monitor-inittable)~%")
+   (dolist (data (monitor-results))
+    (format out "(monitor-add '~s ~s)~%"
+     (monitor-data-name data)
+     (monitor-data-sourcefile data))
+    (format out "(setf (gethash '~s *monitor-table*) 
+                  (make-monitor-data :name '~s :count ~s :monitorp ~s
+                                     :sourcefile ~s))~%"
+     (monitor-data-name data)
+     (monitor-data-name data)
+     (monitor-data-count data)
+     (monitor-data-monitorp data)
+     (monitor-data-sourcefile data))))))
+
+(defun monitor-restore (file)
+ "restore a checkpointed file so that everything is monitored"
+ (load file))
+
+;; these functions are used for testing the algebra code
+
+(defun monitor-dirname (args)
+  "expects a list of 1 libstream (loadvol's arglist) and monitors the source"
+   (let (name)
+    (setq name (libstream-dirname (car args)))
+    (setq name (file-namestring name))
+    (setq name (concatenate 'string "/spad/int/algebra/" name "/code.lsp"))
+    (when (probe-file name)
+     (push name *monitor-nrlibs*)
+     (monitor-file name))))
+
+(defun monitor-autoload ()
+ "traces autoload of algebra to monitor corresponding source files"
+ (trace (vmlisp::loadvol 
+          :entrycond nil
+          :exitcond (progn (monitor-dirname system::arglist) nil))))
+
+(defun monitor-nrlib (nrlib)
+ "takes an nrlib name as a string (eg POLY) and returns a list of 
+  monitor-data structures from that source file"
+ (let (result)
+  (maphash 
+   #'(lambda (k v)
+      (declare (ignore k))
+      (when (string= nrlib 
+             (pathname-name (car (last
+                (pathname-directory (monitor-data-sourcefile v))))))
+       (push v result)))
+   *monitor-table*)
+ result))
+
+(defun monitor-libname (item)
+  "given a monitor-data item, extract the NRLIB name"
+  (pathname-name (car (last
+   (pathname-directory (monitor-data-sourcefile item))))))
+
+(defun monitor-exposedp (fn)
+ "exposed functions have more than 1 semicolon. given a symbol, count them"
+   (> (count #\; (symbol-name fn)) 1))
+
+(defun monitor-readinterp ()
+  "read INTERP.EXPOSED to initialize *monitor-domains* to exposed domains.
+   this is the default action. adding or deleting domains from the list
+   will change the report results"
+  (let (skip expr name)
+   (declare (special *monitor-domains*))
+   (setq *monitor-domains* nil)
+   (with-open-file (in "/spad/src/algebra/INTERP.EXPOSED")
+    (read-line in)
+    (read-line in)
+    (read-line in)
+    (read-line in)
+    (catch 'done
+     (loop
+      (setq expr (read-line in nil "done"))
+      (when (string= expr "done") (throw 'done nil))
+      (cond
+       ((string= expr "basic") (setq skip nil))
+       ((string= expr "categories") (setq skip t))
+       ((string= expr "hidden") (setq skip t))
+       ((string= expr "defaults") (setq skip nil)))
+      (when (and (not skip) (> (length expr) 58))
+       (setq name (subseq expr 58 (length expr)))
+       (setq name (string-right-trim '(#\space) name))
+       (when (> (length name) 0)
+        (push name *monitor-domains*))))))))
+
+(defun monitor-report ()
+ "generate a report of the monitored activity for domains in *monitor-domains*"
+ (let (nrlibs nonzero total)
+  (unless *monitor-domains* (monitor-readinterp))
+  (setq nonzero 0)
+  (setq total 0)
+  (maphash 
+   #'(lambda (k v)
+      (declare (ignore k))
+      (let (nextlib point)
+       (when (> (monitor-data-count v) 0) (incf nonzero))
+       (incf total)
+       (setq nextlib (monitor-libname v))
+       (setq point (member nextlib nrlibs :test #'string= :key #'car))
+       (if point
+         (setf (cdr (first point)) (cons v (cdr (first point))))
+         (push (cons nextlib (list v)) nrlibs))))
+   *monitor-table*)
+  (format t "~d of ~d (~d percent) tested~%" nonzero total 
+    (round (/ (* 100.0 nonzero) total)))
+  (setq nrlibs (sort nrlibs #'string< :key #'car))
+  (dolist (pair nrlibs)
+   (let ((exposedcount 0) (testcount 0))
+    (when (member (car pair) *monitor-domains* :test #'string=)
+     (format t "for library ~s~%" (car pair))
+     (dolist (item (sort (cdr pair)  #'> :key #'monitor-data-count))
+      (when (monitor-exposedp (monitor-data-name item))
+       (incf exposedcount)
+       (when (> (monitor-data-count item) 0) (incf testcount))
+       (format t "~5d ~s~%" 
+         (monitor-data-count item) 
+         (monitor-data-name item))))
+      (if (= exposedcount testcount)
+       (format t "~a has all exposed functions tested~%" (car pair))
+       (format t "Daly bug:~a has untested exposed functions~%" (car pair))))))
+ nil))
+      
+(defun monitor-parse (expr)
+  (let (point1 point2)
+   (setq point1 (position #\space expr :test #'char=))
+   (setq point1 (position #\space expr :start point1 :test-not #'char=))
+   (setq point1 (position #\space expr :start point1 :test #'char=))
+   (setq point1 (position #\space expr :start point1 :test-not #'char=))
+   (setq point2 (position #\space expr :start point1 :test #'char=))
+   (subseq expr point1 point2)))
+
+(defun monitor-spadfile (name)
+ "given a spad file, report all NRLIBS it creates"
+ (let (expr)
+  (with-open-file (in name)
+   (catch 'done
+    (loop
+     (setq expr (read-line in nil 'done))
+     (when (eq expr 'done) (throw 'done nil))
+     (when (and (> (length expr) 4) (string= (subseq expr 0 4) ")abb"))
+      (setq *monitor-domains* 
+       (adjoin (monitor-parse expr) *monitor-domains* :test #'string=))))))))
+
+(defun monitor-percent ()
+ (let (nonzero total)
+  (setq nonzero 0)
+  (setq total 0)
+  (maphash 
+   #'(lambda (k v)
+      (declare (ignore k))
+      (when (> (monitor-data-count v) 0) (incf nonzero))
+      (incf total))
+   *monitor-table*)
+   (format t "~d of ~d (~d percent) tested~%" nonzero total 
+     (round (/ (* 100.0 nonzero) total)))))
+
+(defun monitor-apropos (str)
+  "given a string, find all monitored symbols containing the string
+   the search is case-insensitive. returns a list of monitor-data items"
+ (let (result)
+  (maphash 
+   #'(lambda (k v)
+      (when
+       (search (string-upcase str) 
+               (string-upcase (symbol-name k)) 
+               :test #'string=)
+        (push v result)))
+   *monitor-table*)
+ result))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/msg.boot.pamphlet b/src/interp/msg.boot.pamphlet
new file mode 100644
index 00000000..70983f54
--- /dev/null
+++ b/src/interp/msg.boot.pamphlet
@@ -0,0 +1,577 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/msg.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+ListMember?(ob, l) ==
+  MEMBER(ob, l, KEYWORD::TEST, function EQUAL)
+
+--%  Messages for the USERS of the compiler.
+-- The program being compiled has a minor error.
+-- Give a message and continue processing.
+ncSoftError(pos, erMsgKey, erArgL,:optAttr) ==
+  $newcompErrorCount := $newcompErrorCount + 1
+  desiredMsg erMsgKey =>
+    processKeyedError _
+       msgCreate ('error, pos, erMsgKey, erArgL, $compErrorPrefix,optAttr)
+ 
+-- The program being compiled is seriously incorrect.
+-- Give message and throw to a recovery point.
+ncHardError(pos, erMsgKey, erArgL,:optAttr) ==
+  $newcompErrorCount := $newcompErrorCount + 1
+  desiredMsg erMsgKey =>
+    erMsg := processKeyedError _
+       msgCreate('error,pos,erMsgKey, erArgL, $compErrorPrefix,optAttr)
+  ncError()
+ 
+-- Bug in the compiler: something which shouldn't have happened did.
+ncBug (erMsgKey, erArgL,:optAttr) ==
+  $newcompErrorCount := $newcompErrorCount + 1
+  erMsg := processKeyedError _
+        msgCreate('bug,$nopos, erMsgKey, erArgL,$compBugPrefix,optAttr)
+  -- The next line is to try to deal with some reported cases of unwanted
+  -- backtraces appearing, MCD.
+  ENABLE_-BACKTRACE(nil)
+  BREAK()
+  ncAbort()
+ 
+--% Lower level functions
+ 
+--msgObject  tag -- catagory of msg
+--                    -- attributes as a-list
+--                        'imPr  => dont save for list processing
+--                        toWhere, screen or file
+--                        'norep => only display once in list
+--           pos -- position with possible FROM/TO tag
+--           key -- key for message database
+--          argL -- arguments to be placed in the msg test
+--        prefix -- things like "Error: "
+--          text -- the actual text
+ 
+msgCreate(tag,posWTag,key,argL,optPre,:optAttr) ==
+    if PAIRP key then tag := 'old
+    msg := [tag,posWTag,key,argL,optPre,NIL]
+    if CAR optAttr then
+        setMsgForcedAttrList(msg,car optAttr)
+    putDatabaseStuff msg
+    initImPr    msg
+    initToWhere msg
+    msg
+ 
+processKeyedError msg ==
+    getMsgTag? msg = 'old  =>                                 --temp
+        erMsg := getMsgKey msg                                --temp
+        if pre := getMsgPrefix? msg then                      --temp
+          erMsg := ['%b, pre, '%d, :erMsg]                    --temp
+        sayBrightly ['"old msg from ",_
+          CallerName 4,:erMsg]                  --temp
+    msgImPr? msg =>
+      msgOutputter msg
+    $ncMsgList := cons (msg, $ncMsgList)
+ 
+---------------------------------
+--%getting info from db.
+putDatabaseStuff msg ==
+    [text,attributes] := getMsgInfoFromKey msg
+    if attributes then setMsgUnforcedAttrList(msg,aL)
+    setMsgText(msg,text)
+ 
+getMsgInfoFromKey msg ==
+    $msgDatabaseName : local := []
+    msgText :=
+        msgKey := getMsgKey? msg =>   --temp  oldmsgs use key tostoretext
+           dbL := [$erLocMsgDatabaseName,$erGlbMsgDatabaseName]
+           getErFromDbL (msgKey,dbL)
+        getMsgKey msg                  --temp oldmsgs
+    msgText := segmentKeyedMsg  msgText
+    [msgText,attributes] := removeAttributes msgText
+    msgText := substituteSegmentedMsg(msgText, getMsgArgL msg)
+    [msgText,attributes]
+ 
+ 
+getErFromDbL (erMsgKey,dbL) ==
+    erMsg := NIL
+    while null erMsg   repeat
+        dbName := CAR dbL
+        dbL    := CDR dbL
+        $msgDatabaseName      := dbName
+        lastName := null dbL
+--        fileFound := '"co_-eng.msgs"
+        fileFound := '"s2_-us.msgs"
+        if fileFound or lastName then
+            erMsg := fetchKeyedMsg(erMsgKey,not lastName)
+    erMsg
+ 
+-----------------------
+--%character position marking
+ 
+processChPosesForOneLine msgList ==
+    chPosList := posPointers msgList
+    for msg in msgList repeat
+        if getMsgFTTag? msg then
+            putFTText (msg,chPosList)
+        posLetter := CDR ASSOC(poCharPosn getMsgPos msg,chPosList)
+        oldPre := getMsgPrefix msg
+        setMsgPrefix (msg,STRCONC(oldPre,_
+                     MAKE_-FULL_-CVEC ($preLength - 4 - SIZE oldPre),posLetter) )
+    leaderMsg := makeLeaderMsg chPosList
+    NCONC(msgList,LIST leaderMsg)  --a back cons
+ 
+posPointers msgList ==
+--gets all the char posns for msgs on one line
+--associates them with a uppercase letter
+    pointers  := '"ABCDEFGHIJKLMONPQRS"
+    increment := 0
+    posList:= []
+    ftPosList := []
+    for msg in msgList repeat
+       pos := poCharPosn getMsgPos msg
+       if pos ^= IFCAR posList then
+         posList := [pos,:posList]
+       if getMsgFTTag = 'FROMTO then
+         ftPosList := [poCharPosn getMsgPos2 msg,:ftPosList]
+    for toPos in ftPosList repeat
+           posList := insertPos(toPos,posList)
+    for pos in posList repeat
+        posLetterList := [[pos,:pointers.increment],:posLetterList]
+        increment := increment + 1
+    posLetterList
+ 
+insertPos(newPos,posList) ==
+--insersts a position in the proper place of a positon list
+--used for the 2nd pos of a fromto
+    done := false
+    bot  := [0,:posList]
+    top  := []
+    while not done repeat
+        top  := [CAR bot,:top]
+        bot  := CDR bot
+        pos  := CAR bot
+        done :=
+          pos < newPos => false
+          pos = newPos => true
+          pos > newPos =>
+            top := [newPos,:top]
+            true
+    [CDR reverse top,:bot]
+ 
+putFTText (msg,chPosList) ==
+    tag := getMsgFTTag? msg
+    pos := poCharPosn getMsgPos msg
+    charMarker := CDR ASSOC(pos,chPosList)
+    tag = 'FROM =>
+        markingText := ['"(from ",charMarker,'" and on) "]
+        setMsgText(msg,[:markingText,:getMsgText msg])
+    tag = 'TO =>
+        markingText := ['"(up to ",charMarker,'") "]
+        setMsgText(msg,[:markingText,:getMsgText msg])
+    tag = 'FROMTO =>
+       pos2 := poCharPosn getMsgPos2 msg
+       charMarker2 := CDR ASSOC(pos2,chPosList)
+       markingText := ['"(from ",charMarker,'" up to ",_
+           charMarker2,'") "]
+       setMsgText(msg,[:markingText,:getMsgText msg])
+ 
+rep (c,n)  ==
+    n > 0 =>
+      MAKE_-FULL_-CVEC(n, c)
+    '""
+ 
+--called from parameter list of nc message functions
+From   pos == ['FROM,   pos]
+To     pos == ['TO,     pos]
+FromTo (pos1,pos2) == ['FROMTO, pos1, pos2]
+ 
+------------------------
+--%processing error lists
+processMsgList (erMsgList,lineList) ==
+    $outputList :local := []--grows in queueUp errors
+    $noRepList :local := []--grows in queueUp errors
+    erMsgList  := erMsgSort erMsgList
+    for line in lineList repeat
+        msgLine := makeMsgFromLine line
+        $outputList := [msgLine,:$outputList]
+        globalNumOfLine := poGlobalLinePosn getMsgPos msgLine
+        erMsgList :=
+             queueUpErrors(globalNumOfLine,erMsgList)
+    $outputList := append(erMsgList,$outputList)  --the nopos's
+    st := '"---------SOURCE-TEXT-&-ERRORS------------------------"
+    listOutputter reverse $outputList
+ 
+erMsgSort erMsgList ==
+    [msgWPos,msgWOPos] := erMsgSep erMsgList
+    msgWPos  := listSort(function erMsgCompare, msgWPos)
+    msgWOPos := reverse msgWOPos
+    [:msgWPos,:msgWOPos]
+ 
+erMsgCompare(ob1,ob2)==
+    pos1 :=  getMsgPos ob1
+    pos2 :=  getMsgPos ob2
+    compareposns(pos2,pos1)
+ 
+erMsgSep erMsgList ==
+    msgWPos  := []
+    msgWOPos := []
+    for msg in erMsgList repeat
+        if poNopos? getMsgPos msg then
+          msgWOPos := [msg,:msgWOPos]
+        else
+          msgWPos  := [msg,:msgWPos]
+    [msgWPos,msgWOPos]
+ 
+getLinePos line  == CAR line
+getLineText line == CDR line
+ 
+queueUpErrors(globalNumOfLine,msgList)==
+    thisPosMsgs  := []
+    notThisLineMsgs := []
+    for msg in msgList _
+      while thisPosIsLess(getMsgPos msg,globalNumOfLine) repeat
+    --these are msgs that refer to positions from earlier compilations
+        if not redundant (msg,notThisPosMsgs) then
+           notThisPosMsgs := [msg,:notThisPosMsgs]
+        msgList := rest msgList
+    for msg in msgList _
+      while thisPosIsEqual(getMsgPos msg,globalNumOfLine) repeat
+       if not redundant (msg,thisPosMsgs) then
+           thisPosMsgs := [msg,:thisPosMsgs]
+       msgList := rest msgList
+    if thisPosMsgs then
+        thisPosMsgs := processChPosesForOneLine  thisPosMsgs
+        $outputList := NCONC(thisPosMsgs,$outputList)
+    if notThisPosMsgs then
+        $outputList := NCONC(notThisPosMsgs,$outputList)
+    msgList
+ 
+redundant(msg,thisPosMsgs) ==
+    found := NIL
+    if msgNoRep? msg then
+        for item in $noRepList repeat
+            sameMsg?(msg,item) => return (found := true)
+        $noRepList := [msg,$noRepList]
+    found or member(msg,thisPosMsgs)
+ 
+sameMsg? (msg1,msg2) ==
+    (getMsgKey   msg1 = getMsgKey  msg2) and _
+    (getMsgArgL  msg1 = getMsgArgL msg2)
+ 
+ 
+thisPosIsLess(pos,num) ==
+    poNopos? pos => NIL
+    poGlobalLinePosn pos < num
+ 
+thisPosIsEqual(pos,num) ==
+    poNopos? pos => NIL
+    poGlobalLinePosn pos = num
+ 
+--%outputting stuff
+ 
+listOutputter outputList ==
+    for msg in outputList repeat
+        msgOutputter msg
+ 
+msgOutputter msg  ==
+    st := getStFromMsg msg
+    shouldFlow := not (leader? msg or line? msg)
+    if toScreen? msg then
+       if shouldFlow then
+          st := flowSegmentedMsg(st,$LINELENGTH,0)
+       sayBrightly st
+    if toFile? msg then
+       if shouldFlow then
+          st := flowSegmentedMsg(st,$LOGLENGTH,0)
+       alreadyOpened := alreadyOpened? msg
+        
+toScreen? msg ==  getMsgToWhere msg ^= 'fileOnly
+toFile? msg   ==
+     PAIRP $fn and _
+     getMsgToWhere msg ^= 'screenOnly
+ 
+ 
+alreadyOpened? msg ==
+       not msgImPr? msg
+ 
+getStFromMsg msg ==
+    $optKeyBlanks : local := '""  --set in setOptKeyBlanks()
+    setOptKeyBlanks()
+    preStL := getPreStL getMsgPrefix? msg
+    getMsgTag  msg = 'line =>
+          [$optKeyBlanks, '"%x1" , :preStL,_
+           getMsgText msg]
+    posStL := getPosStL msg
+    optKey :=
+        $showKeyNum =>
+            msgKey := getMsgKey? msg => PNAME msgKey
+            '"no key  "
+        '""
+    st :=[posStL,getMsgLitSym msg,_
+          optKey,:preStL,_
+          tabbing msg,:getMsgText msg]
+ 
+tabbing msg ==
+    chPos := 2
+    if getMsgPrefix? msg then
+      chPos := chPos + $preLength - 1
+    if $showKeyNum then chPos := chPos + 8
+    ["%t",:chPos]
+ 
+setOptKeyBlanks() ==
+    $optKeyBlanks :=
+        $showKeyNum => '"%x8"
+        '""
+ 
+getPosStL msg ==
+    not showMsgPos? msg => '""
+    msgPos := getMsgPos msg
+    howMuch :=
+        msgImPr? msg =>
+            decideHowMuch (msgPos,$lastPos)
+        listDecideHowMuch (msgPos,$lastPos)
+    $lastPos := msgPos
+    fullPrintedPos := ppos msgPos
+    printedFileName :=  ['"%x2",'"[",:remLine fullPrintedPos,'"]" ]
+    printedLineNum  :=  ['"%x2",'"[",:remFile fullPrintedPos,'"]" ]
+    printedOrigin   :=  ['"%x2",'"[",:fullPrintedPos,'"]" ]
+    howMuch  = 'ORG  => [$optKeyBlanks,:printedOrigin, '%l]
+    howMuch  = 'LINE => [$optKeyBlanks,:printedLineNum, '%l]
+    howMuch  = 'FILE => [$optKeyBlanks,:printedFileName, '%l]
+    howMuch  = 'ALL  => [$optKeyBlanks,:printedFileName, '%l,_
+                         $optKeyBlanks,:printedLineNum,  '%l]
+    '""
+ 
+showMsgPos? msg ==
+    $erMsgToss or (not msgImPr? msg and not msgLeader? msg)
+ 
+ 
+remFile positionList ==
+        IFCDR IFCDR positionList
+ 
+remLine positionList ==
+        [IFCAR positionList]
+ 
+decideHowMuch(pos,oldPos) ==
+--when printing a msg, we wish not to show pos infor that was
+--shown for a previous msg with identical pos info.
+--org prints out the word noposition or console
+    ((poNopos? pos) and (poNopos? oldPos)) or _
+      ((poPosImmediate? pos) and (poPosImmediate? oldPos))  => 'NONE
+    (poNopos? pos) or (poPosImmediate? pos) => 'ORG
+    (poNopos? oldPos) or (poPosImmediate? oldPos) => 'ALL
+    poFileName oldPos ^= poFileName pos => 'ALL
+    poLinePosn oldPos ^= poLinePosn pos => 'LINE
+    'NONE
+ 
+listDecideHowMuch(pos,oldPos) ==
+    ((poNopos? pos) and (poNopos? oldPos)) or _
+      ((poPosImmediate? pos) and (poPosImmediate? oldPos))  => 'NONE
+    (poNopos? pos)     => 'ORG
+    (poNopos? oldPos)  => 'NONE
+    poGlobalLinePosn pos < poGlobalLinePosn oldPos =>
+        poPosImmediate? pos => 'ORG
+        'LINE
+    --(poNopos? pos) or (poPosImmediate? pos) => 'ORG
+    'NONE
+ 
+getPreStL optPre ==
+    null optPre => [MAKE_-FULL_-CVEC 2]
+    spses :=
+      (extraPlaces := ($preLength - (SIZE optPre) - 3)) > 0 =>
+        MAKE_-FULL_-CVEC extraPlaces
+      '""
+    ['%b, optPre,spses,'":", '%d]
+ 
+-------------------
+--%   a-list stuff
+desiredMsg (erMsgKey,:optCatFlag) ==
+    isKeyQualityP(erMsgKey,'show)   => true
+    isKeyQualityP(erMsgKey,'stifle) => false
+    not null optCatFlag  => CAR optCatFlag
+    true
+ 
+isKeyQualityP (key,qual)  ==
+    --returns pair if found, else NIL
+    found := false
+    while not found and (qualPair := ASSOC(key,$specificMsgTags)) repeat
+        if CDR qualPair = qual then found := true
+    qualPair
+ 
+-----------------------------
+--% these functions handle the attributes
+ 
+initImPr msg  ==
+    $erMsgToss or MEMQ (getMsgTag msg,$imPrTagGuys) =>
+        setMsgUnforcedAttr (msg,'$imPrGuys,'imPr)
+ 
+initToWhere msg  ==
+    member ('trace,getMsgCatAttr (msg,'catless)) =>
+          setMsgUnforcedAttr (msg,'$toWhereGuys,'screenOnly)
+ 
+msgImPr? msg ==
+    (getMsgCatAttr (msg,'$imPrGuys) = 'imPr)
+ 
+msgNoRep? msg ==
+    (getMsgCatAttr (msg,'$repGuys) = 'noRep)
+ 
+msgLeader? msg ==
+    getMsgTag msg = 'leader
+ 
+getMsgToWhere msg ==
+    getMsgCatAttr (msg,'$toWhereGuys)
+ 
+getMsgCatAttr  (msg,cat) ==
+    IFCDR QASSQ(cat, ncAlist msg)
+ 
+setMsgForcedAttrList (msg,aL) ==
+    for attr in aL repeat
+        setMsgForcedAttr(msg,whichCat attr,attr)
+ 
+setMsgUnforcedAttrList (msg,aL) ==
+    for attr in aL repeat
+        setMsgUnforcedAttr(msg,whichCat attr,attr)
+ 
+setMsgForcedAttr(msg,cat,attr) ==
+    cat = 'catless => setMsgCatlessAttr(msg,attr)
+    ncPutQ(msg,cat,attr)
+ 
+setMsgUnforcedAttr(msg,cat,attr) ==
+    cat = 'catless => setMsgCatlessAttr(msg,attr)
+    not QASSQ(cat, ncAlist msg) => ncPutQ(msg,cat,attr)
+ 
+setMsgCatlessAttr(msg,attr) ==
+    ncPutQ(msg,catless,CONS (attr, IFCDR QASSQ(catless, ncAlist msg)))
+ 
+whichCat attr ==
+    found := 'catless
+    for cat in $attrCats repeat
+        if ListMember? (attr,EVAL cat) then
+          found := cat
+          return found
+    found
+ 
+--------------------------------------
+--% these functions directly interact with the message object
+ 
+makeLeaderMsg chPosList ==
+    st := MAKE_-FULL_-CVEC ($preLength- 3)
+    oldPos := -1
+    for [posNum,:posLetter] in reverse chPosList repeat
+        st := STRCONC(st, _
+            rep(char ".", (posNum - oldPos - 1)),posLetter)
+        oldPos := posNum
+    ['leader,$nopos,'nokey,NIL,NIL,[st]]
+ 
+makeMsgFromLine line ==
+    posOfLine  := getLinePos line
+    textOfLine := getLineText line
+    globalNumOfLine := poGlobalLinePosn posOfLine
+    localNumOfLine  :=
+        i := poLinePosn posOfLine
+        stNum := STRINGIMAGE i
+        STRCONC(rep(char " ", ($preLength - 7 - SIZE stNum)),_
+         stNum)
+    ['line,posOfLine,NIL,NIL, STRCONC('"Line", localNumOfLine),_
+        textOfLine]
+ 
+getMsgTag msg == ncTag msg
+ 
+getMsgTag? msg ==
+   IFCAR member (getMsgTag msg,_
+       ['line,'old,'error,'warn,'bug,'unimple,'remark,'stat,'say,'debug])
+ 
+leader? msg == getMsgTag msg = 'leader
+line?   msg == getMsgTag msg = 'line
+ 
+getMsgPosTagOb msg == msg.1
+ 
+getMsgPos msg ==
+    getMsgFTTag? msg => CADR getMsgPosTagOb msg
+    getMsgPosTagOb msg
+ 
+getMsgPos2 msg ==
+    getMsgFTTag? msg => CADDR getMsgPosTagOb msg
+    ncBug('"not a from to",[])
+ 
+getMsgFTTag? msg == IFCAR member (IFCAR getMsgPosTagOb msg,_
+                      ['FROM,'TO,'FROMTO])
+ 
+getMsgKey msg == msg.2
+ 
+getMsgKey? msg == IDENTP (val := getMsgKey msg) => val
+ 
+getMsgArgL msg == msg.3
+ 
+getMsgPrefix? msg ==
+    (pre := msg.4) = 'noPre => NIL
+    pre
+ 
+getMsgPrefix  msg == msg.4
+ 
+ 
+getMsgLitSym msg ==
+    getMsgKey? msg => '" "
+    '"*"
+ 
+getMsgText msg == msg.5
+ 
+setMsgPrefix (msg,val) == msg.4 := val
+
+setMsgText (msg,val) == msg.5 := val
+ 
+ 
+
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/msgdb.boot.pamphlet b/src/interp/msgdb.boot.pamphlet
new file mode 100644
index 00000000..29920edf
--- /dev/null
+++ b/src/interp/msgdb.boot.pamphlet
@@ -0,0 +1,1076 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/msgdb.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\begin{verbatim}
+Description of Messages
+
+Axiom messages are read from a flat file database and returned
+as one long string.  They are preceded in the database by a key and
+this is how they are referenced from code.  For example, one key is
+S2IL0001 which means:
+   S2          Scratchpad II designation
+   I           from the interpreter
+   L           originally from LISPLIB BOOT
+   0001        a sequence number
+
+Each message may contain formatting codes and and parameter codes.
+The formatting codes are:
+   %b          turn on bright printing
+   %ceoff      turn off centering
+   %ceon       turn on centering
+   %d          turn off bright printing
+   %f          user defined printing
+   %i          start indentation of 3 more spaces
+   %l          start a new line
+   %m          math-print an expression
+   %rjoff      turn off right justification (actually ragged left)
+   %rjon       turn on right justification (actually ragged left)
+   %s          pretty-print as an S-expression
+   %u          unindent 3 spaces
+   %x#         insert # spaces
+
+The parameter codes look like %1, %2b, %3p, %4m, %5bp, %6s where the
+digit is the parameter number ans the letters following indicate
+additional formatting. You can indicate as many additional formatting
+qualifiers as you like, to the degree they make sense. The "p" code
+means to call prefix2String on the parameter, a standard way of
+printing abbreviated types.  The "P" operator maps prefix2String over 
+its arguments.  The "o" operation formats the argument as an operation 
+name.  "b" means to print that parameter in
+a bold (bright) font. "c" means to center that parameter on a
+new line.  "f" means that the parameter is a list [fn, :args]
+and that "fn" is to be called on "args" to get the text. "r" means
+to right justify (ragged left) the argument.
+
+Look in the file with the name defined in $defaultMsgDatabaseName
+above for examples.
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Message Database Code and Message Utility Functions
+
+SETANDFILEQ($msgDatabase,NIL)
+SETANDFILEQ($cacheMessages,'T)  -- for debugging purposes
+SETANDFILEQ($msgAlist,NIL)
+SETANDFILEQ($msgDatabaseName,NIL)
+SETANDFILEQ($testingErrorPrefix, '"Daly Bug")
+
+SETANDFILEQ($texFormatting, false)
+
+--% Accessing the Database
+
+string2Words l ==
+  i := 0
+  [w while wordFrom(l,i) is [w,i]]
+
+wordFrom(l,i) ==
+  maxIndex := MAXINDEX l
+  k := or/[j for j in i..maxIndex | l.j ^= char ('_ ) ] or return nil
+  buf := '""
+  while k < maxIndex and (c := l.k) ^= char ('_ ) repeat
+    ch :=
+      c = char '__   => l.(k := 1+k)  --this may exceed bounds
+      c
+    buf := STRCONC(buf,ch)
+    k := k + 1
+  if k = maxIndex and (c := l.k) ^= char ('_ ) then buf := STRCONC(buf,c)
+  [buf,k+1]
+
+getKeyedMsg key == fetchKeyedMsg(key,false)
+
+--% Formatting and Printing Keyed Messages
+
+segmentKeyedMsg(msg) == string2Words msg
+
+segmentedMsgPreprocess x ==
+  ATOM x => x
+  [head,:tail] := x
+  center := rightJust := NIL
+  if head in '(%ceon "%ceon") then center := true
+  if head in '(%rjon "%rjon") then rightJust := true
+  center or rightJust =>
+    -- start collecting terms
+    y := NIL
+    ok := true
+    while tail and ok repeat
+      [t,:tail] := tail
+      t in '(%ceoff "%ceoff" %rjoff "%rjoff") => ok := NIL
+      y := CONS(segmentedMsgPreprocess t,y)
+    head1 := [(center => '"%ce"; '"%rj"),:NREVERSE y]
+    NULL tail => [head1]
+    [head1,:segmentedMsgPreprocess tail]
+  head1 := segmentedMsgPreprocess head
+  tail1 := segmentedMsgPreprocess tail
+  EQ(head,head1) and EQ(tail,tail1) => x
+  [head1,:tail1]
+
+removeAttributes msg ==
+    --takes a segmented message and returns it with the attributes
+    --separted.
+    first msg ^= '"%atbeg" =>
+        [msg,NIL]
+    attList := []
+    until item = '"%atend" repeat
+        msg     := rest  msg
+        item    := first msg
+        attList := [INTERN item,:attList]
+    msg := rest msg
+    attList := rest attList
+    [msg,attList]
+
+substituteSegmentedMsg(msg,args) ==
+  -- this does substitution of the parameters
+  l := NIL
+  nargs := #args
+  for x in segmentedMsgPreprocess msg repeat
+    -- x is a list
+    PAIRP x =>
+      l := cons(substituteSegmentedMsg(x,args),l)
+    c := x.0
+    n := STRINGLENGTH x
+
+    -- x is a special case
+    (n > 2) and (c = "%") and (x.1 = "k") =>
+        l := NCONC(NREVERSE pkey SUBSTRING(x,2,NIL),l)
+
+    -- ?name gets replaced by '"Push PF10" or '"Type >b (enter)"
+    (x.0 = char "?") and n > 1 and (v := pushOrTypeFuture(INTERN x,nil)) =>
+      l := NCONC(NREVERSE v,l)
+
+    -- x requires parameter substitution
+    (x.0 = char "%") and (n > 1) and (DIGITP x.1) =>
+      a := DIG2FIX x.1
+      arg :=
+        a <= nargs => args.(a-1)
+        '"???"
+      -- now pull out qualifiers
+      q := NIL
+      for i in 2..(n-1) repeat q := cons(x.i,q)
+      -- Note 'f processing must come first.
+      if MEMQ(char 'f,q) then
+          arg :=
+              PAIRP arg => APPLY(first arg, rest arg)
+              arg
+      if MEMQ(char 'm,q) then arg := [['"%m",:arg]]
+      if MEMQ(char 's,q) then arg := [['"%s",:arg]]
+      if MEMQ(char 'p,q) then 
+          $texFormatting => arg := prefix2StringAsTeX arg
+          arg := prefix2String arg 
+      if MEMQ(char 'P,q) then
+          $texFormatting => arg := [prefix2StringAsTeX x for x in arg]
+          arg := [prefix2String x for x in arg]
+      if MEMQ(char 'o, q) and $texFormatting then arg := operationLink(arg)
+
+      if MEMQ(char 'c,q) then arg := [['"%ce",:arg]]
+      if MEMQ(char 'r,q) then arg := [['"%rj",:arg]]
+
+      if MEMQ(char 'l,q) then l := cons('"%l",l)
+      if MEMQ(char 'b,q) then l := cons('"%b",l)
+      --we splice in arguments that are lists
+      --if y is not specified, then the adding of blanks is
+      --stifled after the first item in the list until the
+      --end of the list. (using %n and %y)
+      l :=
+         PAIRP(arg) =>
+           MEMQ(char 'y,q) or (CAR arg = '"%y") or ((LENGTH arg) = 1)  =>
+             APPEND(REVERSE arg, l)
+           head := first arg
+           tail := rest arg
+           ['"%y",:APPEND(REVERSE tail, ['"%n",head,:l ]) ]
+         cons(arg,l)
+      if MEMQ(char 'b,q) then l := cons('"%d",l)
+      for ch in '(_. _, _! _: _; _?) repeat
+        if MEMQ(char ch,q) then l := cons(ch,l)
+
+    --x is a plain word
+    l := cons(x,l)
+  addBlanks NREVERSE l
+
+addBlanks msg ==
+  -- adds proper blanks
+  null PAIRP msg => msg
+  null msg => msg
+  LENGTH msg = 1 => msg
+  blanksOff := false
+  x := first msg
+  if x = '"%n" then
+    blanksOff := true
+    msg1 := []
+  else
+    msg1 := LIST x
+  blank := '" "
+  for y in rest msg repeat
+    y in '("%n" %n) => blanksOff := true
+    y in '("%y" %y) => blanksOff  := false
+    if noBlankAfterP x or noBlankBeforeP y or blanksOff then
+       msg1 := [y,:msg1]
+    else
+       msg1 := [y,blank,:msg1]
+    x := y
+  NREVERSE msg1
+
+
+SETANDFILEQ($msgdbPrims,'( %b %d %l %i %u %U %n %x %ce %rj "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj"))
+SETANDFILEQ($msgdbPunct,'(_. _, _! _: _; _? _] _)  "." "," "!" ":" ";" "?" "]" ")"  ))
+SETANDFILEQ($msgdbNoBlanksBeforeGroup,['" ", " ", '"%", "%",_
+                            :$msgdbPrims, :$msgdbPunct])
+SETANDFILEQ($msgdbListPrims,'(%m %s %ce %rj "%m" "%s" "%ce" "%rj"))
+
+noBlankBeforeP word==
+    INTP word => false
+    word in $msgdbNoBlanksBeforeGroup => true
+    if CVECP word and SIZE word > 1 then
+       word.0 = char '% and word.1 = char 'x => return true
+       word.0 = char " " => return true
+    (PAIRP word) and (CAR word in $msgdbListPrims) => true
+    false
+
+$msgdbPunct := '(_[ _(  "[" "(" )
+SETANDFILEQ($msgdbNoBlanksAfterGroup,['" ", " ",'"%" ,"%",_
+                          :$msgdbPrims,:$msgdbPunct])
+
+noBlankAfterP word==
+    INTP word => false
+    word in $msgdbNoBlanksAfterGroup => true
+    if CVECP word and (s := SIZE word) > 1 then
+       word.0 = char '% and word.1 = char 'x => return true
+       word.(s-1) = char " " => return true
+    (PAIRP word) and (CAR word in $msgdbListPrims) => true
+    false
+
+cleanUpSegmentedMsg msg ==
+  -- removes any junk like double blanks
+  -- takes a reversed msg and puts it in the correct order
+  null PAIRP msg => msg
+  blanks := ['" "," "]
+  haveBlank := NIL
+  prims :=
+    '(%b %d %l %i %u %m %ce %rj _
+     "%b" "%d" "%l" "%i" "%m" "%u" "%ce" "%rj")
+  msg1 := NIL
+  for x in msg repeat
+    if haveBlank and ((x in blanks) or (x in prims)) then
+      msg1 := CDR msg1
+    msg1 := cons(x,msg1)
+    haveBlank := (x in blanks => true; NIL)
+  msg1
+
+operationLink name ==
+  FORMAT(nil, '"\lispLink{\verb!(|oSearch| _"~a_")!}{~a}",
+         name,
+         escapeSpecialChars STRINGIMAGE name)
+
+----------------------------------------
+sayPatternMsg(msg,args) ==
+  msg := segmentKeyedMsg msg
+  msg := substituteSegmentedMsg(msg,args)
+  sayMSG flowSegmentedMsg(msg,$LINELENGTH,3)
+
+throwPatternMsg(key,args) ==
+  sayMSG '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayPatternMsg(key,args)
+  spadThrow()
+
+sayKeyedMsgAsTeX(key, args) == 
+  $texFormatting: fluid := true
+  sayKeyedMsgLocal(key, args)
+
+sayKeyedMsg(key,args) ==
+  $texFormatting: fluid := false
+  sayKeyedMsgLocal(key, args)
+
+sayKeyedMsgLocal(key, args) ==
+  msg := segmentKeyedMsg getKeyedMsg key
+  msg := substituteSegmentedMsg(msg,args)
+  if $displayMsgNumber then msg := ['"%b",key,":",'"%d",:msg]
+  msg' := flowSegmentedMsg(msg,$LINELENGTH,$MARGIN)
+  if $printMsgsToFile then sayMSG2File msg'
+  sayMSG msg'
+
+throwKeyedErrorMsg(kind,key,args) ==
+  BUMPERRORCOUNT kind
+  sayMSG '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayKeyedMsg(key,args)
+  spadThrow()
+
+throwKeyedMsgSP(key,args,atree) ==
+    if atree and (sp := getSrcPos(atree)) then
+        sayMSG '" "
+        srcPosDisplay(sp)
+    throwKeyedMsg(key,args)
+
+throwKeyedMsg(key,args) ==
+  $saturn => saturnThrowKeyedMsg(key, args)
+  throwKeyedMsg1(key, args)
+
+saturnThrowKeyedMsg(key,args) ==
+  _*STANDARD_-OUTPUT_* : fluid := $texOutputStream
+  last := pushSatOutput("line")
+  sayString '"\bgroup\color{red}\begin{list}\item{} "
+  sayKeyedMsgAsTeX(key,args)
+  sayString '"\end{list}\egroup"
+  popSatOutput(last)
+  spadThrow()
+
+throwKeyedMsg1(key,args) ==
+  _*STANDARD_-OUTPUT_* : fluid := $texOutputStream
+  sayMSG '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayKeyedMsg(key,args)
+  spadThrow()
+
+throwListOfKeyedMsgs(descKey,descArgs,l) ==
+  -- idea is that descKey and descArgs are the message describing
+  -- what the list is about and l is a list of [key,args] messages
+  -- the messages in the list are numbered and should have a %1 as
+  -- the first token in the message text.
+  sayMSG '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayKeyedMsg(descKey,descArgs)
+  sayMSG '" "
+  for [key,args] in l for i in 1.. repeat
+    n := STRCONC(object2String i,'".")
+    sayKeyedMsg(key,[n,:args])
+  spadThrow()
+
+--  breakKeyedMsg is like throwKeyedMsg except that the user is given
+--  a chance to play around in a break loop if $BreakMode is not 'nobreak
+
+breakKeyedMsg(key,args) ==
+  BUMPCOMPERRORCOUNT()
+  sayKeyedMsg(key,args)
+  handleLispBreakLoop($BreakMode)
+
+keyedSystemError(key,args) ==
+  $saturn => saturnKeyedSystemError(key, args)
+  keyedSystemError1(key, args)
+
+saturnKeyedSystemError(key, args) ==
+  _*STANDARD_-OUTPUT_* : fluid := $texOutputStream
+  sayString '"\bgroup\color{red}"
+  sayString '"\begin{verbatim}"
+  sayKeyedMsg("S2GE0000",NIL)
+  BUMPCOMPERRORCOUNT()
+  sayKeyedMsgAsTeX(key,args)
+  sayString '"\end{verbatim}"
+  sayString '"\egroup"
+  handleLispBreakLoop($BreakMode)
+
+keyedSystemError1(key,args) ==
+  sayKeyedMsg("S2GE0000",NIL)
+  breakKeyedMsg(key,args)
+
+-- these 2 functions control the mode of saturn output.
+-- having the stream writing functions control this would
+-- be better (eg. sayText, sayCommands)
+
+pushSatOutput(arg) ==
+  $saturnMode = arg => arg
+  was := $saturnMode
+  arg = "verb" => 
+    $saturnMode := "verb"
+    sayString '"\begin{verbatim}"
+    was
+  arg = "line" =>
+    $saturnMode := "line"
+    sayString '"\end{verbatim}"
+    was
+  sayString FORMAT(nil, '"What is: ~a", $saturnMode)
+  $saturnMode
+ 
+popSatOutput(newmode) == 
+  newmode = $saturnMode => nil
+  newmode = "verb" => 
+    $saturnMode := "verb"
+    sayString '"\begin{verbatim}"
+  newmode = "line" =>
+    $saturnMode := "line"
+    sayString '"\end{verbatim}"
+  sayString FORMAT(nil, '"What is: ~a", $saturnMode)
+  $saturnMode
+
+systemErrorHere functionName ==
+  keyedSystemError("S2GE0017",[functionName])
+
+isKeyedMsgInDb(key,dbName) ==
+  $msgDatabaseName : fluid := pathname dbName
+  fetchKeyedMsg(key,true)
+
+getKeyedMsgInDb(key,dbName) ==
+  $msgDatabaseName : fluid := pathname dbName
+  fetchKeyedMsg(key,false)
+
+sayKeyedMsgFromDb(key,args,dbName) ==
+  $msgDatabaseName : fluid := pathname dbName
+  msg := segmentKeyedMsg getKeyedMsg key
+  msg := substituteSegmentedMsg(msg,args)
+  if $displayMsgNumber then msg := ['"%b",key,":",'%d,:msg]
+--sayMSG flowSegmentedMsg(msg,$LINELENGTH,3)
+  u := flowSegmentedMsg(msg,$LINELENGTH,3)
+  sayBrightly u
+
+returnStLFromKey(key,argL,:optDbN) ==
+    savedDbN := $msgDatabaseName
+    if IFCAR optDbN then
+        $msgDatabaseName := pathname CAR optDbN
+    text := fetchKeyedMsg(key, false)
+    $msgDatabaseName := savedDbN
+    text := segmentKeyedMsg text
+    text := substituteSegmentedMsg(text,argL)
+
+throwKeyedMsgFromDb(key,args,dbName) ==
+  sayMSG '" "
+  if $testingSystem then sayMSG $testingErrorPrefix
+  sayKeyedMsgFromDb(key,args,dbName)
+  spadThrow()
+
+queryUserKeyedMsg(key,args) ==
+  -- display message and return reply
+  conStream := DEFIOSTREAM ('((DEVICE . CONSOLE) (MODE . INPUT)),120,0)
+  sayKeyedMsg(key,args)
+  ans := READ_-LINE conStream
+  SHUT conStream
+  ans
+
+flowSegmentedMsg(msg, len, offset) ==
+  -- tries to break a sayBrightly-type input msg into multiple
+  -- lines, with offset and given length.
+  -- msgs that are entirely centered or right justified are not flowed
+  msg is [[ce,:.]] and ce in '(%ce "%ce" %rj "%rj") => msg
+
+  -- if we are formatting latex, then we assume 
+  -- that nothing needs to be done
+  $texFormatting => msg
+  -- msgs that are entirely centered are not flowed
+  msg is [[ce,:.]] and ListMember?(ce,'(%ce "%ce")) => msg
+ 
+  potentialMarg := 0
+  actualMarg    := 0
+
+  off := (offset <= 0 => '""; fillerSpaces(offset,'" "))
+  off1:= (offset <= 1 => '""; fillerSpaces(offset-1,'" "))
+  firstLine := true
+
+  PAIRP msg =>
+    lnl := offset
+    if msg is [a,:.] and a in '(%b %d _  "%b" "%d" " ") then
+      nl :=  [off1]
+      lnl := lnl - 1
+    else nl := [off]
+    for f in msg repeat
+      f in '("%l" %l) =>
+        actualMarg := potentialMarg
+        if lnl = 99999 then nl := ['%l,:nl]
+        lnl := 99999
+      PAIRP(f) and CAR(f) in '("%m" %m '%ce "%ce" %rj "%rj") =>
+        actualMarg := potentialMarg
+        nl := [f,'%l,:nl]
+        lnl := 199999
+      f in '("%i" %i ) =>
+        potentialMarg := potentialMarg + 3
+        nl := [f,:nl]
+      PAIRP(f) and CAR(f) in '("%t" %t) =>
+        potentialMarg := potentialMarg + CDR f
+        nl := [f,:nl]
+      sbl := sayBrightlyLength f
+      tot := lnl + offset + sbl + actualMarg
+      if firstLine then
+        firstLine  := false
+        offset := offset + offset
+        off1   := STRCONC(off, off1)
+        off    := STRCONC(off, off)
+      if (tot <= len) or (sbl = 1 and tot = len) then
+        nl := [f,:nl]
+        lnl := lnl + sbl
+      else
+        f in '(%b %d _  "%b" "%d" " ") =>
+          nl := [f,off1,'%l,:nl]
+          actualMarg := potentialMarg
+          lnl := -1 + offset + sbl
+        nl := [f,off,'%l,:nl]
+        lnl := offset + sbl
+    concat nreverse nl
+  concat('%l,off,msg)
+
+--% Other handy things
+
+keyedMsgCompFailure(key,args) ==
+  -- Called when compilation fails in such a way that interpret-code
+  --  mode might be of some use.
+  not $useCoerceOrCroak =>   THROW('coerceOrCroaker, 'croaked)
+  if not($Coerce) and  $reportInterpOnly then
+    sayKeyedMsg(key,args)
+    sayKeyedMsg("S2IB0009",NIL)
+  null $compilingMap => THROW('loopCompiler,'tryInterpOnly)
+  THROW('mapCompiler,'tryInterpOnly)
+
+keyedMsgCompFailureSP(key,args,atree) ==
+  -- Called when compilation fails in such a way that interpret-code
+  --  mode might be of some use.
+  not $useCoerceOrCroak =>   THROW('coerceOrCroaker, 'croaked)
+  if not($Coerce) and  $reportInterpOnly then
+    if atree and (sp := getSrcPos(atree)) then
+        sayMSG '" "
+        srcPosDisplay(sp)
+    sayKeyedMsg(key,args)
+    sayKeyedMsg("S2IB0009",NIL)
+  null $compilingMap => THROW('loopCompiler,'tryInterpOnly)
+  THROW('mapCompiler,'tryInterpOnly)
+
+throwKeyedMsgCannotCoerceWithValue(val,t1,t2) ==
+  null (val' := coerceInteractive(mkObj(val,t1),$OutputForm)) =>
+    throwKeyedMsg("S2IC0002",[t1,t2])
+  val' := objValUnwrap(val')
+  throwKeyedMsg("S2IC0003",[t1,t2,val'])
+
+--% Some Standard Message Printing Functions
+
+bright x == ['"%b",:(PAIRP(x) and NULL CDR LASTNODE x => x; [x]),'"%d"]
+--bright x == ['%b,:(ATOM x => [x]; x),'%d]
+
+mkMessage msg ==
+  msg and (PAIRP msg) and ((first msg) in '(%l "%l"))  and
+    ((last msg) in '(%l "%l")) => concat msg
+  concat('%l,msg,'%l)
+
+sayMessage msg == sayMSG mkMessage msg
+
+sayNewLine(:margin) ==
+  -- Note: this function should *always* be used by sayBrightly and
+  -- friends rather than TERPRI --  see bindSayBrightly
+  TERPRI()
+  if margin is [n] then BLANKS n
+  nil
+
+sayString x ==
+  -- Note: this function should *always* be used by sayBrightly and
+  -- friends rather than PRINTEXP --  see bindSayBrightly
+  PRINTEXP x
+
+spadStartUpMsgs() ==
+  -- messages displayed when the system starts up
+  $LINELENGTH < 60 => NIL
+  bar := fillerSpaces($LINELENGTH,specialChar 'hbar)
+  sayKeyedMsg("S2GL0001",[_*BUILD_-VERSION_*, _*YEARWEEK_*])
+  sayMSG bar
+  sayKeyedMsg("S2GL0018C",NIL)
+  sayKeyedMsg("S2GL0018D",NIL)
+  sayKeyedMsg("S2GL0003B",[$opSysName])
+  sayMSG bar
+--  sayMSG bar
+--  sayMSG '"                                    *"
+--  sayMSG '"               *****    **     **  ***     ******    ** *     *"
+--  sayMSG '"              *     *     *   *     *     *      *    ** ** ** **"
+--  sayMSG '"                    *      * *      *    *        *   **  ***  **"
+--  sayMSG '"               ******       *       *   *          *  *    *    *"
+--  sayMSG '"              *     *      * *      *    *        *   *    *    *"
+--  sayMSG '"              *     *     *   *     *     *      *    *    *    *"
+--  sayMSG '"              *     *    *     *    *      *    *     *    *    *"
+--  sayMSG '"               ***** * **       ** ***      ****     **   ***  ***"
+--  sayMSG '"                                    *"
+--  sayMSG '"   Issue )copyright for copyright notices."
+--  sayKeyedMsg("S2GL0018A",NIL)
+--  sayKeyedMsg("S2GL0018B",NIL)
+--  sayKeyedMsg("S2GL0003C",NIL)
+--  sayKeyedMsg("S2GL0003A",NIL)
+--  if not $printTimeIfTrue then sayKeyedMsg("S2GL0004",NIL)
+--  if not $printTypeIfTrue then sayKeyedMsg("S2GL0005",NIL)
+  --  if not $displaySetValue then sayKeyedMsg("S2GL0007",NIL)
+--  if not $HiFiAccess then sayKeyedMsg("S2GL0008",NIL)
+--  sayMSG bar
+--  version()
+  $msgAlist := NIL    -- these msgs need not be saved
+  sayMSG " "
+
+HELP() == sayKeyedMsg("S2GL0019",NIL)
+
+version() == _*YEARWEEK_*
+
+--% Some Advanced Formatting Functions
+
+brightPrint x ==
+  $MARG : local := 0
+  for y in x repeat brightPrint0 y
+  NIL
+
+brightPrint0 x ==
+  $texFormatting => brightPrint0AsTeX x
+  if IDENTP x then x := PNAME x
+
+  -- if the first character is a backslash and the second is a percent sign,
+  -- don't try to give the token any special interpretation. Just print
+  -- it without the backslash.
+
+  STRINGP x and STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" =>
+    sayString SUBSTRING(x,1,NIL)
+  x = '"%l" =>
+    sayNewLine()
+    for i in 1..$MARG repeat sayString '" "
+  x = '"%i" =>
+    $MARG := $MARG + 3
+  x = '"%u" =>
+    $MARG := $MARG - 3
+    if $MARG < 0 then $MARG := 0
+  x = '"%U" =>
+    $MARG := 0
+  x = '"%" =>
+    sayString '" "
+  x = '"%%" =>
+    sayString  '"%"
+  x = '"%b" =>
+    NULL IS_-CONSOLE CUROUTSTREAM => sayString '" "
+    NULL $highlightAllowed        => sayString '" "
+    sayString $highlightFontOn
+  k := blankIndicator x => BLANKS k
+  x = '"%d" =>
+    NULL IS_-CONSOLE CUROUTSTREAM => sayString '" "
+    NULL $highlightAllowed        => sayString '" "
+    sayString $highlightFontOff
+  STRINGP x => sayString x
+  brightPrintHighlight x
+
+brightPrint0AsTeX x == 
+  x = '"%l" =>
+    sayString('"\\")
+    for i in 1..$MARG repeat sayString '"\ "
+  x = '"%i" =>
+    $MARG := $MARG + 3
+  x = '"%u" =>
+    $MARG := $MARG - 3
+    if $MARG < 0 then $MARG := 0
+  x = '"%U" =>
+    $MARG := 0
+  x = '"%" =>
+    sayString '"\ "
+  x = '"%%" =>
+    sayString  '"%"
+  x = '"%b" =>
+    sayString '" {\tt "
+  k := blankIndicator x => for i in 1..k repeat sayString '"\ "
+  x = '"%d" =>
+    sayString '"} "
+  x = '"_"$_"" => 
+    sayString('"_"\verb!$!_"")
+  x = '"$" => 
+    sayString('"\verb!$!")
+  STRINGP x => sayString x
+  brightPrintHighlight x
+
+blankIndicator x ==
+  if IDENTP x then x := PNAME x
+  null STRINGP x or MAXINDEX x < 1 => nil
+  x.0 = '% and x.1 = 'x =>
+    MAXINDEX x > 1 => PARSE_-INTEGER SUBSTRING(x,2,nil)
+    1
+  nil
+
+brightPrint1 x ==
+  if x in '(%l "%l") then sayNewLine()
+  else if STRINGP x then sayString x
+       else brightPrintHighlight x
+  NIL
+
+brightPrintHighlight x ==
+  $texFormatting => brightPrintHighlightAsTeX x
+  IDENTP x =>
+    pn := PNAME x
+    sayString pn
+  -- following line helps find certain bugs that slip through
+  -- also see sayBrightlyLength1
+  VECP x => sayString '"UNPRINTABLE"
+  ATOM x => sayString object2String x
+  [key,:rst] := x
+  if IDENTP key then key:=PNAME key
+  key = '"%m" => mathprint rst
+  key in '("%p" "%s") => PRETTYPRIN0 rst
+  key = '"%ce" => brightPrintCenter rst
+  key = '"%rj" => brightPrintRightJustify rst
+  key = '"%t"  => $MARG := $MARG + tabber rst
+  sayString '"("
+  brightPrint1 key
+  if EQ(key,'TAGGEDreturn) then
+    rst:=[CAR rst,CADR rst,CADDR rst, '"environment (omitted)"]
+  for y in rst repeat
+    sayString '" "
+    brightPrint1 y
+  if rst and (la := LASTATOM rst) then
+    sayString '" . "
+    brightPrint1 la
+  sayString '")"
+
+brightPrintHighlightAsTeX x ==
+  IDENTP x =>
+    pn := PNAME x
+    sayString pn
+  ATOM x => sayString object2String x
+  VECP x => sayString '"UNPRINTABLE"
+  [key,:rst] := x
+  key = '"%m" => mathprint rst
+  key = '"%m" => rst
+  key = '"%s" => 
+    sayString '"\verb__"
+    PRETTYPRIN0 rst
+    sayString '"__"
+  key = '"%ce" => brightPrintCenter rst
+  key = '"%t"  => $MARG := $MARG + tabber rst
+  -- unhandled junk (print verbatim(ish)
+  sayString '"("
+  brightPrint1 key
+  if EQ(key,'TAGGEDreturn) then
+    rst:=[CAR rst,CADR rst,CADDR rst, '"environment (omitted)"]
+  for y in rst repeat
+    sayString '" "
+    brightPrint1 y
+  if rst and (la := LASTATOM rst) then
+    sayString '" . "
+    brightPrint1 la
+  sayString '")"
+
+tabber num ==
+    maxTab := 50
+    num > maxTab => maxTab
+    num
+
+brightPrintCenter x ==
+  $texFormatting => brightPrintCenterAsTeX x
+  -- centers rst within $LINELENGTH, checking for %l's
+  ATOM x =>
+    x := object2String x
+    wid := STRINGLENGTH x
+    if wid < $LINELENGTH then
+      f := DIVIDE($LINELENGTH - wid,2)
+      x := LIST(fillerSpaces(f.0,'" "),x)
+    for y in x repeat brightPrint0 y
+    NIL
+  y := NIL
+  ok := true
+  while x and ok repeat
+    if CAR(x) in '(%l "%l") then ok := NIL
+    else y := cons(CAR x, y)
+    x := CDR x
+  y := NREVERSE y
+  wid := sayBrightlyLength y
+  if wid < $LINELENGTH then
+    f := DIVIDE($LINELENGTH - wid,2)
+    y := CONS(fillerSpaces(f.0,'" "),y)
+  for z in y repeat brightPrint0 z
+  if x then
+    sayNewLine()
+    brightPrintCenter x
+  NIL
+
+brightPrintCenterAsTeX x ==
+  ATOM x =>
+    sayString '"\centerline{"
+    sayString x
+    sayString '"}"
+  lst := x
+  while lst repeat 
+    words := nil
+    while lst and not CAR(lst) = "%l" repeat
+      words := [CAR lst,: words]
+      lst := CDR lst
+    if lst then lst := cdr lst
+    sayString '"\centerline{"
+    words := nreverse words
+    for zz in words repeat
+      brightPrint0 zz
+    sayString '"}"
+  nil 
+
+brightPrintRightJustify x ==
+  -- right justifies rst within $LINELENGTH, checking for %l's
+  ATOM x =>
+    x := object2String x
+    wid := STRINGLENGTH x
+    wid < $LINELENGTH =>
+      x := LIST(fillerSpaces($LINELENGTH-wid,'" "),x)
+      for y in x repeat brightPrint0 y
+      NIL
+    brightPrint0 x
+    NIL
+  y := NIL
+  ok := true
+  while x and ok repeat
+    if CAR(x) in '(%l "%l") then ok := NIL
+    else y := cons(CAR x, y)
+    x := CDR x
+  y := NREVERSE y
+  wid := sayBrightlyLength y
+  if wid < $LINELENGTH then
+    y := CONS(fillerSpaces($LINELENGTH-wid,'" "),y)
+  for z in y repeat brightPrint0 z
+  if x then
+    sayNewLine()
+    brightPrintRightJustify x
+  NIL
+
+-- some hooks for older functions
+
+--------------------> NEW DEFINITION (see macros.lisp.pamphlet)
+BRIGHTPRINT x == brightPrint x
+--------------------> NEW DEFINITION (see macros.lisp.pamphlet)
+BRIGHTPRINT_-0 x == brightPrint0 x
+
+--% Message Formatting Utilities
+
+sayBrightlyLength l ==
+  null l => 0
+  atom l => sayBrightlyLength1 l
+  sayBrightlyLength1 first l + sayBrightlyLength rest l
+
+sayBrightlyLength1 x ==
+  member(x,'("%b" "%d" %b %d)) =>
+    NULL $highlightAllowed => 1
+    1
+  member(x,'("%l" %l)) => 0
+  STRINGP x and STRINGLENGTH x > 2 and x.0 = '"%" and x.1 = '"x" =>
+    INTERN x.3
+  STRINGP x => STRINGLENGTH x
+  IDENTP x => STRINGLENGTH PNAME x
+  -- following line helps find certain bugs that slip through
+  -- also see brightPrintHighlight
+  VECP x => STRINGLENGTH '"UNPRINTABLE"
+  ATOM x => STRINGLENGTH STRINGIMAGE x
+  2 + sayBrightlyLength x
+
+sayAsManyPerLineAsPossible l ==
+  -- it is assumed that l is a list of strings
+  l := [atom2String a for a in l]
+  m := 1 + "MAX"/[SIZE(a) for a in l]
+  -- w will be the field width in which we will display the elements
+  m > $LINELENGTH =>
+    for a in l repeat sayMSG a
+    NIL
+  w := MIN(m + 3,$LINELENGTH)
+  -- p is the number of elements per line
+  p := QUOTIENT($LINELENGTH,w)
+  n := # l
+  str := '""
+  for i in 0..(n-1) repeat
+    [c,:l] := l
+    str := STRCONC(str,c,fillerSpaces(w - #c,'" "))
+    REMAINDER(i+1,p) = 0 => (sayMSG str ; str := '"" )
+  if str ^= '"" then sayMSG str
+  NIL
+
+say2PerLine l == say2PerLineWidth(l,$LINELENGTH / 2)
+
+say2PerLineWidth(l,n) ==
+  [short,long] := say2Split(l,nil,nil,n)
+  say2PerLineThatFit short
+  for x in long repeat sayLongOperation x
+  sayBrightly '""
+
+say2Split(l,short,long,width) ==
+  l is [x,:l'] =>
+    sayWidth x < width => say2Split(l',[x,:short],long,width)
+    say2Split(l',short,[x,:long],width)
+  [nreverse short,nreverse long]
+
+sayLongOperation x ==
+  sayWidth x > $LINELENGTH and (splitListOn(x,"if") is [front,back]) =>
+    sayBrightly front
+    BLANKS (6 + # PNAME front.1)
+    sayBrightly back
+  sayBrightly x
+
+splitListOn(x,key) ==
+  key in x =>
+    while first x ^= key repeat
+      y:= [first x,:y]
+      x:= rest x
+    [nreverse y,x]
+  nil
+
+say2PerLineThatFit l ==
+  while l repeat
+    sayBrightlyNT first l
+    sayBrightlyNT
+      fillerSpaces((($LINELENGTH/2)-sayDisplayWidth first l),'" ")
+    (l:= rest l) =>
+      sayBrightlyNT first l
+      l:= rest l
+      sayBrightly '""
+    sayBrightly '""
+
+sayDisplayStringWidth x ==
+  null x => 0
+  sayDisplayWidth x
+
+sayDisplayWidth x ==
+  PAIRP x =>
+    +/[fn y for y in x] where fn y ==
+      y in '(%b %d "%b" "%d") or y=$quadSymbol => 1
+      k := blankIndicator y => k
+      sayDisplayWidth y
+  x = "%%" or x = '"%%" => 1
+  # atom2String x
+
+sayWidth x ==
+  atom x => # atom2String x
+  +/[fn y for y in x] where fn y ==
+    sayWidth y
+
+pp2Cols(al) ==
+  while al repeat
+    [[abb,:name],:al]:= al
+    ppPair(abb,name)
+    if canFit2ndEntry(name,al) then
+      [[abb,:name],:al]:= al
+      TAB ($LINELENGTH / 2)
+      ppPair(abb,name)
+    sayNewLine()
+  nil
+
+ppPair(abb,name) ==
+    sayBrightlyNT [:bright abb,fillerSpaces(8-entryWidth abb," "),name]
+
+canFit2ndEntry(name,al) ==
+  wid := ($LINELENGTH/2) - 10
+  null al => nil
+  entryWidth name > wid => nil
+  entryWidth CDAR al > wid => nil
+  'T
+
+entryWidth x == # atom2String x
+
+center80 text == centerNoHighlight(text,$LINELENGTH,'" ")
+
+centerAndHighlight(text,:argList) ==
+  width := IFCAR argList or $LINELENGTH
+  fillchar := IFCAR IFCDR argList or '" "
+  wid := entryWidth text + 2
+  wid >= width - 2 => sayBrightly ['%b,text,'%d]
+  f := DIVIDE(width - wid - 2,2)
+  fill1 := '""
+  for i in 1..(f.0) repeat
+    fill1 := STRCONC(fillchar,fill1)
+  if f.1 = 0 then fill2 := fill1 else fill2 := STRCONC(fillchar,fill1)
+  sayBrightly [fill1,'%b,text,'%d,fill2]
+  nil
+
+centerNoHighlight(text,:argList) == sayBrightly center(text,argList)
+
+center(text,argList) ==
+  width := IFCAR argList or $LINELENGTH
+  fillchar := IFCAR IFCDR argList or '" "
+  if (u:= splitSayBrightlyArgument text) then [text,:moreLines]:= u
+  wid := sayBrightlyLength text
+  wid >= width - 2 => sayBrightly text
+  f := DIVIDE(width - wid - 2,2)
+  fill1 := '""
+  for i in 1..(f.0) repeat
+    fill1 := STRCONC(fillchar,fill1)
+  if f.1 = 0 then fill2 := fill1 else fill2 := STRCONC(fillchar,fill1)
+  concat(fill1,text,fill2)
+
+splitSayBrightly u ==
+  width:= 0
+  while u and (width:= width + sayWidth first u) < $LINELENGTH repeat
+    segment:= [first u,:segment]
+    u := rest u
+  null u => NREVERSE segment
+  segment => [:NREVERSE segment,"%l",:splitSayBrightly(u)]
+  u
+
+splitSayBrightlyArgument u ==
+  atom u => nil
+  while splitListSayBrightly u is [head,:u] repeat result:= [head,:result]
+  result => [:NREVERSE result,u]
+  [u]
+
+splitListSayBrightly u ==
+  for x in tails u repeat
+    y := rest x
+    null y => nil
+    first y = '%l =>
+      RPLACD(x,nil)
+      ans:= [u,:rest y]
+  ans
+
+
+--=======================================================================
+--                Utility Functions
+--=======================================================================
+
+$htSpecialChars := ['"_#", '"[", '"]", '"%", '"{", '"}", '"_\",
+                    '"$", '"&", '"^", '"__", '"_~"]
+
+$htCharAlist := '(
+  ("$"  . "\%")
+  ("[]" . "\[\]")
+  ("{}" . "\{\}")
+  ("\\" . "\\\\")
+  ("\/" . "\\/" )
+  ("/\" . "/\\" ) )
+
+escapeSpecialChars s ==
+  u := LASSOC(s,$htCharAlist) => u
+  member(s, $htSpecialChars) => STRCONC('"_\", s)
+  null $saturn => s
+  ALPHA_-CHAR_-P (s.0) => s
+  not (or/[dbSpecialDisplayOpChar? s.i for i in 0..MAXINDEX s]) => s
+  buf := '""
+  for i in 0..MAXINDEX s repeat buf :=
+    dbSpecialDisplayOpChar?(s.i) => STRCONC(buf,'"\verb!",s.i,'"!")
+    STRCONC(buf,s.i)
+  buf
+
+dbSpecialDisplayOpChar? c == (c = char '_~)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-c02.boot.pamphlet b/src/interp/nag-c02.boot.pamphlet
new file mode 100644
index 00000000..ed5821e7
--- /dev/null
+++ b/src/interp/nag-c02.boot.pamphlet
@@ -0,0 +1,316 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-c02.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+c02aff() ==
+  htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc02aff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02aff| '|NagPolynomialRootsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Finds all the roots of the complex polynomial equation ")
+    (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} ")
+    (text . "\tab{2} Enter the degree {\em n} of the polynomial:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 5 n PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\newline \menuitemstyle{} \tab{2} Scale value:")
+    (radioButtons scale
+	("" "  True" true)
+        ("" "  False" false))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c02affSolve)
+  htShowPage()
+
+c02affSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  logical := htpButtonValue(htPage,'scale)
+  scale := 
+    logical = 'true => '"true"
+    '"false"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '5 => c02affDefaultSolve(htPage,scale,ifail)
+  labelList :=
+    "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) ==
+      prefix := ('"\newline z**")
+      prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") 
+      post   := ('"\tab{30} ")
+      post   := STRCONC(post,'"\space{1}")
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      inam := INTERN STRCONC ('"i",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], 
+       ['text,:post],['bcStrings,[10, 0.0, inam, 'P]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("C02AFF - All Zeros of a Complex Polynomial", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} Enter the coefficients of the polynomial: "
+  htSay '"\blankline "
+  htSay '"Real parts \tab{30} Imaginary parts "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c02affGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'scale,scale)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c02affDefaultSolve (htPage, scale, ifail) ==
+  n := '5
+  page := htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Enter the coefficients of the polynomial: ")
+    (text . "\blankline ")
+    (text . "Real parts \tab{30} Imaginary parts ")
+    (text . "\newline z**5 \space{1} ")
+    (bcStrings (10 "5.0" r1 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "6.0" i1 F))
+    (text . "\newline ")
+    (text . "z**4 \space{1} ")
+    (bcStrings (10 "30.0" r2 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "20.0" i2 F))
+    (text . "\newline ")
+    (text . "z**3 \space{1} ")
+    (bcStrings (10 "-0.2" r3 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "-6.0" i3 F))
+    (text . "\newline ")
+    (text . "z**2 \space{1} ")
+    (bcStrings (10 "50.0" r4 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "100000.0" i4 F))
+    (text . "\newline ")
+    (text . "z**1 \space{1} ")
+    (bcStrings (10 "-2.0" r5 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "40.0" i5 F))
+    (text . "\newline ")
+    (text . "z**0 \space{1} ")
+    (bcStrings (10 "10.0" r6 F))
+    (text . "\tab{30} ")
+    (text . "\space{1} ")
+    (bcStrings (10 "1.0" i6 F))
+    (text . "\newline ")
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c02affGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'scale,scale)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c02affGen htPage ==
+  n := htpProperty(htPage,'n)
+  scale := htpProperty(htPage,'scale)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC((first y).1," ")
+    y := rest y
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  linkGen STRCONC ('"c02aff([",realstring,",",imagstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")")
+
+c02agf() ==
+  htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc02agf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02agf| '|NagPolynomialRootsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Finds all the roots of the real polynomial equation ")
+    (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} ")
+    (text . "\tab{2} Enter the degree {\em n} of the polynomial:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 5 n PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\newline \menuitemstyle{} \tab{2} Scale value:")
+    (radioButtons scale
+	("" "  True" true)
+        ("" "  False" false))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c02agfSolve)
+  htShowPage()
+
+c02agfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  logical := htpButtonValue(htPage,'scale)
+  scale := 
+    logical = 'true => '"true"
+    '"false"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '5 => c02agfDefaultSolve(htPage,scale,ifail)
+  labelList :=
+    "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) ==
+      prefix := ('"\newline z**")
+      prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") 
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]]]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("C02AGF - All Zeros of a Real Polynomial", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the coefficients of the polynomial: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c02agfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'scale,scale)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c02agfDefaultSolve (htPage, scale, ifail) ==
+  n := '5
+  page := htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Enter the coefficients of the polynomial: ")
+    (text . "\newline ")
+    (text . "z**5 \space{1} ")
+    (bcStrings (10 "1.0" r1 F))
+    (text . "\newline ")
+    (text . "z**4 \space{1} ")
+    (bcStrings (10 "2.0" r2 F))
+    (text . "\newline ")
+    (text . "z**3 \space{1} ")
+    (bcStrings (10 "3.0" r3 F))
+    (text . "\newline ")
+    (text . "z**2 \space{1} ")
+    (bcStrings (10 "4.0" r4 F))
+    (text . "\newline ")
+    (text . "z**1 \space{1} ")
+    (bcStrings (10 "5.0" r5 F))
+    (text . "\newline ")
+    (text . "z**0 \space{1} ")
+    (bcStrings (10 "6.0" r6 F))
+    (text . "\newline ")
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c02agfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'scale,scale)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c02agfGen htPage ==
+  n := htpProperty(htPage,'n)
+  scale := htpProperty(htPage,'scale)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c02agf([",realstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")")
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-c05.boot.pamphlet b/src/interp/nag-c05.boot.pamphlet
new file mode 100644
index 00000000..8b49400d
--- /dev/null
+++ b/src/interp/nag-c05.boot.pamphlet
@@ -0,0 +1,424 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-c05.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+c05adf() ==
+  htInitPage('"C05ADF - Zero of continuous function in given interval, Bus and Dekker algorithm",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXc05adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05adf| '|NagRootFindingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "C05ADF locates a zero of a continuous function in a ")
+    (text . "interval by a combination of the methods of linear ")
+    (text . "interpolation, extrapolation and bisection. ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the function whose zero is to be determined ")
+    (text . "as a function of X, {\it f}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (55 "exp(-X)-X" expression EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Lower bound of the interval {\it a}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Upper bound {\it b}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0" b F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute tolerance {\it eps}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Value tolerance {\it eta}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-5" eps F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.0" eta F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c05adfGen)
+  htShowPage()
+
+c05adfGen htPage ==
+  a     := htpLabelInputString(htPage,'a)
+  b     := htpLabelInputString(htPage,'b)
+  eps   := htpLabelInputString(htPage,'eps)
+  eta   := htpLabelInputString(htPage,'eta)  
+  temp  := READ_-FROM_-STRING(eps) 
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  temp1 :=
+    temp >  0.0 => eps
+    '"1.0e-5"
+  expression := htpLabelInputString(htPage, 'expression)
+  prefix := STRCONC('"c05adf(",a,",",b,",",temp1,",",eta,",",STRINGIMAGE ifail)
+  linkGen STRCONC (prefix,",(",expression,")::ASP1(F))")
+
+
+c05nbf() ==
+  htInitPage('"C05NBF - Solution of system of nonlinear equations using function values only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc05nbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05nbf| '|NagRootFindingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "C05NBF finds a solution of a system of nonlinear equations ")
+    (text . "by a modification of the Powell hybrid method. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of equations in the system {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Accuracy required {\it xtol}:")
+    (text . "\newline\tab{2} ")
+    -- should be sqrt(machine precision)
+    (bcStrings (10 "1.0e-9" xtol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c05nbfSolve)
+  htShowPage()
+
+c05nbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  xtol := htpLabelInputString(htPage,'xtol)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '9 => c05nbfDefaultSolve(htPage,ifail,xtol)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 1")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x}: \newline ")
+  middle := cons('text,middle)
+  vecList := 
+    [fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ['bcStrings,[4, -1.0, xnam, 'F]]
+  funcList := [:funcList,middle,:vecList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain F (Float))
+	    (isDomain I (Integer))),
+ 		:funcList]
+  page := htInitPage("C05NBF - Solution of system of nonlinear equations using function values only", htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c05nbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'xtol,xtol)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c05nbfDefaultSolve (htPage,ifail,xtol) ==
+  n := '9
+  page := htInitPage("C05NBF - Solution of system of nonlinear equations using function values only", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]; ")
+    (text . " \newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x}: \newline ")
+    (bcStrings (4 "-1.0" x1 F))
+    (bcStrings (4 "-1.0" x2 F))
+    (bcStrings (4 "-1.0" x3 F))
+    (bcStrings (4 "-1.0" x4 F))
+    (bcStrings (4 "-1.0" x5 F))
+    (bcStrings (4 "-1.0" x6 F))
+    (bcStrings (4 "-1.0" x7 F))
+    (bcStrings (4 "-1.0" x8 F))
+    (bcStrings (4 "-1.0" x9 F)))
+  htMakeDoneButton('"Continue",'c05nbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'xtol,xtol)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c05nbfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  ifail := htpProperty(htPage,'ifail)
+  xtol := htpProperty(htPage,'xtol)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  i := 1
+  while y repeat
+    if i < (n+1) then 
+      temp1 := STRCONC ((first y).1," ")
+      temp1list := [temp1,:temp1list]	
+    else
+      temp2 := (first y).1
+      temp2list := [temp2,:temp2list]	
+    y := rest y
+    i := i + 1
+  string1 := bcwords2liststring temp1list
+  string2 := bcwords2liststring temp2list
+  lwa := n*(3*n+13)/2
+  prefix := STRCONC ("c05nbf(",STRINGIMAGE n,",",STRINGIMAGE lwa,",[",string1,"],")
+  middle := STRCONC (xtol,",",STRINGIMAGE ifail,",")
+  linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP6(FCN))")
+
+c05pbf() ==
+  htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc05pbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05pbf| '|NagRootFindingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "C05PBF finds a solution of a system of nonlinear equations ")
+    (text . "by a modification of the Powell hybrid method. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of equations in the system {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Accuracy required {\it xtol}:")
+    (text . "\newline\tab{2} ")
+    -- should be sqrt(machine precision)
+    (bcStrings (10 "1.0e-9" xtol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c05pbfSolve)
+  htShowPage()
+
+c05pbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  xtol := htpLabelInputString(htPage,'xtol)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '9 => c05pbfDefaultSolve(htPage,ifail,xtol)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 1")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x}: \newline ")
+  middle := cons('text,middle)
+  vecList := 
+    [fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ['bcStrings,[4, -1.0, xnam, 'F]]
+  funcList := [:funcList,middle,:vecList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain F (Float))
+	    (isDomain I (Integer))),
+ 		:funcList]
+  page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c05pbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'xtol,xtol)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c05pbfDefaultSolve (htPage,ifail,xtol) ==
+  n := '9
+  page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x}: \newline ")
+    (bcStrings (4 "-1.0" x1 F))
+    (bcStrings (4 "-1.0" x2 F))
+    (bcStrings (4 "-1.0" x3 F))
+    (bcStrings (4 "-1.0" x4 F))
+    (bcStrings (4 "-1.0" x5 F))
+    (bcStrings (4 "-1.0" x6 F))
+    (bcStrings (4 "-1.0" x7 F))
+    (bcStrings (4 "-1.0" x8 F))
+    (bcStrings (4 "-1.0" x9 F)))
+  htMakeDoneButton('"Continue",'c05pbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'xtol,xtol)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c05pbfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  ifail := htpProperty(htPage,'ifail)
+  xtol := htpProperty(htPage,'xtol)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  i := 1
+  while y repeat
+    if i < (n+1) then 
+      temp1 := STRCONC ((first y).1," ")
+      temp1list := [temp1,:temp1list]	
+    else
+      temp2 := (first y).1
+      temp2list := [temp2,:temp2list]	
+    y := rest y
+    i := i + 1
+  string1 := bcwords2liststring temp1list
+  string2 := bcwords2liststring temp2list
+  lwa := n*(n+13)/2
+  prefix := STRCONC("c05pbf(",STRINGIMAGE n,",",STRINGIMAGE n)
+  middle := STRCONC(",",STRINGIMAGE lwa,",[",string1,"],")
+  middle := STRCONC (middle,xtol,",",STRINGIMAGE ifail,",")
+  linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP35(FCN))")
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-c06.boot.pamphlet b/src/interp/nag-c06.boot.pamphlet
new file mode 100644
index 00000000..6bf1b75b
--- /dev/null
+++ b/src/interp/nag-c06.boot.pamphlet
@@ -0,0 +1,1854 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-c06.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+c06eaf() ==
+  htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06eaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06eaf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Calculates the discrete Fourier transform of the sequence ")
+    (text . "of real data values \space{1} \inputbitmap{\htbmdir{}/xj.bitmap}, for ")
+    (text . "j = 0,1,...,n-1. ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06eafSolve)
+  htShowPage()
+
+c06eafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '7 => c06eafDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :labelList]
+  page := htInitPage("C06EAF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the sequence to be transformed: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htSay '"Note : On exit, the transformed sequence is stored "
+  htSay '"in Hermitian form "
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06eafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06eafDefaultSolve (htPage, ifail) ==
+  n := '7
+  page := htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the sequence to be transformed: ")
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.34907" r1 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.54890" r2 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.74776" r3 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.94459" r4 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.13850" r5 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.32850" r6 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.51370" r7 F))
+    (text . "\blankline ")
+    (text . "Note : On exit, the transformed sequence is stored ")
+    (text . "in Hermitian form ")
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06eafGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06eafGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06eaf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")")
+
+c06ebf() ==
+  htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06ebf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ebf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Calculates the discrete Fourier transform of a Hermitian ")
+    (text . "sequence of complex data values. ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (5 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06ebfSolve)
+  htShowPage()
+
+c06ebfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '7 => c06ebfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :labelList]
+  page := htInitPage("C06EBF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the sequence to be transformed, stored in Hermitian form: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htSay '"Note : On exit, the components of the discrete Fourier transform "
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06ebfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06ebfDefaultSolve (htPage, ifail) ==
+  n := '7
+  page := htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the sequence to be transformed, stored in Hermitian form: ")
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.34907" r1 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.54890" r2 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.74776" r3 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.94459" r4 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.13850" r5 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.32850" r6 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.51370" r7 F))
+    (text . "\blankline ")
+    (text . "Note : On exit, the components of the discrete Fourier transform")
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06ebfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06ebfGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06ebf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")")
+
+
+c06ecf() ==
+  htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06ecf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ecf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Calculates the discrete Fourier transform of a complex sequence.")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06ecfSolve)
+  htShowPage()
+
+
+c06ecfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '7 => c06ecfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{32} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], 
+       ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} "
+  htSay '"\menuitemstyle{}\tab{32} Imaginary parts: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06ecfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c06ecfDefaultSolve (htPage, ifail) ==
+  n := '7
+  page := htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} ")
+    (text . "\menuitemstyle{}\tab{32} Imaginary parts: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.34907" x1 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "-0.37168" y1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.54890" x2 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "-0.35669" y2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.74776" x3 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "-0.31175" y3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.94459" x4 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "-0.23702" y4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.13850" x5 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "-0.13274" y5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.32850" x6 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.00074" y6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.51370" x7 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.16298" y7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c06ecfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06ecfGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  linkGen STRCONC ('"c06ecf(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")")
+
+
+c06ekf() ==
+  htInitPage('"C06EKF - Circular convolution or correlation of two real vectors",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06ekf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ekf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Calculates the circular convolution or correlation of two real ")
+    (text . "vectors of period {\em n} ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Choose the computation to be performed:")
+    (radioButtons job
+        ("" "  Convolution" conv)
+        ("" "  Correlation" corr))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06ekfSolve)
+  htShowPage()
+
+
+c06ekfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  type := htpButtonValue(htPage,'job)
+  job :=
+    type = 'conv => '1
+    '2
+  n = '9 => c06ekfDefaultSolve(htPage,job,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{34} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], 
+       ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("C06EKF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: "
+  htSay '"\tab{31} "
+  htSay '"\menuitemstyle{}\tab{34} Elements of period of vector {\em y}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06ekfGen)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c06ekfDefaultSolve (htPage, job, ifail) ==
+  n := '9
+  page := htInitPage('"C06EKF - Circular convolution or correlation of two real vectors ",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: \tab{32} ")
+    (text . "\menuitemstyle{}\tab{34} Elements of period of vector {\em y}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "1.00" x1 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.50" y1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x2 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.50" y2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x3 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.50" y3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x4 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.50" y4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x5 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.00" y5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x6 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.00" y6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x7 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.00" y7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x8 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.00" y8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x9 F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.00" y9 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c06ekfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06ekfGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  job := htpProperty(htPage,'job)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  linkGen STRCONC ('"c06ekf(",STRINGIMAGE job,",",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")")
+
+c06fpf() ==
+  htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06fpf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fpf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the discrete Fourier transforms of {\it m} real ")
+    (text . "sequences, each containing {\it n} data values.")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of sequences to be transformed {\it m}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Type of call:")
+    (radioButtons init
+        ("" "  Initial" i)
+        ("" "  Subsequent" s)
+        ("" "  Restart" r))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06fpfSolve)
+  htShowPage()
+
+c06fpfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  call := htpButtonValue(htPage,'init)
+  init :=
+    call = 'i => '"i"
+    call = 's => '"s"
+    '"r"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and m = '3) => c06fpfDefaultSolve(htPage,init,ifail)
+  matList :=
+    "append"/[f(i,m) for i in 1..n] where f(i,n) ==
+      labelList :=
+        "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+          xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, xnam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  trigList := 
+    "append"/[h(k) for k in 1..(2*n)] where h(k) ==
+      prefix := ('"\newline \tab{2} ")
+      trignam := INTERN STRCONC ('"t",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Trigonometric coefficients ")
+  prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  trigList := [['text,:prefix],:trigList]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :matList,:trigList]
+  page := htInitPage("C06FPF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter each sequence to be transformed, {\it x}. "
+  htSay '"(Each column to contain a sequence.) "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c06fpfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06fpfDefaultSolve (htPage, init,ifail) ==
+  n := '6
+  m := '3
+  page := htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter each sequence to be transformed, {\it x}. ")
+    (text . "(Each column to contain a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.3854" x11 F))
+    (bcStrings (6 "0.5417" x21 F))
+    (bcStrings (6 "0.9172" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6772" x12 F))
+    (bcStrings (6 "0.2983" x22 F))
+    (bcStrings (6 "0.0644" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1138" x13 F))
+    (bcStrings (6 "0.1181" x23 F))
+    (bcStrings (6 "0.6037" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6751" x14 F))
+    (bcStrings (6 "0.7255" x24 F))
+    (bcStrings (6 "0.6430" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6362" x15 F))
+    (bcStrings (6 "0.8638" x25 F))
+    (bcStrings (6 "0.0428" x35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1424" x16 F))
+    (bcStrings (6 "0.8723" x26 F))
+    (bcStrings (6 "0.4815" x36 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Trignometric coefficients (not required if initial call) ")
+    (text . "{\it TRIG}: \newline \tab{2} ")
+    (bcStrings (6 "0.0" t1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t12 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06fpfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06fpfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  init := htpProperty(htPage,'init)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(2*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    triglist := [left,:triglist]
+  trigstring := bcwords2liststring triglist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+  xstring := bcwords2liststring xlist
+  prefix := STRCONC ('"c06fpf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"")
+  prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+
+c06fqf() ==
+  htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06fqf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fqf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the discrete Fourier transforms of {\it m} real ")
+    (text . "sequences, each containing {\it n} data values.")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of sequences to be transformed {\it m}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Type of call:")
+    (radioButtons init
+        ("" "  Initial" i)
+        ("" "  Subsequent" s)
+        ("" "  Restart" r))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06fqfSolve)
+  htShowPage()
+
+c06fqfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  call := htpButtonValue(htPage,'init)
+  init :=
+    call = 'i => '"i"
+    call = 's => '"s"
+    '"r"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and m = '3) => c06fqfDefaultSolve(htPage,init,ifail)
+  matList :=
+    "append"/[f(i,m) for i in 1..n] where f(i,n) ==
+      labelList :=
+        "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+          xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, xnam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  trigList := 
+    "append"/[h(k) for k in 1..(2*n)] where h(k) ==
+      prefix := ("\newline \tab{2} ")
+      trignam := INTERN STRCONC ('"t",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ")
+  prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  trigList := [['text,:prefix],:trigList]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :matList,:trigList]
+  page := htInitPage("C06FQF - Multiple 1-D Hermitian discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter each sequence to be transformed, {\it x}. "
+  htSay '"(Each column to contain a sequence.) "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c06fqfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06fqfDefaultSolve (htPage, init,ifail) ==
+  n := '6
+  m := '3
+  page := htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter each sequence to be transformed, {\it x}. ")
+    (text . "(Each column to contain a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.3854" x11 F))
+    (bcStrings (6 "0.5417" x21 F))
+    (bcStrings (6 "0.9172" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6772" x12 F))
+    (bcStrings (6 "0.2983" x22 F))
+    (bcStrings (6 "0.0644" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1138" x13 F))
+    (bcStrings (6 "0.1181" x23 F))
+    (bcStrings (6 "0.6037" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6751" x14 F))
+    (bcStrings (6 "0.7255" x24 F))
+    (bcStrings (6 "0.6430" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6362" x15 F))
+    (bcStrings (6 "0.8638" x25 F))
+    (bcStrings (6 "0.0428" x35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1424" x16 F))
+    (bcStrings (6 "0.8723" x26 F))
+    (bcStrings (6 "0.4815" x36 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Trignometric coefficients (not required if initial call) ")
+    (text . "{\it TRIG}: \newline \tab{2} ")
+    (bcStrings (6 "0.0" t1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t5 F))
+    (text . "\newline \tab{2} ") 
+    (bcStrings (6 "0.0" t6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t12 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06fqfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06fqfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  init := htpProperty(htPage,'init)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(2*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    triglist := [left,:triglist]
+  trigstring := bcwords2liststring triglist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+  xstring := bcwords2liststring xlist
+  prefix := STRCONC ('"c06fqf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"")
+  prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+
+c06frf() ==
+  htInitPage('"C06FRF - Multiple 1-D complex discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06frf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06frf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the discrete Fourier transforms of {\it m} complex ")
+    (text . "sequences, each containing {\it n} data values.")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of sequences to be transformed {\it m}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Type of call:")
+    (radioButtons init
+        ("" "  Initial" i)
+        ("" "  Subsequent" s)
+        ("" "  Restart" r))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06frfSolve)
+  htShowPage()
+
+c06frfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  call := htpButtonValue(htPage,'init)
+  init :=
+    call = 'i => '"i"
+    call = 's => '"s"
+    '"r"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and m = '3) => c06frfDefaultSolve(htPage,init,ifail)
+  xList :=
+    "append"/[fx(i,m) for i in 1..n] where fx(i,n) ==
+      labelList :=
+        "append"/[gx(i,j) for j in 1..n] where gx(i,j) ==
+          xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, xnam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  yList :=
+    "append"/[fy(i,m) for i in 1..n] where fy(i,n) ==
+      labelList :=
+        "append"/[gy(i,j) for j in 1..n] where gy(i,j) ==
+          ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, ynam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ")
+  prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ")
+  prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ")
+  prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ")
+  yList := [['text,:prefix],:yList]
+  trigList := 
+    "append"/[h(k) for k in 1..(2*n)] where h(k) ==
+      prefix := ("\newline \tab{2} ")
+      trignam := INTERN STRCONC ('"t",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ")
+  prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  trigList := [['text,:prefix],:trigList]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :xList,:yList,:trigList]
+  page := htInitPage("C06FRF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the real parts of each sequence to be transformed, {\it x}. "
+  htSay '"(Each column to contain the real parts of a sequence.) "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c06frfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06frfDefaultSolve (htPage, init,ifail) ==
+  n := '6
+  m := '3
+  page := htInitPage('"C06FRF - Multiple 1-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the real parts of each sequence to be transformed, ")
+    (text . "{\it x}. (Each column to contain the real parts of a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.3854" x11 F))
+    (bcStrings (6 "0.9172" x21 F))
+    (bcStrings (6 "0.1156" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6772" x12 F))
+    (bcStrings (6 "0.0644" x22 F))
+    (bcStrings (6 "0.0685" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1138" x13 F))
+    (bcStrings (6 "0.6037" x23 F))
+    (bcStrings (6 "0.2060" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6751" x14 F))
+    (bcStrings (6 "0.6430" x24 F))
+    (bcStrings (6 "0.8630" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6362" x15 F))
+    (bcStrings (6 "0.0428" x25 F))
+    (bcStrings (6 "0.6967" x35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1424" x16 F))
+    (bcStrings (6 "0.4815" x26 F))
+    (bcStrings (6 "0.2792" x36 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ")
+    (text . "sequence to be transformed, {\it y}. ")
+    (text . "(Each column to contain the imaginary parts of a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5417" y11 F))
+    (bcStrings (6 "0.9089" y21 F))
+    (bcStrings (6 "0.6214" y31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.2983" y12 F))
+    (bcStrings (6 "0.3118" y22 F))
+    (bcStrings (6 "0.8681" y32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1181" y13 F))
+    (bcStrings (6 "0.3465" y23 F))
+    (bcStrings (6 "0.7060" y33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.7255" y14 F))
+    (bcStrings (6 "0.6198" y24 F))
+    (bcStrings (6 "0.8652" y34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.8638" y15 F))
+    (bcStrings (6 "0.2668" y25 F))
+    (bcStrings (6 "0.9190" y35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.8723" y16 F))
+    (bcStrings (6 "0.1614" y26 F))
+    (bcStrings (6 "0.3355" y36 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Trignometric coefficients (not required if initial call) ")
+    (text . "{\it TRIG}: \newline \tab{2} ")
+    (bcStrings (6 "0.0" t1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" t12 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06frfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06frfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  init := htpProperty(htPage,'init)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(2*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    triglist := [left,:triglist]
+  trigstring := bcwords2liststring triglist
+  for i in 1..(m*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    ylist := [left,:ylist]
+  ystring := bcwords2liststring ylist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+  xstring := bcwords2liststring xlist
+  prefix := STRCONC ('"c06frf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"")
+  prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[")
+  linkGen STRCONC(prefix,trigstring,"],",STRINGIMAGE ifail,")")
+
+
+c06fuf() ==
+  htInitPage('"C06FUF - 2-D complex discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06fuf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fuf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the two-dimensional discrete Fourier transform of ")
+    (text . "a bivaraite sequence of complex data values; likely to be ")
+    (text . "efficient on vector processors. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of {\it m} of rows of X and Y; ")
+    (text . "\htbitmap{great=} 1 \newline \tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of {\it n} of columns of X and Y; ")
+    (text . "\htbitmap{great=} 1 \newline \tab{2} ")
+    (bcStrings (5 5 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Type of call:")
+    (radioButtons init
+        ("" "  Initial" i)
+        ("" "  Subsequent" s)
+        ("" "  Restart" r))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06fufSolve)
+  htShowPage()
+
+c06fufSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  call := htpButtonValue(htPage,'init)
+  init :=
+    call = 'i => '"i"
+    call = 's => '"s"
+    '"r"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '5 and m = '3) => c06fufDefaultSolve(htPage,init,ifail)
+  xList :=
+    "append"/[fx(i,m) for i in 1..n] where fx(i,n) ==
+      labelList :=
+        "append"/[gx(i,j) for j in 1..n] where gx(i,j) ==
+          xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, xnam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  yList :=
+    "append"/[fy(i,m) for i in 1..n] where fy(i,n) ==
+      labelList :=
+        "append"/[gy(i,j) for j in 1..n] where gy(i,j) ==
+          ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, ynam, 'F]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ")
+  prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ")
+  prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ")
+  prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ")
+  yList := [['text,:prefix],:yList]
+  trigmList := 
+    "append"/[hm(k) for k in 1..(2*m)] where hm(k) ==
+      prefix := ("\newline \tab{2} ")
+      trignam := INTERN STRCONC ('"tm",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ")
+  prefix := STRCONC(prefix,"(not required if initial call) {\it TRIGM}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  trigmList := [['text,:prefix],:trigmList]
+  trignList := 
+    "append"/[hn(k) for k in 1..(2*n)] where hn(k) ==
+      prefix := ("\newline \tab{2} ")
+      trignam := INTERN STRCONC ('"tn",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it TRIGN}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  trignList := [['text,:prefix],:trignList]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :xList,:yList,:trigmList,:trignList]
+  page := htInitPage("C06FUF - 2-D complex discrete Fourier transform ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the real part of each sequence to be transformed, {\it x}. "
+  htSay '"(Each column to contain the real parts of a sequence.) "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'c06fufGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06fufDefaultSolve (htPage, init,ifail) ==
+  n := '5
+  m := '3
+  page := htInitPage('"C06FUF - 2-D real discrete Fourier transform ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the real parts of each sequence to be transformed, ")
+    (text . "{\it x}. (Each column to contain the real parts of a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.000" x11 F))
+    (bcStrings (6 "0.994" x21 F))
+    (bcStrings (6 "0.903" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.999" x12 F))
+    (bcStrings (6 "0.989" x22 F))
+    (bcStrings (6 "0.885" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.987" x13 F))
+    (bcStrings (6 "0.963" x23 F))
+    (bcStrings (6 "0.823" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.936" x14 F))
+    (bcStrings (6 "0.891" x24 F))
+    (bcStrings (6 "0.694" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.802" x15 F))
+    (bcStrings (6 "0.731" x25 F))
+    (bcStrings (6 "0.467" x35 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ")
+    (text . "sequence to be transformed, {\it y}. (Each column to contain ")
+    (text . "the imaginary parts of a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.000" y11 F))
+    (bcStrings (6 "-0.111" y21 F))
+    (bcStrings (6 "-0.430" y31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-0.040" y12 F))
+    (bcStrings (6 "-0.151" y22 F))
+    (bcStrings (6 "-0.466" y32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-0.159" y13 F))
+    (bcStrings (6 "-0.268" y23 F))
+    (bcStrings (6 "-0.568" y33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-0.352" y14 F))
+    (bcStrings (6 "-0.454" y24 F))
+    (bcStrings (6 "-0.720" y34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-0.597" y15 F))
+    (bcStrings (6 "-0.682" y25 F))
+    (bcStrings (6 "-0.884" y35 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Trignometric coefficients (not required if initial call) ")
+    (text . "{\it TRIGM}: \newline \tab{2} ")
+    (bcStrings (6 "0.0" tm1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tm2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tm3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tm4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tm5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tm6 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "{\it TRIGN}: \newline \tab{2} ")
+    (bcStrings (6 "0.0" tn1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" tn10 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06fufGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06fufGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  init := htpProperty(htPage,'init)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(2*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    trignlist := [left,:trignlist]
+  trignstring := bcwords2liststring trignlist
+  for i in 1..(2*m) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    trigmlist := [left,:trigmlist]
+  trigmstring := bcwords2liststring trigmlist
+  for i in 1..(m*n) repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    ylist := [left,:ylist]
+  ystring := bcwords2liststring ylist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+  xstring := bcwords2liststring xlist
+  prefix := STRCONC ('"c06fuf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"")
+  prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[",trigmstring)
+  linkGen STRCONC(prefix,"],[",trignstring,"],",STRINGIMAGE ifail,")")
+
+
+
+c06gbf() ==
+  htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06gbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gbf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Forms the complex conjugate of a Hermitian sequence of {\it n} data values")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values {\it n} ")
+    (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06gbfSolve)
+  htShowPage()
+
+c06gbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '7 => c06gbfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :labelList]
+  page := htInitPage("C06GBF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the Hermitian sequence to be transformed stored in Hermitian form: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htSay '"Note : On exit, the imaginary values are negated "
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06gbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06gbfDefaultSolve (htPage, ifail) ==
+  n := '7
+  page := htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the Hermitian sequence to be transformed ")
+    (text . "stored in Hermitian form: ")
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.34907" r1 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.54890" r2 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.74776" r3 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.94459" r4 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.13850" r5 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.32850" r6 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.51370" r7 F))
+    (text . "\blankline ")
+    (text . "Note : On exit, the imaginary values are negated ")
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06gbfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06gbfGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06gbf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")")
+
+
+c06gcf() ==
+  htInitPage('"C06GCF - Complex conjugate of complex sequence ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06gcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gcf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Forms the complex conjugate of a sequence of {\it n} data values")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data values {\it n} ")
+    (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06gcfSolve)
+  htShowPage()
+
+c06gcfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '7 => c06gcfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]]
+  equationPart := [ 
+     '(domainConditions 
+        (isDomain F (Float))),
+	    :labelList]
+  page := htInitPage("C06GCF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage)
+  htSay '"\menuitemstyle{} \tab{2} "
+  htSay '"Enter the imaginary parts of the sequence: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htSay '"Note : On exit, these values are negated "
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06gcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()  
+
+
+c06gcfDefaultSolve (htPage, ifail) ==
+  n := '7
+  page := htInitPage('"C06GCF - Complex conjugate of complex sequence ", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the imaginary parts of the sequence: ")
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "-0.37168" r1 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "-0.35669" r2 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "-0.31175" r3 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "-0.23702" r4 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.00074" r5 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.16298" r6 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "1.51370" r7 F))
+    (text . "\blankline ")
+    (text . "Note : On exit, these values are negated ")
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'c06gcfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06gcfGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06gcf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")")
+
+c06gqf() ==
+  htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06gqf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gqf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Forms the complex conjugates of {\it m} Hermitian sequences, ")
+    (text . "each containing {\it n} data values. ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "of sequences to be tranformed: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "of data values in each sequence: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06gqfSolve)
+  htShowPage()
+
+
+c06gqfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '3 and n = '6)  => c06gqfDefaultSolve(htPage,ifail)
+  newList:=
+    "append"/[g(i,m) for i in 1..n] where g(i,n) ==
+      labelList :=
+        "append"/[f(i,j) for j in 1..n] where f(i,j) ==
+          rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, rnam, 'P]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :newList]
+  page := htInitPage("C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage)
+  htSay '"\newline "
+  htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be "
+  htSay '"transformed in Hermitian format. (Each column to contain  "
+  htSay '"a sequence.) "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06gqfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c06gqfDefaultSolve (htPage, ifail) ==
+  m := '3
+  n := '6
+  page := htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ")
+    (text . "transformed in Hermitian format. ")
+    (text . "(Each column to contain a sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.3854" x11 F))
+    (bcStrings (6 "0.5417" x21 F))
+    (bcStrings (6 "0.9172" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6772" x12 F))
+    (bcStrings (6 "0.2983" x22 F))
+    (bcStrings (6 "0.0644" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1138" x13 F))
+    (bcStrings (6 "0.1181" x23 F))
+    (bcStrings (6 "0.6037" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6751" x14 F))
+    (bcStrings (6 "0.7255" x24 F))
+    (bcStrings (6 "0.6430" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6362" x15 F))
+    (bcStrings (6 "0.8638" x25 F))
+    (bcStrings (6 "0.0428" x35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1424" x16 F))
+    (bcStrings (6 "0.8723" y26 F))
+    (bcStrings (6 "0.4815" y36 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c06gqfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06gqfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [right,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06gqf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")")
+
+
+
+c06gsf() ==
+  htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXc06gsf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gsf| '|NagSeriesSummationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Takes {\it m} Hermitian sequences, each containing {\it n} data values, ")
+    (text . "and forms the real and imaginary parts of the {\it m} ")
+    (text . "corresponding complex sequences. \newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "of sequences to be transformed: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ")
+    (text . "of data values in each sequence: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'c06gsfSolve)
+  htShowPage()
+
+
+c06gsfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '3 and n = '6)  => c06gsfDefaultSolve(htPage,ifail)
+  newList:=
+    "append"/[g(i,m) for i in 1..n] where g(i,n) ==
+      labelList :=
+        "append"/[f(i,j) for j in 1..n] where f(i,j) ==
+          rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j)
+          [['bcStrings,[6, 0.0, rnam, 'P]]]
+      prefix := ('"\newline \tab{2} ")
+      labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :newList]
+  page := htInitPage("C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage)
+  htSay '"\newline "
+  htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be "
+  htSay '"transformed in Hermitian format. (Each column to contain a "
+  htSay '"sequence.) "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'c06gsfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+c06gsfDefaultSolve (htPage, ifail) ==
+  m := '3
+  n := '6
+  page := htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ")
+    (text . "transformed in Hermitian format. (Each column to contain a ")
+    (text . "sequence.) ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.3854" x11 F))
+    (bcStrings (6 "0.5417" x21 F))
+    (bcStrings (6 "0.9172" x31 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6772" x12 F))
+    (bcStrings (6 "0.2983" x22 F))
+    (bcStrings (6 "0.0644" x32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1138" x13 F))
+    (bcStrings (6 "0.1181" x23 F))
+    (bcStrings (6 "0.6037" x33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6751" x14 F))
+    (bcStrings (6 "0.7255" x24 F))
+    (bcStrings (6 "0.6430" x34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6362" x15 F))
+    (bcStrings (6 "0.8638" x25 F))
+    (bcStrings (6 "0.0428" x35 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1424" x16 F))
+    (bcStrings (6 "0.8723" y26 F))
+    (bcStrings (6 "0.4815" y36 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'c06gsfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+c06gsfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [right,:reallist]
+  realstring := bcwords2liststring reallist
+  linkGen STRCONC ('"c06gsf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")")
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-d01.boot.pamphlet b/src/interp/nag-d01.boot.pamphlet
new file mode 100644
index 00000000..a4b2f373
--- /dev/null
+++ b/src/interp/nag-d01.boot.pamphlet
@@ -0,0 +1,1359 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-d01.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+d01ajf() ==
+  htInitPage('"D01AJF - 1-D quadrature, adaptive, finite interval, allowing for badly-behaved integrands", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01ajf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01ajf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the integral ")
+    (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx ")
+    (text . "using an adaptive method. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "X*sin(30*X)/(sqrt(1-(X/(2*\%pi))**2))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "\%pi*2" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01ajfGen)
+  htShowPage()
+
+d01ajfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/4
+  prefix := STRCONC("d01ajf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw)
+  middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",express,"::Expression Float) :: ASP1(F))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01akf() ==
+  htInitPage('"D01AKF - 1-D quadrature, adaptive, finite interval, method suitable for oscillating functions", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01akf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01akf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes \space{1} \inputbitmap{\htbmdir{}/integral.bitmap} ")
+    (text . "f(x) dx using an adaptive method, ")
+    (text . "especially suited to oscillating, non-singular integrands. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "X*sin(30*X)*cos(X)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "\%pi*2" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01akfGen)
+  htShowPage()
+
+d01akfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/4
+  prefix := STRCONC("d01akf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw)
+  middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",express,"::Expression Float) :: ASP1(F))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01alf() ==
+  htInitPage('"D01ALF - 1-D quadrature, adaptive, finite interval, allowing for singularities at user-specified break-points ", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01alf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01alf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the integral \space{1} ")
+    (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx; ")
+    (text . "the integrand may have local singular behaviour at a ")
+    (text . "finite number of points within [a,b]. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "1/sqrt(abs(X-1/7))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "1.0" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Number of user supplied break-points: \tab{38}")
+    (bcStrings (10 "1" npts PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline User supplied break-points (separated by commas): ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (40 "1/7" points EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01alfGen)
+  htShowPage()
+
+d01alfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  npts := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npts)
+    objValUnwrap htpLabelSpadValue(htPage, 'npts)
+  points := htpLabelInputString(htPage, 'points)
+  points := STRCONC ('"[[",points,"]]")
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/2
+  prefix := STRCONC('"d01alf(",a," ,",b," ,",STRINGIMAGE npts,",",points,",")
+  prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw)
+  middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01amf() ==
+  htInitPage('"D01AMF   1-D quadrature, adaptive, infinite or semi-infinite interval",nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01amf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01amf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Evaluates the integral \space{1} ")
+    (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx, ")
+    (text . "where (a,b) can be an infinite or semi-infinite interval.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "1/((X+1)*sqrt(X))" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Bound} the finite limit of the integration range: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" a F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Choose the kind of integration range: ")
+    (radioButtons inf
+        (" 1" "\tab{2} Range is [Bound, +infinity] " plus)
+        ("-1" "\tab{2} Range is [-infinity, Bound] " minus)
+        ("2" "\tab{2} Range is [-infinity, +infinity] (Bound is not used) " minusPlus))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01amfGen)
+  htShowPage()
+
+d01amfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  infinity := htpButtonValue(htPage,'inf)
+  inf := 
+    infinity = 'plus => 1
+    infinity = 'minus => -1
+    2
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/4
+  prefix := STRCONC('"d01amf(",a," ,",STRINGIMAGE inf," ,")
+  prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw)
+  middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01anf() ==
+  htInitPage('"D01ANF - 1-D quadrature, adaptive, finite interval, weight function cos(\omega x) or sin(\omega x)", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01anf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01anf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)sin(\omega x) dx ")
+    (text . "or \inputbitmap{\htbmdir{}/integral.bitmap} g(x)cos(\omega x) dx, ")
+    (text . "the sine and cosine transform respectively. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} f to be integrated in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "log(X)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "1.0e-6" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "1.0" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\omega the weight function:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\tab{34} ")
+    (bcStrings (20 "10*\%pi" omega F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Key value, indicates which integral is to be computed:")
+    (radioButtons key
+        ("" "  sin" sin)
+        ("" "  cos" cos))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01anfGen)
+  htShowPage()
+
+d01anfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  omega := htpLabelInputString(htPage,'omega)
+  type  := htpButtonValue(htPage,'key)
+  key :=
+    type = 'cos => 1
+    2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/4
+  prefix := STRCONC("d01anf(",a," ,",b," ,",omega," ,",STRINGIMAGE key," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw)
+  middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",express,"::Expression Float) :: ASP1(G))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01apf() ==
+  htInitPage('"D01APF - 1-D quadrature, adaptive, finite interval, weight function with end point singularities of algebraico-logarithmic type", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01apf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01apf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)w(x) dx, where w(x) ")
+    (text . "has end-point singularities of algebraico-logarithmic type. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the {\em function} g(x) in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "sin(10*X)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "1.0e-6" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "1.0" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline \alpha in the weight function:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\beta in the weight function:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "-0.5" alpha F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "-0.5" beta F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Key value, indicates which weight function is to be used: ")
+    (radioButtons key
+        ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta" kone)
+        ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a)" ktwo)
+        ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(b-x)" kthree)
+        ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a) * ln(b-x) " kfour))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01apfGen)
+  htShowPage()
+
+d01apfGen htPage ==
+  express := htpLabelInputString(htPage,'expression)
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  alpha := htpLabelInputString(htPage,'alpha)
+  beta := htpLabelInputString(htPage,'beta)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  type  := htpButtonValue(htPage,'key)
+  key :=
+    type = 'kone => 1
+    type = 'ktwo => 2
+    type = 'kthree => 3
+    4
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  liw := lw/4
+  prefix := STRCONC("d01apf(",a," ,",b," ,",alpha," ,",beta," ,")
+  prefix := STRCONC(prefix,STRINGIMAGE key," ,",epsabs," ,",epsrel," ,")
+  prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,")
+  end := STRCONC("(",express,"::Expression Float) :: ASP1(G))")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end)
+
+d01aqf() ==
+  htInitPage('"D01AQF - 1-D quadrature, adaptive, finite interval, weight function 1/(x-c), Cauchy principal value (Hilbert transform)",nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01aqf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01aqf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the Hilbert transform \inputbitmap{\htbmdir{}/integral.bitmap}")
+    (text . "g(x)/(x-c) dx.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the function {\it g(x)} in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (55 "(X**2+0.01**2)**-1" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval {\it a}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound {\it b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "-1.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "1.0" b F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "Parameter {\it c} \notequal {\it a} or {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.5" c F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Relative accuracy:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" epsabs F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0e-4" epsrel F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01aqfGen)
+  htShowPage()
+
+d01aqfGen htPage ==
+  express := htpLabelInputString(htPage,'expression)
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  c := htpLabelInputString(htPage,'c)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  epsrel := htpLabelInputString(htPage,'epsrel)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  liw := lw/4
+  prefix := STRCONC("d01aqf(",a," ,",b," ,",c," ,",epsabs," ,",epsrel," ,")
+  prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,")
+  end := STRCONC("((",express,")::Expression Float) :: ASP1(G))")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end)
+
+d01asf() ==
+  htInitPage('"D01ASF - 1-D quadrature, adaptive, semi-infinite interval, weight function cos(\omega x) or sin(\omega x)", nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01asf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01asf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates \inputbitmap{\htbmdir{}/si-integral.bitmap} ")
+    (text . "g(x)sin(\omega x) dx ")
+    (text . "or \inputbitmap{\htbmdir{}/si-integral.bitmap} ")
+    (text . "g(x)cos(\omega x) dx, ")
+    (text . "the sine and cosine transform respectively. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the function {\it g(x)} in terms of X: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (45 "1/sqrt(X)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.0e-12" a F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Parameter \omega in the weight function of the transform: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "\%pi/2" omega F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Absolute accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-3" epsabs F))
+    (text . "\newline \menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 800 lw PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it LIMLST} upper bound on number of intervals:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 50 limlst PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Key value, indicates which integral is to be computed:")
+    (radioButtons key
+        ("" "  cos(\omega x)" cos)
+        ("" "  sin(\omega x)" sin))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01asfGen)
+  htShowPage()
+
+d01asfGen htPage ==
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  limlst :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'limlst)
+    objValUnwrap htpLabelSpadValue(htPage, 'limlst)
+  a := htpLabelInputString(htPage,'a)
+  epsabs := htpLabelInputString(htPage,'epsabs)
+  omega := htpLabelInputString(htPage,'omega)
+  type  := htpButtonValue(htPage,'key)
+  key :=
+    type = 'cos => 1
+    2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  express := htpLabelInputString(htPage,'expression)
+  liw := lw/2
+  prefix := STRCONC("d01asf(",a," ,",omega," ,",STRINGIMAGE key," ,",epsabs)
+  prefix := STRCONC(prefix," ,",STRINGIMAGE limlst," ,",STRINGIMAGE lw)
+  middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",express,"::Expression Float) :: ASP1(G))")
+  linkGen STRCONC(prefix,middle,end)
+
+
+
+d01gaf() ==
+  htInitPage('"D01GAF - \space{1} 1-D quadrature, integration of function defined by data values, Gill-Miller method", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd01gaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gaf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the integral ")
+    (text . "\inputbitmap{\htbmdir{}/d01gaf1.bitmap} y(x)dx ")
+    (text . "where the numerical value of the function {\em y} is ")
+    (text . "specified at the n distinct points \vspace{-26} ")
+    (text . "\inputbitmap{\htbmdir{}/d01gaf2.bitmap} ")
+    (text . "\blankline ")
+    (text . "Enter the number of points:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 21 n PI))
+    (text . "\blankline ")
+    (text . "\newline Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01gafSolve)
+  htShowPage()
+
+d01gafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '21 => d01gafDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{40} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], 
+       ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("D01GAF - 1-D quadrature, integration of function defined by data values", htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} "
+  htSay '"\menuitemstyle{}\tab{40} Enter values for {\em y}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htSay '"Note:\space{1}{\em x} values in ascending or descending order only "
+  htMakeDoneButton('"Continue",'d01gafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d01gafDefaultSolve (htPage, ifail) ==
+  n := '21
+  page := htInitPage('"D01GAF - 1-D quadrature, integration of function defined by data values",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} ")
+    (text . "\menuitemstyle{}\tab{40} Enter values for {\em y}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.00" x1 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "4.0000" y1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.04" x2 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.9936" y2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.08" x3 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.9746" y3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.12" x4 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.9432" y4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.22" x5 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.8153" y5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.26" x6 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.7467" y6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.30" x7 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.6697" y7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.38" x8 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.4943" y8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.39" x9 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.4719" y9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.42" x10 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.4002" y10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.45" x11 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.3264" y11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.46" x12 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "3.3014" y12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.60" x13 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.9412" y13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.68" x14 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.7352" y14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.72" x15 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.6344" y15 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.73" x16 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.6094" y16 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.83" x17 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.3684" y17 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.85" x18 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.3222" y18 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.88" x19 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.2543" y19 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.90" x20 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.2099" y20 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x21 F))
+    (text . "\tab{40} ")
+    (bcStrings (10 "2.0000" y21 F))
+    (text . "\newline \tab{2} ")
+    (text . "\blankline ")
+    (text . "Note:\space{1}{\em x} values in ascending or descending order only ")
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'d01gafGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+d01gafGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  linkGen STRCONC ('"d01gaf([",realstring,"],[",imagstring,"],",STRINGIMAGE n,",", STRINGIMAGE ifail,")")
+
+d01fcf() ==
+  htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01fcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01fcf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the multi-dimensional integral ")
+    (text . "\center{\htbitmap{d01fcf}}")
+    (text . "with constant finite limits, using an adaptive subdivision ")
+    (text . "strategy.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of dimensions n in the integral, 2 \htbitmap{less=} ")
+    (text . "{\it NDIM} \htbitmap{less=} 15: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 4 ndim F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (bcStrings (58 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Minimum number of evaluations: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Maximum number of evaluations: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 1000 minpts PI))
+    (text . "\tab{34} ")
+    (bcStrings (10 5700 maxpts PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" eps F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 606 lenwrk PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01fcfSolve)
+  htShowPage()
+
+
+d01fcfSolve htPage ==
+  ndim :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim)
+    objValUnwrap htpLabelSpadValue(htPage, 'ndim)
+  expression := htpLabelInputString(htPage,'expression)
+  minpts :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'minpts)
+    objValUnwrap htpLabelSpadValue(htPage, 'minpts)
+  maxpts :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxpts)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxpts)
+  eps := htpLabelInputString(htPage,'eps)
+  lenwrk :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk)
+    objValUnwrap htpLabelSpadValue(htPage, 'lenwrk)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ndim = '4 => d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..ndim] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{32} ")
+      rnam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      inam := INTERN STRCONC ('"b",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], 
+       ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil)
+  htSay '"Please enter the limits of integration:- "
+  htSay '"\blankline "
+  htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} "
+  htSay '"\menuitemstyle{}\tab{32} Upper limits: "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d01fcfGen)
+  htpSetProperty(page,'ndim,ndim)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'minpts,minpts)
+  htpSetProperty(page,'maxpts,maxpts)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'lenwrk,lenwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail) ==
+  ndim := '4
+  page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "Please enter the limits of integration:- ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Lower limits: \tab{30} ")
+    (text . "\menuitemstyle{} \tab{32} Upper limits: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a1 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a2 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a3 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a4 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b4 F))
+    (text . "\newline ")
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'d01fcfGen)    	
+  htpSetProperty(page,'ndim,ndim)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'minpts,minpts)
+  htpSetProperty(page,'maxpts,maxpts)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'lenwrk,lenwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d01fcfGen htPage ==
+  ndim := htpProperty(htPage,'ndim)
+  minpts := htpProperty(htPage,'minpts)
+  maxpts := htpProperty(htPage,'maxpts)
+  eps := htpProperty(htPage,'eps)
+  lenwrk := htpProperty(htPage,'lenwrk)
+  expression := htpProperty(htPage,'expression)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := (first y).1
+    y := rest y
+    left := (first y).1
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  astring := bcwords2liststring reallist
+  bstring := bcwords2liststring imaglist
+  prefix := STRCONC("d01fcf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ")
+  middle := STRCONC(STRINGIMAGE maxpts,", ",eps," ,",STRINGIMAGE lenwrk," ,")
+  middle := STRCONC(middle,STRINGIMAGE minpts," ,",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))")
+  linkGen STRCONC(prefix,middle,end)
+
+
+d01gbf() ==
+  htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01gbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gbf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the multidimensional integral ")
+    (text . "\center{\htbitmap{d01fcf}} with constant finite limits, ")
+    (text . "using an adaptive Monte-Carlo method;")
+    (text . " the routine is suitable for low accuracy work. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of dimensions n in the integral, {\it NDIM}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 4 ndim F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (bcStrings (60 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Minimum number of FUNCTN calls: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Maximum number of FUNCTN calls: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 1000 mincls PI))
+    (text . "\tab{34} ")
+    (bcStrings (10 20000 maxcls PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Relative accuracy required:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.01" eps F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of workspace array: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 500 lenwrk PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01gbfSolve)
+  htShowPage()
+
+
+d01gbfSolve htPage ==
+  ndim :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim)
+    objValUnwrap htpLabelSpadValue(htPage, 'ndim)
+  expression := htpLabelInputString(htPage,'expression)
+  mincls :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mincls)
+    objValUnwrap htpLabelSpadValue(htPage, 'mincls)
+  maxcls :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxcls)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxcls)
+  eps := htpLabelInputString(htPage,'eps)
+  lenwrk :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk)
+    objValUnwrap htpLabelSpadValue(htPage, 'lenwrk)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ndim = '4 => d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..ndim] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{32} ")
+      rnam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      inam := INTERN STRCONC ('"b",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], 
+       ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil)
+  htSay '"Please enter the limits of integration:- "
+  htSay '"\blankline "
+  htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} "
+  htSay '"\menuitemstyle{}\tab{32} Upper limits: "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d01gbfGen)
+  htpSetProperty(page,'ndim,ndim)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'mincls,mincls)
+  htpSetProperty(page,'maxcls,maxcls)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'lenwrk,lenwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail) ==
+  ndim := '4
+  page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "Please enter the limits of integration:- ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Lower limits: \tab{30} ")
+    (text . "\menuitemstyle{} \tab{32} Upper limits: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a1 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a2 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a3 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" a4 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0" b4 F))
+    (text . "\newline ")
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'d01gbfGen)    	
+  htpSetProperty(page,'ndim,ndim)
+  htpSetProperty(page,'expression,expression)
+  htpSetProperty(page,'mincls,mincls)
+  htpSetProperty(page,'maxcls,maxcls)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'lenwrk,lenwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+
+
+d01gbfGen htPage ==
+  ndim := htpProperty(htPage,'ndim)
+  mincls := htpProperty(htPage,'mincls)
+  maxcls := htpProperty(htPage,'maxcls)
+  eps := htpProperty(htPage,'eps)
+  lenwrk := htpProperty(htPage,'lenwrk)
+  expression := htpProperty(htPage,'expression)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := (first y).1
+    y := rest y
+    left := (first y).1
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  astring := bcwords2liststring reallist
+  bstring := bcwords2liststring imaglist
+  prefix := STRCONC("d01gbf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ")
+  middle := STRCONC(STRINGIMAGE maxcls,", ",eps," ,",STRINGIMAGE lenwrk," ,")
+  middle := STRCONC(middle,STRINGIMAGE mincls," ,[[0.0 for i in 1..")
+  middle := STRCONC(middle,STRINGIMAGE lenwrk,"]],",STRINGIMAGE ifail," ,")
+  end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))")
+  linkGen STRCONC(prefix,middle,end)
+
+d01bbf() ==
+  htInitPage('"D01BBF - Weights and abscissae for Gaussian quadrature rules",nil)
+  htMakePage '(
+    (domainConditions
+	(isDomain EM $EmptyMode)
+	(isDomain PI (PositiveInteger))
+	(isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd01bbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01bbf| '|NagIntegrationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Returns the weights and abscissae appropriate to a Gaussian ")
+    (text . "quadrature formula with a specified number of abscissae. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the D01XXX subroutine: ")
+    (radioButtons gtype
+        ("" " D01BAZ" gZero)
+        ("" " D01BAY" gOne)
+        ("" " D01BAX" gTwo)
+        ("" " D01BAW" gThree))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound of the interval: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "1.0" b EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Type of weights for Gauss-Laguerre or Gauss-Hermite quadrature:")
+    (radioButtons itype
+        ("" " adjusted weights" iOne)
+        ("" " normal weights" iZero))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Number of weights & abscissae to be used {\em n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "6" n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd01bbfGen)
+  htShowPage()
+
+d01bbfGen htPage ==
+  sub := htpButtonValue(htPage,'gtype)
+  gtype := 
+    sub = 'gZero => 0
+    sub = 'gOne => 1
+    sub = 'gTwo => 2
+    3
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  wgts := htpButtonValue(htPage,'itype)
+  itype := 
+    wgts = 'iOne => 1
+    0
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => 1
+    -1
+  prefix := STRCONC("d01bbf(",a," ,",b," ,",STRINGIMAGE itype," ,")
+  end := STRCONC(STRINGIMAGE n," ,",STRINGIMAGE gtype," ,",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,end)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-d02.boot.pamphlet b/src/interp/nag-d02.boot.pamphlet
new file mode 100644
index 00000000..93edfc46
--- /dev/null
+++ b/src/interp/nag-d02.boot.pamphlet
@@ -0,0 +1,2168 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-d02.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+d02bbf() ==
+  htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02bbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02BBF integrates a system of {\it n} ordinary differential ")
+    (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ")
+    (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ")
+    (text . "conditions using a Runge-Kutta-Merson method; the solution ")
+    (text . "may be output at specified points.")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Initial value of {\it x}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "0.0" x F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "End of integration range {\it xend}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "8.0" xend F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of differential equations {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Tolerance required {\it tol}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Error control indicator {\it irelab}:")
+    (radioButtons irelab
+        ("" " 0, mixed" mix)
+        ("" " 1, absolute" abs)
+        ("" " 2, relative" rel))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd02bbfSolve)
+  htShowPage()
+
+d02bbfSolve htPage ==
+  x := htpLabelInputString(htPage,'x)
+  xend := htpLabelInputString(htPage,'xend)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  tol := htpLabelInputString(htPage,'tol)
+  control := htpButtonValue(htPage,'irelab)
+  irelab :=
+    control = 'mix => '0
+    control = 'abs => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'minusOne => '-1
+    '1
+  n = '3 => d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ")
+  middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline \tab{2}")
+  yList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+        ynam := INTERN STRCONC ('"u",STRINGIMAGE i)
+        [['bcStrings,[6, 0, ynam, 'F]]]
+  yList :=  [['text,:middle],:yList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}")
+  mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline \tab{2}")
+  vList := [['bcStrings,[30, "0", 'out, 'EM]]]
+  vList :=  [['text,:mid],:vList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:yList,:vList]
+  page :=   htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions (i.e. the derivatives) below "
+  htSay '"as functions of Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02bbfGen)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'irelab,irelab)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail)   ==
+  n := '3
+  page :=   htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions (i.e. the derivatives) below ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (44 "tan(Y[3])" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the initial values of \htbitmap{yi}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "0.0" y1 EM))
+    (bcStrings (8 "0.5" y2 EM))
+    (bcStrings (8 "\%pi*0.2" y3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Intermediate values of {\it x} at which \htbitmap{yi} is required:")
+    (text . "\newline \tab{2}")
+    (bcStrings (30 "1,2,3,4,5,6,7,8" out EM)))
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'irelab,irelab)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02bbfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02bbfGen htPage ==
+  x := htpProperty(htPage, 'x)
+  xend := htpProperty(htPage, 'xend)
+  n := htpProperty(htPage, 'n)
+  tol := htpProperty(htPage, 'tol)
+  irelab := htpProperty(htPage, 'irelab)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  outp := ((first y).1)
+  oList := [outp,:oList]
+  y := rest y
+  ostring := bcwords2liststring oList
+  -- This is distictly horrible!  OUTP is a comma-seperated string so we
+  -- count up the commas to see how many elements it has.  We return this
+  -- quantity plus 1 since the ASP OUTPUT is always called at least once.
+  numberOfPoints := 
+    ZEROP LENGTH(outp) => 1
+    2+COUNT(CHARACTER(44),outp)
+  for i in 1..n repeat
+    ytemp := STRCONC((first y).1," ")
+    yList := [ytemp,:yList]
+    y := rest y
+  ystring := bcwords2liststring yList
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  prefix := STRCONC("d02bbf(", xend,", ", STRINGIMAGE numberOfPoints, ", ",STRINGIMAGE n,", ",STRINGIMAGE irelab)
+  prefix := STRCONC(prefix,", ",x,", [", ystring,"],",tol)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,",(")
+  end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",ostring)
+  end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))")
+  linkGen STRCONC(prefix,end)
+
+d02bhf() ==
+  htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02bhf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02BHF integrates a system of {\it n} ordinary differential ")
+    (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ")
+    (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ")
+    (text . "conditions using a Runge-Kutta-Merson method until a specified ")
+    (text . "function {\em g(x,y)} of the solution is zero. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Initial value of {\it x}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "0.0" x F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "End of integration range {\it xend}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "10.0" xend F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of differential equations {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Tolerance required {\it tol}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Error control indicator {\it irelab}:")
+    (radioButtons irelab
+        ("" " 0, mixed" mix)
+        ("" " 1, absolute" abs)
+        ("" " 2, relative" rel))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Upper bound on size of the interval {\it hmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" hmax F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd02bhfSolve)
+  htShowPage()
+
+d02bhfSolve htPage ==
+  x := htpLabelInputString(htPage,'x)
+  xend := htpLabelInputString(htPage,'xend)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  tol := htpLabelInputString(htPage,'tol)
+  control := htpButtonValue(htPage,'irelab)
+  irelab :=
+    control = 'mix => '0
+    control = 'abs => '1
+    '2
+  hmax := htpLabelInputString(htPage,'hmax)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '3 => d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ")
+  middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ")
+  yList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+        ynam := INTERN STRCONC ('"u",STRINGIMAGE i)
+        [['bcStrings,[6, 0, ynam, 'F]]]
+  yList :=  [['text,:middle],:yList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ")
+  mid := STRCONC(mid,'"{\em g(x,y)}: \newline ")
+  vList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]]
+  vList :=  [['text,:mid],:vList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:yList,:vList]
+  page :=   htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} "
+  htSay '"as functions of Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02bhfGen)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'irelab,irelab)
+  htpSetProperty(page,'hmax,hmax)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail)   ==
+  n := '3
+  page :=  htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (44 "tan(Y[3])" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the initial values of \htbitmap{yi}:")
+    (text . "\newline ")
+    (bcStrings (8 "0.5" y1 EM))
+    (bcStrings (8 "0.5" y2 EM))
+    (bcStrings (8 "\%pi*0.2" y3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the function below {\em g(x,y)}: ")
+    (text . "\newline ")
+    (bcStrings (30 "Y[1]" g EM)))
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'irelab,irelab)
+  htpSetProperty(page,'hmax,hmax)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02bhfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02bhfGen htPage ==
+  x := htpProperty(htPage, 'x)
+  xend := htpProperty(htPage, 'xend)
+  n := htpProperty(htPage, 'n)
+  tol := htpProperty(htPage, 'tol)
+  irelab := htpProperty(htPage, 'irelab)
+  hmax := htpProperty(htPage, 'hmax)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  g := ((first y).1)
+  y := rest y
+  for i in 1..n repeat
+    ytemp := STRCONC((first y).1," ")
+    yList := [ytemp,:yList]
+    y := rest y
+  ystring := bcwords2liststring yList
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  prefix := STRCONC("d02bhf(", xend,", ",STRINGIMAGE n,", ",STRINGIMAGE irelab)
+  mid := STRCONC(", ",hmax,", ",x,", [", ystring,"],")
+  mid := STRCONC(mid,tol,", ",STRINGIMAGE ifail,",(",g)
+  mid := STRCONC(mid,"::Expression Float)::ASP9('G),(")
+  end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN))")
+  linkGen STRCONC(prefix,mid,end)
+
+  
+d02cjf() ==
+  htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02cjf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02CJF integrates a system of {\it n} ordinary differential ")
+    (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ")
+    (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ")
+    (text . "conditions using an Adams method until a specified ")
+    (text . "function {\em g(x,y)} of the solution is zero; the solution may ")
+    (text . "be output at specified points. \blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Initial value of {\it x}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "0.0" x F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "End of integration range {\it xend}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "10.0" xend F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of differential equations {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Tolerance required {\it tol}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Type of error test used {\it relabs}:")
+    (radioButtons relabs
+        ("" " D, default (mixed)" mix)
+        ("" " A, absolute" abs)
+        ("" " R, relative" rel))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd02cjfSolve)
+  htShowPage()
+
+d02cjfSolve htPage ==
+  x := htpLabelInputString(htPage,'x)
+  xend := htpLabelInputString(htPage,'xend)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  tol := htpLabelInputString(htPage,'tol)
+  control := htpButtonValue(htPage,'relabs)
+  relabs :=
+    control = 'mix => '"D"
+    control = 'abs => '"A"
+    '"R"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '3 => d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ")
+  middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ")
+  yList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+        ynam := INTERN STRCONC ('"u",STRINGIMAGE i)
+        [['bcStrings,[6, 0, ynam, 'F]]]
+  yList :=  [['text,:middle],:yList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}")
+  mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ")
+  vList := [['bcStrings,[30, "2,4", 'out, 'EM]]]
+  vList :=  [['text,:mid],:vList]
+  midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ")
+  midd := STRCONC(midd,'"{\em g(x,y)}: \newline ")
+  uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]]
+  uList :=  [['text,:midd],:uList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:yList,:vList,:uList]
+  page :=  htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} "
+  htSay '"as functions of Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02cjfGen)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'relabs,relabs)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail)   ==
+  n := '3
+  page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (44 "tan(Y[3])" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the initial values of \htbitmap{yi}:")
+    (text . "\newline ")
+    (bcStrings (8 "0.5" y1 EM))
+    (bcStrings (8 "0.5" y2 EM))
+    (bcStrings (8 "\%pi*0.2" y3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Intermediate")
+    (text . " values of {\it x} at which \htbitmap{yi} is required:")
+    (text . "\newline ")
+    (bcStrings (30 "2,4,6,8" out EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the function below {\em g(x,y)}: ")
+    (text . "\newline ")
+    (bcStrings (30 "Y[1]" g EM)))
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'relabs,relabs)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02cjfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02cjfGen htPage ==
+  x := htpProperty(htPage, 'x)
+  xend := htpProperty(htPage, 'xend)
+  n := htpProperty(htPage, 'n)
+  tol := htpProperty(htPage, 'tol)
+  relabs := htpProperty(htPage, 'relabs)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  g := ((first y).1)
+  y := rest y
+  outp := ((first y).1)
+  oList := [outp,:oList]
+  ostring := bcwords2liststring oList
+  -- This is distictly horrible!  OUTP is a comma-seperated string so we
+  -- count up the commas to see how many elements it has.  We return this
+  -- quantity plus 1 since the ASP OUTPUT is always called at least once.
+  numberOfPoints := 
+    ZEROP LENGTH(outp) => 1
+    2+COUNT(CHARACTER(44),outp)
+  y := rest y
+  for i in 1..n repeat
+    ytemp := STRCONC((first y).1," ")
+    yList := [ytemp,:yList]
+    y := rest y
+  ystring := bcwords2liststring yList
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  prefix := STRCONC("d02cjf(",xend,", ",STRINGIMAGE numberOfPoints ,", ", STRINGIMAGE n,", ",tol,",_"",relabs)
+  mid := STRCONC("_", ",x ,", [", ystring,"],",STRINGIMAGE ifail)
+  mid := STRCONC(mid,",(",g,"::Expression Float)::ASP9('G),(",fstring)
+  end := STRCONC("::Vector Expression Float)::ASP7('FCN),(",ostring)
+  end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))")
+  linkGen STRCONC(prefix,mid,end)
+  
+
+
+d02ejf() ==
+  htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02ejf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02EJF integrates a system of {\em n} ordinary differential ")
+    (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for {\it i} ")
+    (text . "= 1,,2,...,{\it n}, over a range with given initial conditions")
+    (text . " using backward differentiation formulae until a specified ")
+    (text . "function {\em g(x,y)} of the solution is zero; the solution may ")
+    (text . "be output at specified points. \blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Initial value of {\it x}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "0.0" x F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "End of integration range {\it xend}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "10.0" xend F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of differential equations {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Tolerance required {\it tol}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Type of error test used {\it relabs}:")
+    (radioButtons relabs
+        ("" " D, default (mixed)" mix)
+        ("" " A, absolute" abs)
+        ("" " R, relative" rel))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd02ejfSolve)
+  htShowPage()
+
+d02ejfSolve htPage ==
+  x := htpLabelInputString(htPage,'x)
+  xend := htpLabelInputString(htPage,'xend)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  tol := htpLabelInputString(htPage,'tol)
+  control := htpButtonValue(htPage,'relabs)
+  relabs :=
+    control = 'mix => '"D"
+    control = 'abs => '"A"
+    '"R"
+  iw := (n + 12) * n + 50
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '3 => d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ")
+  middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ")
+  yList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+        ynam := INTERN STRCONC ('"u",STRINGIMAGE i)
+        [['bcStrings,[6, 0, ynam, 'F]]]
+  yList :=  [['text,:middle],:yList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}")
+  mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ")
+  vList := [['bcStrings,[30, "2,4,6,8", 'out, 'EM]]]
+  vList :=  [['text,:mid],:vList]
+  midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ")
+  midd := STRCONC(midd,'"{\em g(x,y)}: \newline ")
+  uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]]
+  uList :=  [['text,:midd],:uList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:yList,:vList,:uList]
+  page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} "
+  htSay '"as functions of Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htSay '"\blankline {\em Note:} PEDERV is automatically generated using the vector "
+  htSay '"of derivatives given above. "
+  htMakeDoneButton('"Continue",'d02ejfGen)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'relabs,relabs)
+  htpSetProperty(page,'iw,iw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail)   ==
+  n := '3
+  page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (44 "3.0E7*Y[2]*Y[2]" f3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the initial values of \htbitmap{yi}:")
+    (text . "\newline ")
+    (bcStrings (8 "1.0" y1 EM))
+    (bcStrings (8 "0.0" y2 EM))
+    (bcStrings (8 "0.0" y3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Intermediate")
+    (text . " values of {\it x} at which \htbitmap{yi} is required:")
+    (text . "\newline ")
+    (bcStrings (30 "2,4,6,8" out EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the function below {\em g(x,y)}: ")
+    (text . "\newline ")
+    (bcStrings (30 "Y[1]-0.9" g EM))
+    (text . "\blankline ")
+    (text . "{\em Note:} PEDERV is automatically generated using the vector ")
+    (text . "of derivatives given above. "))
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xend,xend)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'relabs,relabs)
+  htpSetProperty(page,'iw,iw)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02ejfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02ejfGen htPage ==
+  x := htpProperty(htPage, 'x)
+  xend := htpProperty(htPage, 'xend)
+  n := htpProperty(htPage, 'n)
+  tol := htpProperty(htPage, 'tol)
+  relabs := htpProperty(htPage, 'relabs)
+  iw := htpProperty(htPage, 'iw)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  g := ((first y).1)
+  y := rest y
+  outp := ((first y).1)
+  oList := [outp,:oList]
+  ostring := bcwords2liststring oList
+  -- This is distictly horrible!  OUTP is a comma-seperated string so we
+  -- count up the commas to see how many elements it has.  We return this
+  -- quantity plus 1 since the ASP OUTPUT is always called at least once.
+  numberOfPoints := 
+    ZEROP LENGTH(outp) => 1
+    2+COUNT(CHARACTER(44),outp)
+  y := rest y
+  for i in 1..n repeat
+    ytemp := STRCONC((first y).1," ")
+    yList := [ytemp,:yList]
+    y := rest y
+  ystring := bcwords2liststring yList
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  prefix := STRCONC("d02ejf(",xend,", ",STRINGIMAGE numberOfPoints,", ", STRINGIMAGE n,",_"",relabs,"_", ")
+  mid:=STRCONC(STRINGIMAGE iw,", ",x ,", [", ystring,"], ",tol,", ")
+  mid := STRCONC(mid,STRINGIMAGE ifail,",(",g,"::Expression Float)::ASP9(G),(")
+  end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",fstring)
+  end := STRCONC(end,"::Vector Expression Float)::ASP31('PEDERV),(",ostring)
+  end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))")
+  linkGen STRCONC(prefix,mid,end)
+
+d02gaf() ==
+  htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02gaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02GAF solves a two-point boundary value problem for a system ")
+    (text . "of n ODEs \center{\htbitmap{d02gaf},} for i = 1,2,...,n, on ")
+    (text . "the range [a,b] with assigned boundary conditions using a ")
+    (text . "deferred correction technique and a Newton iteration; ")
+    (text . "the solution is computed on a mesh. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of equations in the system {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Left hand boundary point {\it a}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Right hand boundary {\it b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "10.0" b F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Max number of mesh points {\it mnp}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Number of points {\it np} ({\it np} = 0 or {\it np} ")
+    (text . "\htbitmap{great=} 4): ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 64 mnp PI))
+    (text . "\tab{34} ")
+    (bcStrings (10 26 np PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Accuracy required {\it tol}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-3" tol F))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail is input in three components: ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it a} ")
+    (radioButtons afail
+        ("" "  0, hard failure" azero)
+        ("" "  1, soft failure" aone))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it b} ")
+    (radioButtons bfail
+        ("" "  1, print error messages" bone)
+        ("" "  0, suppress error messages" bzero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it c} ")
+    (radioButtons cfail
+        ("" "  1, print warning messages" cone)
+        ("" "  0, suppress warning messages" czero)))
+  htMakeDoneButton('"Continue", 'd02gafSolve)
+  htShowPage()
+
+d02gafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  mnp :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp)
+    objValUnwrap htpLabelSpadValue(htPage, 'mnp)
+  np :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np)
+    objValUnwrap htpLabelSpadValue(htPage, 'np)
+  lw := mnp * (3*n*n + 6*n + 2) + 4*n*n + 4*n
+  liw := mnp * (2*n + 1) + n*n + 4*n + 2
+  tol := htpLabelInputString(htPage,'tol)
+  aerror := htpButtonValue(htPage,'afail)
+  afail :=
+    aerror = 'azero => '0
+    '1
+  berror := htpButtonValue(htPage,'bfail)
+  bfail :=
+    berror = 'bone => '1
+    '0
+  cerror := htpButtonValue(htPage,'cfail)
+  cfail :=
+    cerror = 'cone => '1
+    '0
+  ifail := 100*cfail + 10*bfail + afail
+  n = '3 => d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter known or estimated ")
+  middle := STRCONC(middle,'"values of \htbitmap{yi} at a and b, ")
+  middle := STRCONC(middle,"{\it U(n,2)}. [\htbitmap{yi}(a) in the first ")
+  middle := STRCONC(middle,"column, \htbitmap{yi}(b) in the second.] ")
+  middle := STRCONC(middle,"\newline ")
+  uList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+       labelList := 
+         "append"/[fc(i,j) for j in 1..2] where fc(i,j) ==
+            unam := INTERN STRCONC ('"u",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, unam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  uList :=  [['text,:middle],:uList]
+  mid := ('"\blankline \menuitemstyle{} \tab{2} Enter {\it V(n,2)}. ")
+  mid := STRCONC(mid,'"If U(i,j) is known V(i,j) ")
+  mid := STRCONC(mid,'"= 0.0, else V(i,j) = 1.0. \newline ")
+  vList := 
+    "append"/[fd(i) for i in 1..n] where fd(i) ==
+       labelList := 
+         "append"/[fe(i,j) for j in 1..2] where fe(i,j) ==
+            vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, vnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  vList :=  [['text,:mid],:vList]
+  xList := 
+    "append"/[ff(i) for i in 1..mnp] where ff(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, "0.0", xnam, 'F]]]
+  end := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial mesh ")
+  end := STRCONC(end,'"{\it X(mnp)}: \newline ")
+  xList :=  [['text,:end],:xList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:uList,:vList,:xList]
+  page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions (i.e. the derivatives) below as functions of "
+  htSay '"Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02gafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) ==
+  n := '3
+  page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions (i.e. the derivatives) below ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "Y[2]" f1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "Y[3]" f2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" f3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter known or estimated values of \htbitmap{yi} at a and b,")
+    (text . " {\it U(n,2)}. ")
+    (text . " [\htbitmap{yi}(a) in the first column, \htbitmap{yi}(b) ")
+    (text . "in the second.] \newline ")
+    (bcStrings (6 "0" u11 F))
+    (bcStrings (6 "10" u21 F))
+    (text . "\newline ")
+    (bcStrings (6 "0" u12 F))
+    (bcStrings (6 "1" u22 F))
+    (text . "\newline ")
+    (bcStrings (6 "0" u13 F))
+    (bcStrings (6 "0" u23 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter {\it V(n,2)}. ")
+    (text . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \newline")
+    (bcStrings (6 "0.0" v11 F))
+    (bcStrings (6 "1.0" v21 F))
+    (text . "\newline ")
+    (bcStrings (6 "0.0" v12 F))
+    (bcStrings (6 "0.0" v22 F))
+    (text . "\newline ")
+    (bcStrings (6 "1.0" v13 F))
+    (bcStrings (6 "1.0" v23 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the initial mesh {\it X(mnp)}: ")
+    (text . "\newline ")
+    (bcStrings (8 "0.0" x1 F))
+    (bcStrings (8 "0.4" x2 F))
+    (bcStrings (8 "0.8" x3 F))
+    (bcStrings (8 "1.2" x4 F))
+    (bcStrings (8 "1.6" x5 F))
+    (bcStrings (8 "2.0" x6 F))
+    (bcStrings (8 "2.4" x7 F))
+    (bcStrings (8 "2.8" x8 F))
+    (bcStrings (8 "3.2" x9 F))
+    (bcStrings (8 "3.6" x10 F))
+    (bcStrings (8 "4.0" x11 F))
+    (bcStrings (8 "4.4" x12 F))
+    (bcStrings (8 "4.8" x13 F))
+    (bcStrings (8 "5.2" x14 F))
+    (bcStrings (8 "5.6" x15 F))
+    (bcStrings (8 "6.0" x16 F))
+    (bcStrings (8 "6.4" x17 F))
+    (bcStrings (8 "6.8" x18 F))
+    (bcStrings (8 "7.2" x19 F))
+    (bcStrings (8 "7.6" x20 F))
+    (bcStrings (8 "8.0" x21 F))
+    (bcStrings (8 "8.4" x22 F))
+    (bcStrings (8 "8.8" x23 F))
+    (bcStrings (8 "9.2" x24 F))
+    (bcStrings (8 "9.6" x25 F))
+    (bcStrings (8 "10.0" x26 F))
+    (bcStrings (8 "0.0" x27 F))
+    (bcStrings (8 "0.0" x28 F))
+    (bcStrings (8 "0.0" x29 F))
+    (bcStrings (8 "0.0" x30 F))
+    (bcStrings (8 "0.0" x31 F))
+    (bcStrings (8 "0.0" x32 F))
+    (bcStrings (8 "0.0" x33 F))
+    (bcStrings (8 "0.0" x34 F))
+    (bcStrings (8 "0.0" x35 F))
+    (bcStrings (8 "0.0" x36 F))
+    (bcStrings (8 "0.0" x37 F))
+    (bcStrings (8 "0.0" x38 F))
+    (bcStrings (8 "0.0" x39 F))
+    (bcStrings (8 "0.0" x40 F))
+    (bcStrings (8 "0.0" x41 F))
+    (bcStrings (8 "0.0" x42 F))
+    (bcStrings (8 "0.0" x43 F))
+    (bcStrings (8 "0.0" x44 F))
+    (bcStrings (8 "0.0" x45 F))
+    (bcStrings (8 "0.0" x46 F))
+    (bcStrings (8 "0.0" x47 F))
+    (bcStrings (8 "0.0" x48 F))
+    (bcStrings (8 "0.0" x49 F))
+    (bcStrings (8 "0.0" x50 F))
+    (bcStrings (8 "0.0" x51 F))
+    (bcStrings (8 "0.0" x52 F))
+    (bcStrings (8 "0.0" x53 F))
+    (bcStrings (8 "0.0" x54 F))
+    (bcStrings (8 "0.0" x55 F))   
+    (bcStrings (8 "0.0" x56 F))   
+    (bcStrings (8 "0.0" x57 F))  
+    (bcStrings (8 "0.0" x58 F))   
+    (bcStrings (8 "0.0" x59 F))   
+    (bcStrings (8 "0.0" x60 F))   
+    (bcStrings (8 "0.0" x61 F))   
+    (bcStrings (8 "0.0" x62 F))   
+    (bcStrings (8 "0.0" x63 F))   
+    (bcStrings (8 "0.0" x64 F)))
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02gafGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02gafGen htPage ==
+  n := htpProperty(htPage, 'n)
+  a := htpProperty(htPage, 'a)
+  b := htpProperty(htPage, 'b)
+  mnp := htpProperty(htPage, 'mnp)
+  np := htpProperty(htPage, 'np)
+  lw := htpProperty(htPage, 'lw)
+  liw := htpProperty(htPage, 'liw)
+  ifail := htpProperty(htPage,'ifail)
+  tol := htpProperty(htPage,'tol)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..mnp repeat
+    x := STRCONC((first y).1," ")
+    xList := [x,:xList]
+    y := rest y
+  xstring := bcwords2liststring xList
+  for i in 1..n repeat
+    for j in 1..2 repeat
+      v := STRCONC((first y).1," ")
+      rowList := [v,:rowList]
+      y := rest y
+    vList := [:vList,rowList]
+    rowList := []
+  for i in 1..n repeat
+    for j in 1..2 repeat
+      u := STRCONC((first y).1," ")
+      rowList := [u,:rowList]
+      y := rest y
+    uList := [:uList,rowList]
+    rowList := []
+  vList := reverse vList
+  uList := reverse uList
+  vstring := bcwords2liststring [bcwords2liststring x for x in vList]
+  ustring := bcwords2liststring [bcwords2liststring x for x in uList]
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  Y:='Y
+  prefix := STRCONC("d02gaf(",ustring,", ",vstring,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,a,", ",b,", ",tol,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE mnp,", ",STRINGIMAGE lw,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liw,", [",xstring,"], ",STRINGIMAGE np)
+  end:=STRCONC (",",STRINGIMAGE ifail,",(",fstring,"::Vector Expression Float")
+  linkGen STRCONC (prefix,end,")::ASP7('FCN))")
+
+d02gbf() ==
+  htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02gbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02GBF solves a general linear two-point boundary value problem ")
+    (text . "for a system of n ODEs {\it y' = F(x)y + g(x)} on the range ")
+    (text . "[a,b] with boundary conditions {\it Cy(a) + Dy(b) = \gamma} ")
+    (text . "using a deferred correction technique.")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of equations in the system {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Left hand boundary point {\it a}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Right hand boundary {\it b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0" b F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Max number of mesh points {\it mnp}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Number of points {\it np}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 70 mnp PI))
+    (text . "\tab{34} ")
+    (bcStrings (10 0 np PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Accuracy required {\it tol}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-3" tol F))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail is input in three components: ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it a} ")
+    (radioButtons afail
+        ("" "  0, hard failure" azero)
+        ("" "  1, soft failure" aone))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it b} ")
+    (radioButtons bfail
+        ("" "  1, print error messages" bone)
+        ("" "  0, suppress error messages" bzero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it c} ")
+    (radioButtons cfail
+        ("" "  1, print warning messages" cone)
+        ("" "  0, suppress warning messages" czero)))
+  htMakeDoneButton('"Continue", 'd02gbfSolve)
+  htShowPage()
+
+d02gbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  mnp :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp)
+    objValUnwrap htpLabelSpadValue(htPage, 'mnp)
+  np :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np)
+    objValUnwrap htpLabelSpadValue(htPage, 'np)
+  lw := mnp * (3*n*n + 5*n + 2) + 3*n*n + 5*n
+  liw := mnp * (2*n + 1) + n
+  tol := htpLabelInputString(htPage,'tol)
+  aerror := htpButtonValue(htPage,'afail)
+  afail :=
+    aerror = 'azero => '0
+    '1
+  berror := htpButtonValue(htPage,'bfail)
+  bfail :=
+    berror = 'bone => '1
+    '0
+  cerror := htpButtonValue(htPage,'cfail)
+  cfail :=
+    cerror = 'cone => '1
+    '0
+  ifail := 100*cfail + 10*bfail + afail
+  n = '2 => d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail)
+  cList := 
+    "append"/[fa(i,n) for i in 1..n] where fa(i,n) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            cnam := INTERN STRCONC ('"c",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, cnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix {\it D}: ")
+  middle := STRCONC(middle,"\newline ")  
+  dList := 
+    "append"/[fc(i,n) for i in 1..n] where fc(i,n) ==
+       labelList := 
+         "append"/[fd(i,j) for j in 1..n] where fd(i,j) ==
+            dnam := INTERN STRCONC ('"d",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, dnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  dList :=  [['text,:middle],:dList]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector \gamma: ")
+  middle := STRCONC(middle,"\newline ")  
+  gamList := 
+    "append"/[fe(i) for i in 1..n] where fe(i) ==
+      gamnam := INTERN STRCONC ('"gam",STRINGIMAGE i)
+      [['bcStrings,[6, 0, gamnam, 'F]]]
+  prefix := ('"\newline ")
+  gamList := [['text,:middle],:gamList]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ")
+  middle := STRCONC(middle,"{\it F(x)} from the equation {\it y' =} ")
+  middle := STRCONC(middle,"{\it F(x)y + g(x)}: \newline ")  
+  fList := 
+    "append"/[ff(i,n) for i in 1..n] where ff(i,n) ==
+       labelList := 
+         "append"/[fg(i,j) for j in 1..n] where fg(i,j) ==
+            fnam := INTERN STRCONC ('"f",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, fnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  fList :=  [['text,:middle],:fList]
+  mid := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector {\it g(x)}: ")
+  mid := STRCONC(mid,'"\newline ")
+  gList := 
+    "append"/[fh(i) for i in 1..n] where fh(i) ==
+      gnam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['bcStrings,[6, 0, gnam, 'F]]]
+  prefix := ('"\newline ")
+  gList := [['text,:middle],:gList]
+  xList := 
+    "append"/[fi(i) for i in 1..mnp] where fi(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, "0.0", xnam, 'F]]]
+  end := ('"\blankline \menuitemstyle{} \tab{2} The initial mesh {\it X(mnp)}")
+  end := STRCONC(end,'", (all entries = 0 if np < 4): \newline ")
+  xList :=  [['text,:end],:xList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:cList,:dList,:gamList,:fList,:gList,:xList]
+  page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the matrix {\it C} form the equation {\it Cy(a) + Dy(b)} "
+  htSay '"= \gamma \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02gbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) ==
+  n := '2
+  page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it C} from the equation {\it Cy(a) + Dy(b)} = \gamma:")
+    (text . "\newline ")
+    (bcStrings (6 "1" c11 F))
+    (bcStrings (6 "0" c12 F))
+    (text . "\newline ")
+    (bcStrings (6 "0" c21 F))
+    (bcStrings (6 "0" c22 F))
+    (text . "\blankline \menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it D}: \newline ")
+    (bcStrings (6 "0" d11 F))
+    (bcStrings (6 "0" d12 F))
+    (text . "\newline ")
+    (bcStrings (6 "1" d21 F))
+    (bcStrings (6 "0" d22 F))
+    (text . "\blankline \menuitemstyle{}\tab{2}")
+    (text . "Enter the vector \gamma: \newline ")
+    (bcStrings (6 "0" gam1 F))
+    (bcStrings (6 "1" gam2 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it F(x)} from the equation {\it y' = F(x)y + g(x)} : ")
+    (text . "\newline ")
+    (bcStrings (6 "0" f11 F))
+    (bcStrings (6 "1" f12 F))
+    (text . "\newline ")
+    (bcStrings (6 "0" f21 F))
+    (bcStrings (6 "-10" f22 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the vector {\it g(x)}: ")
+    (text . "\newline ")
+    (bcStrings (6 "0" g1 F))
+    (bcStrings (6 "0" g2 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} The initial mesh {\it X(mnp)}, ")
+    (text . "(all entries = 0 if np < 4): \newline ")
+    (bcStrings (8 "0.0" x1 F))
+    (bcStrings (8 "0.0" x2 F))
+    (bcStrings (8 "0.0" x3 F))
+    (bcStrings (8 "0.0" x4 F))
+    (bcStrings (8 "0.0" x5 F))
+    (bcStrings (8 "0.0" x6 F))
+    (bcStrings (8 "0.0" x7 F))
+    (bcStrings (8 "0.0" x8 F))
+    (bcStrings (8 "0.0" x9 F))
+    (bcStrings (8 "0.0" x10 F))
+    (bcStrings (8 "0.0" x11 F))
+    (bcStrings (8 "0.0" x12 F))
+    (bcStrings (8 "0.0" x13 F))
+    (bcStrings (8 "0.0" x14 F))
+    (bcStrings (8 "0.0" x15 F))
+    (bcStrings (8 "0.0" x16 F))
+    (bcStrings (8 "0.0" x17 F))
+    (bcStrings (8 "0.0" x18 F))
+    (bcStrings (8 "0.0" x19 F))
+    (bcStrings (8 "0.0" x20 F))
+    (bcStrings (8 "0.0" x21 F))
+    (bcStrings (8 "0.0" x22 F))
+    (bcStrings (8 "0.0" x23 F))
+    (bcStrings (8 "0.0" x24 F))
+    (bcStrings (8 "0.0" x25 F))
+    (bcStrings (8 "0.0" x26 F))
+    (bcStrings (8 "0.0" x27 F))
+    (bcStrings (8 "0.0" x28 F))
+    (bcStrings (8 "0.0" x29 F))
+    (bcStrings (8 "0.0" x30 F))
+    (bcStrings (8 "0.0" x31 F))
+    (bcStrings (8 "0.0" x32 F))
+    (bcStrings (8 "0.0" x33 F))
+    (bcStrings (8 "0.0" x34 F))
+    (bcStrings (8 "0.0" x35 F))
+    (bcStrings (8 "0.0" x36 F))
+    (bcStrings (8 "0.0" x37 F))
+    (bcStrings (8 "0.0" x38 F))
+    (bcStrings (8 "0.0" x39 F))
+    (bcStrings (8 "0.0" x40 F))
+    (bcStrings (8 "0.0" x41 F))
+    (bcStrings (8 "0.0" x42 F))
+    (bcStrings (8 "0.0" x43 F))
+    (bcStrings (8 "0.0" x44 F))
+    (bcStrings (8 "0.0" x45 F))
+    (bcStrings (8 "0.0" x46 F))
+    (bcStrings (8 "0.0" x47 F))
+    (bcStrings (8 "0.0" x48 F))
+    (bcStrings (8 "0.0" x49 F))
+    (bcStrings (8 "0.0" x50 F))
+    (bcStrings (8 "0.0" x51 F))
+    (bcStrings (8 "0.0" x52 F))
+    (bcStrings (8 "0.0" x53 F))
+    (bcStrings (8 "0.0" x54 F))
+    (bcStrings (8 "0.0" x55 F))   
+    (bcStrings (8 "0.0" x56 F))   
+    (bcStrings (8 "0.0" x57 F))  
+    (bcStrings (8 "0.0" x58 F))   
+    (bcStrings (8 "0.0" x59 F))   
+    (bcStrings (8 "0.0" x60 F))   
+    (bcStrings (8 "0.0" x61 F))   
+    (bcStrings (8 "0.0" x62 F))   
+    (bcStrings (8 "0.0" x63 F))   
+    (bcStrings (8 "0.0" x64 F))
+    (bcStrings (8 "0.0" x65 F))
+    (bcStrings (8 "0.0" x66 F))
+    (bcStrings (8 "0.0" x67 F))
+    (bcStrings (8 "0.0" x68 F))
+    (bcStrings (8 "0.0" x69 F))
+    (bcStrings (8 "0.0" x70 F)))
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02gbfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02gbfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  a := htpProperty(htPage, 'a)
+  b := htpProperty(htPage, 'b)
+  mnp := htpProperty(htPage, 'mnp)
+  np := htpProperty(htPage, 'np)
+  lw := htpProperty(htPage, 'lw)
+  liw := htpProperty(htPage, 'liw)
+  ifail := htpProperty(htPage,'ifail)
+  tol := htpProperty(htPage,'tol)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..mnp repeat -- matrix
+    x := STRCONC((first y).1," ")
+    xList := [x,:xList]
+    y := rest y
+  xstring := bcwords2liststring xList
+  for i in 1..n repeat  -- vector g
+    g := STRCONC((first y).1," ")
+    gList := [g,:gList]
+    y := rest y
+  gstring := bcwords2liststring gList
+  for i in 1..n repeat -- matrix F
+    for j in 1..n repeat
+      f := STRCONC((first y).1," ")
+      flist := [f,:flist]
+      y := rest y
+    fmatlist := [:fmatlist,flist]
+    flist := []
+  fmatlist := reverse fmatlist 
+  fmatstr := bcwords2liststring [bcwords2liststring x for x in fmatlist]
+  for i in 1..n repeat  -- vector gamma
+    gam := STRCONC((first y).1," ")
+    gamList := [gam,:gamList]
+    y := rest y
+  gamstr := bcwords2liststring gamList
+  for i in 1..n repeat -- matrix D
+    for j in 1..n repeat
+      d := STRCONC((first y).1," ")
+      dlist := [d,:dlist]
+      y := rest y
+    dmatlist := [:dmatlist,dlist]
+    dlist := []
+  dmatlist := reverse dmatlist 
+  dmatstr := bcwords2liststring [bcwords2liststring x for x in dmatlist]
+  for i in 1..n repeat -- matrix C
+    for j in 1..n repeat
+      c := STRCONC((first y).1," ")
+      clist := [c,:clist]
+      y := rest y
+    cmatlist := [:cmatlist,clist]
+    clist := []
+  cmatlist := reverse cmatlist 
+  cmatstr := bcwords2liststring [bcwords2liststring x for x in cmatlist]
+  prefix := STRCONC("d02gbf(",STRINGIMAGE a,", ",STRINGIMAGE b,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",tol,", ",STRINGIMAGE mnp,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lw,", ",STRINGIMAGE liw,", ")
+  prefix := STRCONC(prefix,cmatstr,"::Matrix DoubleFloat,",dmatstr,"::Matrix DoubleFloat,[",gamstr,"]::Matrix DoubleFloat,[",xstring,"]::Matrix DoubleFloat, ")
+  mid := STRCONC(STRINGIMAGE np,", ",STRINGIMAGE ifail,", ")
+  end := STRCONC("(",fmatstr,"::Matrix(Expression(Float)))::ASP77(FCNF),(",gstring)
+  linkGen STRCONC(prefix,mid,end,"::Vector(Expression(Float)))::ASP78(FCNG))")
+
+d02kef() ==
+  htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02kef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02KEF finds a specified eigenvalue \htbitmap{lamdab} of a ")
+    (text . "regular or second-order Sturm-Liouville system ")
+    (text . "{\it(p(x)y')' + q(x; \lambda)y = 0} on a finite or infinite ")
+    (text . "range [a,b]; a Pruefer transformation and shooting method ")
+    (text . "are used; discontinuities in coefficient functions or their ")
+    (text . "derivatives are permitted. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of points in XPOINT {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Index of the `break-point' {\it match}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 0 match PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Index of the required eigenvalue {\it k}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 11 k PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Accuracy required {\it tol}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0001" tol F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Eigenvalue estimate {\it elam}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Scale of the problem {\it delam}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "14" elam F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1" delam F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Max iterations {\it maxit}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Max COEFFN calls {\it maxfun}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 0 maxit PI))
+    (text . "\tab{34} ")
+    (bcStrings (10 0 maxfun PI))
+    (text . "\blankline ")
+    (text . "\tab{2} \newline {\it Note:} no bound is assumed ") 
+    (text . "if maxit = 0 \blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd02kefSolve)
+  htShowPage()
+
+d02kefSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  match :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'match)
+    objValUnwrap htpLabelSpadValue(htPage, 'match)
+  k :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k)
+    objValUnwrap htpLabelSpadValue(htPage, 'k)
+  tol := htpLabelInputString(htPage,'tol)
+  elam := htpLabelInputString(htPage,'elam)
+  delam := htpLabelInputString(htPage,'delam)
+  maxit :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxit)
+  maxfun :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxfun)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxfun)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'minusOne => '-1
+    '1
+  m = '5 =>d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail)
+  xpList := 
+    "append"/[fa(i) for i in 1..m] where fa(i) ==
+      xpnam := INTERN STRCONC ('"xp",STRINGIMAGE i)
+      [['bcStrings,[10, "0.0", xpnam, 'EM]]]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it p} for COEFFN:")
+  middle := STRCONC(middle,"\newline ")
+  cList :=  [['text,:middle],['bcStrings,[42, "0.0", 'c1, 'EM]]]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it q} for COEFFN:")
+  middle := STRCONC(middle,"\newline ")
+  c1List := [['text,:middle],['bcStrings,[42, "0.0", 'c2, 'EM]]]
+  cList :=  [:cList,:c1List]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it dqdl}")
+  middle := STRCONC(middle," for COEFFN: \newline ")
+  c2List := [['text,:middle],['bcStrings,[42, "0.0", 'c3, 'EM]]]
+  cList :=  [:cList,:c2List]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YL(1) & YL(2) ")
+  middle := STRCONC(middle,"for BDYVAL: \newline ")
+  ylList := 
+    "append"/[fb(i) for i in 1..2] where fb(i) ==
+      ylnam := INTERN STRCONC ('"yl",STRINGIMAGE i)
+      [['bcStrings,[42, "0.0", ylnam, 'EM]]]
+  ylList := [['text,:middle],:ylList]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YR(1) & YR(2) ")
+  middle := STRCONC(middle,"for BDYVAL: \newline ")
+  yrList := 
+    "append"/[fc(i) for i in 1..2] where fc(i) ==
+      yrnam := INTERN STRCONC ('"yr",STRINGIMAGE i)
+      [['bcStrings,[42, "0.0", yrnam, 'EM]]]
+  yrList := [['text,:middle],:yrList]
+  middle:=('"\blankline \menuitemstyle{} \tab{2} Maximum step size ")
+  middle := STRCONC(middle,"{\it hmax(2,m)}: \newline ")
+  hList := 
+    "append"/[fd(i,m) for i in 1..2] where fd(i,m) ==
+       labelList := 
+         "append"/[fe(i,j) for j in 1..m] where fe(i,j) ==
+            hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", hnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  hList := [['text,:middle],:hList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:xpList,:cList,:ylList,:yrList,:hList]
+  page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil)
+  htSay '"\menuitemstyle{}\tab{2} Enter points where boundary "
+  htSay '"conditions are to be imposed {\it xpoint}: \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02kefGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'match,match)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'elam,elam)
+  htpSetProperty(page,'delam,delam)
+  htpSetProperty(page,'maxit,maxit)
+  htpSetProperty(page,'maxfun,maxfun)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) ==
+  m := '5
+  page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter points where boundary conditions are to be imposed ")
+    (text . "{\it xpoint}: \newline ")
+    (bcStrings (10 "0.0" xp1 F))
+    (bcStrings (10 "0.1" xp2 F))
+    (bcStrings (10 "4**(1/3)" xp3 F))
+    (bcStrings (10 "30.0" xp4 F))
+    (bcStrings (10 "30.0" xp5 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Value of {\it p} for COEFFN: \newline ")
+    (bcStrings (42 "1.0" c1 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Value of {\it q} for COEFFN: \newline ")
+    (bcStrings (42 "ELAM-X-2.0/(X*X)" c2 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Value of {\it dqdl} for COEFFN: \newline ")
+    (bcStrings (42 "1.0" c3 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Values of YL(1) & YL(2) for BDYVAL: \newline ")
+    (bcStrings (42 "XL" yl1 EM))
+    (bcStrings (42 "2.0" yl2 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Values of YR(1) & YR(2) for BDYVAL: \newline ")
+    (bcStrings (42 "1.0" yr1 EM))
+    (bcStrings (42 "-sqrt(XR-ELAM)" yr2 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Maximum step size {\it hmax(2,m)}: \newline ")
+    (bcStrings (6 "0.0" h11 F))
+    (bcStrings (6 "0.0" h12 F))
+    (bcStrings (6 "0.0" h13 F))
+    (bcStrings (6 "0.0" h14 F))
+    (bcStrings (6 "0.0" h15 F))
+    (text . "\newline ")
+    (bcStrings (6 "0.0" h21 F))
+    (bcStrings (6 "0.0" h22 F))
+    (bcStrings (6 "0.0" h23 F))
+    (bcStrings (6 "0.0" h24 F))
+    (bcStrings (6 "0.0" h25 F)))
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'match,match)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'elam,elam)
+  htpSetProperty(page,'delam,delam)
+  htpSetProperty(page,'maxit,maxit)
+  htpSetProperty(page,'maxfun,maxfun)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02kefGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02kefGen htPage ==
+  m := htpProperty(htPage, 'm)
+  match := htpProperty(htPage, 'match)
+  k := htpProperty(htPage, 'k)
+  tol := htpProperty(htPage, 'tol)
+  elam := htpProperty(htPage, 'elam)
+  delam := htpProperty(htPage, 'delam)
+  maxit := htpProperty(htPage, 'maxit)
+  maxfun := htpProperty(htPage, 'maxfun)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..m repeat
+    for j in 1..2 repeat
+      h := STRCONC((first y).1," ")
+      rowList := [h,:rowList]
+      y := rest y
+    hList := [:hList,rowList]
+    rowList := []
+  hList := reverse hList
+  hstring := bcwords2liststring [bcwords2liststring x for x in hList]
+  for i in 1..2 repeat
+    for j in 1..2 repeat
+      b := STRCONC((first y).1," ")
+      rowList := [b,:rowList]
+      y := rest y
+    bList := [:bList,rowList]
+    rowList := []
+  bList := reverse bList
+  bstring := bcwords2liststring [bcwords2liststring x for x in bList]
+  for i in 1..3 repeat
+    c := STRCONC((first y).1," ")
+    cList := [c,:cList]
+    y := rest y
+  cstring := bcwords2liststring cList
+  while y repeat
+    x := STRCONC((first y).1," ")
+    xList := [x,:xList]
+    y := rest y
+  xstring := bcwords2liststring xList
+  prefix := STRCONC("d02kef([",xstring,"]::Matrix DoubleFloat, ",STRINGIMAGE m)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE k,", ",tol,", ",STRINGIMAGE maxfun)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE match,", ",STRINGIMAGE elam,", ")
+  prefix:=STRCONC(prefix,STRINGIMAGE delam,", ",hstring,", ",STRINGIMAGE maxit)
+  end := STRCONC(", ",STRINGIMAGE ifail,",(",cstring,"::Vector(Expression Float))::ASP10(COEFFN)")
+  end := STRCONC(end,", (",bstring,"::Matrix Expression Float)::ASP80('BDYVAL))")
+  linkGen STRCONC (prefix,end)
+
+d02raf() ==
+  htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXd02raf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D02RAF solves a two-point boundary value problem for a system ")
+    (text . "of {\it n} first-order ordinary differential equations ")
+    (text . "{\it \htbitmap{yi}'= \htbitmap{fi}(x,y)}, for {\it i} = 1,2,...,")
+    (text . "{\it n}, on the range [a,b] with {\it n} nonlinear boundary ")
+    (text . "conditions \htbitmap{gi}{\it (y(a),y(b)) = 0} for {\it i} = 1,2,")
+    (text . "...,{\it n} using a deferred correction technique and a Newton ")
+    (text . "iteration; the solution is computed on a mesh.  A continuation ")
+    (text . "facility is provided for which a family of problems is solved ")
+    (text . "posed as {\it y' = f(x,y,\epsilon)} subject to the boundary ")
+    (text . "conditions {\it g(y(a),y(b),\epsilon) = 0}, where \epsilon ")
+    (text . "is the continuation parameter. The choice \epsilon = 0 should ")
+    (text . "define an easy problem to solve and \epsilon = 1 the problem ")
+    (text . "whose solution is required; a sequence of problems is solved ")
+    (text . "with 0 = \htbitmap{ep1} < \htbitmap{ep2} < ... \htbitmap{epp} ")
+    (text . "= 1 where {\it p} and the \htbitmap{epi} are chosen by D02RAF. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of differential equations {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The maximum number of points in the mesh {\it mnp}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 40 mnp PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of points in the initial mesh {\it np}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 17 np PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline Number of boundary conditions involving y(a) only ")
+    (text . "{\it numbeg}: \newline\tab{2} ")
+    (bcStrings (5 2 numbeg PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Boundary conditions involving both y(a) and ")
+    (text . "y(b) {\it nummix}: \newline\tab{2} ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 0 nummix PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Absolute error tolerance {\it tol}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-4" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Do you wish to use an intial mesh or default values,{\it init} ")
+    (radioButtons init
+        ("" " default values" init_zero)
+        ("" " initial mesh" init_nonZero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "First dimension of y, {\it iy}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 iy PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Are JACOBF & JACOBG routines being supplied, {\it ijac}:")
+    (radioButtons ijac
+        ("" " yes" ijac_nonZero)
+        ("" " no" ijac_zero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Continuation facility {\it deleps}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 "0.1" deleps F))
+    (text . "\newline\tab{2} ")
+    (text . "Note: For 0.0 \htbitmap{great=} deleps > 1.0, continuation ")    
+    (text . "is not used. ")
+    (text . "\blankline ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail is input in three components: ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it a} ")
+    (radioButtons afail
+        ("" "  0, hard failure" azero)
+        ("" "  1, soft failure" aone))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it b} ")
+    (radioButtons bfail
+        ("" "  1, print error messages" bone)
+        ("" "  0, suppress error messages" bzero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it c} ")
+    (radioButtons cfail
+        ("" "  1, print warning messages" cone)
+        ("" "  0, suppress warning messages" czero)))
+  htMakeDoneButton('"Continue", 'd02rafSolve)
+  htShowPage()
+
+d02rafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  mnp :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp)
+    objValUnwrap htpLabelSpadValue(htPage, 'mnp)
+  np :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np)
+    objValUnwrap htpLabelSpadValue(htPage, 'np)
+  numbeg :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'numbeg)
+    objValUnwrap htpLabelSpadValue(htPage, 'numbeg)
+  nummix :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nummix)
+    objValUnwrap htpLabelSpadValue(htPage, 'nummix)
+  tol := htpLabelInputString(htPage,'tol)
+  mesh := htpButtonValue(htPage,'init)
+  init :=
+    mesh = 'init_zero => '0 
+    '1
+  iy := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iy)
+    objValUnwrap htpLabelSpadValue(htPage, 'iy)
+  jacob := htpButtonValue(htPage,'ijac)
+  ijac :=
+    jacob = 'ijac_zero => '0
+    '1
+  deleps := htpLabelInputString(htPage,'deleps)
+  lwork := mnp*(3*n*n + 6*n +2) +4*n*n + 3*n
+  liwork :=
+    ijac = 0 => mnp*(2*n +1) + n*n + 4*n +2
+    mnp*(2*n +1) + n
+  aerror := htpButtonValue(htPage,'afail)
+  afail :=
+    aerror = 'azero => '0
+    '1
+  berror := htpButtonValue(htPage,'bfail)
+  bfail :=
+    berror = 'bone => '1
+    '0
+  cerror := htpButtonValue(htPage,'cfail)
+  cfail :=
+    cerror = 'cone => '1
+    '0
+  ifail := 100*cfail + 10*bfail + afail
+  (n = '3 and init = '0 and iy = '3 and nummix = '0 and numbeg = '2 and np = '17 and mnp = '40) => d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail)
+  init = '1 => d02rafCopOut()
+  funcList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      prefix := ('"\newline {\em Function f")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := STRCONC ('"Y[",STRINGIMAGE i ,"]")
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, fnam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the functions ")
+  middle := STRCONC(middle,'"\htbitmap{gi} below ")
+  middle := STRCONC(middle,'"as functions of YA[i] and YB[i]: \newline ")
+  gList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+      prefix := ('"\newline {\em Function g")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      fnc := STRCONC ('"YA[",STRINGIMAGE i ,"]")
+      gnam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, fnc, gnam, 'EM]]]
+  gList :=  [['text,:middle],:gList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the array ")
+  mid := STRCONC(mid,'"{\it x(mnp)}: \newline ")
+  xList := 
+    "append"/[fc(i) for i in 1..mnp] where fc(i) ==
+        xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+        [['bcStrings,[4, 0, xnam, 'F]]]
+  xList :=  [['text,:mid],:xList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:funcList,:gList,:xList]
+  page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions \htbitmap{fi} (i.e. the derivatives) below "
+  htSay '"as functions of Y[1]...Y[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d02rafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'numbeg,numbeg)
+  htpSetProperty(page,'nummix,nummix)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'iy,iy)
+  htpSetProperty(page,'ijac,ijac)
+  htpSetProperty(page,'deleps,deleps)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) ==
+  n := '3
+  page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} (i.e. the derivatives) below ")
+    (text . "as functions of Y[1]...Y[n]: ")
+    (text . "\newline {\em Function f1:} \space{1}")
+    (bcStrings (44 "Y[2]" f1 EM))
+    (text . "\newline {\em Function f2:} \space{1}")
+    (bcStrings (44 "Y[3]" f2 EM))
+    (text . "\newline {\em Function f3:} \space{1}")
+    (bcStrings (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" f3 EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{gi} below ")
+    (text . "as functions of YA[i] and YB[i]: ")
+    (text . "\newline {\em Function g1:} \space{1}")
+    (bcStrings (44 "YA[1]" g1 EM))
+    (text . "\newline {\em Function g2:} \space{1}")
+    (bcStrings (44 "YA[2]" g2 EM))
+    (text . "\newline {\em Function g3:} \space{1}")
+    (bcStrings (44 "YB[2] -1" g3 EM))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the array {\it x(mnp)}: \newline ")
+    (bcStrings (4 "0.0" x1 F))
+    (bcStrings (4 "0.0" x2 F))
+    (bcStrings (4 "0.0" x3 F))
+    (bcStrings (4 "0.0" x4 F))
+    (bcStrings (4 "0.0" x5 F))
+    (bcStrings (4 "0.0" x6 F))
+    (bcStrings (4 "0.0" x7 F))
+    (bcStrings (4 "0.0" x8 F))
+    (bcStrings (4 "0.0" x9 F))
+    (bcStrings (4 "0.0" x10 F))
+    (bcStrings (4 "0.0" x11 F))
+    (bcStrings (4 "0.0" x12 F))
+    (bcStrings (4 "0.0" x13 F))
+    (bcStrings (4 "0.0" x14 F))
+    (bcStrings (4 "0.0" x15 F))
+    (bcStrings (4 "0.0" x16 F))
+    (bcStrings (4 "10.0" x17 F))
+    (bcStrings (4 "0.0" x18 F))
+    (bcStrings (4 "0.0" x19 F))
+    (bcStrings (4 "0.0" x20 F))
+    (bcStrings (4 "0.0" x21 F))
+    (bcStrings (4 "0.0" x22 F))
+    (bcStrings (4 "0.0" x23 F))
+    (bcStrings (4 "0.0" x24 F))
+    (bcStrings (4 "0.0" x25 F))
+    (bcStrings (4 "0.0" x26 F))
+    (bcStrings (4 "0.0" x27 F))
+    (bcStrings (4 "0.0" x28 F))
+    (bcStrings (4 "0.0" x29 F))
+    (bcStrings (4 "0.0" x30 F))
+    (bcStrings (4 "0.0" x31 F))
+    (bcStrings (4 "0.0" x32 F))
+    (bcStrings (4 "0.0" x33 F))
+    (bcStrings (4 "0.0" x34 F))
+    (bcStrings (4 "0.0" x35 F))
+    (bcStrings (4 "0.0" x36 F))
+    (bcStrings (4 "0.0" x37 F))
+    (bcStrings (4 "0.0" x38 F))
+    (bcStrings (4 "0.0" x39 F))
+    (bcStrings (4 "0.0" x40 F)))
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'mnp,mnp)
+  htpSetProperty(page,'np,np)
+  htpSetProperty(page,'numbeg,numbeg)
+  htpSetProperty(page,'nummix,nummix)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'init,init)
+  htpSetProperty(page,'iy,iy)
+  htpSetProperty(page,'ijac,ijac)
+  htpSetProperty(page,'deleps,deleps)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'d02rafGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d02rafGen htPage ==
+  n := htpProperty(htPage, 'n)
+  mnp := htpProperty(htPage, 'mnp)
+  np := htpProperty(htPage, 'np)
+  numbeg := htpProperty(htPage, 'numbeg)
+  nummix := htpProperty(htPage, 'nummix)
+  tol := htpProperty(htPage, 'tol)
+  init := htpProperty(htPage, 'init)
+  iy := htpProperty(htPage, 'iy)
+  ijac := htpProperty(htPage, 'ijac)
+  deleps := htpProperty(htPage, 'deleps)
+  lwork := htpProperty(htPage, 'lwork)
+  liwork := htpProperty(htPage, 'liwork)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..mnp repeat
+    xtemp := STRCONC((first y).1," ")
+    xList := [xtemp,:xList]
+    y := rest y
+  xstring := bcwords2liststring xList
+  for i in 1..n repeat
+    gtemp := STRCONC((first y).1," ")
+    gList := [gtemp,:gList]
+    y := rest y
+  gstring := bcwords2liststring gList
+  while y repeat
+    f := STRCONC((first y).1," ")
+    fList := [f,:fList]
+    y := rest y
+  fstring := bcwords2liststring fList
+  prefix := STRCONC("d02raf(",STRINGIMAGE n,", ",STRINGIMAGE mnp,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE numbeg,", ",STRINGIMAGE nummix,", ")
+  prefix := STRCONC(prefix,tol,", ",STRINGIMAGE init,", ",STRINGIMAGE iy,", ")
+  middle:= STRCONC(STRINGIMAGE ijac,", ",STRINGIMAGE lwork,", ")
+  middle := STRCONC(middle,STRINGIMAGE liwork,", ",STRINGIMAGE np,", [")
+  middle := STRCONC(middle,xstring,"],[[0.0 for i in 1..", STRINGIMAGE mnp)
+  middle := STRCONC(middle,"] for j in 1..",STRINGIMAGE iy,"]")
+  middle := STRCONC(middle,":: Matrix DoubleFloat,",STRINGIMAGE deleps,", ")
+  middle := STRCONC(middle,STRINGIMAGE ifail,", (",fstring,"::Vector ")
+  middle := STRCONC(middle,"Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(")
+  middle := STRCONC(middle,gstring,"::Vector Expression Float)::ASP42('G,'JACOBG,")
+  middle := STRCONC(middle,"'JACGEP))")
+  linkGen STRCONC(prefix,middle)
+  
+
+d02rafCopOut() ==
+  htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\blankline ")
+    (text . "{\center{\em Hyperdoc interface not available for initial mesh}}")
+    (text . "\newline ")
+    (text . "{\center{\em Please use the command line.}}"))
+  htMakeDoneButton('"Continue",'d02raf)
+  htShowPage()
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-d03.boot.pamphlet b/src/interp/nag-d03.boot.pamphlet
new file mode 100644
index 00000000..19717651
--- /dev/null
+++ b/src/interp/nag-d03.boot.pamphlet
@@ -0,0 +1,661 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-d03.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+d03edf() ==
+  htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd03edf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03edf| '|NagPartialDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D03EDF solves, by multigrid iteration, the seven point scheme ")
+    (text . "\newline \htbitmap{d03edf} \newline which arises from the  ")
+    (text . "discretization of an elliptic partial differential equation of  ")
+    (text . "the form \center{\htbitmap{d03edf1}} and its boundary conditions")
+    (text . ", defined on a rectangular region. This we can write in matrix ")
+    (text . "form as \newline \center{{\it Au =f}}")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "Read the input file to see the example program. ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\spadcommand{)read d03edf \bound{s0}} ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "If you would like to enter a problem, ")
+    (text . "how would you like to input the matrices? ")
+    (radioButtons matrix
+        ("" "  By entering individual entries" long)
+        ("" "  By entering matrix names already defined on the command line" short)))
+  htMakeDoneButton('"Continue", 'd03edfControl)
+  htShowPage()
+
+d03edfControl(htPage) ==
+  type := htpButtonValue(htPage,'matrix)
+  if (type = 'long) then 
+    d03edfLong()
+  else
+    d03edfShort()
+
+d03edfLong() ==
+  htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it x}-direction ")
+    (text . "{\it ngx}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 3 ngx PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it y}-direction ")
+    (text . "{\it ngy}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 3 ngy PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "First dimension of A, {\it lda}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 22 lda PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 1 maxit PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Tolerance required, {\it acc}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-4" acc F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Output of printed information for routine {\it iout}:")
+    (radioButtons iout
+        ("" " 0 - no output" zero)
+        ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one)
+        ("" " 2 - residual 2-norm after each iteration " two)
+        ("" " 3 - as for iout = 1 & iout = 2" three)
+        ("" " 4 - as for iout = 3, plus the final residual" four)
+        ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five)
+        ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six)
+        ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven)
+        ("" " 8 - as for iout = 7, plus the residual after each iteration" eight))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" ifail_minusOne)
+        ("" "  1, Suppress error messages" ifail_one)))
+  htMakeDoneButton('"Continue", 'd03edfSolve)
+  htShowPage()
+
+
+d03edfSolve htPage ==
+  ngx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngx)
+  ngy :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngy)
+  lda :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  maxit :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxit)
+  acc := htpLabelInputString(htPage,'acc)
+  control := htpButtonValue(htPage,'iout)
+  iout :=
+    control = 'zero => '0
+    control = 'one => '1
+    control = 'two => '2
+    control = 'three => '3
+    control = 'four => '4
+    control = 'five => '5
+    control = 'six => '6
+    control = 'seven => '7
+    '8
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'ifail_one => '1
+    '-1
+  aList := 
+    "append"/[fa(i) for i in 1..lda] where fa(i) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..7] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[5, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ")
+  middle := STRCONC(middle,'"{\it rhs(lda)}: \newline ")
+  rList := 
+    "append"/[fc(i) for i in 1..lda] where fc(i) ==
+        rnam := INTERN STRCONC ('"r",STRINGIMAGE i)
+        [['bcStrings,[6, "0.0", rnam, 'F]]]
+  rList :=  [['text,:middle],:rList]
+  mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ")
+  mid := STRCONC(mid,'" {\it ub(ngx*ngy)}: \newline ")
+  uList := 
+    "append"/[fd(i) for i in 1..(ngx*ngy)] where fd(i) ==
+        unam := INTERN STRCONC ('"u",STRINGIMAGE i)
+        [['bcStrings,[6, 0, unam, 'F]]]
+  uList :=  [['text,:mid],:uList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:aList,:rList,:uList]
+  page := htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the matrix {\it a(lda,7)}: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'d03edfLongGen)
+  htpSetProperty(page,'ngx,ngx)
+  htpSetProperty(page,'ngy,ngy)
+  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'maxit,maxit)
+  htpSetProperty(page,'acc,acc)
+  htpSetProperty(page,'iout,iout)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d03edfLongGen htPage ==
+  ngx := htpProperty(htPage, 'ngx)
+  ngy := htpProperty(htPage, 'ngy)
+  lda := htpProperty(htPage, 'lda)
+  maxit := htpProperty(htPage, 'maxit)
+  acc := htpProperty(htPage, 'acc)
+  iout := htpProperty(htPage, 'iout)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(ngx*ngy) repeat
+    utemp := STRCONC((first y).1," ")
+    uList := [utemp,:uList]
+    y := rest y
+  ustring := bcwords2liststring uList
+  for i in 1..lda repeat
+    rtemp := STRCONC((first y).1," ")
+    rList := [rtemp,:rList]
+    y := rest y
+  rstring := bcwords2liststring rList
+  for i in 1..lda repeat
+    for j in 1..7 repeat
+      v := STRCONC((first y).1," ")
+      rowList := [v,:rowList]
+      y := rest y
+    vList := [:vList,rowList]
+    rowList := []
+  vList := reverse vList
+  astring := bcwords2liststring [bcwords2liststring x for x in vList]
+  prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc)
+  mid := STRCONC(", ",STRINGIMAGE iout,", ",astring,"::Matrix DoubleFloat,[")
+  mid := STRCONC(mid,rstring,"],[",ustring,"],",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,mid)
+  
+d03edfShort() ==
+  htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it x}-direction ")
+    (text . "\htbitmap{nx}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 0 ngx PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it y}-direction ")
+    (text . "\htbitmap{ny}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 0 ngy PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "First dimension of A, {\it lda}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 0 lda PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Name of the array {\it a(lda,7)} defined on the command line: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "a" a EM))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Name of the array {\it rhs(lda)} defined on the command line: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "rhs" rhs EM))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Name of the array {\it ub(ngx*ngy)} defined on the command line:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "ub" ub EM))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 0 maxit PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Tolerance required, {\it acc}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e-4" acc F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Output of printed information for routine {\it iout}:")
+    (radioButtons iout
+        ("" " 0 - no output" zero)
+        ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one)
+        ("" " 2 - residual 2-norm after each iteration " two)
+        ("" " 3 - as for iout = 1 & iout = 2" three)
+        ("" " 4 - as for iout = 3, plus the final residual" four)
+        ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five)
+        ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six)
+        ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven)
+        ("" " 8 - as for iout = 7, plus the residual after each iteration" eight))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" ifail_minusOne)
+        ("" "  1, Suppress error messages" ifail_one)))
+  htMakeDoneButton('"Continue", 'd03edfShortGen)
+  htShowPage()
+
+
+d03edfShortGen htPage ==
+  ngx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngx)
+  ngy :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngy)
+  lda :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  maxit :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit)
+    objValUnwrap htpLabelSpadValue(htPage, 'maxit)
+  a := htpLabelInputString(htPage, 'a)
+  rhs := htpLabelInputString(htPage, 'rhs)
+  ub := htpLabelInputString(htPage, 'ub)
+  acc := htpLabelInputString(htPage,'acc)
+  control := htpButtonValue(htPage,'iout)
+  iout :=
+    control = 'zero => '0
+    control = 'one => '1
+    control = 'two => '2
+    control = 'three => '3
+    control = 'four => '4
+    control = 'five => '5
+    control = 'six => '6
+    control = 'seven => '7
+    '8
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'ifail_one => '1
+    '-1
+  prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc)
+  mid := STRCONC(", ",STRINGIMAGE iout,", ",a,", ")
+  mid := STRCONC(mid,rhs,", ",ub,", ",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,mid)
+
+
+
+d03eef() ==
+  htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd03eef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03eef| '|NagPartialDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D03EEF discretizes a second order linear elliptic partial ")
+    (text . "differential equation of the form \center{\htbitmap{d03eef}} ")
+    (text . "on a rectangular region \newline \tab{2} ")
+    (text  . "{\it x}a \htbitmap{less=} {\it x}  \htbitmap{less=} {\it x}b ")
+    (text . "\newline \tab{2} {\it y}a \htbitmap{less=} {\it y} ")
+    (text . "\htbitmap{less=} {\it y}b \newline subject to the boundary ")
+    (text . "conditions of the form \newline \htbitmap{d03eef1} \newline ")
+    (text . "where {\it \delta U/ \delta n} denotes the outward pointing ")
+    (text . "normal derivative on the boundary. The equation is said to be ")
+    (text . "elliptic if \center{\htbitmap{d03eef2}} \newline for all points ")
+    (text . "in the rectangular region. The seven-diagonal linear equations ")
+    (text . "produced are in a form suitable for passing directly to the ")
+    (text . "multigrid routine D03EDF. \blankline ")
+    (text . "The equation is discretized on a rectangular grid, with ")
+    (text . "\htbitmap{nx} grid points in the {\it x}-direction and ")
+    (text . "\htbitmap{ny} grid points in the {\it y}-direction. "))
+  htMakeDoneButton('"Continue", 'd03eefInput)
+  htShowPage()
+
+d03eefInput() ==
+  htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the value {\it x}a, {\it xmin}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" xmin F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the value {\it x}b, {\it xmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0" xmax F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the value {\it y}a, {\it ymin}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" ymin F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the value {\it y}b, {\it ymax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0" ymax F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it x}-direction ")
+    (text . "{\it ngx}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 9 ngx PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Number of interior grid points in the {\it y}-direction ")
+    (text . "{\it ngy}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 9 ngy PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "First dimension of A, {\it lda}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 133 lda PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Which {\it scheme} would you like to use: ")
+    (radioButtons scheme
+        (" C" "  central differences" cent)
+        (" U" "  upwind differences" up))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\newline Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'd03eefSolve)
+  htShowPage()
+
+
+
+d03eefSolve htPage ==
+  xmin := htpLabelInputString(htPage,'xmin)
+  xmax := htpLabelInputString(htPage,'xmax)
+  ymin := htpLabelInputString(htPage,'ymin)
+  ymax := htpLabelInputString(htPage,'ymax)
+  ngx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngx)
+  ngy :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy)
+    objValUnwrap htpLabelSpadValue(htPage, 'ngy)
+  lda :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  diff := htpButtonValue(htPage,'scheme)
+  scheme :=
+    diff = 'cent => '"C"
+    '"U"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail)
+
+d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail) ==
+  page := htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "Please enter the values of \alpha to \psi to construct PDEF.")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\alpha (x,y): \tab{10} ")
+    (bcStrings (46 1 alpha F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\beta (x,y): \tab{10} ")
+    (bcStrings (46 0 beta F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\gamma (x,y): \tab{10} ")
+    (bcStrings (46 1 gamma F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\delta (x,y): \tab{10} ")
+    (bcStrings (46 50 delta F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\epsilon (x,y): \tab{10} ")
+    (bcStrings (46 50 eps F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\phi (x,y): \tab{10} ")
+    (bcStrings (46 0 phi F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\psi (x,y): \tab{10} ")    
+    (bcStrings (55 "-2*sin(X)*sin(Y) + 50*cos(X)*sin(Y) +50*sin(X)*cos(Y)" psi EM))
+    (text . "\blankline ")
+    (text . "Please enter the boundary conditions a(x,y), b(x,y), and c(x,y) ")
+    (text . "for the top, bottom, left and right hand sides, to construct ")
+    (text . "BNDY. \blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Bottom boundary conditions: ")
+    (text . "\newline a(x,y): \tab{10} ")
+    (bcStrings (46 0 a11 F))
+    (text . "\newline b(x,y): \tab{10} ")
+    (bcStrings (46 1 a12 F))
+    (text . "\newline c(x,y): \tab{10} ")
+    (bcStrings (46 "-sin(X)" a13 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Right boundary conditions: ")
+    (text . "\newline a(x,y): \tab{10} ")
+    (bcStrings (46 1 a21 F))
+    (text . "\newline b(x,y): \tab{10} ")
+    (bcStrings (46 0 a22 F))
+    (text . "\newline c(x,y): \tab{10} ")
+    (bcStrings (46 "sin(X)*sin(Y)" a23 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Top boundary conditions: ")
+    (text . "\newline a(x,y): \tab{10} ")
+    (bcStrings (46 1 a31 F))
+    (text . "\newline b(x,y): \tab{10} ")
+    (bcStrings (46 0 a32 F))
+    (text . "\newline c(x,y): \tab{10} ")
+    (bcStrings (46 "sin(X)*sin(Y)" a33 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Left boundary conditions: ")
+    (text . "\newline a(x,y): \tab{10} ")
+    (bcStrings (46 0 a41 F))
+    (text . "\newline b(x,y): \tab{10} ")
+    (bcStrings (46 1 a42 F))
+    (text . "\newline c(x,y): \tab{10} ")
+    (bcStrings (46 "-sin(Y)" a43 EM)))
+  htMakeDoneButton('"Continue",'d03eefGen)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'ymin,ymin)
+  htpSetProperty(page,'ymax,ymax)
+  htpSetProperty(page,'ngx,ngx)
+  htpSetProperty(page,'ngy,ngy)
+  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'scheme,scheme)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+d03eefGen htPage ==
+  xmin := htpProperty(htPage, 'xmin)
+  xmax := htpProperty(htPage, 'xmax)
+  ymin := htpProperty(htPage, 'ymin)
+  ymax := htpProperty(htPage, 'ymax)
+  ngx := htpProperty(htPage, 'ngx)
+  ngy := htpProperty(htPage, 'ngy)
+  lda := htpProperty(htPage, 'lda)
+  scheme := htpProperty(htPage, 'scheme)
+  ifail := htpProperty(htPage, 'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..4 repeat
+    for j in 1..3 repeat
+      v := STRCONC((first y).1," ")
+      rowList := [v,:rowList]
+      y := rest y
+    vList := [:vList,rowList]
+    rowList := []
+  vList := reverse vList
+  astring := bcwords2liststring [bcwords2liststring x for x in vList]
+  for i in 1..7 repeat
+    utemp := STRCONC((first y).1," ")
+    uList := [utemp,:uList]
+    y := rest y
+  ustring := bcwords2liststring uList
+  prefix := STRCONC("d03eef(",xmin,", ",xmax,", ",ymin,", ",ymax,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,",_"",scheme,"_", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,", (",ustring)
+  prefix := STRCONC(prefix,"::Vector Expression Float)::ASP73('PDEF),(")
+  prefix := STRCONC(prefix,astring,"::Matrix Expression Float)::ASP74('BNDY))")
+  linkGen prefix
+  
+d03faf() ==
+  htInitPage('"D03FAF - Elliptic PDE, Helmholtz equation, 3-D Cartesian co-ordinates",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F  (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXd03faf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03faf| '|NagPartialDifferentialEquationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "D03FAF solves the three-dimensional Helmholtz equation ")
+    (text . "in cartesian co-ordinates: \center{\htbitmap{d03faf}} \newline ")
+    (text . "This subroutine forms the system of linear equations resulting ")
+    (text . "fom the standard seven-point finite difference equations, ")
+    (text . "and then solves the system using a method based on the fast ")
+    (text . "Fourier transform (FFT) described by Swartztrauber. ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "Read the input file to see the example program. ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\spadcommand{)read d03faf \bound{s0}} "))
+  htShowPage()
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-e01.boot.pamphlet b/src/interp/nag-e01.boot.pamphlet
new file mode 100644
index 00000000..227dabde
--- /dev/null
+++ b/src/interp/nag-e01.boot.pamphlet
@@ -0,0 +1,1780 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-e01.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+e01baf() ==
+  htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01baf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01baf| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a cubic B-spline interpolant ")
+    (text . "\center{s(x) = \htbitmap{e01baf}} to the points ")
+    (text . "(\htbitmap{xiii}, \htbitmap{yi}), for i = 1,2,...,m. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data points, {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 7 m PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01bafSolve)
+  htShowPage()
+
+e01bafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  m = '7 => e01bafDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{32} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of x: \tab{30} "
+  htSay '"\menuitemstyle{}\tab{32} Corresponding values of y: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01bafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01bafDefaultSolve (htPage, ifail) ==
+  m := '7
+  page := htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of x: \tab{30} ")
+    (text . "\menuitemstyle{}\tab{32} Corresponding values of y: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.0" x1 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.0000" y1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.2" x2 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.2214" y2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.4" x3 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.4918" y3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.6" x4 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "1.8221" y4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.75" x5 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "2.1170" y5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.9" x6 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "2.4596" y6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.0" x7 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "2.7183" y7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01bafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01bafGen htPage ==
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  lck := m + 4
+  lwrk := 6*m+16
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  pre := STRCONC ('"e01baf(",STRINGIMAGE m,",[",realstring,"],[",imagstring)
+  post := STRCONC ('"],",STRINGIMAGE lck,",",STRINGIMAGE lwrk,",")
+  linkGen STRCONC (pre,post,STRINGIMAGE ifail,")")
+
+e01bef() ==
+  htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01bef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Brow[Cser operation page}{(|oPageFrom| '|e01bef| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines derivative estimates defining a monoticity preserving")
+    (text . " piecewise cubic Hermite interpolant to the set of points ")
+    (text . "(\htbitmap{xr}, \htbitmap{fr}), ")
+    (text . "for r = 1,2,...,m. The interpolant, its derivative, and its ")
+    (text . "integral can be evaluated by calls to E01BFF, E01BGF or E01BHF. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data points {\it n} \htbitmap{great=} 2:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01befSolve)
+  htShowPage()
+
+e01befSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    error = 'zero => '0
+    '-1
+  n = '9 => e01befDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      post   := ('"\tab{32} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+          (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{30} "
+  htSay '"\menuitemstyle{}\tab{32} Values of \space{1} "
+  htSay '"\htbitmap{fr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01befGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01befDefaultSolve (htPage, ifail) ==
+  n := '9
+  page := htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{30} ")
+    (text . "\menuitemstyle{}\tab{32} Values of \space{1} \htbitmap{fr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "7.99" x1 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.00000e+0" y1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.09" x2 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.27643e-4" y2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.19" x3 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.43750e-1" y3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.70" x4 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.16918" y4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.20" x5 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.46943" y5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.00" x6 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.94374" y6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.00" x7 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.99864" y7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.00" x8 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.99992" y8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.00" x9 F))
+    (text . "\tab{32} ")
+    (bcStrings (10 "0.99999" y9 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01befGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01befGen htPage ==
+  n := htpProperty(htPage,'n)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  lck := n + 4
+  lwrk := 6*n+16
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    reallist := [left,:reallist]
+    imaglist := [right,:imaglist]
+  realstring := bcwords2liststring reallist
+  imagstring := bcwords2liststring imaglist
+  linkGen STRCONC ('"e01bef(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],",STRINGIMAGE ifail,")")
+
+
+e01bff() ==
+  htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01bff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bff| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the piecewise cubic Hermite interpolant computed ")
+    (text . "by E01BEF at the set of points \htbitmap{xiii}, ")
+    (text . "for i = 1,2,...,m. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data points {\em n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of evaluation points {\em m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 11 m PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01bffSolve)
+  htShowPage()
+
+e01bffSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '9 and m = '11) => e01bffDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ")
+  pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ")
+  pxwords := cons('text,pxwords)
+  pointList :=
+    "append"/[g(j) for j in 1..m] where g(j) ==
+      preamb := ('"\newline \tab{2} ")
+      pnam := INTERN STRCONC ('"px",STRINGIMAGE j)
+      [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]]
+  labelList := [:labelList,pxwords,:pointList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01bffGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01bffDefaultSolve (htPage, ifail) ==
+  n := '9
+  m := '11
+  page := htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{dr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "7.99" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00000e+0" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000e+0" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.09" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.27643e-4" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.52510e-4" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.19" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.43750e-1" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.33587" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.70" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.16918" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.34944" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.20" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.46943" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.59696" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.00" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.94374" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "6.03260e-2" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.00" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99864" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "8.98335e-4" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.00" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99992" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.93954e-5" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.00" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99999" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000" z9 F))
+    (text . "\blankline")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Values of array {\it Px}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.99" px1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.191" px2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.392" px3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "11.593" px4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.794" px5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "13.995" px6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.196" px7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "16.397" px8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.598" px9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "18.799" px10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.0" px11 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01bffGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01bffGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  lck := n + 4
+  lwrk := 6*n+16
+  y := alist
+  for i in 1..m repeat
+    px := STRCONC ((first y).1," ")
+    y := rest y
+    pxlist := [px,:pxlist]
+  pxstring := bcwords2liststring pxlist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    flist := [mid,:flist]
+    dlist := [right,:dlist]
+  xstring := bcwords2liststring xlist
+  fstring := bcwords2liststring flist
+  dstring := bcwords2liststring dlist
+  prefix := STRCONC('"e01bff(",STRINGIMAGE n,",[",xstring,"],[",fstring)
+  prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e01bgf() ==
+  htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01bgf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bgf| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the piecewise cubic Hermite interpolant computed ")
+    (text . "by E01BEF and its 1st derivative at the set of points \space{1} ")
+    (text . "\htbitmap{xiii}, for i = 1,2,...,m. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data points {\em n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of evaluation points {\em m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 11 m PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01bgfSolve)
+  htShowPage()
+
+e01bgfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '9 and m = '11) => e01bgfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ")
+  pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ")
+  pxwords := cons('text,pxwords)
+  pointList :=
+    "append"/[g(j) for j in 1..m] where g(j) ==
+      preamb := ('"\newline \tab{2} ")
+      pnam := INTERN STRCONC ('"px",STRINGIMAGE j)
+      [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]]
+  labelList := [:labelList,pxwords,:pointList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01bgfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01bgfDefaultSolve (htPage, ifail) ==
+  n := '9
+  m := '11
+  page := htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{dr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "7.99" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00000e+0" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000e+0" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.09" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.27643e-4" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.52510e-4" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.19" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.43750e-1" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.33587" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.70" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.16918" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.34944" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.20" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.46943" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.59696" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.00" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.94374" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "6.03260e-2" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.00" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99864" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "8.98335e-4" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.00" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99992" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.93954e-5" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.00" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99999" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000" z9 F))
+    (text . "\blankline")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Values of array {\it Px}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.99" px1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.191" px2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.392" px3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "11.593" px4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.794" px5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "13.995" px6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.196" px7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "16.397" px8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.598" px9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "18.799" px10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.0" px11 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01bgfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01bgfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  lck := n + 4
+  lwrk := 6*n+16
+  y := alist
+  for i in 1..m repeat
+    px := STRCONC ((first y).1," ")
+    y := rest y
+    pxlist := [px,:pxlist]
+  pxstring := bcwords2liststring pxlist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    flist := [mid,:flist]
+    dlist := [right,:dlist]
+  xstring := bcwords2liststring xlist
+  fstring := bcwords2liststring flist
+  dstring := bcwords2liststring dlist
+  prefix := STRCONC('"e01bgf(",STRINGIMAGE n,",[",xstring,"],[",fstring)
+  prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e01bhf() ==
+  htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01bhf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bhf| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the definite integral of the piecewise cubic Hermite ")
+    (text . "interpolant computed by E01BEF over the interval [a,b]. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Enter the number of data points {\em n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 9 n PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline {\em Lower} bound {\it a}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\em Upper} bound {\it b}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (20 "7.99" a F))
+    (text . "\tab{34} ")
+    (bcStrings (20 "20.0" b EM))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01bhfSolve)
+  htShowPage()
+
+e01bhfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  a := htpLabelInputString(htPage,'a)
+  b := htpLabelInputString(htPage,'b)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '9 => e01bhfDefaultSolve(htPage,a,b,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01bhfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01bhfDefaultSolve (htPage,a,b,ifail) ==
+  n := '9
+  page := htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{dr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "7.99" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00000e+0" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000e+0" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.09" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.27643e-4" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.52510e-4" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.19" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.43750e-1" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.33587" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.70" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.16918" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.34944" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.20" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.46943" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.59696" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.00" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.94374" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "6.03260e-2" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.00" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99864" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "8.98335e-4" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.00" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99992" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.93954e-5" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.00" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.99999" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.00000" z9 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01bhfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'a,a)
+  htpSetProperty(page,'b,b)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01bhfGen htPage ==
+  n := htpProperty(htPage,'n)
+  a := htpProperty(htPage,'a)
+  b := htpProperty(htPage,'b)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  lck := n + 4
+  lwrk := 6*n+16
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    flist := [mid,:flist]
+    dlist := [right,:dlist]
+  xstring := bcwords2liststring xlist
+  fstring := bcwords2liststring flist
+  dstring := bcwords2liststring dlist
+  prefix := STRCONC('"e01bhf(",STRINGIMAGE n,",[",xstring,"],[",fstring,"],[")
+  prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE a,",",STRINGIMAGE b,",",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e01daf() ==
+  htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on a rectangular grid", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01daf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01daf| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a bicubic spline surface interpolating the set of ")
+    (text . "data values (\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}) ")
+    (text . "given on a rectangular grid. The grid is defined by ")
+    (text . "\space{1} \htbitmap{mx} points along the x-axis and ")
+    (text . "\space{1} \htbitmap{my} points along the y-axis. The ")
+    (text . "spline has \space{1} \htbitmap{px} knots ")
+    (text . "\htbitmap{lamdai} and \space{1}\htbitmap{py}")
+    (text . " knots  \htbitmap{mui} in the x- and y-directions ")
+    (text . "respectively, and is given in the B-spline representation ")
+    (text . "\center{s(x,y) = \htbitmap{e01daf1}} ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "\newline The value \space{1} \htbitmap{mx}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "The value \space{1} \htbitmap{my}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 mx PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 6 my PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01dafSolve)
+  htShowPage()
+
+e01dafSolve htPage ==
+  mx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx)
+    objValUnwrap htpLabelSpadValue(htPage, 'mx)
+  my :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my)
+    objValUnwrap htpLabelSpadValue(htPage, 'my)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (mx = '7 and my = '6) => e01dafDefaultSolve(htPage,ifail)
+  xList :=
+    "append"/[f(i) for i in 1..mx] where f(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[6, 0.0, xnam, 'F]]]
+  prefix := ('"\newline \menuitemstyle{}\tab{2} Values of X(1) to X(MX): \newline ")
+  xList := [['text,:prefix],:xList]
+  yList :=
+    "append"/[g(i) for i in 1..my] where g(i) ==
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['bcStrings,[6, 0.0, ynam, 'F]]]
+  prefix := ('"\blankline\menuitemstyle{}\tab{2}Values of Y(1) to Y(MY): \newline ")
+  yList := [['text,:prefix],:yList]
+  fList := 
+    "append"/[h(j,my) for j in 1..mx] where h(j,my) ==
+      tempList := 
+        "append"/[k(j,m) for m in 1..my] where k(j,m) == 
+          fnam := INTERN STRCONC ('"f",STRINGIMAGE j, STRINGIMAGE m)
+          [['bcStrings,[6, 0.0, fnam, 'F]]]
+      prefix := ('"\newline ")
+      tempList := [['text,:prefix],:tempList]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of F(MX*MY) ")
+  prefix := STRCONC(prefix,'"(x down, y across): ")
+  fList := [['text,:prefix],:fList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+               :xList,:yList,:fList]
+  page := htInitPage("E01DAF - Interpolating functions, fitting bicubic spline, data on a rectanglar grid",htpPropertyList htPage)
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01dafGen)
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01dafDefaultSolve (htPage,ifail) ==
+  mx := '7
+  my := '6
+  page := htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on rectangular grid",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of X(1) to X(MX): ")
+    (text . "\newline ")
+    (bcStrings (6 "1.00" x1 F))
+    (bcStrings (6 "1.10" x2 F))
+    (bcStrings (6 "1.30" x3 F))
+    (bcStrings (6 "1.50" x4 F))
+    (bcStrings (6 "1.60" x5 F))
+    (bcStrings (6 "1.80" x6 F))
+    (bcStrings (6 "2.00" x7 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text ."\menuitemstyle{} \tab{2} Values of Y(1) to Y(MY): ")
+    (text . "\newline  ")
+    (bcStrings (6 "0.00" y1 F))
+    (bcStrings (6 "0.10" y2 F))
+    (bcStrings (6 "0.40" y3 F))
+    (bcStrings (6 "0.70" y4 F))
+    (bcStrings (6 "0.90" y5 F))
+    (bcStrings (6 "1.00" y6 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} Values of F(MX*MY) (x down, y across): ")
+    (text . "\newline ")
+    (bcStrings (6 "1.00" z11 F))
+    (bcStrings (6 "1.10" z21 F))
+    (bcStrings (6 "1.40" z31 F))
+    (bcStrings (6 "1.70" z41 F))
+    (bcStrings (6 "1.90" z51 F))
+    (bcStrings (6 "2.00" z61 F))
+    (text . "\newline ")
+    (bcStrings (6 "1.21" z12 F))
+    (bcStrings (6 "1.31" z22 F))
+    (bcStrings (6 "1.61" z32 F))
+    (bcStrings (6 "1.91" z42 F))
+    (bcStrings (6 "2.11" z52 F))
+    (bcStrings (6 "2.21" z62 F))
+    (text . "\newline ")
+    (bcStrings (6 "1.69" z13 F))
+    (bcStrings (6 "1.79" z23 F))
+    (bcStrings (6 "2.09" z33 F))
+    (bcStrings (6 "2.39" z43 F))
+    (bcStrings (6 "2.59" z53 F))
+    (bcStrings (6 "2.69" z63 F))
+    (text . "\newline ")
+    (bcStrings (6 "2.25" z14 F))
+    (bcStrings (6 "2.35" z24 F))
+    (bcStrings (6 "2.65" z34 F))
+    (bcStrings (6 "2.95" z44 F))
+    (bcStrings (6 "3.15" z54 F))
+    (bcStrings (6 "3.25" z64 F))
+    (text . "\newline ")
+    (bcStrings (6 "2.56" z15 F))
+    (bcStrings (6 "2.66" z25 F))
+    (bcStrings (6 "2.96" z35 F))
+    (bcStrings (6 "3.26" z45 F))
+    (bcStrings (6 "3.46" z55 F))
+    (bcStrings (6 "3.56" z65 F))
+    (text . "\newline ")
+    (bcStrings (6 "3.24" z16 F))
+    (bcStrings (6 "3.34" z26 F))
+    (bcStrings (6 "3.64" z36 F))
+    (bcStrings (6 "3.94" z46 F))
+    (bcStrings (6 "4.14" z56 F))
+    (bcStrings (6 "4.24" z66 F))
+    (text . "\newline ")
+    (bcStrings (6 "4.00" z17 F))
+    (bcStrings (6 "4.10" z27 F))
+    (bcStrings (6 "4.40" z37 F))
+    (bcStrings (6 "4.70" z47 F))
+    (bcStrings (6 "4.90" z57 F))
+    (bcStrings (6 "5.00" z67 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01dafGen)    	
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01dafGen htPage ==
+  mx := htpProperty(htPage,'mx)
+  my := htpProperty(htPage,'my)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1, " ")
+    y := rest y
+    xlist := [right,:xlist]
+  for i in 1..mx repeat
+    xmx := [:xmx,(first xlist)] 
+    xlist := rest xlist
+  xstring := bcwords2liststring xmx
+  for i in 1..my repeat
+    ymy := [:ymy,(first xlist)]
+    xlist := rest xlist
+  ystring := bcwords2liststring ymy
+  fstring := bcwords2liststring xlist
+  prefix := STRCONC('"e01daf(",STRINGIMAGE mx,", ",STRINGIMAGE my,",[")
+  midd := STRCONC(xstring, "], [",ystring,"], [",fstring,"], ")
+  linkGen STRCONC(prefix,midd,STRINGIMAGE ifail,")")
+
+e01saf() ==
+  htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01saf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01saf| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a \htbitmap{c1} piecewise polynomial ")
+    (text . "surface F(x,y) interpolating the set of scattered points ")
+    (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ")
+    (text . "for r = 1,2,...,m, using a method of Renka and Cline. ")
+    (text . "The interpolant can be evaluated using E01SBF. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\em m} \htbitmap{great=} 3:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01safSolve)
+  htShowPage()
+
+e01safSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  m = '30 => e01safDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01SAF - Interpolating functions, method of Renka and Cline,two variables",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01safGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01safDefaultSolve  (htPage, ifail) ==
+  m := '30
+  page := htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{dr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "11.16" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.24" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "22.15" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.85" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.06" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "22.11" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "19.85" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.72" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "7.97" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "19.72" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.39" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "16.83" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.91" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.74" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "15.30" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "34.60" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.87" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.74" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.45" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.78" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "41.24" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "14.26" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "17.87" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "10.74" z9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.43" x10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.46" y10 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "18.60" z10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.80" x11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.39" y11 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.47" z11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.58" x12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.98" y12 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "29.87" z12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "25.00" x13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "11.87" y13 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "4.40" z13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" y14 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "58.20" z14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.66" x15 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y15 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "4.73" z15 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.22" x16 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.66" y16 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "40.36" z16 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.25" x17 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "19.57" y17 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "6.43" z17 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "25.00" x18 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.87" y18 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "8.74" z18 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.13" x19 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.79" y19 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "13.71" z19 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.23" x20 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.21" y20 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "10.25" z20 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "11.52" x21 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.53" y21 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "15.74" z21 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.20" x22 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.0" y22 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "21.60" z22 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.54" x23 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.69" y23 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "19.31" z23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.32" x24 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "13.78" y24 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "12.11" z24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.14" x25 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "15.03" y25 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "53.10" z25 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.51" x26 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.37" y26 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "49.43" z26 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.69" x27 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "19.63" y27 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "3.25" z27 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.47" x28 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "17.13" y28 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "28.63" z28 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "21.67" x29 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.36" y29 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.52" z29 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.31" x30 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.33" y30 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "44.08" z30 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01safGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01safGen htPage ==
+  m := htpProperty(htPage,'m)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    flist := [mid,:flist]
+    dlist := [right,:dlist]
+  xstring := bcwords2liststring xlist
+  fstring := bcwords2liststring flist
+  dstring := bcwords2liststring dlist
+  prefix := STRCONC('"e01saf(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[")
+  prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e01sef() ==
+  htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe01sef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01sef| '|NagInterpolationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a \htbitmap{c1} piecewise polynomial ")
+    (text . "surface F(x,y) interpolating the set of scattered points ")
+    (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ")
+    (text . "for r = 1,2,...,m, using a modified Shepard method. ")
+    (text . "The interpolant can be evaluated using E01SFF. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\em m} \htbitmap{great=} 3:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline ")
+    (text . "Note: RNW, RNQ, NW, NQ set to zero for default value. ")
+    (text . "On exit, they contain the value actually used. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline {\em RNW} weight locality radius: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "{\em RNQ} point locality radius:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "0.0" rnw F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "0.0" rnq F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} \newline")
+    (text . "{\em NW} average number of points within RNW of each point: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 0 nw I))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} \newline")
+    (text . "{\em NQ} average number of points within RNQ of each point: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 0  nq I))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e01sefSolve)
+  htShowPage()
+
+e01sefSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  nw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nw)
+    objValUnwrap htpLabelSpadValue(htPage, 'nw)
+  nq :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nq)
+    objValUnwrap htpLabelSpadValue(htPage, 'nq)
+  rnq := htpLabelInputString(htPage,'rnq)
+  rnw := htpLabelInputString(htPage,'rnw)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  m = '30 => e01sefDefaultSolve(htPage,rnq,rnw,nq,nw,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e01sefGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'rnq,rnq)
+  htpSetProperty(page,'rnw,rnw)
+  htpSetProperty(page,'nq,nq)
+  htpSetProperty(page,'nw,nw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e01sefDefaultSolve  (htPage,rnq,rnw,nq,nw,ifail) ==
+  m := '30
+  page := htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{dr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "11.16" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.24" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "22.15" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.85" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.06" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "22.11" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "19.85" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.72" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "7.97" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "19.72" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.39" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "16.83" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.91" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.74" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "15.30" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "34.60" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "20.87" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.74" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.45" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.78" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "41.24" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "14.26" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "17.87" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "10.74" z9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.43" x10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.46" y10 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "18.60" z10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.80" x11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.39" y11 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.47" z11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.58" x12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.98" y12 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "29.87" z12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "25.00" x13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "11.87" y13 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "4.40" z13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" x14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" y14 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "58.20" z14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.66" x15 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "20.00" y15 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "4.73" z15 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.22" x16 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.66" y16 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "40.36" z16 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.25" x17 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "19.57" y17 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "6.43" z17 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "25.00" x18 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.87" y18 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "8.74" z18 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.13" x19 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.79" y19 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "13.71" z19 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.23" x20 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.21" y20 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "10.25" z20 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "11.52" x21 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.53" y21 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "15.74" z21 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "15.20" x22 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.0" y22 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "21.60" z22 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.54" x23 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.69" y23 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "19.31" z23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "17.32" x24 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "13.78" y24 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "12.11" z24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.14" x25 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "15.03" y25 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "53.10" z25 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.51" x26 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.37" y26 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "49.43" z26 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "22.69" x27 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "19.63" y27 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "3.25" z27 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.47" x28 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "17.13" y28 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "28.63" z28 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "21.67" x29 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.36" y29 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "5.52" z29 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.31" x30 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.33" y30 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "44.08" z30 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e01sefGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'rnq,rnq)
+  htpSetProperty(page,'rnw,rnw)
+  htpSetProperty(page,'nq,nq)
+  htpSetProperty(page,'nw,nw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e01sefGen htPage ==
+  m := htpProperty(htPage,'m)
+  rnw := htpProperty(htPage,'rnw)
+  rnq := htpProperty(htPage,'rnq)
+  nw := htpProperty(htPage,'nw)
+  nq := htpProperty(htPage,'nq)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    flist := [mid,:flist]
+    dlist := [right,:dlist]
+  xstring := bcwords2liststring xlist
+  fstring := bcwords2liststring flist
+  dstring := bcwords2liststring dlist
+  prefix := STRCONC('"e01sef(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[")
+  prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE nw,", ",STRINGIMAGE nq)
+  prefix := STRCONC(prefix,", ",rnw,", ",rnq,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-e02.boot.pamphlet b/src/interp/nag-e02.boot.pamphlet
new file mode 100644
index 00000000..3d738dd1
--- /dev/null
+++ b/src/interp/nag-e02.boot.pamphlet
@@ -0,0 +1,4693 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-e02.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+e02adf() ==
+  htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02adf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines weighted least-squares polynomial approximations of ")
+    (text . "degrees 0,1,...,k to the set of points {\it (} ")
+    (text . "\htbitmap{xr}, \htbitmap{yr}{\it )} ")
+    (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ")
+    (text . "The polynomials are in the Chebyshev series form, the ")
+    (text . "approximation of degree {\it i} being represented as ")
+    (text . "\newline \center{\htbitmap{e02adf}} , where ")
+    (text . "\htbitmap{xbar} is the normalised argument, which is ")
+    (text . "related to the original variable {\it x} by the transformation ")
+    (text . "\blankline  \center{\htbitmap{e02adf1}} ")
+    (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ")
+    (text . "the values of \htbitmap{xr} respectively ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 11 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Maximum degree required {\it k}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 3 k PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "First dimension of A, {\it nrows} \htbitmap{great=} {\it k+1}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 50 nrows I))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02adfSolve)
+  htShowPage()
+
+e02adfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  k :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k)
+    objValUnwrap htpLabelSpadValue(htPage, 'k)
+  nrows :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrows)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '11 and k ='3) => e02adfDefaultSolve(htPage,k,nrows,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02adfGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02adfDefaultSolve  (htPage,k,nrows,ifail) ==
+  m := '11
+  page := htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{wr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "1.00" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.40" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.10" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.90" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.10" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.70" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.90" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.50" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.90" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.20" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.80" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.20" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.80" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.50" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "5.10" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.80" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.10" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "9.20" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.70" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.80" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "16.10" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.50" z9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.40" x10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "24.50" y10 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.30" z10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.00" x11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "35.30" y11 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.20" z11 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02adfGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02adfGen htPage ==
+  m := htpProperty(htPage,'m)
+  k := htpProperty(htPage,'k)
+  nrows := htpProperty(htPage,'nrows)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  kplus1 := k + 1
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    wlist := [right,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  wstring := bcwords2liststring wlist
+  prefix := STRCONC('"e02adf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrows,", [",xstring,"],[",ystring,"],[")
+  prefix := STRCONC(prefix,wstring,"],",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02aef() ==
+  htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02aef| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates a polynomial in Chabyshev series representation ")
+    (text . "\newline \center{\htbitmap{e02aef}} ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of terms in the series {\it n}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\htbitmap{xbar}: ")
+    (text . " \newline \tab{2} ")
+    (bcStrings (6 "-1.0" xcap F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02aefSolve)
+  htShowPage()
+
+e02aefSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  xcap := htpLabelInputString(htPage,'xcap)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4 => e02aefDefaultSolve(htPage,xcap,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..(n+1)] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, anam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series from", nil)
+  htSay '"\menuitemstyle{}\tab{2} Enter the coefficients of {\it a(n+1)}:"
+  htSay '"\blankline "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02aefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'xcap,xcap)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02aefDefaultSolve  (htPage,xcap,ifail) ==
+  n := '4
+  page := htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the coeffients of {\it a(n+1)}: ")
+    (text . "\blankline ")
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "2.0000" a1 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.5000" a2 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.2500" a3 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.1250" a4 F))
+    (text . "\newline \tab{15} ")
+    (bcStrings (10 "0.0625" a5 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'e02aefGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'xcap,xcap)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02aefGen htPage ==
+  n := htpProperty(htPage,'n)
+  xcap := htpProperty(htPage,'xcap)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  nplus1 := n + 1
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    arrayList := [right,:arrayList]
+  astring := bcwords2liststring arrayList
+  prefix := STRCONC('"e02aef(",STRINGIMAGE nplus1,", [",astring ,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE xcap,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02agf() ==
+  htInitPage('"E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02agf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02agf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines constrained least-squares polynomial approximations ")
+    (text . "to the set of points {\it (\htbitmap{xr},\htbitmap{yr})} with ")
+    (text . "weights \htbitmap{wr}, for r = 1,2,...,m. The values of the ")
+    (text . "approximations and any number of their derivatives must be ")
+    (text . "specified at a further set of points \htbitmap{xii}, ")
+    (text . "for i = 1,2,...,{\it mf}. The total number of interpolating ")
+    (text . "conditions is given by \center{\htbitmap{e02agf}} where ")
+    (text . "\htbitmap{pi} is the highest order derivative ")
+    (text . "specified at point \htbitmap{xii}.  The values ")
+    (text . "\htbitmap{xr} and \htbitmap{xii} all lie ")
+    (text . "in the interval [\htbitmap{xmin},")
+    (text . "\htbitmap{xmax}]. The polynomials are given in ")
+    (text . "Chebyshev series form, the approximation of degree {\it i} being")
+    (text . " represented as\blankline  \center{\htbitmap{e02agf1}}")
+    (text . "\newline, where \htbitmap{xbar} is the normalised ")
+    (text . "argument, related to the original variable {\it x} by the ")
+    (text . "transformation \newline \center{\htbitmap{e02adf1}} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Number of data points {\it m}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Maximum degree required {\it k}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 4 k PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "First dimension of A, {\it nrows \htbitmap{great=} k+1}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 nrows I))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline \htbitmap{xmin}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\htbitmap{xmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "0.0" xmin F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "4.0" xmax F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Dimension of {\it xf} & {\it ip}, {\it mf}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Dimension of {\it yf}, {\it lyf}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 2 mf PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 15 lyf PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02agfSolve)
+  htShowPage()
+
+e02agfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  k :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k)
+    objValUnwrap htpLabelSpadValue(htPage, 'kplus1)
+  nrows :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrows)
+  xmin := htpLabelInputString(htPage,'xmin)
+  xmax := htpLabelInputString(htPage,'xmax)
+  mf :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mf)
+    objValUnwrap htpLabelSpadValue(htPage, 'mf)
+  lyf :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lyf)
+    objValUnwrap htpLabelSpadValue(htPage, 'lyf)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '5 and k ='4 and mf = '2 and lyf = '15) => e02agfDefaultSolve(htPage,nrows,xmin,xmax,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  xfList := 
+    "append"/[g(j) for j in 1..mf] where g(j) ==
+      xfnam := INTERN STRCONC ('"xf",STRINGIMAGE j)
+      [['bcStrings,[6, 0.0, xfnam, 'F]]]
+  prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ")
+  prefix := STRCONC(prefix,"{\it xf}: \newline \tab{2} ")
+  xfList := [['text,:prefix],:xfList] 
+  ipList := 
+    "append"/[h(k) for k in 1..mf] where h(k) ==
+      ipnam := INTERN STRCONC ('"ip",STRINGIMAGE k)
+      [['bcStrings,[6, 0, ipnam, 'PI]]]
+  prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ")
+  prefix := STRCONC(prefix,"{\it ip}: \newline \tab{2} ")
+  ipList := [['text,:prefix],:ipList] 
+  yfList :=
+    "append"/[i(l) for l in 1..lyf] where i(l) ==
+      prefix := ('"\newline \tab{2} ")
+      yfnam := INTERN STRCONC ('"lyf",STRINGIMAGE l)
+      [['text,:prefix],['bcStrings,[10, 0.0, yfnam, 'F]]]
+  prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ")
+  prefix := STRCONC(prefix,"{\it yf}: \newline \tab{2} ")
+  yfList := [['text,:prefix],:yfList] 
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:xfList,:ipList,:yfList]
+  page := htInitPage("E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{wr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02agfGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'mf,mf)
+  htpSetProperty(page,'lyf,lyf)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02agfDefaultSolve  (htPage,nrows,xmin,xmax,ifail) == 
+  m := '5
+  k := '4
+  mf := '2
+  lyf := '15
+  page := htInitPage('"E02AGF - Least-squares polynomial fit, values and derivativesby polynomials, arbitrary data points", htpPropertyList htPage)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{wr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.5" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.03" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.0" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.0" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "-0.75" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.0" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.0" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "-1.0" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.0" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.5" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "-0.1" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.0" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.0" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.75" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.0" z5 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it xf}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" xf1 F))
+    (bcStrings (6 "4.0" xf2 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it ip}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 ip1 PI))
+    (bcStrings (6 0 ip2 PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it yf}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.0" lyf1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "-2.0" lyf2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.0" lyf3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" lyf15 F)))
+  htMakeDoneButton('"Continue",'e02agfGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'k,k)
+  htpSetProperty(page,'nrows,nrows)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'mf,mf)
+  htpSetProperty(page,'lyf,lyf)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02agfGen htPage ==
+  m := htpProperty(htPage,'m)
+  k := htpProperty(htPage,'k)
+  nrows := htpProperty(htPage,'nrows)
+  xmin := htpProperty(htPage,'xmin)
+  xmax := htpProperty(htPage,'xmax)
+  mf := htpProperty(htPage,'mf)
+  lyf := htpProperty(htPage,'lyf)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  kplus1 := k + 1
+  ipsum := 0
+  y := alist
+  for i in 1..lyf repeat
+    yf := STRCONC((first y).1," ")
+    yfList := [yf,:yfList]
+    y := rest y
+  yfstring := bcwords2liststring yfList
+  for i in 1..mf repeat
+    iptest := (first y).1
+    iptestval := READ_-FROM_-STRING(iptest)
+    ipsum := ipsum + iptestval
+    ip := STRCONC(iptest," ")
+    iptestList := [iptestval,:iptestList]
+    ipList := [ip,:ipList]
+    y := rest y
+  ipstring := bcwords2liststring ipList
+  ipmax := APPLY ('MAX, iptestList)
+  n := mf + ipsum
+  for i in 1..mf repeat
+    xf := STRCONC((first y).1," ")
+    xfList := [xf,:xfList]
+    y := rest y
+  xfstring := bcwords2liststring xfList
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    wlist := [right,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  wstring := bcwords2liststring wlist
+  wrktest1 := 4*m + 3*kplus1
+  wrktest2 := 8*n + 5*ipmax + mf +10
+  wrktestlist := [wrktest1,wrktest2]
+  wrkmax := APPLY ('MAX, wrktestlist)
+  lwrk := wrkmax + 2*n + 2
+  liwrk := 2*mf + 2
+  prefix := STRCONC('"e02agf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrows,", ",xmin,", ",xmax,", [",xstring)
+  prefix := STRCONC(prefix,"],[",ystring,"],[",wstring,"],",STRINGIMAGE mf)
+  prefix := STRCONC(prefix,", [",xfstring,"],[",yfstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE lyf,", [",ipstring,"]::Matrix Integer,")
+  prefix := STRCONC(prefix,STRINGIMAGE lwrk,", ",STRINGIMAGE liwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02ahf() ==
+  htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float)) 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02ahf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ahf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines the indefinite integral of the Chebyshev series ")
+    (text . "representation \newline \center{\htbitmap{e02ahf1}} ")
+    (text . "of a polynomial, where \htbitmap{xbar} is the ")
+    (text . "normalised argument, related to the original variable x by the ")
+    (text . "transformation \blankline \center{\htbitmap{e02adf1}}")
+    (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ")
+    (text . "minimum and maximum values of {\it x} respectively. The integral")
+    (text . " polynomial has the form ")
+    (text . "\blankline \center{\htbitmap{e02ahf}}")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Degree of the polynomial {\it n}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline \htbitmap{xmin}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\htbitmap{xmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "-0.5" xmin F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "2.5" xmax F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Dimension of array {\it a}, {\it la}: ")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+--    (text . "Dimension of {\it adif}, {\it ladif}: ") 
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (6 7 la PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 7 ladif PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Increment of array {\it a}, {\it ia1}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\newline Increment of array {\it adif}, {\it ladif1}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 1 iaone PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 1 ladifone PI))
+    (text . "\blankline")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02ahfSolve)
+  htShowPage()
+
+e02ahfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  xmin := htpLabelInputString(htPage,'xmin)
+  xmax := htpLabelInputString(htPage,'xmax)
+  iaone :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone)
+    objValUnwrap htpLabelSpadValue(htPage, 'iaone)
+  ladifone :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladifone)
+    objValUnwrap htpLabelSpadValue(htPage, 'ladifone)
+  la := 1+n*iaone
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la)
+--    objValUnwrap htpLabelSpadValue(htPage, 'la)
+  ladif :=1+n*ladifone
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladif)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ladif)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and (la ='7 and ladif = '7)) => 
+     e02ahfDefaultSolve(htPage,xmin,xmax,iaone,ladifone,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..la] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02AHF - Derivative of fitted polynomial in Chebyshev series",nil)
+  htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ahfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'ladif,ladif)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'ladifone,ladifone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02ahfDefaultSolve  (htPage,xmin,xmax,iaone,ladifone,ifail) ==
+  n := '6
+  la := '7
+  ladif := '7
+  page := htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Coefficients of {\it a(la)}: ")
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "2.53213" a1 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "1.13032" a2 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.27150" a3 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.04434" a4 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00547" a5 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00054" a6 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00004" a7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02ahfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'ladif,ladif)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'ladifone,ladifone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02ahfGen htPage ==
+  n := htpProperty(htPage,'n)
+  la := htpProperty(htPage,'la)
+  ladif := htpProperty(htPage,'ladif)
+  xmin := htpProperty(htPage,'xmin)
+  xmax := htpProperty(htPage,'xmax)
+  iaone := htpProperty(htPage,'iaone)
+  ladifone := htpProperty(htPage,'ladifone)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  np1 := n + 1
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    arrayList := [right,:arrayList]
+  astring := bcwords2liststring arrayList
+  prefix := STRCONC('"e02ahf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [")
+  prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE la,", ",STRINGIMAGE ladifone,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ladif,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02ajf() ==
+  htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float)) 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02ajf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ajf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines the indefinite integral of the Chebyshev series ")
+    (text . "representation \newline \center{\htbitmap{e02ahf1}} ")
+    (text . "of a polynomial, where \htbitmap{xbar} is the normalis")
+    (text . "ed argument, related to the original variable {\it x} by the ")
+    (text . "transformation \blankline \center{\htbitmap{e02adf1}}")
+    (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ")
+    (text . "minimum and maximum values of {\it x} respectively. The integral")
+    (text . " polynomial has the form ")
+    (text . "\blankline \center{\htbitmap{e02ajf}}")
+    (text . "and the integration is with respect to the original variable ")
+    (text . "{\it x} \blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Degree of the polynomial {\it n}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline \htbitmap{xmin}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\htbitmap{xmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "-0.5" xmin F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "2.5" xmax F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Dimension of array {\it a}, {\it la}: ")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+--    (text . "Dimension of {\it aint}, {\it laint}: ")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (6 7 la PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 8 laint PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Index increment of {\it a}, {\it ia1}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Increment of {\it aint}, {\it iaint1}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 iaone PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 1 iaintone PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Constant of integration {\it qatm1}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" qatmone F))
+    (text . "\blankline")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02ajfSolve)
+  htShowPage()
+
+e02ajfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  xmin := htpLabelInputString(htPage,'xmin)
+  xmax := htpLabelInputString(htPage,'xmax)
+  iaone :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone)
+    objValUnwrap htpLabelSpadValue(htPage, 'iaone)
+  iaintone :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaintone)
+    objValUnwrap htpLabelSpadValue(htPage, 'iaintone)
+  la := 1+n*iaone
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la)
+--    objValUnwrap htpLabelSpadValue(htPage, 'la)
+  laint := n*iaintone + 1
+  qatmone := htpLabelInputString(htPage,'qatmone)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and (la ='7 and laint = '7)) => 
+     e02ajfDefaultSolve(htPage,xmin,xmax,iaone,iaintone,qatmone,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..la] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02AJF - Integral of fitted polynomial in Chebyshev series form",nil)
+  htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ajfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'laint,laint)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'iaintone,iaintone)
+  htpSetProperty(page,'qatmone,qatmone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02ajfDefaultSolve  (htPage,xmin,xmax,iaone,iaintone,qatmone,ifail) ==
+  n := '6
+  la := '7
+  laint := '8
+  page := htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Coefficients of {\it a(la)}: ")
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "2.53213" a1 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "1.13032" a2 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.27150" a3 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.04434" a4 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00547" a5 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00054" a6 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00004" a7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02ajfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'laint,laint)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'iaintone,iaintone)
+  htpSetProperty(page,'qatmone,qatmone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02ajfGen htPage ==
+  n := htpProperty(htPage,'n)
+  la := htpProperty(htPage,'la)
+  laint := htpProperty(htPage,'laint)
+  xmin := htpProperty(htPage,'xmin)
+  xmax := htpProperty(htPage,'xmax)
+  iaone := htpProperty(htPage,'iaone)
+  iaintone := htpProperty(htPage,'iaintone)
+  qatmone := htpProperty(htPage,'qatmone)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  np1 := n + 1
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    arrayList := [right,:arrayList]
+  astring := bcwords2liststring arrayList
+  prefix := STRCONC('"e02ajf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [")
+  prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE la,", ",qatmone,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE iaintone)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE laint,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02akf() ==
+  htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain F (Float)) 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02akf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02akf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates at the point x the Chebyshev series representation ")
+    (text . "representation \newline \center{\htbitmap{e02ahf1}} ")
+    (text . "of a polynomial, where \htbitmap{xbar} is the normalis")
+    (text . "ed argument, related to the original variable {\it x} by the ")
+    (text . "transformation \blankline \center{\htbitmap{e02adf1}}")
+    (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ")
+    (text . "minimum and maximum values of {\it x} respectively. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Degree of the polynomial {\it n}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Evaluation point {\it x}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 n PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 "-0.5" x F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline \htbitmap{xmin}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "\htbitmap{xmax}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "-0.5" xmin F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "2.5" xmax F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Dimension of array {\it a}, {\it la} : ")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Index increment of {\it a}, {\it ia1}: ")
+    (text . "\newline\tab{2} ")
+--    (bcStrings (6 7 la PI))
+--    (text . "\tab{34} ")
+    (bcStrings (6 1 iaone PI))
+    (text . "\blankline")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02akfSolve)
+  htShowPage()
+
+e02akfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  x := htpLabelInputString(htPage,'x)
+  xmin := htpLabelInputString(htPage,'xmin)
+  xmax := htpLabelInputString(htPage,'xmax)
+  iaone :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone)
+    objValUnwrap htpLabelSpadValue(htPage, 'iaone)
+  la := 1+n*iaone
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la)
+--    objValUnwrap htpLabelSpadValue(htPage, 'la)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and la ='7) =>  e02akfDefaultSolve(htPage,xmin,xmax,x,iaone,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..la] where f(i) ==
+      prefix := ('"\newline \tab{15} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil)
+  htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02akfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02akfDefaultSolve  (htPage,xmin,xmax,x,iaone,ifail) ==
+  n := '6
+  la := '7
+  page := htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Coefficients of {\it a(la)}: ")
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "2.53213" a1 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "1.13032" a2 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.27150" a3 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.04434" a4 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00547" a5 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00054" a6 F))
+    (text . "\newline \tab{15}")
+    (bcStrings (10 "0.00004" a7 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02akfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'xmin,xmin)
+  htpSetProperty(page,'xmax,xmax)
+  htpSetProperty(page,'iaone,iaone)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02akfGen htPage ==
+  n := htpProperty(htPage,'n)
+  x := htpProperty(htPage,'x)
+  la := htpProperty(htPage,'la)
+  xmin := htpProperty(htPage,'xmin)
+  xmax := htpProperty(htPage,'xmax)
+  iaone := htpProperty(htPage,'iaone)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  np1 := n + 1
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    arrayList := [right,:arrayList]
+  astring := bcwords2liststring arrayList
+  prefix := STRCONC('"e02akf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [")
+  prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE la,", ",x,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02baf() ==
+  htInitPage('"E02BAF - Least-squares curve cubic spine fit",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02baf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02baf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a least-squares cubic spline approximation to the ")
+    (text . "set of points {\it (}\htbitmap{xr},")
+    (text . "\htbitmap{yr}{\it )} with weights ")
+    (text . "\htbitmap{wr}, for r = 1,2,...,m. ")
+    (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,")
+    (text . "\htbitmap{ncap}+7, are prescribed by the user. The ")
+    (text . "spline is given by the B-spline representation \blankline ")
+    (text . "\center{\htbitmap{e02baf}} where ")
+    (text . "\htbitmap{ncap} is the number of intervals of the ")
+    (text . "spline. \blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 14 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of intervals in the spline \htbitmap{ncap}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 5 ncap PI))
+    (text . "\blankline")
+    (text . "\newline")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02bafSolve)
+  htShowPage()
+
+e02bafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  ncap :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncap)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '14 and ncap ='5) => e02bafDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  lamdaList := 
+    "append"/[g(j) for j in 5..(ncap+3)] where g(j) ==
+       anam := INTERN STRCONC ('"a",STRINGIMAGE j)
+       [['bcStrings,[6, 0.0, anam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} Interior knots ")
+  prefix := STRCONC(prefix,"\htbitmap{lamdai}, for i = 5,6,...,")
+  prefix := STRCONC(prefix,"\htbitmap{ncap} + 3: \newline \tab{2}" )
+  lamdaList := [['text,:prefix],:lamdaList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamdaList]
+  page := htInitPage("E02BAF - Least-squares curve cubic spline fit",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{dr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02bafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02bafDefaultSolve (htPage,ifail) ==
+  m := '14
+  ncap := '5
+  page := htInitPage('"E02BAF - Least-squares curve cubic spline fit",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{wr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.20" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.20" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.47" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.00" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.20" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.74" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.00" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.30" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.09" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.00" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.70" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.60" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.00" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.90" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.90" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.62" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.60" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "9.10" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.10" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.90" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "8.15" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.80" z9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.15" x10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.00" y10 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.50" z10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.17" x11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.00" y11 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.70" z11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.00" x12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.54" y12 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "10.00" x13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.39" y13 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "12.00" x14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.56" y14 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "Interior knots \htbitmap{lamdai}, for i = 5,6,...")
+    (text . "\htbitmap{ncap} + 3: \newline \tab{2}")
+    (bcStrings (6 "1.50" l1 F))
+    (bcStrings (6 "2.60" l2 F))
+    (bcStrings (6 "4.00" l3 F))
+    (bcStrings (6 "8.00" l4 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02bafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02bafGen htPage ==
+  m := htpProperty(htPage,'m)
+  ncap := htpProperty(htPage,'ncap)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  ncap7 := ncap + 7
+  y := alist
+  for i in (ncap+4)..(ncap+7) repeat
+    lambda := STRCONC( "0.0"," ")
+    lambdaList := [lambda,:lambdaList]
+  for i in 5..(ncap+3) repeat
+    lambda := STRCONC ((first y).1," ")
+    y := rest y
+    lambdaList := [lambda,:lambdaList]
+  for i in 1..4 repeat
+    lambda := STRCONC( "0.0"," ")
+    lambdaList := [lambda,:lambdaList]
+  lambdaString := bcwords2liststring lambdaList
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    wlist := [right,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  wstring := bcwords2liststring wlist
+  prefix := STRCONC('"e02baf(",STRINGIMAGE m,", ",STRINGIMAGE ncap7,", [")
+  prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",wstring,"], [")
+  prefix := STRCONC(prefix,lambdaString,"], ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02bbf() ==
+  htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02bbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bbf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates at the point {\it x} a cubic spline from its B-spline ")
+    (text . "B-spline representation ")
+    (text . "\center{\htbitmap{e02baf}} where ")
+    (text . "\htbitmap{ncap} is the number of intervals of the ")
+    (text . "spline. The spline has knots \htbitmap{lamdai}, for ")
+    (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of intervals in the spline \htbitmap{ncap}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 4 ncap PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Evaluation point {\it x}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" x F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02bbfSolve)
+  htShowPage()
+
+e02bbfSolve htPage ==
+  ncap :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncap)
+  x := htpLabelInputString(htPage,'x)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ncap = '4  => e02bbfDefaultSolve(htPage,x,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..(ncap+7)] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02BBF - Evaluation of fitted cubic spline, function only",nil)
+  htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: "
+  htSay '"\tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Coefficients \space{1} \htbitmap{ci}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02bbfGen)
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02bbfDefaultSolve (htPage,x,ifail) ==
+  ncap := '4
+  page := htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Knots \space{1}")
+    (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Coefficients \space{1} \htbitmap{ci}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "1.00" l1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.00" c1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" l2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.00" c2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" l3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.00" c3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" l4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.00" c4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.00" c5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.00" c6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.00" l7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.00" c7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.00" l8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.00" l9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.00" l10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "9.00" l11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c11 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02bbfGen)    	
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02bbfGen htPage ==
+  ncap := htpProperty(htPage,'ncap)
+  x := htpProperty(htPage,'x)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  ncap7 := ncap + 7
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    lamlist := [left,:lamlist]
+    clist := [right,:clist]
+  lamstring := bcwords2liststring lamlist
+  cstring := bcwords2liststring clist
+  prefix := STRCONC('"e02bbf(",STRINGIMAGE ncap7,", [",lamstring,"],[")
+  prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02bcf() ==
+  htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02bcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bcf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates at the point {\it x} a cubic spline and its first ")
+    (text . "three derivatives from its B-spline representation ")
+    (text . "\center{\htbitmap{e02baf}} where ")
+    (text . "\htbitmap{ncap} is the number of intervals of the ")
+    (text . "spline. The spline has knots \htbitmap{lamdai}, for ")
+    (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of intervals in the spline \htbitmap{ncap}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 ncap PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Evaluation point {\it x}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" x F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "{\it LEFT} specifies whether LH or RH derivatives are required: ")
+    (radioButtons deriv
+        ("" "  Left-hand derivative" left)
+        ("" "  Right-hand derivative" right))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02bcfSolve)
+  htShowPage()
+
+e02bcfSolve htPage ==
+  ncap :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncap)
+  x := htpLabelInputString(htPage,'x)
+  temp := htpButtonValue(htPage,'deriv)
+  deriv :=
+    temp = 'left => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ncap = '7  => e02bcfDefaultSolve(htPage,x,deriv,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..(ncap+7)] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil)
+  htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: "
+  htSay '"\tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Coefficients \space{1} \htbitmap{ci}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02bcfGen)
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'deriv,deriv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02bcfDefaultSolve (htPage,x,deriv,ifail) ==
+  ncap := '7
+  page := htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\menuitemstyle{}\tab{2} Knots \space{1}")
+    (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Coefficients \space{1} \htbitmap{ci}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.0" l1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.00" c1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.00" c2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "13.00" c3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "15.00" c4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" l5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "22.00" c5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "26.00" c6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "24.00" c7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "18.00" c8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" l9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.00" c9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" l10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.00" c10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c14 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02bcfGen)    	
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'x,x)
+  htpSetProperty(page,'deriv,deriv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02bcfGen htPage ==
+  ncap := htpProperty(htPage,'ncap)
+  x := htpProperty(htPage,'x)
+  deriv := htpProperty(htPage,'deriv)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  ncap7 := ncap + 7
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    lamlist := [left,:lamlist]
+    clist := [right,:clist]
+  lamstring := bcwords2liststring lamlist
+  cstring := bcwords2liststring clist
+  prefix := STRCONC('"e02bcf(",STRINGIMAGE ncap7,", [",lamstring,"],[")
+  prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE deriv)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+
+e02bdf() ==
+  htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02bdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bdf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates the definite integral of a cubic spline from its ")
+    (text . "B-spline representation \center{\htbitmap{e02baf}} ")
+    (text . "where \htbitmap{ncap} is the number of intervals of ")
+    (text . "the spline. The spline has knots \htbitmap{lamdai}, ")
+    (text . "for i = 1,2,...,\htbitmap{ncap} + 7, and the integral ")
+    (text . "is evaluated over the range \htbitmap{e02bdf} ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of intervals in the spline \htbitmap{ncap}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 ncap PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02bdfSolve)
+  htShowPage()
+
+e02bdfSolve htPage ==
+  ncap :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncap)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ncap = '7 => e02bdfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..(ncap+7)] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage("E02BDF - Evaluation of fitted cubic spline, definite integral",nil)
+  htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: "
+  htSay '"\tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Coefficients \space{1} \htbitmap{ci}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02bdfGen)
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02bdfDefaultSolve(htPage,ifail) ==
+  ncap := '7
+  page := htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Knots \space{1}")
+    (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Coefficients \space{1} \htbitmap{ci}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.0" l1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "10.00" c1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.00" c2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "13.00" c3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00" l4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "15.00" c4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" l5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "22.00" c5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "26.00" c6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "24.00" c7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" l8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "18.00" c8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" l9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "14.00" c9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" l10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "12.00" c10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" l14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.00" c14 F)))
+  htpSetProperty(page,'ncap,ncap)
+  htpSetProperty(page,'ifail,ifail)
+  htMakeDoneButton('"Continue",'e02bdfGen)    	
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02bdfGen htPage ==
+  ncap := htpProperty(htPage,'ncap)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  ncap7 := ncap + 7
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    lamlist := [left,:lamlist]
+    clist := [right,:clist]
+  lamstring := bcwords2liststring lamlist
+  cstring := bcwords2liststring clist
+  prefix := STRCONC('"e02bdf(",STRINGIMAGE ncap7,", [",lamstring,"],[")
+  prefix := STRCONC(prefix,cstring,"], ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+
+e02bef() ==
+  htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02bef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bef| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Determines a cubic spline approximation to the set of points ")
+    (text . "{\it ( \htbitmap{xr},\htbitmap{yr}) } ")
+    (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ")
+    (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,n, ")
+    (text . "are chosen by the routine, but a single parameter S must be ")
+    (text . "specified to control the trade-off between closeness of fit and ")
+    (text . "smoothness of fit. This affects the number of knots required ")
+    (text . "by the spline, which is given in the B-spline representation ")
+    (text . "\center{\htbitmap{e02bef}}, where n-1 is the number of")
+    (text . " intervals of the spline. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 15 m PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Smoothing factor {\it s}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "1.0" s F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2}  ")
+    (text . "Over-estimate of number n of knots {\it nest}:\newline\tab{2} ")
+    (bcStrings (6 54 nest PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Start value: ")
+    (radioButtons start
+        ("" "  Cold Start - no values needed for {\it n,lamda,wrk} or {\it iwrk}" cold)
+        ("" "  Warm Start - uses knots found in a previous call" warm))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02befSolve)
+  htShowPage()
+
+e02befSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  nest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nest)
+  lwrk := 4*m +16*nest + 41
+  s := htpLabelInputString(htPage,'s)
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'cold => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = 15 and start = 1) => e02befDefaultSolve (htPage,nest,lwrk,s,ifail)
+  start = 1 => e02befColdSolve (htPage,m,nest,lwrk,s,ifail)
+  -- warm start not really possible from hyperdoc
+  -- as inputing a workspace array of dimension 1105 is asking too much
+  -- user should use the command line, using the previous calculated 
+  -- parameters
+  htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\blankline ")
+    (text . "{\center{\it Hyperdoc interface not available for warm starts.}}")
+    (text . "\newline ")
+    (text . "{\center{\it Please use the command line.}}"))
+  htMakeDoneButton('"Continue",'e02bef)
+  htShowPage()
+
+
+
+e02befColdSolve(htPage,m,nest,lwrk,s,ifail) ==
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      post   := ('" \tab{42} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+      num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10)))
+      [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}"
+  htSay '"\menuitemstyle{}\tab{42} Values of \space{1} "
+  htSay '"\htbitmap{wr}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02befColdGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nest,nest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02befDefaultSolve (htPage,nest,lwrk,s,ifail) ==
+  m := 15
+  page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \space{1} ")
+    (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ")
+    (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ")
+    (text . "\menuitemstyle{}\tab{42} Values of \space{1} ")
+    (text . "\htbitmap{wr}: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.00" x1 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "-1.1" y1 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.50" x2 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "-0.372" y2 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.00" z2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.00" x3 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "0.431" y3 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.50" z3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "1.50" x4 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "1.69" y4 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.00" x5 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "2.11" y5 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "3.00" z5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "2.50" x6 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "3.10" y6 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z6 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "3.00" x7 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.23" y7 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "0.50" z7 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.00" x8 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.35" y8 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z8 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "4.50" x9 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.81" y9 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.00" z9 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.00" x10 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.61" y10 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.50" z10 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "5.50" x11 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "4.79" y11 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "6.00" x12 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "5.23" y12 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "3.00" z12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.00" x13 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "6.35" y13 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "7.50" x14 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.19" y14 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "2.00" z14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "8.00" x15 F))
+    (text . "\tab{22} ")
+    (bcStrings (10 "7.97" y15 F))
+    (text . "\tab{42} ")
+    (bcStrings (10 "1.00" z15 F))
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02befColdGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nest,nest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02befColdGen htPage ==
+  m := htpProperty(htPage,'m)
+  nest := htpProperty(htPage,'nest)
+  lwrk := htpProperty(htPage,'lwrk)
+  s := htpProperty(htPage,'s)
+  cold := '"c"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    wlist := [right,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  wstring := bcwords2liststring wlist
+  -- additional entries needed to get it running
+  -- but as Start = c they are not used
+  -- mmax := 50
+  -- nest := mmax + 4 (54)
+  -- lwrk := 4*mmax + 16*nest+41 (1105)
+  prefix := STRCONC('"e02bef(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[")
+  prefix := STRCONC(prefix,ystring,"],[",wstring,"], ",STRINGIMAGE s,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nest,", ",STRINGIMAGE lwrk)
+--  prefix := STRCONC(prefix,",0, [[0.0 for i in 1..",STRINGIMAGE nest,"]],")
+--  prefix := STRCONC(prefix,STRINGIMAGE ifail,", [[0.0 for i in 1..")
+--  prefix := STRCONC(prefix,STRINGIMAGE lwrk,"]], [[0 for i in 1..")
+--  prefix := STRCONC(prefix,STRINGIMAGE nest,"]] :: Matrix Integer)")
+  prefix := STRCONC(prefix,",0, new(1,",STRINGIMAGE nest,",0.0)$Matrix DoubleFloat,")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,", new(1,",STRINGIMAGE lwrk,",0.0)$Matrix DoubleFloat, ")
+  prefix := STRCONC(prefix," new(1,",STRINGIMAGE nest,",0)$Matrix Integer)")
+  linkGen prefix
+
+e02def() == 
+  htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02def} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02def| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates a bicubic spline at the (\htbitmap{xr},")
+    (text . "\htbitmap{yr}), for r = 1,2,...,m, from its B-spline ")
+    (text . "representation \htbitmap{e02daf} ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of evaluation points, {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 m PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of (interior & exterior) knots ")
+    (text . "\lambda, \htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ")
+    (bcStrings (6 11 px PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of (interior & exterior) knots ")
+    (text . "\mu, \htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02defSolve)
+  htShowPage()
+
+e02defSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '7 and px = '11) and py = '10) => e02defDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[fxy(i) for i in 1..m] where fxy(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{22} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]]]
+  lamList :=
+    "append"/[flam(i) for i in 1..px] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(nxest)}: \newline")
+  lamList := [['text,:prefix],:lamList]
+  muList :=
+    "append"/[fmu(i) for i in 1..(py)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(nyest)}:")
+  prefix := STRCONC(prefix,"\newline ")
+  muList := [['text,:prefix],:muList]
+  cList :=
+    "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) ==
+      pnam := INTERN STRCONC ('"p",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, pnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2}Enter values of ")
+  prefix := STRCONC(prefix,"{\it c((nxest*4)-(nyest*4))}: \newline ")
+  cList := [['text,:prefix],:cList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamList,:muList,:cList]
+  page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: "
+  htSay '"\tab{20} \menuitemstyle{}\tab{22} Values of \htbitmap{yr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02defGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02defDefaultSolve (htPage,ifail) ==
+  m := '7
+  px := '11
+  py := '10
+  page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:")
+    (text . "\tab{20} \menuitemstyle{} \tab{22} Values of ")
+    (text . "\htbitmap{yr}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1" x1 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0" y1 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.1" x2 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0.1" y2 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.5" x3 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0.7" y3 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.6" x4 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0.4" y4 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.9" x5 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0.3" y5 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.9" x6 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "0.8" y6 F))  
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "2" x7 F))  
+    (text . "\tab{22}")
+    (bcStrings (8 "1" y7 F))  
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \lambda(nxest)}:")
+    (text . "\newline ")
+    (bcStrings (8 "1.0" l1 F))
+    (bcStrings (8 "1.0" l2 F))
+    (bcStrings (8 "1.0" l3 F))
+    (bcStrings (8 "1.0" l4 F))
+    (bcStrings (8 "1.3" l5 F))
+    (bcStrings (8 "1.5" l6 F))
+    (bcStrings (8 "1.6" l7 F))
+    (bcStrings (8 "2" l8 F))
+    (bcStrings (8 "2" l9 F))
+    (bcStrings (8 "2" l10 F))
+    (bcStrings (8 "2" l11 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \mu(nyest)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" mu1 F))
+    (bcStrings (8 "0" mu2 F))
+    (bcStrings (8 "0" mu3 F))
+    (bcStrings (8 "0" mu4 F))
+    (bcStrings (8 "0.4" mu5 F))
+    (bcStrings (8 "0.7" mu6 F))
+    (bcStrings (8 "1" mu7 F))
+    (bcStrings (8 "1" mu8 F))
+    (bcStrings (8 "1" mu9 F))
+    (bcStrings (8 "1" mu10 F))
+    (text . "\blankline \menuitemstyle{}\tab{2} ")
+    (text . "Enter values for {\it c((nxest-4)*(nyest-4))}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" c1 F))	
+    (bcStrings (8 "1.1333" c2 F))	
+    (bcStrings (8 "1.3667" c3 F))	
+    (bcStrings (8 "1.7" c4 F))	
+    (bcStrings (8 "1.9" c5 F))	
+    (bcStrings (8 "2" c6 F))	
+    (bcStrings (8 "1.2" c7 F))	
+    (bcStrings (8 "1.3333" c8 F))	
+    (bcStrings (8 "1.5667" c9 F))	
+    (bcStrings (8 "1.9" c10 F))	
+    (bcStrings (8 "2.1" c11 F))	
+    (bcStrings (8 "2.2" c12 F))	
+    (bcStrings (8 "1.5833" c13 F))	
+    (bcStrings (8 "1.7167" c14 F))	
+    (bcStrings (8 "1.95" c15 F))	
+    (bcStrings (8 "2.2833" c16 F))	
+    (bcStrings (8 "2.4833" c17 F))	
+    (bcStrings (8 "2.5833" c18 F))	
+    (bcStrings (8 "2.1433" c19 F))	
+    (bcStrings (8 "2.2767" c20 F))	
+    (bcStrings (8 "2.51" c21 F))	
+    (bcStrings (8 "2.8433" c22 F))	
+    (bcStrings (8 "3.0433" c23 F))	
+    (bcStrings (8 "3.1433" c24 F))	
+    (bcStrings (8 "2.8667" c25 F))	
+    (bcStrings (8 "3" c26 F))	
+    (bcStrings (8 "3.2333" c27 F))	
+    (bcStrings (8 "3.5667" c28 F))	
+    (bcStrings (8 "3.7667" c29 F))	
+    (bcStrings (8 "3.8667" c30 F))	
+    (bcStrings (8 "3.4667" c31 F))	
+    (bcStrings (8 "3.6" c32 F))	
+    (bcStrings (8 "3.8333" c33 F))	
+    (bcStrings (8 "4.1667" c34 F))	
+    (bcStrings (8 "4.3667" c35 F))	
+    (bcStrings (8 "4.4667" c36 F))	
+    (bcStrings (8 "4" c37 F))	
+    (bcStrings (8 "4.1333" c38 F))	
+    (bcStrings (8 "4.3667" c39 F))	
+    (bcStrings (8 "4.7" c40 F))	
+    (bcStrings (8 "4.9" c41 F))	
+    (bcStrings (8 "5" c42 F))	
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'e02defGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02defGen htPage ==
+  m := htpProperty(htPage,'m)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  -- c
+  for i in 1..((px-4)*(py-4)) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    cList := [right,:cList]
+  cstring := bcwords2liststring cList
+  -- mu 
+  for i in 1..py repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..px repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  lamstring := bcwords2liststring lamList
+  -- x & y
+  while y repeat
+    one := STRCONC((first y).1," ")
+    y := rest y
+    two := STRCONC((first y).1," ")
+    y := rest y
+    xlist := [two,:xlist]
+    ylist := [one,:ylist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  prefix := STRCONC('"e02def(",STRINGIMAGE m,", ",STRINGIMAGE px,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[")
+  prefix := STRCONC(prefix,lamstring,"],[",mustring,"],[",cstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02dff() == 
+  htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02dff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dff| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Evaluates a bicubic spline at all the points on a rectangular ")
+    (text . "grid defined by \htbitmap{mx} points ")
+    (text . "\htbitmap{xq}on the x-axis and \htbitmap{my}")
+    (text . "points \htbitmap{yr} on the y-axis, from its B-spline ")
+    (text . "representation \center{\htbitmap{e02daf}} \newline with knot sets ")
+    (text . "\{\lambda\} and \{\mu\}. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Grid points on x-axis \htbitmap{mx}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Grid points on y-axis \htbitmap{my}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 mx PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 6 my PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Number of (interior & exterior) knots \lambda, ")
+    (text . "\htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ")
+    (bcStrings (6 11 px PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Number of (interior & exterior) knots \mu, ")
+    (text . "\htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02dffSolve)
+  htShowPage()
+
+e02dffSolve htPage ==
+  mx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx)
+    objValUnwrap htpLabelSpadValue(htPage, 'mx)
+  my :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my)
+    objValUnwrap htpLabelSpadValue(htPage, 'my)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  nwrk1 := 4*mx + px
+  nwrk2 := 4*my + py
+  nwrklist := [nwrk1,nwrk2]
+  nwrkmin := APPLY ('MIN, nwrklist)
+  lwrk := nwrkmin
+  liwrk :=
+    nwrkmin = nwrk2 => my + py -4
+    mx + px -4
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((mx = '7 and my = '6) and (px = '11 and py = '10)) => 
+    e02dffDefaultSolve(htPage,lwrk,liwrk,ifail)
+  xList :=
+    "append"/[fx(i) for i in 1..mx] where fx(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, xnam, 'F]]]
+  yList :=
+    "append"/[fy(i) for i in 1..my] where fy(i) ==
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, ynam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of ")
+  prefix := STRCONC(prefix,"\htbitmap{yr} : \newline")
+  yList := [['text,:prefix],:yList]
+  lamList :=
+    "append"/[flam(i) for i in 1..px] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it \lambda(nxest)}:\newline")
+  lamList := [['text,:prefix],:lamList]
+  muList :=
+    "append"/[fmu(i) for i in 1..(py)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it mu(nyest)}:")
+  prefix := STRCONC(prefix,"\newline ")
+  muList := [['text,:prefix],:muList]
+  cList :=
+    "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) ==
+      pnam := INTERN STRCONC ('"p",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, pnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} Enter values of ")
+  prefix := STRCONC(prefix,"{\it c((px-4)*(py-4))}: \newline")
+  cList := [['text,:prefix],:cList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :xList,:yList,:lamList,:muList,:cList]
+  page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:\newline "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02dffGen)
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02dffDefaultSolve (htPage,lwrk,liwrk,ifail) ==
+  mx := '7
+  my := '6
+  px := '11
+  py := '10
+  page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{xr}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" x1 F))  
+    (bcStrings (8 "1.1" x2 F))  
+    (bcStrings (8 "1.3" x3 F))  
+    (bcStrings (8 "1.4" x4 F))  
+    (bcStrings (8 "1.5" x5 F))  
+    (bcStrings (8 "1.7" x6 F))  
+    (bcStrings (8 "2" x7 F))  
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{yr}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" y1 F))  
+    (bcStrings (8 "0.2" y2 F))  
+    (bcStrings (8 "0.4" y3 F))  
+    (bcStrings (8 "0.6" y4 F))  
+    (bcStrings (8 "0.8" y5 F))  
+    (bcStrings (8 "1" y6 F))  
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it \lambda(nxest)}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" l1 F))
+    (bcStrings (8 "1" l2 F))
+    (bcStrings (8 "1" l3 F))
+    (bcStrings (8 "1" l4 F))
+    (bcStrings (8 "1.3" l5 F))
+    (bcStrings (8 "1.5" l6 F))
+    (bcStrings (8 "1.6" l7 F))
+    (bcStrings (8 "2" l8 F))
+    (bcStrings (8 "2" l9 F))
+    (bcStrings (8 "2" l10 F))
+    (bcStrings (8 "2" l11 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it \mu(nyest)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" mu1 F))
+    (bcStrings (8 "0" mu2 F))
+    (bcStrings (8 "0" mu3 F))
+    (bcStrings (8 "0" mu4 F))
+    (bcStrings (8 "0.4" mu5 F))
+    (bcStrings (8 "0.7" mu6 F))
+    (bcStrings (8 "1" mu7 F))
+    (bcStrings (8 "1" mu8 F))
+    (bcStrings (8 "1" mu9 F))
+    (bcStrings (8 "1" mu10 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it c((px-4)*(py-4))}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" c1 F))	
+    (bcStrings (8 "1.1333" c2 F))	
+    (bcStrings (8 "1.3667" c3 F))	
+    (bcStrings (8 "1.7" c4 F))	
+    (bcStrings (8 "1.9" c5 F))	
+    (bcStrings (8 "2" c6 F))	
+    (bcStrings (8 "1.2" c7 F))	
+    (bcStrings (8 "1.3333" c8 F))	
+    (bcStrings (8 "1.5667" c9 F))	
+    (bcStrings (8 "1.9" c10 F))	
+    (bcStrings (8 "2.1" c11 F))	
+    (bcStrings (8 "2.2" c12 F))	
+    (bcStrings (8 "1.5833" c13 F))	
+    (bcStrings (8 "1.7167" c14 F))	
+    (bcStrings (8 "1.95" c15 F))	
+    (bcStrings (8 "2.2833" c16 F))	
+    (bcStrings (8 "2.4833" c17 F))	
+    (bcStrings (8 "2.5833" c18 F))	
+    (bcStrings (8 "2.1433" c19 F))	
+    (bcStrings (8 "2.2767" c20 F))	
+    (bcStrings (8 "2.51" c21 F))	
+    (bcStrings (8 "2.8433" c22 F))	
+    (bcStrings (8 "3.0433" c23 F))	
+    (bcStrings (8 "3.1433" c24 F))	
+    (bcStrings (8 "2.8667" c25 F))	
+    (bcStrings (8 "3" c26 F))	
+    (bcStrings (8 "3.2333" c27 F))	
+    (bcStrings (8 "3.5667" c28 F))	
+    (bcStrings (8 "3.7667" c29 F))	
+    (bcStrings (8 "3.8667" c30 F))	
+    (bcStrings (8 "3.4667" c31 F))	
+    (bcStrings (8 "3.6" c32 F))	
+    (bcStrings (8 "3.8333" c33 F))	
+    (bcStrings (8 "4.1667" c34 F))	
+    (bcStrings (8 "4.3667" c35 F))	
+    (bcStrings (8 "4.4667" c36 F))	
+    (bcStrings (8 "4" c37 F))	
+    (bcStrings (8 "4.1333" c38 F))	
+    (bcStrings (8 "4.3667" c39 F))	
+    (bcStrings (8 "4.7" c40 F))	
+    (bcStrings (8 "4.9" c41 F))	
+    (bcStrings (8 "5" c42 F))	
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02dffGen)    	
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02dffGen htPage ==
+  mx := htpProperty(htPage,'mx)
+  my := htpProperty(htPage,'my)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  -- c
+  for i in 1..((px-4)*(py-4)) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    cList := [right,:cList]
+  cstring := bcwords2liststring cList
+  -- mu 
+  for i in 1..py repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..px repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  lamstring := bcwords2liststring lamList
+  -- y
+  for i in 1..my repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    yList := [right,:yList]
+  ystring := bcwords2liststring yList
+  -- x 
+  for i in 1..mx repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    xList := [right,:xList]
+  xstring := bcwords2liststring xList
+  prefix := STRCONC('"e02dff(",STRINGIMAGE mx,", ",STRINGIMAGE my,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE px,", ",STRINGIMAGE py,",[")
+  prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",lamstring,"],[")
+  prefix := STRCONC(prefix,mustring,"],[",cstring,"],",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02gaf() ==
+  htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain F (Float))
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02gaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02gaf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Calculates an \htbitmap{l1} solution to the over determined system")
+    (text . " of linear equations {\it Ax = b}, where A is an {\it m} by {\it n")
+    (text . "} matrix, {\it x} is an {\it n} element vector, and {\it b} is an ")
+    (text . "{\it m} element vector.  The matrix {\it A} need not be of full ")
+    (text . "rank. \blankline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of rows of {\it A}, {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of columns of {\it A}, {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2} \newline ")
+--    (text . "First dimension of {\it A(la,n+2)}, {\it la}\htbitmap{great=}")
+--    (text . " {\it m + 2}: \newline\tab{2} ")
+--    (bcStrings (6 7 la PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} \newline ")
+    (text . "Tolerance (default is zero), {\it toler}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.0" toler F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02gafSolve)
+  htShowPage()
+
+e02gafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  la := m+2
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la)
+--    objValUnwrap htpLabelSpadValue(htPage, 'la)
+  toler := htpLabelInputString(htPage,'toler)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = 5 and n = 3) and la = 7) => e02gafDefaultSolve (htPage,toler,ifail) 
+  labelList :=
+    "append"/[fc(i,n) for i in 1..la] where fc(i,n) ==
+      tempList := 
+        "append"/[fr(i,j) for j in 1..(n+2)] where fr(i,j) == 
+          fnam := INTERN STRCONC ('"f",STRINGIMAGE i, STRINGIMAGE j)
+          [['bcStrings,[9, 0.0, fnam, 'F]]]
+      prefix := ('"\newline ")
+      tempList := [['text,:prefix],:tempList]
+  bList := 
+    "append"/[fb(i) for i in 1..m] where fb(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[9, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of {\it B(m)}: \newline")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:bList]
+  page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02gafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'toler,toler)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02gafDefaultSolve (htPage,toler,ifail) ==
+  m := '5
+  n := '3
+  la := '7
+  page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:")
+    (text . "\newline ")
+    (bcStrings (9 "1.0" a11 F))  
+    (bcStrings (9 "1.0" a12 F))  
+    (bcStrings (9 "1.0" a13 F))  
+    (bcStrings (9 "0.0" a14 F))  
+    (bcStrings (9 "0.0" a15 F))  
+    (text . "\newline ")
+    (bcStrings (9 "exp(0.2)" a21 F))  
+    (bcStrings (9 "exp(-0.2)" a22 F))  
+    (bcStrings (9 "1.0" a23 F))  
+    (bcStrings (9 "0.0" a24 F))  
+    (bcStrings (9 "0.0" a25 F))  
+    (text . "\newline ")
+    (bcStrings (9 "exp(0.4)" a31 F))  
+    (bcStrings (9 "exp(-0.4)" a32 F))  
+    (bcStrings (9 "1.0" a33 F))  
+    (bcStrings (9 "0.0" a34 F))  
+    (bcStrings (9 "0.0" a35 F))  
+    (text . "\newline ")
+    (bcStrings (9 "exp(0.6)" a41 F))  
+    (bcStrings (9 "exp(-0.6)" a42 F))  
+    (bcStrings (9 "1.0" a43 F))  
+    (bcStrings (9 "0.0" a44 F))  
+    (bcStrings (9 "0.0" a45 F))  
+    (text . "\newline ")
+    (bcStrings (9 "exp(0.8)" a51 F))  
+    (bcStrings (9 "exp(-0.8)" a52 F))  
+    (bcStrings (9 "1.0" a53 F))  
+    (bcStrings (9 "0.0" a54 F))  
+    (bcStrings (9 "0.0" a55 F))  
+    (text . "\newline ")
+    (bcStrings (9 "0.0" a61 F))  
+    (bcStrings (9 "0.0" a62 F))  
+    (bcStrings (9 "0.0" a63 F))  
+    (bcStrings (9 "0.0" a64 F))  
+    (bcStrings (9 "0.0" a65 F))  
+    (text . "\newline ")
+    (bcStrings (9 "0.0" a71 F))  
+    (bcStrings (9 "0.0" a72 F))  
+    (bcStrings (9 "0.0" a73 F))  
+    (bcStrings (9 "0.0" a74 F))  
+    (bcStrings (9 "0.0" a75 F))  
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it B(m)}:")
+    (text . "\newline ")
+    (bcStrings (9 "4.501" b1 F))  
+    (bcStrings (9 "4.36" b2 F))  
+    (bcStrings (9 "4.333" b3 F))  
+    (bcStrings (9 "4.418" b4 F))  
+    (bcStrings (9 "4.625" b5 F)))  
+  htMakeDoneButton('"Continue",'e02gafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'toler,toler)
+  htpSetProperty(page,'la,la)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02gafGen htPage ==
+  m := htpProperty(htPage,'m)
+  n := htpProperty(htPage,'n)
+  la := htpProperty(htPage,'la)
+  toler := htpProperty(htPage,'toler)
+  ifail := htpProperty(htPage,'ifail)
+  nplustwo := n + 2
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..m repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    blist := [right,:blist]    
+  bstring := bcwords2liststring blist
+  y := REVERSE y
+  k := -1
+  matform := [[y.(k := k + 1).1 for j in 0..(nplustwo-1)] for i in 0..(la-1)]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform] 
+  prefix := STRCONC('"e02gaf(",STRINGIMAGE m,", ",STRINGIMAGE la,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nplustwo,", ",STRINGIMAGE toler,", ")
+  prefix := STRCONC(prefix,matstring,",[",bstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02daf() == 
+  htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a minimal, least squares bicubic B-spline surface fit")
+    (text . "\htbitmap{e02daf} to the set of points ")
+    (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ")
+    (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ")
+    (text . "knot sets {\lambda},in the x-direction and {\mu} in the ")
+    (text . "y-direction, ")
+    (text . "which can be thought of as dividing the data region into panels;")
+    (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ")
+    (text . "the polynomial joining together with second derivative ")
+    (text . "continuity. Eight additional (external) knots are added to each ")
+    (text . "of the knot sets by this routine. The routine minimizes \Sigma, ")
+    (text . "the sum of squares of the weighted residuals ")
+    (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ")
+    (text . "given knot sets. \newline ")
+    (text . "A call of this routine should be preceded by a call of E02ZAF ")
+    (text . "to provide indexing information. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Knots in x direction {\em px}")
+    (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Knots in y direction {\em py}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 8 px PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Rank threshold {\em eps}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.000001" eps F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Dimension of point {\it npoint}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 43 npoint PI))
+    -- include a radio button later to allow switching of
+    -- x & y if px <= py 
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02dafSolve)
+  htShowPage()
+
+e02dafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  npoint :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint)
+    objValUnwrap htpLabelSpadValue(htPage, 'npoint)
+  nc := (px - 4)*(py - 4)
+  nws := (2*nc + 1)*(3*py - 6) -2
+  eps := htpLabelInputString(htPage,'eps)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail)
+  labelList :=
+    "append"/[fxy(i) for i in 1..m] where fxy(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      next := ('"\tab{32} ")
+      end := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+         ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]],
+           ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  lamList :=
+    "append"/[flam(i) for i in 5..(px-4)] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  postfix := ('"\newline \blankline ")
+  lamList := [['text,:prefix],:lamList,['text,:postfix]]
+  muList :=
+    "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  muList := [['text,:prefix],:muList]
+  pList :=
+    "append"/[fp(i) for i in 1..npoint] where fp(i) ==
+      prefix := ('"\newline \tab{2} ")
+      pnam := INTERN STRCONC ('"p",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ")
+  pList := [['text,:prefix],:pList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamList,:muList,:pList]
+  page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: "
+  htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:"
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" 
+  htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02dafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'nws,nws)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) ==
+  m := '30
+  px := '8
+  py := '10
+  page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:")
+    (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ")
+    (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ")
+    (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ")
+    (text . "\tab{46} Values of \htbitmap{wr}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.52" x1 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.60" y1 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.93" f1 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.61" x2 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.95" y2 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.79" f2 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.93" x3 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.87" y3 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.36" f3 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.09" x4 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.84" y4 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.52" f4 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.88" x5 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.17" y5 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.49" f5 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.70" x6 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.87" y6 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.76" f6 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1" x7 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1" y7 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.33" f7 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1" x8 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.1" y8 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.48" f8 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.3" x9 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.24" y9 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.65" f9 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.77" x10 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.77" y10 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.82" f10 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w10 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.23" x11 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.32" y11 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.92" f11 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w11 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-1" x12 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1" y12 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "1" f12 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w12 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.26" x13 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.63" y13 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "8.88" f13 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w13 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.83" x14 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.66" y14 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-2.01" f14 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w14 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.22" x15 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.93" y15 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.47" f15 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w15 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.89" x16 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.15" y16 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.49" f16 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w16 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.80" x17 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.99" y17 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.84" f17 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w17 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.88" x18 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.54" y18 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-2.42" f18 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w18 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.68" x19 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.44" y19 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.47" f19 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w19 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.14" x20 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.72" y20 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "7.15" f20 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w20 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.67" x21 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.63" y21 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" f21 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w21 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.90" x22 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.40" y22 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-3.34" f22 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w22 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.84" x23 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.20" y23 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "2.78" f23 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w23 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.84" x24 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.43" y24 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" f24 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w24 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.15" x25 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.28" y25 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.70" f25 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w25 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.91" x26 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.24" y26 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-6.52" f26 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w26 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.35" x27 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.86" y27 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.66" f27 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w27 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.16" x28 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.41" y28 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "2.32" f28 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w28 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.35" x29 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.05" y29 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "1.66" f29 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w29 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-1" x30 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-1" y30 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1" f30 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w30 F))    
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.50" mu5 F))
+    (bcStrings (8 "0.00" mu6 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values for point:")
+    (text . "\newline \tab{2}")
+    (bcStrings (6 3 p1 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 6 p2 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 4 p3 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 5 p4 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 7 p5 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 10 p6 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 8 p7 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 9 p8 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 11 p9 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 13 p10 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 12 p11 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 15 p12 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 14 p13 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 18 p14 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 16 p15 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 17 p16 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 19 p17 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 20 p18 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 21 p19 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 30 p20 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 23 p21 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 26 p22 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 24 p23 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 25 p24 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 27 p25 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 28 p26 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p27 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 29 p28 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p29 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p30 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 2 p31 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 22 p32 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 1 p33 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p34 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p35 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p36 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p37 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p38 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p39 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p40 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p41 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p42 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p43 PI))	
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02dafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'nws,nws)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02dafGen htPage ==
+  m := htpProperty(htPage,'m)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  nws := htpProperty(htPage,'nws)
+  eps := htpProperty(htPage,'eps)
+  npoint := htpProperty(htPage,'npoint)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  nadres := (px-7)*(py-7)
+  -- point
+  for i in 1..npoint repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    pointList := [right,:pointList]
+  pstring := bcwords2liststring pointList
+  -- mu 
+  for i in 1..4 repeat
+    muList := ['"0 ",:muList]
+  for i in 5..(py-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  for i in (py-3)..py repeat
+    muList := ['"0 ",:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..4 repeat
+    lamList := ['"0 ",:lamList]
+  for i in 5..(px-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  for i in (px-3)..px repeat
+    lamList := ['"0 ",:lamList]
+  lamstring := bcwords2liststring lamList
+  -- x & y
+  while y repeat
+    one := STRCONC((first y).1," ")
+    y := rest y
+    two := STRCONC((first y).1," ")
+    y := rest y
+    three := STRCONC ((first y).1," ")
+    y := rest y    
+    four :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [four,:xlist]
+    ylist := [three,:ylist]
+    flist := [two,:flist]
+    wlist := [one,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  nc := (px-4)*(py-4)
+  prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[")
+  prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[")
+  prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [")
+  prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02dcf() ==
+  htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Determines a bicubic spline approximation to a set of points ")
+    (text . "given on a rectangular grid defined by \htbitmap{mx} ")
+    (text . "points \htbitmap{xq} on the x-axis and ")
+    (text . "\htbitmap{my} points \htbitmap{yr} on the ")
+    (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,")
+    (text . "\htbitmap{nx} and \htbitmap{mui}, for ")
+    (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ")
+    (text . ", but a single parameter S must be specified to control the ")
+    (text . "trade-off between closeness of fit and smoothness of fit.  This ")
+    (text . "affects the number of knots required by the spline, which is ")
+    (text . "given in the B-spline representation \htbitmap{e02daf}")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Grid points on x-axis \htbitmap{mx}: ")    
+    (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ")
+    (text . "\htbitmap{my}: ")    
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 11 mx PI))
+    (text . "\tab{32} ")
+    (bcStrings (6 9 my PI))    
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") 
+    (text . "computed spline, {\it nxest}: \newline\tab{2} ")
+    (bcStrings (6 15 nxest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") 
+    (text . "spline, {\it nyest}: \newline\tab{2} ")
+    (bcStrings (6 13 nyest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Smoothing factor {\it s}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "0.1" s F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Start value: ")
+    (radioButtons start
+        ("" "  Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold)
+        ("" "  Warm Start - uses knots found in a previous call" warm))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02dcfSolve)
+  htShowPage()
+
+e02dcfSolve htPage ==
+  mx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx)
+    objValUnwrap htpLabelSpadValue(htPage, 'mx)
+  my :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my)
+    objValUnwrap htpLabelSpadValue(htPage, 'my)
+  nxest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nxest)
+  nyest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nyest)
+  wrklist := [my,nxest]
+  wrkmax := APPLY ('MAX, wrklist)
+  lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54
+  liwrk := 3 + mx + my + nxest + nyest
+  s := htpLabelInputString(htPage,'s)
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'cold => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((mx = 11 and my = 9) and start = 1) => 
+		e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail)
+  start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail)
+  -- warm start not really possible from hyperdoc
+  -- as inputing a workspace array of dimension 592 is asking too much
+  -- user should use the command line, using the previous calculated 
+  -- parameters
+  htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)  
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\blankline ")
+    (text . "{\center{\em Hyperdoc interface not available for warm starts.}}")
+    (text . "\newline ")
+    (text . "{\center{\em Please use the command line.}}"))
+  htMakeDoneButton('"Continue",'e02dcf)
+  htShowPage()
+
+
+
+e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  xList :=
+    "append"/[f(i) for i in 1..mx] where f(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, xnam, 'F]]] 
+  yList :=
+    "append"/[g(i) for i in 1..my] where g(i) ==
+      ynam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, ynam, 'F]]] 
+  prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ")
+  yList := [['text,:prefix],:yList]
+  fList :=
+    "append"/[h(i) for i in 1..(mx*my)] where h(i) ==
+      fnam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, fnam, 'F]]] 
+  prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ")
+  fList := [['text,:prefix],:fList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :xList,:yList,:fList]
+  page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02dcfColdGen)
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  mx := 11
+  my := 9
+  page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" x1 F))
+    (bcStrings (8 "0.5" x2 F))
+    (bcStrings (8 "1" x3 F))
+    (bcStrings (8 "1.5" x4 F))
+    (bcStrings (8 "2" x5 F))
+    (bcStrings (8 "2.5" x6 F))
+    (bcStrings (8 "3" x7 F))
+    (bcStrings (8 "3.5" x8 F))
+    (bcStrings (8 "4" x9 F))
+    (bcStrings (8 "4.5" x10 F))
+    (bcStrings (8 "5" x11 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" y1 F))
+    (bcStrings (8 "0.5" y2 F))
+    (bcStrings (8 "1" y3 F))
+    (bcStrings (8 "1.5" y4 F))
+    (bcStrings (8 "2" y5 F))
+    (bcStrings (8 "2.5" y6 F))
+    (bcStrings (8 "3" y7 F))
+    (bcStrings (8 "3.5" y8 F))
+    (bcStrings (8 "4" y9 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" f1 F))
+    (bcStrings (8 "0.88758" f2 F))
+    (bcStrings (8 "0.5403" f3 F))
+    (bcStrings (8 "0.070737" f4 F))
+    (bcStrings (8 "-0.41515" f5 F))
+    (bcStrings (8 "-0.80114" f6 F))
+    (bcStrings (8 "-0.97999" f7 F))
+    (bcStrings (8 "-0.93446" f8 F))
+    (bcStrings (8 "-0.65664" f9 F))
+    (bcStrings (8 "1.5" f10 F))
+    (bcStrings (8 "1.3564" f11 F))
+    (bcStrings (8 "0.82045" f12 F))
+    (bcStrings (8 "0.10611" f13 F))
+    (bcStrings (8 "-0.62422" f14 F))
+    (bcStrings (8 "-1.2317" f15 F))
+    (bcStrings (8 "-1.485" f16 F))
+    (bcStrings (8 "-1.3047" f17 F))
+    (bcStrings (8 "-0.98547" f18 F))
+    (bcStrings (8 "2.06" f19 F))
+    (bcStrings (8 "1.7552" f20 F))
+    (bcStrings (8 "1.0806" f21 F))
+    (bcStrings (8 "0.15147" f22 F))
+    (bcStrings (8 "-0.83229" f23 F))
+    (bcStrings (8 "-1.6023" f24 F))
+    (bcStrings (8 "-1.97" f25 F))
+    (bcStrings (8 "-1.8729" f26 F))
+    (bcStrings (8 "-1.4073" f27 F))
+    (bcStrings (8 "2.57" f28 F))
+    (bcStrings (8 "2.124" f29 F))
+    (bcStrings (8 "1.3508" f30 F))
+    (bcStrings (8 "0.17684" f31 F))
+    (bcStrings (8 "-1.0404" f32 F))
+    (bcStrings (8 "-2.0029" f33 F))
+    (bcStrings (8 "-2.475" f34 F))
+    (bcStrings (8 "-2.3511" f35 F))
+    (bcStrings (8 "-1.6741" f36 F))
+    (bcStrings (8 "3" f37 F))
+    (bcStrings (8 "2.6427" f38 F))
+    (bcStrings (8 "1.6309" f39 F))
+    (bcStrings (8 "0.21221" f40 F))
+    (bcStrings (8 "-1.2484" f41 F))
+    (bcStrings (8 "-2.2034" f42 F))
+    (bcStrings (8 "-2.97" f43 F))
+    (bcStrings (8 "-2.8094" f44 F))
+    (bcStrings (8 "-1.9809" f45 F))
+    (bcStrings (8 "3.5" f46 F))
+    (bcStrings (8 "3.1715" f47 F))
+    (bcStrings (8 "1.8611" f48 F))
+    (bcStrings (8 "0.24458" f49 F))
+    (bcStrings (8 "-1.4565" f50 F))
+    (bcStrings (8 "-2.864" f51 F))
+    (bcStrings (8 "-3.265" f52 F))
+    (bcStrings (8 "-3.2776" f53 F))
+    (bcStrings (8 "-2.2878" f54 F))
+    (bcStrings (8 "4.04" f55 F))
+    (bcStrings (8 "3.5103" f56 F))
+    (bcStrings (8 "2.0612" f57 F))
+    (bcStrings (8 "0.28595" f58 F))
+    (bcStrings (8 "-1.6946" f59 F))
+    (bcStrings (8 "-3.2046" f60 F))
+    (bcStrings (8 "-3.96" f61 F))
+    (bcStrings (8 "-3.7958" f62 F))
+    (bcStrings (8 "-2.6146" f63 F))
+    (bcStrings (8 "4.5" f64 F))
+    (bcStrings (8 "3.9391" f65 F))
+    (bcStrings (8 "2.4314" f66 F))
+    (bcStrings (8 "0.31632" f67 F))
+    (bcStrings (8 "-1.8627" f68 F))
+    (bcStrings (8 "-3.6351" f69 F))
+    (bcStrings (8 "-4.455" f70 F))
+    (bcStrings (8 "-4.2141" f71 F))
+    (bcStrings (8 "-2.9314" f72 F))
+    (bcStrings (8 "5.04" f73 F))
+    (bcStrings (8 "4.3879" f74 F))
+    (bcStrings (8 "2.7515" f75 F))
+    (bcStrings (8 "0.35369" f76 F))
+    (bcStrings (8 "-2.0707" f77 F))
+    (bcStrings (8 "-4.0057" f78 F))
+    (bcStrings (8 "-4.97" f79 F))
+    (bcStrings (8 "-4.6823" f80 F))
+    (bcStrings (8 "-3.2382" f81 F))
+    (bcStrings (8 "5.505" f82 F))
+    (bcStrings (8 "4.8367" f83 F))
+    (bcStrings (8 "2.9717" f84 F))
+    (bcStrings (8 "0.38505" f85 F))
+    (bcStrings (8 "-2.2888" f86 F))
+    (bcStrings (8 "-4.4033" f87 F))
+    (bcStrings (8 "-5.445" f88 F))
+    (bcStrings (8 "-5.1405" f89 F))
+    (bcStrings (8 "-3.595" f90 F))
+    (bcStrings (8 "6" f91 F))
+    (bcStrings (8 "5.2755" f92 F))
+    (bcStrings (8 "3.2418" f93 F))
+    (bcStrings (8 "0.42442" f94 F))
+    (bcStrings (8 "-2.4769" f95 F))
+    (bcStrings (8 "-4.8169" f96 F))
+    (bcStrings (8 "-5.93" f97 F))
+    (bcStrings (8 "-5.6387" f98 F))
+    (bcStrings (8 "-3.9319" f99 F)))
+  htMakeDoneButton('"Continue",'e02dcfColdGen)    	
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02dcfColdGen htPage ==
+  mx := htpProperty(htPage,'mx)
+  my := htpProperty(htPage,'my)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  cold := '"c"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(mx*my) repeat
+    end := STRCONC((first y).1," ")
+    y := rest y
+    fList := [end,:fList]
+  fstring := bcwords2liststring fList
+  for i in 1..my repeat
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    ylist := [mid,:ylist]
+  ystring := bcwords2liststring ylist
+  while y repeat
+    start :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [start,:xlist]
+  xstring := bcwords2liststring xlist
+  -- additional entries needed to get it running
+  -- but as Start = c they are not used
+  prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,")
+  prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,")
+  end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..")
+  end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,end)
+
+
+e02ddf() ==
+  htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Determines a bicubic spline approximation to a set of scattered")
+    (text . " points ( \htbitmap{xr},\htbitmap{yr}, ")
+    (text . "\htbitmap{fr})")
+    (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ")
+    (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,")
+    (text . "\htbitmap{nx} and \htbitmap{mui}, for ")
+    (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ")
+    (text . ", but a single parameter S must be specified to control the ")
+    (text . "trade-off between closeness of fit and smoothness of fit.  This ")
+    (text . "affects the number of knots required by the spline, which is ")
+    (text . "given in the B-spline representation \htbitmap{e02daf}")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") 
+    (text . "computed spline, {\it nxest}: \newline\tab{2} ")
+    (bcStrings (6 14 nxest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") 
+    (text . "spline, {\it nyest}: \newline\tab{2} ")
+    (bcStrings (6 14 nyest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Smoothing factor {\it s}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "10" s F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Start value: ")
+    (radioButtons start
+        ("" "  Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold)
+        ("" "  Warm Start - uses knots found in a previous call" warm))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02ddfSolve)
+  htShowPage()
+
+e02ddfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  nxest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nxest)
+  nyest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nyest)
+  u := nxest - 4
+  v := nyest - 4
+  wlist := [u,v]
+  w := APPLY ('MAX, wlist)
+  lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56
+  liwrk := m + 2*(nxest - 7)*(nyest - 7)
+  s := htpLabelInputString(htPage,'s)
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'cold => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) 
+  start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) 
+  -- need to change as only wrk(1) is required
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      post   := ('"\tab{32} ")
+      end    := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]],
+         ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  lamdaList := 
+    "append"/[g(i) for i in 1..nxest] where g(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline")
+  lamdaList := [['text,:prefix],:lamdaList]
+  muList := 
+    "append"/[h(i) for i in 1..nyest] where h(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline")
+  muList := [['text,:prefix],:muList]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}")
+  nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}")
+  nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}")
+  wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamdaList,:muList,:nxList,:nyList,:wList]
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}"
+  htSay '"\menuitemstyle{}\tab{32} Values of \space{1} "
+  htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} "
+  htSay '"\tab{47} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ddfWarmGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+
+
+e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail)  ==
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      post   := ('"\tab{32} ")
+      end    := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]],
+         ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}"
+  htSay '"\menuitemstyle{}\tab{32} Values of \space{1} "
+  htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} "
+  htSay '"\tab{46} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ddfColdGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  m := 30
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:")
+    (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ")
+    (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ")
+    (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ")
+    (text . "\tab{46} Values of \htbitmap{wr}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "11.16" x1 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.24" y1 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "22.15" f1 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "12.85" x2 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.06" y2 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "22.11" f2 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "19.85" x3 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.72" y3 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "7.97" f3 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "19.72" x4 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.39" y4 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "16.83" f4 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "15.91" x5 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "7.74" y5 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "15.30" f5 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0" x6 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y6 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "34.6" f6 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "20.87" x7 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y7 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.74" f7 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "3.45" x8 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "12.78" y8 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "41.24" f8 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "14.26" x9 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "17.87" y9 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "10.74" f9 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.43" x10 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.46" y10 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "18.60" f10 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w10 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.8" x11 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "12.39" y11 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.47" f11 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w11 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "7.58" x12 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.98" y12 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "29.87" f12 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w12 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "25" x13 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "11.87" y13 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "4.4" f13 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w13 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0" x14 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0" y14 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "58.2" f14 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w14 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "9.66" x15 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y15 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "4.73" f15 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w15 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "5.22" x16 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "14.66" y16 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "40.36" f16 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w16 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.25" x17 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "19.57" y17 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "6.43" f17 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w17 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "25" x18 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.87" y18 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "8.74" f18 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w18 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "12.13" x19 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.79" y19 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "13.71" f19 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w19 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.23" x20 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "6.21" y20 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "10.25" f20 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w20 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "11.52" x21 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "8.53" y21 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "15.74" f21 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w21 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "15.2" x22 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0" y22 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "21.6" f22 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w22 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "7.54" x23 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.69" y23 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "19.31" f23 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w23 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.32" x24 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "13.78" y24 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "12.11" f24 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w24 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "2.14" x25 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "15.03" y25 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "53.1" f25 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w25 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.51" x26 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "8.37" y26 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "49.43" f26 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w26 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.69" x27 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "19.63" y27 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "3.25" f27 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w27 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "5.47" x28 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "17.13" y28 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "28.63" f28 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w28 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "21.67" x29 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "14.36" y29 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.52" f29 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w29 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "3.31" x30 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.33" y30 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "44.08" f30 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w30 F))    
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02ddfColdGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02ddfColdGen htPage ==
+  m := htpProperty(htPage,'m)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  cold := '"c"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    end :=  STRCONC ((first y).1," ")
+    y := rest y
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    flist := [right,:flist]
+    wlist := [end,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  -- additional entries nx,ny,lamda,mu,wrk needed to get it running
+  -- but they are just set to 0.0
+  prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[")
+  prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02ddfWarmGen htPage ==
+  m := htpProperty(htPage,'m)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  warm := '"w"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  wrk := (first y).1
+  y := rest y
+  for i in 1..lwrk repeat
+    wrkList := ['"0.0 ",:wrkList]
+  wrkList := [wrk,:wrkList]
+  wrkstring := bcwords2liststring wrkList
+  ny := STRCONC((first y).1," ")
+  y := rest y
+  nx := STRCONC((first y).1," ")
+  y := rest y
+  for i in 1..nyest repeat
+    mu := STRCONC ((first y).1, " ")
+    y := rest y
+    muList := [mu,:muList]
+  mustring := bcwords2liststring muList
+  for i in 1..nxest repeat
+    lam := STRCONC ((first y).1, " ")
+    y := rest y
+    lamList := [lam,:lamList]
+  lamstring := bcwords2liststring lamList
+  while y repeat
+    end :=  STRCONC ((first y).1," ")
+    y := rest y
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    flist := [right,:flist]
+    wlist := [end,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  -- additional entries nx,ny,lamda,mu,wrk needed to get it running
+  -- but they are just set to 0.0
+  prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[")
+  prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny)
+  prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02zaf() == 
+  htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Sorts the set of points {\em (\htbitmap{xr},")
+    (text . "\htbitmap{yr})} into panels defined by \space{1}")
+    (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ")
+    (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ")
+    (text . "\htbitmap{muj} on the y axis. The points are ordered ")
+    (text . "so that all points in a panel occur before data in succeeding ")
+    (text . "panels. Within a panel, the points maintain their original ")
+    (text . "order. ") 
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of points to be sorted to be sorted {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 10 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Intercepts + 8 on x axis {\em px}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Intercepts + 8 on y axis {\em py}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 9 px PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Dimension of point {\it npoint}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 45 npoint PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02zafSolve)
+  htShowPage()
+
+e02zafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  npoint :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint)
+    objValUnwrap htpLabelSpadValue(htPage, 'npoint)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail)
+  labelList :=
+    "append"/[fxy(i) for i in 1..m] where fxy(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{32} ")
+      lnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      cnam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]]
+  lamList :=
+    "append"/[flam(i) for i in 5..(px-4)] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ")
+  prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ")
+  lamList := [['text,:prefix],:lamList]
+  muList :=
+    "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  muList := [['text,:prefix],:muList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamList,:muList]
+  page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: "
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02zafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02zafDefaultSolve (htPage,npoint,ifail) ==
+  m := '10
+  px := '9
+  py := '10
+  page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} {\it x(m)}:")
+    (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.00" x1 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.77" y1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.70" x2 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.06" y2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.44" x3 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.33" y3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.21" x4 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" y4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.01" x5 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.50" y5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.84" x6 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.02" y6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.71" x7 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.95" y7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.00" x8 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.20" y8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.54" x9 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.04" y9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.531" x10 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.18" y10 F))    
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.00" l5 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "0.80" mu5 F))
+    (bcStrings (8 "1.20" mu6 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'e02zafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02zafGen htPage ==
+  m := htpProperty(htPage,'m)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  npoint := htpProperty(htPage,'npoint)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  nadres := (px-7)*(py-7)
+  -- mu 
+  for i in 1..4 repeat
+    muList := ['"0 ",:muList]
+  for i in 5..(py-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  for i in (py-3)..py repeat
+    muList := ['"0 ",:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..4 repeat
+    lamList := ['"0 ",:lamList]
+  for i in 5..(px-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  for i in (px-3)..px repeat
+    lamList := ['"0 ",:lamList]
+  lamstring := bcwords2liststring lamList
+  -- x & y
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [right,:ylist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[")
+  prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [")
+  prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-e02b.boot.pamphlet b/src/interp/nag-e02b.boot.pamphlet
new file mode 100644
index 00000000..d9874717
--- /dev/null
+++ b/src/interp/nag-e02b.boot.pamphlet
@@ -0,0 +1,1757 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-e02b.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- READ THIS NOW!
+--
+-- The automatic make fails to compile this file properly, leaving a 
+-- truncated clisp file in int/interp.  So if you change this file it
+-- must be compiled by hand in the interpreter (which works fine).
+-- MCD.
+--
+
+e02daf() == 
+  htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Determines a minimal, least squares bicubic B-spline surface fit")
+    (text . "\htbitmap{e02daf} to the set of points ")
+    (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ")
+    (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ")
+    (text . "knot sets {\lambda},in the x-direction and {\mu} in the ")
+    (text . "y-direction, ")
+    (text . "which can be thought of as dividing the data region into panels;")
+    (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ")
+    (text . "the polynomial joining together with second derivative ")
+    (text . "continuity. Eight additional (external) knots are added to each ")
+    (text . "of the knot sets by this routine. The routine minimizes \Sigma, ")
+    (text . "the sum of squares of the weighted residuals ")
+    (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ")
+    (text . "given knot sets. \newline ")
+    (text . "A call of this routine should be preceded by a call of E02ZAF ")
+    (text . "to provide indexing information. ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Knots in x direction {\em px}")
+    (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Knots in y direction {\em py}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 8 px PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Rank threshold {\em eps}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.000001" eps F))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Dimension of point {\it npoint}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 43 npoint PI))
+    -- include a radio button later to allow switching of
+    -- x & y if px <= py 
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02dafSolve)
+  htShowPage()
+
+e02dafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  npoint :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint)
+    objValUnwrap htpLabelSpadValue(htPage, 'npoint)
+  nc := (px - 4)*(py - 4)
+  nws := (2*nc + 1)*(3*py - 6) -2
+  eps := htpLabelInputString(htPage,'eps)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail)
+  labelList :=
+    "append"/[fxy(i) for i in 1..m] where fxy(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      next := ('"\tab{32} ")
+      end := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+         ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]],
+           ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  lamList :=
+    "append"/[flam(i) for i in 5..(px-4)] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  postfix := ('"\newline \blankline ")
+  lamList := [['text,:prefix],:lamList,['text,:postfix]]
+  muList :=
+    "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  muList := [['text,:prefix],:muList]
+  pList :=
+    "append"/[fp(i) for i in 1..npoint] where fp(i) ==
+      prefix := ('"\newline \tab{2} ")
+      pnam := INTERN STRCONC ('"p",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ")
+  pList := [['text,:prefix],:pList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamList,:muList,:pList]
+  page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: "
+  htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:"
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" 
+  htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02dafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'nws,nws)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) ==
+  m := '30
+  px := '8
+  py := '10
+  page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:")
+    (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ")
+    (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ")
+    (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ")
+    (text . "\tab{46} Values of \htbitmap{wr}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.52" x1 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.60" y1 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.93" f1 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.61" x2 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.95" y2 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.79" f2 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.93" x3 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.87" y3 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.36" f3 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.09" x4 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.84" y4 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.52" f4 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.88" x5 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.17" y5 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.49" f5 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.70" x6 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.87" y6 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.76" f6 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "10" w6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1" x7 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1" y7 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.33" f7 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1" x8 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.1" y8 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.48" f8 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.3" x9 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.24" y9 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.65" f9 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.77" x10 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.77" y10 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1.82" f10 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w10 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.23" x11 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.32" y11 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.92" f11 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w11 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-1" x12 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1" y12 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "1" f12 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w12 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.26" x13 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.63" y13 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "8.88" f13 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w13 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.83" x14 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.66" y14 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-2.01" f14 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w14 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.22" x15 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.93" y15 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.47" f15 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w15 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.89" x16 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.15" y16 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.49" f16 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w16 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.80" x17 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.99" y17 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.84" f17 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w17 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.88" x18 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.54" y18 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-2.42" f18 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w18 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.68" x19 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.44" y19 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.47" f19 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w19 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.14" x20 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.72" y20 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "7.15" f20 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w20 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.67" x21 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.63" y21 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" f21 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w21 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.90" x22 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.40" y22 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-3.34" f22 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w22 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.84" x23 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.20" y23 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "2.78" f23 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w23 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.84" x24 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.43" y24 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" f24 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w24 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.15" x25 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.28" y25 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.70" f25 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w25 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.91" x26 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.24" y26 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-6.52" f26 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w26 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.35" x27 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.86" y27 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "0.66" f27 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w27 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.16" x28 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.41" y28 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "2.32" f28 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w28 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-0.35" x29 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-0.05" y29 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "1.66" f29 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w29 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "-1" x30 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "-1" y30 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "-1" f30 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w30 F))    
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.50" mu5 F))
+    (bcStrings (8 "0.00" mu6 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values for point:")
+    (text . "\newline \tab{2}")
+    (bcStrings (6 3 p1 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 6 p2 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 4 p3 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 5 p4 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 7 p5 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 10 p6 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 8 p7 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 9 p8 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 11 p9 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 13 p10 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 12 p11 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 15 p12 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 14 p13 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 18 p14 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 16 p15 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 17 p16 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 19 p17 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 20 p18 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 21 p19 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 30 p20 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 23 p21 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 26 p22 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 24 p23 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 25 p24 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 27 p25 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 28 p26 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p27 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 29 p28 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p29 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p30 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 2 p31 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 22 p32 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 1 p33 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p34 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p35 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p36 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p37 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p38 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p39 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p40 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p41 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p42 PI))	
+    (text . "\newline \tab{2}")
+    (bcStrings (6 0 p43 PI))	
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02dafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'nws,nws)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02dafGen htPage ==
+  m := htpProperty(htPage,'m)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  nws := htpProperty(htPage,'nws)
+  eps := htpProperty(htPage,'eps)
+  npoint := htpProperty(htPage,'npoint)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  nadres := (px-7)*(py-7)
+  -- point
+  for i in 1..npoint repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y
+    pointList := [right,:pointList]
+  pstring := bcwords2liststring pointList
+  -- mu 
+  for i in 1..4 repeat
+    muList := ['"0 ",:muList]
+  for i in 5..(py-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  for i in (py-3)..py repeat
+    muList := ['"0 ",:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..4 repeat
+    lamList := ['"0 ",:lamList]
+  for i in 5..(px-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  for i in (px-3)..px repeat
+    lamList := ['"0 ",:lamList]
+  lamstring := bcwords2liststring lamList
+  -- x & y
+  while y repeat
+    one := STRCONC((first y).1," ")
+    y := rest y
+    two := STRCONC((first y).1," ")
+    y := rest y
+    three := STRCONC ((first y).1," ")
+    y := rest y    
+    four :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [four,:xlist]
+    ylist := [three,:ylist]
+    flist := [two,:flist]
+    wlist := [one,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  nc := (px-4)*(py-4)
+  prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[")
+  prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[")
+  prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [")
+  prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+e02dcf() ==
+  htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Determines a bicubic spline approximation to a set of points ")
+    (text . "given on a rectangular grid defined by \htbitmap{mx} ")
+    (text . "points \htbitmap{xq} on the x-axis and ")
+    (text . "\htbitmap{my} points \htbitmap{yr} on the ")
+    (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,")
+    (text . "\htbitmap{nx} and \htbitmap{mui}, for ")
+    (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ")
+    (text . ", but a single parameter S must be specified to control the ")
+    (text . "trade-off between closeness of fit and smoothness of fit.  This ")
+    (text . "affects the number of knots required by the spline, which is ")
+    (text . "given in the B-spline representation \htbitmap{e02daf}")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Grid points on x-axis \htbitmap{mx}: ")    
+    (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ")
+    (text . "\htbitmap{my}: ")    
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 11 mx PI))
+    (text . "\tab{32} ")
+    (bcStrings (6 9 my PI))    
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") 
+    (text . "computed spline, {\it nxest}: \newline\tab{2} ")
+    (bcStrings (6 15 nxest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") 
+    (text . "spline, {\it nyest}: \newline\tab{2} ")
+    (bcStrings (6 13 nyest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Smoothing factor {\it s}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "0.1" s F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Start value: ")
+    (radioButtons start
+        ("" "  Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold)
+        ("" "  Warm Start - uses knots found in a previous call" warm))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02dcfSolve)
+  htShowPage()
+
+e02dcfSolve htPage ==
+  mx :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx)
+    objValUnwrap htpLabelSpadValue(htPage, 'mx)
+  my :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my)
+    objValUnwrap htpLabelSpadValue(htPage, 'my)
+  nxest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nxest)
+  nyest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nyest)
+  wrklist := [my,nxest]
+  wrkmax := APPLY ('MAX, wrklist)
+  lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54
+  liwrk := 3 + mx + my + nxest + nyest
+  s := htpLabelInputString(htPage,'s)
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'cold => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((mx = 11 and my = 9) and start = 1) => 
+		e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail)
+  start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail)
+  -- warm start not really possible from hyperdoc
+  -- as inputing a workspace array of dimension 592 is asking too much
+  -- user should use the command line, using the previous calculated 
+  -- parameters
+  htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)  
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\blankline ")
+    (text . "{\center{\em Hyperdoc interface not available for warm starts.}}")
+    (text . "\newline ")
+    (text . "{\center{\em Please use the command line.}}"))
+  htMakeDoneButton('"Continue",'e02dcf)
+  htShowPage()
+
+
+
+e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  xList :=
+    "append"/[f(i) for i in 1..mx] where f(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, xnam, 'F]]] 
+  yList :=
+    "append"/[g(i) for i in 1..my] where g(i) ==
+      ynam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, ynam, 'F]]] 
+  prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ")
+  yList := [['text,:prefix],:yList]
+  fList :=
+    "append"/[h(i) for i in 1..(mx*my)] where h(i) ==
+      fnam := INTERN STRCONC ('"g",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, fnam, 'F]]] 
+  prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ")
+  fList := [['text,:prefix],:fList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :xList,:yList,:fList]
+  page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02dcfColdGen)
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  mx := 11
+  my := 9
+  page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" x1 F))
+    (bcStrings (8 "0.5" x2 F))
+    (bcStrings (8 "1" x3 F))
+    (bcStrings (8 "1.5" x4 F))
+    (bcStrings (8 "2" x5 F))
+    (bcStrings (8 "2.5" x6 F))
+    (bcStrings (8 "3" x7 F))
+    (bcStrings (8 "3.5" x8 F))
+    (bcStrings (8 "4" x9 F))
+    (bcStrings (8 "4.5" x10 F))
+    (bcStrings (8 "5" x11 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:")
+    (text . "\newline ")
+    (bcStrings (8 "0" y1 F))
+    (bcStrings (8 "0.5" y2 F))
+    (bcStrings (8 "1" y3 F))
+    (bcStrings (8 "1.5" y4 F))
+    (bcStrings (8 "2" y5 F))
+    (bcStrings (8 "2.5" y6 F))
+    (bcStrings (8 "3" y7 F))
+    (bcStrings (8 "3.5" y8 F))
+    (bcStrings (8 "4" y9 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:")
+    (text . "\newline ")
+    (bcStrings (8 "1" f1 F))
+    (bcStrings (8 "0.88758" f2 F))
+    (bcStrings (8 "0.5403" f3 F))
+    (bcStrings (8 "0.070737" f4 F))
+    (bcStrings (8 "-0.41515" f5 F))
+    (bcStrings (8 "-0.80114" f6 F))
+    (bcStrings (8 "-0.97999" f7 F))
+    (bcStrings (8 "-0.93446" f8 F))
+    (bcStrings (8 "-0.65664" f9 F))
+    (bcStrings (8 "1.5" f10 F))
+    (bcStrings (8 "1.3564" f11 F))
+    (bcStrings (8 "0.82045" f12 F))
+    (bcStrings (8 "0.10611" f13 F))
+    (bcStrings (8 "-0.62422" f14 F))
+    (bcStrings (8 "-1.2317" f15 F))
+    (bcStrings (8 "-1.485" f16 F))
+    (bcStrings (8 "-1.3047" f17 F))
+    (bcStrings (8 "-0.98547" f18 F))
+    (bcStrings (8 "2.06" f19 F))
+    (bcStrings (8 "1.7552" f20 F))
+    (bcStrings (8 "1.0806" f21 F))
+    (bcStrings (8 "0.15147" f22 F))
+    (bcStrings (8 "-0.83229" f23 F))
+    (bcStrings (8 "-1.6023" f24 F))
+    (bcStrings (8 "-1.97" f25 F))
+    (bcStrings (8 "-1.8729" f26 F))
+    (bcStrings (8 "-1.4073" f27 F))
+    (bcStrings (8 "2.57" f28 F))
+    (bcStrings (8 "2.124" f29 F))
+    (bcStrings (8 "1.3508" f30 F))
+    (bcStrings (8 "0.17684" f31 F))
+    (bcStrings (8 "-1.0404" f32 F))
+    (bcStrings (8 "-2.0029" f33 F))
+    (bcStrings (8 "-2.475" f34 F))
+    (bcStrings (8 "-2.3511" f35 F))
+    (bcStrings (8 "-1.6741" f36 F))
+    (bcStrings (8 "3" f37 F))
+    (bcStrings (8 "2.6427" f38 F))
+    (bcStrings (8 "1.6309" f39 F))
+    (bcStrings (8 "0.21221" f40 F))
+    (bcStrings (8 "-1.2484" f41 F))
+    (bcStrings (8 "-2.2034" f42 F))
+    (bcStrings (8 "-2.97" f43 F))
+    (bcStrings (8 "-2.8094" f44 F))
+    (bcStrings (8 "-1.9809" f45 F))
+    (bcStrings (8 "3.5" f46 F))
+    (bcStrings (8 "3.1715" f47 F))
+    (bcStrings (8 "1.8611" f48 F))
+    (bcStrings (8 "0.24458" f49 F))
+    (bcStrings (8 "-1.4565" f50 F))
+    (bcStrings (8 "-2.864" f51 F))
+    (bcStrings (8 "-3.265" f52 F))
+    (bcStrings (8 "-3.2776" f53 F))
+    (bcStrings (8 "-2.2878" f54 F))
+    (bcStrings (8 "4.04" f55 F))
+    (bcStrings (8 "3.5103" f56 F))
+    (bcStrings (8 "2.0612" f57 F))
+    (bcStrings (8 "0.28595" f58 F))
+    (bcStrings (8 "-1.6946" f59 F))
+    (bcStrings (8 "-3.2046" f60 F))
+    (bcStrings (8 "-3.96" f61 F))
+    (bcStrings (8 "-3.7958" f62 F))
+    (bcStrings (8 "-2.6146" f63 F))
+    (bcStrings (8 "4.5" f64 F))
+    (bcStrings (8 "3.9391" f65 F))
+    (bcStrings (8 "2.4314" f66 F))
+    (bcStrings (8 "0.31632" f67 F))
+    (bcStrings (8 "-1.8627" f68 F))
+    (bcStrings (8 "-3.6351" f69 F))
+    (bcStrings (8 "-4.455" f70 F))
+    (bcStrings (8 "-4.2141" f71 F))
+    (bcStrings (8 "-2.9314" f72 F))
+    (bcStrings (8 "5.04" f73 F))
+    (bcStrings (8 "4.3879" f74 F))
+    (bcStrings (8 "2.7515" f75 F))
+    (bcStrings (8 "0.35369" f76 F))
+    (bcStrings (8 "-2.0707" f77 F))
+    (bcStrings (8 "-4.0057" f78 F))
+    (bcStrings (8 "-4.97" f79 F))
+    (bcStrings (8 "-4.6823" f80 F))
+    (bcStrings (8 "-3.2382" f81 F))
+    (bcStrings (8 "5.505" f82 F))
+    (bcStrings (8 "4.8367" f83 F))
+    (bcStrings (8 "2.9717" f84 F))
+    (bcStrings (8 "0.38505" f85 F))
+    (bcStrings (8 "-2.2888" f86 F))
+    (bcStrings (8 "-4.4033" f87 F))
+    (bcStrings (8 "-5.445" f88 F))
+    (bcStrings (8 "-5.1405" f89 F))
+    (bcStrings (8 "-3.595" f90 F))
+    (bcStrings (8 "6" f91 F))
+    (bcStrings (8 "5.2755" f92 F))
+    (bcStrings (8 "3.2418" f93 F))
+    (bcStrings (8 "0.42442" f94 F))
+    (bcStrings (8 "-2.4769" f95 F))
+    (bcStrings (8 "-4.8169" f96 F))
+    (bcStrings (8 "-5.93" f97 F))
+    (bcStrings (8 "-5.6387" f98 F))
+    (bcStrings (8 "-3.9319" f99 F)))
+  htMakeDoneButton('"Continue",'e02dcfColdGen)    	
+  htpSetProperty(page,'mx,mx)
+  htpSetProperty(page,'my,my)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02dcfColdGen htPage ==
+  mx := htpProperty(htPage,'mx)
+  my := htpProperty(htPage,'my)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  cold := '"c"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(mx*my) repeat
+    end := STRCONC((first y).1," ")
+    y := rest y
+    fList := [end,:fList]
+  fstring := bcwords2liststring fList
+  for i in 1..my repeat
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    ylist := [mid,:ylist]
+  ystring := bcwords2liststring ylist
+  while y repeat
+    start :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [start,:xlist]
+  xstring := bcwords2liststring xlist
+  -- additional entries needed to get it running
+  -- but as Start = c they are not used
+  prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,")
+  prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,")
+  end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..")
+  end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,end)
+
+
+e02ddf() ==
+  htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Determines a bicubic spline approximation to a set of scattered")
+    (text . " points ( \htbitmap{xr},\htbitmap{yr}, ")
+    (text . "\htbitmap{fr})")
+    (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ")
+    (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,")
+    (text . "\htbitmap{nx} and \htbitmap{mui}, for ")
+    (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ")
+    (text . ", but a single parameter S must be specified to control the ")
+    (text . "trade-off between closeness of fit and smoothness of fit.  This ")
+    (text . "affects the number of knots required by the spline, which is ")
+    (text . "given in the B-spline representation \htbitmap{e02daf}")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of data points {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 30 m PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") 
+    (text . "computed spline, {\it nxest}: \newline\tab{2} ")
+    (bcStrings (6 14 nxest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") 
+    (text . "spline, {\it nyest}: \newline\tab{2} ")
+    (bcStrings (6 14 nyest PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Smoothing factor {\it s}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 "10" s F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Start value: ")
+    (radioButtons start
+        ("" "  Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold)
+        ("" "  Warm Start - uses knots found in a previous call" warm))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02ddfSolve)
+  htShowPage()
+
+e02ddfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  nxest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nxest)
+  nyest :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest)
+    objValUnwrap htpLabelSpadValue(htPage, 'nyest)
+  u := nxest - 4
+  v := nyest - 4
+  wlist := [u,v]
+  w := APPLY ('MAX, wlist)
+  lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56
+  liwrk := m + 2*(nxest - 7)*(nyest - 7)
+  s := htpLabelInputString(htPage,'s)
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'cold => '1
+    '2
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) 
+  start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) 
+  -- need to change as only wrk(1) is required
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      post   := ('"\tab{32} ")
+      end    := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]],
+         ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  lamdaList := 
+    "append"/[g(i) for i in 1..nxest] where g(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline")
+  lamdaList := [['text,:prefix],:lamdaList]
+  muList := 
+    "append"/[h(i) for i in 1..nyest] where h(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline")
+  muList := [['text,:prefix],:muList]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}")
+  nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}")
+  nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}")
+  wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamdaList,:muList,:nxList,:nyList,:wList]
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}"
+  htSay '"\menuitemstyle{}\tab{32} Values of \space{1} "
+  htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} "
+  htSay '"\tab{47} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ddfWarmGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+
+
+e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail)  ==
+  labelList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{17} ")
+      post   := ('"\tab{32} ")
+      end    := ('"\tab{47} ")
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ynam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      wnam := INTERN STRCONC ('"w",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]],
+        ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]],
+         ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList]
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htSay '"\menuitemstyle{}\tab{2} Values of \space{1} "
+  htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} "
+  htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}"
+  htSay '"\menuitemstyle{}\tab{32} Values of \space{1} "
+  htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} "
+  htSay '"\tab{46} Values of \htbitmap{wr}:"
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02ddfColdGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) ==
+  m := 30
+  page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:")
+    (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ")
+    (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ")
+    (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ")
+    (text . "\tab{46} Values of \htbitmap{wr}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "11.16" x1 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.24" y1 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "22.15" f1 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "12.85" x2 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.06" y2 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "22.11" f2 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "19.85" x3 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.72" y3 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "7.97" f3 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "19.72" x4 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.39" y4 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "16.83" f4 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "15.91" x5 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "7.74" y5 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "15.30" f5 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0" x6 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y6 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "34.6" f6 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "20.87" x7 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y7 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.74" f7 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "3.45" x8 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "12.78" y8 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "41.24" f8 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "14.26" x9 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "17.87" y9 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "10.74" f9 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.43" x10 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.46" y10 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "18.60" f10 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w10 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.8" x11 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "12.39" y11 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.47" f11 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w11 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "7.58" x12 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "1.98" y12 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "29.87" f12 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w12 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "25" x13 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "11.87" y13 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "4.4" f13 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w13 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0" x14 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0" y14 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "58.2" f14 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w14 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "9.66" x15 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "20" y15 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "4.73" f15 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w15 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "5.22" x16 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "14.66" y16 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "40.36" f16 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w16 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.25" x17 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "19.57" y17 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "6.43" f17 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w17 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "25" x18 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "3.87" y18 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "8.74" f18 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w18 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "12.13" x19 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.79" y19 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "13.71" f19 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w19 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.23" x20 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "6.21" y20 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "10.25" f20 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w20 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "11.52" x21 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "8.53" y21 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "15.74" f21 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w21 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "15.2" x22 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0" y22 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "21.6" f22 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w22 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "7.54" x23 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "10.69" y23 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "19.31" f23 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w23 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "17.32" x24 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "13.78" y24 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "12.11" f24 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w24 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "2.14" x25 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "15.03" y25 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "53.1" f25 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w25 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.51" x26 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "8.37" y26 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "49.43" f26 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w26 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "22.69" x27 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "19.63" y27 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "3.25" f27 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w27 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "5.47" x28 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "17.13" y28 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "28.63" f28 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w28 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "21.67" x29 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "14.36" y29 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "5.52" f29 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w29 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "3.31" x30 F))  
+    (text . "\tab{17}")
+    (bcStrings (8 "0.33" y30 F))    
+    (text . "\tab{32}")
+    (bcStrings (8 "44.08" f30 F))    
+    (text . "\tab{47}")
+    (bcStrings (8 "1" w30 F))    
+    (text . "\blankline"))
+  htMakeDoneButton('"Continue",'e02ddfColdGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nxest,nxest)
+  htpSetProperty(page,'nyest,nyest)
+  htpSetProperty(page,'lwrk,lwrk)
+  htpSetProperty(page,'liwrk,liwrk)
+  htpSetProperty(page,'s,s)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02ddfColdGen htPage ==
+  m := htpProperty(htPage,'m)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  cold := '"c"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  while y repeat
+    end :=  STRCONC ((first y).1," ")
+    y := rest y
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    flist := [right,:flist]
+    wlist := [end,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  -- additional entries nx,ny,lamda,mu,wrk needed to get it running
+  -- but they are just set to 0.0
+  prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[")
+  prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,")
+  prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],")
+--  prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02ddfWarmGen htPage ==
+  m := htpProperty(htPage,'m)
+  nxest := htpProperty(htPage,'nxest)
+  nyest := htpProperty(htPage,'nyest)
+  lwrk := htpProperty(htPage,'lwrk)
+  liwrk := htpProperty(htPage,'liwrk)
+  s := htpProperty(htPage,'s)
+  warm := '"w"
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  wrk := (first y).1
+  y := rest y
+  for i in 1..lwrk repeat
+    wrkList := ['"0.0 ",:wrkList]
+  wrkList := [wrk,:wrkList]
+  wrkstring := bcwords2liststring wrkList
+  ny := STRCONC((first y).1," ")
+  y := rest y
+  nx := STRCONC((first y).1," ")
+  y := rest y
+  for i in 1..nyest repeat
+    mu := STRCONC ((first y).1, " ")
+    y := rest y
+    muList := [mu,:muList]
+  mustring := bcwords2liststring muList
+  for i in 1..nxest repeat
+    lam := STRCONC ((first y).1, " ")
+    y := rest y
+    lamList := [lam,:lamList]
+  lamstring := bcwords2liststring lamList
+  while y repeat
+    end :=  STRCONC ((first y).1," ")
+    y := rest y
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    mid :=  STRCONC ((first y).1," ")
+    y := rest y
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [mid,:ylist]
+    flist := [right,:flist]
+    wlist := [end,:wlist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  fstring := bcwords2liststring flist
+  wstring := bcwords2liststring wlist
+  -- additional entries nx,ny,lamda,mu,wrk needed to get it running
+  -- but they are just set to 0.0
+  prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[")
+  prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny)
+  prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+e02zaf() == 
+  htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Sorts the set of points {\em (\htbitmap{xr},")
+    (text . "\htbitmap{yr})} into panels defined by \space{1}")
+    (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ")
+    (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ")
+    (text . "\htbitmap{muj} on the y axis. The points are ordered ")
+    (text . "so that all points in a panel occur before data in succeeding ")
+    (text . "panels. Within a panel, the points maintain their original ")
+    (text . "order. ") 
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Number of points to be sorted to be sorted {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 10 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Intercepts + 8 on x axis {\em px}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Intercepts + 8 on y axis {\em py}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 9 px PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 10 py PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} \newline ")
+    (text . "Dimension of point {\it npoint}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 45 npoint PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e02zafSolve)
+  htShowPage()
+
+e02zafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  px :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px)
+    objValUnwrap htpLabelSpadValue(htPage, 'px)
+  py :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py)
+    objValUnwrap htpLabelSpadValue(htPage, 'py)
+  npoint :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint)
+    objValUnwrap htpLabelSpadValue(htPage, 'npoint)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail)
+  labelList :=
+    "append"/[fxy(i) for i in 1..m] where fxy(i) ==
+      prefix := ('"\newline \tab{2} ")
+      middle := ('"\tab{32} ")
+      lnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      cnam := INTERN STRCONC ('"y",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], 
+       ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]]
+  lamList :=
+    "append"/[flam(i) for i in 5..(px-4)] where flam(i) ==
+      lnam := INTERN STRCONC ('"l",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, lnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ")
+  prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ")
+  lamList := [['text,:prefix],:lamList]
+  muList :=
+    "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) ==
+      mnam := INTERN STRCONC ('"m",STRINGIMAGE i)
+      [['bcStrings,[8, 0.0, mnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  muList := [['text,:prefix],:muList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:lamList,:muList]
+  page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: "
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'e02zafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e02zafDefaultSolve (htPage,npoint,ifail) ==
+  m := '10
+  px := '9
+  py := '10
+  page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} {\it x(m)}:")
+    (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.00" x1 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.77" y1 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.70" x2 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.06" y2 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.44" x3 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.33" y3 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.21" x4 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.44" y4 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.01" x5 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.50" y5 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.84" x6 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.02" y6 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.71" x7 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.95" y7 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.00" x8 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "1.20" y8 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "0.54" x9 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.04" y9 F))    
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 "1.531" x10 F))  
+    (text . "\tab{32}")
+    (bcStrings (8 "0.18" y10 F))    
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.00" l5 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "0.80" mu5 F))
+    (bcStrings (8 "1.20" mu6 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'e02zafGen)    	
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'px,px)
+  htpSetProperty(page,'py,py)
+  htpSetProperty(page,'npoint,npoint)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e02zafGen htPage ==
+  m := htpProperty(htPage,'m)
+  px := htpProperty(htPage,'px)
+  py := htpProperty(htPage,'py)
+  npoint := htpProperty(htPage,'npoint)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  nadres := (px-7)*(py-7)
+  -- mu 
+  for i in 1..4 repeat
+    muList := ['"0 ",:muList]
+  for i in 5..(py-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    muList := [right,:muList]
+  for i in (py-3)..py repeat
+    muList := ['"0 ",:muList]
+  mustring := bcwords2liststring muList
+  -- lamda
+  for i in 1..4 repeat
+    lamList := ['"0 ",:lamList]
+  for i in 5..(px-4) repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    lamList := [right,:lamList]
+  for i in (px-3)..px repeat
+    lamList := ['"0 ",:lamList]
+  lamstring := bcwords2liststring lamList
+  -- x & y
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    left :=  STRCONC ((first y).1," ")
+    y := rest y
+    xlist := [left,:xlist]
+    ylist := [right,:ylist]
+  xstring := bcwords2liststring xlist
+  ystring := bcwords2liststring ylist
+  prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[")
+  prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [")
+  prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-e04.boot.pamphlet b/src/interp/nag-e04.boot.pamphlet
new file mode 100644
index 00000000..7a63d8e1
--- /dev/null
+++ b/src/interp/nag-e04.boot.pamphlet
@@ -0,0 +1,2520 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-e04.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+e04dgf() ==
+  htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)
+  htMakePage '(
+    (domainConditions
+        (isDomain EM $EmptyMode)
+        (isDomain PI (PositiveInteger))
+        (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXe04dgf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04dgf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "E04DGF minimizes {\it F(x)}, an unconstrained nonlinear function")
+    (text . " of {\it n} variables, using a pre-conditioned quasi-Newton ")
+    (text . "conjugate gradient method. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the number of variables, {\it n}: ")
+    (text . "\newline ")
+    (bcStrings (5 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Change optional parameters:")
+    (radioButtons optional
+        ("" " No" no)
+        ("" " Yes" yes))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04dgfSolve)
+  htShowPage()
+
+
+e04dgfSolve(htPage) ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  param := htpButtonValue(htPage,'optional)
+  optional := 
+    param = 'no => '0
+    '1
+  (n = '2 and optional = 0) => e04dgfDefaultSolve(htPage,ifail,n,optional)
+  funcList := [['bcStrings,[55, '"exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)", 'f, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  middle := cons('text,middle)
+  vecList := 
+    n='2 =>
+      [['bcStrings,[8,-1.0,'x1,'F]],['bcStrings,[8,1.0,'x2,'F]]]  
+    [fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ['bcStrings,[8, -1.0, xnam, 'F]]
+  funcList := [:funcList,middle,:vecList]
+  if optional = 1 then
+    opt1Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt1Text := STRCONC(opt1Text,'"Estimated optimal function values, {\it es}: \newline ")
+    optList := [['text,:opt1Text],['bcStrings,[20, 1.0, 'es, 'F]]]
+    opt2Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt2Text := STRCONC(opt2Text,'"Function precision, {\it fu}: \newline ")
+    optList := [:optList,:[['text,:opt2Text],['bcStrings,[20,"0.4373903597E-14",'fu,'F]]]]
+    opt3Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt3Text := STRCONC(opt3Text,'"Iteration limit, {\it it}: \newline ")
+    optList := [:optList,:[['text,:opt3Text],['bcStrings,[5,50,'it,'PI]]]]
+    opt4Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt4Text := STRCONC(opt4Text,'"Linesearch tolerance, {\it lin}: \newline ")
+    optList := [:optList,:[['text,:opt4Text],['bcStrings,[20,"0.9",'lin,'F]]]]
+    opt5Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt5Text := STRCONC(opt5Text,'"List parameters:")
+    optList := [:optList,:[['text,:opt5Text],['radioButtons,'lis,:[[""," Yes",'true],[""," No",'false]]]]]
+    opt6Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt6Text := STRCONC(opt6Text,'"Maximum step length, {\it ma}: \newline ")
+    optList := [:optList,:[['text,:opt6Text],['bcStrings,[20,"1.0E+20",'ma,'F]]]]
+    opt7Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt7Text := STRCONC(opt7Text,'"Optimality tolerance, {\it op}: \newline ")
+    optList := [:optList,:[['text,:opt7Text],['bcStrings,[20,"3.26E-12",'op,'F]]]]
+    opt9Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt9Text := STRCONC(opt9Text,'"Print level, {\it pr}: \newline ")
+    optList := [:optList,:[['text,:opt9Text],['bcStrings,[5,10,'pr,'PI]]]]
+    opt10Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt10Text := STRCONC(opt10Text,'"Start objective check at variable, {\it sta}: \newline ")
+    optList := [:optList,:[['text,:opt10Text],['bcStrings,[5,1,'sta,'PI]]]]
+    opt11Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt11Text := STRCONC(opt11Text,'"Stop objective check at variable, {\it sto}: \newline ")
+    optList := [:optList,:[['text,:opt11Text],['bcStrings,[5,2,'sto,'PI]]]]
+    opt12Text := '"\blankline \menuitemstyle{}\tab{2} "
+    opt12Text := STRCONC(opt12Text,'"Verify level, {\it ver}: \newline ")
+    optList := [:optList,:[['text,:opt12Text],['bcStrings,[5,0,'ver,'PI]]]]
+
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "List parameters:")
+--    (radioButtons lis
+--        ("" " Yes" true)
+--        ("" " No" false))
+  else
+    optList := []
+  equationPart := [
+     '(domainConditions 
+         (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+	    (isDomain I (Integer))),
+ 		:funcList,
+		  :optList]
+  page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04dgfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'optional,optional)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04dgfDefaultSolve(htPage,ifail,n,optional) ==
+  page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
+    (text . "\newline ")
+    (bcStrings (55 "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" f EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline")
+    (bcStrings (8 "-1.0" x1 F))
+    (bcStrings (8 "1.0" x2 F)))
+  htMakeDoneButton('"Continue",'e04dgfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'optional,optional)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04dgfGen htPage ==
+  n := htpProperty(htPage,'n)
+  optional := htpProperty(htPage,'optional)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  if (optional = '0) then
+    es := '"1.0"
+    ma := '"1.0E+20"
+    op := '"3.26E-12"
+    lin := '"0.9"
+    fu := '"0.4373903597E-14"
+    it := 50
+    pr := 10
+    sta := 1
+    sto := 2
+    ver := 0
+    lis := '"true"
+    for i in 1..n repeat
+      temp := STRCONC ((first y).1," ")
+      xlist := [temp,:xlist]	
+      y := rest y
+    xstring := bcwords2liststring xlist
+    f := (first y).1
+  else
+    ver := STRCONC((first y).1," ")
+    y := rest y
+    sto := STRCONC((first y).1," ")
+    y := rest y
+    sta := STRCONC((first y).1," ")
+    y := rest y
+    pr := STRCONC((first y).1," ")
+    y := rest y
+    op := STRCONC((first y).1," ")
+    y := rest y
+    ma := STRCONC((first y).1," ")
+    y := rest y
+    nolist := (first y).1
+    lis :=
+      nolist = '" t" => '"false"
+      '"true"
+    y := rest y
+    dummy := first y
+    y := rest y
+    lin := STRCONC((first y).1," ")
+    y := rest y
+    it := STRCONC((first y).1," ")
+    y := rest y
+    fu := STRCONC((first y).1," ")
+    y := rest y
+    es := STRCONC((first y).1," ")
+    y := rest y
+    for i in 1..n repeat
+      temp := STRCONC ((first y).1," ")
+      xlist := [temp,:xlist]	
+      y := rest y
+    xstring := bcwords2liststring xlist
+    f := (first y).1
+  prefix := STRCONC("e04dgf(",STRINGIMAGE n,", ",es,", ",fu,",")
+  prefix := STRCONC(prefix,STRINGIMAGE it,", ",lin,", ",lis,", ",ma,", ",op)
+  prefix := STRCONC(prefix,",",STRINGIMAGE pr,", ",STRINGIMAGE sta,", ")
+  middle := STRCONC(STRINGIMAGE sto,", ",STRINGIMAGE ver,", [",xstring,"] ,")
+  middle := STRCONC(middle,STRINGIMAGE ifail," ,")
+  linkGen STRCONC (prefix,middle,"((",f,")::Expression(Float))::ASP49(OBJFUN))")
+
+e04fdf() ==
+  htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe04fdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04fdf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04FDF is an easy to use routine for finding an unconstrained ")
+    (text . "minimum of a sum of squares of {\it m} nonlinear functions in ")
+    (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ")
+    (text . "is applicable to problems of the form ")
+    (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}")
+    (text . "No derivatives are required.  The routine is intended for ")
+    (text . "functions which have continous first and second derivatives, ")
+    (text . "though it will usually work if the derivatives have occasional ")
+    (text . "discontinuities. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 15 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables \htbitmap{xj}, {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it iw}, {\it liw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 1 liw F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it w}, {\it lw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 171 lw F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04fdfSolve)
+  htShowPage()
+
+e04fdfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  liw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw)
+    objValUnwrap htpLabelSpadValue(htPage, 'liw)
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '15 and n = '3) => e04fdfDefaultSolve(htPage,liw,lw,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..m] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := ('"XC[1] + 1")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  middle := cons('text,middle)
+  vecList := 
+    [fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ['bcStrings,[4, '"0.0", xnam, 'F]]
+  funcList := [:funcList,middle,:vecList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+           (isDomain I (Integer))),
+ 		:funcList]
+  page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions \htbitmap{fi} below in terms XC[1]...XC[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04fdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04fdfDefaultSolve (htPage,liw,lw,ifail) ==
+  n := '3
+  m := '15
+  page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below ")
+    (text . "in terms of XC[1]...XC[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM))
+    (text . "\newline {\em Function 10:} \space{1}")
+    (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM))
+    (text . "\newline {\em Function 11:} \space{1}")
+    (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM))
+    (text . "\newline {\em Function 12:} \space{1}")
+    (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM))
+    (text . "\newline {\em Function 13:} \space{1}")
+    (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM))
+    (text . "\newline {\em Function 14:} \space{1}")
+    (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM))
+    (text . "\newline {\em Function 15:} \space{1}")
+    (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ")
+    (bcStrings (4 "0.5" x1 F))
+    (bcStrings (4 "1.0" x2 F))
+    (bcStrings (4 "1.5" x3 F)))
+  htMakeDoneButton('"Continue",'e04fdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04fdfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  m := htpProperty(htPage, 'm)
+  liw := htpProperty(htPage,'liw)
+  lw := htpProperty(htPage,'lw)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    xlist := [temp,:xlist]	
+    y := rest y
+  xstring := bcwords2liststring xlist    
+  for i in 1..m repeat
+    temp := STRCONC ((first y).1," ")
+    ulist := [temp,:ulist]	
+    y := rest y
+  ustring := bcwords2liststring ulist    
+  prefix := STRCONC("e04fdf(",STRINGIMAGE m,",",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [")
+  middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",")
+  linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP50(LSFUN1))")
+
+
+e04gcf() ==
+  htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe04gcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04gcf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04GCF is an easy to use quasi-Newton routine for finding an unconstrained ")
+    (text . "minimum of a sum of squares of {\it m} nonlinear functions in ")
+    (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ")
+    (text . "is applicable to problems of the form ")
+    (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}")
+    (text . "The routine is intended for ")
+    (text . "functions which have continous first and second derivatives, ")
+    (text . "though it will usually work if the derivatives have occasional ")
+    (text . "discontinuities. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 15 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables \htbitmap{xj}, {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 3 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it iw}, {\it liw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 1 liw F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it w}, {\it lw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 177 lw F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04gcfSolve)
+  htShowPage()
+
+e04gcfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  liw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw)
+    objValUnwrap htpLabelSpadValue(htPage, 'liw)
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '15 and n = '3) => e04gcfDefaultSolve(htPage,liw,lw,ifail)
+  funcList := 
+    "append"/[fa(i) for i in 1..m] where fa(i) ==
+      prefix := ('"\newline {\em Function ")
+      prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}")
+      funct := ('"XC[1] + 1")
+      nam := INTERN STRCONC ('"n",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  middle := cons('text,middle)
+  vecList := 
+    [fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      ['bcStrings,[4, '"0.0", xnam, 'F]]
+  funcList := [:funcList,middle,:vecList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:funcList]
+  page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the functions \htbitmap{fi} below in terms of XC[1]...XC[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04gcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04gcfDefaultSolve (htPage,liw,lw,ifail) ==
+  n := '3
+  m := '15
+  page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the functions \htbitmap{fi} below ")
+    (text . "in terms of XC[1]...XC[n]: ")
+    (text . "\newline ")
+    (text . "\newline {\em Function 1:} \space{1}")
+    (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM))
+    (text . "\newline {\em Function 2:} \space{1}")
+    (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM))
+    (text . "\newline {\em Function 3:} \space{1}")
+    (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM))
+    (text . "\newline {\em Function 4:} \space{1}")
+    (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM))
+    (text . "\newline {\em Function 5:} \space{1}")
+    (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM))
+    (text . "\newline {\em Function 6:} \space{1}")
+    (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM))
+    (text . "\newline {\em Function 7:} \space{1}")
+    (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM))
+    (text . "\newline {\em Function 8:} \space{1}")
+    (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM))
+    (text . "\newline {\em Function 9:} \space{1}")
+    (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM))
+    (text . "\newline {\em Function 10:} \space{1}")
+    (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM))
+    (text . "\newline {\em Function 11:} \space{1}")
+    (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM))
+    (text . "\newline {\em Function 12:} \space{1}")
+    (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM))
+    (text . "\newline {\em Function 13:} \space{1}")
+    (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM))
+    (text . "\newline {\em Function 14:} \space{1}")
+    (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM))
+    (text . "\newline {\em Function 15:} \space{1}")
+    (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ")
+    (bcStrings (4 "0.5" x1 F))
+    (bcStrings (4 "1.0" x2 F))
+    (bcStrings (4 "1.5" x3 F)))
+  htMakeDoneButton('"Continue",'e04gcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04gcfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  m := htpProperty(htPage, 'm)
+  liw := htpProperty(htPage,'liw)
+  lw := htpProperty(htPage,'lw)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    xlist := [temp,:xlist]	
+    y := rest y
+  xstring := bcwords2liststring xlist    
+  for i in 1..m repeat
+    temp := STRCONC ((first y).1," ")
+    ulist := [temp,:ulist]	
+    y := rest y
+  ustring := bcwords2liststring ulist    
+  prefix := STRCONC("e04gcf(",STRINGIMAGE m,",",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [")
+  middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",")
+  linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP19(LSFUN2))")
+
+
+e04jaf() ==
+  htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXe04jaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04jaf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04JAF is an easy to use quasi-Newton routine for finding a ")
+    (text . "minimum of a nonlinear function {\it F(x)} of {\it n} variables ")
+    (text . "\center{\htbitmap{e04fdf1}} possibly subject to fixed upper ")
+    (text . "and lower bounds on the variables, i.e., it is applicable to ")
+    (text . "problems of the form \blankline Minimize {\it F(x)}, subject to ")
+    (text . "\htbitmap{lj} \htbitmap{great=} \htbitmap{xj} \htbitmap{great=} ")
+    (text . "\htbitmap{uj} for {\it j} = 1,2,...,n. \blankline ")
+    (text . "Function values only are required.  The routine is intended for ")
+    (text . "functions which have continuous first and second derivatives, ")
+    (text . "though it will usually work if the derivatives have occasional ")
+    (text . "discontinuities. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables \htbitmap{xj}, {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 4 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Specify the use of bounds, {\it ibound}:")
+    (radioButtons ibound
+        (" 0" " All \htbitmap{lj} and \htbitmap{uj} are given individually" iZero)
+        (" 1" " No bounds on any of the \htbitmap{xj}" iOne)
+        (" 2" " All bounds are of the form 0 \htbitmap{great=} \htbitmap{xj}" iTwo)
+        (" 3" " All \htbitmap{lj} are equal and all \htbitmap{uj} are equal" iThree))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it iw}, {\it liw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 6 liw F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it w}, {\it lw}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 54 lw F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04jafSolve)
+  htShowPage()
+
+e04jafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  boun := htpButtonValue(htPage,'ibound)
+  ibound :=
+    boun = 'iZero => '0
+    boun = 'iOne => '1
+    boun = 'iTwo => '2
+    '3
+  liw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw)
+    objValUnwrap htpLabelSpadValue(htPage, 'liw)
+  lw :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw)
+    objValUnwrap htpLabelSpadValue(htPage, 'lw)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4 => e04jafDefaultSolve(htPage,ibound,liw,lw,ifail)
+  funcList := [['bcStrings,[50, '"XC[1]", 'f, 'EM]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary conditions ")
+  middle := STRCONC(middle,'"{\it bl(n)}: \newline ")
+  blList := 
+    "append"/[fa(i) for i in 1..n] where fa(i) ==
+      xnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  blList := [['text,:middle],:blList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ")
+  middle := STRCONC(middle,'"conditions {\it bu(n)}: \newline ")
+  buList := 
+    "append"/[fb(i) for i in 1..n] where fb(i) ==
+      xnam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  buList := [['text,:middle],:buList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  xList := 
+    "append"/[fc(i) for i in 1..n] where fc(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:middle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:funcList,:blList,:buList,:xList]
+  page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04jafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ibound,ibound)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04jafDefaultSolve (htPage,ibound,liw,lw,ifail) ==
+  n := '4
+  page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: ")
+    (text . "\newline ")
+    (bcStrings (60 "(XC[1]+10*XC[2])**2+5*(XC[3]-XC[4])**2+(XC[2]-2*XC[3])**4+10*(XC[1]-XC[4])**4" n1 EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter lower boundary conditions {\it bl(n)}: \newline ")
+    (bcStrings (8 "1" bl1 F))
+    (bcStrings (8 "-2" bl2 F))
+    (bcStrings (8 "-1.0e-6" bl3 F))
+    (bcStrings (8 "1" bl4 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter upper boundary conditions {\it bu(n)}: \newline ")
+    (bcStrings (8 "3" bu1 F))
+    (bcStrings (8 "0" bu2 F))
+    (bcStrings (8 "1.0e6" bu3 F))
+    (bcStrings (8 "3" bu4 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ")
+    (bcStrings (8 "3" x1 F))
+    (bcStrings (8 "-1" x2 F))
+    (bcStrings (8 "0" x3 F))
+    (bcStrings (8 "1" x4 F)))
+  htMakeDoneButton('"Continue",'e04jafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'ibound,ibound)
+  htpSetProperty(page,'liw,liw)
+  htpSetProperty(page,'lw,lw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04jafGen htPage ==
+  n := htpProperty(htPage, 'n)
+  ibound := htpProperty(htPage, 'ibound)
+  liw := htpProperty(htPage,'liw)
+  lw := htpProperty(htPage,'lw)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    xlist := [temp,:xlist]	
+    y := rest y
+  xstring := bcwords2liststring xlist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    bulist := [temp,:bulist]	
+    y := rest y
+  bustring := bcwords2liststring bulist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    bllist := [temp,:bllist]	
+    y := rest y
+  blstring := bcwords2liststring bllist    
+  f := (first y).1
+  prefix := STRCONC("e04jaf(",STRINGIMAGE n,",",STRINGIMAGE ibound,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [")
+  prefix := STRCONC(prefix,blstring,"],[",bustring,"],[")
+  middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",(")
+  linkGen STRCONC(prefix,middle,f,"::Expression(Float))::ASP24(FUNCT1))")
+
+
+e04mbf() ==
+  htInitPage('"E04MBF - Linear programming problem",nil)
+  htMakePage '(
+    (domainConditions 
+  	(isDomain EM $EmptyMode)
+        (isDomain PI (PositiveInteger))
+        (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXe04mbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04mbf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04MBF is an easy to use routine to solve linear programming ")
+    (text . "(LP) problems of the form \center{\htbitmap{e04mbf}} \newline ")
+    (text . "where {\it c} is an {\it n} element vector and {\it A} is an ")
+    (text . "{\it m} by {\it n} matrix, i.e., there are {\it n} variables ")
+    (text . "and {\it m} linear constraints. {\it m} may be zero in which ")
+    (text . "case the LP problem is subject only to bounds on the variables. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Upper bound on number of iterations, {\it itmax}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 20 itmax PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Type of output messages required, {\it msglvl}: ")
+    (radioButtons msglvl
+        (" = 1 " " Printing occurs at the solution " mOne)
+        (" = 0 " " Printing only if an input parameter is incorrect " mZero)
+        (" < 0 " " No printing " mMinus))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables, {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of general linear constraints, {\it nclin}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 nclin PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "First dimension of array {\it a}, {\it nrowa}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 nrowa PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Specifies whether or not a linear objective function is present, {\it linobj}:")
+    (radioButtons linobj
+        ("" " true - full LP problem is solved" true)
+        ("" " false - only a feasible problem is found" false))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Dimension of {\it iwork}, {\it liwork}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 14 liwork F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it work}, {\it lwork}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 182 lwork F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04mbfSolve)
+  htShowPage()
+
+e04mbfSolve htPage ==
+  itmax :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax)
+    objValUnwrap htpLabelSpadValue(htPage, 'itmax)
+  msg := htpButtonValue(htPage,'msglvl)
+  msglvl :=
+    msg = 'mMinus => '-1
+    msg = 'mZero => '0
+    '1
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nclin :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin)
+    objValUnwrap htpLabelSpadValue(htPage, 'nclin)
+  nrowa :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowa)
+  lin := htpButtonValue(htPage,'linobj)
+  linobj :=
+    lin = 'true => '"true"
+    '"false"
+  liwork :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork)
+    objValUnwrap htpLabelSpadValue(htPage, 'liwork)
+  lwork :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork)
+    objValUnwrap htpLabelSpadValue(htPage, 'lwork)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((nrowa = '7 and n = 7) and nclin = 7) => e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail)
+  aList := 
+    "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[8, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ")
+  middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ")
+  blList := 
+    "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) ==
+      blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", blnam, 'F]]]
+  blList := [['text,:middle],:blList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ")
+  middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ")
+  buList := 
+    "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) ==
+      bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", bunam, 'F]]]
+  buList := [['text,:middle],:buList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ")
+  middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ")
+  cList := 
+    "append"/[fe(i) for i in 1..n] where fe(i) ==
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", cnam, 'F]]]
+  cList := [['text,:middle],:cList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:middle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:aList,:blList,:buList,:cList,:xList]
+  page:= htInitPage('"E04MBF - Linear programming problem",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04mbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'itmax,itmax)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'linobj,linobj)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail) ==
+  n := '7
+  nclin := '7
+  nrowa := '7
+  page:= htInitPage('"E04MBF - Linear programming problem",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ")
+    (bcStrings (5 "1" a11 F))
+    (bcStrings (5 "1" a12 F))
+    (bcStrings (5 "1" a13 F))
+    (bcStrings (5 "1" a14 F))
+    (bcStrings (5 "1" a15 F))
+    (bcStrings (5 "1" a16 F))
+    (bcStrings (5 "1" a17 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.15" a21 F))
+    (bcStrings (5 "0.04" a22 F))
+    (bcStrings (5 "0.02" a23 F))
+    (bcStrings (5 "0.04" a24 F))
+    (bcStrings (5 "0.02" a25 F))
+    (bcStrings (5 "0.01" a26 F))
+    (bcStrings (5 "0.03" a27 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.03" a31 F))
+    (bcStrings (5 "0.05" a32 F))
+    (bcStrings (5 "0.08" a33 F))
+    (bcStrings (5 "0.02" a34 F))
+    (bcStrings (5 "0.06" a35 F))
+    (bcStrings (5 "0.01" a36 F))
+    (bcStrings (5 "0" a37 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a41 F))
+    (bcStrings (5 "0.04" a42 F))
+    (bcStrings (5 "0.01" a43 F))
+    (bcStrings (5 "0.02" a44 F))
+    (bcStrings (5 "0.02" a45 F))
+    (bcStrings (5 "0" a46 F))
+    (bcStrings (5 "0" a47 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a51 F))
+    (bcStrings (5 "0.03" a52 F))
+    (bcStrings (5 "0" a53 F))
+    (bcStrings (5 "0" a54 F))
+    (bcStrings (5 "0.01" a55 F))
+    (bcStrings (5 "0" a56 F))
+    (bcStrings (5 "0" a57 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.7" a61 F))
+    (bcStrings (5 "0.75" a62 F))
+    (bcStrings (5 "0.8" a63 F))
+    (bcStrings (5 "0.75" a64 F))
+    (bcStrings (5 "0.8" a65 F))
+    (bcStrings (5 "0.97" a66 F))
+    (bcStrings (5 "0" a67 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a71 F))
+    (bcStrings (5 "0.06" a72 F))
+    (bcStrings (5 "0.08" a73 F))
+    (bcStrings (5 "0.12" a74 F))
+    (bcStrings (5 "0.02" a75 F))
+    (bcStrings (5 "0.01" a76 F))
+    (bcStrings (5 "0.97" a77 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ")
+    (bcStrings (8 "-0.01" bl1 F))
+    (bcStrings (8 "-0.1" bl2 F))
+    (bcStrings (8 "-0.01" bl3 F))
+    (bcStrings (8 "-0.04" bl4 F))
+    (bcStrings (8 "-0.1" bl5 F))
+    (bcStrings (8 "-0.01" bl6 F))
+    (bcStrings (8 "-0.01" bl7 F))
+    (bcStrings (8 "-0.13" bl8 F))
+    (bcStrings (8 "-1.0e+21" bl9 F))
+    (bcStrings (8 "-1.0e+21" bl10 F))
+    (bcStrings (8 "-1.0e+21" bl11 F))
+    (bcStrings (8 "-1.0e+21" bl12 F))
+    (bcStrings (8 "-0.0992" bl13 F))
+    (bcStrings (8 "-0.003" bl14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ")
+    (bcStrings (8 "0.01" bu1 F))
+    (bcStrings (8 "0.15" bu2 F))
+    (bcStrings (8 "0.03" bu3 F))
+    (bcStrings (8 "0.02" bu4 F))
+    (bcStrings (8 "0.05" bu5 F))
+    (bcStrings (8 "1.0e+21" bu6 F))
+    (bcStrings (8 "1.0e+21" bu7 F))
+    (bcStrings (8 "-0.13" bu8 F))
+    (bcStrings (8 "-0.0049" bu9 F))
+    (bcStrings (8 "-0.0064" bu10 F))
+    (bcStrings (8 "-0.0037" bu11 F))
+    (bcStrings (8 "-0.0012" bu12 F))
+    (bcStrings (8 "1.0e+21" bu13 F))
+    (bcStrings (8 "0.002" bu14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") 
+    (text . "\newline ")
+    (bcStrings (8 "-0.02" c1 F))
+    (bcStrings (8 "-0.2" c2 F))
+    (bcStrings (8 "-0.2" c3 F))
+    (bcStrings (8 "-0.2" c4 F))
+    (bcStrings (8 "-0.2" c5 F))
+    (bcStrings (8 "0.04" c6 F))
+    (bcStrings (8 "0.04" c7 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector, {\it x(n)}: ")
+    (text . "\newline ")
+    (bcStrings (8 "-0.01" x1 F))
+    (bcStrings (8 "-0.03" x2 F))
+    (bcStrings (8 "0.0" x3 F))
+    (bcStrings (8 "-0.01" x4 F))
+    (bcStrings (8 "-0.1" x5 F))
+    (bcStrings (8 "0.02" x6 F))
+    (bcStrings (8 "0.01" x7 F)))
+  htMakeDoneButton('"Continue",'e04mbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'itmax,itmax)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'linobj,linobj)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04mbfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  nclin := htpProperty(htPage, 'nclin)
+  nrowa := htpProperty(htPage, 'nrowa)
+  itmax := htpProperty(htPage, 'itmax)
+  msglvl := htpProperty(htPage, 'msglvl)
+  linobj := htpProperty(htPage, 'linobj)
+  liwork := htpProperty(htPage,'liwork)
+  lwork := htpProperty(htPage,'lwork)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    xlist := [temp,:xlist]	
+    y := rest y
+  xstring := bcwords2liststring xlist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    clist := [temp,:clist]	
+    y := rest y
+  cstring := bcwords2liststring clist    
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    bulist := [temp,:bulist]	
+    y := rest y
+  bustring := bcwords2liststring bulist    
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    bllist := [temp,:bllist]	
+    y := rest y
+  blstring := bcwords2liststring bllist    
+  for i in 1..nrowa repeat -- matrix A
+    for j in 1..n repeat
+      a := STRCONC((first y).1," ")
+      arrlist := [a,:arrlist]
+      y := rest y
+    amatlist := [:amatlist,arrlist]
+    arrlist := []
+  amatlist := reverse amatlist 
+  amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist]  
+  nctotl := n + nclin
+  prefix := STRCONC("e04mbf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ")
+  middle := STRCONC(amatstr,",[")
+  middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring)
+  middle := STRCONC(middle,"],",linobj,", ",STRINGIMAGE liwork)
+  middle := STRCONC(middle,",",STRINGIMAGE lwork,",[")
+  middle := STRCONC(middle,xstring,"],",STRINGIMAGE ifail,")")
+  linkGen STRCONC(prefix,middle)
+
+
+
+e04naf() ==
+  htInitPage('"E04NAF - Quadratic programming problem",nil)
+  htMakePage '(
+    (domainConditions 
+  	(isDomain EM $EmptyMode)
+        (isDomain PI (PositiveInteger))
+        (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXe04naf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04naf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04NAF is a comprehensive routine to solve quadratic problems ")
+    (text . "(QP) of the form \center{\htbitmap{e04naf}} \newline ")
+    (text . "where {\it c} is a constant {\it n} element vector, {\it H} is a")
+    (text . " constant {\it n} by {\it n} symmetric matrix, and the matrix ")
+    (text . "{\it A} is {\it m} by {\it n}, i.e. there are {\it n} variables ")
+    (text . "and {\it m} general linear constraints. {\it m} may be zero in ")
+    (text . "which case the LP problem is subject only to bounds on the ")
+    (text . "variables. \blankline If {\it H} = 0 a flag can be set so that ")
+    (text . "the problem is treated as a linear programming (LP) problem. ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Upper bound on number of iterations, {\it itmax}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 20 itmax PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Type of output messages required, {\it msglvl}: ")
+    (radioButtons msglvl
+        (" < 0 " " No printing " mMinus)
+        (" = 0 " " Printing only if an input parameter is incorrect or overflow is likely" mZero)
+        (" = 1" " Printing occurs at the solution " mOne)
+        (" = 5" " One line of output for each constraint addition or deletion, no printout" mFive)
+        (" \htbitmap{great=} 10" " As above with printout of the solution" mTen)
+        (" \htbitmap{great=} 15" " As above with X, ISTATE and indices of free variables at each iteration" mFifteen)
+        (" \htbitmap{great=} 20" " As above with the Lagrange multiplier estimates and the free variables at each iteration" mTwenty)
+        (" \htbitmap{great=} 30" " As above with the diagonal elements of the matrix {\it T} associated with the {\it TQ} factorization of the working set, and the diagonal elements of the Cholesky factor {\it R} of the projected Hessian" mThirty)
+        (" \htbitmap{great=} 80" " As above with debug printout" mEighty)        
+        (" = 99" " As above with arrays {\it cvec} and {\it hess}" mNinetyNine))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables, {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of general linear constraints, {\it nclin}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 nclin PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "First dimension of array {\it a}, {\it nrowa}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 nrowa PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "First dimension of array {\it hess}, {\it nrowh}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 nrowh PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Second dimension of array {\it hess}, {\it ncolh}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 7 ncolh PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Size above which a bound is regarded as infinite, {\it bigbnd}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "1.0e10" bigbnd F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Specifies whether or not an initial estimate of the active constraints is present, {\it cold}:")
+    (radioButtons cold
+        ("" " true - E04NAF determines the initial working set" cTrue)
+        ("" " false - user defined contents of array {\it istate}" cFalse))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Specifies whether or not {\it h} is a zero matrix, {\it lp}:")
+    (radioButtons lp
+        ("" " false - QP problem " lFalse)
+        ("" " true - LP problem, {\it hess} and {\it qphess} are not referenced " lTrue))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Specifies whether or not orthogonal transformations are to be used in computing and updating the working set, {\it orthog}:")
+    (radioButtons orthog
+        ("" " true " oTrue)
+        ("" " false " oFalse))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Dimension of {\it iwork}, {\it liwork}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 14 liwork F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of {\it work}, {\it lwork}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 238 lwork F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04nafSolve)
+  htShowPage()
+
+e04nafSolve htPage ==
+  itmax :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax)
+    objValUnwrap htpLabelSpadValue(htPage, 'itmax)
+  msg := htpButtonValue(htPage,'msglvl)
+  msglvl :=
+    msg = 'mMinus => '-1
+    msg = 'mZero => '0
+    msg = 'mOne => '1
+    msg = 'mFive => '5
+    msg = 'mTen => '10
+    msg = 'mFifteen => '15
+    msg = 'mTwenty => '20
+    msg = 'mThirty => '30
+    msg = 'mEighty => '80
+    '99
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nclin :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin)
+    objValUnwrap htpLabelSpadValue(htPage, 'nclin)
+  nrowa :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowa)
+  nrowh :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowh)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowh)
+  ncolh :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolh)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolh)
+  bigbnd := htpLabelInputString(htPage,'bigbnd)
+  col := htpButtonValue(htPage,'cold)
+  cold :=
+    col = 'cTrue => '"true"
+    '"false"
+  linear := htpButtonValue(htPage,'lp)
+  lp :=
+    linear = 'lTrue => '"true"
+    '"false"
+  ortho := htpButtonValue(htPage,'orthog)
+  orthog :=
+    ortho = 'oTrue => '"true"
+    '"false"
+  liwork :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork)
+    objValUnwrap htpLabelSpadValue(htPage, 'liwork)
+  lwork :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork)
+    objValUnwrap htpLabelSpadValue(htPage, 'lwork)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (((nrowa = '7 and n = '7) and (nrowh = '7 and ncolh ='7)) and nclin = '7) => 
+     e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail)
+  aList := 
+    "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[8, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ")
+  middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ")
+  blList := 
+    "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) ==
+      blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", blnam, 'F]]]
+  blList := [['text,:middle],:blList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ")
+  middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ")
+  buList := 
+    "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) ==
+      bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", bunam, 'F]]]
+  buList := [['text,:middle],:buList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ")
+  middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ")
+  cList := 
+    "append"/[fe(i) for i in 1..n] where fe(i) ==
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", cnam, 'F]]]
+  cList := [['text,:middle],:cList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter set of positive ")
+  middle := STRCONC(middle,'"tolerances {\it featol(n+nclin)}: \newline ")
+  fList := 
+    "append"/[ff(i) for i in 1..(n+nclin)] where ff(i) ==
+      fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
+      [['bcStrings,[9, '"0.1053e-7", fnam, 'F]]]
+  fList := [['text,:middle],:fList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements of ")
+  middle := STRCONC(middle,'"array {\it hess(nrowh,ncolh)}: \newline ")
+  hList := 
+    "append"/[fh(i,n) for i in 1..nrowh] where fh(i,n) ==
+       labelList := 
+         "append"/[fi(i,j) for j in 1..n] where fi(i,j) ==
+            hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[8, 0, hnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  hList := [['text,:middle],:hList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:middle],:xList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} If {\it cold} = false ")
+  middle := STRCONC(middle,'"enter {\it istate(n+nclin)} values: \newline ")
+  iList := 
+    "append"/[fj(i) for i in 1..(n+nclin)] where fj(i) ==
+      inam := INTERN STRCONC ('"i",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", inam, 'F]]]
+  iList := [['text,:middle],:iList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:aList,:blList,:buList,:cList,:fList,:hList,:xList,:iList]
+  page:= htInitPage('"E04NAF - Quadratic programming problem",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04nafGen)
+  htpSetProperty(page,'itmax,itmax)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'nrowh,nrowh)
+  htpSetProperty(page,'ncolh,ncolh)
+  htpSetProperty(page,'bigbnd,bigbnd)
+  htpSetProperty(page,'cold,cold)
+  htpSetProperty(page,'lp,lp)
+  htpSetProperty(page,'orthog,orthog)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail) ==
+  n := '7
+  nclin := '7
+  nrowa := '7
+  nrowh := '7
+  ncolh := '7
+  page:= htInitPage('"E04NAF - Quadratic programming problem",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ")
+    (bcStrings (5 "1" a11 F))
+    (bcStrings (5 "1" a12 F))
+    (bcStrings (5 "1" a13 F))
+    (bcStrings (5 "1" a14 F))
+    (bcStrings (5 "1" a15 F))
+    (bcStrings (5 "1" a16 F))
+    (bcStrings (5 "1" a17 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.15" a21 F))
+    (bcStrings (5 "0.04" a22 F))
+    (bcStrings (5 "0.02" a23 F))
+    (bcStrings (5 "0.04" a24 F))
+    (bcStrings (5 "0.02" a25 F))
+    (bcStrings (5 "0.01" a26 F))
+    (bcStrings (5 "0.03" a27 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.03" a31 F))
+    (bcStrings (5 "0.05" a32 F))
+    (bcStrings (5 "0.08" a33 F))
+    (bcStrings (5 "0.02" a34 F))
+    (bcStrings (5 "0.06" a35 F))
+    (bcStrings (5 "0.01" a36 F))
+    (bcStrings (5 "0" a37 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a41 F))
+    (bcStrings (5 "0.04" a42 F))
+    (bcStrings (5 "0.01" a43 F))
+    (bcStrings (5 "0.02" a44 F))
+    (bcStrings (5 "0.02" a45 F))
+    (bcStrings (5 "0" a46 F))
+    (bcStrings (5 "0" a47 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a51 F))
+    (bcStrings (5 "0.03" a52 F))
+    (bcStrings (5 "0" a53 F))
+    (bcStrings (5 "0" a54 F))
+    (bcStrings (5 "0.01" a55 F))
+    (bcStrings (5 "0" a56 F))
+    (bcStrings (5 "0" a57 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.7" a61 F))
+    (bcStrings (5 "0.75" a62 F))
+    (bcStrings (5 "0.8" a63 F))
+    (bcStrings (5 "0.75" a64 F))
+    (bcStrings (5 "0.8" a65 F))
+    (bcStrings (5 "0.97" a66 F))
+    (bcStrings (5 "0" a67 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.02" a71 F))
+    (bcStrings (5 "0.06" a72 F))
+    (bcStrings (5 "0.08" a73 F))
+    (bcStrings (5 "0.12" a74 F))
+    (bcStrings (5 "0.02" a75 F))
+    (bcStrings (5 "0.01" a76 F))
+    (bcStrings (5 "0.97" a77 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ")
+    (bcStrings (8 "-0.01" bl1 F))
+    (bcStrings (8 "-0.1" bl2 F))
+    (bcStrings (8 "-0.01" bl3 F))
+    (bcStrings (8 "-0.04" bl4 F))
+    (bcStrings (8 "-0.1" bl5 F))
+    (bcStrings (8 "-0.01" bl6 F))
+    (bcStrings (8 "-0.01" bl7 F))
+    (bcStrings (8 "-0.13" bl8 F))
+    (bcStrings (8 "-1.0e+21" bl9 F))
+    (bcStrings (8 "-1.0e+21" bl10 F))
+    (bcStrings (8 "-1.0e+21" bl11 F))
+    (bcStrings (8 "-1.0e+21" bl12 F))
+    (bcStrings (8 "-0.0992" bl13 F))
+    (bcStrings (8 "-0.003" bl14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ")
+    (bcStrings (8 "0.01" bu1 F))
+    (bcStrings (8 "0.15" bu2 F))
+    (bcStrings (8 "0.03" bu3 F))
+    (bcStrings (8 "0.02" bu4 F))
+    (bcStrings (8 "0.05" bu5 F))
+    (bcStrings (8 "1.0e+21" bu6 F))
+    (bcStrings (8 "1.0e+21" bu7 F))
+    (bcStrings (8 "-0.13" bu8 F))
+    (bcStrings (8 "-0.0049" bu9 F))
+    (bcStrings (8 "-0.0064" bu10 F))
+    (bcStrings (8 "-0.0037" bu11 F))
+    (bcStrings (8 "-0.0012" bu12 F))
+    (bcStrings (8 "1.0e+21" bu13 F))
+    (bcStrings (8 "0.002" bu14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") 
+    (text . "\newline ")
+    (bcStrings (8 "-0.02" c1 F))
+    (bcStrings (8 "-0.2" c2 F))
+    (bcStrings (8 "-0.2" c3 F))
+    (bcStrings (8 "-0.2" c4 F))
+    (bcStrings (8 "-0.2" c5 F))
+    (bcStrings (8 "0.04" c6 F))
+    (bcStrings (8 "0.04" c7 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter set of positive tolerances {\it featol(n+nclin)}:\newline ")
+    (bcStrings (9 "0.1053e-7" f1 F))
+    (bcStrings (9 "0.1053e-7" f2 F))
+    (bcStrings (9 "0.1053e-7" f3 F))
+    (bcStrings (9 "0.1053e-7" f4 F))
+    (bcStrings (9 "0.1053e-7" f5 F))
+    (bcStrings (9 "0.1053e-7" f6 F))
+    (bcStrings (9 "0.1053e-7" f7 F))
+    (bcStrings (9 "0.1053e-7" f8 F))
+    (bcStrings (9 "0.1053e-7" f9 F))
+    (bcStrings (9 "0.1053e-7" f10 F))
+    (bcStrings (9 "0.1053e-7" f11 F))
+    (bcStrings (9 "0.1053e-7" f12 F))
+    (bcStrings (9 "0.1053e-7" f13 F))
+    (bcStrings (9 "0.1053e-7" f14 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of array {\it hess(nrowh,ncolh)}: \newline ")
+    (bcStrings (5 "2" h11 F))
+    (bcStrings (5 "0" h12 F))
+    (bcStrings (5 "0" h13 F))
+    (bcStrings (5 "0" h14 F))
+    (bcStrings (5 "0" h15 F))
+    (bcStrings (5 "0" h16 F))
+    (bcStrings (5 "0" h17 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h21 F))
+    (bcStrings (5 "2" h22 F))
+    (bcStrings (5 "0" h23 F))
+    (bcStrings (5 "0" h24 F))
+    (bcStrings (5 "0" h25 F))
+    (bcStrings (5 "0" h26 F))
+    (bcStrings (5 "0" h27 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h31 F))
+    (bcStrings (5 "0" h32 F))
+    (bcStrings (5 "2" h33 F))
+    (bcStrings (5 "2" h34 F))
+    (bcStrings (5 "0" h35 F))
+    (bcStrings (5 "0" h36 F))
+    (bcStrings (5 "0" h37 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h41 F))
+    (bcStrings (5 "0" h42 F))
+    (bcStrings (5 "2" h43 F))
+    (bcStrings (5 "2" h44 F))
+    (bcStrings (5 "0" h45 F))
+    (bcStrings (5 "0" h46 F))
+    (bcStrings (5 "0" h47 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h51 F))
+    (bcStrings (5 "0" h52 F))
+    (bcStrings (5 "0" h53 F))
+    (bcStrings (5 "0" h54 F))
+    (bcStrings (5 "2" h55 F))
+    (bcStrings (5 "0" h56 F))
+    (bcStrings (5 "0" h57 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h61 F))
+    (bcStrings (5 "0" h62 F))
+    (bcStrings (5 "0" h63 F))
+    (bcStrings (5 "0" h64 F))
+    (bcStrings (5 "0" h65 F))
+    (bcStrings (5 "-2" h66 F))
+    (bcStrings (5 "-2" h67 F))
+    (text . "\newline ")
+    (bcStrings (5 "0" h71 F))
+    (bcStrings (5 "0" h72 F))
+    (bcStrings (5 "0" h73 F))
+    (bcStrings (5 "0" h74 F))
+    (bcStrings (5 "0" h75 F))
+    (bcStrings (5 "-2" h76 F))
+    (bcStrings (5 "-2" h77 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector, {\it x(n)}: ")
+    (text . "\newline ")
+    (bcStrings (8 "-0.01" x1 F))
+    (bcStrings (8 "-0.03" x2 F))
+    (bcStrings (8 "0.0" x3 F))
+    (bcStrings (8 "-0.01" x4 F))
+    (bcStrings (8 "-0.1" x5 F))
+    (bcStrings (8 "0.02" x6 F))
+    (bcStrings (8 "0.01" x7 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "If {\it cold} = false enter {\it istate(n+nclin)} values: ")
+    (text . "\newline ")
+    (bcStrings (8 "0" i1 F))
+    (bcStrings (8 "0" i2 F))
+    (bcStrings (8 "0" i3 F))
+    (bcStrings (8 "0" i4 F))
+    (bcStrings (8 "0" i5 F))
+    (bcStrings (8 "0" i6 F))
+    (bcStrings (8 "0" i7 F))
+    (bcStrings (8 "0" i8 F))
+    (bcStrings (8 "0" i9 F))
+    (bcStrings (8 "0" i10 F))
+    (bcStrings (8 "0" i11 F))
+    (bcStrings (8 "0" i12 F))
+    (bcStrings (8 "0" i13 F))
+    (bcStrings (8 "0" i14 F)))
+  htMakeDoneButton('"Continue",'e04nafGen)
+  htpSetProperty(page,'itmax,itmax)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'nrowh,nrowh)
+  htpSetProperty(page,'ncolh,ncolh)
+  htpSetProperty(page,'bigbnd,bigbnd)
+  htpSetProperty(page,'cold,cold)
+  htpSetProperty(page,'lp,lp)
+  htpSetProperty(page,'orthog,orthog)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04nafGen htPage ==
+  itmax := htpProperty(htPage, 'itmax)
+  msglvl := htpProperty(htPage, 'msglvl)
+  n := htpProperty(htPage, 'n)
+  nclin := htpProperty(htPage, 'nclin)
+  nrowa := htpProperty(htPage, 'nrowa)
+  nrowh := htpProperty(htPage, 'nrowh)
+  ncolh := htpProperty(htPage, 'ncolh)
+  bigbnd := htpProperty(htPage, 'bigbnd)
+  cold := htpProperty(htPage, 'cold)
+  lp := htpProperty(htPage, 'lp)
+  orthog := htpProperty(htPage, 'orthog)
+  liwork := htpProperty(htPage,'liwork)
+  lwork := htpProperty(htPage,'lwork)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    ilist := [temp,:ilist]	
+    y := rest y
+  istring := bcwords2liststring ilist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    xlist := [temp,:xlist]	
+    y := rest y
+  xstring := bcwords2liststring xlist    
+  for i in 1..nrowh repeat -- matrix H
+    for j in 1..ncolh repeat
+      h := STRCONC((first y).1," ")
+      hlist := [h,:hlist]
+      y := rest y
+    hmatlist := [:hmatlist,hlist]
+    hlist := []
+  hmatlist := reverse hmatlist 
+  hmatstr := bcwords2liststring [bcwords2liststring x for x in hmatlist]  
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    flist := [temp,:flist]	
+    y := rest y
+  fstring := bcwords2liststring flist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    clist := [temp,:clist]	
+    y := rest y
+  cstring := bcwords2liststring clist    
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    bulist := [temp,:bulist]	
+    y := rest y
+  bustring := bcwords2liststring bulist    
+  for i in 1..(n+nclin) repeat
+    temp := STRCONC ((first y).1," ")
+    bllist := [temp,:bllist]	
+    y := rest y
+  blstring := bcwords2liststring bllist    
+  for i in 1..nrowa repeat -- matrix A
+    for j in 1..n repeat
+      a := STRCONC((first y).1," ")
+      arrlist := [a,:arrlist]
+      y := rest y
+    amatlist := [:amatlist,arrlist]
+    arrlist := []
+  amatlist := reverse amatlist 
+  amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist]  
+  nctotl := n + nclin
+  prefix := STRCONC("e04naf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrowh,",",STRINGIMAGE ncolh,", ",bigbnd)
+  middle := STRCONC(", ",amatstr,",[")
+  middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring)
+  middle := STRCONC(middle,"],[",fstring,"],",hmatstr,",",STRINGIMAGE cold,",")
+  middle := STRCONC(middle,STRINGIMAGE lp,", ",STRINGIMAGE orthog,", ")
+  middle := STRCONC(middle,STRINGIMAGE liwork,",",STRINGIMAGE lwork,",[")
+  middle := STRCONC(middle,xstring,"],[",istring,"]::Matrix Integer,")
+  middle := STRCONC(middle,STRINGIMAGE ifail)
+  end := STRCONC(",((",hmatstr,")::Matrix Expression Float)::ASP20('QPHESS))")
+  linkGen STRCONC(prefix,middle,end)
+
+e04ucf() ==
+  htInitPage('"E04UCF - Minimum, function of several variables, sequential QP method, nonlinear constraints, using function values and optionally 1st derivatives", nil)
+  htMakePage '(
+    (domainConditions 
+  	(isDomain EM $EmptyMode)
+        (isDomain PI (PositiveInteger))
+        (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXe04ucf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ucf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04UCF minimizes an arbitrary smooth function subject to ")
+    (text . "constraints which may include simple bounds on the variables, ")
+    (text . "linear constraints and smooth nonlinear constraints. As many ")
+    (text . "first partial derivatives as possible should be supplied by the ")
+    (text . "user, unspecified derivatives being estimated by finite ")
+    (text . "differences. \newline The routine solves problems of the form")
+    (text . "\center{\htbitmap{e04ucf}}\newline where the objective function ")
+    (text . "{\it F(x)} is nonlinear, \htbitmap{Al} is an \htbitmap{nl} by n ")
+    (text . "constant matrix and {\it c(x)} is an \htbitmap{nn} element ")
+    (text . "vector of nonlinear constraint functions. The objective function")
+    (text . " and constraint functions are assumed to be smooth (i.e. at ")
+    (text . "least twice continuously differentiable), although the method ")
+    (text . "will usually work if there are discontinuities away from the ")
+    (text . "solution. \blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the number of variables, {\it n}: ")
+    (text . "\newline ")
+    (bcStrings (5 4 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the number of general linear constraints, {\it nclin}: ")
+    (text . "\newline ")
+    (bcStrings (5 1 nclin PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the number of nonlinear constraints, {\it ncnln}: ")
+    (text . "\newline ")
+    (bcStrings (5 2 ncnln PI))
+    (text . "\blankline ")
+    (text . "Change optional parameters:")
+    (radioButtons optional
+        ("" " No" no)
+        ("" " Yes" yes))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Start value:")
+    (radioButtons start
+        ("" " Cold start" false)
+        ("" " Warm start" true))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04ucfSolve)
+  htShowPage()
+
+
+e04ucfSolve(htPage) ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nclin :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin)
+    objValUnwrap htpLabelSpadValue(htPage, 'nclin)
+  ncnln :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncnln)
+  nrowa :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowa)
+  nrowj :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowj)
+  nrowr :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrowr)
+  liwork := 3*n+nclin+2*ncnln
+  lwork :=
+    (ncnln = '0 and nclin = '0) => 20*n
+    (ncnln = '0 and nclin > '0) => 2*n*n + 20*n + 11*nclin
+    (ncnln > '0 and nclin >= '0) => 2*n*n + n*nclin +2*n*ncnln + 20*n + 11*nclin + 21*ncnln
+    '1 
+  initial := htpButtonValue(htPage,'start)
+  start :=
+    initial = 'true => '1
+    '0
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  param := htpButtonValue(htPage,'optional)
+  optional := 
+    param = 'no => '0
+    '1
+  ((n = '4  and optional = '0 and nclin=1 and ncnln=2) and (start = '0)) => 
+    e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail)
+  start = '1 => e04ucfCopOut()
+  optional := '1
+  aList := 
+    "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[8, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ")
+  middle := STRCONC(middle,'"conditions {\it bl(n+nclin+ncnln)}: \newline ")
+  blList := 
+    "append"/[fc(i) for i in 1..(n+nclin+ncnln)] where fc(i) ==
+      blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
+      [['bcStrings,[8, '"-1.E25", blnam, 'F]]]
+  blList := [['text,:middle],:blList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ")
+  middle := STRCONC(middle,'"conditions {\it bu(n+nclin+ncnln)}: \newline ")
+  buList := 
+    "append"/[fd(i) for i in 1..(n+nclin+ncnln)] where fd(i) ==
+      bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
+      [['bcStrings,[8, '"1.E25", bunam, 'F]]]
+  buList := [['text,:middle],:buList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the nonlinear ")
+  middle := STRCONC(middle,'"constraint functions {\it c(ncnln)} ")
+  middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ")
+  cList := 
+    "append"/[fe(i) for i in 1..ncnln] where fe(i) ==
+      lineEnd := ('"\newline \tab{2} ")
+      cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
+      [['text,:lineEnd],['bcStrings,[55, '"X[1]", cnam, 'F]]]
+  cList := [['text,:middle],:cList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the objective ")
+  middle := STRCONC(middle,'"function, {\it F(x)} ")
+  middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ")
+  funcList := [['bcStrings,[55, '"X[1]", 'f, 'EM]]]
+  funcList := [['text,:middle],:funcList]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ")
+  middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ")
+  xList := 
+    "append"/[fg(i) for i in 1..n] where fg(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[8, '"0.0", xnam, 'F]]]
+  xList := [['text,:middle],:xList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:aList,:blList,:buList,:cList,:funcList,:xList,
+                  :'(
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Crash tolerance, {\it cra}: ")
+    (text . "\newline ")
+    (bcStrings (20 "0.01" cra F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Derivative level, {\it der}: ")
+    (text . "\newline ")
+    (bcStrings (5 3 der PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Feasibility tolerance, {\it fea}: ")
+    (text . "\newline ")
+    (bcStrings (20 "0.1053671201E-7" fea F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Function Precision, {\it fun}: ")
+    (text . "\newline ")
+    (bcStrings (20 "0.4373903510E-14" fun F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it r} is a Hessian matrix :")
+    (radioButtons hess
+        ("" " No" hFalse)
+        ("" " Yes" hTrue))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Infinite bound size, {\it infb}: ")
+    (text . "\newline ")
+    (bcStrings (20 "1.00E+15" infb F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Infinite step size, {\it infs}: ")
+    (text . "\newline ")
+    (bcStrings (20 "1.00E+15" infs F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Linear feasibility tolerance, {\it linf}: ")
+    (text . "\newline ")
+    (bcStrings (20 "0.1053671201E-7" linf F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Linesearch tolerance, {\it lint}: ")
+    (text . "\newline ")
+    (bcStrings (20 "0.9" lint F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "List parameters:")
+    (radioButtons list
+        ("" " No" false)
+        ("" " Yes" true))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Major iteration limit, {\it maji}: ")
+    (text . "\newline ")
+    (bcStrings (5 30 maji PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Major print level, {\it majp}: ")
+    (text . "\newline ")
+    (bcStrings (5 1 majp PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Minor iteration limit, {\it mini}: ")
+    (text . "\newline ")
+    (bcStrings (5 81 mini PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Minor print level, {\it minp}: ")
+    (text . "\newline ")
+    (bcStrings (5 0 minp PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Monitoring channel, {\it mon}. ")
+    (text . "(Ignored in Foundation Library version.) ")
+    (text . "\newline ")
+    (bcStrings (5 "-1" mon F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Nonlinear feasibiltity tolerance, {\it nonf}: ")
+    (text . "\newline ")
+    (bcStrings (20 "1.05E-08" nonf F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Optimality tolerance, {\it opt}: ")
+    (text . "\newline ")
+    (bcStrings (20 "3.26E-08" opt F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Step limit, {\it ste}: ")
+    (text . "\newline ")
+    (bcStrings (5 "2.0" ste F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Start objective check at variable, {\it stao}: ")
+    (text . "\newline ")
+    (bcStrings (5 1 stao PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Start constraint check at variable, {\it stac}: ")
+    (text . "\newline ")
+    (bcStrings (5 1 stac PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Stop objective check at variable, {\it stoo}: ")
+    (text . "\newline ")
+    (bcStrings (5 9 stoo PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Stop objective check at variable, {\it stoc}: ")
+    (text . "\newline ")
+    (bcStrings (5 9 stoc PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Verify level, {\it ver}: ")
+    (text . "\newline ")
+    (bcStrings (5 3 ver PI)))]
+  page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the elements of the array, {\it A(nrowa,n)}: "
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04ucfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'ncnln,ncnln)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'nrowj,nrowj)
+  htpSetProperty(page,'nrowr,nrowr)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'optional,optional)
+  htpSetProperty(page,'start,start)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail) ==
+  n := '4
+  optional := '0
+  start := '0
+  page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of the array {\it A(nrowa,n)}: ")
+    (text . "\newline ")
+    (bcStrings (4 "1.0" a11 F))
+    (bcStrings (4 "1.0" a12 F))
+    (bcStrings (4 "1.0" a13 F))
+    (bcStrings (4 "1.0" a14 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the lower boundary conditions {\it bl(n+nclin+ncnln)}: ")
+    (text . "\newline ")
+    (bcStrings (8 "1.0" bl1 F))
+    (bcStrings (8 "1.0" bl2 F))
+    (bcStrings (8 "1.0" bl3 F))
+    (bcStrings (8 "1.0" bl4 F))
+    (bcStrings (8 "-1.E25" bl5 F))
+    (bcStrings (8 "-1.E25" bl6 F))
+    (bcStrings (8 "25.0" bl7 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the upper boundary conditions {\it bu(n+nclin+ncnln)}: ")
+    (text . "\newline ")
+    (bcStrings (8 "5.0" bu1 F))
+    (bcStrings (8 "5.0" bu2 F))
+    (bcStrings (8 "5.0" bu3 F))
+    (bcStrings (8 "5.0" bu4 F))
+    (bcStrings (8 "20.0" bu5 F))
+    (bcStrings (8 "40.0" bu6 F))
+    (bcStrings (8 "1.E25" bu7 F))
+    -- no istate or clamda or r as default condition is cold
+    -- what about cjac when der = 3 ?
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the nonlinear constraint functions, {\it c(ncnln)} ")
+    (text . "in terms of X[1]...X[n]: ")
+    (text . "\newline ")	
+    (bcStrings (55 "X[1]**2 + X[2]**2 + X[3]**2 + X[4]**2" cx1 EM))
+    (text . "\newline ")	
+    (bcStrings (55 "X[1]*X[2]*X[3]*X[4]" cx2 EM))
+    (text . "\newline ")	
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the objective function, {\it F(x)} ")
+    (text . "in terms of X[1]...X[n]: ")
+    (text . "\newline ")	
+    (bcStrings (55 "X[1]*X[4]*(X[1] + X[2] + X[3]) + X[3]" of  EM))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline")
+    (bcStrings (8 "1.0" x1 F))
+    (bcStrings (8 "5.0" x2 F))
+    (bcStrings (8 "5.0" x3 F))
+    (bcStrings (8 "1.0" x4 F)))
+  htMakeDoneButton('"Continue",'e04ucfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nclin,nclin)
+  htpSetProperty(page,'ncnln,ncnln)
+  htpSetProperty(page,'nrowa,nrowa)
+  htpSetProperty(page,'nrowj,nrowj)
+  htpSetProperty(page,'nrowr,nrowr)
+  htpSetProperty(page,'liwork,liwork)
+  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'start,start)
+  htpSetProperty(page,'optional,optional)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+e04ucfGen htPage ==
+  n := htpProperty(htPage,'n)
+  nclin := htpProperty(htPage,'nclin)
+  ncnln := htpProperty(htPage,'ncnln)
+  nrowa := htpProperty(htPage,'nrowa)
+  nrowj := htpProperty(htPage,'nrowj)
+  nrowr := htpProperty(htPage,'nrowr)
+  liwork := htpProperty(htPage,'liwork)
+  lwork := htpProperty(htPage,'lwork)
+  optional := htpProperty(htPage,'optional)
+  start := htpProperty(htPage,'start)
+  ifail := htpProperty(htPage,'ifail)
+  sta := 'false -- no warm start in HD
+  alist := htpInputAreaAlist htPage
+  y := alist
+  if (optional = '0) then
+    cra := '"0.01"
+    der := 3
+    fea := '"0.1053671201E-7"
+    fun := '"0.4373903510E-14"
+    hes := 'true
+    infb := '"1.00E+15"
+    infs := '"1.00E+15"
+    linf := '"0.1053671201E-7"
+    lint := '"0.9"
+    lis := 'true
+    maji := 30
+    majp := 1
+    mini := 81
+    minp := 0
+    mon := '"-1"
+    nonf := '"1.05E-08"
+    opt := '"3.26E-08"
+    ste := '"2.0"
+    stao := 1
+    stac := 1
+    stoo := n
+    stoc := n
+    ver := 3
+    for i in 1..n repeat
+      temp := STRCONC ((first y).1," ")
+      xlist := [temp,:xlist]	
+      y := rest y
+    xstring := bcwords2liststring xlist
+    f := (first y).1
+    y := rest y
+    for i in 1..ncnln repeat
+      temp := STRCONC ((first y).1," ")
+      cxlist := [temp,:cxlist]	
+      y := rest y
+    cxstring := bcwords2liststring cxlist
+    for i in 1..(n+nclin+ncnln) repeat
+      temp := STRCONC ((first y).1," ")
+      bulist := [temp,:bulist]	
+      y := rest y
+    buu := bcwords2liststring bulist
+    for i in 1..(n+nclin+ncnln) repeat
+      temp := STRCONC ((first y).1," ")
+      bllist := [temp,:bllist]	
+      y := rest y
+    bll := bcwords2liststring bllist
+    for i in 1..nrowa repeat -- matrix A
+      for j in 1..n repeat
+        a := STRCONC((first y).1," ")
+        arrlist := [a,:arrlist]
+        y := rest y
+      amatlist := [:amatlist,arrlist]
+      arrlist := []
+    amatlist := reverse amatlist 
+    amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist]  
+  else
+    ver := STRCONC((first y).1," ")
+    y := rest y
+    stoc := STRCONC((first y).1," ")
+    y := rest y
+    stoo := STRCONC((first y).1," ")
+    y := rest y
+    stac := STRCONC((first y).1," ")
+    y := rest y
+    stao := STRCONC((first y).1," ")
+    y := rest y
+    ste := STRCONC((first y).1," ")
+    y := rest y
+    opt := STRCONC((first y).1," ")
+    y := rest y
+    nonf := STRCONC((first y).1," ")
+    y := rest y
+    mon := STRCONC((first y).1," ")
+    y := rest y
+    minp := STRCONC((first y).1," ")
+    y := rest y
+    mini := STRCONC((first y).1," ")
+    y := rest y
+    majp := STRCONC((first y).1," ")
+    y := rest y
+    maji := STRCONC((first y).1," ")
+    y := rest y
+    nolist := (first y).1
+    lis := 
+      nolist = '" nil" => '"false"
+      '"true"
+    y := rest y
+    dummy1 := first y
+    y := rest y
+    lint := STRCONC((first y).1," ")
+    y := rest y
+    linf := STRCONC((first y).1," ")
+    y := rest y
+    infs := STRCONC((first y).1," ")
+    y := rest y
+    infb := STRCONC((first y).1," ")
+    y := rest y
+    noHess := (first y).1
+    hes :=
+      noHess = '" nil" => '"false"
+      '"true"
+    y := rest y
+    dummy2 := first y
+    y := rest y
+    fun := STRCONC((first y).1," ")
+    y := rest y
+    fea := STRCONC((first y).1," ")
+    y := rest y
+    der := STRCONC((first y).1," ")
+    y := rest y
+    cra := STRCONC((first y).1," ")
+    y := rest y
+    for i in 1..n repeat
+      temp := STRCONC ((first y).1," ")
+      xlist := [temp,:xlist]	
+      y := rest y
+    xstring := bcwords2liststring xlist
+    f := (first y).1
+    y := rest y
+    for i in 1..ncnln repeat
+      temp := STRCONC ((first y).1," ")
+      cxlist := [temp,:cxlist]	
+      y := rest y
+    cxstring := bcwords2liststring cxlist
+    for i in 1..(n+nclin+ncnln) repeat
+      temp := STRCONC ((first y).1," ")
+      bulist := [temp,:bulist]	
+      y := rest y
+    buu := bcwords2liststring bulist
+    for i in 1..(n+nclin+ncnln) repeat
+      temp := STRCONC ((first y).1," ")
+      bllist := [temp,:bllist]	
+      y := rest y
+    bll := bcwords2liststring bllist
+    for i in 1..nrowa repeat -- matrix A
+      for j in 1..n repeat
+        a := STRCONC((first y).1," ")
+        arrlist := [a,:arrlist]
+        y := rest y
+      amatlist := [:amatlist,arrlist]
+      arrlist := []
+    amatlist := reverse amatlist 
+    amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist]  
+  ntotl := n + nclin + ncnln
+  prefix := STRCONC("e04ucf(",STRINGIMAGE n,", ",STRINGIMAGE nclin,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ncnln,", ",STRINGIMAGE nrowa,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrowj,", ",STRINGIMAGE nrowr,", ")
+  prefix:= STRCONC(prefix,amatstr,",[",bll,"],[",buu,"],",STRINGIMAGE liwork)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE lwork,", ",STRINGIMAGE sta,", ")
+  prefix := STRCONC(prefix,cra,", ",STRINGIMAGE der,", ",fea,", ")
+  prefix := STRCONC(prefix,fun,", ",hes,", ",infb,", ",infs,", ",linf,", ")
+  prefix := STRCONC(prefix,lint,", ",lis,", ",STRINGIMAGE maji,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE majp,", ",STRINGIMAGE mini,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE minp,", ",mon,", ",nonf,", ",opt,", ")
+  prefix := STRCONC(prefix,ste,", ",STRINGIMAGE stao,", ",STRINGIMAGE stac)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE stoo,", ",STRINGIMAGE stoc,", ")
+  middle:= STRCONC(STRINGIMAGE ver,",[[0 for i in 1..",STRINGIMAGE ntotl,"]]")
+  middle:=STRCONC(middle,"::Matrix Integer,[[0.0 for i in 1..",STRINGIMAGE n)
+  middle:=STRCONC(middle,"] for j in 1..",STRINGIMAGE nrowj,"],[[0.0 for i in 1..")
+  middle := STRCONC(middle,STRINGIMAGE ntotl,"]],[[0.0 for i in 1..")
+  middle := STRCONC(middle,STRINGIMAGE n,"] for j in 1..",STRINGIMAGE nrowr)
+  middle := STRCONC(middle,"],[",xstring,"],",STRINGIMAGE ifail)
+  end:=STRCONC(",((",cxstring,")::Vector Expression(Float))::ASP55(CONFUN),")
+  end := STRCONC(end,"((",f,")::Expression(Float))::ASP49(OBJFUN))")
+  linkGen STRCONC(prefix,middle,end)
+
+
+e04ucfCopOut() ==
+  htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil)  
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\blankline ")
+    (text . "{\center{\em Hyperdoc interface not available for warm start}}")
+    (text . "\newline ")
+    (text . "{\center{\em Please use the command line.}}"))
+  htMakeDoneButton('"Continue",'e04ucf)
+  htShowPage()
+
+e04ycf() ==
+  htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil)
+  htMakePage '(
+    (domainConditions 
+  	(isDomain EM $EmptyMode)
+        (isDomain PI (PositiveInteger))
+        (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXe04ycf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ycf| '|NagOptimisationPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "E04YCF returns estimates of elements of the variance-covariance ")
+    (text . "matrix of the estimated regression coefficients for a nonlinear ")
+    (text . "least-squares problem. ")
+    (text . "\blankline ")
+    (text . "This routine may be used following any of the nonlinear ")
+    (text . "least-squares routines E04FDF, E04GCF. It ")
+    (text . "requires the parameters {\it fumsq, s} and {\it v} supplied ")
+    (text . "by those routines. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Elements of {\it c} returned, {\it job}: ")
+    (radioButtons job
+        (" 0" " The diagonal elements of {\it c} " jZero)
+        (" 1" " Elements of column {\it job} of {\it c} " jOne)
+        (" -1" " The whole {\it n} by {\it n} symmetric matrix " jMinus))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of observations, {\it m}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 15 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of variables, {\it n}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 3 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Sum of the squares of the residuals, {\it fsumsq}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (30 "0.0082148773065789729" fsumsq F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "First dimension of array {\it v}, {\it lv}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (6 3 lv PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'e04ycfSolve)
+  htShowPage()
+
+e04ycfSolve htPage ==
+  temp := htpButtonValue(htPage,'job)
+  job :=
+    temp = 'jMinus => '-1
+    temp = 'jOne => '1
+    '0
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fsumsq := htpLabelInputString(htPage, 'fsumsq)
+  lv :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lv)
+    objValUnwrap htpLabelSpadValue(htPage, 'lv)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = 3 and lv = 3) => e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail)
+  sList := 
+    "append"/[fa(i) for i in 1..(n)] where fa(i) ==
+      snam := INTERN STRCONC ('"s",STRINGIMAGE i)
+      [['bcStrings,[30, '"0.0", snam, 'F]]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements ")
+  middle := STRCONC(middle,'"of array {\it v(lv,n)}: \newline ")
+  vList := 
+    "append"/[fb(i,n) for i in 1..lv] where fb(i,n) ==
+       labelList := 
+         "append"/[fc(i,j) for j in 1..n] where fc(i,j) ==
+            vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[15, 0, vnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  vList := [['text,:middle],:vList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain EM $EmptyMode)
+          (isDomain F (Float))
+            (isDomain I (Integer))),
+ 		:sList,:vList]
+  page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the elements of the array {\it s(n)}: \newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'e04ycfGen)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'fsumsq,fsumsq)
+  htpSetProperty(page,'lv,lv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail) ==
+  n := '3
+  lv := '3
+  page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of array {\it s(n)}: \newline ")
+    (bcStrings (30 "4.0965034571419325" s1 F))
+    (bcStrings (30 "1.5949579400198182" s2 F))
+    (bcStrings (30 "0.061258491120317927" s3 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the elements of array {\it v(lv,n)}: \newline ")
+    -- not the correct values yet !
+    (bcStrings (8 "0.9354" v11 F))
+    (bcStrings (8 "-0.2592" v12 F))
+    (bcStrings (8 "-0.2405" v13 F))
+    (text . "\newline ")
+    (bcStrings (8 "0.3530" v21 F))
+    (bcStrings (8 "0.6432" v22 F))
+    (bcStrings (8 "0.6795" v23 F))
+    (text . "\newline ")
+    (bcStrings (8 "-0.0215" v31 F))
+    (bcStrings (8 "-0.7205" v32 F))
+    (bcStrings (8 "0.6932" v33 F)))
+  htMakeDoneButton('"Continue",'e04ycfGen)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'fsumsq,fsumsq)
+  htpSetProperty(page,'lv,lv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+e04ycfGen htPage ==
+  job := htpProperty(htPage,'job)
+  n := htpProperty(htPage, 'n)
+  m := htpProperty(htPage, 'm)
+  fsumsq := htpProperty(htPage, 'fsumsq)
+  lv := htpProperty(htPage, 'lv)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..(lv*n) repeat
+    temp := STRCONC ((first y).1," ")
+    vlist := [temp,:vlist]	
+    y := rest y
+  vstring := bcwords2liststring vlist    
+  for i in 1..n repeat
+    temp := STRCONC ((first y).1," ")
+    slist := [temp,:slist]	
+    y := rest y
+  sstring := bcwords2liststring slist    
+  prefix := STRCONC("e04ycf(",STRINGIMAGE job,",", STRINGIMAGE m,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,",",fsumsq,", [")
+  prefix := STRCONC(prefix,sstring,"],", STRINGIMAGE lv,",[",vstring)
+  linkGen STRCONC(prefix,"],",STRINGIMAGE ifail,")")
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-f01.boot.pamphlet b/src/interp/nag-f01.boot.pamphlet
new file mode 100644
index 00000000..0fa5c044
--- /dev/null
+++ b/src/interp/nag-f01.boot.pamphlet
@@ -0,0 +1,2252 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-f01.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+f01brf() ==
+  htInitPage("F01BRF - LU factorization of real sparse matrix",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf01brf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01brf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Factorizes a real sparse matrix A of order n. The routine forms ")
+    (text . "the {\it LU} factorization of the entire matrix, or ,")
+    (text . "optionally, first permutes the matrix to block lower ")
+    (text . "triangular form and then only factorizes the diagonal block. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the order {\em n} of the matrix A ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (8 6 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of non-zero elements {\it nz}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "{\it pivot}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 15 nz PI))
+    (text . "\tab{34} ")
+    (bcStrings (8 "0.1" pivot PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of A & ICN {\it licn}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Dimension of IRN {\it lirn}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 150 licn PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 75 lirn PI))
+    (text . "\blankline")
+    (text . "\menuitemstyle{}\tab{2} Grow value:")
+    (radioButtons grow
+	("" "  True" gr_true)
+        ("" "  False" gr_false))
+    (text . "\blankline")
+    (text . "\menuitemstyle{}\tab{2} Lblock value:")
+    (radioButtons lblock
+	("" "  True" lb_true)
+        ("" "  False" lb_false))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail is input in three components: ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it a} ")
+    (radioButtons afail
+        ("" "  0, hard failure" azero)
+        ("" "  1, soft failure" aone))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it b} ")
+    (radioButtons bfail
+        ("" "  1, print error messages" bone)
+        ("" "  0, suppress error messages" bzero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it c} ")
+    (radioButtons cfail
+        ("" "  1, print warning messages" cone)
+        ("" "  0, suppress warning messages" czero)))
+  htMakeDoneButton('"Continue", 'f01brfSolve)
+  htShowPage()
+
+f01brfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nz :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz)
+    objValUnwrap htpLabelSpadValue(htPage, 'nz)
+  licn :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn)
+    objValUnwrap htpLabelSpadValue(htPage, 'licn)
+  lirn :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn)
+    objValUnwrap htpLabelSpadValue(htPage, 'lirn)
+  pivot := htpLabelInputString(htPage, 'pivot)
+  gr := htpButtonValue(htPage,'grow)
+  grow :=
+    gr = 'gr_true => '"true"
+    '"false"
+  lb := htpButtonValue(htPage,'lblock)
+  lblock :=
+    lb = 'lb_true => '"true"
+    '"false"
+  aerror := htpButtonValue(htPage,'afail)
+  afail :=
+    aerror = 'azero => '0
+    '1
+  berror := htpButtonValue(htPage,'bfail)
+  bfail :=
+    berror = 'bone => '1
+    '0
+  cerror := htpButtonValue(htPage,'cfail)
+  cfail :=
+    cerror = 'cone => '1
+    '0
+  ifail := 100*cfail + 10*bfail + afail
+  ((n = '6 and nz = '15) and (licn = '150 and lirn = '75))
+		=> f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..nz] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      mid := ('"\tab{32} ")
+      rnam := INTERN STRCONC ('"irn",STRINGIMAGE i)
+      end := ('"\tab{42} ")
+      cnam := INTERN STRCONC ('"icn",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]],
+        ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]],
+         ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]]
+  abortList :=
+    [['bcStrings,[6, '"true", 'abortone, 'EM]],
+      ['bcStrings,[6, '"true", 'aborttwo, 'EM]],
+        ['bcStrings,[6, '"false", 'abortthree, 'EM]],
+          ['bcStrings,[6, '"true", 'abortfour, 'EM]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ")
+  abortList := [['text,:prefix],:abortList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain EM (EmptyMode))
+           (isDomain F (Float))
+            (isDomain PI (PositiveInteger))),
+	     :labelList,:abortList]
+  page :=  htInitPage("F01BRF - LU factorization of real sparse matrix",nil)
+  htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: "
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: "
+  htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01brfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nz,nz)
+  htpSetProperty(page,'licn,licn)
+  htpSetProperty(page,'lirn,lirn)
+  htpSetProperty(page,'pivot,pivot)
+  htpSetProperty(page,'grow,grow)
+  htpSetProperty(page,'lblock,lblock)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) ==
+  n := '6
+  nz := '15
+  licn := '150
+  lirn := '75
+  page :=  htInitPage("F01BRF - LU factorization of real sparse matrix",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ")
+    (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "5.0" a1 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 1 irn1 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 1 icn1 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "2.0" a2 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn2 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 2 icn2 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0" a3 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn3 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 3 icn3 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "2.0" a4 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn4 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 4 icn4 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "3.0" a5 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 3 irn5 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 3 icn5 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-2.0" a6 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 4 irn6 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 1 icn6 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a7 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 4 irn7 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 4 icn7 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a8 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 4 irn8 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 5 icn8 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0" a9 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn9 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 1 icn9 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0" a10 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn10 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 4 icn10 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "2.0" a11 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn11 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 5 icn11 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-3.0" a12 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn12 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 6 icn12 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0" a13 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn13 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 1 icn13 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-1.0" a14 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn14 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 2 icn14 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "6.0" a15 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn15 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 6 icn15 PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} Abort :")
+    (bcStrings (8 "true" abort_one EM))
+    (bcStrings (8 "true" abort_two EM))
+    (bcStrings (8 "false" abort_three EM))
+    (bcStrings (8 "true" abort_four EM)))
+  htMakeDoneButton('"Continue",'f01brfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nz,nz)
+  htpSetProperty(page,'licn,licn)
+  htpSetProperty(page,'lirn,lirn)
+  htpSetProperty(page,'pivot,pivot)
+  htpSetProperty(page,'grow,grow)
+  htpSetProperty(page,'lblock,lblock)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01brfGen htPage ==
+  n := htpProperty(htPage,'n)
+  nz := htpProperty(htPage,'nz)
+  licn := htpProperty(htPage,'licn)
+  lirn := htpProperty(htPage,'lirn)
+  pivot := htpProperty(htPage,'pivot)
+  grow := htpProperty(htPage,'grow)
+  lblock := htpProperty(htPage,'lblock)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..4 repeat
+    abort := STRCONC((first y).1," ")
+    y := rest y
+    abortList := [abort,:abortList]
+  astring := bcwords2liststring abortList
+  while y repeat
+    end := STRCONC ((first y).1," ")
+    y := rest y
+    mid := STRCONC ((first y).1," ")
+    y := rest y
+    top := STRCONC ((first y).1," ")
+    y := rest y
+    cList := [end,:cList]
+    rList := [mid,:rList]
+    matList := [top,:matList]
+  for i in 1..(licn-nz) repeat
+    cList := [:cList,'"0 "]
+    matList := [:matList,'"0 "]
+  for i in 1..(lirn-nz) repeat
+    rList := [:rList,'"0 "]
+  cstring := bcwords2liststring cList
+  rstring := bcwords2liststring rList
+  matstring := bcwords2liststring matList
+  prefix := STRCONC('"f01brf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ",pivot)
+  prefix := STRCONC(prefix,", ",lblock,", ",grow,", ",astring,",[",matstring)
+  prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+f01bsf() ==
+  htInitPage("F01BSF - LU factorization of real sparse matrix with known sparsity pattern",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf01bsf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01bsf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Factorizes a real sparse matrix A of order n using the pivotal ")
+    (text . "sequence previously obtained by F01BRF when a matrix of the ")
+    (text . "same sparsity pattern was factorized. ")
+    (text . "\blankline ")
+    (text . "Read the input file to see the example program. ")
+    (text . "\spadpaste{)read f01bsf \bound{s0}} ")
+    (text . "\blankline")
+    (text . "\newline "))
+  htShowPage()
+
+f01maf() ==
+  htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf01maf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01maf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes an incomplete Cholesky factorization of a real ")
+    (text . "sparse symmetric positive-definite matrix A of order n. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the order {\em n} of the matrix A ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (8 16 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of non-zero elements {\it nz}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (8 40 nz PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Dimension of A & ICN {\it licn}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Dimension of IRN {\it lirn}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 90 licn PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 50 lirn PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Tolerance {\it droptl}: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "{\it densw}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.1" droptl F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "0.8" densw F))
+    (text . "\blankline ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail is input in three components: ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it a} ")
+    (radioButtons afail
+        ("" "  0, hard failure" azero)
+        ("" "  1, soft failure" aone))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it b} ")
+    (radioButtons bfail
+        ("" "  1, print error messages" bone)
+        ("" "  0, suppress error messages" bzero))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "{\it c} ")
+    (radioButtons cfail
+        ("" "  1, print warning messages" cone)
+        ("" "  0, suppress warning messages" czero)))
+  htMakeDoneButton('"Continue", 'f01mafSolve)
+  htShowPage()
+
+f01mafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nz :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz)
+    objValUnwrap htpLabelSpadValue(htPage, 'nz)
+  licn :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn)
+    objValUnwrap htpLabelSpadValue(htPage, 'licn)
+  lirn :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn)
+    objValUnwrap htpLabelSpadValue(htPage, 'lirn)
+  aerror := htpButtonValue(htPage,'afail)
+  afail :=
+    aerror = 'azero => '0
+    '1
+  berror := htpButtonValue(htPage,'bfail)
+  bfail :=
+    berror = 'bone => '1
+    '0
+  cerror := htpButtonValue(htPage,'cfail)
+  cfail :=
+    cerror = 'cone => '1
+    '0
+  ifail := 100*cfail + 10*bfail + afail
+  droptl := htpLabelInputString(htPage, 'droptl)
+  densw := htpLabelInputString(htPage, 'densw)
+  ((n = '16 and nz = '40) and (licn = '90 and lirn = '50))
+		=> f01mafDefaultSolve(htPage,droptl,densw,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..nz] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      anam := INTERN STRCONC ('"a",STRINGIMAGE i)
+      mid := ('"\tab{32} ")
+      rnam := INTERN STRCONC ('"irn",STRINGIMAGE i)
+      end := ('"\tab{42} ")
+      cnam := INTERN STRCONC ('"icn",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]],
+        ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]],
+         ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]]
+  abortList :=
+    [['bcStrings,[6, '"true", 'abortone, 'EM]],
+      ['bcStrings,[6, '"true", 'aborttwo, 'EM]],
+        ['bcStrings,[6, '"true", 'abortthree, 'EM]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ")
+  abortList := [['text,:prefix],:abortList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain EM (EmptyMode))
+           (isDomain F (Float))
+            (isDomain PI (PositiveInteger))),
+	     :labelList,:abortList]
+  page :=  htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil)
+  htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: "
+  htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: "
+  htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01mafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nz,nz)
+  htpSetProperty(page,'licn,licn)
+  htpSetProperty(page,'lirn,lirn)
+  htpSetProperty(page,'droptl,droptl)
+  htpSetProperty(page,'densw,densw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01mafDefaultSolve(htPage,droptl,densw,ifail) ==
+  n := '16
+  nz := '40
+  licn := '90
+  lirn := '50
+  page :=  htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ")
+    (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ")
+    (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a1 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 1 irn1 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 1 icn1 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a2 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn2 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 2 icn2 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a3 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 3 irn3 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 3 icn3 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a4 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 4 irn4 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 4 icn4 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a5 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn5 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 5 icn5 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a6 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn6 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 6 icn6 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a7 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 7 irn7 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 7 icn7 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a8 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 8 irn8 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 8 icn8 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a9 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 9 irn9 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 9 icn9 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a10 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 10 irn10 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 10 icn10 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a11 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 11 irn11 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 11 icn11 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a12 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 12 irn12 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 12 icn12 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a13 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 13 irn13 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 13 icn13 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a14 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 14 irn14 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 14 icn14 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a15 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 15 irn15 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 15 icn15 PI))
+    (text . "\blankline ")
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "1.0" a16 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 16 irn16 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 16 icn16 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a17 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 1 irn17 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 2 icn17 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a18 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn18 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 3 icn18 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a19 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 3 irn19 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 4 icn19 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a20 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn20 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 6 icn20 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a21 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn21 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 7 icn21 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a22 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 7 irn22 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 8 icn22 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a23 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 9 irn23 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 10 icn23 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a24 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 10 irn24 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 11 icn24 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a25 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 11 irn25 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 12 icn25 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a26 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 13 irn26 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 14 icn26 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a27 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 14 irn27 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 15 icn27 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a28 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 15 irn28 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 16 icn28 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a29 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 1 irn29 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 5 icn29 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a30 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 2 irn30 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 6 icn30 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a31 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 3 irn31 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 7 icn31 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a32 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 4 irn32 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 8 icn32 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a33 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 5 irn33 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 9 icn33 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a34 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 6 irn34 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 10 icn34 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a35 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 7 irn35 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 11 icn35 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a36 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 8 irn36 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 12 icn36 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a37 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 9 irn37 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 13 icn37 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a38 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 10 irn38 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 14 icn38 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a39 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 11 irn39 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 15 icn39 PI))
+    (text . "\newline \tab{2}")
+    (bcStrings (8 "-0.25" a40 F)) 
+    (text . "\tab{32} ")  
+    (bcStrings (4 12 irn40 PI))
+    (text . "\tab{42} ")
+    (bcStrings (4 16 icn40 PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{} \tab{2} Abort :")
+    (bcStrings (8 "true" abort_one EM))
+    (bcStrings (8 "true" abort_two EM))
+    (bcStrings (8 "true" abort_three EM)))
+  htMakeDoneButton('"Continue",'f01mafGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nz,nz)
+  htpSetProperty(page,'licn,licn)
+  htpSetProperty(page,'lirn,lirn)
+  htpSetProperty(page,'droptl,droptl)
+  htpSetProperty(page,'densw,densw)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01mafGen htPage ==
+  n := htpProperty(htPage,'n)
+  nz := htpProperty(htPage,'nz)
+  licn := htpProperty(htPage,'licn)
+  lirn := htpProperty(htPage,'lirn)
+  droptl := htpProperty(htPage,'droptl)
+  densw := htpProperty(htPage,'densw)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..3 repeat
+    abort := STRCONC((first y).1," ")
+    y := rest y
+    abortList := [abort,:abortList]
+  astring := bcwords2liststring abortList
+  while y repeat
+    end := STRCONC ((first y).1," ")
+    y := rest y
+    mid := STRCONC ((first y).1," ")
+    y := rest y
+    top := STRCONC ((first y).1," ")
+    y := rest y
+    cList := [end,:cList]
+    rList := [mid,:rList]
+    matList := [top,:matList]
+  for i in 1..(licn-nz) repeat
+    cList := [:cList,'"0 "]
+    matList := [:matList,'"0 "]
+  for i in 1..(lirn-nz) repeat
+    rList := [:rList,'"0 "]
+  cstring := bcwords2liststring cList
+  rstring := bcwords2liststring rList
+  matstring := bcwords2liststring matList
+  prefix := STRCONC('"f01maf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ")
+  prefix := STRCONC(prefix,astring,",[",matstring)
+  prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ",droptl,", ",densw)
+  linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")")
+
+
+
+
+f01mcf() ==
+  htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf01mcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01mcf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the Cholesky factorization of a real symmetric positive")
+    (text . "-definite variable-bandwidth matrix {\it A} or order {\it n}. ")
+    (text . "That is, {\it A = }\htbitmap{ldlt}, where {\it L} is ")
+    (text . "a unit lower triangular matrix and {\it D} is a diagonal matrix.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the order {\em n} of the matrix A ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 6 n PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Enter the number of elements: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 14 lal PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01mcfSolve)
+  htShowPage()
+
+f01mcfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lal :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal)
+    objValUnwrap htpLabelSpadValue(htPage, 'lal)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and lal = '14) => f01mcfDefaultSolve(htPage,ifail)
+  labelList :=
+    "append"/[f(i) for i in 1..lal] where f(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[6, 0.0, xnam, 'F]]]
+  nrowList :=
+    "append"/[g(j) for j in 1..n] where g(j) ==
+      nam := INTERN STRCONC ('"n",STRINGIMAGE j) 
+      [['bcStrings,[6, 0, nam, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ")
+  prefix := STRCONC(prefix,"of the ith row of A: \newline \tab{2} ")
+  nrowList := [['text,:prefix],:nrowList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:nrowList]
+  page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil)
+  htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by row "
+  htSay '"order: \newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01mcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'lal,lal)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01mcfDefaultSolve  (htPage,ifail) ==
+  n := '6
+  lal := '14
+  page :=   htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by ")
+    (text . "row order: ") 
+    (text . "\newline ")
+    (bcStrings (6 "1.0" x1 F))
+    (bcStrings (6 "2.0" x2 F))
+    (bcStrings (6 "5.0" x3 F))
+    (bcStrings (6 "3.0" x4 F))
+    (bcStrings (6 "13.0" x5 F))
+    (bcStrings (6 "16.0" x6 F))
+    (bcStrings (6 "5.0" x7 F))
+    (bcStrings (6 "14.0" x8 F))
+    (bcStrings (6 "18.0" x9 F))
+    (bcStrings (6 "8.0" x10 F))
+    (bcStrings (6 "55.0" x11 F))
+    (bcStrings (6 "24.0" x12 F))
+    (bcStrings (6 "17.0" x13 F))
+    (bcStrings (6 "77.0" x14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ")
+    (text . "of A: ") 
+    (text . "\newline ")
+    (bcStrings (6 1 n1 PI))
+    (bcStrings (6 2 n2 PI))
+    (bcStrings (6 2 n3 PI))
+    (bcStrings (6 1 n4 PI))
+    (bcStrings (6 5 n5 PI))
+    (bcStrings (6 3 n6 PI))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01mcfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'lal,lal)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01mcfGen htPage ==
+  n := htpProperty(htPage,'n)
+  lal := htpProperty(htPage,'lal)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    nrowList := [right,:nrowList]
+  nrowstring := bcwords2liststring nrowList
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    matList := [right,:matList]
+  matstring := bcwords2liststring matList
+  prefix := STRCONC('"f01mcf(",STRINGIMAGE n,", [",matstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE lal,", [",nrowstring,"], ")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+
+f01qcf() ==
+  htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01qcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qcf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Finds the QR factorization of a real {\it m} by {it n} ({\it m ")
+    (text . "\htbitmap{great=} n}) matrix {\it A}, which ")
+    (text . "is factorized as \htbitmap{f01qcf}, ")
+    (text . "where {\it m > n} and {\it A = QR } when {\it m = n }, where ")
+    (text . "{\it Q} is an {\it m} by {\it m } orthogonal matrix and {\it R} ")
+    (text . "is an {\it n} by {\it n} upper triangular matrix. The {\it k}th ")
+    (text . "transformation matrix,{\it Qk}, ")
+    (text . "which is used to introduce zeros into the {\it k}th column of ")
+    (text . "{\it A}, is given in the form ")
+    (text . "\htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01qcf2}, ")
+    (text . "\htbitmap{f01qcf3},  ")
+    (text . "\htbitmap{zetak} is a scalar and ")
+    (text . "\htbitmap{zk} is an (m-k) element vector. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01qcfSolve)
+  htShowPage()
+
+f01qcfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '5 and n = '3)  => f01qcfDefaultSolve(htPage,lda,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..lda] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage("F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01qcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01qcfDefaultSolve  (htPage,lda,ifail) == 
+  n := '3
+  m := '5
+  page := htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a11 F))
+    (bcStrings (6 "2.5" a12 F))
+    (bcStrings (6 "2.5" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a21 F))
+    (bcStrings (6 "2.5" a22 F))
+    (bcStrings (6 "2.5" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.6" a31 F))
+    (bcStrings (6 "-0.4" a32 F))
+    (bcStrings (6 "2.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a41 F))
+    (bcStrings (6 "-0.5" a42 F))
+    (bcStrings (6 "0.5" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.2" a51 F))
+    (bcStrings (6 "-0.3" a52 F))
+    (bcStrings (6 "-2.9" a53 F)))
+  htMakeDoneButton('"Continue",'f01qcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01qcfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+  lda := m
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f01qcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f01qdf() ==
+  htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01qdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qdf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Performs one of the transformations {\it B = QB or B = }")
+    (text . "\htbitmap{f01qdf}, where {\it B} is a real {\it m} ")
+    (text . "by {\it ncolb} matrix and {\it Q} is an {\it m} by {\it m} ")
+    (text . "orthogonal matrix assumed to be given by {\it Q = }")
+    (text . "\htbitmap{f01qdf1}, \htbitmap{f01qdf2} ")
+    (text . "being given in the form ")
+    (text . "\htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01qcf2}, ")
+    (text . "\htbitmap{f01qcf3},  ")
+    (text . "\htbitmap{zetak} is a scalar and ")
+    (text . "\htbitmap{zk} is an (m-k) element vector. ")
+    (text . "The routine is intended for use following F01QCF or F01QFF. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of B, {\it ldb} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 5 ldb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Number of columns of matrix B {\it ncolb}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 2 ncolb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Transformation to be performed: ")
+    (radioButtons trans
+        (" " "  {\it B = QB}" no_trans)
+        (" " "  {\it B =} \htbitmap{f01qdf}" trans))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Where the elements can be found: ")
+    (radioButtons wheret
+        (" " "  the elements of \zeta are in A" in_a)
+        (" " "  the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" seperate))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01qdfSolve)
+  htShowPage()
+
+f01qdfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  ncolb :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolb)
+  operation := htpButtonValue(htPage,'trans)
+  trans :=
+    operation = 'no_trans => '"n"
+    '"t"
+  elements := htpButtonValue(htPage,'wheret)
+  wheret :=
+    elements = 'in_a => '"i"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolb = '2)  => f01qdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bList :=
+    "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) ==
+       labelList := 
+	 "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  zList :=
+    "append"/[fz(i) for i in 1..n] where fz(i) ==
+       znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+       [['bcStrings,[6, "0.0", znam, 'F]]]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ")
+  prefix := STRCONC(prefix,"(if required): \newline \tab{2}")
+  zList := [['text,:prefix],:zList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bList,:zList]
+  page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01qdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01qdfDefaultSolve  (htPage,lda,ldb,trans,wheret,ifail) == 
+  n := '3
+  m := '5
+  ncolb := '2
+  page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a11 F))
+    (bcStrings (6 "2.5" a12 F))
+    (bcStrings (6 "2.5" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a21 F))
+    (bcStrings (6 "2.5" a22 F))
+    (bcStrings (6 "2.5" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.6" a31 F))
+    (bcStrings (6 "-0.4" a32 F))
+    (bcStrings (6 "2.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a41 F))
+    (bcStrings (6 "-0.5" a42 F))
+    (bcStrings (6 "0.5" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.2" a51 F))
+    (bcStrings (6 "-0.3" a52 F))
+    (bcStrings (6 "-2.9" a53 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.1" b11 F))
+    (bcStrings (6 "0.0" b12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.9" b21 F))
+    (bcStrings (6 "0.0" b22 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.6" b31 F))
+    (bcStrings (6 "1.32" b32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b41 F))
+    (bcStrings (6 "1.1" b42 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-0.8" b51 F))
+    (bcStrings (6 "-0.26" b52 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \zeta (if required): ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" z1 F))
+    (bcStrings (10 "0.0" z2 F))
+    (bcStrings (10 "0.0" z3 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01qdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01qdfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+--  ldb := htpProperty(htPage,'ldb)
+  lda := m
+  ldb := m
+  ncolb := htpProperty(htPage,'ncolb)
+  trans := htpProperty(htPage,'trans)
+  wheret := htpProperty(htPage,'wheret)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    zetalist := [left,:zetalist]
+  zetastring := bcwords2liststring zetalist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  for i in 1..ldb repeat
+    for j in 1..ncolb repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f01qdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda)
+  prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+f01qef() ==
+  htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01qef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qef| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns the first {\it ncolq} columns of the real {\it m} by ")
+    (text . "{\it n} orthogonal matrix {\it Q}, where {\it Q} is assumed ")
+    (text . "to be given by {\it Q = }\htbitmap{f01qdf1}, ")
+    (text . "\htbitmap{f01qdf2} being given in the form ")
+    (text . "\htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01qcf2}, ")
+    (text . "\htbitmap{f01qcf3},  ")
+    (text . "\htbitmap{zetak} is a scalar and ")
+    (text . "\htbitmap{zk} is an (m-k) element vector. ")
+    (text . "The routine is intended for use following F01QCF or F01QFF. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Number columns of matrix Q {\it ncolq}: ")
+    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+--    (text . "\tab{34} ")
+    (bcStrings (6 5 ncolq PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Where the elements can be found: ")
+    (radioButtons wheret
+        (" " "  the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" subsequent)
+        (" " "  the elements of \zeta are in A" initial))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01qefSolve)
+  htShowPage()
+
+f01qefSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ncolq :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolq)
+  elements := htpButtonValue(htPage,'wheret)
+  wheret :=
+    elements = 'initial => '"i"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolq = '5)  => f01qefDefaultSolve(htPage,lda,wheret,ifail)
+  matList :=
+    "append"/[fa(i,ncolq) for i in 1..lda] where fa(i,ncolq) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..ncolq] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[7, "0.0", anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  zList :=
+    "append"/[fz(i) for i in 1..n] where fz(i) ==
+       znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+       [['bcStrings,[7, "0.0", znam, 'F]]]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ")
+  prefix := STRCONC(prefix,"(if required): \newline ")
+  zList := [['text,:prefix],:zList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:zList]
+  page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it Q}: "
+  htSay '"\newline  "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01qefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ncolq,ncolq)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01qefDefaultSolve  (htPage,lda,wheret,ifail) == 
+  n := '3
+  m := '5
+  ncolq := '5
+  page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it Q}")
+    (text . "(in this case returned by the default entries of F01QCF) : ")
+    (text . "\newline ")
+    (bcStrings (7 "-4.0" a11 F))
+    (bcStrings (7 "-2.0" a12 F))
+    (bcStrings (7 "-3.0" a13 F))
+    (bcStrings (7 "0.0" a14 F))
+    (bcStrings (7 "0.0" a15 F))
+    (text . "\newline  ")
+    (bcStrings (7 "0.4085" a21 F))
+    (bcStrings (7 "-3.0" a22 F))
+    (bcStrings (7 "-2.0" a23 F))
+    (bcStrings (7 "0.0" a24 F))
+    (bcStrings (7 "0.0" a25 F))
+    (text . "\newline  ")
+    (bcStrings (7 "0.3266" a31 F))
+    (bcStrings (7 "-0.4619" a32 F))
+    (bcStrings (7 "-4.0" a33 F))
+    (bcStrings (7 "0.0" a34 F))
+    (bcStrings (7 "0.0" a35 F))
+    (text . "\newline  ")
+    (bcStrings (7 "0.4082" a41 F))
+    (bcStrings (7 "-0.5774" a42 F))
+    (bcStrings (7 "0.0" a43 F))
+    (bcStrings (7 "0.0" a44 F))
+    (bcStrings (7 "0.0" a45 F))
+    (text . "\newline  ")
+    (bcStrings (7 "0.2449" a51 F))
+    (bcStrings (7 "-0.3464" a52 F))
+    (bcStrings (7 "-0.6326" a53 F))
+    (bcStrings (7 "0.0" a54 F))
+    (bcStrings (7 "0.0" a55 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \zeta: ")
+    (text . "\newline ")
+    (bcStrings (10 "1.2247" z1 F))
+    (bcStrings (10 "1.1547" z2 F))
+    (bcStrings (10 "1.2649" z3 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01qefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ncolq,ncolq)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01qefGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+  lda := m
+  ncolq := htpProperty(htPage,'ncolq)
+  wheret := htpProperty(htPage,'wheret)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    zetalist := [left,:zetalist]
+  zetastring := bcwords2liststring zetalist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..ncolq repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f01qef(_"",wheret,"_",",STRINGIMAGE m,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE lda,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ncolq,",[",zetastring,"],")
+  prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f01rcf() ==
+  htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01rcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rcf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Finds the QR factorization of the complex m by n matrix {\it A},")
+    (text . " which is factorized as \htbitmap{f01qcf}, where m > n")
+    (text . " and A = QR  when m = n , where Q is an m by m unitary matrix ")
+    (text . "and R is an n by n upper triangular matrix with real diagonal ")
+    (text . "elements. The {\it k}th transformation matrix,{\it Qk}, ")
+    (text . "which is used to introduce zeros into the {\it k}th column of ")
+    (text . "{\it A}, is given in the form ")
+    (text . "\htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01rdf2}, ")
+    (text . "\htbitmap{f01qcf3},  ")
+    (text . "\htbitmap{gammak} is a scalar for which Re ")
+    (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ")
+    (text . "is a real scalar and \htbitmap{zk} is an ")
+    (text . "(m-k) element vector. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01rcfSolve)
+  htShowPage()
+
+f01rcfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '5 and n = '3) => f01rcfDefaultSolve(htPage,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01rcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01rcfDefaultSolve  (htPage,ifail) == 
+  n := '3
+  m := '5
+  lda := '5
+  page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.5*%i" a11 F))
+    (bcStrings (15 "-0.5 + 1.5*%i" a12 F))
+    (bcStrings (15 "-1.0 + 1.0*%i" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4 + 0.3*%i" a21 F))
+    (bcStrings (15 "0.9 + 1.3*%i" a22 F))
+    (bcStrings (15 "0.2 + 1.4*%i" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4" a31 F))
+    (bcStrings (15 "-0.4 + 0.4*%i" a32 F))
+    (bcStrings (15 "1.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.3 - 0.4*%i" a41 F))
+    (bcStrings (15 "0.1 + 0.7*%i" a42 F))
+    (bcStrings (15 "0.0" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "-0.3*%i" a51 F))
+    (bcStrings (15 "0.3 + 0.3*%i" a52 F))
+    (bcStrings (15 "2.4*%i" a53 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01rcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01rcfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+  lda := m
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f01rcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring)
+  linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")")
+
+f01rdf() ==
+  htInitPage('"F01RDF - Operations with unitary matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01rdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rdf| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Performs one of the transformations B = QB or B = ")
+    (text . "\htbitmap{f01rdf}, where B is an m ")
+    (text . "by ncolb matrix and Q is an m by  m ")
+    (text . "unitary matrix assumed to be given by Q = ")
+    (text . "\htbitmap{f01rdf1}, \htbitmap{f01qdf2} ")
+    (text . "being given in the form \htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01rdf2}, \htbitmap{f01qcf3}")
+    (text . ", \htbitmap{gammak} is a scalar for which Re ")
+    (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ")
+    (text . "is a real scalar and \htbitmap{zk} is an ")
+    (text . "(m-k) element vector. ")
+    (text . "The routine is intended for use following F01QCF or F01QFF. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of B, {\it ldb} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 5 ldb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Number of columns of matrix B {\it ncolb}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 2 ncolb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Transformation to be performed: ")
+    (radioButtons trans
+        (" " "  {\it B = QB}" no_trans)
+        (" " "  {\it B =} \htbitmap{f01rdf} (Conjugate Transpose)" trans))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Where the elements can be found: ")
+    (radioButtons wheret
+        (" " "  the elements of \theta are in A" in_a)
+        (" " "  the elements of \theta are in THETA" seperate))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01rdfSolve)
+  htShowPage()
+
+f01rdfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  ncolb :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolb)
+  operation := htpButtonValue(htPage,'trans)
+  trans :=
+    operation = 'no_trans => '"n"
+    '"c"
+  elements := htpButtonValue(htPage,'wheret)
+  wheret :=
+    elements = 'in_a => '"i"
+    '"c"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolb = '2)  => f01rdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bList :=
+    "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) ==
+       labelList := 
+	 "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[16, "0.0 + 0.0*%i", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  zList :=
+    "append"/[fz(i) for i in 1..n] where fz(i) ==
+       znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+       [['bcStrings,[16, "0.0", znam, 'F]]]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ")
+  prefix := STRCONC(prefix,"(if required): \newline \tab{2}")
+  zList := [['text,:prefix],:zList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bList,:zList]
+  page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01rdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01rdfDefaultSolve  (htPage,lda,ldb,trans,wheret,ifail) == 
+  n := '3
+  m := '5
+  ncolb := '2
+  page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.5*%i" a11 F))
+    (bcStrings (15 "-0.5 + 1.5*%i" a12 F))
+    (bcStrings (15 "-1.0 + 1.0*%i" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4 + 0.3*%i" a21 F))
+    (bcStrings (15 "0.9 + 1.3*%i" a22 F))
+    (bcStrings (15 "0.2 + 1.4*%i" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4" a31 F))
+    (bcStrings (15 "-0.4 + 0.4*%i" a32 F))
+    (bcStrings (15 "1.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.3 - 0.4*%i" a41 F))
+    (bcStrings (15 "0.1 + 0.7*%i" a42 F))
+    (bcStrings (15 "0.0" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "-0.3*%i" a51 F))
+    (bcStrings (15 "0.3 + 0.3*%i" a52 F))
+    (bcStrings (15 "2.4" a53 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "-0.55 + 1.05*%i" b11 F))
+    (bcStrings (15 "0.45 + 1.05*%i" b12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.49 + 0.93*%i" b21 F))
+    (bcStrings (15 "1.09 + 0.13*%i" b22 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.56 - 0.16*%i" b31 F))
+    (bcStrings (15 "0.64 + 0.16*%i" b32 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.39 + 0.23*%i" b41 F))
+    (bcStrings (15 "-0.39 - 0.23*%i" b42 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "1.13 + 0.83*%i" b51 F))
+    (bcStrings (15 "-1.13 + 0.77*%i" b52 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \theta (if required): ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.0" z1 F))
+    (bcStrings (15 "0.0" z2 F))
+    (bcStrings (15 "0.0" z3 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01rdfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01rdfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+--  ldb := htpProperty(htPage,'ldb)
+  lda := m
+  ldb := m
+  ncolb := htpProperty(htPage,'ncolb)
+  trans := htpProperty(htPage,'trans)
+  wheret := htpProperty(htPage,'wheret)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    zetalist := [left,:zetalist]
+  zetastring := bcwords2liststring zetalist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  for i in 1..ldb repeat
+    for j in 1..ncolb repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f01rdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda)
+  prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+f01ref() ==
+  htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf01ref} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01ref| '|NagMatrixOperationsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns the first {\it ncolq} columns of the real {\it m} by ")
+    (text . "{\it m} unitary matrix {\it Q}, where {\it Q} is assumed ")
+    (text . "to be given by {\it Q = }\htbitmap{f01rdf1}, ")
+    (text . "\htbitmap{f01qdf2} being given in the form ")
+    (text . "\htbitmap{f01qcf1}, ")
+    (text . "where \htbitmap{f01rdf2}, ")
+    (text . "\htbitmap{f01qcf3},  ")
+    (text . "\htbitmap{gammak} is a scalar for which Re ")
+    (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ")
+    (text . "is a real scalar and \htbitmap{zk} is an ")
+    (text . "(m-k) element vector. ")
+    (text . "The routine is intended for use following F01RCF or F01RFF. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda} ")
+--    (text . "\htbitmap{great=} m: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Required number of columns  of matrix Q {\it ncolq}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 2 ncolq PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Where the elements can be found: ")
+    (radioButtons wheret
+        (" " "  the elements of \theta are in THETA" seperate)
+        (" " "  the elements of \theta are in A" in_a))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f01refSolve)
+  htShowPage()
+
+f01refSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ncolq :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolq)
+  elements := htpButtonValue(htPage,'wheret)
+  wheret :=
+    elements = 'in_a => '"i"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolq = '2)  => f01refDefaultSolve(htPage,lda,wheret,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[20, "0.0 + 0.0*%i", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  zList :=
+    "append"/[fz(i) for i in 1..n] where fz(i) ==
+       znam := INTERN STRCONC ('"z",STRINGIMAGE i)
+       [['bcStrings,[20, "0.0", znam, 'F]]]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ")
+  prefix := STRCONC(prefix,"(if required): \newline \tab{2}")
+  zList := [['text,:prefix],:zList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:zList]
+  page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f01refGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ncolq,ncolq)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f01refDefaultSolve  (htPage,lda,wheret,ifail) == 
+  n := '3
+  m := '5
+  ncolq := '2
+  page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "1" a11 F))
+    (bcStrings (16 "1 + %i" a12 F))
+    (bcStrings (16 "1 + %i" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "-0.2-0.4*%i" a21 F))
+    (bcStrings (16 "-2" a22 F))
+    (bcStrings (16 "-1 - %i" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "-0.32 - 0.16*%i" a31 F))
+    (bcStrings (16 "-0.3505+0.263*%i" a32 F))
+    (bcStrings (16 "-3" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "-0.4 + 0.2*%i" a41 F))
+    (bcStrings (16 "0.5477*%i" a42 F))
+    (bcStrings (16 "0.0" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "-0.12 + 0.24*%i" a51 F))
+    (bcStrings (16 "0.1972+0.2629*%i" a52 F))
+    (bcStrings (16 "0.6325" a53 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of \theta: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (16 "1 + 0.5*%i" z1 F))
+    (bcStrings (16 "1.0954-0.3333*%i" z2 F))
+    (bcStrings (16 "1.2649-1.1565*%i" z3 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f01refGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ncolq,ncolq)
+  htpSetProperty(page,'wheret,wheret)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f01refGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  lda := htpProperty(htPage,'lda)
+  lda := m
+  ncolq := htpProperty(htPage,'ncolq)
+  wheret := htpProperty(htPage,'wheret)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    left := STRCONC((first y).1," ")
+    y := rest y
+    thetalist := [left,:thetalist]
+  thetastring := bcwords2liststring thetalist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f01ref(_"",wheret,"_",",STRINGIMAGE m,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ncolq,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,",[",thetastring,"],")
+  prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-f02.boot.pamphlet b/src/interp/nag-f02.boot.pamphlet
new file mode 100644
index 00000000..ccbd74f5
--- /dev/null
+++ b/src/interp/nag-f02.boot.pamphlet
@@ -0,0 +1,2755 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-f02.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+f02aaf() ==
+  htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02aaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues of a real symmetric matrix ")
+    (text . "{\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02aafSolve)
+  htShowPage()
+
+f02aafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02aafDefaultSolve(htPage,ia,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage("F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02aafGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02aafDefaultSolve  (htPage,ia,ifail) == 
+  n := '4
+  page := htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "2.3" a13 F))
+    (bcStrings (6 "-2.6" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "0.5" a22 F))
+    (bcStrings (6 "-1.4" a23 F))
+    (bcStrings (6 "-0.7" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.3" a31 F))
+    (bcStrings (6 "-1.4" a32 F))
+    (bcStrings (6 "0.5" a33 F))
+    (bcStrings (6 "0.0" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.6" a41 F))
+    (bcStrings (6 "-0.7" a42 F))
+    (bcStrings (6 "0.0" a43 F))
+    (bcStrings (6 "0.5" a44 F)))
+  htMakeDoneButton('"Continue",'f02aafGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02aafGen htPage ==
+  n := htpProperty(htPage,'n)
+  -- ia should be = n, unlike the example program
+  -- where ia = nmax
+--  ia := htpProperty(htPage,'ia)
+  ia := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f02aaf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02abf() ==
+  htInitPage('"F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02abf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues and eigenvectors of a real ")
+    (text . "symmetric matrix ")
+    (text . "{\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\tab{32} \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of V, {\it v} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 v PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02abfSolve)
+  htShowPage()
+
+f02abfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  iv := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'v)
+--    objValUnwrap htpLabelSpadValue(htPage, 'v)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02abfDefaultSolve(htPage,ia,iv,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage("F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02abfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02abfDefaultSolve  (htPage,ia,iv,ifail) == 
+  n := '4
+  page := htInitPage('"F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "2.3" a13 F))
+    (bcStrings (6 "-2.6" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "0.5" a22 F))
+    (bcStrings (6 "-1.4" a23 F))
+    (bcStrings (6 "-0.7" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.3" a31 F))
+    (bcStrings (6 "-1.4" a32 F))
+    (bcStrings (6 "0.5" a33 F))
+    (bcStrings (6 "0.0" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.6" a41 F))
+    (bcStrings (6 "-0.7" a42 F))
+    (bcStrings (6 "0.0" a43 F))
+    (bcStrings (6 "0.5" a44 F)))
+  htMakeDoneButton('"Continue",'f02abfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02abfGen htPage ==
+  n := htpProperty(htPage,'n)
+  -- ia should be = n, unlike the example program
+  -- where ia = nmax
+--  ia := htpProperty(htPage,'ia)
+--  iv  := htpProperty(htPage,'iv)
+  ia := n
+  iv := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f02abf(",matstring,", ",STRINGIMAGE ia,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+f02adf() ==
+  htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates all the eigenvalues of Ax = \lambda Bx, where ")
+    (text . "A and B are real symmetric matrices of order n and B is positive-definite ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrices A and B, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "\newline First dimension of B, {\it ib}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 ib F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02adfSolve)
+  htShowPage()
+
+f02adfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  ib := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ib)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02adfDefaultSolve(htPage,ia,ib,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..ib] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02adfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02adfDefaultSolve  (htPage,ia,ib,ifail) == 
+  n := '4
+  page := htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "1.5" a12 F))
+    (bcStrings (6 "6.6" a13 F))
+    (bcStrings (6 "4.8" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" a21 F))
+    (bcStrings (6 "6.5" a22 F))
+    (bcStrings (6 "16.2" a23 F))
+    (bcStrings (6 "8.6" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "6.6" a31 F))
+    (bcStrings (6 "16.2" a32 F))
+    (bcStrings (6 "37.6" a33 F))
+    (bcStrings (6 "9.8" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "4.8" a41 F))
+    (bcStrings (6 "8.6" a42 F))
+    (bcStrings (6 "9.8" a43 F))
+    (bcStrings (6 "-17.1" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b11 F))
+    (bcStrings (6 3 b12 F))
+    (bcStrings (6 4 b13 F))
+    (bcStrings (6 1 b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 3 b21 F))
+    (bcStrings (6 13 b22 F))
+    (bcStrings (6 16 b23 F))
+    (bcStrings (6 11 b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 b31 F))
+    (bcStrings (6 16 b32 F))
+    (bcStrings (6 24 b33 F))
+    (bcStrings (6 18 b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b41 F))
+    (bcStrings (6 11 b42 F))
+    (bcStrings (6 18 b43 F))
+    (bcStrings (6 27 b44 F)))
+  htMakeDoneButton('"Continue",'f02adfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02adfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+--  ib := htpProperty(htPage,'ib)
+  ia := n
+  ib := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..ib repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02adf(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02aef() ==
+  htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates all the eigenvalues and eigenvectors of Ax = ")
+    (text . "\lambda Bx, where A and B are real symmetric matrices of order ")
+    (text . "n and B is positive-definite ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrices A and B, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "\newline First dimension of B, {\it ib}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 ib F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of V, {\it iv}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 iv PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02aefSolve)
+  htShowPage()
+
+f02aefSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  ib := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ib)
+  iv := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iv)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02aefDefaultSolve(htPage,ia,ib,iv,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..ib] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02aefGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02aefDefaultSolve  (htPage,ia,ib,iv,ifail) == 
+  n := '4
+  page := htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "1.5" a12 F))
+    (bcStrings (6 "6.6" a13 F))
+    (bcStrings (6 "4.8" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" a21 F))
+    (bcStrings (6 "6.5" a22 F))
+    (bcStrings (6 "16.2" a23 F))
+    (bcStrings (6 "8.6" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "6.6" a31 F))
+    (bcStrings (6 "16.2" a32 F))
+    (bcStrings (6 "37.6" a33 F))
+    (bcStrings (6 "9.8" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "4.8" a41 F))
+    (bcStrings (6 "8.6" a42 F))
+    (bcStrings (6 "9.8" a43 F))
+    (bcStrings (6 "-17.1" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b11 F))
+    (bcStrings (6 3 b12 F))
+    (bcStrings (6 4 b13 F))
+    (bcStrings (6 1 b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 3 b21 F))
+    (bcStrings (6 13 b22 F))
+    (bcStrings (6 16 b23 F))
+    (bcStrings (6 11 b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 b31 F))
+    (bcStrings (6 16 b32 F))
+    (bcStrings (6 24 b33 F))
+    (bcStrings (6 18 b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b41 F))
+    (bcStrings (6 11 b42 F))
+    (bcStrings (6 18 b43 F))
+    (bcStrings (6 27 b44 F)))
+  htMakeDoneButton('"Continue",'f02aefGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02aefGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+--  ib := htpProperty(htPage,'ib)
+--  iv := htpProperty(htPage,'iv)
+  ia := n
+  ib := n
+  iv := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..ib repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02aef(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ")
+  prefix := STRCONC(prefix,matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+f02aff() ==
+  htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02aff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues of a real unsymmetric matrix ")
+    (text . "{\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02affSolve)
+  htShowPage()
+
+f02affSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02affDefaultSolve(htPage,ia,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage("F02AFF - All eigenvalues of real matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02affGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02affDefaultSolve  (htPage,ia,ifail) == 
+  n := '4
+  page := htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" a11 F))
+    (bcStrings (6 "0.1" a12 F))
+    (bcStrings (6 "4.5" a13 F))
+    (bcStrings (6 "-1.5" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-22.5" a21 F))
+    (bcStrings (6 "3.5" a22 F))
+    (bcStrings (6 "12.5" a23 F))
+    (bcStrings (6 "-2.5" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" a31 F))
+    (bcStrings (6 "0.3" a32 F))
+    (bcStrings (6 "4.5" a33 F))
+    (bcStrings (6 "-2.5" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" a41 F))
+    (bcStrings (6 "0.1" a42 F))
+    (bcStrings (6 "4.5" a43 F))
+    (bcStrings (6 "2.5" a44 F)))
+  htMakeDoneButton('"Continue",'f02affGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02affGen htPage ==
+  n := htpProperty(htPage,'n)
+  -- ia should be = n, unlike the example program
+  -- where ia = nmax
+--  ia := htpProperty(htPage,'ia)
+  ia := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f02aff(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02agf() ==
+  htInitPage('"F02AGF - All eigenvalues and eignevectors of real matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02agf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues and eigenvectors of a real ")
+    (text . "unsymmetric matrix {\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\tab{32} \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of VR, {\it ivr} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 ivr PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of VI, {\it ivi} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ivi PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02agfSolve)
+  htShowPage()
+
+f02agfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  ivr := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivr)
+  ivi := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivi)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02agfDefaultSolve(htPage,ia,ivr,ivi,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage("F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02agfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02agfDefaultSolve  (htPage,ia,ivr,ivi,ifail) == 
+  n := '4
+  page := htInitPage('"F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" a11 F))
+    (bcStrings (6 "0.1" a12 F))
+    (bcStrings (6 "4.5" a13 F))
+    (bcStrings (6 "-1.5" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-22.5" a21 F))
+    (bcStrings (6 "3.5" a22 F))
+    (bcStrings (6 "12.5" a23 F))
+    (bcStrings (6 "-2.5" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" a31 F))
+    (bcStrings (6 "0.3" a32 F))
+    (bcStrings (6 "4.5" a33 F))
+    (bcStrings (6 "-2.5" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" a41 F))
+    (bcStrings (6 "0.1" a42 F))
+    (bcStrings (6 "4.5" a43 F))
+    (bcStrings (6 "2.5" a44 F)))
+  htMakeDoneButton('"Continue",'f02agfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02agfGen htPage ==
+  n := htpProperty(htPage,'n)
+  -- ia should be = n, unlike the example program
+  -- where ia = nmax
+--  ia := htpProperty(htPage,'ia)
+--  ivr  := htpProperty(htPage,'ivr)
+--  ivi  := htpProperty(htPage,'ivi)
+  ia := n
+  ivr := n
+  ivi := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f02agf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ")
+  linkGen STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")")
+
+f02ajf() ==
+  htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02ajf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates all the eigenvalues of a complex matrix {\it A} ")
+    (text . "of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing real parts, ")
+--    (text . " {\it iar}: \newline \tab{2} ")
+--    (bcStrings (6 4 iar PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing imaginary parts,")
+--    (text . " {\it iai}: \newline \tab{2} ")
+--    (bcStrings (6 4 iai F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02ajfSolve)
+  htShowPage()
+
+f02ajfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  iar := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iar)
+  iai := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iai)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02ajfDefaultSolve(htPage,iar,iai,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..iar] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..iai] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02AJF - All eigenvalues of complex matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02ajfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02ajfDefaultSolve  (htPage,iar,iai,ifail) == 
+  n := '4
+  page := htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-21.0" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "13.6" a13 F))
+    (bcStrings (6 "0.0" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "26.0" a22 F))
+    (bcStrings (6 "7.5" a23 F))
+    (bcStrings (6 "2.5" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.0" a31 F))
+    (bcStrings (6 "1.68" a32 F))
+    (bcStrings (6 "4.5" a33 F))
+    (bcStrings (6 "1.5" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a41 F))
+    (bcStrings (6 "-2.6" a42 F))
+    (bcStrings (6 "-2.7" a43 F))
+    (bcStrings (6 "2.5" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-5.0" b11 F))
+    (bcStrings (6 "24.6" b12 F))
+    (bcStrings (6 "10.2"b13 F))
+    (bcStrings (6 "4.0" b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "22.5" b21 F))
+    (bcStrings (6 "-5.0" b22 F))
+    (bcStrings (6 "-10.0" b23 F))
+    (bcStrings (6 "0.0" b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" b31 F))
+    (bcStrings (6 "2.24" b32 F))
+    (bcStrings (6 "-5.0" b33 F))
+    (bcStrings (6 "2.0" b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" b41 F))
+    (bcStrings (6 "0.0" b42 F))
+    (bcStrings (6 "3.6" b43 F))
+    (bcStrings (6 "-5.0" b44 F)))
+  htMakeDoneButton('"Continue",'f02ajfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02ajfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  iar := htpProperty(htPage,'iar)
+--  iai := htpProperty(htPage,'iai)
+  iar := n
+  iai := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..iar repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..iai repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02ajf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02akf() ==
+  htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02akf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues and eigenvectors of a complex ")
+    (text . "matrix {\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing real parts, ")
+--    (text . " {\it iar}: \newline \tab{2} ")
+--    (bcStrings (6 4 iar PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing imaginary parts,")
+--    (text . " {\it iai}: \newline \tab{2} ")
+--    (bcStrings (6 4 iai F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} \newline ")
+--    (text . "First dimension of array of real parts of the eigenvectors, ")
+--    (text . " {\it ivr}: \newline \tab{2} ")
+--    (bcStrings (6 4 ivr PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} \newline ")
+--    (text . "First dimension of array of imaginary parts of the eigenvectors,")
+--    (text . " {\it ivi}: \newline \tab{2} ")
+--    (bcStrings (6 4 ivi PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02akfSolve)
+  htShowPage()
+
+f02akfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  iar := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iar)
+  iai := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iai)
+  ivr := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivr)
+  ivi := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivi)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02akfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..iar] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..iai] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02akfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02akfDefaultSolve  (htPage,iar,iai,ivr,ivi,ifail) == 
+  n := '4
+  page := htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-21.0" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "13.6" a13 F))
+    (bcStrings (6 "0.0" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "26.0" a22 F))
+    (bcStrings (6 "7.5" a23 F))
+    (bcStrings (6 "2.5" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.0" a31 F))
+    (bcStrings (6 "1.68" a32 F))
+    (bcStrings (6 "4.5" a33 F))
+    (bcStrings (6 "1.5" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a41 F))
+    (bcStrings (6 "-2.6" a42 F))
+    (bcStrings (6 "-2.7" a43 F))
+    (bcStrings (6 "2.5" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-5.0" b11 F))
+    (bcStrings (6 "24.6" b12 F))
+    (bcStrings (6 "10.2"b13 F))
+    (bcStrings (6 "4.0" b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "22.5" b21 F))
+    (bcStrings (6 "-5.0" b22 F))
+    (bcStrings (6 "-10.0" b23 F))
+    (bcStrings (6 "0.0" b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.5" b31 F))
+    (bcStrings (6 "2.24" b32 F))
+    (bcStrings (6 "-5.0" b33 F))
+    (bcStrings (6 "2.0" b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.5" b41 F))
+    (bcStrings (6 "0.0" b42 F))
+    (bcStrings (6 "3.6" b43 F))
+    (bcStrings (6 "-5.0" b44 F)))
+  htMakeDoneButton('"Continue",'f02akfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02akfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  iar := htpProperty(htPage,'iar)
+--  iai := htpProperty(htPage,'iai)
+--  ivr := htpProperty(htPage,'ivr)
+--  ivi := htpProperty(htPage,'ivi)
+  iar := n
+  iai := n
+  ivr := n
+  ivi := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..iar repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..iai repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02akf(",STRINGIMAGE iar,", ",STRINGIMAGE iai,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ivr,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ivi,", ",matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02awf() ==
+  htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02awf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates all the eigenvalues of a complex Hermitian matrix ")
+    (text . "{\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of the complex Hermitian matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing real parts, ")
+--    (text . " {\it iar}: \newline \tab{2} ")
+--    (bcStrings (6 4 iar PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing imaginary parts,")
+--    (text . " {\it iai}: \newline \tab{2} ")
+--    (bcStrings (6 4 iai F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02awfSolve)
+  htShowPage()
+
+f02awfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  iar := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iar)
+  iai := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iai)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02awfDefaultSolve(htPage,iar,iai,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..iar] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..iai] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values {\it AI}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it AR}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02awfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02awfDefaultSolve  (htPage,iar,iai,ifail) == 
+  n := '4
+  page := htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter real values {\it AR}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "1.84" a13 F))
+    (bcStrings (6 "2.08" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "0.5" a22 F))
+    (bcStrings (6 "1.12" a23 F))
+    (bcStrings (6 "-0.56" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.84" a31 F))
+    (bcStrings (6 "1.12" a32 F))
+    (bcStrings (6 "0.5" a33 F))
+    (bcStrings (6 "0.0" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.08" a41 F))
+    (bcStrings (6 "-0.56" a42 F))
+    (bcStrings (6 "0.0" a43 F))
+    (bcStrings (6 "0.5" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter imaginary values {\it AI}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b11 F))
+    (bcStrings (6 "0.0" b12 F))
+    (bcStrings (6 "1.38" b13 F))
+    (bcStrings (6 "-1.56" b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b21 F))
+    (bcStrings (6 "0.0" b22 F))
+    (bcStrings (6 "0.84" b23 F))
+    (bcStrings (6 "0.42" b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-1.38" b31 F))
+    (bcStrings (6 "-0.84" b32 F))
+    (bcStrings (6 "0.0" b33 F))
+    (bcStrings (6 "0.0" b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.56" b41 F))
+    (bcStrings (6 "-0.42" b42 F))
+    (bcStrings (6 "0.0" b43 F))
+    (bcStrings (6 "0.0" b44 F)))
+  htMakeDoneButton('"Continue",'f02awfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02awfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  iar := htpProperty(htPage,'iar)
+--  iai := htpProperty(htPage,'iai)
+  iar := n
+  iai := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..iar repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..iai repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02awf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02axf() ==
+  htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02axf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues and eigenvectors of a complex ")
+    (text . "Hermitian matrix {\it A} of order {\it n}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing real parts, ")
+--    (text . " {\it iar}: \newline \tab{2} ")
+--    (bcStrings (6 4 iar PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of array containing imaginary parts,")
+--    (text . " {\it iai}: \newline \tab{2} ")
+--    (bcStrings (6 4 iai F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} \newline ")
+--    (text . "First dimension of array of real parts of the eigenvectors, ")
+--    (text . " {\it ivr}: \newline \tab{2} ")
+--    (bcStrings (6 4 ivr PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} \newline ")
+--    (text . "First dimension of array of imaginary parts of the eigenvectors,")
+--    (text . " {\it ivi}: \newline \tab{2} ")
+--    (bcStrings (6 4 ivi PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02axfSolve)
+  htShowPage()
+
+f02axfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  iar := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iar)
+  iai := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iai)
+  ivr := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivr)
+  ivi := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ivi)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02axfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..iar] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..iai] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values of {\it A}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02axfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02axfDefaultSolve  (htPage,iar,iai,ivr,ivi,ifail) == 
+  n := '4
+  page := htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "1.84" a13 F))
+    (bcStrings (6 "2.08" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "0.5" a22 F))
+    (bcStrings (6 "1.12" a23 F))
+    (bcStrings (6 "-0.56" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.84" a31 F))
+    (bcStrings (6 "1.12" a32 F))
+    (bcStrings (6 "0.5" a33 F))
+    (bcStrings (6 "0.0" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.08" a41 F))
+    (bcStrings (6 "-0.56" a42 F))
+    (bcStrings (6 "0.0" a43 F))
+    (bcStrings (6 "0.5" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b11 F))
+    (bcStrings (6 "0.0" b12 F))
+    (bcStrings (6 "1.38" b13 F))
+    (bcStrings (6 "-1.56" b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b21 F))
+    (bcStrings (6 "0.0" b22 F))
+    (bcStrings (6 "0.84" b23 F))
+    (bcStrings (6 "0.42" b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-1.38" b31 F))
+    (bcStrings (6 "-0.84" b32 F))
+    (bcStrings (6 "0.0" b33 F))
+    (bcStrings (6 "0.0" b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.56" b41 F))
+    (bcStrings (6 "-0.42" b42 F))
+    (bcStrings (6 "0.0" b43 F))
+    (bcStrings (6 "0.0" b44 F)))
+  htMakeDoneButton('"Continue",'f02axfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'iar,iar)
+--  htpSetProperty(page,'iai,iai)
+--  htpSetProperty(page,'ivr,ivr)
+--  htpSetProperty(page,'ivi,ivi)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02axfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  iar := htpProperty(htPage,'iar)
+--  iai := htpProperty(htPage,'iai)
+--  ivr := htpProperty(htPage,'ivr)
+--  ivi := htpProperty(htPage,'ivi)
+  iar := n
+  iai := n
+  ivr := n
+  ivi := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..iar repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..iai repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02axf(",matstring,", ",STRINGIMAGE iar,", ",bstring)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE iai,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02bbf() ==
+  htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02bbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates selected eigenvalues and eigenvectors of a real ")
+    (text . "symmetric matrix {\it A} of order {\it n} by reduction to ")
+    (text . "tridiagonal form, bisection and inverse iteration, where the ")
+    (text . "selected eigenvalues lie within a given interval [{\it l,u}].")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrix A, {\it n}: ")
+    (text . "\tab{32} \menuitemstyle{} \tab{34} ")
+    (text . "Max number of eigenvectors, {\it m}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 m PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Lower end-point of interval {\it l}: ")
+    (text . "\tab{32} \menuitemstyle{} \tab{34} ")
+    (text . "Upper end-point of interval {\it u}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.0" alb F))
+    (text . "\tab{34} ")
+    (bcStrings (6 "3.0" ub F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\tab{32} \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of V, {\it v} ")
+--    (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 iv PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02bbfSolve)
+  htShowPage()
+
+f02bbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  alb := htpLabelInputString(htPage,'alb)
+  ub := htpLabelInputString(htPage,'ub)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  iv := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iv)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02bbfDefaultSolve(htPage,m,alb,ub,ia,iv,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList]
+  page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02bbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'alb,alb)
+  htpSetProperty(page,'ub,ub)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02bbfDefaultSolve (htPage,m,alb,ub,ia,iv,ifail) ==
+  n := '4
+  page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.5" a11 F))
+    (bcStrings (6 "0.0" a12 F))
+    (bcStrings (6 "2.3" a13 F))
+    (bcStrings (6 "-2.6" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a21 F))
+    (bcStrings (6 "0.5" a22 F))
+    (bcStrings (6 "-1.4" a23 F))
+    (bcStrings (6 "-0.7" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.3" a31 F))
+    (bcStrings (6 "-1.4" a32 F))
+    (bcStrings (6 "0.5" a33 F))
+    (bcStrings (6 "0.0" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-2.6" a41 F))
+    (bcStrings (6 "-0.7" a42 F))
+    (bcStrings (6 "0.0" a43 F))
+    (bcStrings (6 "0.5" a44 F)))
+  htMakeDoneButton('"Continue",'f02bbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'alb,alb)
+  htpSetProperty(page,'ub,ub)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02bbfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  alb := htpProperty(htPage,'alb)
+  ub := htpProperty(htPage,'ub)
+  -- ia should be = n, unlike the example program
+  -- where ia = nmax
+--  ia := htpProperty(htPage,'ia)
+--  iv := htpProperty(htPage,'iv)
+  ia := n
+  iv := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f02bbf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,alb,", ",ub,", ",STRINGIMAGE m,", ",STRINGIMAGE iv)
+  prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+f02bjf() ==
+  htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02bjf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates all the eigenvalues and, if required, all the ")
+    (text . "eigenvectors of Ax = \lambda Bx, where A and B are real ")
+    (text . "symmetric matrices of order n and B using the QZ algorithm. ")
+    (text . "The routine does not actually produce the eigenvalues ")
+    (text . "\inputbitmap{\htbmdir{}/lamdaj.bitmap}, but instead returns ")
+    (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} and ")
+    (text . "\inputbitmap{\htbmdir{}/betaj.bitmap} ")
+    (text . "such that \inputbitmap{\htbmdir{}/lamdaj.bitmap} = ")
+    (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap}  / ")
+    (text . "\inputbitmap{\htbmdir{}/betaj.bitmap}, ")
+    (text . "for j = 1,2,...,n. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Order of matrices A and B, {\it n}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it ia}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "\newline First dimension of B, {\it ib}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 ia PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 4 ib F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of V, {\it iv}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "\newline Tolerance, {\it eps}: ")
+    (text . "\newline \tab{2} ")
+--    (bcStrings (6 4 iv PI))
+--    (text . "\tab{34} ")
+    (bcStrings (6 "1.0e-4" eps F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Are eigenvectors required: ")
+    (radioButtons matv
+        ("" "  true" true)
+        ("" "  false" false))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02bjfSolve)
+  htShowPage()
+
+f02bjfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  ib := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ib)
+  iv := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iv)
+  eps := htpLabelInputString(htPage,'eps)
+  bool := htpButtonValue(htPage,'matv)
+  matv :=
+    bool = 'true => '"true"
+    '"false"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '4  => f02bjfDefaultSolve(htPage,ia,ib,iv,eps,matv,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k,n) for k in 1..ib] where h(k,n) ==
+       bList := 
+         "append"/[l(k,p) for p in 1..n] where l(k,p) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       bList := [['text,:prefix],:bList]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02bjfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'matv,matv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f02bjfDefaultSolve  (htPage,ia,ib,iv,eps,matv,ifail) ==
+  n := '4
+  page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "3.9" a11 F))
+    (bcStrings (6 "12.5" a12 F))
+    (bcStrings (6 "-34.5" a13 F))
+    (bcStrings (6 "-0.5" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "4.3" a21 F))
+    (bcStrings (6 "21.5" a22 F))
+    (bcStrings (6 "-47.5" a23 F))
+    (bcStrings (6 "7.5" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "4.3" a31 F))
+    (bcStrings (6 "21.5" a32 F))
+    (bcStrings (6 "-43.5" a33 F))
+    (bcStrings (6 "3.5" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "4.4" a41 F))
+    (bcStrings (6 "26.0" a42 F))
+    (bcStrings (6 "-46.0" a43 F))
+    (bcStrings (6 "6.0" a44 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b11 F))
+    (bcStrings (6 2 b12 F))
+    (bcStrings (6 "-3" b13 F))
+    (bcStrings (6 1 b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b21 F))
+    (bcStrings (6 3 b22 F))
+    (bcStrings (6 "-5" b23 F))
+    (bcStrings (6 4b24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b31 F))
+    (bcStrings (6 3 b32 F))
+    (bcStrings (6 -4 b33 F))
+    (bcStrings (6 3 b34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b41 F))
+    (bcStrings (6 3 b42 F))
+    (bcStrings (6 -4 b43 F))
+    (bcStrings (6 4 b44 F)))
+  htMakeDoneButton('"Continue",'f02bjfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'iv,iv)
+  htpSetProperty(page,'eps,eps)
+  htpSetProperty(page,'matv,matv)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02bjfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+--  ib := htpProperty(htPage,'ib)
+--  iv := htpProperty(htPage,'iv)
+  ia := n
+  ib := n
+  iv := n
+  eps := htpProperty(htPage,'eps)
+  matv := htpProperty(htPage,'matv)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..ia repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..ib repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02bjf(",STRINGIMAGE n,", ",STRINGIMAGE ia,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ib,", ",eps,", ",matv,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE iv,", ",matstring,", ",bstring,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+f02fjf() ==
+  htInitPage('"F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02fjf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Finds the {\it m} eigenvalues of largest absolute value and the ")
+    (text . "corresponding eigenvectors for the eigenvalue problem ")
+    (text . "{\it Cx = \htbitmap{lambda}x}, where {\it C} is a real matrix ")
+    (text . "of order {\it n} such that {\it BC = \htbitmap{ctb}} for a ")
+    (text . "given positive-definite matrix {\it B}. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "Read the input file to see the example program. ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\spadcommand{)read f02fjf \bound{s0}} "))
+  htShowPage()
+
+
+f02wef() ==
+  htInitPage('"F02WEF - SVD of real matrix",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02wef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns all or part of the singular value decomposition of a ")
+    (text . "real {\it m} by {\it n} matrix {\it A}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of B, {\it ldb}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 5 ldb PI))
+--    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Number of columns of matrix B, {\it ncolb}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 ncolb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Is the matrix {\it Q} required, {\it wantq}:")
+    (radioButtons wantq
+        (" " "  true" qtrue)
+        (" " "  false" qfalse))
+    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of {\it Q}, {\it ldq}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of {\it PT}, {\it ldpt}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 1 ldq PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 5 ldpt PI))
+--    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Is the matrix {\it PT} required, {\it wantp}:")
+    (radioButtons wantp
+        (" " "  true" ptrue)
+        (" " "  false" pfalse))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02wefSolve)
+  htShowPage()
+
+f02wefSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  ncolb :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolb)
+  operation := htpButtonValue(htPage,'wantq)
+  wantq :=
+    operation = 'qtrue => '"true"
+    '"false"
+  ldq := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldq)
+  ldpt := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldpt)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldpt)
+  elements := htpButtonValue(htPage,'wantp)
+  wantp :=
+    elements = 'ptrue => '"true"
+    '"false"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolb = '1)  => 
+	f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[10, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bList :=
+    "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) ==
+       pre := ("\newline \tab{2} ")
+       labelList :=
+         "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       labelList := [['text,:pre],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bList]
+  page := htInitPage('"F02WEF - SVD of real matrix",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02wefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'wantq,wantq)
+--  htpSetProperty(page,'ldq,ldq)
+--  htpSetProperty(page,'ldpt,ldpt)
+  htpSetProperty(page,'wantp,wantp)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) ==
+  n := '3
+  m := '5
+  ncolb := '1
+  page := htInitPage('"F02WEF - SVD of real matrix",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a11 F))
+    (bcStrings (6 "2.5" a12 F))
+    (bcStrings (6 "2.5" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a21 F))
+    (bcStrings (6 "2.5" a22 F))
+    (bcStrings (6 "2.5" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.6" a31 F))
+    (bcStrings (6 "-0.4" a32 F))
+    (bcStrings (6 "2.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a41 F))
+    (bcStrings (6 "-0.5" a42 F))
+    (bcStrings (6 "0.5" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.2" a51 F))
+    (bcStrings (6 "-0.3" a52 F))
+    (bcStrings (6 "-2.9" a53 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.1" b11 F))
+    (bcStrings (6 "0.9" b12 F))
+    (bcStrings (6 "0.6" b13 F))
+    (bcStrings (6 "0.0" b14 F))
+    (bcStrings (6 "-0.8" b15 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f02wefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'wantq,wantq)
+  htpSetProperty(page,'ldq,ldq)
+  htpSetProperty(page,'ldpt,ldpt)
+  htpSetProperty(page,'wantp,wantp)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02wefGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  lda := htpProperty(htPage,'lda)
+  ldb := htpProperty(htPage,'ldb)
+  ncolb := htpProperty(htPage,'ncolb)
+  wantq := htpProperty(htPage,'wantq)
+  ldq := htpProperty(htPage,'ldq)
+  ldpt := htpProperty(htPage,'ldpt)
+  wantp := htpProperty(htPage,'wantp)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  for i in 1..ldb repeat
+    for j in 1..ncolb repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02wef(",STRINGIMAGE m,",",STRINGIMAGE n,",")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldpt,", ",matstring,", ",bstring," ,")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+f02xef() ==
+  htInitPage('"F02XEF - SVD of complex matrix",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf02xef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns all or part of the singular value decomposition of a ")
+    (text . "complex {\it m} by {\it n} matrix {\it A}.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 5 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 3 n PI))
+    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it lda}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of B, {\it ldb}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 lda PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 5 ldb PI))
+--    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Number of columns of matrix B, {\it ncolb}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 ncolb PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Is the matrix {\it Q} required, {\it wantq}:")
+    (radioButtons wantq
+        (" " "  true" qtrue)
+        (" " "  false" qfalse))
+    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of {\it Q}, {\it ldq}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+--    (text . "First dimension of {\it PH}, {\it ldph}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 5 ldq PI))
+--    (text . "\tab{34} ")
+--    (bcStrings (6 3 ldph PI))
+--    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Is the matrix {\it PH} required, {\it wantp}:")
+    (radioButtons wantp
+        (" " "  true" ptrue)
+        (" " "  false" pfalse))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f02xefSolve)
+  htShowPage()
+
+f02xefSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  ncolb :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb)
+    objValUnwrap htpLabelSpadValue(htPage, 'ncolb)
+  operation := htpButtonValue(htPage,'wantq)
+  wantq :=
+    operation = 'qtrue => '"true"
+    '"false"
+  ldq := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldq)
+  ldph := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldph)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldph)
+  elements := htpButtonValue(htPage,'wantp)
+  wantp :=
+    elements = 'ptrue => '"true"
+    '"false"
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  ((m = '5 and n = '3) and ncolb = '1)  => 
+	f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail)
+  matList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList := 
+	 "append"/[ga(i,j) for j in 1..n] where ga(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[15, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bList :=
+    "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) ==
+       pre := ("\newline \tab{2} ")
+       labelList :=
+         "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[15, "0.0", bnam, 'F]]]
+       labelList := [['text,:pre],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bList]
+  page := htInitPage('"F02XEF - SVD of complex matrix",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f02xefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'wantq,wantq)
+  htpSetProperty(page,'ldq,ldq)
+  htpSetProperty(page,'ldph,ldph)
+  htpSetProperty(page,'wantp,wantp)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) ==
+  n := '3
+  m := '5
+  ncolb := '1
+  page := htInitPage('"F02XEF - SVD of complex matrix",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.5*%i" a11 F))
+    (bcStrings (15 "-0.5 + 1.5*%i" a12 F))
+    (bcStrings (15 "-1 + 1*%i" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4 + 0.3*%i" a21 F))
+    (bcStrings (15 "0.9 + 1.3*%i" a22 F))
+    (bcStrings (15 "0.2 + 1.4*%i" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.4" a31 F))
+    (bcStrings (15 "-0.4 + 0.4*%i" a32 F))
+    (bcStrings (15 "1.8" a33 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.3 - 0.4*%i" a41 F))
+    (bcStrings (15 "0.1 + 0.7*%i" a42 F))
+    (bcStrings (15 "0.0" a43 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "-0.3*%i" a51 F))
+    (bcStrings (15 "0.3 + 0.3*%i" a52 F))
+    (bcStrings (15 "2.4*%i" a53 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "-0.55+1.05*%i" b11 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.49+0.93*%i" b12 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.56-0.16*%i" b13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "0.39+0.23*%i" b14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (15 "1.13+0.83*%i" b15 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f02xefGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'ncolb,ncolb)
+  htpSetProperty(page,'wantq,wantq)
+  htpSetProperty(page,'ldq,ldq)
+  htpSetProperty(page,'ldph,ldph)
+  htpSetProperty(page,'wantp,wantp)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f02xefGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+  lda := htpProperty(htPage,'lda)
+  ldb := htpProperty(htPage,'ldb)
+  ncolb := htpProperty(htPage,'ncolb)
+  wantq := htpProperty(htPage,'wantq)
+  ldq := htpProperty(htPage,'ldq)
+  ldph := htpProperty(htPage,'ldph)
+  wantp := htpProperty(htPage,'wantp)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  y := REVERSE y
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  for i in 1..ldb repeat
+    for j in 1..ncolb repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    bform := [:bform,rowList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bform]
+  prefix := STRCONC('"f02xef(",STRINGIMAGE m,",",STRINGIMAGE n,",")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldph,", ",matstring,", ",bstring," ,")
+  linkGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-f04.boot.pamphlet b/src/interp/nag-f04.boot.pamphlet
new file mode 100644
index 00000000..da36ae78
--- /dev/null
+++ b/src/interp/nag-f04.boot.pamphlet
@@ -0,0 +1,2331 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-f04.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+f04adf() ==
+  htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain I (Integer)))
+    (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Calculates the approximate solution of a set of complex linear ")
+    (text . "equations {\it AX = B} using an {\it LU} factorization with ")
+    (text . "partial pivoting, where {\it A} is an n * n matrix, {\it X} is ")
+    (text . "an {\it n} by {\it m} matrix of unknowns and {\it B} is an ")    
+    (text . "{\it n} by {\it m} matrix of right-hand sides.")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "{\it n} order of matrix A:")
+    (text . "\tab{28} \menuitemstyle{}\tab{30} ")
+    (text . "{\it m} number of right-hand sides \htbitmap{great=} 0 :")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 3 n I))
+    (text . "\tab{30} ")
+    (bcStrings (10 1 m I))
+--    (text . "\blankline ")
+--    (text . "\newline \menuitemstyle{}\tab{2} ")
+--    (text . "{\it IA} first dimension of A:")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+--    (text . "{\it IB} first dimension of B:")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (10 3 ia I))
+--    (text . "\tab{34} ")
+--    (bcStrings (10 3 ib I))
+--    (text . "\blankline ")
+--    (text . "\newline \menuitemstyle{}\tab{2} ")
+--    (text . "{\it IC} first dimension of C:")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (10 3 ic I))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04adfSolve)
+  htShowPage()
+
+f04adfSolve htPage ==
+  n := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  m := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  ib := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ib)
+  ic := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ic)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ic)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '3 and m = '1) => f04adfDefaultSolve(htPage,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            ianam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[12, "0.0 + 0.0*%i", ianam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList :=
+    "append"/[fb(i,m) for i in 1..ib] where fb(i,m) ==
+       blabelList := 
+	 "append"/[gb(i,j) for j in 1..m] where gb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[12, "0.0 + 0.0*%i", bnam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       blabelList := [['text,:prefix],:blabelList]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :matList,:bmatList]
+  page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04adfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'ic,ic)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()   
+       
+  
+
+f04adfDefaultSolve (htPage, ifail) ==
+  n := '3
+  m := '1
+  ia := '3
+  ib := '3
+  ic := '3
+  page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "1" a11 F))
+    (bcStrings (12 "1 + 2*%i" a12 F))
+    (bcStrings (12 "2 + 10*%i" a13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "1 + %i" a21 F))
+    (bcStrings (12 "3*%i" a22 F))
+    (bcStrings (12 "-5 + 14*%i" a23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "1 + %i" a31 F))
+    (bcStrings (12 "5*%i" a32 F))
+    (bcStrings (12 "-8 + 20*%i" a33 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "1" b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "0" b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (12 "0" b3 F)))
+  htMakeDoneButton('"Continue",'f04adfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'ib,ib)
+--  htpSetProperty(page,'ic,ic)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04adfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  ia := htpProperty(htPage,'ia)
+--  ib := htpProperty(htPage,'ib)
+--  ic := htpProperty(htPage,'ic)
+  ia := n
+  ib := n
+  ic := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  -- will probably need to change this as its a vector not an array
+  for i in 1..m repeat
+    for j in 1..ib repeat
+      right := STRCONC((first y).1," ")
+      y := rest y
+      bList := [right,:bList]
+      bstring := bcwords2liststring bList
+    boutList := [bstring,:boutList]
+    bList := []
+  boutstring := bcwords2liststring boutList
+  y := REVERSE y
+  k := -1
+  matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform] 
+  prefix := STRCONC('"f04adf(",STRINGIMAGE ia,",",boutstring,",")
+  prefix := STRCONC(prefix,STRINGIMAGE ib,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE m,", ",STRINGIMAGE ic)
+  prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")")
+  bcGen prefix
+
+f04arf() ==
+  htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain I (Integer)))
+    (text . "\windowlink{Manual Page}{manpageXXf04arf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates the approximate solution of a set of real linear ")
+    (text . "equations {\it Ax = b} using an {\it LU} factorization with ")
+    (text . "pivoting, where {\it A} is an n * n matrix, {\it x} is an n ")
+    (text . "element vector of unknowns and {\it b} is an n element ")
+    (text . "right-hand side vector.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+--    (text . "{\it IA} first dimension of A:")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\it n} order of matrix A:")
+    (text . "\newline\tab{2} ")
+--    (bcStrings (10 8 ia I))
+--    (text . "\tab{34} ")
+    (bcStrings (10 3 n I))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04arfSolve)
+  htShowPage()
+
+f04arfSolve htPage ==
+  n := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '3 => f04arfDefaultSolve(htPage,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", ianam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k) for k in 1..n] where h(k) ==
+       prefix := ('"\newline \tab{2} ")
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE k)
+       [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :matList,:bmatList]
+  page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04arfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()   
+       
+  
+
+f04arfDefaultSolve (htPage, ifail) ==
+  n := '3
+  ia := '3
+  page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 33 ia11 F))
+    (bcStrings (6 16 ia12 F))
+    (bcStrings (6 72 ia13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-24" ia21 F))
+    (bcStrings (6 "-10" ia22 F))
+    (bcStrings (6 "-57" ia23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-8" ia31 F))
+    (bcStrings (6 "-4" ia32 F))
+    (bcStrings (6 "-17" ia33 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia41 F))
+--    (bcStrings (6 0 ia42 F))
+--    (bcStrings (6 0 ia43 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia51 F))
+--    (bcStrings (6 0 ia52 F))
+--    (bcStrings (6 0 ia53 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia61 F))
+--    (bcStrings (6 0 ia62 F))
+--    (bcStrings (6 0 ia63 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia71 F))
+--    (bcStrings (6 0 ia72 F))
+--    (bcStrings (6 0 ia73 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia81 F))
+--    (bcStrings (6 0 ia82 F))
+--    (bcStrings (6 0 ia83 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-359" b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "281" b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "85" b3 F)))
+  htMakeDoneButton('"Continue",'f04arfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04arfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+  ia := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    right := STRCONC((first y).1," ")
+    y := rest y
+    bList := [right,:bList]
+  bstring := bcwords2liststring bList
+  y := REVERSE y
+  k := -1
+  matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform] 
+  prefix := STRCONC('"f04arf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n)
+  prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")")
+  bcGen prefix
+
+f04asf() ==
+  htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain I (Integer)))
+    (text . "\windowlink{Manual Page}{manpageXXf04asf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates the accurate solution of a set of real symmetric ")
+    (text . "positive-definite linear equations {\it Ax = b} using an a ")
+    (text . "Cholesky factorization and iterative refinement, ")
+    (text . "where {\it A} is an n * n matrix, {\it x} is an n ")
+    (text . "element vector of unknowns and {\it b} is an n element ")
+    (text . "right-hand side vector.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+--    (text . "{\it IA} first dimension of A:")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\it n} order of matrix A:")
+    (text . "\newline\tab{2} ")
+--    (bcStrings (10 8 ia I))
+--    (text . "\tab{34} ")
+    (bcStrings (10 4 n I))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04asfSolve)
+  htShowPage()
+
+f04asfSolve htPage ==
+  n := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+--  (n = '4 and ia = '8) => f04asfDefaultSolve(htPage,ifail)
+  n = '4 => f04asfDefaultSolve(htPage,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", ianam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k) for k in 1..n] where h(k) ==
+       prefix := ('"\newline \tab{2} ")
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE k)
+       [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :matList,:bmatList]
+  page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04asfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()   
+       
+  
+
+f04asfDefaultSolve (htPage, ifail) ==
+  n := '4
+  ia := '4
+  page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 5 ia11 F))
+    (bcStrings (6 7 ia12 F))
+    (bcStrings (6 6 ia13 F))
+    (bcStrings (6 5 ia14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 7 ia21 F))
+    (bcStrings (6 10 ia22 F))
+    (bcStrings (6 8 ia23 F))
+    (bcStrings (6 7 ia24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 ia31 F))
+    (bcStrings (6 8 ia32 F))
+    (bcStrings (6 10 ia33 F))
+    (bcStrings (6 9 ia34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 5 ia41 F))
+    (bcStrings (6 7 ia42 F))
+    (bcStrings (6 9 ia43 F))
+    (bcStrings (6 10 ia44 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia51 F))
+--    (bcStrings (6 0 ia52 F))
+--    (bcStrings (6 0 ia53 F))
+--    (bcStrings (6 0 ia54 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia61 F))
+--    (bcStrings (6 0 ia62 F))
+--    (bcStrings (6 0 ia63 F))
+--    (bcStrings (6 0 ia64 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia71 F))
+--    (bcStrings (6 0 ia72 F))
+--    (bcStrings (6 0 ia73 F))
+--    (bcStrings (6 0 ia74 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia81 F))
+--    (bcStrings (6 0 ia82 F))
+--    (bcStrings (6 0 ia83 F))
+--    (bcStrings (6 0 ia84 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 23 b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 32 b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 33 b3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 31 b4 F)))
+  htMakeDoneButton('"Continue",'f04asfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04asfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+  ia := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    right := STRCONC((first y).1," ")
+    y := rest y
+    bList := [right,:bList]
+  bstring := bcwords2liststring bList
+  y := REVERSE y
+  k := -1
+  matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform] 
+  prefix := STRCONC('"f04asf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n)
+  prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")")
+  bcGen prefix
+
+f04atf() ==
+  htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+      (isDomain I (Integer)))
+    (text . "\windowlink{Manual Page}{manpageXXf04atf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates the approximate solution of a set of real linear ")
+    (text . "equations {\it Ax = b} using an {\it LU} factorization with ")
+    (text . "pivoting and iterative refinement, ")
+    (text . "where {\it A} is an n * n matrix, {\it x} is an n ")
+    (text . "element vector of unknowns and {\it b} is an n element ")
+    (text . "right-hand side vector.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+--    (text . "{\it IA} first dimension of A:")
+--    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "{\it n} order of matrix A:")
+    (text . "\newline\tab{2} ")
+--    (bcStrings (10 8 ia I))
+--    (text . "\tab{34} ")
+    (bcStrings (10 3 n I))
+--    (text . "\blankline ")
+--    (text . "\newline \menuitemstyle{} \tab{2} ")
+--    (text . "{\it IAA} first dimension of AA:")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (10 8 iaa I))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{} \tab{2} ")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04atfSolve)
+  htShowPage()
+
+f04atfSolve htPage ==
+  n := 
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  ia :=  n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ia)
+  iaa := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaa)
+--    objValUnwrap htpLabelSpadValue(htPage, 'iaa)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+--  (n = '3 and ia = '8) => f04atfDefaultSolve(htPage,iaa,ifail)
+  n = '3 => f04atfDefaultSolve(htPage,iaa,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..ia] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", ianam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k) for k in 1..n] where h(k) ==
+       prefix := ('"\newline \tab{2} ")
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE k)
+       [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :matList,:bmatList]
+  page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04atfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iaa,iaa)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()   
+       
+  
+
+f04atfDefaultSolve (htPage, iaa, ifail) ==
+  n := '3
+  ia := '3
+  page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 33 ia11 F))
+    (bcStrings (6 16 ia12 F))
+    (bcStrings (6 72 ia13 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-24" ia21 F))
+    (bcStrings (6 "-10" ia22 F))
+    (bcStrings (6 "-57" ia23 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-8" ia31 F))
+    (bcStrings (6 "-4" ia32 F))
+    (bcStrings (6 "-17" ia33 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia41 F))
+--    (bcStrings (6 0 ia42 F))
+--    (bcStrings (6 0 ia43 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia51 F))
+--    (bcStrings (6 0 ia52 F))
+--    (bcStrings (6 0 ia53 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia61 F))
+--    (bcStrings (6 0 ia62 F))
+--    (bcStrings (6 0 ia63 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia71 F))
+--    (bcStrings (6 0 ia72 F))
+--    (bcStrings (6 0 ia73 F))
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 0 ia81 F))
+--    (bcStrings (6 0 ia82 F))
+--    (bcStrings (6 0 ia83 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-359" b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "281" b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "85" b3 F)))
+  htMakeDoneButton('"Continue",'f04atfGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'ia,ia)
+--  htpSetProperty(page,'iaa,iaa)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04atfGen htPage ==
+  n := htpProperty(htPage,'n)
+--  ia := htpProperty(htPage,'ia)
+--  iaa := htpProperty(htPage,'iaa)
+  ia := n
+  iaa := n
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    right := STRCONC((first y).1," ")
+    y := rest y
+    bList := [right,:bList]
+  bstring := bcwords2liststring bList
+  y := REVERSE y
+  k := -1
+  matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform] 
+  prefix := STRCONC('"f04atf(",matstring,", ",STRINGIMAGE ia,", [",bstring)
+  prefix := STRCONC(prefix,"],",STRINGIMAGE n,", ",STRINGIMAGE iaa,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  bcGen prefix
+
+
+f04faf() ==
+  htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Calculates the approximate solution of a set of real symmetric ")
+    (text . "positive-definite tridiagonal linear equations {\it Tx = b} ")
+    (text . "using a modified symmetric Gaussian Elimination algorithm, ")
+    (text . "where {\it T} is an n * n matrix, {\it x} is an n ")
+    (text . "element vector of unknowns and {\it b} is an n element ")
+    (text . "right-hand side vector. {\it T} is factorized as ")
+    (text . "\inputbitmap{\htbmdir{}/mkm.bitmap}, where {\it K} is a diagonal matrix ")
+    (text . "and {\it M} is a matrix of multipliers. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "{\it JOB} to be performed by f04faf: ")
+    (radioButtons job
+        ("" " = 0. {\it T} is factorized and equations {\it Tx = b} are solved for x." jobZero)
+        ("" " = 1. {\it T} assumed to be already factorized by previous call to f04faf, the equations {\it Tx = b} are solved for x." jobOne))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Order of the matrix T {\it n}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 5 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04fafSolve)
+  htShowPage()
+
+f04fafSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  number := htpButtonValue(htPage,'job)
+  job :=
+    number = 'jobOne => '1
+    '0
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  n = '5  => f04fafDefaultSolve(htPage,job,ifail)
+  dList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+      prefix := ('"\newline \tab{2} ")
+      dnam := INTERN STRCONC ('"d",STRINGIMAGE i)
+      [['text,:prefix],['bcStrings,[10, 0.0, dnam, 'F]]]
+  prefix := ('"\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T: ")
+  prefix := STRCONC(prefix,"\newline \tab{2} ")
+  dList := [['text,:prefix],:dList]
+  eList := 
+    "append"/[g(j) for j in 1..(n-1)] where g(j) ==
+      prefix := ('"\newline \tab{2} ")
+      enam := INTERN STRCONC ('"e",STRINGIMAGE j)
+      [['text,:prefix],['bcStrings,[10, 0.0, enam, 'F]]]
+  prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it E} E(2) ")
+  prefix := STRCONC(prefix,"to E(N)\newline \tab{2} Job = 0 => super-diagonal")
+  prefix := STRCONC(prefix," elements of {\it T}. \newline \tab{2} Job = 1 =>")
+  prefix := STRCONC(prefix," off-diagonal elements of {\it M} from previous ")
+  prefix := STRCONC(prefix,"call to F04FAF. ")
+  eList := [['text,:prefix],:eList] 
+  bList := 
+    "append"/[h(k) for k in 1..n] where h(k) ==
+      prefix := ('"\newline \tab{2} ")
+      bnam := INTERN STRCONC ('"b",STRINGIMAGE k)
+      [['text,:prefix],['bcStrings,[10, 0.0, bnam, 'F]]]
+  prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it B} Right-hand")
+  prefix := STRCONC(prefix," side vector b: ")
+  bList := [['text,:prefix],:bList] 
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :dList,:eList,:bList]
+  page := htInitPage("F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil)
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'f04fafGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f04fafDefaultSolve  (htPage,job,ifail) == 
+  n := '5
+  page := htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 4 d1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 10 d2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 29 d3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 25 d4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 5 d5 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} {\it E}\space{1} E(2) to E(N) ")
+    (text . "\newline \tab{2} ")
+    (text . "Job = 0 => super-diagonal elements of {\it T}. \newline \tab{2}")
+    (text . "Job = 1 => off-diagonal elements of {\it M} from ")
+    (text . "previous call to F04FAF \newline \tab{2} ")
+    (bcStrings (10 "-2" e2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "-6" e3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 15 e4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 8 e5 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} {\it B} Right-hand side vector b:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 6 b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 9 b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 b3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 14 b4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 7 b5 F)))
+  htMakeDoneButton('"Continue",'f04fafGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'job,job)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04fafGen htPage ==
+  n := htpProperty(htPage,'n)
+  job := htpProperty(htPage,'job)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    b := STRCONC((first y).1," ")
+    bList := [b,:bList]
+    y := rest y
+  bstring := bcwords2liststring bList
+  for i in 1..(n-1) repeat
+    e := STRCONC((first y).1," ")
+    eList := [e,:eList]
+    y := rest y
+  eList := ['"0",:eList]
+  estring := bcwords2liststring eList
+  for i in 1..n repeat
+    d := STRCONC((first y).1," ")
+    dList := [d,:dList]
+    y := rest y
+  dstring := bcwords2liststring dList
+  prefix := STRCONC('"f04faf(",STRINGIMAGE job,", ",STRINGIMAGE n,",[")
+  prefix := STRCONC(prefix,dstring,"], [",estring,"], [",bstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  bcGen prefix
+
+
+f04jgf() ==
+  htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} it n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf04jgf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Finds the solution of a linear least squares problem {\it Ax=b},")
+    (text . " where A is a real m by n matrix, (m \inputbitmap{\htbmdir{}/great=.bitmap}")
+    (text . " n), x is an n element vector of unknowns and b is an m element ")
+    (text . "right-hand side vector.  The routine uses a QU factorization if ")
+    (text . "rank A = n and the SVD if A < n. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline Rows of matrix A, {\it m}: ")
+    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Columns of matrix A, {\it n}: \newline \tab{2} ")
+    (bcStrings (6 6 m PI))
+    (text . "\tab{34} ")
+    (bcStrings (6 4 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+--    (text . "\newline First dimension of A, {\it nra}: ")
+--    (text . "\tab{32}  \menuitemstyle{} \tab{34} ")
+    (text . "Tolerance, {\it tol}: ")
+    (text . "\newline \tab{2} ")
+--    (bcStrings (6 8 nra PI))
+--    (text . "\tab{34} ")
+    (bcStrings (8 "5.0e-4" tol F))
+--    (text . "\blankline ")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Dimension of workspace array {\it lwork}: ")
+--    (text . "\newline \tab{2} ")
+--    (bcStrings (6 32 lwork PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04jgfSolve)
+  htShowPage()
+
+f04jgfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nra := m
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nra)
+--    objValUnwrap htpLabelSpadValue(htPage, 'nra)
+  lwork := 4*n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lwork)
+  tol := htpLabelInputString(htPage,'tol)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '6 and n = '4)  => f04jgfDefaultSolve(htPage,nra,lwork,tol,ifail)
+  matList :=
+    "append"/[f(i,n) for i in 1..m] where f(i,n) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..n] where g(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       labelList := [['text,:prefix],:labelList]
+  bmatList := 
+    "append"/[h(k) for k in 1..m] where h(k) ==
+       prefix := ('"\newline \tab{2} ")
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE k)
+       [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]]
+  start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:")
+  bmatList := [['text,:start],:bmatList]  
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :matList,:bmatList]
+  page := htInitPage("F04JGF - Least-squares (if rank = {\it n}) or minimal least-squares (if rank < {\it n}) solution of {\it m} real equations in {\it n} unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} {\it n}, {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} {\it n}",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04jgfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'nra,nra)
+--  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f04jgfDefaultSolve  (htPage,nra,lwork,tol,ifail) == 
+  n := '4
+  m := '6
+  page := htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float))
+         (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.05" a11 F))
+    (bcStrings (6 "0.05" a12 F))
+    (bcStrings (6 "0.25" a13 F))
+    (bcStrings (6 "-0.25" a14 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.25" a21 F))
+    (bcStrings (6 "0.25" a22 F))
+    (bcStrings (6 "0.05" a23 F))
+    (bcStrings (6 "-0.05" a24 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.35" a31 F))
+    (bcStrings (6 "0.35" a32 F))
+    (bcStrings (6 "1.75" a33 F))
+    (bcStrings (6 "-1.75" a34 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.75" a41 F))
+    (bcStrings (6 "1.75" a42 F))
+    (bcStrings (6 "0.35" a43 F))
+    (bcStrings (6 "-0.35" a44 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.30" a51 F))
+    (bcStrings (6 "-0.30" a52 F))
+    (bcStrings (6 "0.30" a53 F))
+    (bcStrings (6 "0.30" a54 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.40" a61 F))
+    (bcStrings (6 "-0.40" a62 F))
+    (bcStrings (6 "0.40" a63 F))
+    (bcStrings (6 "0.40" a64 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 1 b1 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 2 b2 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 3 b3 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 4 b4 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 5 b5 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 6 b6 F)))
+  htMakeDoneButton('"Continue",'f04jgfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'nra,nra)
+--  htpSetProperty(page,'lwork,lwork)
+  htpSetProperty(page,'tol,tol)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04jgfGen htPage ==
+  n := htpProperty(htPage,'n)
+  m := htpProperty(htPage,'m)
+--  nra := htpProperty(htPage,'nra)
+--  lwork := htpProperty(htPage,'lwork)
+  nra := m
+  lwork := 4*n
+  tol := htpProperty(htPage,'tol)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..m repeat
+    b := STRCONC((first y).1," ")
+    bList := [b,:bList]
+    y := rest y
+  bstring := bcwords2liststring bList
+  y := REVERSE y
+  for i in 1..m repeat
+    for j in 1..n repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [:rowList,elm]
+      y := rest y
+    matform := [:matform,rowList]
+    rowList := []
+  for i in 1..n repeat
+    null := STRCONC('"0.0"," ")
+    nullList := [:nullList,null]
+  for i in m..(nra-1) repeat
+    matform := [:matform,nullList]
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  prefix := STRCONC('"f04jgf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nra,", ",tol,", ",STRINGIMAGE lwork)
+  prefix := STRCONC(prefix,", ",matstring,", [",bstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,")")
+  bcGen prefix
+
+f04mcf() ==
+  htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf04mcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "Computes the approximate solution of a system of real linear ")
+    (text . "equations AX = B, where the n by n symmetric positive-definite ")
+    (text . "variable-bandwidth matrix A has previously been factorized as ")
+    (text . "\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ")
+    (text . "and B is an n by r matrix of right-hand sides. Related systems ")
+    (text . "may also be solved. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the order of the matrix A, {\it n} ")
+    (text ."\htbitmap{great=} 1:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 6 n PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Enter the dimension of AL, {\it lal}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 14 lal PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "\newline Enter the number of right-hand sides, {\it ir}: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 2 ir PI))
+--    (text . "\blankline")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Enter the first dimension of B, {\it nrb}: ")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (9 6 nrb PI))
+--    (text . "\blankline")
+--    (text . "\newline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "\newline Enter the first dimension of X, {\it nrx}: ")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (9 6 nrx PI))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Type of system to be solved, {\it iselct}:")
+    (radioButtons iselct
+        ("" "  {\em \htbitmap{ldlt}X = B} is solved" selone)
+        ("" "  {\em LDX = B} is solved" seltwo)
+        ("" "  {\em D\htbitmap{lt}X = B} is solved" selthree)
+        ("" "  {\em L\htbitmap{lt}X = B} is solved" selfour)
+        ("" "  {\em LX = B} is solved" selfive)
+        ("" "  {\em \htbitmap{lt}X = B} is solved" selsix))
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04mcfSolve)
+  htShowPage()
+
+f04mcfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lal :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal)
+    objValUnwrap htpLabelSpadValue(htPage, 'lal)
+  ir :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ir)
+    objValUnwrap htpLabelSpadValue(htPage, 'ir)
+  nrb := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'nrb)
+  nrx := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrx)
+--    objValUnwrap htpLabelSpadValue(htPage, 'nrx)
+  select := htpButtonValue(htPage,'iselct)
+  iselct :=
+    select = 'selone => '1
+    select = 'seltwo => '2
+    select = 'selthree => '3
+    select = 'selfour => '4
+    select = 'selfive => '5
+    '6
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '6 and lal = '14 and ir = '2) => f04mcfDefaultSolve(htPage,iselct,ifail)
+  labelList :=
+    "append"/[fal(i) for i in 1..lal] where fal(i) ==
+      xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
+      [['bcStrings,[6, "0.0", xnam, 'F]]]
+  dList :=
+    "append"/[fd(i) for i in 1..n] where fd(i) ==
+      dnam := INTERN STRCONC ('"d",STRINGIMAGE i) 
+      [['bcStrings,[6, "0.0", dnam, 'F]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} Diagonal elements of diagon")
+  prefix := STRCONC(prefix,"al matrix D as returned by F01MCF: \newline")
+  dList := [['text,:prefix],:dList]
+  nrowList :=
+    "append"/[gj(j) for j in 1..n] where gj(j) ==
+      nam := INTERN STRCONC ('"n",STRINGIMAGE j) 
+      [['bcStrings,[6, 0, nam, 'PI]]]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ")
+  prefix := STRCONC(prefix,"of the ith row of A: \newline ")
+  nrowList := [['text,:prefix],:nrowList]
+  bList :=
+    "append"/[f(i,ir) for i in 1..nrb] where f(i,ir) ==
+       labelList := 
+	 "append"/[g(i,j) for j in 1..ir] where g(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j)
+            [['bcStrings,[6, "0.0", bnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  prefix := ('"\blankline \menuitemstyle{}\tab{2} The n by r right-hand side ")
+  prefix := STRCONC(prefix,"matrix B: \newline ")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions 
+        (isDomain P (Polynomial $EmptyMode))
+         (isDomain S (String))
+          (isDomain F (Float))
+           (isDomain PI (PositiveInteger))),
+	    :labelList,:dList,:nrowList,:bList]
+  page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil)
+  htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by row "
+  htSay '"order as returned by F01MCF: \newline "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04mcfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'lal,lal)
+  htpSetProperty(page,'ir,ir)
+--  htpSetProperty(page,'nrb,nrb)
+--  htpSetProperty(page,'nrx,nrx)
+  htpSetProperty(page,'iselct,iselct)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+f04mcfDefaultSolve  (htPage,iselct,ifail) ==
+  n := '6
+  lal := '14
+  ir := '2
+  nrb := '6
+  nrx := '6
+  page :=   htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil)
+  htMakePage '(
+    (domainConditions 
+      (isDomain PI (Positive Integer))
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by ")
+    (text . "row order as returned by F01MCF: ") 
+    (text . "\newline ")
+    (bcStrings (6 "1.0" x1 F))
+    (bcStrings (6 "2.0" x2 F))
+    (bcStrings (6 "1.0" x3 F))
+    (bcStrings (6 "3.0" x4 F))
+    (bcStrings (6 "1.0" x5 F))
+    (bcStrings (6 "1.0" x6 F))
+    (bcStrings (6 "5.0" x7 F))
+    (bcStrings (6 "4.0" x8 F))
+    (bcStrings (6 "1.5" x9 F))
+    (bcStrings (6 "0.5" x10 F))
+    (bcStrings (6 "1.0" x11 F))
+    (bcStrings (6 "1.5" x12 F))
+    (bcStrings (6 "5.0" x13 F))
+    (bcStrings (6 "1.0" x14 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} Diagonal elements of diagonal matrix ")
+    (text . "D as returned by F01MCF: ") 
+    (text . "\newline ")
+    (bcStrings (6 "1.0" d1 F))
+    (bcStrings (6 "1.0" d2 F))
+    (bcStrings (6 "4.0" d3 F))
+    (bcStrings (6 "16.0" d4 F))
+    (bcStrings (6 "1.0" d5 F))
+    (bcStrings (6 "16.0" d6 F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ")
+    (text . "of A: ") 
+    (text . "\newline ")
+    (bcStrings (6 1 n1 PI))
+    (bcStrings (6 2 n2 PI))
+    (bcStrings (6 2 n3 PI))
+    (bcStrings (6 1 n4 PI))
+    (bcStrings (6 5 n5 PI))
+    (bcStrings (6 3 n6 PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2} The n by r right-hand side matrix B:")
+    (text . "\newline ")
+    (bcStrings (6 "6" b11 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "-10" b12 PI))
+    (text . "\newline ")
+    (bcStrings (6 "15" b21 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "-21" b22 PI))
+    (text . "\newline ")
+    (bcStrings (6 "11" b31 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "-3" b32 PI))
+    (text . "\newline ")
+    (bcStrings (6 "0" b41 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "24" b42 PI))
+    (text . "\newline ")
+    (bcStrings (6 "51" b51 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "-39" b52 PI))
+    (text . "\newline ")
+    (bcStrings (6 "46" b61 F))
+    (text . "\tab{10} ")
+    (bcStrings (6 "67" b62 PI))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f04mcfGen)    	
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'lal,lal)
+  htpSetProperty(page,'ir,ir)
+--  htpSetProperty(page,'nrb,nrb)
+--  htpSetProperty(page,'nrx,nrx)
+  htpSetProperty(page,'iselct,iselct)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04mcfGen htPage ==
+  n := htpProperty(htPage,'n)
+  lal := htpProperty(htPage,'lal)
+  ir := htpProperty(htPage,'ir)
+--  nrb := htpProperty(htPage,'nrb)
+--  nrx := htpProperty(htPage,'nrx)
+  nrb := n
+  nrx := n
+  iselct := htpProperty(htPage,'iselct)
+  ifail := htpProperty(htPage,'ifail)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..nrb repeat
+    for j in 1..ir repeat
+      elm := STRCONC((first y).1," ")
+      rowList := [elm,:rowList]
+      y := rest y
+    matform := [rowList,:matform]
+    rowList := []
+  matfrom := REVERSE matform
+  matstring := bcwords2liststring [bcwords2liststring x for x in matform]
+  for i in 1..n repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    nrowList := [right,:nrowList]
+  nrowstring := bcwords2liststring nrowList
+  for i in 1..n repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    dList := [right,:dList]
+  dstring := bcwords2liststring dList
+  while y repeat
+    right := STRCONC ((first y).1," ")
+    y := rest y    
+    alList := [right,:alList]
+  alstring := bcwords2liststring alList
+  prefix := STRCONC('"f04mcf(",STRINGIMAGE n,", [",alstring,"], ")
+  prefix := STRCONC(prefix,STRINGIMAGE lal,", [",dstring,"],[",nrowstring)
+  prefix := STRCONC(prefix,"]::Matrix Integer,")
+  prefix := STRCONC(prefix,STRINGIMAGE ir,", ",matstring,", ",STRINGIMAGE nrb)
+  prefix := STRCONC(prefix,", ",STRINGIMAGE iselct,", ",STRINGIMAGE nrx,", ")
+  bcGen STRCONC(prefix,STRINGIMAGE ifail,")")
+
+
+f04axf() ==
+  htInitPage('"F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf04axf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F04AXF calculates the approximate solution of a set of real ")
+    (text . "sparse linear equations {\it Ax=b} or ")
+    (text . "\htbitmap{aTx=b}, where the {\it n} by {\it n} matrix ")
+    (text . "{\it A} has been factorized by F01BRF or F01BSF, {\it x} ")
+    (text . "is an {\it n} element vector of unknowns and {\it b} is an ")
+    (text . "{\it n} element right-hand side vector. ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "Read the input file to see the example program. ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\spadcommand{)read f04axf \bound{s0}} "))
+  htShowPage()
+
+f04maf() ==
+  htInitPage('"F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf04maf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F04MAF solves a real sparse symmetric positive-definite system ")
+    (text . "of linear equations {\it Ax=b} using a pre-conditioned ")
+    (text . "conjugate gradient method, where the {\it n} by {\it n} ")
+    (text . "matrix {\it A} has been factorized by F01MAF, {\it x} is an ")
+    (text . "{\it n} element vector of unknowns and {\it b} is an {\it n} ")
+    (text . "element right-hand side vector. ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "\spadcommand{)read f04maf \bound{s0}} "))
+  htShowPage()
+
+f04mbf() ==
+  htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain PI (PositiveInteger))
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F04MBF solve a system of real symmetric linear equations ")
+    (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ")
+    (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ")
+    (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ")
+    (text . "and {\it b} is an {\it n} element right-hand side vector. ")
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the order {\it n} of matrix {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 10 n PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")    
+    (text . "Is preconditioning required? ")
+    (radioButtons precon
+        (""  " Yes" true)
+        (""  " No" false))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the shift in the equations \lambda, {\it shift} : ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" shift F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the tolerance for convergence, {\it rtol}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.00001" rtol F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter an upper limit for the number of iterations, {\it itnlim}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 100 itnlim PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the printing level, {\it msglvl}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 1 msglvl PI))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04mbfSolve)
+  htShowPage()
+
+f04mbfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  msolve := htpButtonValue(htPage,'precon)
+  precon :=
+    msolve = 'true => 'true
+    'false
+  shift := htpLabelInputString(htPage,'shift)
+  rtol := htpLabelInputString(htPage,'rtol)
+  itnlim :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim)
+    objValUnwrap htpLabelSpadValue(htPage, 'itnlim)
+  msglvl :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl)
+    objValUnwrap htpLabelSpadValue(htPage, 'msglvl)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (n = '10 and precon ='true) => f04mbfDefaultSolve(htPage,shift,rtol,itnlim,msglvl,ifail)
+  bmatList :=
+    "append"/[f(i) for i in 1..n] where f(i) ==
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE i)
+       [['bcStrings,[6, "0.0", bnam, 'F]]]
+  amatList :=
+    "append"/[h(ia,n) for ia in 1..n] where h(ia,n) ==
+       alabelList :=
+         "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       alabelList := [['text,:prefix],:alabelList]
+  start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ")
+  amatList := [['text,:start],:amatList]
+  mmatList:=
+    precon = 'true =>
+     alabelList:=
+      "append"/[l(im,n) for im in 1..n] where l(im,n) ==
+         mlabelList :=
+           "append"/[o(im,jm) for jm in 1..n] where o(im,jm) ==
+              mnam := INTERN STRCONC ('"m",STRINGIMAGE im,STRINGIMAGE jm)
+              [['bcStrings,[6, "0.0", mnam, 'F]]]
+         prefix := ('"\newline \tab{2} ")
+         mlabelList := [['text,:prefix],:mlabelList]
+     start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it m}: ")
+     [['text,:start],:alabelList]
+    []
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :bmatList,:amatList,:mmatList]
+  page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} "
+  htSay '"Enter the right-hand side vector {\it b(n)}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04mbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'precon,precon)
+  htpSetProperty(page,'shift,shift)
+  htpSetProperty(page,'rtol,rtol)
+  htpSetProperty(page,'itnlim,itnlim)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04mbfDefaultSolve (htPage,shift,rtol,itnlim,msglvl,ifail) ==
+  n := '10
+  precon := 'true
+  page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the right-hand side vector {\it b(n)}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "6.0" b1 F))
+    (bcStrings (6 "4.0" b2 F))
+    (bcStrings (6 "4.0" b3 F))
+    (bcStrings (6 "4.0" b4 F))
+    (bcStrings (6 "4.0" b5 F))
+    (bcStrings (6 "4.0" b6 F))
+    (bcStrings (6 "4.0" b7 F))
+    (bcStrings (6 "4.0" b8 F))
+    (bcStrings (6 "4.0" b9 F))
+    (bcStrings (6 "6.0" b10 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the matrix {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" a11 F))
+    (bcStrings (6 "1.0" a12 F))
+    (bcStrings (6 "0.0" a13 F))
+    (bcStrings (6 "0.0" a14 F))
+    (bcStrings (6 "0.0" a15 F))
+    (bcStrings (6 "0.0" a16 F))
+    (bcStrings (6 "0.0" a17 F))
+    (bcStrings (6 "0.0" a18 F))
+    (bcStrings (6 "0.0" a19 F))
+    (bcStrings (6 "3.0" a110 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.0" a21 F))
+    (bcStrings (6 "2.0" a22 F))
+    (bcStrings (6 "1.0" a23 F))
+    (bcStrings (6 "0.0" a24 F))
+    (bcStrings (6 "0.0" a25 F))
+    (bcStrings (6 "0.0" a26 F))
+    (bcStrings (6 "0.0" a27 F))
+    (bcStrings (6 "0.0" a28 F))
+    (bcStrings (6 "0.0" a29 F))
+    (bcStrings (6 "0.0" a210 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a31 F))
+    (bcStrings (6 "1.0" a32 F))
+    (bcStrings (6 "2.0" a33 F))
+    (bcStrings (6 "1.0" a34 F))
+    (bcStrings (6 "0.0" a35 F))
+    (bcStrings (6 "0.0" a36 F))
+    (bcStrings (6 "0.0" a37 F))
+    (bcStrings (6 "0.0" a38 F))
+    (bcStrings (6 "0.0" a39 F))
+    (bcStrings (6 "0.0" a310 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a41 F))
+    (bcStrings (6 "0.0" a42 F))
+    (bcStrings (6 "1.0" a43 F))
+    (bcStrings (6 "2.0" a44 F))
+    (bcStrings (6 "1.0" a45 F))
+    (bcStrings (6 "0.0" a46 F))
+    (bcStrings (6 "0.0" a47 F))
+    (bcStrings (6 "0.0" a48 F))
+    (bcStrings (6 "0.0" a49 F))
+    (bcStrings (6 "0.0" a410 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a51 F))
+    (bcStrings (6 "0.0" a52 F))
+    (bcStrings (6 "0.0" a53 F))
+    (bcStrings (6 "1.0" a54 F))
+    (bcStrings (6 "2.0" a55 F))
+    (bcStrings (6 "1.0" a56 F))
+    (bcStrings (6 "0.0" a57 F))
+    (bcStrings (6 "0.0" a58 F))
+    (bcStrings (6 "0.0" a59 F))
+    (bcStrings (6 "0.0" a510 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a61 F))
+    (bcStrings (6 "0.0" a62 F))
+    (bcStrings (6 "0.0" a63 F))
+    (bcStrings (6 "0.0" a64 F))
+    (bcStrings (6 "1.0" a65 F))
+    (bcStrings (6 "2.0" a66 F))
+    (bcStrings (6 "1.0" a67 F))
+    (bcStrings (6 "0.0" a68 F))
+    (bcStrings (6 "0.0" a69 F))
+    (bcStrings (6 "0.0" a610 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a71 F))
+    (bcStrings (6 "0.0" a72 F))
+    (bcStrings (6 "0.0" a73 F))
+    (bcStrings (6 "0.0" a74 F))
+    (bcStrings (6 "0.0" a75 F))
+    (bcStrings (6 "1.0" a76 F))
+    (bcStrings (6 "2.0" a77 F))
+    (bcStrings (6 "1.0" a78 F))
+    (bcStrings (6 "0.0" a79 F))
+    (bcStrings (6 "0.0" a710 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a81 F))
+    (bcStrings (6 "0.0" a82 F))
+    (bcStrings (6 "0.0" a83 F))
+    (bcStrings (6 "0.0" a84 F))
+    (bcStrings (6 "0.0" a85 F))
+    (bcStrings (6 "0.0" a86 F))
+    (bcStrings (6 "1.0" a87 F))
+    (bcStrings (6 "2.0" a88 F))
+    (bcStrings (6 "1.0" a89 F))
+    (bcStrings (6 "0.0" a810 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a91 F))
+    (bcStrings (6 "0.0" a92 F))
+    (bcStrings (6 "0.0" a93 F))
+    (bcStrings (6 "0.0" a94 F))
+    (bcStrings (6 "0.0" a95 F))
+    (bcStrings (6 "0.0" a96 F))
+    (bcStrings (6 "0.0" a97 F))
+    (bcStrings (6 "1.0" a98 F))
+    (bcStrings (6 "2.0" a99 F))
+    (bcStrings (6 "1.0" a910 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "3.0" a101 F))
+    (bcStrings (6 "0.0" a102 F))
+    (bcStrings (6 "0.0" a103 F))
+    (bcStrings (6 "0.0" a104 F))
+    (bcStrings (6 "0.0" a105 F))
+    (bcStrings (6 "0.0" a106 F))
+    (bcStrings (6 "0.0" a107 F))
+    (bcStrings (6 "0.0" a108 F))
+    (bcStrings (6 "1.0" a109 F))
+    (bcStrings (6 "2.0" a1010 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the matrix {\it m}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "2.0" m11 F))
+    (bcStrings (6 "1.0" m12 F))
+    (bcStrings (6 "0.0" m13 F))
+    (bcStrings (6 "0.0" m14 F))
+    (bcStrings (6 "0.0" m15 F))
+    (bcStrings (6 "0.0" m16 F))
+    (bcStrings (6 "0.0" m17 F))
+    (bcStrings (6 "0.0" m18 F))
+    (bcStrings (6 "0.0" m19 F))
+    (bcStrings (6 "0.0" m110 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.0" m21 F))
+    (bcStrings (6 "2.0" m22 F))
+    (bcStrings (6 "1.0" m23 F))
+    (bcStrings (6 "0.0" m24 F))
+    (bcStrings (6 "0.0" m25 F))
+    (bcStrings (6 "0.0" m26 F))
+    (bcStrings (6 "0.0" m27 F))
+    (bcStrings (6 "0.0" m28 F))
+    (bcStrings (6 "0.0" m29 F))
+    (bcStrings (6 "0.0" m210 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m31 F))
+    (bcStrings (6 "1.0" m32 F))
+    (bcStrings (6 "2.0" m33 F))
+    (bcStrings (6 "1.0" m34 F))
+    (bcStrings (6 "0.0" m35 F))
+    (bcStrings (6 "0.0" m36 F))
+    (bcStrings (6 "0.0" m37 F))
+    (bcStrings (6 "0.0" m38 F))
+    (bcStrings (6 "0.0" m39 F))
+    (bcStrings (6 "0.0" m310 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m41 F))
+    (bcStrings (6 "0.0" m42 F))
+    (bcStrings (6 "1.0" m43 F))
+    (bcStrings (6 "2.0" m44 F))
+    (bcStrings (6 "1.0" m45 F))
+    (bcStrings (6 "0.0" m46 F))
+    (bcStrings (6 "0.0" m47 F))
+    (bcStrings (6 "0.0" m48 F))
+    (bcStrings (6 "0.0" m49 F))
+    (bcStrings (6 "0.0" m410 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m51 F))
+    (bcStrings (6 "0.0" m52 F))
+    (bcStrings (6 "0.0" m53 F))
+    (bcStrings (6 "1.0" m54 F))
+    (bcStrings (6 "2.0" m55 F))
+    (bcStrings (6 "1.0" m56 F))
+    (bcStrings (6 "0.0" m57 F))
+    (bcStrings (6 "0.0" m58 F))
+    (bcStrings (6 "0.0" m59 F))
+    (bcStrings (6 "0.0" m510 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m61 F))
+    (bcStrings (6 "0.0" m62 F))
+    (bcStrings (6 "0.0" m63 F))
+    (bcStrings (6 "0.0" m64 F))
+    (bcStrings (6 "1.0" m65 F))
+    (bcStrings (6 "2.0" m66 F))
+    (bcStrings (6 "1.0" m67 F))
+    (bcStrings (6 "0.0" m68 F))
+    (bcStrings (6 "0.0" m69 F))
+    (bcStrings (6 "0.0" m610 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m71 F))
+    (bcStrings (6 "0.0" m72 F))
+    (bcStrings (6 "0.0" m73 F))
+    (bcStrings (6 "0.0" m74 F))
+    (bcStrings (6 "0.0" m75 F))
+    (bcStrings (6 "1.0" m76 F))
+    (bcStrings (6 "2.0" m77 F))
+    (bcStrings (6 "1.0" m78 F))
+    (bcStrings (6 "0.0" m79 F))
+    (bcStrings (6 "0.0" m710 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m81 F))
+    (bcStrings (6 "0.0" m82 F))
+    (bcStrings (6 "0.0" m83 F))
+    (bcStrings (6 "0.0" m84 F))
+    (bcStrings (6 "0.0" m85 F))
+    (bcStrings (6 "0.0" m86 F))
+    (bcStrings (6 "1.0" m87 F))
+    (bcStrings (6 "2.0" m88 F))
+    (bcStrings (6 "1.0" m89 F))
+    (bcStrings (6 "0.0" m810 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m91 F))
+    (bcStrings (6 "0.0" m92 F))
+    (bcStrings (6 "0.0" m93 F))
+    (bcStrings (6 "0.0" m94 F))
+    (bcStrings (6 "0.0" m95 F))
+    (bcStrings (6 "0.0" m96 F))
+    (bcStrings (6 "0.0" m97 F))
+    (bcStrings (6 "1.0" m98 F))
+    (bcStrings (6 "2.0" m99 F))
+    (bcStrings (6 "1.0" m910 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" m101 F))
+    (bcStrings (6 "0.0" m102 F))
+    (bcStrings (6 "0.0" m103 F))
+    (bcStrings (6 "0.0" m104 F))
+    (bcStrings (6 "0.0" m105 F))
+    (bcStrings (6 "0.0" m106 F))
+    (bcStrings (6 "0.0" m107 F))
+    (bcStrings (6 "0.0" m108 F))
+    (bcStrings (6 "1.0" m109 F))
+    (bcStrings (6 "2.0" m1010 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f04mbfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'precon,precon)
+  htpSetProperty(page,'shift,shift)
+  htpSetProperty(page,'rtol,rtol)
+  htpSetProperty(page,'itnlim,itnlim)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04mbfGen htPage ==
+  n := htpProperty(htPage,'n)
+  precon := htpProperty(htPage,'precon)
+  shift := htpProperty(htPage,'shift)
+  rtol := htpProperty(htPage,'rtol)
+  itnlim := htpProperty(htPage,'itnlim)
+  msglvl := htpProperty(htPage,'msglvl)
+  ifail := htpProperty(htPage,'ifail)
+  lrwork := '1
+  liwork := '1
+  alist := htpInputAreaAlist htPage
+  y := alist
+  if (precon = 'true) then
+    for i in 1..n repeat
+      for j in 1..n repeat
+        melm := STRCONC((first y).1," ")
+        mrowlist := [melm,:mrowlist]
+        y := rest y
+      matm := [mrowlist,:matm]
+      mrowlist := []
+    mstring := bcwords2liststring [bcwords2liststring x for x in matm]
+  for k in 1..n repeat
+    for l in 1..n repeat
+      aelm := STRCONC((first y).1," ")
+      arowlist := [aelm,:arowlist]
+      y := rest y
+    mata := [arowlist,:mata]
+    arowlist := []
+  astring := bcwords2liststring [bcwords2liststring y for y in mata]
+  for z in 1..n repeat
+    belm := STRCONC((first y).1," ")
+    blist := [belm,:blist]
+    y := rest y
+  bstring := bcwords2liststring blist
+  if (precon = 'false) then
+    mstring := astring
+  prefix := STRCONC('"f04mbf(",STRINGIMAGE n,",[",bstring,"]::Matrix DoubleFloat,",precon,",")
+  prefix := STRCONC(prefix,STRINGIMAGE shift,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",")
+  prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",")
+  prefix := STRCONC(prefix,STRINGIMAGE rtol,",",STRINGIMAGE ifail,",((")
+  prefix := STRCONC(prefix,astring,"::Matrix MachineFloat)::ASP28(APROD)),((")
+  prefix := STRCONC(prefix,mstring,"::Matrix MachineFloat)::ASP34(MSOLVE)))")
+  linkGen prefix
+
+
+-- f04qaf() ==
+--   htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil)
+--   htMakePage '(
+--     (domainConditions
+--        (isDomain EM $EmptyMode)
+--        (isDomain F (Float)))
+--     (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ")
+--     (text . "\newline ")
+--     (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine")
+--     (text . "\newline \horizontalline ")
+--     (text . "\newline ")
+--     (text . "F04QAF solves sparse unsymmetric equations, sparse linear ")
+--     (text . "least-squares problems and sparse damped least-squares ")
+--     (text . "problems, using a Lanczos algorithm. Specifically, the ")
+--     (text . "routine can be used to solve a system of linear equations ")
+--     (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ")
+--     (text . "sparse unsymmetric matrix, or can be used to solve linear ")
+--     (text . "least-squares problems, so that it minimizes the the value ")
+--     (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ")
+--     (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ")
+--     (text . "sparse matrix. A damping parameter \lambda may ")
+--     (text . "be included in the least squares problem in which case the ")
+--     (text . "routine minimizes the value {\htbitmap{newrho}} given by ")
+--     (text . "{\htbitmap{rhosq=}}. \newline ")
+--     (text . "\blankline ")
+--     (text . "\menuitemstyle{}\tab{2}")
+--     (text . "\spadcommand{)read f04qaf \bound{s0}} "))
+--   htShowPage()
+
+-- f04mbf() ==
+--   htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil)
+--   htMakePage '(
+--     (domainConditions
+--        (isDomain EM $EmptyMode)
+--        (isDomain F (Float)))
+--     (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ")
+--     (text . "\newline ")
+--     (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine")
+--     (text . "\newline \horizontalline ")
+--     (text . "\newline ")
+--     (text . "\newline ")
+--     (text . "F04MBF solve a system of real symmetric linear equations ")
+--     (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ")
+--     (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ")
+--     (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ")
+--     (text . "and {\it b} is an {\it n} element right-hand side vector. ")
+--     (text . "\blankline")
+--     (text . "\newline ")
+--     (text . "\menuitemstyle{}\tab{2} ")
+--     (text . "\spadcommand{)read f04mbf \bound{s0}} "))
+--   htShowPage()
+
+f04qaf() ==
+  htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain PI (PositiveInteger))
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F04QAF solves sparse unsymmetric equations, sparse linear ")
+    (text . "least-squares problems and sparse damped least-squares ")
+    (text . "problems, using a Lanczos algorithm. Specifically, the ")
+    (text . "routine can be used to solve a system of linear equations ")
+    (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ")
+    (text . "sparse unsymmetric matrix, or can be used to solve linear ")
+    (text . "least-squares problems, so that it minimizes the the value ")
+    (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ")
+    (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ")
+    (text . "sparse matrix. A damping parameter \lambda may ")
+    (text . "be included in the least squares problem in which case the ")
+    (text . "routine minimizes the value {\htbitmap{newrho}} given by ")
+    (text . "{\htbitmap{rhosq=}}. \newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of rows of the matrix {\it A}, {\it m}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 13 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the number of columns of the matrix {\it A}, {\it n}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 12 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the damping parameter \lambda, {\it damp}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.0" damp F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the tolerance for elements of {\it A}, {\it atol}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.00001" atol F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the tolerance for elements of {\it b}, {\it btol}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 "0.0001" btol F))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the maximum number of iterations {\it itnlim}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 100 itnlim PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the printing level {\it msglvl}:")
+    (text . "\newline \tab{2}")
+    (bcStrings (10 1 msglvl PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'f04qafSolve)   
+  htShowPage()
+
+f04qafSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  damp := htpLabelInputString(htPage,'damp)
+  atol := htpLabelInputString(htPage,'atol)
+  btol := htpLabelInputString(htPage,'btol)
+  itnlim :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim)
+    objValUnwrap htpLabelSpadValue(htPage, 'itnlim)
+  msglvl :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl)
+    objValUnwrap htpLabelSpadValue(htPage, 'msglvl)
+  error := htpButtonValue(htPage,'ifail)
+  ifail :=
+    error = 'one => '1
+    '-1
+  (m = '13 and n = '12) => f04qafDefaultSolve(htPage,damp,atol,btol,itnlim,msglvl,ifail)
+  bmatList :=
+    "append"/[f(i) for i in 1..m] where f(i) ==
+       bnam := INTERN STRCONC ('"b",STRINGIMAGE i)
+       [['bcStrings,[6, "0.0", bnam, 'F]]]
+  amatList :=
+    "append"/[h(ia,n) for ia in 1..m] where h(ia,n) ==
+       alabelList :=
+         "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja)
+            [['bcStrings,[6, "0.0", anam, 'F]]]
+       prefix := ('"\newline \tab{2} ")
+       alabelList := [['text,:prefix],:alabelList]
+  start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ")
+  amatList := [['text,:start],:amatList]
+  equationPart := [
+     '(domainConditions
+        (isDomain P (Polynomial $EmptyMode))
+          (isDomain F (Float))),
+            :bmatList,:amatList]
+  page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil)
+  htSay '"\newline \menuitemstyle{}\tab{2} "
+  htSay '"Enter the right-hand side vector {\it b(m)}: "
+  htSay '"\newline \tab{2} "
+  htMakePage equationPart
+  htSay '"\blankline "
+  htMakeDoneButton('"Continue",'f04qafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'damp,damp)
+  htpSetProperty(page,'atol,atol)
+  htpSetProperty(page,'btol,btol)
+  htpSetProperty(page,'itnlim,itnlim)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+
+
+f04qafDefaultSolve (htPage,damp,atol,btol,itnlim,msglvl,ifail) ==
+  m := '13
+  n := '12
+  page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the right-hand side vector {\it b(n)}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" b1 F))
+    (bcStrings (6 "0.0" b2 F))
+    (bcStrings (6 "0.0" b3 F))
+    (bcStrings (6 "-0.01" b4 F))
+    (bcStrings (6 "-0.01" b5 F))
+    (bcStrings (6 "0.0" b6 F))
+    (bcStrings (6 "0.0" b7 F))
+    (bcStrings (6 "-0.01" b8 F))
+    (bcStrings (6 "-0.01" b9 F))
+    (bcStrings (6 "0.0" b10 F))
+    (bcStrings (6 "0.0" b11 F))
+    (bcStrings (6 "0.0" b12 F))
+    (bcStrings (6 "10.0" b13 F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2} ")
+    (text . "Enter the matrix {\it A}: ")
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.0" a0101 F))
+    (bcStrings (6 "0.0" a0102 F))
+    (bcStrings (6 "0.0" a0103 F))
+    (bcStrings (6 "-1.0" a0104 F))
+    (bcStrings (6 "0.0" a0105 F))
+    (bcStrings (6 "0.0" a0106 F))
+    (bcStrings (6 "0.0" a0107 F))
+    (bcStrings (6 "0.0" a0108 F))
+    (bcStrings (6 "0.0" a0109 F))
+    (bcStrings (6 "0.0" a0110 F))
+    (bcStrings (6 "0.0" a0111 F))
+    (bcStrings (6 "0.0" a0112 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0201 F))
+    (bcStrings (6 "1.0" a0202 F))
+    (bcStrings (6 "0.0" a0203 F))
+    (bcStrings (6 "0.0" a0204 F))
+    (bcStrings (6 "-1.0" a0205 F))
+    (bcStrings (6 "0.0" a0206 F))
+    (bcStrings (6 "0.0" a0207 F))
+    (bcStrings (6 "0.0" a0208 F))
+    (bcStrings (6 "0.0" a0209 F))
+    (bcStrings (6 "0.0" a0210 F))
+    (bcStrings (6 "0.0" a0211 F))
+    (bcStrings (6 "0.0" a0212 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0301 F))
+    (bcStrings (6 "0.0" a0302 F))
+    (bcStrings (6 "1.0" a0303 F))
+    (bcStrings (6 "-1.0" a0304 F))
+    (bcStrings (6 "0.0" a0305 F))
+    (bcStrings (6 "0.0" a0306 F))
+    (bcStrings (6 "0.0" a0307 F))
+    (bcStrings (6 "0.0" a0308 F))
+    (bcStrings (6 "0.0" a0309 F))
+    (bcStrings (6 "0.0" a0310 F))
+    (bcStrings (6 "0.0" a0311 F))
+    (bcStrings (6 "0.0" a0312 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "-1.0" a0401 F))
+    (bcStrings (6 "0.0" a0402 F))
+    (bcStrings (6 "-1.0" a0403 F))
+    (bcStrings (6 "4.0" a0404 F))
+    (bcStrings (6 "-1.0" a0405 F))
+    (bcStrings (6 "0.0" a0406 F))
+    (bcStrings (6 "0.0" a0407 F))
+    (bcStrings (6 "-1.0" a0408 F))
+    (bcStrings (6 "0.0" a0409 F))
+    (bcStrings (6 "0.0" a0410 F))
+    (bcStrings (6 "0.0" a0411 F))
+    (bcStrings (6 "0.0" a0412 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0501 F))
+    (bcStrings (6 "-1.0" a0502 F))
+    (bcStrings (6 "0.0" a0503 F))
+    (bcStrings (6 "-1.0" a0504 F))
+    (bcStrings (6 "4.0" a0505 F))
+    (bcStrings (6 "-1.0" a0506 F))
+    (bcStrings (6 "0.0" a0507 F))
+    (bcStrings (6 "0.0" a0508 F))
+    (bcStrings (6 "-1.0" a0509 F))
+    (bcStrings (6 "0.0" a0510 F))
+    (bcStrings (6 "0.0" a0511 F))
+    (bcStrings (6 "0.0" a0512 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0601 F))
+    (bcStrings (6 "0.0" a0602 F))
+    (bcStrings (6 "0.0" a0603 F))
+    (bcStrings (6 "0.0" a0604 F))
+    (bcStrings (6 "-1.0" a0605 F))
+    (bcStrings (6 "1.0" a0606 F))
+    (bcStrings (6 "0.0" a0607 F))
+    (bcStrings (6 "0.0" a0608 F))
+    (bcStrings (6 "0.0" a0609 F))
+    (bcStrings (6 "0.0" a0610 F))
+    (bcStrings (6 "0.0" a0611 F))
+    (bcStrings (6 "0.0" a0612 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0701 F))
+    (bcStrings (6 "0.0" a0702 F))
+    (bcStrings (6 "0.0" a0703 F))
+    (bcStrings (6 "0.0" a0704 F))
+    (bcStrings (6 "0.0" a0705 F))
+    (bcStrings (6 "0.0" a0706 F))
+    (bcStrings (6 "1.0" a0707 F))
+    (bcStrings (6 "-1.0" a0708 F))
+    (bcStrings (6 "0.0" a0709 F))
+    (bcStrings (6 "0.0" a0710 F))
+    (bcStrings (6 "0.0" a0711 F))
+    (bcStrings (6 "0.0" a0712 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0801 F))
+    (bcStrings (6 "0.0" a0802 F))
+    (bcStrings (6 "0.0" a0803 F))
+    (bcStrings (6 "-1.0" a0804 F))
+    (bcStrings (6 "0.0" a0805 F))
+    (bcStrings (6 "0.0" a0806 F))
+    (bcStrings (6 "-1.0" a0807 F))
+    (bcStrings (6 "4.0" a0808 F))
+    (bcStrings (6 "-1.0" a0809 F))
+    (bcStrings (6 "0.0" a0810 F))
+    (bcStrings (6 "-1.0" a0811 F))
+    (bcStrings (6 "0.0" a0812 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a0901 F))
+    (bcStrings (6 "0.0" a0902 F))
+    (bcStrings (6 "0.0" a0903 F))
+    (bcStrings (6 "0.0" a0904 F))
+    (bcStrings (6 "-1.0" a0905 F))
+    (bcStrings (6 "0.0" a0906 F))
+    (bcStrings (6 "0.0" a0907 F))
+    (bcStrings (6 "-1.0" a0908 F))
+    (bcStrings (6 "4.0" a0909 F))
+    (bcStrings (6 "-1.0" a0910 F))
+    (bcStrings (6 "0.0" a0911 F))
+    (bcStrings (6 "-1.0" a0912 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a1001 F))
+    (bcStrings (6 "0.0" a1002 F))
+    (bcStrings (6 "0.0" a1003 F))
+    (bcStrings (6 "0.0" a1004 F))
+    (bcStrings (6 "0.0" a1005 F))
+    (bcStrings (6 "0.0" a1006 F))
+    (bcStrings (6 "0.0" a1007 F))
+    (bcStrings (6 "0.0" a1008 F))
+    (bcStrings (6 "-1.0" a1009 F))
+    (bcStrings (6 "1.0" a1010 F))
+    (bcStrings (6 "0.0" a1011 F))
+    (bcStrings (6 "0.0" a1012 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a1101 F))
+    (bcStrings (6 "0.0" a1102 F))
+    (bcStrings (6 "0.0" a1103 F))
+    (bcStrings (6 "0.0" a1104 F))
+    (bcStrings (6 "0.0" a1105 F))
+    (bcStrings (6 "0.0" a1106 F))
+    (bcStrings (6 "0.0" a1107 F))
+    (bcStrings (6 "-1.0" a1108 F))
+    (bcStrings (6 "0.0" a1109 F))
+    (bcStrings (6 "0.0" a1110 F))
+    (bcStrings (6 "1.0" a1111 F))
+    (bcStrings (6 "0.0" a1112 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "0.0" a1201 F))
+    (bcStrings (6 "0.0" a1202 F))
+    (bcStrings (6 "0.0" a1203 F))
+    (bcStrings (6 "0.0" a1204 F))
+    (bcStrings (6 "0.0" a1205 F))
+    (bcStrings (6 "0.0" a1206 F))
+    (bcStrings (6 "0.0" a1207 F))
+    (bcStrings (6 "0.0" a1208 F))
+    (bcStrings (6 "-1.0" a1209 F))
+    (bcStrings (6 "0.0" a1210 F))
+    (bcStrings (6 "0.0" a1211 F))
+    (bcStrings (6 "1.0" a1212 F))
+    (text . "\newline \tab{2} ")
+    (bcStrings (6 "1.0" a1301 F))
+    (bcStrings (6 "1.0" a1302 F))
+    (bcStrings (6 "1.0" a1303 F))
+    (bcStrings (6 "0.0" a1304 F))
+    (bcStrings (6 "0.0" a1305 F))
+    (bcStrings (6 "1.0" a1306 F))
+    (bcStrings (6 "1.0" a1307 F))
+    (bcStrings (6 "0.0" a1308 F))
+    (bcStrings (6 "0.0" a1309 F))
+    (bcStrings (6 "1.0" a1310 F))
+    (bcStrings (6 "1.0" a1311 F))
+    (bcStrings (6 "1.0" a1312 F))
+    (text . "\blankline "))
+  htMakeDoneButton('"Continue",'f04qafGen)
+  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'damp,damp)
+  htpSetProperty(page,'atol,atol)
+  htpSetProperty(page,'btol,btol)
+  htpSetProperty(page,'itnlim,itnlim)
+  htpSetProperty(page,'msglvl,msglvl)
+  htpSetProperty(page,'ifail,ifail)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f04qafGen htPage ==
+  m := htpProperty(htPage,'m)
+  n := htpProperty(htPage,'n)
+  damp := htpProperty(htPage,'damp)
+  atol := htpProperty(htPage,'atol)
+  btol := htpProperty(htPage,'btol)
+  divisor := READ_-FROM_-STRING(atol)
+  if (divisor < 1.0e-7) then divisor:=1.0e-7
+  conlim := 1.0/divisor
+  itnlim := htpProperty(htPage,'itnlim)
+  msglvl := htpProperty(htPage,'msglvl)
+  ifail := htpProperty(htPage,'ifail)
+  lrwork := 1
+  liwork := 1
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for k in 1..m repeat
+    for l in 1..n repeat
+      aelm := STRCONC((first y).1," ")
+      arowlist := [aelm,:arowlist]
+      y := rest y
+    mata := [arowlist,:mata]
+    arowlist := []
+  astring := bcwords2liststring [bcwords2liststring y for y in mata]
+  for z in 1..m repeat
+    belm := STRCONC((first y).1," ")
+    blist := [belm,:blist]
+    y := rest y
+  bstring := bcwords2liststring blist
+  prefix := STRCONC('"f04qaf(",STRINGIMAGE m,",",STRINGIMAGE n,",")
+  prefix := STRCONC(prefix,STRINGIMAGE damp,",")
+  prefix := STRCONC(prefix,STRINGIMAGE atol,",",STRINGIMAGE btol,",")
+  prefix := STRCONC(prefix,STRINGIMAGE conlim,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",")
+  prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",")
+  prefix := STRCONC(prefix,"[",bstring,"]::Matrix DoubleFloat,")
+  prefix := STRCONC(prefix,STRINGIMAGE ifail,",((",astring,"::Matrix MachineFloat)::ASP30(APROD)))")
+  linkGen prefix
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-f07.boot.pamphlet b/src/interp/nag-f07.boot.pamphlet
new file mode 100644
index 00000000..3de2bb32
--- /dev/null
+++ b/src/interp/nag-f07.boot.pamphlet
@@ -0,0 +1,726 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-f07.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+f07adf() ==
+  htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf07adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F07ADF computes the {\it LU} factorization of a real {\it m}")
+    (text . " by {\it n} matrix ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of rows {\it m}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 4 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of columns {\it n}:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (5 4 n PI))
+    )
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of array A, {\it lda}:")
+--    (text . "\newline\tab{2} ")
+--    (bcStrings (5 4 lda PI))
+  htMakeDoneButton('"Continue", 'f07adfSolve)
+  htShowPage()
+
+f07adfSolve htPage ==
+  m :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := m
+  (n = '4 and m = '4) => f07adfDefaultSolve(htPage,lda)
+  aList := 
+    "append"/[fa(i,n) for i in 1..m] where fa(i,n) ==
+       labelList := 
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings,[6, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions 
+	(isDomain EM $EmptyMode)
+          (isDomain S (String))
+            (isDomain F (Float))
+	      (isDomain I (Integer))),
+ 		:aList]
+  page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the array {\it A}:"
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'f07adfGen)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07adfDefaultSolve (htPage,lda)   ==
+  n := '4
+  m := '4
+  page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the array {\it A}:")
+    (text . "\newline ")
+    (bcStrings (5 "1.8" a11 F))
+    (bcStrings (5 "2.88" a12 F))
+    (bcStrings (5 "2.05" a13 F))
+    (bcStrings (5 "-0.89" a14 F))
+    (text . "\newline ")
+    (bcStrings (5 "5.25" a21 F))
+    (bcStrings (5 "-2.95" a22 F))
+    (bcStrings (5 "-0.95" a23 F))
+    (bcStrings (5 "-3.8" a24 F))
+    (text . "\newline ")
+    (bcStrings (5 "1.58" a31 F))
+    (bcStrings (5 "-2.69" a32 F))
+    (bcStrings (5 "-2.9" a33 F))
+    (bcStrings (5 "-1.04" a34 F))
+    (text . "\newline ")
+    (bcStrings (5 "-1.11" a41 F))
+    (bcStrings (5 "-0.66" a42 F))
+    (bcStrings (5 "-0.59" a43 F))
+    (bcStrings (5 "0.8" a44 F)))
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'m,m)
+--  htpSetProperty(page,'lda,lda)
+  htMakeDoneButton('"Continue",'f07adfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07adfGen htPage ==
+  n := htpProperty(htPage, 'n)
+  m := htpProperty(htPage, 'm)
+  lda := m
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    for j in 1..m repeat
+      a := STRCONC((first y).1," ")
+      rowList := [a,:rowList]
+      y := rest y
+    aList := [rowList,:aList]
+    rowList := []
+  astring := bcwords2liststring [bcwords2liststring x for x in aList]
+  prefix := STRCONC("f07adf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")")
+  linkGen prefix
+  
+
+f07aef() ==
+  htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf07aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\it AX=B} or ")
+    (text . "\htbitmap{aTx=b} , where {\it a} has been factorized by F07ADF ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Form of the equations:")
+    (text . "\blankline ")
+    (radioButtons trans
+        ("" "  N, the equations are {\it AX=B}" norm)
+        ("" "  T, the equations are \htbitmap{aTx=b}" transp))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The order {\it n} of {\it A}: ")
+    (text . "\newline ")
+    (bcStrings (5 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "The order {\it m} of {\it A} used by F07AEF: ")
+--    (text . "\newline ")
+--    (bcStrings (5 4 m PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The number of right-hand sides, {\it nrhs}: ")
+    (text . "\newline ")
+    (bcStrings (5 2 nrhs PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of {\it A}, {\it lda}: ")
+--    (text . "\newline ")
+--    (bcStrings (5 4 lda PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of {\it B}, {\it ldb}: ")
+--    (text . "\newline ")
+--    (bcStrings (5 4 ldb PI))
+  )
+  htMakeDoneButton('"Continue", 'f07aefSolve)
+  htShowPage()
+
+f07aefSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+--  m :=
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
+--    objValUnwrap htpLabelSpadValue(htPage, 'm)
+  nrhs :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrhs)
+  lda := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  equa := htpButtonValue(htPage, 'trans)
+  trans :=
+    equa = 'norm => '"N"
+    '"T"
+  (n = '4 and nrhs = '2 ) => f07aefDefaultSolve (htPage,trans)
+  aList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList :=
+         "append"/[faa(i,j) for j in 1..n] where faa(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings, [6, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  ipList :=
+       [fp(i) for i in 1..n] where fp(i) ==
+           ipnam := INTERN STRCONC ('"ip",STRINGIMAGE i)
+           ['bcStrings,[5, 0, ipnam, 'I]]
+  middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the pivot ")
+  middle := STRCONC(middle,'"indices {\it IPIV} from F07ADF: ")
+  middle := STRCONC(middle,'"\newline ")
+  ipList := [['text,:middle],:ipList]
+  bList :=
+    "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) ==
+       labelList :=
+         "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings, [6, 0, bnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions
+         (isDomain EM $EmptyMode)
+         (isDomain S (String))
+         (isDomain F (Float))
+         (isDomain I (Integer)))
+	     ,:aList,:ipList,:bList]
+  page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the matrix {\it A}:"
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'f07aefGen)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'m,m)
+  htpSetProperty(page,'nrhs,nrhs)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07aefDefaultSolve (htPage,trans) ==
+  n := '4
+  nrhs := '2
+  lda := '4
+  ldb := '4
+  length := '4
+  page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it A}:")
+    (text . "\newline ")
+    (bcStrings (5 "5.25" a11 F))
+    (bcStrings (5 "-2.95" a12 F))
+    (bcStrings (5 "-0.95" a13 F))
+    (bcStrings (5 "-3.8" a14 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.34" a21 F))
+    (bcStrings (5 "3.89" a22 F))
+    (bcStrings (5 "2.38" a23 F))
+    (bcStrings (5 "0.41" a24 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.3" a31 F))
+    (bcStrings (5 "-0.46" a32 F))
+    (bcStrings (5 "-1.51" a33 F))
+    (bcStrings (5 "0.29" a34 F))
+    (text . "\newline ")
+    (bcStrings (5 "-0.21" a41 F))
+    (bcStrings (5 "-0.33" a42 F))
+    (bcStrings (5 "0.00" a43 F))
+    (bcStrings (5 "0.13" a44 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the pivot indices {\it IPIV} from F07ADF: ")
+    (text . "\newline ")
+    (bcStrings (5 2 ip1 PI))
+    (bcStrings (5 2 ip2 PI))
+    (bcStrings (5 3 ip3 PI))
+    (bcStrings (5 4 ip4 PI))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it B}:")
+    (text . "\newline ")
+    (bcStrings (5 "9.52" b11 F))
+    (bcStrings (5 "18.47" b12 F))
+    (text . "\newline ")
+    (bcStrings (5 "24.35" b21 F))
+    (bcStrings (5 "2.25" b22 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.77" b31 F))
+    (bcStrings (5 "-13.28" b32 F))
+    (text . "\newline ")
+    (bcStrings (5 "-6.22" b41 F))
+    (bcStrings (5 "-6.21" b42 F)))
+  htpSetProperty(page,'trans,trans)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nrhs,nrhs)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'length,length)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htMakeDoneButton('"Continue",'f07aefGen)
+  htShowPage()
+
+f07aefGen htPage ==
+  n := htpProperty(htPage, 'n)
+  nrhs := htpProperty(htPage, 'nrhs)
+--  lda := htpProperty(htPage, 'lda)
+--  ldb := htpProperty(htPage, 'ldb)
+  lda := n
+  ldb := n
+  length := htpProperty(htPage, 'length)
+  trans := htpProperty(htPage,'trans)
+  aplist := htpInputAreaAlist htPage
+  y := aplist
+  for i in 1..n repeat
+    for j in 1..nrhs repeat
+      b := STRCONC((first y).1," ")
+      rowList := [b,:rowList]
+      y := rest y
+    bList := [rowList,:bList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bList]
+  for i in 1..length repeat
+    ip := STRCONC((first y).1," ")
+    ipList := [ip,:ipList]
+    y := rest y
+  ipstring := bcwords2liststring ipList
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      a := STRCONC((first y).1," ")
+      rowList := [a,:rowList]
+      y := rest y
+    aList := [rowList,:aList]
+    rowList := []
+  astring := bcwords2liststring [bcwords2liststring x for x in aList]
+  prefix := STRCONC("f07aef(_"", trans,"_", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", [",ipstring,"]::Matrix INT, ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)")
+  linkGen prefix
+
+f07fdf() ==
+  htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf07fdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ")
+    (text . "matrix {\it A} ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Method of factorization of {\it A}, {\it UPLO}:")
+    (text . "\blankline ")
+    (radioButtons uplo
+        ("" "  L, {\it A} factorized as lower triangular" lower)
+        ("" "  U, {\it A} factorized as upper triangular" upper))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The order {\it n} of {\it A}: ")
+    (text . "\newline ")
+    (bcStrings (5 4 n PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of {\it A}, {\it lda}:")
+--    (text . "\newline ")
+--    (bcStrings (5 4 lda PI)))
+    )
+  htMakeDoneButton('"Continue", 'f07fdfSolve)
+  htShowPage()
+
+f07fdfSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  lda := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  upl := htpButtonValue(htPage, 'uplo)
+  uplo:=
+    upl = 'lower => '"L"
+    '"U"
+  (n = '4 ) => f07fdfDefaultSolve(htPage,uplo)
+  aList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList :=
+         "append"/[fb(i,j) for j in 1..n] where fb(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings, [6, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  equationPart := [
+     '(domainConditions
+        (isDomain EM $EmptyMode)
+          (isDomain S  (String))
+            (isDomain F  (Float))
+              (isDomain I (Integer))),
+                :aList]
+  page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the matrix {\it A}:"
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'f07fdfGen)
+  htpSetProperty(page,'uplo,uplo)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'lda,lda)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07fdfDefaultSolve (htPage,uplo) ==
+  n := '4
+  lda := '4
+  page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it A}:")
+    (text . "\newline ")
+    (bcStrings (5 "4.16" a11 F))
+    (bcStrings (5 "0.0" a12 F))
+    (bcStrings (5 "0.0" a13 F))
+    (bcStrings (5 "0.0" a14 F))
+    (text . "\newline ")
+    (bcStrings (5 "-3.12" a21 F))
+    (bcStrings (5 "5.03" a22 F))
+    (bcStrings (5 "0.0" a23 F))
+    (bcStrings (5 "0.0" a24 F))
+    (text . "\newline ")
+    (bcStrings (5 "0.56" a31 F))
+    (bcStrings (5 "-0.83" a32 F))
+    (bcStrings (5 "0.76" a33 F))
+    (bcStrings (5 "0.0" a34 F))
+    (text . "\newline ")
+    (bcStrings (5 "-0.1" a41 F))
+    (bcStrings (5 "1.18" a42 F))
+    (bcStrings (5 "0.34" a43 F))
+    (bcStrings (5 "1.18" a44 F)))
+  htpSetProperty(page,'uplo,uplo)
+  htpSetProperty(page,'n,n)
+--  htpSetProperty(page,'lda,lda)
+  htMakeDoneButton('"Continue",'f07fdfGen)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07fdfGen htPage ==
+  n := htpProperty(htPage, 'n)
+--  lda := htpProperty(htPage, 'lda)
+  lda := n
+  uplo := htpProperty(htPage,'uplo)
+  alist := htpInputAreaAlist htPage
+  y := alist
+  for i in 1..n repeat
+    for j in 1..n repeat
+      a := STRCONC((first y).1," ")
+      rowList := [a,:rowList]
+      y := rest y
+    aList := [rowList,:aList]
+    rowList := []
+  astring := bcwords2liststring [bcwords2liststring x for x in aList]
+  prefix := STRCONC("f07fdf(_"", uplo,"_", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")")
+  linkGen prefix
+  
+
+f07fef() ==
+  htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXf07fef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "F07FEF solves a real symmetric positive-definite system of linear ")
+    (text . "equations with multiple right-hand sides, {\it AX=B}, where ")
+    (text . "{\it A} has been factorized by F07FDF ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Method of factorization of {\it A}, {\it UPLO}:")
+    (text . "\blankline ")
+    (radioButtons uplo
+        ("" "  L, {\it A} factorized as lower triangular" lower)
+        ("" "  U, {\it A} factorized as upper triangular" upper))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The order {\it n} of {\it A}: ")
+    (text . "\newline ")
+    (bcStrings (5 4 n PI))
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "The number of right-hand sides, {\it nrhs}: ")
+    (text . "\newline ")
+    (bcStrings (5 2 nrhs PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of {\it A}, {\it lda}: ")
+--    (text . "\newline ")
+--    (bcStrings (5 4 lda PI))
+--    (text . "\blankline ")
+--    (text . "\menuitemstyle{}\tab{2}")
+--    (text . "First dimension of {\it B}, {\it ldb}: ")
+--    (text . "\newline ")
+--    (bcStrings (5 4 ldb PI)))
+    )
+  htMakeDoneButton('"Continue", 'f07fefSolve)
+  htShowPage()
+
+f07fefSolve htPage ==
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  nrhs :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs)
+    objValUnwrap htpLabelSpadValue(htPage, 'nrhs)
+  lda := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda)
+--    objValUnwrap htpLabelSpadValue(htPage, 'lda)
+  ldb := n
+--    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb)
+--    objValUnwrap htpLabelSpadValue(htPage, 'ldb)
+  upl := htpButtonValue(htPage, 'uplo)
+  uplo:=
+    upl = 'lower => '"L"
+    '"U"
+  (n = '4 and nrhs = '2) => f07fefDefaultSolve(htPage,uplo)
+  aList :=
+    "append"/[fa(i,n) for i in 1..lda] where fa(i,n) ==
+       labelList :=
+         "append"/[faa(i,j) for j in 1..n] where faa(i,j) ==
+            anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings, [8, 0, anam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  bList :=
+    "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) ==
+       labelList :=
+         "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) ==
+            bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j)
+            [['bcStrings, [8, 0, bnam, 'F]]]
+       prefix := ('"\newline ")
+       labelList := [['text,:prefix],:labelList]
+  prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ")
+  bList := [['text,:prefix],:bList]
+  equationPart := [
+     '(domainConditions
+         (isDomain EM $EmptyMode)
+         (isDomain S (String))
+         (isDomain F (Float))
+         (isDomain I (Integer)))
+	     ,:aList,:bList]
+  page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil)
+  htSay '"\menuitemstyle{}\tab{2} "
+  htSay '"Enter the matrix {\it A}:"
+  htSay '"\newline "
+  htMakePage equationPart
+  htMakeDoneButton('"Continue",'f07fefGen)
+  htpSetProperty(page,'uplo,uplo)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nrhs,nrhs)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htShowPage()
+
+f07fefDefaultSolve (htPage,uplo) ==
+  n := '4
+  nrhs := '2
+  lda := '4
+  ldb := '4
+  page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain EM $EmptyMode)
+       (isDomain F (Float))
+       (isDomain I (Integer)))
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it A}:")
+    (text . "\newline ")
+    (bcStrings (8 "2.04" a11 F))
+    (bcStrings (8 "0.0" a12 F))
+    (bcStrings (8 "0.0" a13 F))
+    (bcStrings (8 "0.0" a14 F))
+    (text . "\newline ")
+    (bcStrings (8 "-1.53" a21 F))
+    (bcStrings (8 "1.64" a22 F))
+    (bcStrings (8 "0.0" a23 F))
+    (bcStrings (8 "0.0" a24 F))
+    (text . "\newline ")
+    (bcStrings (8 "0.28" a31 F))
+    (bcStrings (8 "-0.25" a32 F))
+    (bcStrings (8 "0.79" a33 F))
+    (bcStrings (8 "0.0" a34 F))
+    (text . "\newline ")
+    (bcStrings (8 "-0.05" a41 F))
+    (bcStrings (8 "0.67" a42 F))
+    (bcStrings (8 "0.66" a43 F))
+    (bcStrings (8 "0.54" a44 F))
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the matrix {\it B}:")
+    (text . "\newline ")
+    (bcStrings (8 "8.7" b11 F))
+    (bcStrings (8 "8.3" b12 F))
+    (text . "\newline ")
+    (bcStrings (8 "-13.35" b21 F))
+    (bcStrings (8 "2.13" b22 F))
+    (text . "\newline ")
+    (bcStrings (8 "1.89" b31 F))
+    (bcStrings (8 "1.61" b32 F))
+    (text . "\newline ")
+    (bcStrings (8 "-4.14" b41 F))
+    (bcStrings (8 "5" b42 F)))
+  htpSetProperty(page,'uplo,uplo)
+  htpSetProperty(page,'n,n)
+  htpSetProperty(page,'nrhs,nrhs)
+--  htpSetProperty(page,'lda,lda)
+--  htpSetProperty(page,'ldb,ldb)
+  htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
+  htMakeDoneButton('"Continue",'f07fefGen)
+  htShowPage()
+
+f07fefGen htPage ==
+  n := htpProperty(htPage, 'n)
+  nrhs := htpProperty(htPage, 'nrhs)
+--  lda := htpProperty(htPage, 'lda)
+--  ldb := htpProperty(htPage, 'ldb)
+  lda := n
+  ldb := n
+  uplo := htpProperty(htPage,'uplo)
+  aplist := htpInputAreaAlist htPage
+  y := aplist
+  for i in 1..n repeat
+    for j in 1..nrhs repeat
+      b := STRCONC((first y).1," ")
+      rowList := [b,:rowList]
+      y := rest y
+    bList := [rowList,:bList]
+    rowList := []
+  bstring := bcwords2liststring [bcwords2liststring x for x in bList]
+  for i in 1..lda repeat
+    for j in 1..n repeat
+      a := STRCONC((first y).1," ")
+      rowList := [a,:rowList]
+      y := rest y
+    aList := [rowList,:aList]
+    rowList := []
+  astring := bcwords2liststring [bcwords2liststring x for x in aList]
+  prefix := STRCONC("f07fef(_"", uplo,"_", ",STRINGIMAGE n,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ")
+  prefix := STRCONC(prefix,STRINGIMAGE lda,", ")
+  prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)")
+  linkGen prefix
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nag-s.boot.pamphlet b/src/interp/nag-s.boot.pamphlet
new file mode 100644
index 00000000..1e2d0486
--- /dev/null
+++ b/src/interp/nag-s.boot.pamphlet
@@ -0,0 +1,1604 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nag-s.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+s01eaf() ==
+  page := htInitPage("S01EAF - Complex exponential {\em exp(z)} ",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs01eaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s01eaf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Evaluates the exponential function, exp(z), for complex z. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "-0.5" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "2.0" y F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's01eafGen)
+  htShowPage()
+
+s01eafGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC('"s01eaf(complex(",x,",",y,"),",STRINGIMAGE ifail,")")
+
+
+
+s13aaf() ==
+  page := htInitPage("S13AAF - Exponential integral \htbitmap{s13aaf2}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs13aaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13aaf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the exponential integral \vspace{-32} ")
+    (text . "\htbitmap{s13aaf1} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "2.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s13aaf")
+  htShowPage()
+
+s13acf() ==
+  page := htInitPage("S13ACF - Cosine integral {\em Ci(x)} ",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs13acf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13acf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the cosine integral \space{1} ")
+    (text . "\htbitmap{s13acf} ")
+    (text . ", where \gamma denotes Euler's constant. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.2" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s13acf")
+  htShowPage()
+
+s13adf() ==
+  page := htInitPage("S13ADF - Sine integral Si(x) ",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs13adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the sine integral \space{1} \vspace{-32} ")
+    (text . "\inputbitmap{\htbmdir{}/s13adf.bitmap} \vspace{-37}. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.2" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s13adf")
+  htShowPage()
+
+s14aaf() ==
+  page := htInitPage("S14AAF - Gamma Function \Gamma(x) ",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs14aaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14aaf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the gamma function, {\em Gamma(x)}. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "1.25" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s14aaf")
+  htShowPage()
+
+s14abf() ==
+  page := htInitPage("S14ABF - Log Gamma Function \Gamma(x) ",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs14abf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14abf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the logarithm of the gamma function, ")
+    (text . "{\em ln Gamma(x)}. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "1.25" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s14abf")
+  htShowPage()
+
+s14baf() ==
+  htInitPage("S14BAF - Incomplete Gamma Functions P(a,x) & Q(a,x)",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs14baf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14baf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the incomplete gamma functions, \space{1} ")
+    (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s14baf.bitmap} \vspace{-37}, ")
+    (text . "which are normalised such that P(a,x) + Q(a,x) = 1. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Enter the value of {\em a}: > 0.0")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Enter the value of {\em x}:  >= 0.0 ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "2.0" a F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "3.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the tolerance:")
+    (text . "\newline\tab{2} ")
+    (bcStrings (30 "1.1102230246251600E-16" tol F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's14bafGen)
+  htShowPage()
+
+s14bafGen htPage == 
+  a := htpLabelInputString(htPage,'a)
+  x := htpLabelInputString(htPage,'x)
+  tol := htpLabelInputString(htPage,'tol)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC('"s14baf(",a,",",x,",",tol,",",STRINGIMAGE ifail,")")
+
+s15adf() ==
+  page := htInitPage("S15ADF - Complement of error function erfc x",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs15adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the complementary gamma functions, erfc x = ")
+    (text . "\space{1} \vspace{-32} \inputbitmap{\htbmdir{}/s15adf.bitmap} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-10.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s15adf")
+  htShowPage()
+
+s15aef() ==
+  page := htInitPage("S15AEF - Error Function erf x", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs15aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15aef| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the error function, erf x = \space{1} ")
+    (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s15aef.bitmap} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-6.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s15aef")
+  htShowPage()
+
+s17acf() ==
+  page := htInitPage("S17ACF - Bessel Function \space{1} \htbitmap{s17acf}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17acf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17acf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Bessel function \space{1} \htbitmap{s17acf}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17acf")
+  htShowPage()
+
+s17adf() ==
+  page := htInitPage("S17ADF - Bessel Function \space{1} \htbitmap{s17adf}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Bessel function \space{1} \htbitmap{s17adf}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17adf")
+  htShowPage()
+
+s17aef() ==
+  page := htInitPage("S17AEF - Bessel Function \space{1} \htbitmap{s17aef}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aef| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Bessel function \space{1}")
+    (text . "\htbitmap{s17aef}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17aef")
+  htShowPage()
+
+s17aff() ==
+  page := htInitPage("S17AFF - Bessel Function \space{1} \htbitmap{s17aff}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17aff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aff| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Bessel function \space{1} \htbitmap{s17aff}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17aff")
+  htShowPage()
+
+s17agf() ==
+  page := htInitPage("S17AGF - Airy Function {\em Ai(x)}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17agf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17agf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Airy function {\em Ai(x)} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-10.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17agf")
+  htShowPage()
+
+s17ahf() ==
+  page := htInitPage("S17AHF - Airy Function {\em Bi(x)}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17ahf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ahf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Airy function {\em Bi(x)} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-10.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17ahf")
+  htShowPage()
+
+s17ajf() ==
+  page := htInitPage("S17AJF - Airy Function {\em Ai'(x)}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17ajf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ajf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates {\em Ai'(x)}, ")
+    (text . "the derivative of the Airy function Ai(x) ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-10.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17ajf")
+  htShowPage()
+
+s17akf() ==
+  page := htInitPage("S17AKF - Airy Function {\em Bi'(x)}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs17akf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17akf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates {\em Bi'(x)}, ")
+    (text . "the derivative of the Airy function Bi(x) ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "-10.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s17akf")
+  htShowPage()
+
+s17dcf() ==
+  htInitPage('"S17DCF - Bessel function \htbitmap{s17dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs17dcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dcf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns a sequence of values for the Bessel functions ")
+    (text . "\htbitmap{s17dcf}, for complex z, non-negative v ")
+    (text . "and n = 0,1,...,N-1, with an option for exponential scaling.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Order v of the first member of the sequence of functions ")
+    (text . "{\it FNU} \htbitmap{great=} 0:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" fnu F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of members required in sequence {\it N} ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's17dcfGen)
+  htShowPage()
+
+
+s17dcfGen htPage == 
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fnu := htpLabelInputString(htPage,'fnu)
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s17dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n)
+  prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+s17def() ==
+  htInitPage('"S17DEF - Bessel function \htbitmap{s17def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs17def} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17def| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns a sequence of values for the Bessel functions ")
+    (text . "\htbitmap{s17def}, for complex z, non-negative v ")
+    (text . "and n = 0,1,...,N-1, with an option for exponential scaling.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Order v of the first member of the sequence of functions ")
+    (text . "{\it FNU} \htbitmap{great=} 0:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" fnu F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of members required in sequence {\it N} ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's17defGen)
+  htShowPage()
+
+
+s17defGen htPage == 
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fnu := htpLabelInputString(htPage,'fnu)
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s17def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n)
+  prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+s17dgf() ==
+  htInitPage('"S17DGF - Airy functions {\em Ai(z)} and {\em Ai'(z)} ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs17dgf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dgf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Evaluates the Airy function Ai(z) or its derivative Ai'(z), ")
+    (text . "for complex z, with an option for exponential scaling. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Function or derivative required: ")
+    (radioButtons deriv
+        ("" "  Function" f)
+        ("" "  Derivative" d))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's17dgfGen)
+  htShowPage()
+
+
+s17dgfGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  ford := htpButtonValue(htPage,'deriv)
+  deriv := 
+    ford = 'f => '"f"
+    '"d"
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s17dgf(_"",deriv,"_",complex(",x,",",y,"),_"")
+  prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+s17dhf() ==
+  htInitPage('"S17DHF - Airy functions {\em Bi(z)} and {\em Bi'(z)} ",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs17dhf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dhf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Evaluates the Airy function Bi(z) or its derivative Bi'(z), ")
+    (text . "for complex z, with an option for exponential scaling. ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Function or derivative required: ")
+    (radioButtons deriv
+        ("" "  Function" f)
+        ("" "  Derivative" d))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's17dhfGen)
+  htShowPage()
+
+
+s17dhfGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  ford := htpButtonValue(htPage,'deriv)
+  deriv := 
+    ford = 'f => '"f"
+    '"d"
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s17dhf(_"",deriv,"_",complex(",x,",",y,"),_"")
+  prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+s17dlf() ==
+  htInitPage('"S17DLF - Hankel function \vspace{-28} \htbitmap{s17dlf} \vspace{-37}, j = 1,2, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs17dlf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dlf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns a sequence of values for the Hankel functions ")
+    (text . "\htbitmap{s17dlf}, j = 1,2, for complex z, ")
+    (text . "non-negative v ")
+    (text . "and n = 0,1,...,N-1, with an option for exponential scaling.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Order v of the first member of the sequence of functions ")
+    (text . "{\it FNU} \htbitmap{great=} 0:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" fnu F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of members required in sequence {\it N} ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Hankel function {\it m}: ")
+    (radioButtons hankel
+        ("" "  \htbitmap{s17dlf1}" mone)
+        ("" "  \htbitmap{s17dlf2}" mtwo))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's17dlfGen)
+  htShowPage()
+
+
+s17dlfGen htPage == 
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fnu := htpLabelInputString(htPage,'fnu)
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  hankel := htpButtonValue(htPage,'hankel)
+  m := 
+    hankel = 'mone => '1
+    '2
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s17dlf(",STRINGIMAGE m,", ",fnu,",complex(")
+  prefix := STRCONC(prefix,x,",",y,"),",STRINGIMAGE n)
+  prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+s18acf() ==
+  page := htInitPage("S18ACF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18acf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs18acf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18acf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}")
+    (text . "\inputbitmap{\htbmdir{}/s18acf.bitmap} \vspace{-40}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.4" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s18acf")
+  htShowPage()
+
+s18adf() ==
+  page := htInitPage("S18ADF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18adf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs18adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}")
+    (text . "\inputbitmap{\htbmdir{}/s18adf.bitmap} \vspace{-40}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.4" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s18adf")
+  htShowPage()
+
+s18aef() ==
+  page := htInitPage("S18AeF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aef1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs18aef} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aef| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}")
+    (text . "\inputbitmap{\htbmdir{}/s18aef.bitmap} \vspace{-40}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s18aef")
+  htShowPage()
+
+s18aff() ==
+  page := htInitPage("S18AFF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aff1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs18aff} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aff| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}")
+    (text . "\inputbitmap{\htbmdir{}/s18aff.bitmap} \vspace{-40}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s18aff")
+  htShowPage()
+
+s18dcf() ==
+  htInitPage('"S18DCF - Bessel function \htbitmap{s18dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs18dcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18dcf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns a sequence of values for the modified Bessel functions ")
+    (text . "\htbitmap{s18dcf}, for complex z, non-negative v ")
+    (text . "and n = 0,1,...,N-1, with an option for exponential scaling.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Order v of the first member of the sequence of functions ")
+    (text . "{\it FNU} \htbitmap{great=} 0:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" fnu F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of members required in sequence {\it N} ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's18dcfGen)
+  htShowPage()
+
+
+s18dcfGen htPage == 
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fnu := htpLabelInputString(htPage,'fnu)
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s18dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n)
+  prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+s18def() ==
+  htInitPage('"S18DEF - Modified bessel function \htbitmap{s18def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil)
+  htMakePage '(
+    (domainConditions 
+       (isDomain F (Float))
+         (isDomain PI (PositiveInteger)))
+    (text . "\windowlink{Manual Page}{manpageXXs18def} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18def| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\newline ")
+    (text . "Returns a sequence of values for the modified Bessel functions ")
+    (text . "\htbitmap{s18def}, for complex z, non-negative v ")
+    (text . "and n = 0,1,...,N-1, with an option for exponential scaling.")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Order v of the first member of the sequence of functions ")
+    (text . "{\it FNU} \htbitmap{great=} 0:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.0" fnu F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Real part of {\it z}:")
+    (text . "\tab{32} \menuitemstyle{}\tab{34}")
+    (text . "Imaginary part of {\it z}:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 "0.3" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "-0.4" y F))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Number of members required in sequence {\it N} ")
+    (text . "\htbitmap{great=} 1:")
+    (text . "\newline \tab{2} ")
+    (bcStrings (10 2 n PI))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Scaling option: ")
+    (radioButtons scale
+        ("" "  Unscaled" u)
+        ("" "  Scaled" s))
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{} \tab{2} ")
+    (text . "\newline \tab{2} ")
+    (text . "Ifail value: ")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's18defGen)
+  htShowPage()
+
+
+s18defGen htPage == 
+  n :=
+    $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
+    objValUnwrap htpLabelSpadValue(htPage, 'n)
+  fnu := htpLabelInputString(htPage,'fnu)
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  uors := htpButtonValue(htPage,'scale)
+  scale := 
+    uors = 'u => '"u"
+    '"s"
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  prefix := STRCONC('"s18def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n)
+  prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")")
+  linkGen prefix
+
+
+s19aaf() ==
+  page := htInitPage("S19AAF - Kelvin Function {\em ber x}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs19aaf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19aaf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Kelvin function {\em ber x}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "1.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s19aaf")
+  htShowPage()
+
+s19abf() ==
+  page := htInitPage("S19ABF - Kelvin Function {\em bei x}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs19abf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19abf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Kelvin function {\em bei x}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.1" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s19abf")
+  htShowPage()
+
+s19acf() ==
+  page := htInitPage("S19ACF - Kelvin Function {\em ker x}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs19acf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19acf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Kelvin function {\em ker x}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x > 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.1" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s19acf")
+  htShowPage()
+
+s19adf() ==
+  page := htInitPage("S19AAF - Kelvin Function {\em kei x}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs19adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Kelvin function {\em kei x}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x \inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.0" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s19adf")
+  htShowPage()
+
+s20acf() ==
+  page := htInitPage("S20ACF - Fresnel Integral {\em S(x)}",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs20acf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20acf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Fresnel Integral {\em S(x)}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s20acf")
+  htShowPage()
+
+s20adf() ==
+  page := htInitPage("S20ADF - Fresnel Integral {\em C(x)}",nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs20adf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20adf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the Fresnel Integral {\em C(x)}")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument x: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (9 "0.5" x F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 'sGen)
+  htpSetProperty(page,'routine,"s20adf")
+  htShowPage()
+
+s21baf() ==
+  htInitPage("S21BAF - Degenerate Symmetrised Elliptic Integral of 1st Kind \vspace{-28} \inputbitmap{\htbmdir{}/s21baf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs21baf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21baf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the elementary (degenerate symmetrised elliptic) ")
+    (text . " integral \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21baf.bitmap} ")
+    (text . "\blankline ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Enter the argument y \notequal 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.5" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0" y F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's21bafGen)
+  htShowPage()
+
+s21bafGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC("s21baf(",x,'",",y,",",STRINGIMAGE ifail,'")")
+
+s21bbf() ==
+  htInitPage("S21BBF - Symmetrised Elliptic Integral of 1st Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs21bbf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bbf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the symmetrised elliptic integral of the first kind ")
+    (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf.bitmap} ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.5" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "1.0" y F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ")
+    (text . "at most one of x,y and z may be equal to 0.0: \newline \tab{2}")
+    (bcStrings (10 "1.5" z F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's21bbfGen)
+  htShowPage()
+
+s21bbfGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  z := htpLabelInputString(htPage,'z)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC("s21bbf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")")
+
+s21bcf() ==
+  htInitPage("S21BCF - Symmetrised Elliptic Integral of 2nd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs21bcf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bcf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the symmetrised elliptic integral of the second kind ")
+    (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf.bitmap} ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.5" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.5" y F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument z > 0.0; ")
+    (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}")
+    (bcStrings (10 "1.0" z F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's21bcfGen)
+  htShowPage()
+
+s21bcfGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  z := htpLabelInputString(htPage,'z)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC("s21bcf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")")
+
+s21bdf() ==
+  htInitPage("S21BDF - Symmetrised Elliptic Integral of 3rd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf1.bitmap}", nil)
+  htMakePage '(
+    (domainConditions
+       (isDomain F (Float)))
+    (text . "\windowlink{Manual Page}{manpageXXs21bdf} for this routine ")
+    (text . "\newline ")
+    (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bdf| '|NagSpecialFunctionsPackage|)} for this routine")
+    (text . "\newline \horizontalline ")
+    (text . "\blankline ")
+    (text . "Evaluates the symmetrised elliptic integral of the third kind ")
+    (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf.bitmap} ")
+    (text . "\newline ")
+    (text . "\blankline ")
+    (text . "\newline \menuitemstyle{}\tab{2} ")
+    (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\tab{32} \menuitemstyle{}\tab{34} ")
+    (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ")
+    (text . "\newline\tab{2} ")
+    (bcStrings (10 "0.5" x F))
+    (text . "\tab{34} ")
+    (bcStrings (10 "0.5" y F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ")
+    (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}")
+    (bcStrings (10 "0.5" z F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Enter the argument \rho \notequal 0.0: \newline \tab{2} ")
+    (bcStrings (10 "2.0" r F))
+    (text . "\blankline")
+    (text . "\newline ")
+    (text . "\menuitemstyle{}\tab{2}")
+    (text . "Ifail value:")
+    (radioButtons ifail
+        ("" " -1, Print error messages" minusOne)
+        ("" "  1, Suppress error messages" one)))
+  htMakeDoneButton('"Continue", 's21bdfGen)
+  htShowPage()
+
+s21bdfGen htPage == 
+  x := htpLabelInputString(htPage,'x)
+  y := htpLabelInputString(htPage,'y)
+  z := htpLabelInputString(htPage,'z)
+  r := htpLabelInputString(htPage,'r)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC("s21bdf(",x,'",",y,",",z,",",r,",",STRINGIMAGE ifail,'")")
+
+sGen htPage == 
+  routine := htpProperty(htPage,'routine)
+  x := htpLabelInputString(htPage,'x)
+  error := htpButtonValue(htPage,'ifail)
+  ifail := 
+    error = 'one => 1
+    -1
+  linkGen STRCONC(routine,"(",x,'",",STRINGIMAGE ifail,'")")
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nci.lisp.pamphlet b/src/interp/nci.lisp.pamphlet
new file mode 100644
index 00000000..51917f58
--- /dev/null
+++ b/src/interp/nci.lisp.pamphlet
@@ -0,0 +1,107 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nci.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+;; Interpreter interface to new compiler
+
+(defun |ncParseAndInterpretString| (s)
+  (|processInteractive|
+    (|packageTran| (|parseFromString| s))
+    NIL ))
+
+(defun |ncParseFromString| (s)
+  (|zeroOneTran| (|packageTran|
+    (catch 'SPAD_READER (|parseFromString| s)))))
+
+(defun |ncINTERPFILE| (file echo)
+  (let ((|$EchoLines| echo) (|$ReadingFile| t))
+    (declare (special |$EchoLines|))
+    (declare (special |$ReadingFile|))
+    (|SpadInterpretFile| file)) )
+
+(defun |ncGetFunction| (op dom sig)
+  (|applyInPackage| #'|getNCfunction|
+   (list (|rePackageTran| op "boot")
+	 (|rePackageTran| dom "boot")
+	 (|rePackageTran| sig "boot"))
+   "boot"))
+
+(defun |ncSetCurrentLine| (c)
+  (|setCurrentLine| c))
+
+(defun |applyInPackage| (fun args package)
+  (let ((*package* (find-package (string package))))
+    (declare (special *package*))
+    (apply fun args)))
+
+(defun |clearMacroTable| ()
+  (setq |$pfMacros| NIL))
+
+(defun |getParserMacros| ()
+    |$pfMacros|)
+
+(defun |displayParserMacro| (m)
+  (let ((m (assq m |$pfMacros|)))
+    (cond ((null m) nil)
+	  (t (|pfPrintSrcLines| (CADDR m))))))
+
+
+(defun |intloopInclude| (name n)
+  (with-open-file (st name)
+		  (|intloopInclude0| st name n)))
+
+(defun |ncloopInclude| (name n)
+  (with-open-file (st name)
+		  (|ncloopInclude0| st name n)))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/newaux.lisp.pamphlet b/src/interp/newaux.lisp.pamphlet
new file mode 100644
index 00000000..11295fbd
--- /dev/null
+++ b/src/interp/newaux.lisp.pamphlet
@@ -0,0 +1,251 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp newaux.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{Operator Precedence Table Initialization} 
+\begin{verbatim}
+; PURPOSE: This file sets up properties which are used by the Boot lexical
+;          analyzer for bottom-up recognition of operators.  Also certain
+;          other character-class definitions are included, as well as
+;          table accessing functions.
+;
+; ORGANIZATION: Each section is organized in terms of Creation and Access code.
+;
+;               1. Led and Nud Tables
+;               2. GLIPH  Table
+;               3. RENAMETOK Table
+;               4. GENERIC Table
+;               5. Character syntax class predicates
+\end{verbatim}
+\subsection{LED and NUD Tables}
+\begin{verbatim}
+; **** 1. LED and NUD Tables
+ 
+; ** TABLE PURPOSE
+ 
+; Led and Nud have to do with operators. An operator with a Led property takes
+; an operand on its left (infix/suffix operator).
+ 
+; An operator with a Nud takes no operand on its left (prefix/nilfix).
+; Some have both (e.g. - ).  This terminology is from the Pratt parser.
+; The translator for Scratchpad II is a modification of the Pratt parser which
+; branches to special handlers when it is most convenient and practical to
+; do so (Pratt's scheme cannot handle local contexts very easily).
+ 
+; Both LEDs and NUDs have right and left binding powers.  This is meaningful 
+; for prefix and infix operators.  These powers are stored as the values of 
+; the LED and NUD properties of an atom, if the atom has such a property. 
+; The format is:
+ 
+;       <Operator Left-Binding-Power  Right-Binding-Power <Special-Handler>>
+ 
+; where the Special-Handler is the name of a function to be evaluated when that
+; keyword is encountered.
+ 
+; The default values of Left and Right Binding-Power are NIL.  NIL is a 
+; legitimate value signifying no precedence.  If the Special-Handler is NIL,
+; this is just an ordinary operator (as opposed to a surfix operator like 
+; if-then-else).
+ 
+\end{verbatim}
+<<LEDNUDTables>>=
+; ** TABLE CREATION
+ 
+(defparameter OpAssoc nil 
+  "Information used by OUT BOOT operator pretty printing routines")
+
+(defun MAKENEWOP (X Y) (MAKEOP X Y '|PARSE-NewKEY|))
+ 
+(defun MAKEOP (X Y KEYNAME)
+  (if (OR (NOT (CDR X)) (NUMBERP (SECOND X)))
+      (SETQ X (CONS (FIRST X) X)))
+  (if (AND (alpha-char-p (ELT (STRINGIMAGE (FIRST X)) 0))
+           (NOT (MEMBER (FIRST X) (EVAL KEYNAME))))
+      (SET KEYNAME (CONS (FIRST X) (EVAL KEYNAME))))
+  (MAKEPROP (FIRST X) Y X)
+  (SETQ OPASSOC (ADDASSOC Y (CONS (CONS X X) (LASSOC Y OPASSOC)) OPASSOC))
+  (SECOND X))
+ 
+(setq |PARSE-NewKEY| nil) ;;list of keywords
+ 
+(mapcar #'(LAMBDA(J) (MAKENEWOP J '|Led|))
+        '((* 800 801)   (|rem| 800 801)   (|mod| 800 801)
+          (|quo| 800 801)   (|div| 800 801)
+          (/ 800 801)    (** 900 901)  (^ 900 901)
+          (|exquo| 800 801) (+ 700 701)
+          (\- 700 701)    (\-\> 1001 1002)  (\<\- 1001 1002)
+          (\: 996 997)    (\:\: 996 997)
+          (\@ 996 997)    (|pretend| 995 996)
+          (\.)            (\! \! 1002 1001)
+          (\, 110 111)
+          (\; 81 82 (|PARSE-SemiColon|))
+          (\< 400 400)    (\> 400 400)
+          (\<\< 400 400)  (\>\> 400 400)
+          (\<= 400 400)   (\>= 400 400)
+          (= 400 400)     (^= 400 400)
+          (\~= 400 400)
+          (|in| 400 400)    (|case| 400 400)
+          (|add| 400 120)   (|with| 2000 400 (|PARSE-InfixWith|))
+          (|has| 400 400)
+          (|where| 121 104)     ; must be 121 for SPAD, 126 for boot--> nboot
+          (|when| 112 190)
+          (|otherwise| 119 190 (|PARSE-Suffix|))
+          (|is| 400 400)    (|isnt| 400 400)
+          (|and| 250 251)   (|or| 200 201)
+          (/\\ 250 251)   (\\/ 200 201)
+          (\.\. SEGMENT 401 699 (|PARSE-Seg|))
+          (=\> 123 103)
+          (+-\> 998 102)
+          (== DEF 122 121)
+          (==\> MDEF 122 121)
+          (\| 108 111)                          ;was 190 190
+          (\:- LETD 125 124) (\:= LET 125 124)))
+ 
+(mapcar #'(LAMBDA (J) (MAKENEWOP J `|Nud|))
+        '((|for| 130 350 (|PARSE-Loop|))
+          (|while| 130 190 (|PARSE-Loop|))
+          (|until| 130 190 (|PARSE-Loop|))
+          (|repeat| 130 190 (|PARSE-Loop|))
+          (|import| 120 0 (|PARSE-Import|) )
+          (|unless|)
+          (|add| 900 120)
+          (|with| 1000 300 (|PARSE-With|))
+          (|has| 400 400)
+          (\- 701 700)  ; right-prec. wants to be -1 + left-prec
+;;        (\+ 701 700)
+          (\# 999 998)
+          (\! 1002 1001)
+          (\' 999 999 (|PARSE-Data|))
+          (\<\< 122 120 (|PARSE-LabelExpr|))
+          (\>\>)
+          (^ 260 259 NIL)
+          (\-\> 1001 1002)
+          (\: 194 195)
+          (|not| 260 259 NIL)
+          (\~ 260 259 nil)
+          (\= 400 700)
+          (|return| 202 201 (|PARSE-Return|))
+          (|leave| 202 201 (|PARSE-Leave|))
+          (|exit| 202 201 (|PARSE-Exit|))
+          (|from|)
+          (|iterate|)
+          (|yield|)
+          (|if| 130 0 (|PARSE-Conditional|))    ; was 130
+          (\| 0 190)
+          (|suchthat|)
+          (|then| 0 114)
+          (|else| 0 114)))
+
+@ 
+\section{Gliph Table}
+Gliphs are symbol clumps. The gliph property of a symbol gives
+the tree describing the tokens which begin with that symbol.
+The token reader uses the gliph property to determine the longest token.
+Thus [[:=]] is read as one token not as [[:]] followed by [[=]].
+ 
+<<GLIPHTable>>=
+(mapcar #'(lambda (x) (makeprop (car x) 'gliph (cdr x)))
+        `(
+          ( \| (\))        )
+          ( *  (*)         )
+          ( \( (<) (\|)    )
+          ( +  (- (>))     )
+          ( -  (>)         )
+          ( <  (=) (<)     )
+     ;;     ( /  (\\)        ) breaks */xxx
+          ( \\ (/)         )
+          ( >  (=) (>) (\)))
+          ( =  (= (>)) (>) )
+          ( \. (\.)        )
+          ( ^  (=)         )
+          ( \~ (=)         )
+          ( \: (=) (-) (\:))))
+ 
+@
+\subsection{Rename Token Table} 
+RENAMETOK defines alternate token strings which can be used for different
+keyboards which define equivalent tokens.
+<<RENAMETOKTable>>=
+(mapcar 
+  #'(lambda (x) (MAKEPROP (CAR X) 'RENAMETOK (CADR X)) (MAKENEWOP X NIL))
+        '((\(\| \[)                     ; (| |) means []
+          (\|\) \])
+          (\(< \{)                      ; (< >) means {}
+          (>\) \})))
+ 
+@
+\subsection{Generic function table}
+GENERIC operators be suffixed by [[$]] qualifications in SPAD code.  
+[[$]] is then followed by a domain label, such as I for Integer, which 
+signifies which domain the operator refers to.  For example [[+$Integer]] 
+is [[+]] for Integers.
+<<GENERICTable>>=
+(mapcar #'(lambda (x) (MAKEPROP X 'GENERIC 'TRUE))
+        '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ^= ))
+
+@  
+\subsection{Character Syntax Table}
+<<CharacterSyntaxTable>>=
+(defun SPECIALCASESYNTAX () (OR (AND (char= TOK '#\#) (DIGITP CHR))))
+ 
+(defun TERMINATOR (CHR)
+  (member CHR '(#\  #\( #\) #\. #\; #\, #\Return)) :test #'char=)
+ 
+@  
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+ 
+(in-package "BOOT")
+ 
+<<LEDNUDTables>>
+<<GLIPHTable>> 
+<<RENAMETOKTable>>
+<<GENERICTable>>
+<<CharacterSyntaxTable>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/newfort.boot.pamphlet b/src/interp/newfort.boot.pamphlet
new file mode 100644
index 00000000..b5720292
--- /dev/null
+++ b/src/interp/newfort.boot.pamphlet
@@ -0,0 +1,967 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp newfort.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Translation of Expression to FORTRAN
+assignment2Fortran1(name,e) ==
+  $fortError : fluid := nil
+  checkLines fortran2Lines statement2Fortran ["=",name,e]
+
+integerAssignment2Fortran1(name,e) ==
+  $fortError : fluid := nil
+  $fortInts2Floats : fluid := nil
+  checkLines fortran2Lines statement2Fortran ["=",name,e]
+
+statement2Fortran e ==
+  -- takes an object of type Expression and returns a list of
+  -- strings. Any part of the expression which is a list starting
+  -- with 'FORTRAN is merely passed on in the list of strings. The
+  -- list of strings may contain '"%l".
+  -- This is used when formatting e.g. a DO loop from Lisp
+  $exp2FortTempVarIndex : local := 0
+  $fortName : fluid := "DUMMY"
+  $fortInts2Floats : fluid := nil
+  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
+
+expression2Fortran e ==
+  -- takes an object of type Expression and returns a list of
+  -- strings. Any part of the expression which is a list starting
+  -- with 'FORTRAN is merely passed on in the list of strings. The
+  -- list of strings may contain '"%l".
+  $exp2FortTempVarIndex : local := 0
+  $fortName : fluid := newFortranTempVar()
+  $fortInts2Floats : fluid := nil
+  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
+
+expression2Fortran1(name,e) ==
+  -- takes an object of type Expression and returns a list of
+  -- strings. Any part of the expression which is a list starting
+  -- with 'FORTRAN is merely passed on in the list of strings. The
+  -- list of strings may contain '"%l".
+  $exp2FortTempVarIndex : local := 0
+  $fortName : fluid := name
+  fortranCleanUp exp2Fort1 segment fortPre exp2FortOptimize outputTran e
+
+newFortranTempVar() ==
+  $exp2FortTempVarIndex := 1 + $exp2FortTempVarIndex
+  newVar := INTERN STRCONC('"T",STRINGIMAGE $exp2FortTempVarIndex)
+  updateSymbolTable(newVar,$defaultFortranType)
+  newVar
+ 
+fortranCleanUp l ==
+  -- takes reversed list and cleans up a bit, putting it in
+  -- correct order
+  oldTok := NIL
+  m := NIL
+  for e in l repeat
+    if not (oldTok = '"-" and e = '"+") then m := [e,:m]
+    oldTok := e
+  m
+ 
+exp2Fort1 l ==
+  s := nil
+  for e in l repeat s := [:exp2Fort2(e,0,nil),:s]
+  s
+ 
+exp2Fort2(e,prec,oldOp) ==
+  null e    => nil
+  atom e    => [object2String e]
+  e is [ "=",lhs,rhs] or e is [ '"=",lhs,rhs] =>
+    ['"%l",:exp2Fort2(rhs,prec,'"="),'"=",:exp2Fort2(lhs,prec,'"=")]
+ 
+  unaryOps    := ['"-",'"^",'"~"]
+  unaryPrecs  := [700,260,50]
+  binaryOps   := ['"|",'"**",'"/",'".LT.",'".GT.",'".EQ.",'".LE.",'".GE.", _
+                  '"OVER",'".AND.",'".OR."]
+  binaryPrecs := [0, 900, 800, 400, 400, 400, 400, 400, 800, 70, 90]
+  naryOps     := ['"-",'"+",'"*",'",",'" ",'"ROW",'""]
+  naryPrecs   := [700,  700, 800,  110,   0,     0,  0]
+  nonUnaryOps := append(binaryOps,naryOps)
+  [op,:args] := e
+  op := object2String op
+  nargs := #args
+  nargs = 0 => exp2FortFn(op,args,0)
+  nargs = 1 =>
+    (p := position(op,unaryOps)) > -1 =>
+      nprec := unaryPrecs.p
+      s := [:exp2Fort2(first args,nprec,op),op]
+      op = '"-" and atom first args => s
+      op = oldOp and op in ['"*",'"+"] => s
+      nprec <= prec => ['")",:s,'"("]
+      s
+    exp2FortFn(op,args,nargs)
+  op = '"CMPLX" =>
+    ['")",:exp2Fort2(SECOND args, prec, op),'",",:exp2Fort2(first args,prec,op),'"("]
+  member(op,nonUnaryOps) =>
+    if nargs > 0 then arg1 := first args
+    nargs = 1 and op in '("+" "*") => exp2Fort2(arg1,prec,op)
+    if nargs > 1 then arg2 := first rest args
+    p := position(op,binaryOps)
+    if p = -1
+      then
+        p := position(op,naryOps)
+        nprec := naryPrecs.p
+      else nprec := binaryPrecs.p
+    s := nil
+    for arg in args repeat
+      op = '"+" and (arg is [m,a]) and m in '(_- "=") =>
+        if not s then s := ['junk]
+        s:= [op,:exp2Fort2(a,nprec,op),'"-",:rest s]
+      s := [op,:exp2Fort2(arg,nprec,op),:s]
+    s := rest s
+    op = oldOp and op in ['"*",'"+"] => s
+    nprec <= prec => ['")",:s,'"("]
+    s
+  exp2FortFn(op,args,nargs)
+ 
+ 
+exp2FortFn(op,args,nargs) ==
+  s := ['"(",op]
+  while args repeat
+    s := ['",",:exp2Fort2(first args,0,op),:s]
+    args := rest args
+  if nargs > 0 then ['")",:rest s]
+  else ['")",:s]
+ 
+ 
+--% Optimization of Expression
+ 
+exp2FortOptimize e ==
+  -- $fortranOptimizationLevel means:
+  --   0         just extract arrays
+  --   1         extract common subexpressions
+  --   2         try to optimize computing of powers
+  $exprStack : local := NIL
+  atom e => [e]
+  $fortranOptimizationLevel = 0 =>
+    e1 := exp2FortOptimizeArray e
+    NREVERSE [e1,:$exprStack]
+  e := minimalise e
+  for e1 in exp2FortOptimizeCS  e repeat
+    e2 := exp2FortOptimizeArray e1
+    $exprStack := [e2,:$exprStack]
+  NREVERSE $exprStack
+
+ 
+exp2FortOptimizeCS e ==
+  $fortCsList : local := NIL
+  $fortCsHash : local := MAKE_-HASHTABLE 'EQ
+  $fortCsExprStack : local := NIL
+  $fortCsFuncStack : local := NIL
+  f := exp2FortOptimizeCS1 e
+  NREVERSE [f,:$fortCsList]
+ 
+-- bug fix to beenHere 
+-- Thu Nov 05 12:01:46 CUT 1992 , Author: TTT
+-- Used in exp2FortOprtimizeCS 
+-- Original file : newfort.boot
+beenHere(e,n) ==
+  n.0 := n.0 + 1                      -- increase count (initially 1)
+  n.0 = 2 =>                          -- first time back again
+    var := n.1 := newFortranTempVar() -- stuff n.1 with new var
+    exprStk := n.2                    -- get expression
+    if exprStk then
+-- using COPY-TREE : RPLAC does not smash $fortCsList
+-- which led to inconsistencies in assignment of temp. vars.
+      $fortCsList := COPY_-TREE [['"=",var,e],:$fortCsList]
+      loc := CAR exprStk
+      fun := CAR n.3
+      fun = 'CAR =>
+        RPLACA(loc,var)
+      fun = 'CDR =>
+        if PAIRP QCDR loc
+          then RPLACD(loc,[var])
+          else RPLACD(loc,var)
+      SAY '"whoops"
+    var
+  n.1                     -- been here before, so just get variable
+
+
+exp2FortOptimizeCS1 e ==
+  -- we do nothing with atoms or simple lists containing atoms
+  atom(e) or (atom first e and null rest e) => e
+  e is [op,arg] and object2Identifier op = "-" and atom arg => e
+
+  -- see if we have been here before
+  not (object2Identifier QCAR e in '(ROW AGGLST)) and
+    (n := HGET($fortCsHash,e)) => beenHere(e,n) -- where
+
+  -- descend sucessive CARs of CDRs of e
+  f := e
+  while f repeat
+    pushCsStacks(f,'CAR) where pushCsStacks(x,y) ==
+      $fortCsExprStack := [x,:$fortCsExprStack]
+      $fortCsFuncStack := [y,:$fortCsFuncStack]
+    RPLACA(f,exp2FortOptimizeCS1 QCAR f)
+    popCsStacks(0) where popCsStacks(x) ==
+      $fortCsFuncStack := QCDR $fortCsFuncStack
+      $fortCsExprStack := QCDR $fortCsExprStack
+    g := QCDR f
+    -- check to see of we have an non-NIL atomic CDR
+    g and atom g =>
+      pushCsStacks(f,'CDR)
+      RPLACD(f,exp2FortOptimizeCS1 g)
+      popCsStacks(0)
+      f := NIL
+    f := g
+
+  MEMQ(object2Identifier QCAR e,'(ROW AGGLST)) => e
+
+  -- see if we have already seen this expression
+  n := HGET($fortCsHash,e)
+  null n =>
+    n := VECTOR(1,NIL,$fortCsExprStack,$fortCsFuncStack)
+    HPUT($fortCsHash,e,n)
+    e
+  beenHere(e,n)
+
+
+ 
+exp2FortOptimizeArray e ==
+  -- this handles arrays
+  atom e => e
+  [op,:args] := e
+  op1 := object2Identifier op
+  op1 in '(BRACE BRACKET) =>
+    args is [['AGGLST,:elts]] =>
+      LISTP first elts and first first elts in '(BRACE BRACKET) => fortError1 e
+      -- var := newFortranTempVar()
+      var := $fortName
+      $exprStack := [[op,var,['AGGLST,:exp2FortOptimizeArray elts]],
+        :$exprStack]
+      var
+  EQ(op1,'MATRIX) =>
+    -- var := newFortranTempVar()
+    var := $fortName
+    -- args looks like [NIL,[ROW,...],[ROW,...]]
+    $exprStack := [[op,var,:exp2FortOptimizeArray args],:$exprStack]
+    var
+  [exp2FortOptimizeArray op,:exp2FortOptimizeArray args]
+
+ 
+--% FORTRAN Line Breaking
+ 
+fortran2Lines f ==
+  -- f is a list of strings
+  -- returns: a list of strings where each string is a valid
+  -- FORTRAN line in fixed form
+ 
+  -- collect strings up to first %l or end of list. Then feed to
+  -- fortran2Lines1.
+  fs := NIL
+  lines := NIL
+  while f repeat
+    while f and (ff := first(f)) ^= '"%l" repeat
+      fs := [ff,:fs]
+      f := rest f
+    if f and first(f) = '"%l" then f := rest f
+    lines := append(fortran2Lines1 nreverse fs,lines)
+    fs := nil
+  nreverse lines
+ 
+fortran2Lines1 f ==
+  -- f is a list of strings making up 1 FORTRAN statement
+  -- return: a reverse list of FORTRAN lines
+  normPref := MAKE_-STRING($fortIndent)
+  --contPref := STRCONC(MAKE_-STRING($fortIndent-1),"&")
+  contPref := STRCONC("     &",MAKE_-STRING($fortIndent-6))
+  lines := NIL
+  ll := $fortIndent
+  while f repeat
+    ok := true
+    line := normPref
+    ff := first f
+    while ok repeat
+      (ll + (sff := SIZE ff)) <= $fortLength =>
+        ll := ll + sff
+        line := STRCONC(line,ff)
+        f := rest f
+        if f then ff := first f
+        else ok := nil
+      -- fill the line out to exactly $fortLength spaces if possible by splitting
+      -- up symbols.  This is helpful when doing the segmentation
+      -- calculations, and also means that very long strings (e.g. numbers
+      -- with more than $fortLength-$fortIndent digits) are printed in a
+      -- legal format. MCD
+      if (ll < $fortLength) and (ll + sff) > $fortLength then
+        spaceLeft := $fortLength - ll
+        line := STRCONC(line,SUBSEQ(ff,0,spaceLeft))
+        ff := SUBSEQ(ff,spaceLeft)
+      lines := [line,:lines]
+      ll := $fortIndent
+      line := contPref
+    if ll > $fortIndent then lines := [line,:lines]
+  lines
+ 
+-- The Fortran error functions
+fortError1 u ==
+  $fortError := "t"
+  sayErrorly("Fortran translation error",
+             "   No corresponding Fortran structure for:")
+  mathPrint u
+ 
+fortError(u,v) ==
+  $fortError := "t"
+  msg := STRCONC("   ",STRINGIMAGE u);
+  sayErrorly("Fortran translation error",msg)
+  mathPrint v
+ 
+--% Top Level Things to Call
+-- The names are the same as those used in the old fortran code
+
+dispStatement x ==
+  $fortError : fluid := nil
+  displayLines fortran2Lines statement2Fortran x
+
+
+getStatement(x,ints2Floats?) ==
+  $fortInts2Floats : fluid := ints2Floats?
+  $fortError : fluid := nil
+  checkLines fortran2Lines statement2Fortran x
+
+fortexp0 x ==
+  f := expression2Fortran x
+  p := position('"%l",f)
+  p < 0 => f
+  l := NIL
+  while p < 0 repeat
+    [t,:f] := f
+    l := [t,:l]
+  NREVERSE ['"...",:l]
+ 
+dispfortexp x ==
+  if atom(x) or x is [op,:.] and not object2Identifier op in
+    '(_= MATRIX construct ) then
+      var := INTERN STRCONC('"R",object2String $IOindex)
+      x := ['"=",var,x]
+  dispfortexp1 x
+ 
+dispfortexpf (xf, fortranName) ==
+  $fortError : fluid := nil
+  linef := fortran2Lines BUTLAST(expression2Fortran1(fortranName,xf),2)
+  displayLines linef
+
+dispfortexpj (xj, fortranName) ==
+  $fortName : fluid := fortranName
+  $fortError : fluid := nil
+  linej := fortran2Lines BUTLAST(expression2Fortran1(fortranName,xj),2)
+  displayLines linej
+
+
+dispfortexp1 x ==
+  $fortError : fluid := nil
+  displayLines fortran2Lines expression2Fortran x
+
+getfortexp1 x ==
+  $fortError : fluid := nil
+  checkLines fortran2Lines expression2Fortran x
+
+displayLines1 lines ==
+  for l in lines repeat
+    PRINTEXP(l,$fortranOutputStream)
+    TERPRI($fortranOutputStream)
+
+displayLines lines ==
+  if not $fortError then displayLines1 lines
+ 
+checkLines lines ==
+  $fortError => []
+  lines
+
+dispfortarrayexp (fortranName,m) ==
+  $fortError : fluid := nil
+  displayLines fortran2Lines BUTLAST(expression2Fortran1(fortranName,m),2)
+
+getfortarrayexp(fortranName,m,ints2floats?) ==
+  $fortInts2Floats : fluid := ints2floats?
+  $fortError : fluid := nil
+  checkLines fortran2Lines BUTLAST(expression2Fortran1(fortranName,m),2)
+
+ 
+-- Globals
+$currentSubprogram := nil
+$symbolTable := nil
+ 
+
+
+--fix [x,exp x]
+ 
+------------ exp2FortSpecial.boot --------------------
+ 
+exp2FortSpecial(op,args,nargs) ==
+  op = "CONCAT" and first args in ["<",">","<=",">=","~","and","or"] =>
+    mkFortFn(first args,CDADAR rest args,#(CDADAR rest args))
+  op = "CONCAT" and CADR(args)="EQ" =>
+    mkFortFn("EQ",[first args, CADDR args],2)
+  --the next line is NEVER used by FORTRAN code but is needed when
+  --  called to get a linearized form for the browser
+  op = "QUOTE" =>
+    atom (arg := first args) => STRINGIMAGE arg
+    tailPart := "STRCONC"/[STRCONC('",",x) for x in rest arg]
+    STRCONC('"[",first arg,tailPart,'"]")
+  op = "PAREN" =>
+    args := first args
+    not(first(args)="CONCATB") => fortError1 [op,:args]
+    -- Have a matrix element
+    mkMat(args)
+  op = "SUB" =>
+    $fortInts2Floats : fluid := nil
+    mkFortFn(first args,rest args,#(rest args))
+  op in ["BRACE","BRACKET"] =>
+    args is [var,['AGGLST,:elts]] =>
+      var := object2String var
+      si := $fortranArrayStartingIndex
+      hidim := #elts - 1 + si
+      if LISTP first elts and #elts=1 and first elts is [sOp,:sArgs] then
+        sOp in ['"SEGMENT","SEGMENT"] =>
+          #sArgs=1 => fortError1 first elts
+          not(NUMBERP(first sArgs) and NUMBERP(SECOND sArgs)) =>
+            fortError("Cannot expand segment: ",first elts)
+          first sArgs > SECOND sArgs => fortError1
+            '"Lower bound of segment exceeds upper bound."
+          for e in first sArgs .. SECOND sArgs for i in si.. repeat
+            $exprStack := [["=",[var,object2String i],fortPre1(e)],:$exprStack]
+      for e in elts for i in si.. repeat
+        $exprStack := [["=",[var,object2String i],fortPre1(e)],:$exprStack]
+    fortError1 [op,:args]
+  op in ["CONCAT","CONCATB"] =>
+    nargs = 0 => NIL
+    nargs = 1 => fortPre1 first args
+    nargs = 2 and first rest args in ["!",'"!"] =>
+      mkFortFn("FACTORIAL",[first args],1)
+    fortError1 [op,:args]
+  op in ['"MATRIX","MATRIX"] =>
+    args is [var, =NIL,:rows] =>
+      var := object2String var
+      nrows := #rows - 1
+      ncols := #(rest first rows) - 1
+      si := $fortranArrayStartingIndex
+      for r in rows for rx in si.. repeat
+        for c in rest r for cx in si.. repeat
+          $exprStack := [["=",[var,object2String rx,object2String cx],
+                          fortPre1(c)],:$exprStack]
+    fortError1 [op,:args]
+  fortError1 [op,:args]
+
+mkMat(args) ==
+  $fortInts2Floats : fluid := nil
+  mkFortFn(first rest args,rest rest args,#(rest rest args))
+
+ 
+mkFortFn(op,args,nargs) ==
+  [fortranifyFunctionName(STRINGIMAGE op,nargs), 
+   :MAPCAR(function fortPre1 , args) ]
+ 
+fortranifyFunctionName(op,nargs) ==
+  op = '"<" => '".LT."
+  op = '">" => '".GT."
+  op = '"<=" => '".LE."
+  op = '">=" => '".GE."
+  op = '"EQ" => '".EQ."
+  op = '"and" => '".AND."
+  op = '"or" => '".OR."
+  op = '"~" => '".NOT."
+  fortranifyIntrinsicFunctionName(op,nargs)
+
+fortranifyIntrinsicFunctionName(op,nargs) ==
+  $useIntrinsicFunctions =>
+    intrinsic := if op = '"acos" then '"ACOS"
+    else if op = '"asin" then '"ASIN"
+    else if op = '"atan" then
+      nargs = 2 => '"ATAN2"
+      '"ATAN"
+    else if op = '"cos" then '"COS"
+    else if op = '"cosh" then '"COSH"
+    else if op = '"cot" then '"COTAN"
+    else if op = '"erf" then '"ERF"
+    else if op = '"exp" then '"EXP"
+    else if op = '"log" then '"LOG"
+    else if op = '"log10" then '"LOG10"
+    else if op = '"sin" then '"SIN"
+    else if op = '"sinh" then '"SINH"
+    else if op = '"sqrt" then '"SQRT"
+    else if op = '"tan" then '"TAN"
+    else if op = '"tanh" then '"TANH"
+    intrinsic =>
+      $intrinsics := ADJOIN(intrinsic,$intrinsics)
+      intrinsic
+    op
+  $fortranPrecision = 'double =>
+    op = '"acos" => '"DACOS"
+    op = '"asin" => '"DASIN"
+    op = '"atan" =>
+      nargs = 2 => '"DATAN2"
+      '"DATAN"
+    op = '"cos" => '"DCOS"
+    op = '"cosh" => '"DCOSH"
+    op = '"cot" => '"DCOTAN"
+    op = '"erf" => '"DERF"
+    op = '"exp" => '"DEXP"
+    op = '"log" => '"DLOG"
+    op = '"log10" => '"DLOG10"
+    op = '"sin" => '"DSIN"
+    op = '"sinh" => '"DSINH"
+    op = '"sqrt" => '"DSQRT"
+    op = '"tan" => '"DTAN"
+    op = '"tanh" => '"DTANH"
+    op = '"abs" => '"DABS"
+    op
+  op = '"acos" => '"ACOS"
+  op = '"asin" => '"ASIN"
+  op = '"atan" =>
+    nargs = 2 => '"ATAN2"
+    '"ATAN"
+  op = '"cos" => '"COS"
+  op = '"cosh" => '"COSH"
+  op = '"cot" => '"COTAN"
+  op = '"erf" => '"ERF"
+  op = '"exp" => '"EXP"
+  op = '"log" => '"ALOG"
+  op = '"log10" => '"ALOG10"
+  op = '"sin" => '"SIN"
+  op = '"sinh" => '"SINH"
+  op = '"sqrt" => '"SQRT"
+  op = '"tan" => '"TAN"
+  op = '"tanh" => '"TANH"
+  op = '"abs" => '"ABS"
+  op
+
+--------------------------format.boot------------------------------------------
+
+-- These functions are all used by FortranCode and FortranProgram.
+-- Those used by FortranCode have been changed to return a list of
+-- lines rather than print them directly, thus allowing us to catch
+-- and display type declarations for temporary variables.
+--  MCD 25/3/93
+
+indentFortLevel(i) ==
+  $maximumFortranExpressionLength := $maximumFortranExpressionLength -2*i
+  $fortIndent := $fortIndent + 2*i
+
+changeExprLength(i) ==>
+  $maximumFortranExpressionLength := $maximumFortranExpressionLength + i
+
+fortFormatDo(var,lo,hi,incr,lab) ==
+  $fortError : fluid := nil
+  $fortInts2Floats : fluid := nil
+  incr=1 =>
+    checkLines fortran2Lines
+      ['"DO ",STRINGIMAGE lab,'" ",STRINGIMAGE var,'"=",:statement2Fortran lo,_
+       '",", :statement2Fortran hi]
+  checkLines fortran2Lines
+    ['"DO ",STRINGIMAGE lab,'" ",STRINGIMAGE var,'"=",:statement2Fortran lo,_
+     '",", :statement2Fortran hi,'",",:statement2Fortran incr]
+
+fortFormatIfGoto(switch,label) ==
+  changeExprLength(-8) -- Leave room for IF( ... )GOTO
+  $fortError : fluid := nil
+  if first(switch) = "NULL" then switch := first rest switch
+  r := nreverse statement2Fortran switch
+  changeExprLength(8)
+  l := ['")GOTO ",STRINGIMAGE label]
+  while r and not(first(r) = '"%l") repeat
+    l := [first(r),:l]
+    r := rest(r)
+  checkLines fortran2Lines nreverse [:nreverse l,'"IF(",:r]
+
+fortFormatLabelledIfGoto(switch,label1,label2) ==
+  changeExprLength(-8) -- Leave room for IF( ... )GOTO
+  $fortError : fluid := nil
+  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
+  r := nreverse statement2Fortran switch
+  changeExprLength(8)
+  l := ['")GOTO ",STRINGIMAGE label2]
+  while r and not(first(r) = '"%l") repeat
+    l := [first(r),:l]
+    r := rest(r)
+  labString := STRINGIMAGE label1
+  for i in #(labString)..5 repeat labString := STRCONC(labString,'" ")
+  lines := fortran2Lines nreverse [:nreverse l,'"IF(",:r]
+  lines := [STRCONC(labString,SUBSEQ(first lines,6)),:rest lines]
+  checkLines lines
+
+fortFormatIf(switch) ==
+  changeExprLength(-8) -- Leave room for IF( ... )THEN
+  $fortError : fluid := nil
+  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
+  r := nreverse statement2Fortran switch
+  changeExprLength(8)
+  l := ['")THEN"]
+  while r and not(first(r) = '"%l") repeat
+    l := [first(r),:l]
+    r := rest(r)
+  checkLines fortran2Lines nreverse [:nreverse l,'"IF(",:r]
+
+fortFormatElseIf(switch) ==
+  -- Leave room for IF( ... )THEN
+  changeExprLength(-12)
+  $fortError : fluid := nil
+  if LISTP(switch) and first(switch) = "NULL" then switch := first rest switch
+  r := nreverse statement2Fortran switch
+  changeExprLength(12)
+  l := ['")THEN"]
+  while r and not(first(r) = '"%l") repeat
+    l := [first(r),:l]
+    r := rest(r)
+  checkLines fortran2Lines nreverse [:nreverse l,'"ELSEIF(",:r]
+
+fortFormatHead(returnType,name,args) ==
+  $fortError : fluid := nil
+  $fortranSegment : fluid := nil
+  -- if returnType = '"_"_(_)_"" then 
+  if returnType = '"void" then
+    asp := ['"SUBROUTINE "]
+    changeExprLength(l := -11)
+  else
+    asp := [s := checkType STRINGIMAGE returnType,'" FUNCTION "]
+    changeExprLength(l := -10-LENGTH(s))
+  displayLines fortran2Lines [:asp,:statement2Fortran [name,:CDADR args] ]
+  changeExprLength(-l)
+
+checkType ty ==
+  ty := STRING_-UPCASE STRINGIMAGE ty
+  $fortranPrecision = "double" =>
+    ty = '"REAL" => '"DOUBLE PRECISION"
+    ty = '"COMPLEX" => '"DOUBLE COMPLEX"
+    ty
+  ty
+
+mkParameterList l ==
+  [par2string(u) for u in l] where par2string u ==
+      atom(u) => STRINGIMAGE u
+      u := rest first rest u
+      apply('STRCONC,[STRINGIMAGE(first u),'"(",_
+               :rest [:['",",:statement2Fortran(v)] for v in rest u],'")"])
+
+nameLen n ==>
+ +/[1+LENGTH(u) for u in n]
+
+fortFormatTypes(typeName,names) ==
+  null names => return()
+  $fortError : fluid := nil
+  $fortranSegment : fluid := nil
+  $fortInts2Floats : fluid := nil
+  typeName := checkType typeName
+  typeName = '"CHARACTER" =>
+    fortFormatCharacterTypes([unravel(u) for u in names])
+      where unravel u ==
+              atom u => u
+              CDADR u
+  fortFormatTypes1(typeName,mkParameterList names)
+
+fortFormatTypes1(typeName,names) ==
+  l := $maximumFortranExpressionLength-1-LENGTH(typeName)
+  while nameLen(names) > l repeat
+    n := []
+    ln := 0
+    while (ln := ln + LENGTH(first names) + 1) < l repeat
+      n := [first names,:n]
+      names := rest names
+    displayLines fortran2Lines [typeName,'" ",:addCommas n]
+  displayLines fortran2Lines [typeName,'" ",:addCommas names]
+
+insertEntry(size,el,aList) ==
+  entry := assoc(size,aList)
+  null entry => CONS(CONS(size,LIST el),aList)
+  RPLACD(entry,CONS(el,CDR entry))
+  aList
+
+fortFormatCharacterTypes(names) ==
+  sortedByLength := []
+  genuineArrays  := []
+  for u in names repeat
+    ATOM u => sortedByLength := insertEntry(0,u,sortedByLength)
+    #u=2 => sortedByLength := insertEntry(CADR u,CAR u,sortedByLength)
+    genuineArrays := [u,:genuineArrays]
+  for u in sortedByLength repeat
+    fortFormatTypes1(mkCharName car u, [STRINGIMAGE(s) for s in cdr(u)]) where
+       mkCharName v == CONCAT("CHARACTER*(",STRINGIMAGE v,")")
+  if (not null genuineArrays) then
+    fortFormatTypes1('"CHARACTER",mkParameterList2 genuineArrays) where
+       mkParameterList2 l ==
+         [par2string(u) for u in l] where par2string u ==
+             apply('STRCONC,[STRINGIMAGE(first u),'"(",_
+                      :rest [:['",",:statement2Fortran(v)] for v in rest u],'")"])
+
+fortFormatIntrinsics(l) ==
+  $fortError : fluid := nil
+  null l => return()
+  displayLines fortran2Lines ['"INTRINSIC ",:addCommas(l)]
+  
+ 
+------------------ fortDec.boot --------------------
+ 
+-- This file contains the stuff for creating and updating the Fortran symbol
+-- table.
+ 
+currentSP () ==
+  -- Return the name of the current subprogram being generated
+  $currentSubprogram or "MAIN"
+ 
+updateSymbolTable(name,type) ==
+    fun := ['$elt,'SYMS,'declare_!]
+    coercion := ['_:_:,STRING type,'FST]
+    $insideCompileBodyIfTrue: local := false
+    interpret([fun,["QUOTE",name],coercion])
+ 
+addCommas l ==
+  not l => nil
+  r := [STRINGIMAGE first l]
+  for e in rest l repeat r := [STRINGIMAGE e,'",",:r]
+  reverse r
+
+$intrinsics := []
+initialiseIntrinsicList() == 
+  $intrinsics := []
+
+getIntrinsicList() ==
+  $intrinsics
+
+ 
+-------------------- fortPre.boot ------------------
+ 
+fortPre l ==
+  -- Essentially, the idea is to fix things so that we know what size of
+  -- expression we will generate, which helps segment large expressions
+  -- and do transformations to double precision output etc..
+  $exprStack : fluid := nil -- sometimes we will add elements to this in
+                            -- other functions, for example when extracing
+                            -- lists etc.
+  for e in l repeat if new := fortPre1 e then
+     $exprStack := [new,:$exprStack]
+  reverse $exprStack
+ 
+fortPre1 e ==
+  -- replace spad function names by Fortran equivalents
+  -- where appropriate, replace integers by floats
+  -- extract complex numbers
+  -- replace powers of %e by calls to EXP
+  -- replace x**2 by x*x etc.
+  -- replace ROOT by either SQRT or **(1./ ... )
+  -- replace N-ary by binary functions
+  -- strip the '%' character off objects like %pi etc..
+  null e => nil
+  INTEGERP(e) =>
+    $fortInts2Floats = true =>
+      e >= 0 => fix2FortranFloat(e)
+      ['"-", fix2FortranFloat(-e)]
+    e
+  isFloat(e) => checkPrecision(e)
+  -- Keep strings as strings:
+  -- STRINGP(e) => STRCONC(STRING(34),e,STRING(34))
+  STRINGP(e) => e
+  e = "%e" => fortPre1 ["exp" , 1]
+  imags := ['"%i","%i"]
+  e in imags => ['"CMPLX",fortPre1(0),fortPre1(1)]
+  -- other special objects
+  ELT(STRINGIMAGE e,0) = "%" => SUBSEQ(STRINGIMAGE e,1)
+  atom e => e
+  [op, :args] := e
+  op in ["**" , '"**"] =>
+    [rand,exponent] := args
+    rand = "%e" => fortPre1 ["exp", exponent]
+    (IDENTP rand or STRINGP rand) and exponent=2 => ["*", rand, rand]
+    (FIXP exponent and ABS(exponent) < 32768) => ["**",fortPre1 rand,exponent]
+    ["**", fortPre1 rand,fortPre1 exponent]
+  op = "ROOT" =>
+    #args = 1 => fortPreRoot ["sqrt", first args]
+    [ "**" , fortPreRoot first args , [ "/" , fortPreRoot(1), fortPreRoot first rest args] ]
+  if op in ['"OVER", "OVER"] then op := '"/"
+  specialOps  := '(BRACKET BRACE SUB AGGLST SUPERSUB MATRIX SEGMENT ALTSUPERSUB
+                   PAREN CONCAT CONCATB QUOTE STRING SIGMA  STEP IN SIGMA2
+                   INTSIGN  PI PI2 INDEFINTEGRAL)
+  op in specialOps => exp2FortSpecial(op,args,#args)
+  op in ['"*", "*", '"+", "+", '"-", "-"] and (#args > 2) =>
+    binaryExpr := fortPre1 [op,first args, SECOND args]
+    for i in 3..#args repeat
+      binaryExpr := [op,binaryExpr,fortPre1 NTH(i-1,args)]
+    binaryExpr
+  -- Now look for any complex objects
+  #args = 2 =>
+    [arg1,arg2] := args
+    op in ["*",'"*"] and arg2 in imags => ['"CMPLX",fortPre1(0),fortPre1(arg1)]
+    op in ["+",'"+"] and arg2 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(1)]
+    op in ["+",'"+"] and arg2 is [mop,m1,m2] and mop in ["*",'"*"] =>
+      m2 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(m1)]
+      m1 in imags => ['"CMPLX",fortPre1(arg1),fortPre1(m2)]
+      ["+",fortPre1 arg1,fortPre1 arg2]
+    op in ["+",'"+"] and arg1 is [mop,m1,m2] and mop in ["*",'"*"] =>
+      m2 in imags => ['"CMPLX",fortPre1(arg2),fortPre1(m1)]
+      m1 in imags => ['"CMPLX",fortPre1(arg2),fortPre1(m2)]
+      ["+",fortPre1 arg1,fortPre1 arg2]
+    mkFortFn(op,args,2)
+  mkFortFn(op,args,#args)
+
+fortPreRoot e ==
+-- To set $fortInts2Floats 
+  $fortInts2Floats : fluid := true
+  fortPre1 e
+ 
+fix2FortranFloat e ==
+  -- Return a Fortran float for a given integer.
+  $fortranPrecision = "double" => STRCONC(STRINGIMAGE(e),".0D0")
+  STRCONC(STRINGIMAGE(e),".")
+ 
+isFloat e ==
+  FLOATP(e) or STRINGP(e) and FIND(char ".",e)
+ 
+checkPrecision e ==
+  -- Do we have a string?
+  STRINGP(e) and CHAR_-CODE(CHAR(e,0)) = 34 => e
+  e := delete(char " ",STRINGIMAGE e)
+  $fortranPrecision = "double" =>
+    iPart := SUBSEQ(e,0,(period:=POSITION(char ".",e))+1)
+    expt  := if ePos := POSITION(char "E",e) then SUBSEQ(e,ePos+1) else "0"
+    rPart :=
+      ePos => SUBSEQ(e,period+1,ePos)
+      period+1 < LENGTH e => SUBSEQ(e,period+1)
+      "0"
+    STRCONC(iPart,rPart,"D",expt)
+  e
+ 
+----------------- segment.boot -----------------------
+ 
+fortExpSize e ==
+  -- computes a tree reflecting the number of characters of the printed
+  -- expression.
+  -- The first element of a list is the "total so far", while subsequent
+  -- elements are the sizes of the components.
+  --
+  -- This function overestimates the size because it assumes that e.g.
+  -- (+ x (+ y z)) will be printed as "x+(y+z)" rather than "x+y+z"
+  -- which is the actual case.
+  atom e => LENGTH STRINGIMAGE e
+  #e > 3 => 2+fortSize MAPCAR(function fortExpSize, e)
+  #e < 3 => 2+fortSize MAPCAR(function fortExpSize, e)
+  [op,arg1,arg2] := e
+  op := STRINGIMAGE op
+  op = '"CMPLX" => 3+fortSize [fortExpSize arg1,fortExpSize arg2]
+  narys := ['"+",'"*"] -- those nary ops we changed to binary
+  op in narys =>
+    LISTP arg1 and not(op=STRINGIMAGE first arg1) =>
+      2+fortSize MAPCAR(function fortExpSize, e)
+    LISTP arg2 and not(op=STRINGIMAGE first arg2) =>
+      2+fortSize MAPCAR(function fortExpSize, e)
+    1+fortSize [fortExpSize arg1,fortExpSize arg2]
+  2+fortSize MAPCAR(function fortExpSize, e)
+ 
+fortSize e ==
+  +/[elen u for u in e] where
+    elen z ==
+      atom z => z
+      first z
+ 
+tempLen () == 1 + LENGTH STRINGIMAGE $exp2FortTempVarIndex
+ 
+segment l ==
+  not $fortranSegment => l
+  s := nil
+  for e in l repeat
+    if LISTP(e) and first e in ["=",'"="] then
+      var := NTH(1,e)
+      exprs := segment1(THIRD e,
+                        $maximumFortranExpressionLength-1-fortExpSize var)
+      s:= [:[['"=",var,car exprs],:cdr exprs],:s]
+    else if LISTP(e) and first e in ['"RETURN"] then
+      exprs := segment1(SECOND e,
+                        $maximumFortranExpressionLength-2-fortExpSize first e)
+      s := [:[[first e,car exprs],:cdr exprs],:s]
+    else s:= [e,:s]
+  reverse s
+ 
+segment1(e,maxSize) ==
+  (size := fortExpSize e) < maxSize => [e]
+  expressions := nil;
+  newE := [first e]
+  -- Assume we have to replace each argument with a temporary variable, and
+  -- that the temporary variable may be larger than we expect.
+  safeSize := maxSize -  (#e-1)*(tempLen()+1) - fortExpSize newE
+  for i in 2..#e repeat
+    subSize := fortExpSize NTH(i-1,e)
+    -- We could have a check here for symbols which are simply too big
+    -- for Fortran (i.e. more than the maximum practical expression length)
+    subSize <= safeSize =>
+      safeSize := safeSize - subSize
+      newE := [:newE,NTH(i-1,e)]
+    -- this ones too big.
+    exprs := segment2(NTH(i-1,e),safeSize)
+    expressions := [:(cdr exprs),:expressions]
+    newE := [:newE,(car exprs)]
+    safeSize := safeSize - fortExpSize car exprs
+  [newE,:expressions]
+ 
+segment2(e,topSize) ==
+  maxSize := $maximumFortranExpressionLength -tempLen()-1
+  atom(e) => [e]
+  exprs := nil
+  newE  := [first e]
+  topSize := topSize - fortExpSize newE
+  for i in 2..#e repeat
+    subE := NTH(i-1,e)
+    (subSize := fortExpSize subE) > maxSize =>
+      subE := segment2(subE,maxSize)
+      exprs := [:(cdr subE),:exprs]
+      if (subSize := fortExpSize first subE) <= topSize then
+        newE := [:newE,first subE]
+        topSize := topSize - subSize
+      else
+        newVar := newFortranTempVar()
+        newE := [:newE,newVar]
+        exprs:=[['"=",newVar,first subE],:exprs]
+        topSize := topSize - fortExpSize newVar
+    newE := [:newE,subE]
+    topSize := topSize - subSize
+  topSize > 0 => [newE,:exprs]
+  newVar := newFortranTempVar()
+  [newVar,['"=",newVar,newE],:exprs]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nhyper.boot.pamphlet b/src/interp/nhyper.boot.pamphlet
new file mode 100644
index 00000000..d0fb8051
--- /dev/null
+++ b/src/interp/nhyper.boot.pamphlet
@@ -0,0 +1,141 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nhyper.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- HyperTex Spad interface
+
+--SETANDFILEQ($SendXEventToHyperTeX, 8)
+--SETANDFILEQ($LinkToPage, 96)
+--SETANDFILEQ($StartPage, 97)
+--SETANDFILEQ($SendLine, 98)
+--SETANDFILEQ($EndOfPage, 99)
+--SETANDFILEQ($PopUpPage, 95)
+--SETANDFILEQ($PopUpNamedPage, 94)
+--SETANDFILEQ($KillPage, 93)
+--SETANDFILEQ($ReplacePage, 92)
+--SETANDFILEQ($ReplaceNamedPage, 91)
+--SETANDFILEQ($SpadError, 90)
+--SETANDFILEQ($PageStuff, 100)
+
+-- Issue a line of HyperTex
+issueHT line ==
+  sockSendInt($MenuServer, $SendLine)
+  sockSendString($MenuServer, line)
+
+endHTPage() ==
+  sockSendInt($MenuServer, $EndOfPage)
+
+testPage() ==
+  startHTPage(50)
+  issueHT '"\page{TestPage}{Test Page generated from Lisp} "
+  issueHT '"\horizontalline\beginscroll\beginitems "
+  issueHT '"\item \downlink{Quayle Jokes}{ChickenPage} \space{2} "
+  issueHT '"The misadventures of the White House bellboy. "
+  issueHT '"\enditems\endscroll\autobuttons "
+  endHTPage()
+
+-- create a named top-page
+HTLinkToPage name ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $LinkToPage)
+  sockSendString($MenuServer, name)
+
+-- create a pop-up named page ; returns a windowid
+HTPopUpNamedPage(name,cols) ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $PopUpNamedPage)
+  sockSendInt($MenuServer, cols)
+  sockSendString($MenuServer, name)
+  sockGetInt($MenuServer)
+
+-- Update a window with named page
+HTReplaceNamedPage(window, name) ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $ReplaceNamedPage)
+  sockSendInt($MenuServer, window)
+  sockSendString($MenuServer, name)
+   
+-- Start a pop-up page ; returns a windowid
+HTPopUpPage cols ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $PopUpPage)
+  sockSendInt($MenuServer, cols)
+  sockGetInt($MenuServer)
+
+-- Start an update sequence on a window
+HTReplacePage w ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $ReplacePage)
+  sockSendInt($MenuServer, w)
+
+-- Start a top-page ; no further Lisp interaction
+HTStartPage cols ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $StartPage)
+  sockSendInt($MenuServer, cols)
+
+-- Kill a window from Lisp
+HTKillPage w ==
+  sockSendInt($MenuServer, $PageStuff)
+  sockSendInt($MenuServer, $currentFrameNum)
+  sockSendInt($MenuServer, $KillPage)
+  sockSendInt($MenuServer, w)
+   
+HTErrorSignal() ==
+  sockSendInt($MenuServer, $SpadError)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nlib.lisp.pamphlet b/src/interp/nlib.lisp.pamphlet
new file mode 100644
index 00000000..2782a6cb
--- /dev/null
+++ b/src/interp/nlib.lisp.pamphlet
@@ -0,0 +1,537 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/nlib.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{GCL code.lsp name change}
+
+When we compile an algebra file we create an NRLIB directory which contains
+several files. One of the files is named [[code.lsp]]. 
+On certain platforms this causes linking problems for GCL. 
+The problem is that the compiler produces an init code block which is
+sensitive to the name of the source file.
+Since all of the [[code.lsp]] files have the same name all of
+the init blocks have the same name. At link time this causes
+the names to collide. Here we rename the file before we compile,
+do the compile, and then rename the result back to [[code.o]].
+This code used to read:
+but has been changed to read:
+<<code.lsp name change>>=
+#-:GCL (recompile-lib-file-if-necessary 
+         (concat (namestring filespec) "/code.lsp"))
+#+:GCL (let* ((base (pathname-name filespec))
+             (code (concatenate 'string (namestring filespec) "/code.lsp"))
+             (temp (concatenate 'string (namestring filespec) "/" base ".lsp"))
+             (o (make-pathname :type "o")))
+        (si::system (format nil "cp ~S ~S" code temp))
+        (recompile-lib-file-if-necessary temp)
+        (si::system (format nil "mv ~S ~S~%" 
+           (namestring (merge-pathnames o temp))
+           (namestring (merge-pathnames o code)))))
+@
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "VMLISP")
+
+#+:AKCL (defvar *lisp-bin-filetype* "o")
+
+#+:AKCL (defvar *lisp-source-filetype* "lsp")
+
+;; definition of our stream structure
+(defstruct libstream  mode dirname (indextable nil)  (indexstream nil))
+;indextable is a list of entries (key class <location or filename>)
+;filename is of the form filenumber.lsp or filenumber.o
+
+(defvar optionlist nil "alist which controls compiler output")
+
+(defun addoptions (key value) "adds pairs to optionlist"
+  (push (cons key value) optionlist)
+  (if (equal key 'FILE)
+      (push 
+       (cons 'COMPILER-OUTPUT-STREAM
+                   (open (concat (libstream-dirname value) "/" "code.lsp")
+                         :direction :output :if-exists :supersede))
+             optionlist)))
+
+(defun directory? (filename) (boot::|directoryp| filename))
+
+;; (RDEFIOSTREAM ((MODE . IO) (FILE fn ft dir))) IO is I,O,INPUT,OUTPUT
+#+:AKCL
+(defun rdefiostream (options &optional (missing-file-error-flag t))
+  (let ((mode (cdr (assoc 'mode options)))
+	(file (assoc 'file options))
+	(stream nil)
+	(fullname nil)
+	(indextable nil))
+        (cond ((equal (elt (string mode) 0) #\I)
+	       ;;(setq fullname (make-input-filename (cdr file) 'LISPLIB))
+	       (setq fullname (make-input-filename (cdr file) 'NIL))
+	       (setq stream (get-input-index-stream fullname))
+               (if (null stream)
+		   (if missing-file-error-flag
+		       (ERROR (format nil "Library ~s doesn't exist"
+			      ;;(make-filename (cdr file) 'LISPLIB))
+			      (make-filename (cdr file) 'NIL)))
+		     NIL)
+               (make-libstream :mode 'input  :dirname fullname
+                               :indextable (get-index-table-from-stream stream)
+			       :indexstream stream)))
+              ((equal (elt (string mode) 0) #\O)
+	       ;;(setq fullname (make-full-namestring (cdr file) 'LISPLIB))
+	       (setq fullname (make-full-namestring (cdr file) 'NIL))
+	       (case (directory? fullname)
+		     (-1 (makedir fullname))
+		     (0 (error (format nil "~s is an existing file, not a library" fullname)))
+		     (otherwise))
+	       (multiple-value-setq (stream indextable) (get-io-index-stream fullname))
+	       (make-libstream :mode 'output  :dirname fullname
+			       :indextable indextable
+			       :indexstream stream ))
+              ('t  (ERROR "Unknown MODE")))))
+
+#+:CCL
+(defun rdefiostream (options &optional (missing-file-error-flag t))
+  (let ((mode (cdr (assoc 'mode options)))
+        (file (assoc 'file options))
+        (stream nil)
+        (fullname nil)
+        (indextable nil))
+        (cond ((equal (elt (string mode) 0) #\I)
+               (setq fullname (make-input-filename (cdr file) NIL))
+               (setq stream (get-input-index-stream fullname))
+               (if (null stream)
+                   (if missing-file-error-flag
+                       (ERROR (format nil "Library ~s doesn't exist"
+                              (make-filename (cdr file) NIL)))
+                     NIL)
+               (make-libstream :mode 'input  :dirname fullname
+                               :indextable (get-index-table-from-stream stream)
+                               :indexstream stream)))
+              ((equal (elt (string mode) 0) #\O)
+               (setq fullname (make-full-namestring (cdr file) NIL))
+               (create-directory fullname)
+               (multiple-value-setq (stream indextable)
+                        (get-io-index-stream fullname))
+               (make-libstream :mode 'output  :dirname fullname
+                               :indextable indextable
+                               :indexstream stream ))
+              ('t  (ERROR "Unknown MODE")))))
+
+#+:AKCL (defvar *index-filename* "index.KAF")
+#+:CCL (defvar *index-filename* "index.KAF")
+
+;get the index table of the lisplib in dirname
+(defun getindextable (dirname)
+  (let ((index-file (concat dirname "/" *index-filename*)))
+     (if (probe-file index-file)
+         (with-open-file (stream index-file) (get-index-table-from-stream stream))
+            ;; create empty index file to mark directory as lisplib
+         (with-open-file (stream index-file :direction :output) nil))))
+
+;get the index stream of the lisplib in dirname
+(defun get-input-index-stream (dirname)
+  (let ((index-file (concat dirname "/" *index-filename*)))
+    (open index-file :direction :input :if-does-not-exist nil)))
+
+(defun get-index-table-from-stream (stream)
+  (let ((pos (read  stream)))
+    (cond ((numberp pos)
+	   (file-position stream pos)
+	   (read stream))
+	  (t pos))))
+
+#+:AKCL
+(defun get-io-index-stream (dirname)
+  (let* ((index-file (concat dirname "/" *index-filename*))
+	 (stream (open index-file :direction :io :if-exists :overwrite
+		       :if-does-not-exist :create))
+	 (indextable ())
+	 (pos (read stream nil nil)))
+    (cond ((numberp pos)
+	   (file-position stream pos)
+	   (setq indextable (read stream))
+	   (file-position stream pos))
+	  (t (file-position stream 0)
+	     (princ "                    " stream)
+	     (setq indextable pos)))
+    (values stream indextable)))
+
+#+:CCL
+(defun get-io-index-stream (dirname)
+  (let ((index-file (concat dirname "/" *index-filename*))
+        (indextable ())
+        (stream) (pos))
+    (cond ((probe-file index-file)
+           (setq stream (open index-file :direction :io :if-exists :overwrite))
+           (setq pos (read stream))
+           (file-position stream pos)
+           (setq indextable (read stream))
+           (file-position stream pos))
+          (t (setq stream (open index-file :direction :io
+                       :if-does-not-exist :create))
+             ;(file-position stream 0)
+             (princ "                    " stream)))
+    (values stream indextable)))
+
+
+;substitute indextable in dirname
+
+(defun write-indextable (indextable stream)
+  (let ((pos (file-position stream)))
+    (write indextable :stream stream :level nil :length nil :escape t)
+    (finish-output stream)
+    (file-position stream 0)
+    (princ pos stream)
+    (finish-output stream)))
+
+;;#+:ccl
+;;(defun putindextable (indextable dirname)
+;;  (with-open-file
+;;    (stream (concat dirname "/" *index-filename*)
+;;             :direction :io :if-does-not-exist :create)
+;;    (file-position stream :end)
+;;    (write-indextable indextable stream)))
+;;#-:ccl
+(defun putindextable (indextable dirname)
+  (with-open-file
+    (stream (concat dirname "/" *index-filename*)
+             :direction :io :if-exists :overwrite
+             :if-does-not-exist :create)
+    (file-position stream :end)
+    (write-indextable indextable stream)))
+
+;makedir (fname) fname is a directory name.
+#+:AKCL
+(defun makedir (fname)
+  (system (concat "mkdir " fname)))
+
+;; (RREAD key rstream)
+(defun rread (key rstream &optional (error-val nil error-val-p))
+  (if (equal (libstream-mode rstream) 'output) (error "not input stream"))
+  (let* ((entry
+	 (and (stringp key)
+	      (assoc key (libstream-indextable rstream) :test #'string=)))
+	 (file-or-pos (and entry (caddr entry))))
+    (cond ((null entry)
+	   (if error-val-p error-val (error (format nil "key ~a not found" key))))
+	  ((null (caddr entry)) (cdddr entry))  ;; for small items
+	  ((numberp file-or-pos)
+	   (file-position (libstream-indexstream rstream) file-or-pos)
+	   (read (libstream-indexstream rstream)))
+	  (t
+	   (with-open-file
+	    (stream (concat (libstream-dirname rstream) "/" file-or-pos))
+	    (read  stream))) )))
+
+(defvar *lib-var*)
+
+;; (RKEYIDS filearg) -- interned version of keys
+(defun rkeyids (&rest filearg)
+  (mapcar #'intern (mapcar #'car (getindextable
+				  (make-input-filename filearg 'NIL)))))
+;;(defun rkeyids (&rest filearg)
+;;  (mapcar #'intern (mapcar #'car (getindextable
+;;				  (make-input-filename filearg 'LISPLIB)))))
+
+;; (RWRITE cvec item rstream)
+(defun rwrite (key item rstream)
+  (if (equal (libstream-mode rstream) 'input) (error "not output stream"))
+  (let ((stream (libstream-indexstream rstream))
+	(pos (if item (cons (file-position (libstream-indexstream rstream)) nil)
+	       (cons nil item))))   ;; for small items
+    (make-entry (string key) rstream pos)
+    (when (numberp (car pos))
+	  (write item :stream stream :level nil :length nil
+		 :circle t :array t :escape t)
+	  (terpri stream))))
+
+(defun make-entry (key rstream value-or-pos)
+   (let ((entry (assoc key (libstream-indextable rstream) :test #'equal)))
+     (if (null entry)
+	 (push (setq entry (cons key (cons 0 value-or-pos)))
+	       (libstream-indextable rstream))
+       (progn
+	 (if (stringp (caddr entry)) ($erase (caddr entry)))
+	 (setf (cddr entry) value-or-pos)))
+     entry))
+
+;;(defun rshut (rstream)
+;;  (when (and (equal rstream (cdr (assoc 'FILE OPTIONLIST)))
+;;             (assoc 'compiler-output-stream optionlist))
+;;        (close (cdr (assoc 'compiler-output-stream optionlist)))
+;;        (setq optionlist nil))
+;;  (if (eq (libstream-mode rstream) 'output)
+;;      (write-indextable (libstream-indextable rstream) (libstream-indexstream rstream)))
+;;  (close (libstream-indexstream rstream)))
+(defun rshut (rstream)
+  (when (and (equal rstream (cdr (assoc 'FILE OPTIONLIST)))
+             (assoc 'compiler-output-stream optionlist))
+        (close (cdr (assoc 'compiler-output-stream optionlist)))
+        (setq optionlist (cddr optionlist)))
+  (if (eq (libstream-mode rstream) 'output)
+      (write-indextable (libstream-indextable rstream) (libstream-indexstream rstream)))
+  (close (libstream-indexstream rstream)))
+
+;; filespec is id or list of 1, 2 or 3 ids
+;; filearg is filespec or 1, 2 or 3 ids
+;; (RPACKFILE filearg)  -- compiles code files and converts to compressed format
+(defun rpackfile (filespec)
+  (setq filespec (make-filename filespec))
+  (if (string= (pathname-type filespec) "NRLIB")
+<<code.lsp name change>>
+  ;; only pack non libraries to avoid lucid file handling problems    
+    (let* ((rstream (rdefiostream (list (cons 'file filespec) (cons 'mode 'input))))
+	   (nstream nil)
+	   (nindextable nil)
+	   (nrstream nil)
+	   (index-file-name (concat (truename filespec) "/" *index-filename*))
+	   (temp-index-file-name (make-pathname :name "oldindex"
+						:defaults index-file-name)))
+      (rename-file index-file-name temp-index-file-name ) ;; stays until closed
+      (multiple-value-setq (nstream nindextable) (get-io-index-stream filespec))
+      (setq nrstream (make-libstream :mode 'output  :dirname filespec
+				     :indextable nindextable
+				     :indexstream nstream ))
+      (dolist (entry (libstream-indextable rstream))
+	      (rwrite (car entry) (rread (car entry) rstream) nrstream)
+	      (if (stringp (caddr entry))
+		  (delete-file (concat filespec "/" (caddr entry)))))
+      (close (libstream-indexstream rstream))
+      (delete-file temp-index-file-name)
+      (rshut nrstream)))
+  filespec)
+
+#+:AKCL
+(defun recompile-lib-file-if-necessary (lfile)
+   (let* ((bfile (make-pathname :type *lisp-bin-filetype* :defaults lfile))
+          (bdate (and (probe-file bfile) (file-write-date bfile)))
+          (ldate (and (probe-file lfile) (file-write-date lfile))))
+     (if ldate
+	 (if (and bdate (> bdate ldate)) nil
+	   (progn (compile-lib-file lfile) (list bfile))))))
+
+#+:CCL
+(defun recompile-lib-file-if-necessary (lfile)
+ (let ( (mname (pathname-name (file-namestring (directory-namestring lfile))))
+        (mdate (modulep mname))
+        (ldate (filedate lfile)) )
+        (if (or (not mdate) (datelessp mdate ldate)) 
+          (seq
+            (if (null output-library)
+                (boot::|openOutputLibrary|
+                  (setq boot::|$outputLibraryName|
+                   (if (null boot::|$outputLibraryName|)
+                       (make-pathname :directory (get-current-directory)
+                                      :name "user.lib")
+                        (if (filep boot::|$outputLibraryName|)
+                            (truename boot::|$outputLibraryName|)
+                            boot::|$outputLibraryName|)))))
+            (compile-file lfile 
+                          :output-file (intern (pathname-name
+                                               (directory-namestring lfile))))))))
+
+
+#+:AKCL
+(defun spad-fixed-arg (fname )
+   (and (equal (symbol-package fname) (find-package "BOOT"))
+        (not (get fname 'compiler::spad-var-arg))
+	(search ";" (symbol-name fname))
+        (or (get fname 'compiler::fixed-args)
+	    (setf (get fname 'compiler::fixed-args) t)))
+   nil)
+
+#+:AKCL
+(defun compile-lib-file (fn &rest opts)
+  (unwind-protect
+      (progn
+	(trace (compiler::fast-link-proclaimed-type-p
+		:exitcond nil
+		:entrycond (spad-fixed-arg (car system::arglist))))
+	(trace (compiler::t1defun :exitcond nil
+		:entrycond (spad-fixed-arg (caar system::arglist))))
+	(apply #'compile-file fn opts))
+    (untrace compiler::fast-link-proclaimed-type-p compiler::t1defun)))
+#+:CCL
+(define-function 'compile-lib-file #'compile-file)
+
+;; (RDROPITEMS filearg keys) don't delete, used in files.spad
+(defun rdropitems (filearg keys &aux (ctable (getindextable filearg)))
+  (mapc #'(lambda(x)
+           (setq ctable (delete x ctable :key #'car :test #'equal)) )
+           (mapcar #'string keys))
+  (putindextable ctable filearg))
+
+;; cms file operations
+(defun make-filename (filearg &optional (filetype nil))
+  (let ((filetype (if (symbolp filetype) 
+		      (symbol-name filetype)
+		      filetype)))
+    (cond
+     ((pathnamep filearg) 
+      (cond ((pathname-type filearg) (namestring filearg))
+	    (t (namestring (make-pathname :directory (pathname-directory filearg)
+					  :name (pathname-name filearg)
+					  :type filetype)))))
+     ;; Previously, given a filename containing "." and
+     ;; an extension this function would return filearg. MCD 23-8-95.
+     ((and (stringp filearg) (pathname-type filearg) (null filetype)) filearg)
+     ;;  ((and (stringp filearg)
+     ;;    (or (pathname-type filearg) (null filetype)))
+     ;;     filearg)
+     ((and (stringp filearg) (stringp filetype)
+	   (pathname-type filearg) 
+	   (string-equal (pathname-type filearg) filetype))
+      filearg)
+     ((consp filearg)
+      (make-filename (car filearg) (or (cadr filearg) filetype)))
+     (t (if (stringp filetype) (setq filetype (intern filetype "BOOT")))
+	(let ((ft (or (cdr (assoc filetype $filetype-table)) filetype)))
+	  (if ft 
+	      (concatenate 'string (string filearg) "." (string ft))
+	      (string filearg)))))))
+
+(defun make-full-namestring (filearg &optional (filetype nil))
+  (namestring (merge-pathnames (make-filename filearg filetype))))
+
+(defun probe-name (file)
+  (if (probe-file file) (namestring file) nil))
+
+(defun get-directory-list (ft &aux (cd (namestring $current-directory)))
+  (declare (special $current-directory))
+  (cond ((member ft '("NRLIB" "DAASE" "EXPOSED") :test #'string=)
+	   (if (eq BOOT::|$UserLevel| 'BOOT::|development|)
+	       (cons cd $library-directory-list)
+	       $library-directory-list))
+	(t (adjoin cd 
+              (adjoin (namestring (user-homedir-pathname)) $directory-list 
+                      :test #'string=) 
+              :test #'string=))))
+
+(defun make-input-filename (filearg &optional (filetype nil))
+   (let*
+     ((filename  (make-filename filearg filetype))
+      (dirname (pathname-directory filename))
+      (ft (pathname-type filename))
+      (dirs (get-directory-list ft))
+      (newfn nil))   
+    (if (or (null dirname) (eqcar dirname :relative))
+	(dolist (dir dirs (probe-name filename))
+		(when 
+		 (probe-file 
+		  (setq newfn (concatenate 'string dir filename)))
+		 (return newfn)))
+      (probe-name filename))))
+
+(defun $FILEP (&rest filearg) (make-full-namestring filearg))
+(define-function '$OUTFILEP #'$FILEP) ;;temporary bogus def
+
+(defun $findfile (filespec filetypelist)
+  (let ((file-name (if (consp filespec) (car filespec) filespec))
+	(file-type (if (consp filespec) (cadr filespec) nil)))
+    (if file-type (push file-type filetypelist))
+    (some #'(lambda (ft) (make-input-filename file-name ft))
+	  filetypelist)))
+
+;; ($ERASE filearg) -> 0 if succeeds else 1
+(defun $erase (&rest filearg)
+  (system (concat "rm -rf "(make-full-namestring filearg))))
+
+(defun $REPLACE (filespec1 filespec2)
+    ($erase (setq filespec1 (make-full-namestring filespec1)))
+    (rename-file (make-full-namestring filespec2) filespec1))
+
+
+
+;;(defun move-file (namestring1 namestring2)
+;;  (rename-file namestring1 namestring2))
+
+(defun $FCOPY (filespec1 filespec2)
+    (let ((name1 (make-full-namestring filespec1))
+	  (name2 (make-full-namestring filespec2)))
+      (if (library-file name1)
+	(copy-lib-directory name1 name2)
+	(copy-file name1 name2))))
+
+
+#+(OR :AKCL (AND :CCL :UNIX))
+(defun copy-lib-directory (name1 name2)
+   (makedir name2)
+   (system (concat "sh -c 'cp " name1 "/* " name2 "'")))
+
+#+(OR :AKCL (AND :CCL :UNIX))
+(defun copy-file (namestring1 namestring2)
+  (system (concat "cp " namestring1 " " namestring2)))
+
+
+(defvar vmlisp::$filetype-table
+  '((BOOT::LISPLIB . |LILIB|)
+    (BOOT::SPADLIB . |slib|)
+    (BOOT::HISTORY . |hist|)
+    (BOOT::HELPSPAD . |help|)
+    (BOOT::INPUT . |input|)
+    (BOOT::SPAD . |spad|)
+    (BOOT::BOOT . |boot|)
+    (BOOT::LISP . |lsp|)
+    (BOOT::META . |meta|)
+    (BOOT::OUTPUT . |splog|)
+    (BOOT::ERRORLIB . |erlib|)
+    (BOOT::DATABASE . |DAASE|)
+    (BOOT::SPADDATA . |sdata|)
+    (BOOT::SPADFORT . |sfort|)
+    (BOOT::SPADFORM . |sform|)
+    (BOOT::SPADTEX . |stex|)
+    (BOOT::SPADOUT . |spout|)))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nocompil.lisp.pamphlet b/src/interp/nocompil.lisp.pamphlet
new file mode 100644
index 00000000..a3a3c980
--- /dev/null
+++ b/src/interp/nocompil.lisp.pamphlet
@@ -0,0 +1,104 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nocompil.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+The function {\bf protected-symbol-warn} was added because it is
+used in {\bf setvart.boot} but apparently is nowhere defined. It
+is probably primitive to {\bf CCL}.
+
+The function {\bf protect-symbols} was added because it is
+used in {\bf setvart.boot} but apparently is nowhere defined. It
+is probably primitive to {\bf CCL}.
+
+The output of these functions is just a noisy warning message
+and this has been commented out.
+\section{GCL cmpnote function}
+GCL keeps noting the fact that the compiler is performing tail-recursion.
+Bill Schelter added this as a debugging tool for Axiom and it was never
+removed. Patching the lisp code in the GCL build fails as the system
+is actually built from the pre-compiled C code. Thus, we can only step
+on this message after the fact. The cmpnote function is used nowhere
+else in GCL so stepping on the function call seems best. We're unhappy
+with this hack and will try to convince the GCL crowd to fix this.
+<<gcl-cmpnote>>=
+#+:gcl (defun compiler::cmpnote (&rest x))
+@ 
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+<<gcl-cmpnote>>
+
+(in-package "BOOT")
+
+(defun protected-symbol-warn (&rest arg))
+;  (format t "protected-symbol-warn called with ~A~%" arg))
+
+(defun protect-symbols (&rest arg))
+;  (format t "protected-symbol-warn called with ~A~%" arg))
+
+(defun use-fast-links (arg)
+;  (format t "use-fast-links called with ~A~%" arg)
+#+:GCL  (si::use-fast-links arg)
+ )
+
+(defun verbos (arg))
+;  (format t "verbos called with ~A~%" arg))
+
+(defun enable-backtrace (&rest arg)
+#+:ccl
+  (format t "protected-symbol-warn called with ~A~%" arg))
+
+;; NOTE: JoinInner is defined in CATEGORY BOOT
+;; following code needs to run interpreted to overcome arglist length limits
+(defun |Join| (&rest L)
+  (|JoinInner| L (if (OR (not (boundp '|$e|)) (NULL |$e|) |$InteractiveMode|)
+		   |$CategoryFrame|
+		   |$e|)))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nruncomp.boot.pamphlet b/src/interp/nruncomp.boot.pamphlet
new file mode 100644
index 00000000..fbc94289
--- /dev/null
+++ b/src/interp/nruncomp.boot.pamphlet
@@ -0,0 +1,769 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp nruncomp.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-----------------------------NEW buildFunctor CODE-----------------------------
+NRTaddDeltaCode() ==
+--NOTES: This function is called from NRTbuildFunctor to initially
+--  fill slots in $template. The $template so created is stored in the
+--  NRLIB. On load, makeDomainTemplate is called on this $template to
+--  create a template which becomes slot 0 of the infovec for the constructor.
+--The template has 6 kinds of entries:
+--  (1) formal arguments and local variables, represented by (QUOTE <entry>)
+--      this conflicts by (5) but is ok since each is explicitly set by
+--      instantiator code;
+--  (2) domains, represented by lazy forms, e.g. (Foo 12 17 6)
+--  (3) latch slots, represented SPADCALLable forms which goGet an operation
+--      from a domain then cache the operation in the same slot
+--  (4) functions, represented by identifiers which are names of functions
+--  (5) identifiers/strings, parts of signatures (now parts of signatures
+--      now must all have slot numbers, represented by (QUOTE <entry>)
+--  (6) constants, like 0 and 1, represented by (CONS .. ) form
+  kvec := first $catvecList
+  for i in $NRTbase.. for item in REVERSE $NRTdeltaList
+    for compItem in REVERSE $NRTdeltaListComp
+      |null (s:=kvec.i) repeat
+        $template.i:= deltaTran(item,compItem)
+  $template.5 :=
+    $NRTaddForm =>
+      $NRTaddForm is ['Tuple,:y] => NREVERSE y
+      NRTencode($NRTaddForm,$addForm)
+    nil
+
+deltaTran(item,compItem) ==
+  item is ['domain,lhs,:.] => NRTencode(lhs,compItem)
+  --NOTE: all items but signatures are wrapped with domain forms
+  [op,:modemap] := item
+  [dcSig,[.,[kind,:.]]] := modemap
+  [dc,:sig] := dcSig
+  sig := substitute('$,dc,substitute("$$",'$,sig))
+  dcCode :=
+    dc = '$ =>
+      --$NRTaddForm => -5
+      0
+    NRTassocIndexAdd dc or keyedSystemError("S2NR0004",[dc])
+  formalSig:= SUBLISLIS($FormalMapVariableList,$formalArgList,sig)
+  kindFlag:= (kind = 'CONST => 'CONST; nil)
+  newSig := [NRTassocIndex x or x for x in formalSig]
+  [newSig,dcCode,op,:kindFlag]
+
+--NRTencodeSig x == [NRTencode y for y in x]
+
+NRTreplaceAllLocalReferences(form) ==
+  $devaluateList :local := []
+  NRTputInLocalReferences form
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
+  --converts a domain form to a lazy domain form; everything other than
+  --the operation name should be assigned a slot
+  null firstTime and (k:= NRTassocIndex x) => k
+  VECP x => systemErrorHere '"NRTencode"
+  PAIRP x =>
+    QCAR x='Record or x is ['Union,['_:,a,b],:.] =>
+      [QCAR x,:[['_:,a,encode(b,c,false)]
+        for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]]
+    constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) =>
+      [QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]]
+    ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm]
+  MEMQ(x,$formalArgList) =>
+    v := $FormalMapVariableList.(POSN1(x,$formalArgList))
+    firstTime => ['local,v]
+    v
+  x = '$ => x
+  ['QUOTE,x]
+
+--------------FUNCTIONS CALLED DURING CAPSULE FUNCTION COMPILATION-------------
+listOfBoundVars form ==
+-- Only called from the function genDeltaEntry below
+  form = '$ => []
+  IDENTP form and (u:=get(form,'value,$e)) =>
+    u:=u.expr
+    MEMQ(KAR u,'(Union Record)) => listOfBoundVars u
+    [form]
+  atom form => []
+  CAR form = 'QUOTE => []
+  EQ(CAR form,":") => listOfBoundVars CADDR form
+  -- We don't want to pick up the tag, only the domain
+  "union"/[listOfBoundVars x for x in CDR form]
+
+optDeltaEntry(op,sig,dc,eltOrConst) ==
+  $killOptimizeIfTrue = true => nil
+  ndc :=
+    dc = '$ => $functorForm
+    atom dc and (dcval := get(dc,'value,$e)) => dcval.expr
+    dc
+--if (atom dc) and (dcval := get(dc,'value,$e))
+--   then ndc := dcval.expr
+--   else ndc := dc
+  sig := SUBST(ndc,dc,sig)
+  not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
+  dcval := optCallEval ndc
+  -- MSUBST guarantees to use EQUAL testing
+  sig := MSUBST(devaluate dcval, ndc, sig)
+  if rest ndc then
+     for new in rest devaluate dcval for old in rest ndc repeat
+       sig := MSUBST(new,old,sig)
+     -- optCallEval sends (List X) to (LIst (Integer)) etc,
+     -- so we should make the same transformation
+  fn := compiledLookup(op,sig,dcval)
+  if null fn then
+    -- following code is to handle selectors like first, rest
+     nsig := [quoteSelector tt for tt in sig] where
+       quoteSelector(x) ==
+         not(IDENTP x) => x
+         get(x,'value,$e) => x
+         x='$ => x
+	 MKQ x
+     fn := compiledLookup(op,nsig,dcval)
+     if null fn then return nil
+  eltOrConst="CONST" => ['XLAM,'ignore,MKQ SPADCALL fn]
+  GETL(compileTimeBindingOf first fn,'SPADreplace)
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+genDeltaEntry opMmPair ==
+--called from compApplyModemap
+--$NRTdeltaLength=0.. always equals length of $NRTdeltaList
+  [.,[odc,:.],.] := opMmPair
+  --opModemapPair := SUBLIS($LocalDomainAlist,opMmPair)
+  [op,[dc,:sig],[.,cform:=[eltOrConst,:.]]] := opMmPair
+  if $profileCompiler = true then profileRecord(dc,op,sig)
+  eltOrConst = 'XLAM => cform
+  if eltOrConst = 'Subsumed then eltOrConst := 'ELT
+    -- following hack needed to invert Rep to $ substitution
+  if odc = 'Rep and cform is [.,.,osig] then sig:=osig
+  newimp := optDeltaEntry(op,sig,dc,eltOrConst) => newimp
+  setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] =>
+    ['applyFun,['compiledLookupCheck,MKQ op,
+         mkList consSig(sig,dc),consDomainForm(dc,nil)]]
+ --if null atom dc then
+ --   sig := substitute('$,dc,sig)
+ --   cform := substitute('$,dc,cform)
+  opModemapPair :=
+    [op,[dc,:[genDeltaSig x for x in sig]],['T,cform]] -- force pred to T
+  if null NRTassocIndex dc and dc ^= $NRTaddForm and
+    (member(dc,$functorLocalParameters) or null atom dc) then
+    --create "domain" entry to $NRTdeltaList
+      $NRTdeltaList:= [['domain,NRTaddInner dc,:dc],:$NRTdeltaList]
+      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      compEntry:= compOrCroak(dc,$EmptyMode,$e).expr
+--      dc
+      RPLACA(saveNRTdeltaListComp,compEntry)
+  u :=
+    [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index ==
+      (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1
+        --n + 1 since $NRTdeltaLength is 1 too large
+      $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+      $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      0
+  u
+
+genDeltaSig x ==
+  NRTgetLocalIndex x
+
+genDeltaSpecialSig x ==
+  x is [":",y,z] => [":",y,genDeltaSig z]
+  genDeltaSig x
+
+NRTassocIndexAdd x ==
+  x = $NRTaddForm => 5
+  NRTassocIndex x
+
+NRTassocIndex x == --returns index of "domain" entry x in al
+  NULL x => x
+  x = $NRTaddForm => 5
+  k := or/[i for i in 1.. for y in $NRTdeltaList
+            | y.0 = 'domain and y.1 = x and ($found := y)] =>
+    $NRTbase + $NRTdeltaLength - k
+  nil
+
+NRTgetLocalIndexClear item == NRTgetLocalIndex1(item,true)
+
+NRTgetLocalIndex item == NRTgetLocalIndex1(item,false)
+
+NRTgetLocalIndex1(item,killBindingIfTrue) ==
+  k := NRTassocIndex item => k
+  item = $NRTaddForm => 5
+  item = '$ => 0
+  item = '_$_$ => 2
+  value:=
+    MEMQ(item,$formalArgList) => item
+    nil
+  atom item and null MEMQ(item,'($ _$_$))
+   and null value =>  --give slots to atoms
+    $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+    $NRTdeltaListComp:=[item,:$NRTdeltaListComp]
+    $NRTdeltaLength := $NRTdeltaLength+1
+    $NRTbase + $NRTdeltaLength - 1
+  $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+  saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+  saveIndex := $NRTbase + $NRTdeltaLength
+  $NRTdeltaLength := $NRTdeltaLength+1
+  compEntry:= compOrCroak(item,$EmptyMode,$e).expr
+--    item
+  RPLACA(saveNRTdeltaListComp,compEntry)
+  saveIndex
+
+NRTgetAddForm domain ==
+  u := HGET($Slot1DataBase,first domain) =>
+    EQSUBSTLIST(rest domain,$FormalMapVariableList,first u)
+  systemErrorHere '"NRTgetAddForm"
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+NRTassignCapsuleFunctionSlot(op,sig) ==
+--called from compDefineCapsuleFunction
+  opSig := [op,sig]
+  [.,.,implementation] := NRTisExported? opSig or return nil
+    --if opSig is not exported, it is local and need not be assigned
+  sig := [genDeltaSig x for x in sig]
+  opModemapPair := [op,['_$,:sig],['T,implementation]]
+  POSN1(opModemapPair,$NRTdeltaList) => nil   --already there
+  $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+  $NRTdeltaListComp := [nil,:$NRTdeltaListComp]
+  $NRTdeltaLength := $NRTdeltaLength+1
+
+NRTisExported? opSig ==
+  or/[u for u in $domainShell.1 | u.0 = opSig]
+
+consOpSig(op,sig,dc) ==
+  if null atom op then
+    keyedSystemError("S2GE0016",['"consOpSig",'"bad operator in table"])
+  mkList [MKQ op,mkList consSig(sig,dc)]
+
+consSig(sig,dc) == [consDomainName(sigpart,dc) for sigpart in sig]
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+consDomainName(x,dc) ==
+  x = dc => ''$
+  x = '$ => ['devaluate,'$]
+  x is [op,:argl] =>
+    (op = 'Record) or (op = 'Union and argl is [[":",:.],:.])  =>
+       mkList [MKQ op,
+         :[['LIST,MKQ '_:,MKQ tag,consDomainName(dom,dc)]
+                   for [.,tag,dom] in argl]]
+    isFunctor op or op = 'Mapping or constructor? op =>
+         -- call to constructor? needed if op was compiled in $bootStrapMode
+        mkList [MKQ op,:[consDomainName(y,dc) for y in argl]]
+    x
+  x = [] => x
+  (y := LASSOC(x,$devaluateList)) => y
+  k:=NRTassocIndex x =>
+    ['devaluate,['ELT,'$,k]]
+  get(x,'value,$e) or get(x,'mode,$e) =>
+    isDomainForm(x,$e) => ['devaluate,x]
+    x
+  MKQ x
+
+consDomainForm(x,dc) ==
+  x = '$ => '$
+  x is [op,:argl] =>
+     op = ":" and argl is [tag, value] => [op, tag, consDomainForm(value,dc)]
+     [op,:[consDomainForm(y,dc) for y in argl]]
+  x = [] => x
+  (y := LASSOC(x,$devaluateList)) => y
+  k:=NRTassocIndex x => ['ELT,'$,k]
+  get(x,'value,$e) or get(x,'mode,$e) => x
+  MKQ x
+
+buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
+--PARAMETERS
+--  $definition: constructor form, e.g. (SquareMatrix 10 (RationalNumber))
+--  sig: signature of constructor form
+--  code: result of "doIt", converting body of capsule to CodeDefine forms, e.g.
+--       (PROGN (LET Rep ...)
+--              (: (ListOf x y) $)
+--              (CodeDefine (<op> <signature> <functionName>))
+--              (COND ((HasCategory $ ...) (PROGN ...))) ..)
+--  $locals: list of variables to go into slot 5, e.g. (R Rep R,1 R,2 R,3 R,4)
+--           same as $functorLocalParameters
+--           this list is not augmented by this function
+--  $e: environment
+--GLOBAL VARIABLES REFERENCED:
+--  $domainShell: passed in from compDefineFunctor1
+--  $QuickCode: compilation flag
+
+  if code is ['add,.,newstuff] then code := newstuff
+
+  changeDirectoryInSlot1()  --this extends $NRTslot1PredicateList
+
+  --pp '"=================="
+  --for item in $NRTdeltaList repeat pp item
+
+--LOCAL BOUND FLUID VARIABLES:
+  $GENNO: local:= 0     --bound in compDefineFunctor1, then as parameter here
+--$frontier: local      --index of first local slot=#(cat part of princ view)
+  $catvecList: local    --list of vectors v1..vn for each view
+  $hasCategoryAlist: local  --list of GENSYMs bound to (HasCategory ..) items
+  $catNames: local      --list of names n1..nn for each view
+  $maximalViews: local  --list of maximal categories for domain (???)
+  $catsig: local        --target category (used in ProcessCond)
+  $SetFunctions: local  --copy of p view with preds telling when fnct defined
+  $MissingFunctionInfo: local --now useless
+     --vector marking which functions are assigned
+  $ConstantAssignments: local --code for creation of constants
+  $epilogue: local := nil     --code to set slot 5, things to be done last
+  $HackSlot4: local  --Invention of JHD 13/July/86-set in InvestigateConditions
+  $extraParms:local  --Set in DomainSubstitutionFunction, used in setVector12
+  $devaluateList: local --Bound to ((#1 . dv$1)..) where &1 := devaluate #1 later
+  $devaluateList:= [[arg,:b] for arg in args for b in $ModeVariableList]
+  $supplementaries: local
+   --set in InvestigateConditions to represent any additional
+   --category membership tests that may be needed(see buildFunctor for details)
+------------------------
+  $maximalViews: local
+  oldtime:= TEMPUS_-FUGIT()
+  [$catsig,:argsig]:= sig
+  catvecListMaker:=REMDUP
+    [(comp($catsig,$EmptyMode,$e)).expr,
+      :[compCategories first u for u in CADR $domainShell.4]]
+  condCats:= InvestigateConditions [$catsig,:rest catvecListMaker]
+  -- a list, one %for each element of catvecListMaker
+  -- indicating under what conditions this
+  -- category should be present.  true => always
+  makeCatvecCode:= first catvecListMaker
+  emptyVector := VECTOR()
+--if $NRTaddForm and null NRTassocIndex $NRTaddForm then
+--  --create "domain" entry to $NRTdeltaList
+--    $NRTdeltaList:=
+--      [['domain,NRTaddInner $NRTaddForm,:$NRTaddForm],:$NRTdeltaList]
+--    $NRTdeltaLength := $NRTdeltaLength+1
+--NRTgetLocalIndex $NRTaddForm
+  domainShell := GETREFV (6 + $NRTdeltaLength)
+  for i in 0..4 repeat domainShell.i := $domainShell.i
+    --we will clobber elements; copy since $domainShell may be a cached vector
+  $template :=
+    $NRTvec = true => GETREFV (6 + $NRTdeltaLength)
+    nil
+  $catvecList:= [domainShell,:[emptyVector for u in CADR domainShell.4]]
+  $catNames := ['$] -- for DescendCode -- to be changed below for slot 4
+  $maximalViews:= nil
+  $SetFunctions:= GETREFV SIZE domainShell
+  $MissingFunctionInfo:= GETREFV SIZE domainShell
+  $catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]]
+  domname:='dv_$
+
+-->  Do this now to create predicate vector; then DescendCode can refer
+-->  to predicate vector if it can
+  [$uncondAlist,:$condAlist] :=    --bound in compDefineFunctor1
+      NRTsetVector4Part1($catNames,catvecListMaker,condCats)
+  [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
+      makePredicateBitVector [:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList]
+
+  storeOperationCode:= DescendCode(code,true,nil,first $catNames)
+  outsideFunctionCode:= NRTaddDeltaCode()
+  storeOperationCode:= NRTputInLocalReferences storeOperationCode
+  if $NRTvec = true then
+    NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode
+  codePart2:=
+    $NRTvec = true =>
+      argStuffCode :=
+        [[$setelt,'$,i,v] for i in 6.. for v in $FormalMapVariableList
+          for arg in rest $definition]
+      if MEMQ($NRTaddForm,$locals) then
+         addargname := $FormalMapVariableList.(POSN1($NRTaddForm,$locals))
+         argStuffCode := [[$setelt,'$,5,addargname],:argStuffCode]
+      [['stuffDomainSlots,'$],:argStuffCode,
+         :predBitVectorCode2,storeOperationCode]
+    [:outsideFunctionCode,storeOperationCode]
+
+  $CheckVectorList := NRTcheckVector domainShell
+--CODE: part 1
+  codePart1:= [:devaluateCode,:domainFormCode,createDomainCode,
+                createViewCode,setVector0Code, slot3Code,:slamCode] where
+    devaluateCode:= [['LET,b,['devaluate,a]] for [a,:b] in $devaluateList]
+    domainFormCode := [['LET,a,b] for [a,:b] in NREVERSE $NRTdomainFormList]
+      --$NRTdomainFormList is unused now
+    createDomainCode:=
+      ['LET,domname,['LIST,MKQ CAR $definition,:ASSOCRIGHT $devaluateList]]
+    createViewCode:= ['LET,'$,['GETREFV, 6+$NRTdeltaLength]]
+    setVector0Code:=[$setelt,'$,0,'dv_$]
+    slot3Code := ['QSETREFV,'$,3,['LET,'pv_$,predBitVectorCode1]]
+    slamCode:=
+      isCategoryPackageName opOf $definition => nil
+      [NRTaddToSlam($definition,'$)]
+
+--CODE: part 3
+  $ConstantAssignments :=
+      [NRTputInLocalReferences code for code in $ConstantAssignments]
+  codePart3:= [:constantCode1,
+                :constantCode2,:epilogue] where
+    constantCode1:=
+      name='Integer => $ConstantAssignments
+      nil
+                      -- The above line is needed to get the recursion
+                      -- Integer => FontTable => NonNegativeInteger  => Integer
+                      -- right.  Otherwise NNI has 'unset' for 0 and 1
+--  setVector4c:= setVector4part3($catNames,$catvecList)
+                      -- In particular, setVector4part3 and setVector5,
+                      -- which generate calls to local domain-instantiators,
+                      -- must come after operations are set in the vector.
+                      -- The symptoms of getting this wrong are that
+                      -- operations are not set which should be
+    constantCode2:= --matches previous test on Integer
+      name='Integer => nil
+      $ConstantAssignments
+    epilogue:= $epilogue
+  ans :=
+    ['PROGN,:optFunctorPROGN [:codePart1,:codePart2,:codePart3], '$]
+  $getDomainCode:= nil
+    --if we didn't kill this, DEFINE would insert it in the wrong place
+  ans:= minimalise ans
+  SAY ['"time taken in buildFunctor: ",TEMPUS_-FUGIT()-oldtime]
+  --sayBrightly '"------------------functor code: -------------------"
+  --pp ans
+  ans
+
+NRTcheckVector domainShell ==
+--RETURNS: an alist (((op,sig),:pred) ...) of missing functions
+  alist := nil
+  for i in 6..MAXINDEX domainShell repeat
+--Vector elements can be one of
+-- (a) T           -- item was marked
+-- (b) NIL         -- item is a domain; will be filled in by setVector4part3
+-- (c) categoryForm-- it was a domain view; now irrelevant
+-- (d) op-signature-- store missing function info in $CheckVectorList
+    v:= domainShell.i
+    v=true => nil  --item is marked; ignore
+    null v => nil  --a domain, which setVector4part3 will fill in
+    atom first v => nil  --category form; ignore
+    atom v => systemErrorHere '"CheckVector"
+    ASSOC(first v,alist) => nil
+    alist:=
+      [[first v,:$SetFunctions.i],:alist]
+  alist
+
+-- Obsolete once we have moved to JHD's world
+NRTvectorCopy(cacheName,domName,deltaLength) == GETREFV (6 + deltaLength)
+
+mkDomainCatName id == INTERN STRCONC(id,";CAT")
+
+NRTsetVector4(siglist,formlist,condlist) ==
+  $uncondList: local := nil
+  $condList: local := nil
+  $count: local := 0
+  for sig in reverse siglist for form in reverse formlist
+         for cond in reverse condlist repeat
+                  NRTsetVector4a(sig,form,cond)
+  --NRTsetVector4a(first siglist,first formlist,first condlist)
+
+  $lisplibCategoriesExtended:= [$uncondList,:$condList]
+  code := ['mapConsDB,MKQ REVERSE REMDUP $uncondList]
+  if $condList then
+    localVariable := GENSYM()
+    code := [['LET,localVariable,code]]
+    for [pred,list] in $condList repeat
+      code :=
+        [['COND,[pred,['LET,localVariable,
+          ['mergeAppend,['mapConsDB,MKQ list],localVariable]]]],
+            :code]
+    code := ['PROGN,:NREVERSE [['NREVERSE,localVariable],:code]]
+  g := GENSYM()
+  [$setelt,'$,4,['PROG2,['LET,g,code],
+    ['VECTOR,['catList2catPackageList,g],g]]]
+
+NRTsetVector4Part1(siglist,formlist,condlist) ==
+  $uncondList: local := nil
+  $condList: local := nil
+  $count: local := 0
+  for sig in reverse siglist for form in reverse formlist
+         for cond in reverse condlist repeat
+                  NRTsetVector4a(sig,form,cond)
+  reducedUncondlist := REMDUP $uncondList
+  reducedConlist :=
+    [[x,:y] for [x,z] in $condList| y := SETDIFFERENCE(z,reducedUncondlist)]
+  revCondlist := reverseCondlist reducedConlist
+  orCondlist := [[x,:MKPF(y,'OR)] for [x,:y] in revCondlist]
+  [reducedUncondlist,:orCondlist]
+  --NRTsetVector4a(first siglist,first formlist,first condlist)
+
+reverseCondlist cl ==
+  alist := nil
+  for [x,:y] in cl repeat
+    for z in y repeat
+      u := ASSOC(z,alist)
+      null u => alist := [[z,x],:alist]
+      member(x,CDR u) => nil
+      RPLACD(u,[x,:CDR u])
+  alist
+
+NRTsetVector4Part2(uncondList,condList) ==
+  $lisplibCategoriesExtended:= [uncondList,:condList]
+  code := ['mapConsDB,MKQ REVERSE REMDUP uncondList]
+  if condList then
+    localVariable := GENSYM()
+    code := [['LET,localVariable,code]]
+    for [pred,list] in condList repeat
+      code :=
+        [['COND,[predicateBitRef SUBLIS($pairlis,pred),['LET,localVariable,
+          ['mergeAppend,['mapConsDB,MKQ list],localVariable]]]],
+            :code]
+    code := ['PROGN,:NREVERSE [['NREVERSE,localVariable],:code]]
+  g := GENSYM()
+  [$setelt,'$,4,['PROG2,['LET,g,code],
+    ['VECTOR,['catList2catPackageList,g],g]]]
+
+mergeAppend(l1,l2) ==
+  ATOM l1 => l2
+  member(QCAR l1,l2) => mergeAppend(QCDR l1, l2)
+  CONS(QCAR l1, mergeAppend(QCDR l1, l2))
+
+--genLoadTimeValue u ==
+--  name :=
+--    INTERN STRCONC(PNAME first $definition,'";",STRINGIZE($count:=$count+1))
+--  $NRTloadTimeAlist := [[name,:['addConsDB,MKQ u]],:$NRTloadTimeAlist]
+--  --see compDefineFunctor1
+--  name
+
+catList2catPackageList u ==
+--converts ((Set) (Module R) ...) to ((Set& $) (Module& $ R)...)
+  [fn x for x in u] where
+    fn [op,:argl] ==
+      newOp := INTERN(STRCONC(PNAME op,"&"))
+      addConsDB [newOp,"$",:argl]
+
+NRTsetVector4a(sig,form,cond) ==
+  sig = '$ =>
+     domainList :=
+       [optimize COPY KAR comp(d,$EmptyMode,$e) or d for d in $domainShell.4.0]
+     $uncondList := APPEND(domainList,$uncondList)
+     if isCategoryForm(form,$e) then $uncondList := [form,:$uncondList]
+     $uncondList
+  evalform := eval mkEvalableCategoryForm form
+  cond = true => $uncondList := [form,:APPEND(evalform.4.0,$uncondList)]
+  $condList := [[cond,[form,:evalform.4.0]],:$condList]
+
+NRTmakeSlot1 domainShell ==
+  opDirectName := INTERN STRCONC(PNAME first $definition,'";opDirect")
+  fun :=
+    $NRTmakeCompactDirect => '(function lookupInCompactTable)
+    '(function lookupInTable)
+  [($QuickCode=>'QSETREFV;'SETELT), '$,1, ['LIST,fun,'$,opDirectName]]
+
+NRTmakeSlot1Info() ==
+-- 4 cases:
+-- a:T == b add c  --- slot1 directory has #s for entries defined in c
+-- a:T == b        --- slot1 has all slot #s = NIL (see compFunctorBody)
+-- a == b add c    --- not allowed (line 7 of getTargetFromRhs)
+-- a == b          --- $NRTderivedTargetIfTrue = true; set directory to NIL
+  pairlis :=
+    $insideCategoryPackageIfTrue = true =>
+      [:argl,dollarName] := rest $form
+      [[dollarName,:'_$],:mkSlot1sublis argl]
+    mkSlot1sublis rest $form
+  $lisplibOpAlist := transformOperationAlist SUBLIS(pairlis,$domainShell.1)
+  opList :=
+    $NRTderivedTargetIfTrue => 'derived
+    $insideCategoryPackageIfTrue = true => slot1Filter $lisplibOpAlist
+    $lisplibOpAlist
+  addList := SUBLIS(pairlis,$NRTaddForm)
+  [first $form,[addList,:opList]]
+
+mkSlot1sublis argl ==
+  [[a,:b] for a in argl for b in $FormalMapVariableList]
+
+slot1Filter opList ==
+--include only those ops which are defined within the capsule
+  [u for x in opList | u := fn x] where
+    fn [op,:l] ==
+      u := [entry for entry in l | INTEGERP CADR entry] => [op,:u]
+      nil
+
+NRToptimizeHas u ==
+--u is a list ((pred cond)...) -- see optFunctorBody
+--produces an alist: (((HasCategory a b) . GENSYM)...)
+  u is [a,:b] =>
+    a='HasCategory => LASSOC(u,$hasCategoryAlist) or
+      $hasCategoryAlist := [[u,:(y:=GENSYM())],:$hasCategoryAlist]
+      y
+    a='has => NRToptimizeHas ['HasCategory,first b,MKQ first rest b]
+    a = 'QUOTE => u
+    [NRToptimizeHas a,:NRToptimizeHas b]
+  u
+
+NRTaddToSlam([name,:argnames],shell) ==
+  $mutableDomain => return nil
+  null argnames => addToConstructorCache(name,nil,shell)
+  args:= ['LIST,:ASSOCRIGHT $devaluateList]
+  addToConstructorCache(name,args,shell)
+
+--------------------> NEW DEFINITION (override in xruncomp.boot.pamphlet)
+changeDirectoryInSlot1() ==  --called by NRTbuildFunctor
+  --3 cases:
+  --  if called inside NRTbuildFunctor, $NRTdeltaLength gives different locs
+  --  otherwise called from compFunctorBody (all lookups are forwarded):
+  --    $NRTdeltaList = nil  ===> all slot numbers become nil
+  $lisplibOperationAlist := [sigloc entry for entry in $domainShell.1] where
+    sigloc [opsig,pred,fnsel] ==
+        if pred ^= 'T then
+          pred := simpBool pred
+          $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+        fnsel is [op,a,:.] and (op = 'ELT or op = 'CONST) =>
+          [opsig,pred,[op,a,vectorLocation(first opsig,CADR opsig)]]
+        [opsig,pred,fnsel]
+  sortedOplist := listSort(function GLESSEQP,
+                           COPY_-LIST $lisplibOperationAlist,function CADR)
+  $lastPred :local := nil
+  $newEnv :local := $e
+  $domainShell.1 := [fn entry for entry in sortedOplist] where
+    fn [[op,sig],pred,fnsel] ==
+       if $lastPred ^= pred then
+            $newEnv := deepChaseInferences(pred,$e)
+            $lastPred := pred
+       newfnsel :=
+         fnsel is ['Subsumed,op1,sig1] =>
+           ['Subsumed,op1,genSlotSig(sig1,'T,$newEnv)]
+         fnsel
+       [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel]
+
+genSlotSig(sig,pred,$e) ==
+   [genDeltaSig t for t in sig]
+
+deepChaseInferences(pred,$e) ==
+    pred is ['AND,:preds] or pred is ['and,:preds] =>
+        for p in preds repeat $e := deepChaseInferences(p,$e)
+        $e
+    pred is ['OR,pred1,:.] or pred is ['or,pred1,:.] =>
+        deepChaseInferences(pred1,$e)
+    pred is 'T or pred is ['NOT,:.] or pred is ['not,:.] => $e
+    chaseInferences(pred,$e)
+
+vectorLocation(op,sig) ==
+  u := or/[i for i in 1.. for u in $NRTdeltaList
+        | u is [=op,[='$,: xsig],:.] and sig=NRTsubstDelta(xsig) ]
+  u => $NRTdeltaLength - u + 6
+  nil    -- this signals that calls should be forwarded
+
+NRTsubstDelta(initSig) ==
+  sig := [replaceSlotTypes s for s in initSig] where
+     replaceSlotTypes(t) ==
+        atom t =>
+          not INTEGERP t => t
+          t = 0 => '$
+          t = 2 => '_$_$
+          t = 5 => $NRTaddForm
+          u:= $NRTdeltaList.($NRTdeltaLength+5-t)
+          CAR u = 'domain => CADR u
+          error "bad $NRTdeltaList entry"
+        MEMQ(CAR t,'(Mapping Union Record _:)) =>
+           [CAR t,:[replaceSlotTypes(x) for x in rest t]]
+        t
+-----------------------------SLOT1 DATABASE------------------------------------
+
+updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info)
+
+NRTputInLocalReferences bod ==
+  $elt: local := ($QuickCode => 'QREFELT; 'ELT)
+  NRTputInHead bod
+
+NRTputInHead bod ==
+  atom bod => bod
+--  LASSOC(bod,$devaluateList) => nil
+--  k:= NRTassocIndex bod => [$elt,'_$,k]
+--  systemError '"unexpected position of domain reference"
+--  bod
+--bod is ['LET,var,val,:extra] and IDENTP var =>
+--  NRTputInTail extra
+--  k:= NRTassocIndex var => RPLAC(CADDR bod,[$elt,'$,k])
+--  NRTputInHead val
+--  bod
+  bod is ['SPADCALL,:args,fn] =>
+    NRTputInTail rest bod --NOTE: args = COPY of rest bod
+    -- The following test allows function-returning expressions
+    fn is [elt,dom,ind] and not (dom='$) and MEMQ(elt,'(ELT QREFELT CONST)) =>
+      k:= NRTassocIndex dom => RPLACA(LASTNODE bod,[$elt,'_$,k])
+--    sayBrightlyNT '"unexpected SPADCALL:"
+--    pp fn
+--    nil
+--    keyedSystemError("S2GE0016",['"NRTputInHead",
+--       '"unexpected SPADCALL form"])
+      nil
+    NRTputInHead fn
+    bod
+  bod is ["COND",:clauses] =>
+    for cc in clauses repeat NRTputInTail cc
+    bod
+  bod is ["QUOTE",:.] => bod
+  bod is ["CLOSEDFN",:.] => bod
+  bod is ["SPADCONST",dom,ind] =>
+    RPLACA(bod,$elt)
+    dom = '_$ => nil
+    k:= NRTassocIndex dom =>
+      RPLACA(LASTNODE bod,[$elt,'_$,k])
+      bod
+    keyedSystemError("S2GE0016",['"NRTputInHead",
+       '"unexpected SPADCONST form"])
+  NRTputInHead first bod
+  NRTputInTail rest bod
+  bod
+
+NRTputInTail x ==
+  for y in tails x repeat
+    atom (u := first y) =>
+      EQ(u,'$) or LASSOC(u,$devaluateList) => nil
+      k:= NRTassocIndex u =>
+        atom u => RPLACA(y,[$elt,'_$,k])
+        -- u atomic means that the slot will always contain a vector
+        RPLACA(y,['SPADCHECKELT,'_$,k])
+      --this reference must check that slot is a vector
+      nil
+    NRTputInHead u
+  x
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nrunfast.boot.pamphlet b/src/interp/nrunfast.boot.pamphlet
new file mode 100644
index 00000000..e6a29b12
--- /dev/null
+++ b/src/interp/nrunfast.boot.pamphlet
@@ -0,0 +1,692 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nrunfast.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--=======================================================================
+--                     Basic Functions
+--=======================================================================
+initNewWorld() ==
+  $NRTflag := true
+  $NRTvec := true
+  $NRTmakeCompactDirect := true
+  $NRTquick := true
+  $NRTmakeShortDirect := true
+  $newWorld := true
+  $monitorNewWorld := false
+  $consistencyCheck := false
+  $spadLibFT := 'NRLIB
+  $NRTmonitorIfTrue := false
+  $updateCatTableIfTrue := false
+  $doNotCompressHashTableIfTrue := true
+ 
+isNewWorldDomain domain == INTEGERP domain.3    --see HasCategory/Attribute
+ 
+getDomainByteVector dom == CDDR dom.4
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+getOpCode(op,vec,max) ==
+--search Op vector for "op" returning code if found, nil otherwise
+  res := nil
+  for i in 0..max by 2 repeat
+    EQ(QVELT(vec,i),op) => return (res := QSADD1 i)
+  res
+ 
+--=======================================================
+--                 Lookup From Compiled Code
+--=======================================================
+newGoGet(:l) ==
+  [:arglist,env] := l
+  slot := replaceGoGetSlot env
+  APPLY(first slot,[:arglist,rest slot])  --SPADCALL it!
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+replaceGoGetSlot env ==
+  [thisDomain,index,:op] := env
+  thisDomainForm := devaluate thisDomain
+  bytevec := getDomainByteVector thisDomain
+  numOfArgs := bytevec.index
+  goGetDomainSlotIndex := bytevec.(index := QSADD1 index)
+  goGetDomain :=
+     goGetDomainSlotIndex = 0 => thisDomain
+     thisDomain.goGetDomainSlotIndex
+  if PAIRP goGetDomain then
+     goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex)
+  sig :=
+    [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain)
+      for i in 0..numOfArgs]
+  thisSlot := bytevec.(QSADD1 index)
+  if $monitorNewWorld then
+    sayLooking(concat('"%l","..",form2String thisDomainForm,
+      '" wants",'"%l",'"  "),op,sig,goGetDomain)
+  slot :=  .basicLookup(op,sig,goGetDomain,goGetDomain)
+  slot = nil =>
+    $returnNowhereFromGoGet = true =>
+      ['nowhere,:goGetDomain]  --see newGetDomainOpTable
+    sayBrightly concat('"Function: ",formatOpSignature(op,sig),
+      '" is missing from domain: ",form2String goGetDomain.0)
+    keyedSystemError("S2NR0001",[op,sig,goGetDomain.0])
+  if $monitorNewWorld then
+    sayLooking1(['"goget stuffing slot",:bright thisSlot,'"of "],thisDomain)
+  SETELT(thisDomain,thisSlot,slot)
+  if $monitorNewWorld then
+    sayLooking1('"<------",[CAR slot,:devaluate CDR slot])
+  slot
+ 
+--=======================================================
+--       Lookup Function in Slot 1 (via SPADCALL)
+--=======================================================
+lookupFF(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,nil)
+ 
+lookupUF(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,true)
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lookupComplete(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,nil)
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lookupIncomplete(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,true)
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lookupInCompactTable(op,sig,dollar,env) ==
+  newLookupInTable(op,sig,dollar,env,true)
+ 
+newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
+  dollar = nil => systemError()
+  $lookupDefaults = true =>
+    newLookupInCategories(op,sig,domain,dollar)      --lookup first in my cats
+      or newLookupInAddChain(op,sig,domain,dollar)
+  --fast path when called from newGoGet
+  success := false
+  if $monitorNewWorld then
+    sayLooking(concat('"---->",form2String devaluate domain,
+      '"----> searching op table for:","%l","  "),op,sig,dollar)
+  someMatch := false
+  numvec := getDomainByteVector domain
+  predvec := domain.3
+  max := MAXINDEX opvec
+  k := getOpCode(op,opvec,max) or return
+    flag => newLookupInAddChain(op,sig,domain,dollar)
+    nil
+  maxIndex := MAXINDEX numvec
+  start := ELT(opvec,k)
+  finish :=
+    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    maxIndex
+  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
+  numArgs := QSDIFFERENCE(#sig,1)
+  success := nil
+  $isDefaultingPackage: local :=
+    -- use special defaulting handler when dollar non-trivial
+    dollar ^= domain and isDefaultPackageForm? devaluate domain
+  while finish > start repeat
+    PROGN
+      i := start
+      numArgs ^= (numTableArgs :=numvec.i) => nil
+      predIndex := numvec.(i := QSADD1 i)
+      NE(predIndex,0) and null testBitVector(predvec,predIndex) => nil
+      loc := newCompareSig(sig,numvec,(i := QSADD1 i),dollar,domain)
+      null loc => nil  --signifies no match
+      loc = 1 => (someMatch := true)
+      loc = 0 =>
+        start := QSPLUS(start,QSPLUS(numTableArgs,4))
+        i := start + 2
+        someMatch := true --mark so that if subsumption fails, look for original
+        subsumptionSig :=
+          [newExpandTypeSlot(numvec.(QSPLUS(i,j)),
+            dollar,domain) for j in 0..numTableArgs]
+        if $monitorNewWorld then
+          sayBrightly [formatOpSignature(op,sig),'"--?-->",
+            formatOpSignature(op,subsumptionSig)]
+        nil
+      slot := domain.loc
+      null atom slot =>
+        EQ(QCAR slot,'newGoGet) => someMatch:=true
+                   --treat as if operation were not there
+        --if EQ(QCAR slot,'newGoGet) then
+        --  UNWIND_-PROTECT --break infinite recursion
+        --    ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot QCDR slot),
+        --      if domain.loc = 'skip then domain.loc := slot)
+        return (success := slot)
+      slot = 'skip =>       --recursive call from above 'replaceGoGetSlot
+        return (success := newLookupInAddChain(op,sig,domain,dollar))
+      systemError '"unexpected format"
+    start := QSPLUS(start,QSPLUS(numTableArgs,4))
+  NE(success,'failed) and success =>
+    if $monitorNewWorld then
+      sayLooking1('"<----",uu) where uu ==
+        PAIRP success => [first success,:devaluate rest success]
+        success
+    success
+  subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u
+  flag or someMatch => newLookupInAddChain(op,sig,domain,dollar)
+  nil
+ 
+ 
+isDefaultPackageForm? x == x is [op,:.]
+  and IDENTP op and (s := PNAME op).(MAXINDEX s) = "&"
+ 
+ 
+--=======================================================
+--       Lookup Addlist (from lookupInDomainTable or lookupInDomain)
+--=======================================================
+newLookupInAddChain(op,sig,addFormDomain,dollar) ==
+  if $monitorNewWorld then sayLooking1('"looking up add-chain: ",addFormDomain)
+  addFunction:=newLookupInDomain(op,sig,addFormDomain,dollar,5)
+  addFunction =>
+    if $monitorNewWorld then
+      sayLooking1(concat('"<----add-chain function found for ",
+        form2String devaluate addFormDomain,'"<----"),CDR addFunction)
+    addFunction
+  nil
+ 
+--=======================================================
+--   Lookup In Domain (from lookupInAddChain)
+--=======================================================
+newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
+  addFormCell := addFormDomain.index =>
+    INTEGERP KAR addFormCell =>
+      or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
+    if null VECP addFormCell then lazyDomainSet(addFormCell,addFormDomain,index)
+    lookupInDomainVector(op,sig,addFormDomain.index,dollar)
+  nil
+ 
+--=======================================================
+--       Category Default Lookup (from goGet or lookupInAddChain)
+--=======================================================
+newLookupInCategories(op,sig,dom,dollar) ==
+  slot4 := dom.4
+  catVec := CADR slot4
+  SIZE catVec = 0 => nil                      --early exit if no categories
+  INTEGERP KDR catVec.0 =>
+    newLookupInCategories1(op,sig,dom,dollar) --old style
+  $lookupDefaults : local := nil
+  if $monitorNewWorld = true then sayBrightly concat('"----->",
+    form2String devaluate dom,'"-----> searching default packages for ",op)
+  predvec := dom.3
+  packageVec := QCAR slot4
+--the next three lines can go away with new category world
+  varList := ['$,:$FormalMapVariableList]
+  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+  valueList := [MKQ val for val in valueList]
+  nsig := MSUBST(dom.0,dollar.0,sig)
+  for i in 0..MAXINDEX packageVec |
+       (entry := packageVec.i) and entry ^= 'T repeat
+    package :=
+      VECP entry =>
+         if $monitorNewWorld then
+           sayLooking1('"already instantiated cat package",entry)
+         entry
+      IDENTP entry =>
+        cat := catVec.i
+        packageForm := nil
+        if not GETL(entry,'LOADED) then loadLib entry
+        infovec := GETL(entry,'infovec)
+        success :=
+          --VECP infovec =>  ----new world
+          true =>  ----new world
+            opvec := infovec.1
+            max := MAXINDEX opvec
+            code := getOpCode(op,opvec,max)
+            null code => nil
+            byteVector := CDDDR infovec.3
+            endPos :=
+              code+2 > max => SIZE byteVector
+              opvec.(code+2)
+            not nrunNumArgCheck(#(QCDR sig),byteVector,opvec.code,endPos) => nil
+            --numOfArgs := byteVector.(opvec.code)
+            --numOfArgs ^= #(QCDR sig) => nil
+            packageForm := [entry,'$,:CDR cat]
+            package := evalSlotDomain(packageForm,dom)
+            packageVec.i := package
+            package
+                           ----old world
+          table := HGET($Slot1DataBase,entry) or systemError nil
+          (u := LASSQ(op,table))
+            and (v := or/[rest x for x in u | #sig = #x.0]) =>
+              packageForm := [entry,'$,:CDR cat]
+              package := evalSlotDomain(packageForm,dom)
+              packageVec.i := package
+              package
+          nil
+        null success =>
+          if $monitorNewWorld = true then
+            sayBrightlyNT '"  not in: "
+            pp (packageForm and devaluate package or entry)
+          nil
+        if $monitorNewWorld then
+          sayLooking1('"candidate default package instantiated: ",success)
+        success
+      entry
+    null package => nil
+    if $monitorNewWorld then
+      sayLooking1('"Looking at instantiated package ",package)
+    res := basicLookup(op,sig,package,dollar) =>
+      if $monitorNewWorld = true then
+        sayBrightly '"candidate default package succeeds"
+      return res
+    if $monitorNewWorld = true then
+      sayBrightly '"candidate fails -- continuing to search categories"
+    nil
+ 
+nrunNumArgCheck(num,bytevec,start,finish) ==
+   args := bytevec.start
+   num = args => true
+   (start := start + args + 4) = finish => nil
+   nrunNumArgCheck(num,bytevec,start,finish)
+ 
+newLookupInCategories1(op,sig,dom,dollar) ==
+  $lookupDefaults : local := nil
+  if $monitorNewWorld = true then sayBrightly concat('"----->",
+    form2String devaluate dom,'"-----> searching default packages for ",op)
+  predvec := dom.3
+  slot4 := dom.4
+  packageVec := CAR slot4
+  catVec := CAR QCDR slot4
+--the next three lines can go away with new category world
+  varList := ['$,:$FormalMapVariableList]
+  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+  valueList := [MKQ val for val in valueList]
+  nsig := MSUBST(dom.0,dollar.0,sig)
+  for i in 0..MAXINDEX packageVec | (entry := ELT(packageVec,i))
+      and (VECP entry or (predIndex := CDR (node := ELT(catVec,i))) and
+          (EQ(predIndex,0) or testBitVector(predvec,predIndex))) repeat
+    package :=
+      VECP entry =>
+         if $monitorNewWorld then
+           sayLooking1('"already instantiated cat package",entry)
+         entry
+      IDENTP entry =>
+        cat := QCAR node
+        packageForm := nil
+        if not GETL(entry,'LOADED) then loadLib entry
+        infovec := GETL(entry,'infovec)
+        success :=
+          VECP infovec =>
+            opvec := infovec.1
+            max := MAXINDEX opvec
+            code := getOpCode(op,opvec,max)
+            null code => nil
+            byteVector := CDDR infovec.3
+            numOfArgs := byteVector.(opvec.code)
+            numOfArgs ^= #(QCDR sig) => nil
+            packageForm := [entry,'$,:CDR cat]
+            package := evalSlotDomain(packageForm,dom)
+            packageVec.i := package
+            package
+          table := HGET($Slot1DataBase,entry) or systemError nil
+          (u := LASSQ(op,table))
+            and (v := or/[rest x for x in u | #sig = #x.0]) =>
+              packageForm := [entry,'$,:CDR cat]
+              package := evalSlotDomain(packageForm,dom)
+              packageVec.i := package
+              package
+          nil
+        null success =>
+          if $monitorNewWorld = true then
+            sayBrightlyNT '"  not in: "
+            pp (packageForm and devaluate package or entry)
+          nil
+        if $monitorNewWorld then
+          sayLooking1('"candidate default package instantiated: ",success)
+        success
+      entry
+    null package => nil
+    if $monitorNewWorld then
+      sayLooking1('"Looking at instantiated package ",package)
+    res := lookupInDomainVector(op,sig,package,dollar) =>
+      if $monitorNewWorld = true then
+        sayBrightly '"candidate default package succeeds"
+      return res
+    if $monitorNewWorld = true then
+      sayBrightly '"candidate fails -- continuing to search categories"
+    nil
+ 
+--=======================================================
+--     Instantiate Default Package if Signature Matches
+--=======================================================
+ 
+getNewDefaultPackage(op,sig,infovec,dom,dollar) ==
+  hohohoho()
+  opvec := infovec . 1
+  numvec := CDDR infovec . 3
+  max := MAXINDEX opvec
+  k := getOpCode(op,opvec,max) or return nil
+  maxIndex := MAXINDEX numvec
+  start := ELT(opvec,k)
+  finish :=
+    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    maxIndex
+  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
+  numArgs := QSDIFFERENCE(#sig,1)
+  success := nil
+  while finish > start repeat
+    PROGN
+      i := start
+      numArgs ^= (numTableArgs :=numvec.i) => nil
+      newCompareSigCheaply(sig,numvec,(i := QSPLUS(i,2))) =>
+        return (success := true)
+    start := QSPLUS(start,QSPLUS(numTableArgs,4))
+  null success => nil
+  defaultPackage := cacheCategoryPackage(packageVec,catVec,i)
+ 
+--=======================================================
+--         Compare Signature to One Derived from Table
+--=======================================================
+newCompareSig(sig, numvec, index, dollar, domain) ==
+  k := index
+  null (target := first sig)
+   or lazyMatchArg(target,numvec.k,dollar,domain) =>
+     and/[lazyMatchArg(s,numvec.(k := i),dollar,domain)
+              for s in rest sig for i in (index+1)..] => numvec.(QSINC1 k)
+     nil
+  nil
+ 
+--=======================================================
+--     Compare Signature to One Derived from Table
+--=======================================================
+lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
+  if s = '$ then
+--  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
+    s := devaluate dollar -- calls from HasCategory can have $s
+  INTEGERP a =>
+    not typeFlag => s = domain.a
+    a = 6 and $isDefaultingPackage => s = devaluate dollar
+    VECP (d := domainVal(dollar,domain,a)) =>
+      s = d.0 => true
+      domainArg := ($isDefaultingPackage => domain.6.0; domain.0)
+      KAR s = QCAR d.0 and lazyMatchArgDollarCheck(s,d.0,dollar.0,domainArg)
+    --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain)      --old style (erase)
+    lazyMatch(s,d,dollar,domain)                         --new style
+  a = '$ => s = devaluate dollar
+  STRINGP a =>
+    s is ['QUOTE,y] and PNAME y = a
+    IDENTP s and PNAME s = a
+  atom a =>  a = s
+  op := opOf a
+  op  = 'NRTEVAL => s = nrtEval(CADR a,domain)
+  op = 'QUOTE => s = CADR a
+  lazyMatch(s,a,dollar,domain)
+  --above line is temporarily necessary until system is compiled 8/15/90
+--s = a
+ 
+lazyMatch(source,lazyt,dollar,domain) ==
+  lazyt is [op,:argl] and null atom source and op=CAR source
+    and #(sargl := CDR source) = #argl =>
+      MEMQ(op,'(Record Union)) and first argl is [":",:.] =>
+        and/[stag = atag and lazyMatchArg(s,a,dollar,domain)
+              for [.,stag,s] in sargl for [.,atag,a] in argl]
+      MEMQ(op,'(Union Mapping QUOTE)) =>
+         and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
+      coSig := GETDATABASE(op,'COSIG)
+      NULL coSig => error ["bad Constructor op", op]
+      and/[lazyMatchArg2(s,a,dollar,domain,flag)
+           for s in sargl for a in argl for flag in rest coSig]
+  STRINGP source and lazyt is ['QUOTE,=source] => true
+  NUMBERP source =>
+      lazyt is ['_#, slotNum] => source = #(domain.slotNum)
+      lazyt is ['call,'LENGTH, slotNum] => source = #(domain.slotNum)
+      nil
+  source is ['construct,:l] => l = lazyt
+  -- A hideous hack on the same lines as the previous four lines JHD/MCD
+  nil
+
+ 
+lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
+  #s ^= #d => nil
+  scoSig := GETDATABASE(opOf s,'COSIG) or return nil
+  if MEMQ(opOf s, '(Union Mapping Record)) then 
+     scoSig := [true for x in s]
+  and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where
+   fn ==
+    x = arg => true
+    x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg)
+    x = '$ and (arg = dollarName or arg = domainName) => true
+    x = dollarName and arg = domainName => true
+    ATOM x or ATOM arg => false
+    xt and CAR x = CAR arg =>
+      lazyMatchArgDollarCheck(x,arg,dollarName,domainName)
+    false
+
+lookupInDomainByName(op,domain,arg) ==
+  atom arg => nil
+  opvec := domain . 1 . 2
+  numvec := getDomainByteVector domain
+  predvec := domain.3
+  max := MAXINDEX opvec
+  k := getOpCode(op,opvec,max) or return nil
+  maxIndex := MAXINDEX numvec
+  start := ELT(opvec,k)
+  finish :=
+    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    maxIndex
+  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
+  success := false
+  while finish > start repeat
+    i := start
+    numberOfArgs :=numvec.i
+    predIndex := numvec.(i := QSADD1 i)
+    NE(predIndex,0) and null testBitVector(predvec,predIndex) => nil
+    slotIndex := numvec.(i + 2 + numberOfArgs)
+    newStart := QSPLUS(start,QSPLUS(numberOfArgs,4))
+    slot := domain.slotIndex
+    null atom slot and EQ(CAR slot,CAR arg) and EQ(CDR slot,CDR arg) => return (success := true)
+    start := QSPLUS(start,QSPLUS(numberOfArgs,4))
+  success
+ 
+--=======================================================
+--        Expand Signature from Encoded Slot Form
+--=======================================================
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+newExpandGoGetTypeSlot(slot,dollar,domain) ==
+  newExpandTypeSlot(slot,domain,domain)
+ 
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+newExpandTypeSlot(slot, dollar, domain) ==
+--> returns domain form for dollar.slot
+   newExpandLocalType(domainVal(dollar, domain, slot), dollar,domain)
+ 
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+newExpandLocalType(lazyt,dollar,domain) ==
+  VECP lazyt => lazyt.0
+  lazyt is [vec,.,:lazyForm] and VECP vec =>              --old style
+    newExpandLocalTypeForm(lazyForm,dollar,domain)
+  newExpandLocalTypeForm(lazyt,dollar,domain)             --new style
+ 
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
+  MEMQ(functorName, '(Record Union)) and first argl is [":",:.] =>
+    [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)]
+                                 for [.,tag,dom] in argl]]
+  MEMQ(functorName, '(Union Mapping)) =>
+	  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
+  functorName = 'QUOTE => [functorName,:argl]
+  coSig := GETDATABASE(functorName,'COSIG)
+  NULL coSig => error ["bad functorName", functorName]
+  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
+        for a in argl for flag in rest coSig]]
+ 
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
+  u = '$ => dollar.0      -------eliminate this as $ is rep by 0
+  INTEGERP u =>
+     typeFlag => newExpandTypeSlot(u, dollar,domain)
+     domain.u
+  u is ['NRTEVAL,y] => nrtEval(y,domain)
+  u is ['QUOTE,y] => y
+  atom u => u   --can be first, rest, etc.
+  newExpandLocalTypeForm(u,dollar,domain)
+ 
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+nrtEval(expr,dom) ==
+  $:fluid := dom
+  eval expr
+ 
+domainVal(dollar,domain,index) ==
+--returns a domain or a lazy slot
+  index = 0 => dollar
+  index = 2 => domain
+  domain.index
+ 
+ 
+--=======================================================
+--          Convert Lazy Domain to Domain Form
+--=======================================================
+ 
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lazyDomainSet(lazyForm,thisDomain,slot) ==
+  form :=
+    lazyForm is [vec,.,:u] and VECP vec => u        --old style
+    lazyForm                                        --new style
+  slotDomain := evalSlotDomain(form,thisDomain)
+  if $monitorNewWorld then
+    sayLooking1(concat(form2String devaluate thisDomain,
+      '" activating lazy slot ",slot,'": "),slotDomain)
+  name := CAR form
+  SETELT(thisDomain,slot,slotDomain)
+ 
+--=======================================================
+--                   HasCategory/Attribute
+--=======================================================
+-- PLEASE NOTE: This function has the rather charming side-effect that
+-- e.g. it works if domform is an Aldor Category.  This is being used
+-- by extendscategoryForm in c-util to allow Aldor domains to be used
+-- in spad code.  Please do not break this!  An example is the use of
+-- Interval (an Aldor domain) by SIGNEF in limitps.spad.  MCD.
+newHasTest(domform,catOrAtt) ==
+  domform is [dom,:.] and dom in '(Union Record Mapping Enumeration) =>
+    ofCategory(domform, catOrAtt)
+  catOrAtt = '(Type) => true
+  GETDATABASE(opOf domform, 'ASHARP?) => fn(domform,catOrAtt) where
+  -- atom (infovec := getInfovec opOf domform) => fn(domform,catOrAtt) where
+    fn(a,b) ==
+      categoryForm?(a) => assoc(b, ancestorsOf(a, nil))
+      isPartialMode a => throwKeyedMsg("S2IS0025",NIL)
+      b is ["SIGNATURE",:opSig] =>
+        HasSignature(evalDomain a,opSig)
+      b is ["ATTRIBUTE",attr] => HasAttribute(evalDomain a,attr)
+      hasCaty(a,b,NIL) ^= 'failed
+      HasCategory(evalDomain a,b) => true -- for asharp domains: must return Boolean
+  op := opOf catOrAtt
+  isAtom := atom catOrAtt
+  null isAtom and op = 'Join =>
+    and/[newHasTest(domform,x) for x in rest catOrAtt]
+-- we will refuse to say yes for 'Cat has Cat'
+--GETDATABASE(opOf domform,'CONSTRUCTORKIND) = 'category => throwKeyedMsg("S2IS0025",NIL)
+-- on second thoughts we won't!
+  GETDATABASE(opOf domform,'CONSTRUCTORKIND) = 'category =>
+      domform = catOrAtt => 'T
+      for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,GETDATABASE(opOf domform,'ATTRIBUTES))] |  aCat = catOrAtt  repeat
+         return evalCond cond where
+           evalCond x ==
+	     ATOM x => x
+             [pred,:l] := x
+             pred = 'has => 
+                  l is [ w1,['ATTRIBUTE,w2]] => newHasTest(w1,w2) 
+                  l is [ w1,['SIGNATURE,:w2]] => compiledLookup(CAR w2,CADR w2, eval mkEvalable w1)
+                  newHasTest(first  l ,first rest l) 
+             pred = 'OR => or/[evalCond i for i in l]
+             pred = 'AND => and/[evalCond i for i in l]
+             x  
+  null isAtom and constructor? op  =>
+    domain := eval mkEvalable domform
+    newHasCategory(domain,catOrAtt)
+  newHasAttribute(eval mkEvalable domform,catOrAtt)
+ 
+lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
+  n : FIXNUM := MAXINDEX catvec
+  xop := CAR x
+  or/[ELT(auxvec,i) for i in 0..n |
+    xop = CAR (lazyt := QVELT(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
+ 
+lazyMatchAssocV1(x,vec,domain) ==               --old style slot4
+  n : FIXNUM := MAXINDEX vec
+  xop := CAR x
+  or/[QCDR QVELT(vec,i) for i in 0..n |
+    xop = CAR (lazyt := CAR QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
+ 
+--newHasAttribute(domain,attrib) ==
+--  predIndex := LASSOC(attrib,domain.2) =>
+--    EQ(predIndex,0) => true
+--    predvec := domain.3
+--    testBitVector(predvec,predIndex)
+--  false
+ 
+--=======================================================
+--                   Utility Functions
+--=======================================================
+ 
+sayLooking(prefix,op,sig,dom) ==
+  $monitorNewWorld := false
+  dollar := devaluate dom
+  atom dollar or VECP dollar or or/[VECP x for x in dollar] => systemError nil
+  sayBrightly
+    concat(prefix,formatOpSignature(op,sig),bright '"from ",form2String dollar)
+  $monitorNewWorld := true
+ 
+sayLooking1(prefix,dom) ==
+  $monitorNewWorld := false
+  dollar :=
+    VECP dom => devaluate dom
+    devaluateList dom
+  sayBrightly concat(prefix,form2String dollar)
+  $monitorNewWorld := true
+ 
+cc() == -- don't remove this function
+  clearConstructorCaches()
+  clearClams()
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nrungo.boot.pamphlet b/src/interp/nrungo.boot.pamphlet
new file mode 100644
index 00000000..72a8e153
--- /dev/null
+++ b/src/interp/nrungo.boot.pamphlet
@@ -0,0 +1,417 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nrungo.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--=======================================================
+--             Lookup From Interpreter
+--=======================================================
+
+NRTevalDomain form ==
+  form is ['SETELT,:.] => eval form
+  evalDomain form
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+compiledLookup(op,sig,dollar) ==
+--called by coerceByFunction, evalForm, findEqualFun, findUniqueOpInDomain,
+--  getFunctionFromDomain, optDeltaEntry, retractByFunction
+  if not VECP dollar then dollar := NRTevalDomain dollar
+  basicLookup(op,sig,dollar,dollar)
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+basicLookup(op,sig,domain,dollar) ==
+  domain.1 is ['lookupInDomain,:.] => lookupInDomainVector(op,sig,domain,dollar)
+  ----------new world code follows------------
+  $lookupDefaults : local := nil -- new world
+  u := lookupInDomainVector(op,sig,domain,dollar) => u
+  $lookupDefaults := true
+  lookupInDomainVector(op,sig,domain,dollar)
+
+compiledLookupCheck(op,sig,dollar) ==
+  fn := compiledLookup(op,sig,dollar)
+
+  -- NEW COMPILER COMPATIBILITY ON
+
+  if      (fn = nil)  and (op = "^") then
+    fn := compiledLookup("**",sig,dollar)
+  else if (fn = nil)  and (op = "**") then
+    fn := compiledLookup("^",sig,dollar)
+
+  -- NEW COMPILER COMPATIBILITY OFF
+
+  fn = nil =>
+    keyedSystemError("S2NR0001",[op,formatSignature sig,dollar.0])
+  fn
+
+--=======================================================
+--                 Lookup From Compiled Code
+--=======================================================
+goGet(:l) ==
+  [:arglist,env] := l
+  arglist is ['goGet,:.] => stop()
+  [[.,[op,initSig,:code]],thisDomain] := env
+  domainSlot := QSQUOTIENT(code,8192)
+  code1 := QSREMAINDER(code,8192)
+  if QSODDP code1 then isConstant := true
+  code2 := QSQUOTIENT(code1,2)
+  if QSODDP code2 then explicitLookupDomainIfTrue := true
+  index := QSQUOTIENT(code2,2)
+  kind := (isConstant = true => 'CONST; 'ELT)
+  sig := [NRTreplaceLocalTypes(s,thisDomain) for s in initSig]
+  sig := substDomainArgs(thisDomain,sig)
+  lookupDomain :=
+     domainSlot = 0 => thisDomain
+     thisDomain.domainSlot -- where we look for the operation
+  if PAIRP lookupDomain then lookupDomain := NRTevalDomain lookupDomain
+  dollar :=                             -- what matches $ in signatures
+    explicitLookupDomainIfTrue => lookupDomain
+    thisDomain
+  if PAIRP dollar then dollar := NRTevalDomain dollar
+  fn:= basicLookup(op,sig,lookupDomain,dollar)
+  fn = nil => keyedSystemError("S2NR0001",[op,sig,lookupDomain.0])
+  val:= APPLY(first fn,[:arglist,rest fn])
+  SETELT(thisDomain,index,fn)
+  val
+
+NRTreplaceLocalTypes(t,dom) ==
+   atom t =>
+     not INTEGERP t => t
+     t:= dom.t
+     if PAIRP t then t:= NRTevalDomain t
+     t.0
+   MEMQ(CAR t,'(Mapping Union Record _:)) =>
+      [CAR t,:[NRTreplaceLocalTypes(x,dom) for x in rest t]]
+   t
+
+substDomainArgs(domain,object) ==
+    form := devaluate domain
+    SUBLISLIS([form,:rest form],["$$",:$FormalMapVariableList],object)
+
+--=======================================================
+--       Lookup Function in Slot 1 (via SPADCALL)
+--=======================================================
+domainTableLookup(op,sig,dollar,env) == lookupInTable(op,sig,dollar,env)
+lookupInTable(op,sig,dollar,[domain,table]) ==
+  EQ(table,'derived) => lookupInAddChain(op,sig,domain,dollar)
+  success := false
+  someMatch := false
+  while not success for [sig1,:code] in LASSQ(op,table) repeat
+    success :=
+      null compareSig(sig,sig1,dollar.0,domain) => false
+      code is ['subsumed,a] =>
+            subsumptionSig :=
+               EQSUBSTLIST(rest(domain.0),$FormalMapVariableList,a)
+            someMatch:=true
+            false
+      predIndex := QSQUOTIENT(code,8192)
+      predIndex ^= 0 and null lookupPred($predVector.predIndex,dollar,domain)
+        => false
+      loc := QSQUOTIENT(QSREMAINDER(code,8192),2)
+      loc = 0 =>
+        someMatch := true
+        nil
+      slot := domain.loc
+      EQCAR(slot,'goGet) =>
+        lookupDisplay(op,sig,domain,'" !! goGet found, will ignore")
+        lookupInAddChain(op,sig,domain,dollar) or 'failed
+      NULL slot =>
+        lookupDisplay(op,sig,domain,'" !! null slot entry, continuing")
+        lookupInAddChain(op,sig,domain,dollar) or 'failed
+      lookupDisplay(op,sig,domain,'" !! found in NEW table!!")
+      slot
+  NE(success,'failed) and success => success
+  subsumptionSig and (u:= SPADCALL(op,subsumptionSig,dollar,domain.1)) => u
+  someMatch => lookupInAddChain(op,sig,domain,dollar)
+  nil
+
+--=======================================================
+--       Lookup Addlist (from lookupInDomainTable or lookupInDomain)
+--=======================================================
+lookupInAddChain(op,sig,addFormDomain,dollar) ==
+  addFunction:=lookupInDomain(op,sig,addFormDomain,dollar,5)
+  defaultingFunction addFunction =>
+     lookupInCategories(op,sig,addFormDomain,dollar) or addFunction
+  addFunction or lookupInCategories(op,sig,addFormDomain,dollar)
+
+
+defaultingFunction op ==
+  not(op is [.,:dom]) => false
+  not VECP dom => false
+  not (#dom > 0) => false
+  not (dom.0 is [packageName,:.]) => false
+  not IDENTP packageName => false
+  pname := PNAME packageName
+  pname.(MAXINDEX pname) = char "&"
+
+--=======================================================
+--   Lookup In Domain (from lookupInAddChain)
+--=======================================================
+lookupInDomain(op,sig,addFormDomain,dollar,index) ==
+  addFormCell := addFormDomain.index =>
+    INTEGERP KAR addFormCell =>
+      or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
+    if null VECP addFormCell then addFormCell := eval addFormCell
+    lookupInDomainVector(op,sig,addFormCell,dollar)
+  nil
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lookupInDomainVector(op,sig,domain,dollar) ==
+  slot1 := domain.1
+  SPADCALL(op,sig,dollar,slot1)
+
+--=======================================================
+--       Category Default Lookup (from goGet or lookupInAddChain)
+--=======================================================
+lookupInCategories(op,sig,dom,dollar) ==
+  catformList := dom.4.0
+  varList := ['$,:$FormalMapVariableList]
+  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+  valueList := [MKQ val for val in valueList]
+  nsig := MSUBST(dom.0,dollar.0,sig)
+  r := or/[lookupInDomainVector(op,nsig,
+                   eval EQSUBSTLIST(valueList,varList,catform),dollar)
+        for catform in catformList | pred] where pred ==
+   (table := HGET($Slot1DataBase,first catform)) and
+      (u := LASSQ(op,table))  --compare without checking predicates
+         and (v := or/[rest x for x in u | #sig = #x.0])
+        -- following lines commented out because compareSig needs domain
+        -- and (v := or/[rest x for x in u |
+        --             compareSig(sig,x.0,dollar.0, catform)])
+  r or lookupDisplay(op,sig,'"category defaults",'"-- not found")
+
+--=======================================================
+--                       Predicates
+--=======================================================
+lookupPred(pred,dollar,domain) ==
+  pred = true => true
+  pred = 'asserted => false
+  pred is ['AND,:pl] or pred is ['and,:pl] =>
+    and/[lookupPred(p,dollar,domain) for p in pl]
+  pred is ['OR,:pl] or pred is ['or,:pl] =>
+    or/[lookupPred(p,dollar,domain) for p in pl]
+  pred is ['NOT,p] or pred is ['not,p] => not lookupPred(p,dollar,domain)
+  pred is ['is,dom1,dom2] => domainEqual(dom1,dom2)
+  pred is ['has,a,b] =>
+    VECP a =>
+      keyedSystemError("S2GE0016",['"lookupPred",
+        '"vector as  first argument to has"])
+    a := eval mkEvalable substDollarArgs(dollar,domain,a)
+    b := substDollarArgs(dollar,domain,b)
+    HasCategory(a,b)
+  keyedSystemError("S2NR0002",[pred])
+
+substDollarArgs(dollar,domain,object) ==
+    form := devaluate domain
+    SUBLISLIS([devaluate dollar,:rest form],
+                ["$",:$FormalMapVariableList],object)
+
+compareSig(sig,tableSig,dollar,domain) ==
+  not (#sig = #tableSig) => false
+  null (target := first sig)
+   or lazyCompareSigEqual(target,first tableSig,dollar,domain) =>
+     and/[lazyCompareSigEqual(s,t,dollar,domain)
+              for s in rest sig for t in rest tableSig]
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+lazyCompareSigEqual(s,tslot,dollar,domain) ==
+  tslot = '$ => s = devaluate dollar  --needed for browser
+  INTEGERP tslot and PAIRP(lazyt:=domain.tslot) and PAIRP s =>
+      lazyt is [.,.,.,[.,item,.]] and
+        item is [.,[functorName,:.]] and functorName = CAR s =>
+          compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain)
+      nil
+  compareSigEqual(s,NRTreplaceLocalTypes(tslot,domain),dollar,domain)
+
+
+compareSigEqual(s,t,dollar,domain) ==
+  EQUAL(s,t) => true
+  ATOM t =>
+    u :=
+      EQ(t,'$) => dollar
+      isSharpVar t =>
+        VECP domain => ELT(rest domain.0,POSN1(t,$FormalMapVariableList))
+        ELT(rest domain,POSN1(t,$FormalMapVariableList))
+      STRINGP t and IDENTP s => (s := PNAME s; t)
+      nil
+    s = '$ => compareSigEqual(dollar,u,dollar,domain)
+    u => compareSigEqual(s,u,dollar,domain)
+    EQUAL(s,u)
+  EQ(s,'$) => compareSigEqual(dollar,t,dollar,domain)
+  ATOM s => nil
+  #s ^= #t => nil
+  match := true
+  for u in s for v in t repeat
+    not compareSigEqual(u,v,dollar,domain) => return(match:=false)
+  match
+
+-----------------------Compiler for Interpreter---------------------------------
+NRTcompileEvalForm(opName,sigTail,dcVector) ==
+  u := NRTcompiledLookup(opName,sigTail,dcVector)
+  not ($insideCompileBodyIfTrue = true) => MKQ u
+  k := NRTgetMinivectorIndex(u,opName,sigTail,dcVector)
+  ['ELT,"$$$",k]  --$$$ denotes minivector
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+NRTcompiledLookup(op,sig,dom) ==
+  if CONTAINED('_#,sig) then
+      sig := [NRTtypeHack t for t in sig]
+  compiledLookupCheck(op,sig,dom)
+
+NRTtypeHack t ==
+  ATOM t => t
+  CAR t = '_# => # CADR t
+  [CAR t,:[NRTtypeHack tt for tt in CDR t]]
+
+NRTgetMinivectorIndex(u,op,sig,domVector) ==
+  s := # $minivector
+  k := or/[k for k in 0..(s-1)
+        for x in $minivector | EQ(x,u)] => k
+  $minivector := [:$minivector,u]
+  if $compilingInputFile then
+    $minivectorCode := [:$minivectorCode,[op,sig,devaluate domVector]]
+--  pp '"-- minivectorCode -->"
+--  pp $minivectorCode
+  s
+
+NRTisRecurrenceRelation(op,body,minivectorName) ==
+  -- returns [body p1 p2 ... pk] for a k-term recurrence relation
+  -- where the n-th term is computed using the (n-1)st,...,(n-k)th
+  -- whose values are initially computed using the expressions
+  -- p1,...,pk respectively; body has #2,#3,... in place of
+  -- f(k-1),f(k-2),...
+
+  body isnt ['COND,:pcl] => false
+  -- body should have a conditional expression which
+  -- gives k boundary values, one general term plus possibly an
+  -- "out of domain" condition
+--pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
+--  CONTAINED('throwKeyedMsg,mess)) => NIL
+  pcl := [x for x in pcl | not (x is [''T,:mess] and
+    (CONTAINED('throwMessage,mess) or
+      CONTAINED('throwKeyedMsg,mess)))]
+  integer := EVALFUN $Integer
+  iequalSlot:=compiledLookupCheck("=",'((Boolean) $ $),integer)
+  lesspSlot:=compiledLookupCheck("<",'((Boolean) $ $),integer)
+  bf := '(Boolean)
+  notpSlot:= compiledLookupCheck("not",'((Boolean)(Boolean)),EVALFUN bf)
+  for [p,c] in pcl repeat
+    p is ['SPADCALL,sharpVar,n1,['ELT,=minivectorName,slot]]
+      and EQ(iequalSlot,$minivector.slot) =>
+        initList:= [[n1,:c],:initList]
+        sharpList := insert(sharpVar,sharpList)
+        n:=n1
+    miscList:= [[p,c],:miscList]
+  miscList isnt [[generalPred,generalTerm]] or sharpList isnt [sharpArg] =>
+      return false
+    --first general term starts at n
+
+  --Must have at least one special value; insist that they be consecutive
+  null initList => false
+  specialValues:= MSORT ASSOCLEFT initList
+  or/[null INTEGERP n for n in specialValues] => false
+  minIndex:= "MIN"/specialValues
+  not (and/[i=x for i in minIndex..(minIndex+n-1) for x in specialValues]) =>
+    sayKeyedMsg("S2IX0005",
+      ["append"/[['" ",sv]  for sv in specialValues]])
+    return nil
+
+  --Determine the order k of the recurrence and index n of first general term
+  k:= #specialValues
+  n:= k+minIndex
+  --Check general predicate
+  predOk :=
+    generalPred is '(QUOTE T) => true
+    generalPred is ['SPADCALL,m,=sharpArg,['ELT,=minivectorName,slot]]
+      and EQ(lesspSlot,$minivector.slot)=> m+1
+    generalPred is ['SPADCALL,['SPADCALL,=sharpArg,m,
+      ['ELT,=minivectorName,slot]], ['ELT,=minivectorName,notSlot]]
+        and EQ(lesspSlot,$minivector.slot)
+          and EQ(notpSlot,$minivector.notSlot) => m
+    generalPred is ['NOT,['SPADCALL,=sharpArg,m,['ELT,=minivectorName, =lesspSlot]]]
+      and EQ(lesspSlot,$minivector.slot) => m
+    return nil
+  INTEGERP predOk and predOk ^= n =>
+    sayKeyedMsg("S2IX0006",[n,m])
+    return nil
+
+  --Check general term for references to just the k previous values
+  diffCell:=compiledLookupCheck("-",'($ $ $),integer)
+  diffSlot := or/[i for i in 0.. for x in $minivector | EQ(x,diffCell)]
+                or return nil
+  --Check general term for references to just the k previous values
+  sharpPosition := PARSE_-INTEGER SUBSTRING(sharpArg,1,nil)
+  al:= mkDiffAssoc(op,generalTerm,k,sharpPosition,sharpArg,diffSlot,minivectorName)
+  null al => false
+  '$failed in al => false
+  body:= generalTerm
+  for [a,:b] in al repeat
+    body:= substitute(b,a,body)
+  result:= [body,sharpArg,n-1,:NREVERSE [LASSOC(i,initList) or
+      systemErrorHere('"NRTisRecurrenceRelation")
+        for i in minIndex..(n-1)]]
+
+mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) ==
+  -- returns alist which should not have any entries = $failed
+  -- form substitution list of the form:
+  -- ( ((f (,DIFFERENCE #1 1)) . #2) ((f (,DIFFERENCE #1 2)) . #3) ...)
+  --   but also checking that all difference values lie in 1..k
+  atom body => nil
+  body is ['COND,:pl] =>
+    "union"/[mkDiffAssoc(op,c,k,sharpPosition,sharpArg,diffSlot,vecname) for [p,c] in pl]
+  body is [fn,:argl] =>
+    (fn = op) and argl.(sharpPosition-1) is
+      ['SPADCALL,=sharpArg,n,['ELT,=vecname,=diffSlot]] =>
+          NUMP n and n > 0 and n <= k =>
+            [[body,:$TriangleVariableList.n]]
+          ['$failed]
+    "union"/[mkDiffAssoc(op,x,k,sharpPosition,sharpArg,diffSlot,vecname) for x in argl]
+  systemErrorHere '"mkDiffAssoc"
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nrunopt.boot.pamphlet b/src/interp/nrunopt.boot.pamphlet
new file mode 100644
index 00000000..672131fc
--- /dev/null
+++ b/src/interp/nrunopt.boot.pamphlet
@@ -0,0 +1,929 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/nrunopt.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--=======================================================================
+--            Generate Code to Create Infovec
+--=======================================================================
+getInfovecCode() == 
+--Function called by compDefineFunctor1 to create infovec at compile time
+  ['LIST,
+    MKQ makeDomainTemplate $template,
+      MKQ makeCompactDirect $NRTslot1Info,
+        MKQ NRTgenFinalAttributeAlist(),
+          NRTmakeCategoryAlist(),
+            MKQ $lookupFunction]
+
+--=======================================================================
+--         Generation of Domain Vector Template (Compile Time)
+--=======================================================================
+makeDomainTemplate vec ==   
+--NOTES: This function is called at compile time to create the template
+--  (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1
+  newVec := GETREFV SIZE vec
+  for index in 0..MAXINDEX vec repeat
+    item := vec.index
+    null item => nil
+    newVec.index :=
+      atom item => item
+      null atom first item => makeGoGetSlot(item,index)
+      item   
+  $byteVec := "append"/NREVERSE $byteVec
+  newVec
+ 
+makeGoGetSlot(item,index) ==
+--NOTES: creates byte vec strings for LATCH slots
+--these parts of the $byteVec are created first; see also makeCompactDirect
+  [sig,whereToGo,op,:flag] := item
+  n := #sig - 1
+  newcode := [n,whereToGo,:makeCompactSigCode(sig,nil),index]
+  $byteVec := [newcode,:$byteVec]
+  curAddress := $byteAddress
+  $byteAddress := $byteAddress + n + 4
+  [curAddress,:op]
+ 
+--=======================================================================
+--                Generate OpTable at Compile Time
+--=======================================================================
+--> called by getInfovecCode (see top of this file) from compDefineFunctor1
+makeCompactDirect u ==
+  $predListLength :local := LENGTH $NRTslot1PredicateList
+  $byteVecAcc: local := nil
+  [nam,[addForm,:opList]] := u
+  --pp opList 
+  d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(op,items)]
+  $byteVec := [:$byteVec,:"append"/NREVERSE $byteVecAcc]
+  LIST2VEC ("append"/d)
+ 
+makeCompactDirect1(op,items) ==
+--NOTES: creates byte codes for ops implemented by the domain
+    curAddress := $byteAddress
+    $op: local := op  --temp hack by RDJ 8/90 (see orderBySubsumption)
+    newcodes :=
+      "append"/[u for y in orderBySubsumption items | u := fn y] or return nil
+    $byteVecAcc := [newcodes,:$byteVecAcc]
+    curAddress
+ where fn y ==
+  [sig,:r] := y
+  r = ['Subsumed] =>
+    n := #sig - 1
+    $byteAddress := $byteAddress + n + 4
+    [n,0,:makeCompactSigCode(sig,$isOpPackageName),0]  --always followed by subsuming signature
+    --identified by a 0 in slot position
+  if r is [n,:s] then
+    slot :=
+      n is [p,:.] => p  --the CDR is linenumber of function definition
+      n
+    predCode :=
+      s is [pred,:.] => predicateBitIndex pred
+      0
+  --> drop items which are not present (predCode = -1)
+  predCode = -1 => return nil
+  --> drop items with NIL slots if lookup function is incomplete
+  if null slot then
+     $lookupFunction = 'lookupIncomplete => return nil
+     slot := 1   --signals that operation is not present
+  n := #sig - 1
+  $byteAddress := $byteAddress + n + 4
+  res := [n,predCode,:makeCompactSigCode(sig,$isOpPackageName),slot]
+  res
+ 
+orderBySubsumption items ==
+  acc := subacc := nil
+  for x in items repeat
+    not MEMQ($op,'(Zero One)) and x is [.,.,.,'Subsumed] => subacc := [x,:subacc]
+    acc := [x,:acc]
+  y := z := nil
+  for [a,b,:.] in subacc | b repeat   
+  --NOTE: b = nil means that the signature a will appear in acc, that this
+  --  entry is be ignored (e.g. init: -> $ in ULS)
+    while (u := ASSOC(b,subacc)) repeat b := CADR u
+    u := ASSOC(b,acc) or systemError nil
+    if null CADR u then u := [CAR u,1] --mark as missing operation
+    y := [[a,'Subsumed],u,:y] --makes subsuming signature follow one subsumed
+    z := insert(b,z)  --mark a signature as already present
+  [:y,:[w for (w := [c,:.]) in acc | not member(c,z)]] --add those not subsuming
+ 
+makeCompactSigCode(sig,$isOpPackageName) == [fn for x in sig] where 
+--$isOpPackageName = true only for an exported operation of a default package
+  fn == 
+    x = '_$_$ => 2
+    x = '$ => 0
+    NULL INTEGERP x => systemError ['"code vector slot is ",x,"; must be number"]
+--  x = 6 and $isOpPackageName => 0  --treat slot 6 as $ for default packages
+    x
+  
+--=======================================================================
+--              Instantiation Code (Stuffslots)
+--=======================================================================
+stuffDomainSlots dollar ==
+  domname := devaluate dollar
+  infovec := GETL(opOf domname,'infovec)
+  lookupFunction := getLookupFun infovec
+  lookupFunction :=
+    lookupFunction = 'lookupIncomplete => function lookupIncomplete
+    function lookupComplete
+  template := infovec.0
+  if template.5 then stuffSlot(dollar,5,template.5)
+  for i in (6 + # rest domname)..MAXINDEX template | item := template.i repeat
+    stuffSlot(dollar,i,item)
+  dollar.1 := LIST(lookupFunction,dollar,infovec.1)
+  dollar.2 := infovec.2
+  proto4 := infovec.3
+  dollar.4 := 
+    VECP CDDR proto4 => [COPY_-SEQ CAR proto4,:CDR proto4]   --old style
+    bitVector := dollar.3
+    predvec := CAR proto4
+    packagevec := CADR proto4
+    auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn ==
+      null testBitVector(bitVector,predvec.i) => nil
+      packagevec.i or 'T
+    [auxvec,:CDDR proto4]
+
+getLookupFun infovec ==
+  MAXINDEX infovec = 4 => infovec.4
+  'lookupIncomplete
+
+stuffSlot(dollar,i,item) ==
+  dollar.i :=
+    atom item => [SYMBOL_-FUNCTION item,:dollar]
+    item is [n,:op] and INTEGERP n => ['newGoGet,dollar,:item]
+    item is ['CONS,.,['FUNCALL,a,b]] =>
+      b = '$ => ['makeSpadConstant,eval a,dollar,i]
+      sayBrightlyNT '"Unexpected constant environment!!"
+      pp devaluate b
+      nil
+--  [dollar,i,:item]    --old form
+--  $isOpPackageName = 'T => SUBST(0,6,item)
+    item                --new form
+--=======================================================================
+--                Generate Slot 2 Attribute Alist
+--=======================================================================
+NRTgenInitialAttributeAlist attributeList ==
+  --alist has form ((item pred)...) where some items are constructor forms
+  alist := [x for x in attributeList | -- throw out constructors
+    null MEMQ(opOf first x,allConstructors())]
+  $lisplibAttributes := simplifyAttributeAlist
+    [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a ^= 'nothing]
+
+simplifyAttributeAlist al ==
+  al is [[a,:b],:r] =>
+    u := [x for x in r | x is [=a,:b]] 
+    null u => [first al,:simplifyAttributeAlist rest al]
+    pred := simpBool makePrefixForm([b,:ASSOCRIGHT u],'OR)
+    $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+    s := [x for x in r | x isnt [=a,:b]]
+    [[a,:pred],:simplifyAttributeAlist s]
+  nil
+ 
+NRTgenFinalAttributeAlist() ==
+  [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ^= -1]
+ 
+predicateBitIndex x == 
+  pn(x,nil) where
+    pn(x,flag) ==
+      u := simpBool transHasCode x
+      u = 'T  =>  0
+      u = nil => -1
+      p := POSN1(u,$NRTslot1PredicateList) => p + 1
+      null flag => pn(predicateBitIndexRemop x,true)
+      systemError nil
+
+predicateBitIndexRemop p==
+--transform attribute predicates taken out by removeAttributePredicates
+  p is [op,:argl] and op in '(AND and OR or NOT not) => 
+    simpBool makePrefixForm([predicateBitIndexRemop x for x in argl],op)
+  p is ['has,'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
+  p
+ 
+predicateBitRef x ==
+  x = 'T => 'T
+  ['testBitVector,'pv_$,predicateBitIndex x]
+ 
+makePrefixForm(u,op) ==
+  u := MKPF(u,op)
+  u = ''T => 'T
+  u
+--=======================================================================
+--               Generate Slot 3 Predicate Vector
+--=======================================================================
+makePredicateBitVector pl ==   --called by NRTbuildFunctor
+  if $insideCategoryPackageIfTrue = true then
+    pl := union(pl,$categoryPredicateList)
+  $predGensymAlist := nil --bound by NRTbuildFunctor, used by optHas
+  for p in removeAttributePredicates pl repeat
+    pred := simpBool transHasCode p
+    atom pred => 'skip                --skip over T and NIL
+    if isHasDollarPred pred then 
+      lasts := insert(pred,lasts)
+      for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts)
+    else 
+      firsts := insert(pred,firsts)
+  firstPl := SUBLIS($pairlis,NREVERSE orderByContainment firsts)
+  lastPl  := SUBLIS($pairlis,NREVERSE orderByContainment lasts)
+  firstCode:= 
+    ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)]
+  lastCode := augmentPredCode(# firstPl,lastPl)
+  $lisplibPredicates := [:firstPl,:lastPl] --what is stored under 'predicates
+  [$lisplibPredicates,firstCode,:lastCode]  --$pairlis set by compDefineFunctor1
+
+augmentPredCode(n,lastPl) ==
+  ['LIST,:pl] := mungeAddGensyms(lastPl,$predGensymAlist)
+  delta := 2 ** n
+  l := [(u := MKPF([x,['augmentPredVector,$,delta]],'AND); 
+         delta:=2 * delta; u) for x in pl]
+
+augmentPredVector(dollar,value) ==
+  QSETREFV(dollar,3,value + QVELT(dollar,3))
+
+isHasDollarPred pred ==
+  pred is [op,:r] =>
+    MEMQ(op,'(AND and OR or NOT not)) => or/[isHasDollarPred x for x in r]
+    MEMQ(op,'(HasCategory HasAttribute)) => CAR r = '$
+  false
+
+stripOutNonDollarPreds pred ==
+  pred is [op,:r] and MEMQ(op,'(AND and OR or NOT not)) => 
+    "append"/[stripOutNonDollarPreds x for x in r]
+  not isHasDollarPred pred => [pred]
+  nil
+
+removeAttributePredicates pl ==
+  [fn p for p in pl] where
+    fn p ==
+      p is [op,:argl] and op in '(AND and OR or NOT not) => 
+          makePrefixForm(fnl argl,op)
+      p is ['has,'$,['ATTRIBUTE,a]] =>
+        sayBrightlyNT '"Predicate: "
+        PRINT p
+        sayBrightlyNT '"  replaced by: "
+        PRINT LASSOC(a,$NRTattributeAlist)
+      p
+    fnl p == [fn x for x in p]
+ 
+transHasCode x ==
+  atom x => x
+  op := QCAR x
+  MEMQ(op,'(HasCategory HasAttribute)) => x
+  EQ(op,'has) => compHasFormat x
+  [transHasCode y for y in x]
+ 
+mungeAddGensyms(u,gal) ==
+  ['LIST,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) ==
+    atom x => x
+    g := LASSOC(x,gal) =>
+      n = 0 => ['LET,g,x]
+      g
+    [first x,:[fn(y,gal,n + 1) for y in rest x]]
+ 
+orderByContainment pl ==
+  null pl or null rest pl => pl
+  max := first pl
+  for x in rest pl repeat
+    if (y := CONTAINED(max,x)) then
+      if null ASSOC(max,$predGensymAlist)
+      then $predGensymAlist := [[max,:GENSYM()],:$predGensymAlist]
+    else if CONTAINED(x,max)
+         then if null ASSOC(x,$predGensymAlist) then $predGensymAlist := [[x,:GENSYM()],:$predGensymAlist]
+    if y then max := x
+  [max,:orderByContainment delete(max,pl)]
+ 
+buildBitTable(:l) == fn(REVERSE l,0) where fn(l,n) ==
+  null l => n
+  n := n + n
+  if QCAR l then n := n + 1
+  fn(rest l,n)
+ 
+buildPredVector(init,n,l) == fn(init,2 ** n,l) where fn(acc,n,l) ==
+  null l => acc
+  if CAR l then acc := acc + n
+  fn(acc,n + n,rest l)
+
+testBitVector(vec,i) ==
+--bit vector indices are always 1 larger than position in vector
+  EQ(i,0) => true
+  LOGBITP(i - 1,vec)
+ 
+bitsOf n ==
+  n = 0 => 0
+  1 + bitsOf (n/2)
+ 
+--=======================================================================
+--               Generate Slot 4 Constructor Vectors
+--=======================================================================
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+NRTmakeCategoryAlist() ==
+  $depthAssocCache: local := MAKE_-HASHTABLE 'ID
+  pcAlist := [:[[x,:'T] for x in $uncondAlist],:$condAlist]
+  $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
+  opcAlist := NREVERSE SORTBY(function NRTcatCompare,pcAlist)
+  newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
+  slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist) 
+                   | (k := predicateBitIndex b) ^= -1]
+  slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
+  sixEtc := [5 + i for i in 1..#$pairlis]
+  formals := ASSOCRIGHT $pairlis
+  for x in slot1 repeat RPLACA(x,EQSUBSTLIST(sixEtc,formals,CAR x))
+  -----------code to make a new style slot4-----------------
+  predList := ASSOCRIGHT slot1  --is list of predicate indices
+  maxPredList := "MAX"/predList
+  catformvec := ASSOCLEFT slot1
+  maxElement := "MAX"/$byteVec
+  ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList], 
+    ['CONS, MKQ LIST2VEC slot0, 
+      ['CONS, MKQ LIST2VEC [encodeCatform x for x in catformvec],
+        ['makeByteWordVec2,maxElement,MKQ $byteVec]]]]
+  --NOTE: this is new form: old form satisfies VECP CDDR form
+
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+encodeCatform x == 
+  k := NRTassocIndex x => k
+  atom x or atom rest x => x
+  [first x,:[encodeCatform y for y in rest x]]
+ 
+NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist)
+ 
+hasDefaultPackage catname ==
+  defname := INTERN STRCONC(catname,'"&")
+  constructor? defname => defname
+--MEMQ(defname,allConstructors()) => defname
+  nil
+ 
+ 
+--=======================================================================
+--             Generate Category Level Alist
+--=======================================================================
+orderCatAnc x == NREVERSE ASSOCLEFT SORTBY('CDR,CDR depthAssoc x)
+ 
+depthAssocList u == 
+  u := delete('DomainSubstitutionMacro,u)  --hack by RDJ 8/90
+  REMDUP ("append"/[depthAssoc(y) for y in u])
+ 
+depthAssoc x ==
+  y := HGET($depthAssocCache,x) => y
+  x is ['Join,:u] or (u := getCatAncestors x) =>
+    v := depthAssocList u
+    HPUT($depthAssocCache,x,[[x,:n],:v])
+      where n == 1 + "MAX"/[rest y for y in v]
+  HPUT($depthAssocCache,x,[[x,:0]])
+ 
+getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
+ 
+listOfEntries form ==
+  atom form => form
+  form is [op,:l] =>
+    op = 'Join => "append"/[listOfEntries x for x in l]
+    op = 'CATEGORY => listOfCategoryEntries rest l
+    op = 'PROGN => listOfCategoryEntries l
+    op = 'ATTRIBUTE and first l is [f,:.] and constructor? f => [first l]
+    op in '(ATTRIBUTE SIGNATURE) => nil
+    [form]
+  categoryFormatError()
+ 
+listOfCategoryEntries l ==
+  null l => nil
+  l is [[op,:u],:v] =>
+    firstItemList:=
+      op = 'ATTRIBUTE and first u is [f,:.] and constructor? f =>
+        [first u]
+      MEMQ(op,'(ATTRIBUTE SIGNATURE)) => nil
+      op = 'IF and u is [pred,conseq,alternate] =>
+          listOfCategoryEntriesIf(pred,conseq,alternate)
+      categoryFormatError()
+    [:firstItemList,:listOfCategoryEntries v]
+  l is ['PROGN,:l] => listOfCategoryEntries l
+  l is '(NIL) => nil
+  sayBrightly '"unexpected category format encountered:"
+  pp l
+ 
+listOfCategoryEntriesIf(pred,conseq,alternate) ==
+  alternate in '(noBranch NIL) =>
+    conseq is ['IF,p,c,a] => listOfCategoryEntriesIf(makePrefixForm([pred,p],'AND),c,a)
+    [fn for x in listOfEntries conseq] where fn ==
+      x is ['IF,a,b] => ['IF,makePrefixForm([pred,a],'AND),b]
+      ['IF,pred,x]
+  notPred := makePrefixForm(pred,'NOT)
+  conseq is ['IF,p,c,a] =>
+    listOfCategoryEntriesIf(makePrefixForm([notPred,p],'AND),c,a)
+  [gn for x in listOfEntries conseq] where gn ==
+    x is ['IF,a,b] => ['IF,makePrefixForm([notPred,a],'AND),b]
+    ['IF,notPred,x]
+ 
+--=======================================================================
+--                     Display Template
+--=======================================================================
+dc(:r) ==
+  con := KAR r
+  options := KDR r
+  ok := MEMQ(con,allConstructors()) or (con := abbreviation? con)
+  null ok =>
+    sayBrightly '"Format is: dc(<constructor name or abbreviation>,option)"
+    sayBrightly 
+      '"options are: all (default), slots, atts, cats, data, ops, optable"
+  option := KAR options
+  option = 'all or null option => dcAll con
+  option = 'slots   =>  dcSlots con
+  option = 'atts    =>  dcAtts  con
+  option = 'cats    =>  dcCats  con
+  option = 'data    =>  dcData  con
+  option = 'ops     =>  dcOps   con
+  option = 'size    =>  dcSize( con,'full)
+  option = 'optable =>  dcOpTable con
+
+dcSlots con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  template := $infovec.0
+  for i in 5..MAXINDEX template repeat
+    sayBrightlyNT bright i
+    item := template.i
+    item is [n,:op] and INTEGERP n => dcOpLatchPrint(op,n)
+    null item and i > 5 => sayBrightly ['"arg  ",STRCONC('"#",STRINGIMAGE(i - 5))]
+    atom item => sayBrightly ['"fun  ",item]
+    item is ['CONS,.,['FUNCALL,[.,a],b]] => sayBrightly ['"constant ",a]
+    sayBrightly concat('"lazy ",form2String formatSlotDomain i)
+ 
+dcOpLatchPrint(op,index) ==
+  numvec := getCodeVector()
+  numOfArgs := numvec.index
+  whereNumber := numvec.(index := index + 1)
+  signumList := dcSig(numvec,index + 1,numOfArgs)
+  index := index + numOfArgs + 1
+  namePart := concat(bright "from",
+    dollarPercentTran form2String formatSlotDomain whereNumber)
+  sayBrightly ['"latch",:formatOpSignature(op,signumList),:namePart]
+ 
+getInfovec name ==
+  u := GETL(name,'infovec) => u
+  GETL(name,'LOADED) => nil
+  fullLibName := GETDATABASE(name,'OBJECT) or return nil
+  startTimingProcess 'load
+  loadLibNoUpdate(name, name, fullLibName)
+  GETL(name,'infovec)
+ 
+getOpSegment index ==
+  numOfArgs := (vec := getCodeVector()).index
+  [vec.i for i in index..(index + numOfArgs + 3)]
+
+getCodeVector() ==
+  proto4 := $infovec.3
+  u := CDDR proto4
+  VECP u => u           --old style
+  CDR u                 --new style
+
+formatSlotDomain x ==
+  x = 0 => ["$"]
+  x = 2 => ["$$"]
+  INTEGERP x =>
+    val := $infovec.0.x
+    null val => [STRCONC('"#",STRINGIMAGE (x  - 5))]
+    formatSlotDomain val
+  atom x => x
+  x is ['NRTEVAL,y] => (atom y => [y]; y)
+  [first x,:[formatSlotDomain y for y in rest x]]
+ 
+--=======================================================================
+--                     Display OpTable
+--=======================================================================
+dcOpTable con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  template := $infovec.0
+  $predvec: local := GETDATABASE(con,'PREDICATES)
+  opTable := $infovec.1
+  for i in 0..MAXINDEX opTable repeat
+    op := opTable.i
+    i := i + 1
+    startIndex := opTable.i
+    stopIndex :=
+      i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector()
+      opTable.(i + 2)
+    curIndex := startIndex
+    while curIndex < stopIndex repeat
+      curIndex := dcOpPrint(op,curIndex)
+ 
+dcOpPrint(op,index) ==
+  numvec := getCodeVector()
+  segment := getOpSegment index
+  numOfArgs := numvec.index
+  index := index + 1
+  predNumber := numvec.index
+  index := index + 1
+  signumList := dcSig(numvec,index,numOfArgs)
+  index := index + numOfArgs + 1
+  slotNumber := numvec.index
+  suffix :=
+    predNumber = 0 => nil
+    [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+  namePart := bright
+    slotNumber = 0 => '"subsumed by next entry"
+    slotNumber = 1 => '"missing"
+    name := $infovec.0.slotNumber
+    atom name => name
+    '"looked up"
+  sayBrightly [:formatOpSignature(op,signumList),:namePart, :suffix]
+  index + 1
+ 
+dcSig(numvec,index,numOfArgs) ==
+  [formatSlotDomain numvec.(index + i) for i in 0..numOfArgs]
+ 
+dcPreds con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  $predvec:= GETDATABASE(con,'PREDICATES)
+  for i in 0..MAXINDEX $predvec repeat
+    sayBrightlyNT bright (i + 1)
+    sayBrightly pred2English $predvec.i
+ 
+dcAtts con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  $predvec:= GETDATABASE(con,'PREDICATES)
+  attList := $infovec.2
+  for [a,:predNumber] in attList for i in 0.. repeat
+    sayBrightlyNT bright i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    sayBrightly [a,:suffix]
+ 
+dcCats con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  u := $infovec.3
+  VECP CDDR u => dcCats1 con    --old style slot4
+  $predvec:= GETDATABASE(con,'PREDICATES)
+  catpredvec := CAR u
+  catinfo := CADR u
+  catvec := CADDR u
+  for i in 0..MAXINDEX catvec repeat
+    sayBrightlyNT bright i
+    form := catvec.i
+    predNumber := catpredvec.i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    extra :=
+      null (info := catinfo.i) => nil
+      IDENTP info => bright '"package"
+      bright '"instantiated"
+    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
+ 
+dcCats1 con ==
+  $predvec:= GETDATABASE(con,'PREDICATES)
+  u := $infovec.3
+  catvec := CADR u
+  catinfo := CAR u
+  for i in 0..MAXINDEX catvec repeat
+    sayBrightlyNT bright i
+    [form,:predNumber] := catvec.i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    extra :=
+      null (info := catinfo.i) => nil
+      IDENTP info => bright '"package"
+      bright '"instantiated"
+    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
+ 
+dcData con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  sayBrightly '"Operation data from slot 1"
+  PRINT_-FULL $infovec.1
+  vec := getCodeVector()
+  vec := (PAIRP vec => CDR vec; vec)
+  sayBrightly ['"Information vector has ",SIZE vec,'" entries"]
+  dcData1 vec
+
+dcData1 vec ==
+  n := MAXINDEX vec
+  tens := n / 10
+  for i in 0..tens repeat
+    start := 10*i
+    sayBrightlyNT rightJustifyString(STRINGIMAGE start,6)
+    sayBrightlyNT '"  |"
+    for j in start..MIN(start + 9,n) repeat
+      sayBrightlyNT rightJustifyString(STRINGIMAGE vec.j,6)
+    sayNewLine()
+  vec
+
+dcSize(:options) ==
+  con := KAR options
+  options := rest options
+  null con => dcSizeAll()
+  quiet := MEMQ('quiet,options)
+  full := MEMQ('full,options)
+  name := abbreviation? con or con
+  infovec := getInfovec name
+  template := infovec.0
+  maxindex := MAXINDEX template
+  latch := 0  --# of go get slots
+  lazy  := 0  --# of lazy domain slots
+  fun   := 0  --# of function slots
+  lazyNodes := 0 --# of nodes needed for lazy domain slots
+  for i in 5..maxindex repeat
+    atom (item := template.i) =>   fun := fun + 1
+    INTEGERP first item    => latch := latch + 1
+    'T                 =>  
+       lazy := lazy + 1
+       lazyNodes := lazyNodes + numberOfNodes item
+  tSize := sum(vectorSize(1 + maxindex),nodeSize(lazyNodes + latch))
+  -- functions are free in the template vector
+  oSize := vectorSize(SIZE infovec.1)
+  aSize := numberOfNodes infovec.2
+  slot4 := infovec.3
+  catvec := 
+    VECP CDDR slot4 => CADR slot4
+    CADDR slot4
+  n := MAXINDEX catvec
+  cSize := sum(nodeSize(2),vectorSize(SIZE CAR slot4),vectorSize(n + 1),
+               nodeSize(+/[numberOfNodes catvec.i for i in 0..n]))
+  codeVector :=
+    VECP CDDR slot4 => CDDR slot4
+    CDDDR slot4
+  vSize := halfWordSize(SIZE codeVector)
+  itotal := sum(tSize,oSize,aSize,cSize,vSize)
+  if null quiet then sayBrightly ['"infovec total = ",itotal,'" BYTES"]
+  if null quiet then
+    lookupFun := getLookupFun infovec
+    suffix := (lookupFun = 'lookupIncomplete => '"incomplete"; '"complete")
+    sayBrightly ['"template    = ",tSize]
+    sayBrightly ['"operations  = ",oSize,'" (",suffix,'")"]
+    sayBrightly ['"attributes  = ",aSize]
+    sayBrightly ['"categories  = ",cSize]
+    sayBrightly ['"data vector = ",vSize]
+  if null quiet then
+    sayBrightly ['"number of function slots (one extra node) = ",fun]
+    sayBrightly ['"number of latch slots (2 extra nodes) = ",latch]
+    sayBrightly ['"number of lazy slots (no extra nodes) = ",lazy]
+    sayBrightly ['"size of domain vectors = ",1 + maxindex,'" slots"]
+  vtotal := itotal + nodeSize(fun)       --fun   slot is ($ . function)
+  vtotal := vtotal + nodeSize(2 * latch) --latch slot is (newGoGet $ . code)
+  --NOTE: lazy slots require no cost     --lazy  slot is lazyDomainForm
+  if null quiet then sayBrightly ['"domain size = ",vtotal,'" BYTES"] 
+  etotal := nodeSize(fun + 2 * latch) + vectorSize(1 + maxindex)
+  if null quiet then sayBrightly ['"cost per instantiation = ",etotal,'" BYTES"]
+  vtotal
+
+dcSizeAll() ==
+  count := 0
+  total := 0
+  for x in allConstructors() | null atom GETL(x,'infovec) repeat
+    count := count + 1
+    s := dcSize(x,'quiet)
+    sayBrightly [s,'" : ",x]
+    total := total + s
+  sayBrightly '"------------total-------------"
+  sayBrightly [count," constructors; ",total," BYTES"]  
+    
+sum(:l) == +/l
+
+nodeSize(n) == 12 * n
+
+vectorSize(n) == 4 * (1 + n)
+
+halfWordSize(n) == 
+  n < 128 => n / 2
+  n < 256 => n
+  2 * n
+
+numberOfNodes(x) ==
+  atom x => 0
+  1 + numberOfNodes first x + numberOfNodes rest x
+
+template con ==
+  con := abbreviation? con or con
+  ppTemplate (getInfovec con).0
+
+ppTemplate vec ==
+  for i in 0..MAXINDEX vec repeat
+    sayBrightlyNT bright i
+    pp vec.i
+
+infovec con == 
+  con := abbreviation? con or con
+  u := getInfovec con
+  sayBrightly '"---------------slot 0 is template-------------------"
+  ppTemplate u.0
+  sayBrightly '"---------------slot 1 is op table-------------------"
+  PRINT_-FULL u.1
+  sayBrightly '"---------------slot 2 is attribute list-------------"
+  PRINT_-FULL u.2
+  sayBrightly '"---------------slot 3.0 is catpredvec---------------"
+  PRINT_-FULL u.3.0
+  sayBrightly '"---------------slot 3.1 is catinfovec---------------"
+  PRINT_-FULL u.3.1
+  sayBrightly '"---------------slot 3.2 is catvec-------------------"
+  PRINT_-FULL u.3.2
+  sayBrightly '"---------------tail of slot 3 is datavector---------"
+  dcData1 CDDDR u.3
+  'done
+
+dcAll con ==
+  con := abbreviation? con or con
+  $infovec : local := getInfovec con
+  complete? := 
+    #$infovec = 4 => false
+    $infovec.4 = 'lookupComplete
+  sayBrightly '"----------------Template-----------------"
+  dcSlots con
+  sayBrightly
+    complete? => '"----------Complete Ops----------------"
+    '"----------Incomplete Ops---------------"
+  dcOpTable con
+  sayBrightly '"----------------Atts-----------------"
+  dcAtts con
+  sayBrightly '"----------------Preds-----------------"
+  dcPreds con
+  sayBrightly '"----------------Cats-----------------"
+  dcCats con
+  sayBrightly '"----------------Data------------------"
+  dcData con
+  sayBrightly '"----------------Size------------------"
+  dcSize(con,'full)
+  'done
+
+dcOps conname ==
+  for [op,:u] in REVERSE getOperationAlistFromLisplib conname repeat
+    for [sig,slot,pred,key,:.] in u repeat
+      suffix := 
+        atom pred => nil
+        concat('" if ",pred2English pred)
+      key = 'Subsumed =>
+        sayBrightly [:formatOpSignature(op,sig),'" subsumed by ",:formatOpSignature(op,slot),:suffix]
+      sayBrightly [:formatOpSignature(op,sig),:suffix]
+  
+--=======================================================================
+--              Compute the lookup function (complete or incomplete)
+--=======================================================================
+NRTgetLookupFunction(domform,exCategory,addForm) ==
+  domform := SUBLIS($pairlis,domform)
+  addForm := SUBLIS($pairlis,addForm)
+  $why: local := nil
+  atom addForm => 'lookupComplete
+  extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm)
+  if null extends then 
+    [u,msg,:v] := $why
+    sayBrightly '"--------------non extending category----------------------"
+    sayBrightlyNT ['"..",:bright form2String domform,"of cat "]
+    PRINT u
+    sayBrightlyNT bright msg
+    if v then PRINT CAR v else TERPRI()
+  extends => 'lookupIncomplete
+  'lookupComplete
+
+getExportCategory form ==
+  [op,:argl] := form
+  op = 'Record => ['RecordCategory,:argl]
+  op = 'Union => ['UnionCategory,:argl]
+  functorModemap := GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  [[.,target,:tl],:.] := functorModemap
+  EQSUBSTLIST(argl,$FormalMapVariableList,target)
+ 
+NRTextendsCategory1(domform,exCategory,addForm) ==
+  addForm is ['Tuple,:r] => 
+    and/[extendsCategory(domform,exCategory,x) for x in r]
+  extendsCategory(domform,exCategory,addForm)
+
+--=======================================================================
+--         Compute if a domain constructor is forgetful functor
+--=======================================================================
+extendsCategory(dom,u,v) ==
+  --does category u extend category v (yes iff u contains everything in v)
+  --is dom of category u also of category v?
+  u=v => true
+  v is ["Join",:l] => and/[extendsCategory(dom,u,x) for x in l]
+  v is ["CATEGORY",.,:l] => and/[extendsCategory(dom,u,x) for x in l]
+  v is ["SubsetCategory",cat,d] => extendsCategory(dom,u,cat) and isSubset(dom,d,$e)
+  v := substSlotNumbers(v,$template,$functorForm)
+  extendsCategoryBasic0(dom,u,v) => true
+  $why :=
+    v is ['SIGNATURE,op,sig] => [u,['"  has no ",:formatOpSignature(op,sig)]]
+    [u,'" has no",v]
+  nil
+ 
+extendsCategoryBasic0(dom,u,v) ==
+  v is ['IF,p,['ATTRIBUTE,c],.] =>
+    uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr
+    null atom c and isCategoryForm(c,nil) =>
+      slot4 := uVec.4
+      LASSOC(c,CADR slot4) is [=p,:.]
+    slot2 := uVec.2
+    LASSOC(c,slot2) is [=p,:.]
+  extendsCategoryBasic(dom,u,v)
+ 
+extendsCategoryBasic(dom,u,v) ==
+  u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v) for x in l]
+  u = v => true
+  uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr
+  isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec)
+  v is ['SIGNATURE,op,sig] =>
+    or/[uVec.i is [[=op,=sig],:.] for i in 6..MAXINDEX uVec]
+  u is ['CATEGORY,.,:l] =>
+    v is ['IF,:.] => member(v,l)
+    nil
+  nil
+ 
+catExtendsCat?(u,v,uvec) ==
+  u = v => true
+  uvec := uvec or compMakeCategoryObject(u,$EmptyEnvironment).expr
+  slot4 := uvec.4
+  prinAncestorList := CAR slot4
+  member(v,prinAncestorList) => true
+  vOp := KAR v
+  if similarForm := ASSOC(vOp,prinAncestorList) then
+    PRINT u
+    sayBrightlyNT '"   extends "
+    PRINT similarForm
+    sayBrightlyNT '"   but not "
+    PRINT v
+  or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT CADR slot4]
+ 
+substSlotNumbers(form,template,domain) ==
+  form is [op,:.] and
+    MEMQ(op,allConstructors()) => expandType(form,template,domain)
+  form is ['SIGNATURE,op,sig] =>
+    ['SIGNATURE,op,[substSlotNumbers(x,template,domain) for x in sig]]
+  form is ['CATEGORY,k,:u] =>
+    ['CATEGORY,k,:[substSlotNumbers(x,template,domain) for x in u]]
+  expandType(form,template,domain)
+ 
+expandType(lazyt,template,domform) ==
+  atom lazyt => expandTypeArgs(lazyt,template,domform)
+  [functorName,:argl] := lazyt
+  MEMQ(functorName, '(Record Union)) and first argl is [":",:.] =>
+     [functorName,:[['_:,tag,expandTypeArgs(dom,template,domform)]
+                                 for [.,tag,dom] in argl]]
+  lazyt is ['local,x] =>
+    n := POSN1(x,$FormalMapVariableList)
+    ELT(domform,1 + n)
+  [functorName,:[expandTypeArgs(a,template,domform) for a in argl]]
+ 
+expandTypeArgs(u,template,domform) ==
+  u = '$ => u --template.0      -------eliminate this as $ is rep by 0
+  INTEGERP u => expandType(templateVal(template, domform, u), template,domform)
+  u is ['NRTEVAL,y] => y  --eval  y
+  u is ['QUOTE,y] => y
+  atom u => u
+  expandType(u,template,domform)
+ 
+templateVal(template,domform,index) ==
+--returns a domform or a lazy slot
+  index = 0 => harhar() --template
+  template.index
+   
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nruntime.boot.pamphlet b/src/interp/nruntime.boot.pamphlet
new file mode 100644
index 00000000..c2d809d1
--- /dev/null
+++ b/src/interp/nruntime.boot.pamphlet
@@ -0,0 +1,80 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nruntime.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+unloadOneConstructor(cnam,fn) ==
+    REMPROP(cnam,'LOADED)
+    SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
+
+devaluateDeeply x ==
+  VECP x => devaluate x
+  atom x => x
+  [devaluateDeeply y for y in x]
+
+lookupDisplay(op,sig,vectorOrForm,suffix) ==
+  null $NRTmonitorIfTrue => nil
+  prefix := (suffix = '"" => ">"; "<")
+  sayBrightly
+    concat(prefix,formatOpSignature(op,sig),
+        '" from ", prefix2String devaluateDeeply vectorOrForm,suffix)
+
+isInstantiated [op,:argl] ==
+  u:= lassocShiftWithFunction(argl,HGET($ConstructorCache,op),'domainEqualList)
+    => CDRwithIncrement u
+  nil
+
+isCategoryPackageName nam ==
+  p := PNAME opOf nam
+  p.(MAXINDEX p) = char '_&
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/nspadaux.lisp.pamphlet b/src/interp/nspadaux.lisp.pamphlet
new file mode 100644
index 00000000..1b272228
--- /dev/null
+++ b/src/interp/nspadaux.lisp.pamphlet
@@ -0,0 +1,139 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp nspadaux.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+(defvar |$DEFdepth| 0)
+(defvar |$localMacroStack| nil)
+(defvar |$globalMacroStack| nil)
+(defvar |$abbreviationStack| nil)
+(defvar |$knownAttributes| nil "cumulative list of known attributes of a file") 
+
+(setq |$underscoreChar| (|char| '_))
+(defvar |$back| nil) 
+
+(setq |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT))
+(setq |$convert2NewCompiler| 'T)
+(setq |$AnalyzeOnly| NIL)
+(setq |$categoryPart| 'T)
+(setq |$insideCAPSULE| nil)
+(setq |$insideEXPORTS| nil)
+(setq |$originalSignature| nil)
+(setq |$insideDEF| nil)
+(setq |$insideTypeExpression| nil)
+(setq |$spadTightList| '(\.\. \# \'  \:\  \: \:\:))
+
+(setq |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10))
+(makeprop '_^ '|parseTran| '|parseNot|)
+
+(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'SPECIAL (CADR X)))
+        '((PART |compPART|)
+          (WI |compWI|)
+          (MI |compWI|)))
+        
+(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'PSPAD (CADR X)))
+        '((|default| |formatDefault|)
+          (|local| |formatLocal|)
+          (COMMENT   |formatCOMMENT|)
+          (CAPSULE |formatCAPSULE|)
+          (LISTOF |formatPAREN|)
+          (DEF    |formatDEF|)
+          (SEQ    |formatSEQ|)
+          (LET    |formatLET|)
+          (\:    |formatColon|)
+          (ELT    |formatELT|)
+          (QUOTE |formatQUOTE|)
+          (SEGMENT |formatSEGMENT|)
+          (DOLLAR |formatDOLLAR|)
+          (BRACE  |formatBrace|)
+          (|dot|  |formatDot|)
+          (MDEF |formatMDEF|)
+          (|free| |formatFree|)
+          (|elt|  |formatElt|)
+          (PAREN |formatPAREN|)
+          (PROGN |formatPROGN|)
+          (|exit| |formatExit|)
+          (|leave| |formatLeave|)
+          (|void|  |formatvoid|)
+          (MI   |formatMI|)
+          (IF   |formatIF|)
+          (\=\> |formatFATARROW|)
+          (\+\-\> |formatMap|)
+          (|Enumeration| |formatEnumeration|)
+          (|import| |formatImport|)
+          (UNCOERCE |formatUNCOERCE|)
+          (CATEGORY |formatCATEGORY|)
+          (SIGNATURE |formatSIGNATURE|)
+          (|where| |formatWHERE|)
+          (COLLECT   |formatCOLLECT|)
+          (|MyENUM|    |formatENUM|)
+          (REDUCE    |formatREDUCE|)
+          (REPEAT    |formatREPEAT|)
+          (ATTRIBUTE |formatATTRIBUTE|)
+          (CONS      |formatCONS|)
+          (|construct| |formatConstruct|)
+          (|Union| |formatUnion|)
+          (|Record| |formatRecord|)
+          (|Mapping| |formatMapping|)
+          (|Tuple|   |formatTuple|)
+          (|with|  |formatWith|)
+          (|withDefault| |formatWithDefault|)
+          (|defaultDefs| |formatDefaultDefs|)
+          (|add|   |formatAdd|)))
+
+(remprop 'cons   '|Led|)
+(remprop 'append 'format)
+(remprop 'cons   'format)
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/obey.lisp.pamphlet b/src/interp/obey.lisp.pamphlet
new file mode 100644
index 00000000..486e08f6
--- /dev/null
+++ b/src/interp/obey.lisp.pamphlet
@@ -0,0 +1,86 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp obey.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "VMLISP")
+
+#+ (and :lucid :unix)
+(defun OBEY (S)
+   (system:run-aix-program (make-absolute-filename "/lib/obey")
+             :arguments	(list "-c" S)))
+
+#+ (and :lucid :unix)
+(defun makedir (fname)
+  (system:run-aix-program "mkdir" :arguments (list fname)))
+
+#+ (and :lucid :unix)
+(defun delete-directory (dirname)
+   (system:run-aix-program "rm" :arguments (list "-r" dirname)))
+
+#+ (and :lucid :unix)
+(defun move-file (namestring1 namestring2)
+  (system:run-aix-program "mv" :arguments (list namestring1 namestring2)))
+
+#+ (and :lucid :unix)
+(defun copy-lib-directory (name1 name2)
+   (vmlisp::makedir name2)
+   (system:run-aix-program "sh" :arguments
+			(list "-c" (concat "cp " name1 "/* " name2))))
+
+#+ (and :lucid :unix)
+(defun copy-file (namestring1 namestring2)
+  (system:run-aix-program "cp" :arguments (list namestring1 namestring2)))
+
+(setq |$algebraOutputStream| *terminal-io*)
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/osyscmd.boot.pamphlet b/src/interp/osyscmd.boot.pamphlet
new file mode 100644
index 00000000..c1afede2
--- /dev/null
+++ b/src/interp/osyscmd.boot.pamphlet
@@ -0,0 +1,75 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp osyscmd.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+
+InterpExecuteSpadSystemCommand string ==
+  CATCH($intCoerceFailure,
+    CATCH($intSpadReader, ExecuteInterpSystemCommand string) )
+ 
+ExecuteInterpSystemCommand string ==
+   string := intProcessSynonyms(string)
+   $currentLine:local:=string
+   string:=SUBSTRING(string,1,nil)
+   string = '"" => nil
+   doSystemCommand string
+
+--------------------> NEW DEFINITION (see i-syscmd.boot.pamphlet)
+parseFromString(s) ==
+   s := next(function ncloopParse,
+        next(function lineoftoks,incString s))
+   StreamNull s => nil
+   pf2Sex macroExpanded first rest first s
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/package.boot.pamphlet b/src/interp/package.boot.pamphlet
new file mode 100644
index 00000000..f97f86ac
--- /dev/null
+++ b/src/interp/package.boot.pamphlet
@@ -0,0 +1,300 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/package.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+isPackageFunction() ==
+  -- called by compile/putInLocalDomainReferences
+--+
+  nil
+ 
+processFunctorOrPackage(form,signature,data,localParList,m,e) ==
+--+
+  processFunctor(form,signature,data,localParList,e)
+ 
+processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
+  $GENNO: local:= 0 --for GENVAR()
+  $catsig: local
+               --used in ProcessCond
+  $maximalViews: local
+                      --read by ProcessCond
+  $ResetItems: local
+       --stores those items that get SETQed, and may need re-processing
+  $catvecList: local:= [$domainShell]
+  $catNames: local:= ["$"]
+--PRINT $definition
+--PRINT ($catsig,:argssig)
+--PRETTYPRINT code
+  catvec:= $domainShell --from compDefineFunctor
+  $getDomainCode:= optFunctorBody $getDomainCode
+      --the purpose of this is so ProcessCond recognises such items
+  code:= PackageDescendCode(code,true,nil)
+  if delete(nil,locals) then code:=[:code,:(setPackageCode locals)] where
+      setPackageCode locals ==
+          locals':=[[u,:i] for u in locals for i in 0.. | u]
+          locals'' :=[]
+          while locals' repeat
+            for v in locals' repeat
+              [u,:i]:=v
+              if and/[EQ(v,v') or not subTree(u,CAR v') for v' in locals']
+              then
+                locals'':=[v,:locals'']
+                locals':=delete(v,locals')
+          precomp:=code:=[]
+          for elem in locals'' repeat
+            [u,:i]:=elem
+            if ATOM u then u':=u
+            else
+              u':=opt(u,precomp) where
+                  opt(u,alist) ==
+                    ATOM u => u
+                    for v in u repeat
+                      if (a:=ASSOC(v,alist)) then
+                        [.,:i]:=a
+                        u:=replace(v,[($QuickCode=>'QREFELT;'ELT),"$",i],u) where
+                           replace(old,new,l) ==
+                             l isnt [h,:t] => l
+                             h = old => [new,:t]
+                             [h,:replace(old,new,t)]
+                      v':=opt(v,alist)
+                      EQ(v,v') => nil
+                      u:=replace(v,v',u)
+                    u
+              precomp:=[elem,:precomp]
+            code:=[[($QuickCode=>'QSETREFV;'SETELT),"$",i,u'],:code]
+          nreverse code
+  code:=
+    ["PROGN",:$getDomainCode,["LET","$",["GETREFV",#locals]],
+                           --It is important to place this code here,
+                           --after $ is set up
+                   --slam functor with shell
+                   --the order of steps in this PROGN are critical
+      addToSlam($definition,"$"),code,[
+        "SETELT","$",0, mkDomainConstructor $definition],:
+-- If we call addMutableArg this early, then recurise calls to this domain
+-- (e.g. while testing predicates) will generate new domains => trouble
+--      "SETELT","$",0,addMutableArg mkDomainConstructor $definition],:
+          [["SETELT","$",position(name,locals),name]
+            for name in $ResetItems | MEMQ(name,locals)],
+             :[($mutableDomain => '(RPLACD (LASTNODE (ELT $ 0))
+                                           (LIST (GENSYM)));[]) ],
+              "$"]
+  for u in $getDomainCode repeat
+    u is ['LET,.,u'] and u' is ['getDomainView,.,u''] =>
+      $packagesUsed:=union(CategoriesFromGDC u'',$packagesUsed)
+  $packagesUsed:=union($functorLocalParameters,$packagesUsed)
+  $getDomainCode:= nil
+     --if we didn't kill this, DEFINE would insert it in the wrong place
+  optFunctorBody code
+ 
+subTree(u,v) ==
+  v=u => true
+  ATOM v => nil
+  or/[subTree(u,v') for v' in v]
+ 
+mkList u ==
+  u => ["LIST",:u]
+  nil
+ 
+setPackageLocals(pac,locs) ==
+  for var in locs for i in 0.. | var^=nil repeat pac.i:= var
+ 
+PackageDescendCode(code,flag,viewAssoc) ==
+               --flag is true if we are walking down code always executed
+               --nil if we are in conditional code
+  code=nil => nil
+  code="noBranch" => nil
+  code is ["add",base,:codelist] =>
+    systemError '"packages may not have add clauses"
+  code is ["PROGN",:codelist] =>
+    ["PROGN",:
+      [v for u in codelist | (v:= PackageDescendCode(u,flag,viewAssoc))^=nil]]
+  code is ["COND",:condlist] =>
+    c:=
+      ["COND",:
+        [[u2:= ProcessCond(first u,viewAssoc),:
+         (if null u2
+             then nil
+             else
+              [PackageDescendCode(v,flag and TruthP u2,
+                if first u is ["HasCategory",dom,cat]
+                   then [[dom,:cat],:viewAssoc]
+                   else viewAssoc) for v in rest u])] for u in condlist]]
+    TruthP CAADR c => ["PROGN",:CDADR c]
+    c
+  code is ["LET",name,body,:.] =>
+    if not MEMQ(name,$ResetItems) then $ResetItems:= [name,:$ResetItems]
+    if body is [a,:.] and isFunctor a
+      then $packagesUsed:=[body,:$packagesUsed]
+    code
+  code is ["CodeDefine",sig,implem] =>
+             --Generated by doIt in COMPILER BOOT
+    dom:= "$"
+    dom:=
+      u:= LASSOC(dom,viewAssoc) => ["getDomainView",dom,u]
+      dom
+    body:= ["CONS",implem,dom]
+    SetFunctionSlots(sig,body,flag,"original")
+  code is [":",:.] => (RPLACA(code,"LIST"); RPLACD(code,NIL))
+      --Yes, I know that's a hack, but how else do you kill a line?
+  code is ["LIST",:.] => nil
+  code is ["MDEF",:.] => nil
+  code is ["devaluate",:.] => nil
+  code is ["call",:.] => code
+  code is ["SETELT",:.] => code
+  code is ["QSETREFV",:.] => code
+  stackWarning ["unknown Package code ",code]
+  code
+ 
+mkOperatorEntry(domainOrPackage,opSig is [op,sig,:flag],pred,count) ==
+  domainOrPackage^="domain" =>
+    [opSig,pred,["PAC","$",name]] where
+      name() == encodeFunctionName(op,domainOrPackage,sig,":",count)
+  null flag => [opSig,pred,["ELT","$",count]]
+  first flag="constant" => [[op,sig],pred,["CONST","$",count]]
+  systemError ["unknown variable mode: ",flag]
+ 
+optPackageCall(x,["PAC",packageVariableOrForm,functionName],arglist) ==
+  RPLACA(x,functionName)
+  RPLACD(x,[:arglist,packageVariableOrForm])
+  x
+ 
+--% Code for encoding function names inside package or domain
+ 
+encodeFunctionName(fun,package is [packageName,:arglist],signature,sep,count)
+   ==
+    signature':= substitute("$",package,signature)
+    reducedSig:= mkRepititionAssoc [:rest signature',first signature']
+    encodedSig:=
+      ("STRCONC"/[encodedPair for [n,:x] in reducedSig]) where
+        encodedPair() ==
+          n=1 => encodeItem x
+          STRCONC(STRINGIMAGE n,encodeItem x)
+    encodedName:= INTERNL(getAbbreviation(packageName,#arglist),";",
+        encodeItem fun,";",encodedSig, sep,STRINGIMAGE count)
+    if $LISPLIB then
+      $lisplibSignatureAlist:=
+        [[encodedName,:signature'],:$lisplibSignatureAlist]
+    encodedName
+ 
+splitEncodedFunctionName(encodedName, sep) ==
+    -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL
+    -- sep0 is the separator used in "encodeFunctionName".
+    sep0 := '";"
+    if not STRINGP encodedName then
+        encodedName := STRINGIMAGE encodedName
+    null (p1 := STRPOS(sep0, encodedName, 0,    '"*")) => nil
+    null (p2 := STRPOS(sep0, encodedName, p1+1, '"*")) => 'inner
+--  This is picked up in compile for inner functions in partial compilation
+    null (p3 := STRPOS(sep,  encodedName, p2+1, '"*")) => nil
+    s1 := SUBSTRING(encodedName, 0,    p1)
+    s2 := SUBSTRING(encodedName, p1+1, p2-p1-1)
+    s3 := SUBSTRING(encodedName, p2+1, p3-p2-1)
+    s4 := SUBSTRING(encodedName, p3+1, nil)
+    [s1, s2, s3, s4]
+ 
+mkRepititionAssoc l ==
+  mkRepfun(l,1) where
+    mkRepfun(l,n) ==
+      null l => nil
+      l is [x] => [[n,:x]]
+      l is [x, =x,:l'] => mkRepfun(rest l,n+1)
+      [[n,:first l],:mkRepfun(rest l,1)]
+ 
+encodeItem x ==
+  x is [op,:argl] => getCaps op
+  IDENTP x => PNAME x
+  STRINGIMAGE x
+ 
+getCaps x ==
+  s:= STRINGIMAGE x
+  clist:= [c for i in 0..MAXINDEX s | UPPER_-CASE_-P (c:= s.i)]
+  null clist => '"__"
+  "STRCONC"/[first clist,:[L_-CASE u for u in rest clist]]
+ 
+--% abbreviation code
+ 
+getAbbreviation(name,c) ==
+  --returns abbreviation of name with c arguments
+  x := constructor? name
+  X := ASSQ(x,$abbreviationTable) =>
+    N:= ASSQ(name,rest X) =>
+      C:= ASSQ(c,rest N) => rest C --already there
+      newAbbreviation:= mkAbbrev(X,x)
+      RPLAC(rest N,[[c,:newAbbreviation],:rest N])
+      newAbbreviation
+    newAbbreviation:= mkAbbrev(X,x)
+    RPLAC(rest X,[[name,[c,:newAbbreviation]],:rest X])
+    newAbbreviation
+  $abbreviationTable:= [[x,[name,[c,:x]]],:$abbreviationTable]
+  x
+ 
+mkAbbrev(X,x) == addSuffix(alistSize rest X,x)
+ 
+alistSize c ==
+  count(c,1) where
+    count(x,level) ==
+      level=2 => #x
+      null x => 0
+      count(CDAR x,level+1)+count(rest x,level)
+ 
+addSuffix(n,u) ==
+  ALPHA_-CHAR_-P (s:= STRINGIMAGE u).(MAXINDEX s) => INTERN STRCONC(s,STRINGIMAGE n)
+  INTERNL STRCONC(s,STRINGIMAGE ";",STRINGIMAGE n)
+ 
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/packtran.boot.pamphlet b/src/interp/packtran.boot.pamphlet
new file mode 100644
index 00000000..b1814ddf
--- /dev/null
+++ b/src/interp/packtran.boot.pamphlet
@@ -0,0 +1,86 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp packtran.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- The $useNewParser flag controls which parser will be used in the interpreter
+-- If nil then the old parser is used, otherwise Bill Burge's parser is used
+$useNewParser := true
+
+rePackageTran(sex, package) ==
+  _*PACKAGE_* : fluid := FIND_-PACKAGE STRING package
+  packageTran sex
+
+packageTran sex ==
+-- destructively translate all the symbols in the given s-expression to the 
+-- current package
+  SYMBOLP sex =>
+    EQ(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex
+    INTERN STRING sex
+  CONSP sex =>
+    RPLACA(sex, packageTran CAR sex)
+    RPLACD(sex, packageTran CDR sex)
+    sex
+  sex
+
+zeroOneTran sex ==
+-- destructively translate the symbols |0| and |1| to their 
+-- integer counterparts
+  NSUBST("$EmptyMode", "?", sex)
+  sex
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/parini.boot.pamphlet b/src/interp/parini.boot.pamphlet
new file mode 100644
index 00000000..06ea15c1
--- /dev/null
+++ b/src/interp/parini.boot.pamphlet
@@ -0,0 +1,206 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp parini.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+SPACE       := QENUM('"    ", 0)
+ESCAPE      := QENUM('"__  ", 0)
+STRING_CHAR := QENUM('"_"  ", 0)
+PLUSCOMMENT := QENUM('"+   ", 0)
+MINUSCOMMENT:= QENUM('"-   ", 0)
+RADIX_CHAR  := QENUM('"r   ", 0)
+DOT         := QENUM('".   ", 0)
+EXPONENT1   := QENUM('"E   ", 0)
+EXPONENT2   := QENUM('"e   ", 0)
+CLOSEPAREN  := QENUM('")   ", 0)
+CLOSEANGLE  := QENUM('">   ", 0)
+QUESTION    := QENUM('"?   ",0)
+
+scanKeyWords := [ _
+           ['"add",      "ADD" ],_
+           ['"and",      "AND" ],_
+           ['"break",   "BREAK" ],_
+           ['"by",        "BY" ],_
+           ['"case",     "CASE" ],_
+           ['"default",  "DEFAULT" ],_
+           ['"define",  "DEFN" ],_
+           ['"do",        "DO"],_
+           ['"else",    "ELSE" ],_
+           ['"exit",    "EXIT" ],_
+           ['"export","EXPORT" ],_
+           ['"for",      "FOR" ],_
+           ['"free",    "FREE" ],_
+           ['"from",    "FROM" ],_
+           ['"has",      "HAS" ],_
+           ['"if",       "IF" ],_
+           ['"import", "IMPORT" ],_
+           ['"in", "IN" ],_
+           ['"inline", "INLINE" ],_
+           ['"is", "IS" ],_
+           ['"isnt", "ISNT" ],_
+           ['"iterate", "ITERATE"],_
+           ['"local", "local" ],_
+           ['"macro", "MACRO" ],_
+           ['"mod", "MOD" ],_
+           ['"or", "OR" ],_
+           ['"pretend","PRETEND" ],_
+           ['"quo","QUO" ],_
+           ['"rem","REM" ],_
+           ['"repeat","REPEAT" ],_
+           ['"return","RETURN" ],_
+           ['"rule","RULE" ],_
+           ['"then","THEN" ],_
+           ['"where","WHERE" ],_
+           ['"while","WHILE" ],_
+           ['"with","WITH" ],_
+           ['"|","BAR"],_
+           ['".","DOT" ],_
+           ['"::","COERCE" ],_
+           ['":","COLON" ],_
+           ['":-","COLONDASH" ],_
+           ['"@","AT" ],_
+           ['"@@","ATAT" ],_
+           ['",","COMMA" ],_
+           ['";","SEMICOLON" ],_
+           ['"**","POWER" ],_
+           ['"*","TIMES" ],_
+           ['"+","PLUS" ],_
+           ['"-","MINUS" ],_
+           ['"<","LT" ],_
+           ['">","GT" ],_
+           ['"<=","LE" ],_
+           ['">=","GE" ],_
+           ['"=", "EQUAL"],_
+           ['"~=","NOTEQUAL" ],_
+           ['"~","~" ],_
+           ['"^","CARAT" ],_
+           ['"..","SEG" ],_
+           ['"#","#" ],_
+           ['"&","AMPERSAND" ],_
+           ['"$","$" ],_
+           ['"/","SLASH" ],_
+           ['"\","BACKSLASH" ],_
+           ['"//","SLASHSLASH" ],_
+           ['"\\","BACKSLASHBACKSLASH" ],_
+           ['"/\","SLASHBACKSLASH" ],_
+           ['"\/","BACKSLASHSLASH" ],_
+           ['"=>","EXIT" ],_
+           ['":=","BECOMES" ],_
+           ['"==","DEF" ],_
+           ['"==>","MDEF" ],_
+           ['"->","ARROW" ],_
+           ['"<-","LARROW" ],_
+           ['"+->","GIVES" ],_
+           ['"(","(" ],_
+           ['")",")" ],_
+           ['"(|","(|" ],_
+           ['"|)","|)" ],_
+           ['"[","[" ],_
+           ['"]","]" ],_
+           ['"[__]","[]" ],_
+           ['"{","{" ],_
+           ['"}","}" ],_
+           ['"{__}","{}" ],_
+           ['"[|","[|" ],_
+           ['"|]","|]" ],_
+           ['"[|__|]","[||]" ],_
+           ['"{|","{|" ],_
+           ['"|}","|}" ],_
+           ['"{|__|}","{||}" ],_
+           ['"<<","OANGLE" ],_
+           ['">>","CANGLE" ],_
+           ['"'", "'" ],_
+           ['"`", "BACKQUOTE" ]_
+                          ]
+
+scanKeyTable:=scanKeyTableCons()
+
+scanDict:=scanDictCons()
+
+scanPun:=scanPunCons()
+
+--for i in ["COLON","MINUS"] repeat
+--   MAKEPROP(i,'PREGENERIC,'TRUE)
+
+for i in   [ _
+   ["EQUAL"    ,"="], _
+   ["TIMES"    ,"*"], _
+   ["HAS"      ,"has"], _
+   ["CASE"     ,"case"], _
+   ["REM"      ,"rem"], _
+   ["MOD"      ,"mod"], _
+   ["QUO"      ,"quo"], _
+   ["SLASH"    ,"/"], _
+   ["BACKSLASH","\"], _
+   ["SLASHSLASH"    ,"//"], _
+   ["BACKSLASHBACKSLASH","\\"], _
+   ["SLASHBACKSLASH"    ,"/\"], _
+   ["BACKSLASHSLASH","\/"], _
+   ["POWER"    ,"**"], _
+   ["CARAT"    ,"^"], _
+   ["PLUS"     ,"+"], _
+   ["MINUS"    ,"-"], _
+   ["LT"       ,"<"], _
+   ["GT"       ,">"], _
+   ["OANGLE"       ,"<<"], _
+   ["CANGLE"       ,">>"], _
+   ["LE"       ,"<="], _
+   ["GE"       ,">="], _
+   ["NOTEQUAL" ,"~="], _
+   ["BY"       ,"by"], _
+   ["ARROW"       ,"->"], _
+   ["LARROW"       ,"<-"], _
+   ["BAR"       ,"|"], _
+   ["SEG"       ,".."] _
+    ] repeat MAKEPROP(CAR i,'INFGENERIC,CADR i)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/parse.boot.pamphlet b/src/interp/parse.boot.pamphlet
new file mode 100644
index 00000000..0af415c6
--- /dev/null
+++ b/src/interp/parse.boot.pamphlet
@@ -0,0 +1,571 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/parse.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{parseTransform}
+This is the top-level function in this file. 
+
+When parsing spad code we walk an source code expression such as
+
+[[P ==> PositiveInteger]]
+
+This gets translated by [[|postTransform|]]\cite{1} into
+
+[[(MDEF P NIL NIL (|PositiveInteger|))]]
+
+[[|parseTranform|]] is called with this expression. The [[%]] symbol,
+which represents the current domain, is replaced with the [[$]] symbol
+internally. This hack was introduced because the Aldor compiler wanted
+to use [[%]] for the [[current domain]]. The Spad compiler used [[$]].
+In order not to have to change this everywhere we do a subsitution here.
+<<parseTransform>>=
+parseTransform x ==
+  $defOp: local:= nil
+  x := substitute('$,'%,x) -- for new compiler compatibility
+  parseTran x
+
+@
+
+\section{parseTran}
+[[|parseTran|]] sees an expression such as
+
+[[(MDEF P NIL NIL (|PositiveInteger|))]]
+
+It walks the
+expression, which is a list, item by item (note the tail recursive
+call in this function). In general, we are converting certain 
+source-level constructs into internal constructs. Note the subtle
+way that functions get called in this file. The information about
+what function to call is stored on the property list of the symbol.
+
+For example, given the form: [[(|has| S (|OrderedSet|))]]
+the symbol [[|has|]] occurs in the car of the list. [[|parseTran|]]
+assigns [[$op]] to be [[|has|]] and [[argl]] to be the list
+[[(S (|OrderedSet|))]]. Next, a local function [[g]], which checks
+for the compile-time elts, returns [[$op]] unchanged. The variable
+[[u]] is set to [[|has|]].
+
+Since [[|has|]] is an atom we do 
+[[(GET '|has| '|parseTran|)]] which returns [[|parseHas|]]
+because the symbol [[|has|]] contains the association 
+[[|parseTran| |parseHas|]] on it's symbol property list.
+You can see this by calling [[(symbol-plist '|has|)]].
+
+This ends up calling [[(|parseHas| '(S (|OrderedSet|)))]].
+
+The [[|parseTran|]] function walks the entire s-expression
+calling special parsers for various special forms in the input.
+This does things like reverse tests so that [[(if (not x) a b)]]
+becomes [[(if x b a)]], etc.
+
+<<parseTran>>= 
+parseTran x ==
+  $op: local
+  atom x => parseAtom x
+  [$op,:argl]:= x
+  u := g($op) where g op == (op is ["elt",op,x] => g x; op)
+  u="construct" =>
+    r:= parseConstruct argl
+    $op is ["elt",:.] => [parseTran $op,:rest r]
+    r
+  SYMBOLP u and (fn:= GETL(u,'parseTran)) => FUNCALL(fn,argl)
+  [parseTran $op,:parseTranList argl]
+ 
+@ 
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Transformation of Parser Output
+ 
+<<parseTransform>>
+<<parseTran>>
+
+parseAtom x ==
+ -- next line for compatibility with new compiler
+  x = "break" => parseLeave ["$NoValue"]
+  x
+ 
+parseTranList l ==
+  atom l => parseTran l
+  [parseTran first l,:parseTranList rest l]
+ 
+parseConstruct u ==
+  $insideConstructIfTrue: local:= true
+  l:= parseTranList u
+  ["construct",:l]
+ 
+parseUpArrow u ==  parseTran ["**",:u]
+ 
+parseLeftArrow u == parseTran ["LET",:u]
+ 
+parseIs [a,b] == ["is",parseTran a,transIs parseTran b]
+ 
+parseIsnt [a,b] == ["isnt",parseTran a,transIs parseTran b]
+ 
+transIs u ==
+  isListConstructor u => ["construct",:transIs1 u]
+  u
+ 
+isListConstructor u == u is [op,:.] and op in '(construct append cons)
+ 
+transIs1 u ==
+  u is ["construct",:l] => [transIs x for x in l]
+  u is ["append",x,y] =>
+    h:= [":",transIs x]
+    (v:= transIs1 y) is [":",z] => [h,z]
+    v="nil" => first rest h
+    atom v => [h,[":",v]]
+    [h,:v]
+  u is ["cons",x,y] =>
+    h:= transIs x
+    (v:= transIs1 y) is [":",z] => [h,z]
+    v="nil" => [h]
+    atom v => [h,[":",v]]
+    [h,:v]
+  u
+ 
+parseLET [x,y] ==
+  p := ["LET",parseTran x,parseTranCheckForRecord(y,opOf x)]
+  opOf x = "cons" => ["LET",transIs p.1,p.2]
+  p
+ 
+parseLETD [x,y] == ["LETD",parseTran x,parseTran parseType y]
+ 
+parseColon u ==
+  u is [x] => [":",parseTran x]
+  u is [x,typ] =>
+    $InteractiveMode =>
+      $insideConstructIfTrue=true => ["TAG",parseTran x,parseTran typ]
+      [":",parseTran x,parseTran parseType typ]
+    [":",parseTran x,parseTran typ]
+ 
+parseBigelt [typ,consForm] ==
+  [["elt",typ,"makeRecord"],:transUnCons consForm]
+ 
+transUnCons u ==
+  atom u => systemErrorHere '"transUnCons"
+  u is ["APPEND",x,y] =>
+    null y => x
+    systemErrorHere '"transUnCons"
+  u is ["CONS",x,y] =>
+    atom y => [x,:y]
+    [x,:transUnCons y]
+ 
+parseCoerce [x,typ] ==
+  $InteractiveMode => ["::",parseTran x,parseTran parseType typ]
+  ["::",parseTran x,parseTran typ]
+ 
+parseAtSign [x,typ] ==
+  $InteractiveMode => ["@",parseTran x,parseTran parseType typ]
+  ["@",parseTran x,parseTran typ]
+ 
+parsePretend [x,typ] ==
+  $InteractiveMode => ["pretend",parseTran x,parseTran parseType typ]
+  ["pretend",parseTran x,parseTran typ]
+ 
+parseType x ==
+  x := substitute($EmptyMode,$quadSymbol,x)
+  x is ["typeOf",val] => ["typeOf",parseTran val]
+  $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x
+  x
+ 
+parseTypeEvaluate form ==
+  form is [op,:argl] =>
+    newType? op => form
+    $op: local:= op
+    op = "Mapping" =>
+      [op,:[parseTypeEvaluate a for a in argl]]
+    op = "Union" =>
+      isTaggedUnion form =>
+        [op,:[['_:,sel,parseTypeEvaluate type] for
+          ['_:,sel,type] in argl]]
+      [op,:[parseTypeEvaluate a for a in argl]]
+    op = 'Record =>
+      [op,:[['_:,sel,parseTypeEvaluate type] for ['_:,sel,type] in argl]]
+    cmm :=
+      fn := constructor? op =>
+        p := pathname [fn,$spadLibFT,'"*"] =>
+          isExistingFile p => getConstructorModemap(abbreviation? fn)
+          nil
+      nil
+    cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)]
+    throwKeyedMsg("S2IL0015",[op])
+  form
+ 
+parseTypeEvaluateArgs(argl,argml) ==
+  [argVal for arg in argl for md in argml for i in 1..] where argVal ==
+      isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg
+      arg
+ 
+ 
+parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md])
+ 
+specialModeTran form ==
+  form is [op,:argl] =>
+    not ATOM op => form --added 10/5/84 by SCM
+    (s0:= (sop:= PNAME op).0) = "*" =>
+      n:= #sop
+      n=1=> form
+      argKey:= sop.1
+      numArgs:= #argl - (argKey="1" => 1; 0)
+      zeroOrOne:= argKey="0" or argKey="1"
+      isDmp :=
+        numArgs < 10 =>
+          n=6 and ('"DMP"=SUBSTRING(sop,3,3)) and zeroOrOne
+        true =>
+          n=7 and ('"DMP"=SUBSTRING(sop,4,3)) and zeroOrOne
+      isDmp =>
+        if argKey="0" then
+          extraDomain:= $EmptyMode
+          vl:= argl
+         else
+          [:vl,extraDomain] := argl
+        ["DistributedMultivariatePolynomial",["construct",:vl],
+            specialModeTran extraDomain]
+      n=4 and (s3:= sop.3) = "M" and zeroOrOne =>
+        specialModeTran
+          extraDomain:= (argKey="0" => [$EmptyMode]; nil)
+          (n:= PARSE_-INTEGER PNAME sop.2)=1 =>
+            ["SquareMatrix",:argl,:extraDomain]
+          n=2 => ["RectangularMatrix",:argl,:extraDomain]
+          form
+      isUpOrMp :=
+        numArgs < 10 =>
+          n=4 and (s3:= sop.3) = "P" and zeroOrOne or
+            n=5 and (s3:= sop.3)="R" and sop.4="F" and zeroOrOne
+        true =>
+          n=5 and (s3:= sop.4) = "P" and zeroOrOne or
+            n=6 and (s3:= sop.4)="R" and sop.5="F" and zeroOrOne
+      isUpOrMp =>
+        polyForm:=
+          domainPart:= (argKey="0" => $EmptyMode; last argl)
+          argPart:= (argKey="0" => argl; drop(-1,argl))
+          numArgs < 10 and (n:= PARSE_-INTEGER PNAME sop.2)=1
+            => ["UP",:argPart,domainPart]
+          ["MP",["construct",:argPart],domainPart]
+        specialModeTran
+          s3 = "R" => [$QuotientField,polyForm]
+          polyForm
+      [first form,:[specialModeTran x for x in rest form]]
+    [first form,:[specialModeTran x for x in rest form]]
+  form
+ 
+parseHas [x,y] ==
+  if $InteractiveMode then
+    x:=
+      get(x,'value,$CategoryFrame) is [D,m,.]
+        and m in '((Mode) (Domain) (SubDomain (Domain))) => D
+      parseType x
+  mkand [["has",x,u] for u in fn y] where
+    mkand x ==
+      x is [a] => a
+      ["and",:x]
+    fn y ==
+      if $InteractiveMode then y:= unabbrevAndLoad y
+      y is [":" ,op,["Mapping",:map]] =>
+         op:= (STRINGP op => INTERN op; op)
+         [["SIGNATURE",op,map]]
+      y is ["Join",:u] => "append"/[fn z for z in u]
+      y is ["CATEGORY",:u] => "append"/[fn z for z in u]
+      kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND)
+      kk = "domain" or kk = "category" => [makeNonAtomic y]
+      y is ["ATTRIBUTE",:.] => [y]
+      y is ["SIGNATURE",:.] => [y]
+      $InteractiveMode => parseHasRhs y
+      [["ATTRIBUTE",y]]
+ 
+parseHasRhs u ==   --$InteractiveMode = true
+  get(u,'value,$CategoryFrame) is [D,m,.]
+    and m in '((Mode) (Domain) (SubDomain (Domain))) => m
+  y := abbreviation? u =>
+    loadIfNecessary y => [unabbrevAndLoad y]
+    [["ATTRIBUTE",u]]
+  [["ATTRIBUTE",u]]
+ 
+parseDEF [$lhs,tList,specialList,body] ==
+  setDefOp $lhs
+  ["DEF",parseLhs $lhs,parseTranList tList,parseTranList specialList,
+    parseTranCheckForRecord(body,opOf $lhs)]
+ 
+parseLhs x ==
+  atom x => parseTran x
+  atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]]
+  parseTran x
+ 
+parseMDEF [$lhs,tList,specialList,body] ==
+  ["MDEF",parseTran $lhs,parseTranList tList,parseTranList specialList,
+    parseTranCheckForRecord(body,opOf $lhs)]
+ 
+parseTranCheckForRecord(x,op) ==
+  (x:= parseTran x) is ["Record",:l] =>
+    or/[y for y in l | y isnt [":",.,.]] =>
+      postError ['"   Constructor",:bright x,'"has missing label"]
+    x
+  x
+ 
+parseCases [expr,ifClause] ==
+  casefn(expr,ifClause) where
+    casefn(x,ifExpr) ==
+      ifExpr="noBranch" => ["ifClauseError",x]
+      ifExpr is ["IF",a,b,c] => ["IF",parseTran a,parseTran b,casefn(x,c)]
+      postError ['"   CASES format error: cases ",x," of ",ifExpr]
+ 
+parseCategory x ==
+  l:= parseTranList parseDropAssertions x
+  key:=
+    CONTAINED("$",l) => "domain"
+    "package"
+  ["CATEGORY",key,:l]
+ 
+parseDropAssertions x ==
+--note: the COPY of this list is necessary-- do not replace by RPLACing version
+  x is [y,:r] =>
+    y is ["IF","asserted",:.] => parseDropAssertions r
+    [y,:parseDropAssertions r]
+  x
+ 
+parseGreaterThan [x,y] ==
+  [substitute("<",">",$op),parseTran y,parseTran x]
+ 
+parseGreaterEqual u == parseTran ["not",[substitute("<",">=",$op),:u]]
+ 
+parseLessEqual u == parseTran ["not",[substitute(">","<=",$op),:u]]
+ 
+parseNotEqual u == parseTran ["not",[substitute("=","^=",$op),:u]]
+ 
+parseDollarGreaterThan [x,y] ==
+  [substitute("$<","$>",$op),parseTran y,parseTran x]
+ 
+parseDollarGreaterEqual u ==
+  parseTran ["not",[substitute("$<","$>=",$op),:u]]
+ 
+parseDollarLessEqual u ==
+  parseTran ["not",[substitute("$>","$<=",$op),:u]]
+ 
+parseDollarNotEqual u ==
+  parseTran ["not",[substitute("$=","$^=",$op),:u]]
+ 
+parseAnd u ==
+  $InteractiveMode => ["and",:parseTranList u]
+  null u => "true"
+  null rest u => first u
+  parseIf [parseTran first u,parseAnd rest u,"false"]
+ 
+parseOr u ==
+  $InteractiveMode => ["or",:parseTranList u]
+  null u => "false"
+  null rest u => first u
+  (x:= parseTran first u) is ["not",y] => parseIf [y,parseOr rest u,"true"]
+  true => parseIf [x,"true",parseOr rest u]
+ 
+parseNot u ==
+  $InteractiveMode => ["not",parseTran first u]
+  parseTran ["IF",first u,:'(false true)]
+ 
+parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]]
+ 
+parseImplies [a,b] == parseIf [a,b,"true"]
+ 
+parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b]
+ 
+parseExit [a,:b] ==
+  --  note: I wanted to convert 1s to 0s here to facilitate indexing in
+  --   comp code; unfortunately, parseTran-ning is sometimes done more
+  --   than once so that the count can be decremented more than once
+  a:= parseTran a
+  b:= parseTran b
+  b =>
+    null INTEGERP a =>
+      (MOAN('"first arg ",a,'" for exit must be integer"); ["exit",1,a])
+    ["exit",a,:b]
+  ["exit",1,a]
+ 
+parseLeave [a,:b] ==
+  a:= parseTran a
+  b:= parseTran b
+  b =>
+    null INTEGERP a =>
+      (MOAN('"first arg ",a,'" for 'leave' must be integer"); ["leave",1,a])
+    ["leave",a,:b]
+  ["leave",1,a]
+ 
+parseReturn [a,:b] ==
+  a:= parseTran a
+  b:= parseTran b
+  b =>
+    (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b])
+  ["return",1,a]
+ 
+parseJoin l ==
+  ["Join",:fn parseTranList l] where
+    fn l ==
+      null l => nil
+      l is [["Join",:x],:y] => [:x,:fn y]
+      [first l,:fn rest l]
+ 
+parseInBy [i,n,inc] ==
+  (u:= parseIn [i,n]) isnt ["STEP",i,a,j,:r] =>
+    postError ["   You cannot use",:bright '"by",
+      '"except for an explicitly indexed sequence."]
+  inc:= parseTran inc
+  ["STEP",i,a,parseTran inc,:r]
+ 
+parseSegment p ==
+  p is [a,b] =>
+    b => ["SEGMENT",parseTran a, parseTran b]
+    ["SEGMENT",parseTran a]
+  ["SEGMENT",:p]
+ 
+parseIn [i,n] ==
+  i:= parseTran i
+  n:= parseTran n
+  n is ["SEGMENT",a] => ["STEP",i,a,1]
+  n is ["reverse",["SEGMENT",a]] =>
+    postError ['"  You cannot reverse an infinite sequence."]
+  n is ["SEGMENT",a,b] => (b => ["STEP",i,a,1,b]; ["STEP",i,a,1])
+  n is ["reverse",["SEGMENT",a,b]] =>
+    b => ["STEP",i,b,-1,a]
+    postError ['"  You cannot reverse an infinite sequence."]
+  n is ["tails",s] => ["ON",i,s]
+  ["IN",i,n]
+ 
+parseIf t ==
+  t isnt [p,a,b] => t
+  ifTran(parseTran p,parseTran a,parseTran b) where
+    ifTran(p,a,b) ==
+      null($InteractiveMode) and p="true"  => a
+      null($InteractiveMode) and p="false"  => b
+      p is ["not",p'] => ifTran(p',b,a)
+      p is ["IF",p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
+      p is ["SEQ",:l,["exit",1,p']] =>
+        ["SEQ",:l,["exit",1,ifTran(p',incExitLevel a,incExitLevel b)]]
+         --this assumes that l has no exits
+      a is ["IF", =p,a',.] => ["IF",p,a',b]
+      b is ["IF", =p,.,b'] => ["IF",p,a,b']
+      makeSimplePredicateOrNil p is ["SEQ",:s,["exit",1,val]] =>
+        parseTran ["SEQ",:s,["exit",1,incExitLevel ["IF",val,a,b]]]
+      ["IF",p,a,b]
+ 
+makeSimplePredicateOrNil p ==
+  isSimple p => nil
+  u:= isAlmostSimple p => u
+  true => wrapSEQExit [["LET",g:= GENSYM(),p],g]
+ 
+parseWhere l == ["where",:mapInto(l, function parseTran)]
+ 
+ 
+parseSeq l ==
+  not l is [:.,["exit",:.]] =>
+    postError ['"   Invalid ending to block: ",last l]
+  transSeq mapInto(l,function parseTran)
+ 
+transSeq l ==
+  null l => nil
+  null rest l => decExitLevel first l
+  [item,:tail]:= l
+  item is ["SEQ",:l,["exit",1,["IF",p,["exit", =2,q],"noBranch"]]] and
+    (and/[x is ["LET",:.] for x in l]) =>
+      ["SEQ",:[decExitLevel x for x in l],["exit",1,["IF",decExitLevel p,
+        decExitLevel q,transSeq tail]]]
+  item is ["IF",a,["exit",1,b],"noBranch"] =>
+    ["IF",decExitLevel a,decExitLevel b,transSeq tail]
+  item is ["IF",a,"noBranch",["exit",1,b]] =>
+    ["IF",decExitLevel a,transSeq tail,decExitLevel b]
+  (y:= transSeq tail) is ["SEQ",:s] => ["SEQ",item,:s]
+  ["SEQ",item,["exit",1,incExitLevel y]]
+ 
+transCategoryItem x ==
+  x is ["SIGNATURE",lhs,rhs] =>
+    lhs is ["LISTOF",:y] =>
+      "append" /[transCategoryItem ["SIGNATURE",z,rhs] for z in y]
+    atom lhs =>
+      if STRINGP lhs then lhs:= INTERN lhs
+      rhs is ["Mapping",:m] =>
+        m is [.,"constant"] => LIST ["SIGNATURE",lhs,[first m],"constant"]
+        LIST ["SIGNATURE",lhs,m]
+      $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc]
+      NIL
+    [op,:argl]:= lhs
+    extra:= nil
+    if rhs is ["Mapping",:m] then
+      if rest m then extra:= rest m
+                 --should only be 'constant' or 'variable'
+      rhs:= first m
+    LIST ["SIGNATURE",op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra]
+  LIST x
+ 
+superSub(name,x) ==
+  for u in x repeat y:= [:y,:u]
+  code:=
+    x is [[u]] => $quadSymbol
+    STRCONC("_(",scriptTranRow first x,scriptTran rest x,"_)")
+  [INTERNL(PNAME name,"$",code),:y]
+ 
+scriptTran x ==
+  null x => ""
+  STRCONC(";",scriptTranRow first x,scriptTran rest x)
+ 
+scriptTranRow x ==
+  null x => ""
+  STRCONC($quadSymbol,scriptTranRow1 rest x)
+ 
+scriptTranRow1 x ==
+  null x => ""
+  STRCONC(",",$quadSymbol,scriptTranRow1 rest x)
+ 
+parseVCONS l == ["VECTOR",:parseTranList l]
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet
new file mode 100644
index 00000000..54c9dbfe
--- /dev/null
+++ b/src/interp/parsing.lisp.pamphlet
@@ -0,0 +1,1088 @@
+%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/parsing.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+; NAME:    META/LISP Parser Generator and Lexical Analysis Utilities (Parsing)
+;
+; PURPOSE: This package provides routines to support the Metalanguage
+;          translator writing system.   Metalanguage is described
+;          in META/LISP, R.D. Jenks, Tech Report, IBM T.J. Watson Research Center,
+;          1969.  Familiarity with this document is assumed.
+;
+;          The parser generator itself is described in either the file
+;          MetaBoot.lisp (hand-coded version) or the file MetaMeta.lisp (machine
+;          generated from self-descriptive Meta code), both of which load themselves
+;          into package Parsing.
+
+; CONTENTS:
+;
+;       0. Current I/O Stream definition
+;
+;       1. Data structure declarations (defstructs) for parsing objects
+;
+;               A. Line Buffer
+;               B. Stack
+;               C. Token
+;               D. Reduction
+;
+;       2. Recursive descent parsing support routines
+;               A. Stacking and retrieving reductions of rules.
+;               B. Applying metagrammatical elements of a production (e.g., Star).
+;
+;       3. Routines for handling lexical scanning
+;
+;               A. Manipulating the token stack and reading tokens
+;               B. Error handling
+;               C. Constructing parsing procedures
+;               D. Managing rule sets
+;
+;       4. Tracing routines
+;
+;       5. Routines for inspecting and resetting total I/O system state
+;
+;       METALEX.LISP:  Meta file handling, auxiliary parsing actions and tokenizing
+;       METAMETA.LISP: Meta parsing
+;
+;       BOOTLEX.LISP:  Boot file handling, auxiliary parsing actions and tokenizing
+;       NEWMETA.LISP:  Boot parsing
+
+(in-package "BOOT")
+
+; 0. Current I/O Stream definition
+
+(defparameter in-stream  t "Current input stream.")
+(defparameter out-stream t "Current output stream.")
+(defparameter File-Closed nil   "Way to stop EOF tests for console input.")
+
+(defun IOStreams-Show ()
+  (format t "~&Input is coming from ~A, and output is going to ~A.~%"
+           (or (streamp in-stream) "the keyboard")
+           (or (streamp out-stream) "the screen"))
+  (format t "~:[~;The current input stream is logically closed.~%~]~%" File-Closed))
+
+(defmacro IOStreams-Set (input output) `(setq in-stream ,input out-stream ,output))
+
+(defmacro IOStreams-Clear (&optional (in t) (out t))
+  `(progn (and (streamp in-stream) (close in-stream))
+          (and (streamp out-stream) (close out-stream))
+          (setq File-Closed nil)
+          (IOStreams-Set ,in ,out)))
+
+; 1. Data structure declarations (defstructs) for parsing objects
+;
+;               A. Line Buffer
+;               B. Stack
+;               C. Token
+;               D. Reduction
+
+; 1A. A Line Buffer
+;
+; The philosophy of lines is that
+;
+;       a) NEXT LINE will always get you a non-blank line or fail.
+;       b) Every line is terminated by a blank character.
+;
+; Hence there is always a current character, because there is never a non-blank line,
+; and there is always a separator character between tokens on separate lines.
+; Also, when a line is read, the character pointer is always positioned ON the first
+; character.
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Line-Buffer, Line-Current-Char, Line-Current-Index, Line-Last-Index, Line-Number
+;       Line-New-Line, Line-Advance-Char, Line-Past-End-P, Line-At-End-P
+;       Make-Line
+
+(defstruct Line "Line of input file to parse."
+           (Buffer (make-string 0) :type string)
+           (Current-Char #\Return :type character)
+           (Current-Index 1 :type fixnum)
+           (Last-Index 0 :type fixnum)
+           (Number 0 :type fixnum))
+
+(defun Line-Print (line)
+  (format out-stream "~&~5D> ~A~%" (Line-Number line) (Line-Buffer Line))
+  (format out-stream "~v@T^~%" (+ 7 (Line-Current-Index line))))
+
+(defmacro Line-Clear (line)
+  `(let ((l ,line))
+     (setf (Line-Buffer l) (make-string 0)
+           (Line-Current-Char l) #\Return
+           (Line-Current-Index l) 1
+           (Line-Last-Index l) 0
+           (Line-Number l) 0)))
+
+(defun Line-Current-Segment (line)
+  "Buffer from current index to last index."
+  (if (line-at-end-p line) (make-string 0)
+      (subseq (Line-Buffer line)
+              (Line-Current-Index line)
+              (Line-Last-Index line))))
+
+(defun Line-New-Line (string line &optional (linenum nil))
+  "Sets string to be the next line stored in line."
+  (setf (Line-Last-Index line) (1- (length string))
+        (Line-Current-Index line) 0
+        (Line-Current-Char line) (or (and (> (length string) 0) (elt string 0)) #\Return)
+        (Line-Buffer line) string
+        (Line-Number line) (or linenum (1+ (Line-Number line)))))
+
+(defun Line-Advance-Char (line)
+  (setf (Line-Current-Char line)
+        (elt (Line-Buffer line) (incf (Line-Current-Index line)))))
+
+(defun Line-Next-Char (line)
+  (elt (Line-Buffer line) (1+ (Line-Current-Index line))))
+
+(defun Line-Past-End-P (line)
+  "Tests if line is empty or positioned past the last character."
+  (> (line-current-index line) (line-last-index line)))
+
+(defun Line-At-End-P (line)
+  "Tests if line is empty or positioned past the last character."
+  (>= (line-current-index line) (line-last-index line)))
+
+; 1B. A Stack (of lines, tokens, or whatever)
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Make-Stack, Stack-Store, Stack-Size, Stack-Top, Stack-Load, Stack-Clear,
+;       Stack-/-Empty, Stack-Push, Stack-Pop
+
+(defstruct Stack                "A stack"
+           (Store nil)          ; contents of the stack
+           (Size 0)             ; number of elements in Store
+           (Top nil)            ; first element of Store
+
+           (Updated nil)        ; whether something has been pushed on the stack
+                                ; since this flag was last set to NIL
+)
+
+(defun stack-load (list stack)
+  (setf (stack-store stack) list
+        (stack-size stack) (length list)
+        (stack-top stack) (car list)))
+
+(defun stack-clear (stack)
+  (setf (stack-store stack) nil (stack-size stack) 0 (stack-top stack) nil
+        (stack-updated stack) nil))
+
+(defmacro stack-/-empty (stack) `(> (stack-size ,stack) 0))
+
+(defun stack-push (x stack)
+  (push x (stack-store stack))
+  (setf (stack-top stack) x (stack-updated stack) t)
+  (incf (stack-size stack))
+  x)
+
+(defun stack-pop (stack)
+  (let ((y (pop (stack-store stack))))
+    (decf (stack-size stack))
+    (setf (stack-top stack) (if (stack-/-empty stack) (car (stack-store stack))))
+    y))
+
+; 1C. Token
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Make-Token, Token-Symbol, Token-Type, Token-Install, Token-Print
+
+(defstruct Token
+  "A token is a Symbol with a Type.
+The type is either NUMBER, IDENTIFIER or SPECIAL-CHAR.
+NonBlank is true if the token is not preceded by a blank."
+  (Symbol nil)
+  (Type nil)
+  (NonBlank t))
+
+(defparameter Prior-Token (make-token) "What did I see last")
+(defparameter nonblank t "Is there no blank in front of the current token.")
+(defparameter Current-Token (make-token) "Token at head of input stream.")
+(defparameter Next-Token (make-token)    "Next token in input stream.")
+(defparameter Valid-Tokens 0               "Number of tokens in buffer (0, 1 or 2)")
+
+(defun Token-Install (symbol type token &optional (nonblank t))
+  (setf (token-symbol token) symbol (token-type token) type
+        (token-nonblank token) nonblank)
+  token)
+
+(defun Token-Print (token)
+  (format out-stream "(token (symbol ~S) (type ~S))~%"
+          (Token-Symbol token) (Token-Type token)))
+
+; 1D. A Reduction
+;
+
+(defstruct (Reduction (:type list))
+"A reduction of a rule is any S-Expression the rule chooses to stack."
+  (Rule nil)            ; Name of rule
+  (Value nil))
+
+; 2. Recursive descent parsing support routines (semantically related to MetaLanguage)
+;
+; This section of the code contains:
+;
+;               A. Routines for stacking and retrieving reductions of rules.
+;               B. Routines for applying certain metagrammatical elements
+;                  of a production (e.g., Star).
+;               C. Token-level parsing utilities (keywords, strings, identifiers).
+
+; 2A. Routines for stacking and retrieving reductions of rules.
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Push-Reduction Pop-Reduction
+
+(defparameter Reduce-Stack (make-stack) "Stack of results of reduced productions.")
+
+(defun Push-Reduction (rule redn)
+  (stack-push (make-reduction :rule rule :value redn) Reduce-Stack))
+
+(defun reduce-stack-show ()
+  (let ((store (stack-store reduce-stack))
+        (*print-pretty* t))
+    (if store
+        (progn (format t "~%Reduction stack contains:~%")
+               (mapcar #'(lambda (x) (if (eq (type-of x) 'token)
+                               #+Symbolics (zl:describe-defstruct x)
+                               #-Symbolics (describe x)
+                                         (print x)))
+                       (stack-store reduce-stack)))
+        (format t "~%There is nothing on the reduction stack.~%"))))
+
+(defmacro reduce-stack-clear () `(stack-load nil reduce-stack))
+
+(defun Pop-Reduction () (stack-pop Reduce-Stack))
+
+(defmacro pop-stack-1 () '(reduction-value (Pop-Reduction)))
+
+(defmacro pop-stack-2 ()
+  `(let* ((top (Pop-Reduction)) (next (Pop-Reduction)))
+     (stack-push top Reduce-Stack)
+     (reduction-value next)))
+
+(defmacro pop-stack-3 ()
+  `(let* ((top (Pop-Reduction)) (next (Pop-Reduction)) (nnext (Pop-Reduction)))
+     (stack-push next Reduce-Stack)
+     (stack-push top Reduce-Stack)
+     (reduction-value nnext)))
+
+(defmacro pop-stack-4 ()
+  `(let* ((top (Pop-Reduction))
+          (next (Pop-Reduction))
+          (nnext (Pop-Reduction))
+          (nnnext (Pop-Reduction)))
+     (stack-push nnext Reduce-Stack)
+     (stack-push next Reduce-Stack)
+     (stack-push top Reduce-Stack)
+     (reduction-value nnnext)))
+
+(defmacro nth-stack (x)
+  `(reduction-value (nth (1- ,x) (stack-store Reduce-Stack))))
+
+; 2B. Routines for applying certain metagrammatical elements
+;     of a production (e.g., Star).
+
+; Must means that if it is not present in the token stream, it is a syntax error.
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Star, Bang, Must, Optional, Action, Sequence
+
+(defmacro Star (lab prod)
+
+"Succeeds if there are one or more of PROD, stacking as one unit
+the sub-reductions of PROD and labelling them with LAB.
+E.G., (Star IDs (parse-id)) with A B C will stack (3 IDs (A B C)),
+where (parse-id) would stack (1 ID (A)) when applied once."
+
+  `(prog ((oldstacksize (stack-size reduce-stack)))
+         (if (not ,prod) ;(progn (format t "~&Star failed for ~A.~%" ',lab) (return nil)))
+             (return nil))
+    loop (if (not ,prod)
+             (let* ((newstacksize (stack-size reduce-stack))
+                    (number-of-new-reductions (- newstacksize oldstacksize)))
+;              (format t "~&Starring ~A with ~D new reductions.~%"
+;                      ',lab number-of-new-reductions)
+               (if (> number-of-new-reductions 0)
+                   (return (do ((i 0 (1+ i)) (accum nil))
+                               ((= i number-of-new-reductions)
+                                (Push-Reduction ',lab accum)
+;                               (format t "~&Star accumulated ~D reductions.~%"
+;                                       (length accum))
+                                (return t))
+                             (push (pop-stack-1) accum)))
+                   (return t)))
+             (go loop))))
+
+(defmacro Bang (lab prod)
+
+"If the execution of prod does not result in an increase in the size of
+the stack, then stack a NIL. Return the value of prod."
+
+  `(progn (setf (stack-updated reduce-stack) nil)
+;         (format t "~&Banging ~A~:[~; and I think the stack is updated!~].~%" ',lab
+;                 (stack-updated reduce-stack))
+          (let* ((prodvalue ,prod)
+                 (updated (stack-updated reduce-stack)))
+;           (format t "~&Bang thinks that ~A ~:[didn't do anything~;did something~].~&"
+;                   ',lab prodvalue)
+            (if updated
+                (progn ; (format t "~&Banged ~A and I think the stack is updated!~%" ',lab)
+                       prodvalue)
+                (progn (push-reduction ',lab nil)
+                       ; (format t "~&Banged ~A.~%" ',lab)
+                       prodvalue)))))
+
+(defmacro must (dothis &optional (this-is nil) (in-rule nil))
+  `(or ,dothis (meta-syntax-error ,this-is ,in-rule)))
+
+; Optional means that if it is present in the token stream, that is a good thing,
+; otherwise don't worry (like [ foo ] in BNF notation).
+
+(defun Optional (dothis) (or dothis t))
+
+; Action is something we do as a consequence of successful parsing; it is
+; inserted at the end of the conjunction of requirements for a successful
+; parse, and so should return T.
+
+(defun action (dothis) (or dothis t))
+
+; A sequence consists of a head, which if recognized implies that the
+; tail must follow.   Following tail are actions, which
+; are performed upon recognizing the head and tail.
+
+(defmacro sequence (subrules &optional (actions nil))
+  `(and ,(pop subrules) . ,(append (mapcar #'(lambda (x) (list 'must x)) subrules)
+                         (if actions `((progn . ,(append actions '(t))))))))
+
+; 3. Routines for handling lexical scanning
+;
+; Lexical scanning of tokens is performed off of the current line.  No
+; token can span more than 1 line.  All real I/O is handled in a line-oriented
+; fashion (in a slight paradox) below the character level.  All character
+; routines implicitly assume the parameter Current-Line.  We do not make
+; Current-Line an explicit optional parameter for reasons of efficiency.
+
+(defparameter Current-Line (make-line)  "Current input line.")
+
+(defmacro current-line-print () '(Line-Print Current-Line))
+
+(defmacro current-line-show ()
+  `(if (line-past-end-p current-line)
+       (format t "~&The current line is empty.~%")
+       (progn (format t "~&The current line is:~%~%")
+              (current-line-print))))
+
+(defmacro current-line-clear () `(Line-Clear Current-Line))
+
+; 3A.  Manipulating the token stack and reading tokens
+
+; This section is broken up into 3 levels:
+;
+;       (0) String grabbing:    Match String, Match Advance String
+;       (1) Token handling:     Current Token, Next Token, Advance Token
+;       (2) Character handling: Current Char, Next Char, Advance Char
+;       (3) Line handling:      Next Line, Print Next Line
+;       (X) Random Stuff
+
+; A good test for lexing is:
+
+(defmacro test-lexing ()
+  '(with-open-file (in-stream "lisp>meta.meta" :direction :input)
+    (with-open-file (out-stream "lisp>foo.pars" :direction :output :if-exists :supersede)
+      (loop (let ((z (advance-token)))
+              (if z (Token-Print z out-stream) (return nil)))))))
+
+; 3A (0). String grabbing
+
+; String grabbing is the art of matching initial segments of the current
+; line, and removing them from the line before the get tokenized if they
+; match (or removing the corresponding current tokens).
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Match-String, Match-Advance-String
+
+(defun Match-String (x)
+  "Returns length of X if X matches initial segment of inputstream."
+  (unget-tokens)                        ; So we don't get out of synch with token stream
+  (skip-blanks)
+  (if (and (not (Line-Past-End-P Current-Line)) (Current-Char) )
+      (initial-substring-p x
+           (subseq (Line-Buffer Current-Line) (Line-Current-Index Current-Line)))))
+
+(defun Match-Advance-String (x)
+  "Same as MATCH-STRING except if successful, advance inputstream past X."
+  (let ((y (if (>= (length (string x))
+                   (length (string (quote-if-string (current-token)))))
+               (Match-String x)
+               nil))) ; must match at least the current token
+    (if y (progn (incf (Line-Current-Index Current-Line) y)
+                 (if (not (Line-Past-End-P Current-Line))
+                     (setf (Line-Current-Char Current-Line)
+                           (elt (Line-Buffer Current-Line)
+                                (Line-Current-Index Current-Line)))
+                     (setf (Line-Current-Char Current-Line) #\Space))
+                 (setq prior-token
+                       (make-token :Symbol (intern (string x))
+                                   :Type 'identifier
+                                   :nonBlank nonblank))
+                 t))))
+
+(defun initial-substring-p (part whole)
+  "Returns length of part if part matches initial segment of whole."
+  (let ((x (string-not-greaterp part whole)))
+    (and x (= x (length part)) x)))
+
+; 3A (1) Token Handling.
+
+; Tokens are acquired from a stream of characters.  Lexical analysis is performed
+; by the functiond Get Token.  One-token lookahead is maintained in variables
+; Current-Token and Next-Token by procedures Current Token, Next Token, and
+; Advance Token.  The functions Match Current Token and Match Next Token recognize
+; classes of tokens, by type, or by type and symbol.  The current and next tokens
+; can be shoved back on the input stream (to the current line) with Unget-Tokens.
+
+(defmacro Defun-Parse-Token (token)
+  `(defun ,(intern (concatenate 'string "PARSE-" (string token))) ()
+     (let* ((tok (match-current-token ',token))
+            (symbol (if tok (token-symbol tok))))
+       (if tok (progn (Push-Reduction
+                        ',(intern (concatenate 'string (string token)
+                                               "-TOKEN"))
+                        (copy-tree symbol))
+                      (advance-token)
+                      t)))))
+
+(defun token-stack-show ()
+  (if (= Valid-Tokens 0) (format t "~%There are no valid tokens.~%")
+      (format t "~%The number of valid tokens is ~S.~%" Valid-Tokens))
+  (if (> Valid-Tokens 0)
+      (progn (format t "The current token is~%")
+             #+Symbolics (zl:describe-defstruct current-token)
+             #-Symbolics (describe current-token)
+             ))
+  (if (> Valid-Tokens 1)
+      (progn (format t "The next token is~%")
+             #+Symbolics (zl:describe-defstruct next-token)
+             #-Symbolics (describe next-token)
+             ))
+  (if (token-type prior-token)
+      (progn (format t "The prior token was~%")
+             #+Symbolics (zl:describe-defstruct prior-token)
+             #-Symbolics (describe prior-token)
+             )))
+
+(defmacro token-stack-clear ()
+  `(progn (setq valid-tokens 0)
+          (token-install nil nil current-token nil)
+          (token-install nil nil next-token nil)
+          (token-install nil nil prior-token nil)))
+
+; Unget-Tokens
+
+(defun quote-if-string (token)
+  (if token   ;only use token-type on non-null tokens
+  (case (token-type token)
+    (bstring            (strconc "[" (token-symbol token) "]*"))
+    (string             (strconc "'" (token-symbol token) "'"))
+    (spadstring         (strconc "\"" (underscore (token-symbol token)) "\""))
+    (number             (format nil "~v,'0D" (token-nonblank token)
+				(token-symbol token)))
+    (special-char       (string (token-symbol token)))
+    (identifier         (let ((id (symbol-name (token-symbol token)))
+			      (pack (package-name (symbol-package
+						   (token-symbol token)))))
+                          (if (or $BOOT $SPAD)
+			      (if (equal pack "BOOT")
+				  (escape-keywords (underscore id) (token-symbol token))
+				(concatenate 'string
+					     (underscore pack) "'" (underscore id)))
+			    id)))
+    (t                  (token-symbol token)))
+   nil))
+
+(defun escape-keywords (pname id)
+  (if (member id keywords)
+      (concatenate 'string "_" pname)
+    pname))
+
+(defun underscore (string)
+  (if (every #'alpha-char-p string) string
+    (let* ((size (length string))
+	   (out-string (make-array (* 2 size)
+				   :element-type 'character
+				   :fill-pointer 0))
+	   next-char)
+      (dotimes (i size)
+	       (setq next-char (char string i))
+	       (if (not (alpha-char-p next-char))
+		   (vector-push #\_ out-string))
+	       (vector-push next-char out-string))
+      out-string)))
+
+(defun Unget-Tokens ()
+  (case Valid-Tokens
+    (0 t)
+    (1 (let* ((cursym (quote-if-string current-token))
+              (curline (line-current-segment current-line))
+              (revised-line (strconc cursym curline (copy-seq " "))))
+         (line-new-line revised-line current-line (line-number current-line))
+         (setq NonBlank (token-nonblank current-token))
+         (setq Valid-Tokens 0)))
+    (2 (let* ((cursym (quote-if-string current-token))
+              (nextsym (quote-if-string next-token))
+              (curline (line-current-segment current-line))
+              (revised-line
+                (strconc (if (token-nonblank current-token) "" " ")
+                         cursym
+                         (if (token-nonblank next-token) "" " ")
+                         nextsym curline " ")))
+         (setq NonBlank (token-nonblank current-token))
+         (line-new-line revised-line current-line (line-number current-line))
+         (setq Valid-Tokens 0)))
+    (t (error "How many tokens do you think you have?"))))
+
+; *** Match Token
+
+(defun match-token (token type &optional (symbol nil))
+  (if (and token (eq (token-type token) type))
+      (if symbol (if (equal symbol (token-symbol token)) token) token)))
+
+(defun match-current-token (type &optional (symbol nil))
+  "Returns the current token if it has EQ type and (optionally) equal symbol."
+  (match-token (current-token) type symbol))
+
+(defun match-next-token (type &optional (symbol nil))
+  "Returns the next token if it has equal type and (optionally) equal symbol."
+  (match-token (next-token) type symbol))
+
+; *** Current Token, Next Token, Advance Token
+
+(defun try-get-token (token)
+  (let ((tok (get-token token)))
+    (if tok (progn (incf Valid-Tokens) token))))
+
+(defun current-symbol () (make-symbol-of (current-token)))
+
+(defun make-symbol-of (token)
+  (let ((u (and token (token-symbol token))))
+    (cond ((not u) nil)
+          ((characterp u) (intern (string u)))
+          (u))))
+
+(defun current-token ()
+  "Returns the current token getting a new one if necessary."
+  (if (> Valid-Tokens 0)
+      Current-Token
+      (try-get-token Current-Token)))
+
+(defun next-token ()
+  "Returns the token after the current token, or NIL if there is none after."
+  (current-token)
+  (if (> Valid-Tokens 1)
+      Next-Token
+      (try-get-token Next-Token)))
+
+(defun advance-token ()
+  (current-token)			;don't know why this is needed
+  "Makes the next token be the current token."
+  (case Valid-Tokens
+    (0 (try-get-token (Current-Token)))
+    (1 (decf Valid-Tokens)
+       (setq Prior-Token (copy-token Current-Token))
+       (try-get-token Current-Token))
+    (2 (setq Prior-Token (copy-token Current-Token))
+       (setq Current-Token (copy-token Next-Token))
+       (decf Valid-Tokens))))
+
+(defparameter XTokenReader 'get-meta-token "Name of tokenizing function")
+
+; *** Get Token
+
+(defun get-token (token) (funcall XTokenReader token))
+
+; 3A (2) Character handling.
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Current-Char, Next-Char, Advance-Char
+
+; *** Current Char, Next Char, Advance Char
+
+(defun Current-Char ()
+  "Returns the current character of the line, initially blank for an unread line."
+  (if (Line-Past-End-P Current-Line) #\Return (Line-Current-Char Current-Line)))
+
+(defun Next-Char ()
+   "Returns the character after the current character, blank if at end of line.
+The blank-at-end-of-line assumption is allowable because we assume that end-of-line
+is a token separator, which blank is equivalent to."
+
+  (if (Line-At-End-P Current-Line) #\Return (Line-Next-Char Current-Line)))
+
+(defun Advance-Char ()
+  "Advances IN-STREAM, invoking Next Line if necessary."
+  (loop (cond ((not (Line-At-End-P Current-Line))
+               (return (Line-Advance-Char Current-Line)))
+              ((next-line in-stream)
+               (return (current-char)))
+              ((return nil)))))
+
+; 3A 3. Line Handling.
+
+; PARAMETERS DEFINED IN THIS SECTION:
+;
+;       Echo-Meta
+
+; *** Next Line
+
+(defparameter Echo-Meta nil                 "T if you want a listing of what has been read.")
+(defparameter Line-Handler 'next-META-line "Who grabs lines for us.")
+
+(defun next-line (&optional (in-stream t)) (funcall Line-Handler in-stream))
+
+(defun make-string-adjustable (s)
+  (cond ((adjustable-array-p s) s)
+        (t (make-array (array-dimensions s) :element-type 'character
+                       :adjustable t :initial-contents s))))
+
+(defun get-a-line (stream)
+  (if (IS-CONSOLE stream) (princ (MKPROMPT)))
+  (let ((ll (read-a-line stream)))
+    (if (stringp ll) (make-string-adjustable ll) ll)))
+
+(defparameter Current-Fragment nil
+  "A string containing remaining chars from readline; needed because
+Symbolics read-line returns embedded newlines in a c-m-Y.")
+
+(defun input-clear () (setq Current-Fragment nil))
+
+#-:CCL
+(defun read-a-line (&optional (stream t))
+  (let (cp)
+    (if (and Current-Fragment (> (length Current-Fragment) 0))
+        (let ((line (with-input-from-string
+                      (s Current-Fragment :index cp :start 0)
+                      (read-line s nil nil))))
+          (setq Current-Fragment (subseq Current-Fragment cp))
+          line)
+        (prog nil
+              (if (stream-eof in-stream)
+                  (progn (setq File-Closed t *EOF* t)
+                         (Line-New-Line (make-string 0) Current-Line)
+                         (return nil)))
+              (if (setq Current-Fragment (read-line stream))
+                  (return (read-a-line stream)))))))
+#+:CCL
+(defun read-a-line (&optional (stream t))
+   (let ((line (read-line stream nil nil)))
+      (if (null line)
+           (progn (setq File-Closed t *EOF* t)
+                  (Line-New-Line (make-string 0) Current-Line)
+                   nil)
+          line)))
+
+; *** Print New Line
+
+(defparameter Printer-Line-Stack (make-stack)
+  "Stack of output listing lines waiting to print. [local to PRINT-NEW-LINE]")
+
+(defparameter Read-Quietly nil
+  "Whether or not to produce an output listing. [local to PRINT-NEW-LINE]")
+
+(defun Print-New-Line (string &optional (strm *terminal-io*))
+  "Makes output listings."
+  (if Read-Quietly (stack-push (copy-tree string) Printer-Line-Stack)
+      (progn (mapc #'(lambda (x) (format strm "; ~A~%" x) (terpri))
+                   (nreverse (stack-store Printer-Line-Stack)))
+             (stack-clear Printer-Line-Stack)
+             (format strm "~&; ~A~%" string))))
+
+; 3B. Error handling
+
+(defparameter errcol nil)
+(defparameter line nil)
+(defparameter count nil)
+
+(defun conversation (x y)
+  (prog (u)
+     a  (reduce-stack-clear)
+        (setq u (namederrset 'spad_reader (conversation1 x y) ))
+        (cond (*eof* (return nil))
+              ((atom u) (go a))
+              ((return (car u))))))
+
+(defparameter ulcasefg nil              "")
+
+(defun conversation1 (firstfun procfun)
+  (prog nil
+     top(cond ((not (Current-Char)) (return nil))
+              ((and (current-token) (next-token)) (go top))
+              ((compfin) (return 't))
+              ((and (funcall firstfun)
+                    (or (funcall procfun (pop-stack-1))))
+               (go top))
+              ((compfin) (return 't)) )
+        (meta-syntax-error)
+        (go top)))
+
+(defun termchr ()  "Is CHR a terminating character?"
+  (position (current-char) " *,;<>()[]/\\"))
+
+(defun compfin () (or (match-string ")fin") (match-string ".FIN")))
+
+(defparameter Meta_Errors_Occurred nil  "Did any errors occur")
+
+(defparameter Meta_Error_Handler 'meta-meta-error-handler)
+
+(defun meta-syntax-error (&optional (wanted nil) (parsing nil))
+  (funcall Meta_Error_Handler wanted parsing))
+
+; 3 C. Constructing parsing procedures
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Make-Parse-Function, GetGenSym
+
+(MAKEPROP 'PROGN 'NARY T)       ; Setting for Make-Parse-Function
+
+(defun make-parse-function (l op)
+   (if (flagp op 'nary) (setq l (make-parse-func-flatten-1 l op nil)))
+   (make-parse-function1 l op))
+
+(defun make-parse-func-flatten (x op)
+  (cond ((atom x) x)
+        ((eq (car x) op) (cons op (make-parse-func-flatten-1 (cdr x) op nil)))
+        (t (cons (make-parse-func-flatten (car x) op) (make-parse-func-flatten (cdr x) op)))))
+
+(defun make-parse-func-flatten-1 (l op r)
+  (let (x)
+    (if (null l)
+        r
+        (make-parse-func-flatten-1
+            (cdr l) op
+            (append r (if (eqcar (setq x (make-parse-func-flatten (car l) op)) op)
+                          (cdr x)
+                          (list x)))))))
+
+(defun make-parse-function1 (l op)
+  (let (x)
+    (case op
+      (plus (cond ((eq 0 (setq x (length (setq l (s- l '(0 (zero))))))) 0)
+                  ((eq 1 x) (car l))
+                  (t `(+ . ,l))))
+      (times (cond ((s* l '(0 (zero))) 0)
+                   ((eq 0 (setq x (length (setq l (s- l '(1 (one))))))) 1)
+                   ((eq 1 x) (car l))
+                   (t `(times . ,l)) ))
+      (quotient (cond ((> (length l) 2) (fail))
+                      ((eq 0 (car l)) 0)
+                      ((eq (cadr l) 1) (car l))
+                      (t `(quotient . ,l)) ))
+      (minus (cond ((cdr l) (fail))
+                   ((numberp (setq x (car l))) (minus x))
+                   ((eqcar x 'minus) (cadr x))
+                   (t `(minus . ,l))  ))
+      (- (cond ((> (length l) 2) (fail))
+                        ((equal (car l) (cadr l)) '(zero))
+                        ((member (car l) '(0 (zero))) (make-parse-function (cdr l) 'minus))
+                        ((member (cadr l) '(0 (zero))) (car l))
+                        ((eqcar (cadr l) 'minus)
+                         (make-parse-function (list (car l) (cadadr l)) 'plus))
+                        (t `(- . ,l)) ))
+      (expt (cond ((> (length l) 2) (fail))
+                  ((eq 0 (cadr l)) 1)
+                  ((eq 1 (cadr l)) (car l))
+                  ((member (car l) '(0 1 (zero) (one))) (car l))
+                  (t `(expt . ,l)) ))
+      (or (cond ((member 't l) ''t)
+                ((eq 0 (setq x (length (setq l (delete nil l))))) nil)
+                ((eq 1 x) (car l))
+                (t `(or . ,l)) ))
+      (|or| (cond ((member 't l) 't)
+                  ((eq 0 (setq x (length (setq l (delete nil l))))) nil)
+                  ((eq 1 x) (car l))
+                  (t `(|or| . ,l)) ))
+      (null (cond ((cdr l) (fail))
+                  ((eqcar (car l) 'null) (cadar l))
+                  ((eq (car l) 't) nil)
+                  ((null (car l)) ''t)
+                  (t `(null . ,l))))
+      (|and| (cond ((eq 0 (setq x (length (setq l (delete 't (delete 'true l)))))) 't)
+                   ((eq 1 x) (car l))
+                   (t `(|and| . ,l)) ))
+      (and (cond ((eq 0 (setq x (length (setq l (delete 't (delete 'true l)))))) ''t)
+                 ((eq 1 x) (car l))
+                 (t `(and . ,l)) ))
+      (progn (cond ((and (not (atom l)) (null (last l)))
+                    (cond ((cdr l) `(progn . ,l))
+                          (t (car l))))
+                   ((null (setq l (delete nil l))) nil)
+                   ((cdr l) `(progn . ,l))
+                   (t (car l)) ))
+      (seq (cond ((eqcar (car l) 'exit) (cadar l))
+                 ((cdr l) `(seq . ,l))
+                 (t (car l))   ))
+      (list (cond ((null l) nil) (t `(list . ,l))))
+      (cons (cond ((cdr l) `(cons . ,l)) (t (car l)) ))
+      (t (cons op l) ))))
+
+(defparameter /genvarlst nil    "??")
+
+(defun transpgvar (metapgvar) (remove-duplicates metapgvar))
+
+(defparameter /gensymlist nil   "List of rule local variables generated by getgensym.")
+
+(defun getgensym (n)
+  "Used to create unique numerically indexed local variables for the use of rules."
+  (loop
+     (let ((m (length /gensymlist)))
+       (if (< m n)
+           (setq /gensymlist (nconc /gensymlist `(,(intern (format nil "G~D" (1+ m))))))
+           (return (nth (1- n) /gensymlist))))))
+
+; 3 D.  Managing rule sets
+
+(defparameter bac nil                   "")
+(defparameter keyfn nil                 "")
+(defparameter /metaoption               "")
+(defparameter tline nil                 "")
+(defparameter rs nil                    "")
+
+(defun getrulefunlists  (rootfun rs)
+  (let* ((metapfx (or (get rootfun 'metapfx) ""))
+         (mainfun (internl metapfx (pname rootfun)))
+         (mainfunstr (pname mainfun))
+         (flnam (internl mainfunstr "FUN"))
+         (pfx-funlist (union (cons mainfun
+                                   (if (atom (eval flnam)) nil (eval flnam)))
+                             (mapcar #'(lambda (x) (internl metapfx (pname x)))
+                                     (assocleft rs))))
+         n unpfx-funlist)
+    (set flnam pfx-funlist)
+    (if (not (lessp (setq n (length metapfx)) 0))
+        (setq unpfx-funlist
+              (mapcar #'(lambda (x) (intern (subseq (copy-symbol (pname x)) n)))
+                       pfx-funlist)))
+    (if unpfx-funlist (list pfx-funlist unpfx-funlist))))
+
+;  4. Tracing routines
+
+(defparameter debugmode 'yes "Can be either YES or NO")
+
+(defun reduction-print (y rule)
+  (format t "~&")
+  (cond ((eq y t) (|sayBrightly| `(|%b| ,rule |%d| " reduced")))
+        (y (|sayBrightlyNT| `(|%b| ,rule |%d|))
+           (format t " reduced ~A~%" y)))
+  y)
+
+#+Symbolics
+(defmacro rtrace (&rest rules)
+  `(compiler-let () .
+        ,(mapcar #'(lambda (x)
+                    (let ((rule (intern (strconc "PARSE-" x))))
+                      `(zl:advise ,rule :around nil nil
+                               (reduction-print :do-it ',rule))))
+                rules)))
+
+#+Symbolics
+(defmacro runtrace () `(zl:unadvise))
+
+(defmacro tracemeta (&rest l) `(trmeta ',l))
+
+(defparameter /depth 0 "Used in Debug.lisp.")
+
+(defun trmeta (l) (setq /depth 0) (mapc #'trmeta1 l))
+
+(defun trmeta1 (x)
+  (let (y)
+  (if (not (fboundp  x))
+      (if (fboundp (setq y (internl $lastprefix (pname x))))
+          (moan (format nil "********* ~S RENAMED AS ~S" x (setq x y)))
+          (croak (format nil  "********* ~S MUST BE GIVEN PREFIX" x))))
+  (/embed-1 x
+   (sublislis
+     (list (pname x) x (gensym))
+     '(nam* fun* argl*)
+     '(lambda (&rest argl*)
+       (prog (v tok)
+         (terpri)
+         (trblanks (* 2 /depth))          (setq /depth (+ 1 /depth))
+         (princ (stringimage /depth))  (princ "<")
+         (princ nam*)              (trargprint argl*)   (princ "/")
+         (princ "chr= ")           (prin1 (Current-Char))
+         (princ "/tok= ")          (prin1 (setq tok (current-symbol)))
+         (princ "/col= ")          (prin1 (line-current-index current-line))
+ ;;      (princ "/icol= ")         (prin1 initcolumn)
+         (cond ( (not nonblank) (go a1)))     (princ "/nblnk= T")
+     a1  ;;(cond (ok (go b1)))               (princ "/ok= NIL")
+     b1  ;;(cond ( (not stackx) (go c1)))   (princ "/stackx= ")
+         ;;(prin1 stackx)
+     c1  (cond ( (not (identp tok)) (go d1)))
+         (princ "/isid= ")
+        ;; (princ (cond (isid "T") (t "NIL")))
+     d1  (princ "/stack= ")            (prin1 (stack-store reduce-stack))
+         (setq v (apply fun* argl*))           (setq /depth (- /depth 1))
+         (terpri)
+         (trblanks (* 2 /depth))          (princ (stringimage (\1+ /depth)))
+         (princ ">")                       (princ nam*)
+         (princ "/chr= ")                  (prin1 (Current-Char))
+         (princ "/tok= ")                  (prin1 (setq tok (current-symbol)))
+         (princ "/col= ")            (prin1 (line-current-index current-line))
+         (if (not nonblank) (go a2))          (princ "/nblnk= ")
+         (princ (if nonblank "T" "NIL"))
+     a2  ;;(if ok (go b2))                   (princ "/ok= ")          (prin1 ok)
+     b2  ;;(if (not stackx) (go c2))        (princ "/stackx1= ")     (prin1 stackx)
+     c2  (if (not (identp tok)) (go d2))
+         (princ "/isid= ")
+        ;; (princ (if isid "T" "NIL"))
+     d2  (princ "/stack= ")            (prin1 (stack-store reduce-stack))
+         (princ "/value= ")         (prin1 v)
+         (return v)))))))
+
+(defun /embed-1 (x y)
+   (princ (strconc (pname x) " embedded"))
+   (terpri)
+   (/embed-q x y))
+
+(defun /embed-q (x y)
+   (setq /embednames (cons x /embednames))
+   (embed x
+          (cond ((eqcar y 'lambda) y)
+                ((eqcar y 'before)
+		 `(lambda ,(cadr y)
+		    (prog2 ,(caddr y) ,(cons 'funcall (cons x (cadr y))))))
+                ((eqcar y 'after)
+		 `(lambda ,(cadr y)
+		    (prog1 ,(cons 'funcall (cons x (cadr y))) ,(caddr y))))))
+   (/embedreply))
+
+(defun /embedreply ()
+  (if (atom (embedded)) '(|none| |embedded|)
+      (append (embedded) (list '|embedded|))))
+
+(defun numofargs (fn) (numberofargs (car (/mdef (cons fn '(x))))))
+
+(defparameter mdeftrace nil             "")
+
+(defun /mdef (x)
+  (let (u)
+    (cond  ((atom x) x)
+           ((or (null (atom (car x))) (not (mbpip (car x))))
+            (mapcar #'/mdef x))
+           ((equal x (setq u (mdef (car x) x))) x)
+           (mdeftrace (print x) (princ " --> ") (print u) (/mdef u))
+           ((/mdef u)))))
+
+(defun trargprint (l) (mapc #'(lambda (x) (princ " / ") (prin1 x)) l))
+
+(defun trblanks (n) (do ((i 1 (1+ i))) ((> i n)) (princ " ")))
+
+;       5. Routines for inspecting and resetting total I/O system state
+;
+; The package largely assumes that:
+;
+;       A. One I/O stream pair is in effect at any moment.
+;       B. There is a Current Line
+;       C. There is a Current Token and a Next Token
+;       D. There is a Reduction Stack
+;
+; This state may be examined and reset with the procedures IOSTAT and IOCLEAR.
+
+(defun IOStat ()
+  "Tell me what the current state of the parsing world is."
+  ;(IOStreams-show)
+  (current-line-show)
+  (if (or $BOOT $SPAD) (next-lines-show))
+  (token-stack-show)
+  ;(reduce-stack-show)
+  nil)
+
+(defun IOClear (&optional (in t) (out t))
+  ;(IOStreams-clear in out)
+  (input-clear)
+  (current-line-clear)
+  (token-stack-clear)
+  (reduce-stack-clear)
+  (if (or $BOOT $SPAD) (next-lines-clear))
+  nil)
+
+;; auxiliary functions needed by the parser
+
+(defun char-eq (x y) (char= (character x) (character y)))
+
+(defun char-ne (x y) (char/= (character x) (character y)))
+
+(Defun FLOATEXPID (X &aux S)
+  (if (AND (IDENTP X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
+           (> (LENGTH S) 1)
+           (SPADREDUCE AND 0 (COLLECT (STEP I 1 1 (MAXINDEX S))
+                                      (DIGITP (ELT S I)))))
+       (READ-FROM-STRING S t nil :start 1)
+    NIL))
+
+(defun |getToken| (x) (if (EQCAR x '|elt|) (third x) x))
+
+(defun |dollarTran| (dom rand)
+       (let ((eltWord (if |$InteractiveMode| '|$elt| '|elt|)))
+         (if (and (not (atom rand)) (cdr rand))
+             (cons (list eltWord dom (car rand)) (cdr rand))
+             (list eltWord dom rand))))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet
new file mode 100644
index 00000000..96d8a2c0
--- /dev/null
+++ b/src/interp/patches.lisp.pamphlet
@@ -0,0 +1,450 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp patches.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\subsection{toplevel}
+The function top-level is the very root of the normal invocation
+history stack. Control will pass to the restart function which is 
+also in this file.
+
+For some unknown reason toplevel was redefined to incorrectly
+call lisp::unwind whereas it is defined (in this file) to be
+interned in the boot package. We've returned toplevel to its
+previous definition.
+<<toplevel>>=
+(defun toplevel (&rest foo) (throw '|top_level| '|restart|))
+;;(defun toplevel (&rest foo) (lisp::unwind))
+
+@
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+;;patches for now
+
+;; browser stuff:
+;; gdr NOTES: it is WRONG to test for platforms, when in fact
+;; gdr NOTES: one should test for functionalities.
+#+:UNIX (defvar |$standard| 't)
+#-:UNIX (defvar |$standard| 'nil)
+#+(or :UNIX :winnt) (defvar |$saturn| 'nil)
+#-(or :UNIX :winnt) (defvar |$saturn| 't)
+
+(defun CATCHALL (a &rest b) a) ;; not correct but ok for now
+(defvar |$demoFlag| nil)
+
+(define-function '|construct| #'list) ;; NEEDED , SPAD-COMPILER generated Lisp code
+(define-function '|COMP,TRAN| #'comp-tran) ;called by |compWithMappingMode|
+
+(defvar |Undef| (function |Undef|)) ;needed in NewbFVectorCopy
+(define-function '|spadHash| #'sxhash)
+
+(defun |mkAutoLoad| (fn cname)
+   (function (lambda (&rest args)
+		 (|autoLoad| fn cname)
+		 (apply cname args))))
+
+(setq |$printTimeIfTrue| nil)
+
+
+(defmacro dribinit (streamvar)
+  `(if (is-console ,streamvar)
+       (setq ,streamvar *terminal-io*)))
+
+(defun clear-highlight ()
+  (let ((|$displaySetValue| nil))
+    (declare (special |$displaySetValue| |$saveHighlight| |$saveSpecialchars|))
+    (setq |$saveHighlight| |$highlightAllowed|
+	  |$highlightAllowed| nil)
+    (setq |$saveSpecialchars| |$specialCharacters|)
+    (|setOutputCharacters| '(|plain|))))
+
+(defun reset-highlight ()
+  (setq |$highlightAllowed| |$saveHighlight|)
+  (setq |$specialCharacters| |$saveSpecialchars|))
+
+(defun |spool| (filename)
+  (cond ((null filename)
+	 (dribble) (TERPRI)
+	 (reset-highlight))
+	((probe-file (car filename))
+	 (error (format nil "file ~a already exists" (car filename))))
+	(t (dribble (car filename))
+	   (TERPRI)
+	   (clear-highlight))
+    ))
+
+(defun |cd| (args)
+  (cond ((null args)
+#+(and :lucid :ibm/370)
+         (setq $current-directory "")
+#-(and :lucid :ibm/370)
+         (setq $current-directory (truename (user-homedir-pathname))) )
+        ((eql (|directoryp| (interp-make-directory (car args))) 1)
+         (setq $current-directory (namestring (truename (interp-make-directory (car args)))))))
+#+(or :kcl :ibcl :CCL) (system:CHDIR $current-directory)
+  (|sayKeyedMsg| 'S2IZ0070 (list (namestring $current-directory))))
+
+<<toplevel>>
+(define-function 'top-level #'toplevel)
+(define-function 'unwind #'|spadThrow|)
+(define-function 'resume #'|spadThrow|)
+
+(DEFUN BUMPCOMPERRORCOUNT () ())
+
+(define-function '|isBpiOrLambda| #'FBOUNDP)
+;;(defun |isSharpVar| (x) (and (identp x) (char= (elt (pname x) 0) #\#)))
+
+(setq |$useInternalHistoryTable| T)
+(defvar |$internalHistoryTable| ())
+(setq |$inputPromptType| '|step|)
+(setq |nullstream| '|nullstream|)
+(setq |nonnullstream| '|nonnullstream|)
+(defun |cpCms| (prefix &optional (string (|getSystemCommandLine|)))
+  (setq string (concat prefix string))
+  (if (equal string "") (obey "sh")
+    (obey string))
+   (|terminateSystemCommand|))
+(setq *print-escape* nil) ;; so stringimage doesn't escape idents?
+#+(or :IEEE-FLOATING-POINT)
+ (setq system:*print-nans* T)
+(defun /RF (&rest foo &aux (Echo-Meta 'T))
+  (declare (special Echo-Meta))
+  (/RF-1 nil))
+(defun /RQ (&rest foo &aux (Echo-Meta nil))
+  (declare (special Echo-Meta))
+  (/RF-1 nil))
+(defun |/RQ,LIB| (&rest foo &aux (Echo-Meta nil) ($LISPLIB T))
+  (declare (special Echo-Meta $LISPLIB))
+  (/RF-1 nil))
+
+(defun /RF-1 (ignore)
+ (declare (ignore ignore))
+  (let* ((input-file (vmlisp::make-input-filename /EDITFILE))
+     (lfile ())
+     (type (pathname-type input-file)))
+    (cond
+     ((string= type "boot")
+#-:CCL
+      (boot input-file
+	 (setq lfile (make-pathname :type "lisp"
+			   :defaults input-file)))
+#+:CCL
+      (boot input-file
+         (setq lfile (make-pathname :name (pathname-name input-file)
+                                :type "lisp")))
+      (load lfile))
+     ((string= type "lisp") (load input-file))
+     ((string= type "bbin") (load input-file))
+     ((and (string= type "input")
+	   |$useNewParser|)
+      (|ncINTERPFILE| input-file Echo-Meta))
+     (t (spad input-file)))))
+
+(defun /EF (&rest foo)
+  (obey (concat "vi " (namestring (vmlisp::make-input-filename /EDITFILE)))))
+#-:CCL
+  (defun user::start () (in-package "BOOT") (boot::|start|))
+#+:CCL
+  (defun user::start () (setq *package* (find-package "BOOT")) (boot::|start|))
+
+(setq |$algebraOutputStream|
+   (setq |$fortranOutputStream|
+      (setq |$texOutputStream|
+	  (setq |$formulaOutputStream|
+	     (setq |conOutStream| (make-synonym-stream '*terminal-io*))))))
+
+;; non-interactive restarts...
+(defun restart0 ()
+#+(and :NAG :ccl) (lisp::init-lm 0)
+  (compressopen);; set up the compression tables
+  (interpopen);; open up the interpreter database
+  (operationopen);; all of the operations known to the system
+  (categoryopen);; answer hasCategory question
+  (browseopen)
+  (let ((asharprootlib (strconc (|getEnv| "AXIOM") "/aldor/lib/")))
+    (set-file-getter (strconc asharprootlib "runtime.o"))
+    (set-file-getter (strconc asharprootlib "lang.o"))
+    (set-file-getter (strconc asharprootlib "attrib.o"))
+    (set-file-getter (strconc asharprootlib "axlit.o"))
+    (set-file-getter (strconc asharprootlib "minimach.o"))
+    (set-file-getter (strconc asharprootlib "axextend.o")))
+)
+
+(defun AKCL-VERSION () system::*akcl-version*)
+(defun SHAREDITEMS (x) T) ;;checked in history code
+(defun whocalled (n) nil) ;; no way to look n frames up the stack
+(defun setletprintflag (x) x)
+(defun |normalizeTimeAndStringify| (time)
+  (if (= time 0.0) "0" (format nil "~,1F" time)))
+
+(define-function '|eval| #'eval)
+
+(defun |libraryFileLists| () '((SPAD SPADLIBS J)))
+
+;;--------------------> NEW DEFINITION (see cattable.boot.pamphlet)
+(defun |compressHashTable| (ht) ht)
+(defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0))
+
+(defun |normalizeArgFileName| (l) l)
+
+(defun READSPADEXPR ()
+  (let* ((line (cdar (preparse in-stream))))
+    (cond ((or (not (stringp line)) (zerop (SIZE line)))
+       (SAY "   Scratchpad -- input")
+       (READSPADEXPR))
+      (t (|parseTransform| (|postTransform| (|string2SpadTree| line)))))))
+
+(setq |$sourceFiles| ()) ;; set in readSpad2Cmd
+
+(setq |$localVars| ())	;checked by isType
+
+(setq |$highlightFontOn| (concat " " $BOLDSTRING))
+(setq |$highlightFontOff| (concat $NORMALSTRING " "))
+(define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy)
+#+(and :lucid (not :ibm/370))
+ (define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM)
+(setq |$specialCharacters| |$plainRTspecialCharacters|)
+;; following should be no longer necessary
+;; (eval-when (eval load compile) (shadow 'delete))
+;; (define-function 'boot::delete #'|delete|)
+
+;; following code is to mimic def of MAP in NEWSPAD LISP
+;; i.e. MAP in boot package is a self evaluating form
+;; #-:CCL (eval-when (eval load compile) (shadow 'map))
+;; #-:CCL (defmacro map (&rest args) `'(map ,@args))
+(eval-when (eval load compile) (shadow 'map))
+(defmacro map (&rest args) `'(map ,@args))
+
+#+:Lucid
+(defun save-system (filename)
+      (in-package "BOOT")
+      (UNTRACE)
+      (|untrace| NIL)
+      (|clearClams|)
+	;; bind output to nulloutstream
+      (let ((*standard-output* (make-broadcast-stream)))
+	(|resetWorkspaceVariables|))
+      (setq |$specialCharacters| |$plainRTspecialCharacters|)
+
+	  (load (make-absolute-filename "lib/interp/obey"))
+      (system:disksave filename :restart-function restart-hook :full-gc t))
+#+:Lucid (define-function 'user::save-system  #'boot::save-system)
+(defun |undoINITIALIZE| () ())
+;; following are defined in spadtest.boot and stantest.boot
+(defun |installStandardTestPackages| () ())
+(defun |spadtestValueHook| (val type) ())
+(defun |testError| (errotype erroValue) ())
+(defvar |$TestOptions| ())
+;; following in defined in word.boot
+(defun |bootFind| (word) ())
+;; following 3 are replacements for g-util.boot
+(define-function '|isLowerCaseLetter| #'LOWER-CASE-P)
+(define-function '|isUpperCaseLetter| #'UPPER-CASE-P)
+(define-function '|isLetter| #'ALPHA-CHAR-P)
+;; reset from /spad/lisp/setq.lisp
+(setq |$consistencyCheck| ()) ;; prevents wasting time checking consistency
+
+
+#+(or :CCL (and :lucid :ibm/370))
+(setq vmlisp::$current-directory (truename "."))
+#-(or :CCL (and :lucid :ibm/370))
+(setq vmlisp::$current-directory (make-directory *default-pathname-defaults*))
+
+(defvar *msghash* nil "hash table keyed by msg number")
+
+(defun cacheKeyedMsg (file)
+  (let ((line "") (msg "") key)
+   (with-open-file (in file)
+    (catch 'done
+     (loop
+      (setq line (read-line in nil nil))
+      (cond
+       ((null line)
+	 (when key
+	  (setf (gethash key *msghash*) msg))
+	  (throw 'done nil))
+       ((= (length line) 0))
+       ((char= (schar line 0) #\S)
+	 (when key
+	  (setf (gethash key *msghash*) msg))
+	 (setq key (intern line "BOOT"))
+	 (setq msg ""))
+       ('else
+	(setq msg (concatenate 'string msg line)))))))))
+
+(defun |fetchKeyedMsg| (key ignore)
+ (declare (ignore ignore))
+ (setq key (|object2Identifier| key))
+ (unless *msghash*
+  (setq *msghash* (make-hash-table))
+  (cacheKeyedMsg |$defaultMsgDatabaseName|))
+ (gethash key *msghash*))
+
+#+:AKCL (proclaim '(ftype (function (t) t) identity))
+#+:AKCL (defun identity (x) x)
+
+(setq identity #'identity) ;to make LispVM code for handling constants to work
+
+(|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|)
+
+(defun |rebuild| (filemode)
+ "rebuild MODEMAP.DAASE, exit lisp with bad return code on failure"
+ (let ((returncode -16))
+  (unwind-protect
+   (let (|$databaseQueue| |$e|)
+    (declare (special |$databaseQueue| |$e|))
+    (|clearConstructorAndLisplibCaches|)
+    (setq |$databaseQueue| nil)
+    (setq |$e| (cons (cons nil nil) nil))
+    (|buildDatabase| filemode t)
+    (setq |$IOindex| 1)
+    (setq |$InteractiveFrame| (cons (cons nil nil) nil))
+    (setq returncode 0))
+   (unless (zerop returncode) (bye returncode)))))
+
+#+:dos
+(setq vmlisp::$current-directory (truename "."))
+#+:dos
+(setq vmlisp::$spadroot "/spad/mnt/dos")
+#+:dos
+(defun user-homedir-pathname ()
+ (truename "."))
+
+(defun boot::|printCopyright| ()
+ (format t "there is no such thing as a simple job -- ((iHy))~%"))
+
+(defun |setViewportProcess| ()
+  (setq |$ViewportProcessToWatch|
+     (stringimage (CDR
+	  (|processInteractive|	 '(|key| (|%%| -2)) NIL) ))))
+
+(defun |waitForViewport| ()
+  (progn
+   (do ()
+       ((not (zerop (obey
+	 (concat
+	  "ps "
+	  |$ViewportProcessToWatch|
+	  " > /dev/null")))))
+       ())
+   (|sockSendInt| |$MenuServer| 1)
+   (|setIOindex| (- |$IOindex| 3))
+  )
+)
+
+
+(defun |makeVector| (els type)
+ (make-array (length els) :element-type (or type t) :initial-contents els))
+
+
+(defun |makeList| (size el) (make-list size :initial-element el) )
+
+#+:akcl
+(defun print-xdr-stream (x y z) (format y "XDR:~A" (xdr-stream-name x)))
+#+:akcl
+(defstruct (xdr-stream
+		(:print-function  print-xdr-stream))
+           "A structure to hold XDR streams. The stream is printed out."
+           (handle ) ;; this is what is used for xdr-open xdr-read xdr-write
+           (name ))  ;; this is used for printing
+#+(and :gcl (not (or :dos :win32)))
+(defun |xdrOpen| (str dir) (make-xdr-stream :handle (system:xdr-open str) :name str))
+#+:CCL
+(defun |xdrOpen| (str dir) (xdr-open str dir) )
+#+(and :gcl (or :dos :win32))
+(defun |xdrOpen| (str dir) (format t "xdrOpen called"))
+
+#+(and :akcl (not (or :dos :win32)))
+(defun |xdrRead| (xstr r) (system:xdr-read (xdr-stream-handle xstr) r) )
+#+:CCL
+(defun |xdrRead| (xstr r) (xdr-read xstr r) )
+#+(and :gcl (or :dos :win32))
+(defun |xdrRead| (str) (format t "xdrRead called"))
+
+#+(and :akcl (not (or :dos :win32)))
+(defun |xdrWrite| (xstr d) (system:xdr-write (xdr-stream-handle xstr) d) )
+#+:CCL
+(defun |xdrWrite| (xstr d) (xdr-write xstr d) )
+#+(and :gcl (or :dos :win32))
+(defun |xdrWrite| (str) (format t "xdrWrite called"))
+
+;; here is a test for XDR
+;; (setq *print-array* T)
+;; (setq foo (open "xdrtest" :direction :output))
+;; (setq xfoo (|xdrOpen| foo))
+;; (|xdrWrite| xfoo "hello: This contains an integer, a float and a float array")
+;; (|xdrWrite| xfoo 42)
+;; (|xdrWrite| xfoo 3.14159)
+;; (|xdrWrite| xfoo (make-array 10 :element-type 'long-float :initial-element 2.78111D12))
+;; (close foo)
+;; (setq foo (open "xdrtest" :direction :input))
+;; (setq xfoo (|xdrOpen| foo))
+;; (|xdrRead| xfoo "")
+;; (|xdrRead| xfoo 0)
+;; (|xdrRead| xfoo 0.0)
+;; (|xdrRead| xfoo (make-array 10 :element-type 'long-float ))
+;; (setq *print-array* NIL)
+
+;; clearParserMacro has problems as boot code (package notation)
+;; defined here in Lisp
+;;--------------------> NEW DEFINITION (see i-syscmd.boot.pamphlet)
+(DEFUN |clearParserMacro| (|macro|)
+  (PROG ()
+    (RETURN (COND
+       ((NULL (IFCDR (|assoc| |macro| |$pfMacros|))) NIL)
+       ((QUOTE T) (SPADLET |$pfMacros|
+          (REMALIST |$pfMacros| |macro|)))))))
+;
+
+(setq /MAJOR-VERSION 2)
+(setq echo-meta nil)
+(defun /versioncheck (n) (unless (= n /MAJOR-VERSION) (throw 'versioncheck -1)))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} CMUCL {\bf src/interp/util.lisp.pamphlet}
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pathname.boot.pamphlet b/src/interp/pathname.boot.pamphlet
new file mode 100644
index 00000000..300d2c41
--- /dev/null
+++ b/src/interp/pathname.boot.pamphlet
@@ -0,0 +1,165 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pathname.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- This file implements the Common Lisp pathname functions for
+-- Lisp/VM.  On VM, a filename is 3-list consisting of the filename,
+-- filetype and filemode. We also UPCASE everything.
+ 
+-- This file also contains some other VM specific functions for
+-- dealing with files.
+ 
+--% Common Lisp Pathname Functions
+ 
+pathname? p == p=[] or PATHNAMEP p
+ 
+pathname p ==
+  p = [] => p
+  PATHNAMEP p => p
+  not PAIRP p => PATHNAME p
+  if #p>2 then p:=[p.0,p.1]
+  PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p)
+ 
+namestring p == NAMESTRING pathname p
+ 
+pathnameName p == PATHNAME_-NAME pathname p
+ 
+pathnameType p == PATHNAME_-TYPE pathname p
+ 
+pathnameTypeId p == UPCASE object2Identifier pathnameType p
+ 
+pathnameDirectory p ==
+   NAMESTRING MAKE_-PATHNAME(LispKeyword '"DIRECTORY",PATHNAME_-DIRECTORY pathname p)
+ 
+deleteFile f == _$ERASE pathname f
+ 
+isExistingFile f ==
+--  p := pathname f
+  --member(p,$existingFiles) => true
+  if MAKE_-INPUT_-FILENAME f
+    then
+      --$existingFiles := [p,:$existingFiles]
+      true
+    else false
+ 
+--% Scratchpad II File Name Functions
+ 
+makePathname(name,type,dir) ==
+  -- Common Lisp version of this will have to be written
+  -- using MAKE-PATHNAME and the optional args.
+  pathname [object2String name,object2String type]
+ 
+mergePathnames(a,b) ==
+  (fn := pathnameName(a)) = '"*" => b
+  fn ^= pathnameName(b) => a
+  (ft := pathnameType(a)) = '"*" => b
+  ft ^= pathnameType(b) => a
+  (fm := pathnameDirectory(a)) = ['"*"] => b
+  a
+ 
+isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir)
+ 
+-- the next function is an improved version of the one in DEBUG LISP
+ 
+_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile)
+ 
+newMKINFILENAM(infile) ==
+  NULL infile => nil
+  file := infile := pathname infile
+  repeat
+    fn := pathnameName file
+    nfile := $FINDFILE (file,$sourceFileTypes)
+    null nfile =>
+      nfile := file
+      if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL)
+      else              sayKeyedMsg("S2IL0003",[namestring file])
+      ans := queryUserKeyedMsg("S2IL0017",NIL)
+      if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2
+      else n := 1
+      nfn := UPCASE STRING2ID_-N(ans,n)
+      (nfn = 0) or (nfn = 'QUIT) =>
+        sayKeyedMsg("S2IL0018",NIL)
+        THROW('FILENAM,NIL)
+      nfn = 'CREATE => return 'fromThisLoop
+      file := pathname ans
+    return 'fromThisLoop
+  if nfile then pathname nfile
+  else NIL
+ 
+ 
+getFunctionSourceFile fun ==
+  null (f := getFunctionSourceFile1 fun) => NIL
+  if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f
+  f
+ 
+getFunctionSourceFile1 fun ==
+  -- returns NIL or [fn,ft,fm]
+  (file := KDR GETL(fun,'DEFLOC)) => pathname file
+  null ((fileinfo := FUNLOC fun) or
+    (fileinfo := FUNLOC unabbrev fun)) =>
+      u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u)
+      NIL
+  3 = #fileinfo =>
+    [fn,ft,$FUNCTION] := fileinfo
+    newMKINFILENAM pathname [fn,ft]
+  [fn,$FUNCTION] := fileinfo
+  newMKINFILENAM pathname [fn]
+ 
+updateSourceFiles p ==
+  p := pathname p
+  p := pathname [pathnameName p, pathnameType p, '"*"]
+  if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then
+    $sourceFiles := insert(p, $sourceFiles)
+  p
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pf2atree.boot.pamphlet b/src/interp/pf2atree.boot.pamphlet
new file mode 100644
index 00000000..29e85ad1
--- /dev/null
+++ b/src/interp/pf2atree.boot.pamphlet
@@ -0,0 +1,575 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pf2atree.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- not hooked in yet
+
+-- BB parser tree to interpreter vectorized attributed trees.
+-- Used to interface the BB parser
+-- technology to the interpreter.  The input is a parseTree and the
+-- output is an interpreter attributed tree.
+
+SETANDFILEQ($useParserSrcPos, true)
+SETANDFILEQ($transferParserSrcPos, true)
+
+pf2Sexpr pf == packageTran (pf2Sex1)(pf)
+
+pf2Atree pf ==
+    (intUnsetQuiet)()
+
+    $insideRule:        local := false
+    $insideApplication: local := false
+    $insideSEQ:         local := false
+
+    -- we set the following because we will be using some things
+    -- within pf2sex.boot and they are in the spadcomp package.
+
+    ($insideRule):        local := false
+    ($insideApplication): local := false
+    ($insideSEQ):         local := false
+
+    pf2Atree1 pf
+
+pf2Atree1 pf ==
+    -- some simple things that are really just S-expressions
+
+    (pfNothing?)(pf) =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfSymbol?) pf =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfLiteral?)(pf) =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfId?) pf =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+
+    -- Now some compound forms
+
+    (pfApplication?)(pf) =>
+        pfApplication2Atree pf
+
+    (pfTuple?)(pf) =>
+        [mkAtreeNodeWithSrcPos("Tuple",pf),
+            :[pf2Atree1 x for x in (pf0TupleParts)(pf)]]
+
+    (pfIf?)(pf) =>
+        condPf      := (pfIfCond)(pf)
+        condPart    := pf2Atree1 condPf
+        thenPart    := pf2Atree1 (pfIfThen)(pf)
+        elsePart    := pf2Atree1 (pfIfElse)(pf)
+        ifPart      := mkAtreeNodeWithSrcPos("IF", pf)
+        thenPart = "noBranch" =>
+            [ifPart, [mkAtreeNodeWithSrcPos("not", condPf), condPart],
+                elsePart, thenPart]
+        [ifPart, condPart, thenPart, elsePart]
+
+    (pfTagged?)(pf) =>
+        tag := (pfTaggedTag)(pf)
+        tagPart :=
+            (pfTuple?) tag =>
+                ["Tuple", :[pf2Sexpr(arg) for arg in (pf0TupleParts)(tag)]]
+            pf2Sexpr(tag)
+        [mkAtreeNodeWithSrcPos("Declare",pf), tagPart,
+            pf2Sexpr((pfTaggedExpr)(pf))]
+
+    (pfCoerceto?)(pf) =>
+        [mkAtreeNodeWithSrcPos("COERCE",pf),
+            pf2Atree1 (pfCoercetoExpr)(pf),
+                pf2Sexpr((pfCoercetoType)(pf))]
+
+    (pfPretend?)(pf) =>
+        [mkAtreeNodeWithSrcPos("pretend",pf),
+            pf2Atree1 (pfPretendExpr)(pf),
+                pf2Sexpr((pfPretendType)(pf))]
+
+    (pfFromdom?)(pf) =>
+        op := packageTran (opTran)(pf2Sexpr((pfFromdomWhat)(pf)))
+        if op = "braceFromCurly" then op := "SEQ"         -- ??
+
+        op = 0 =>
+            -- 0$Foo => Zero()$Foo
+            [mkAtreeNodeWithSrcPos("Dollar",pf),
+                pf2Sexpr((pfFromdomDomain)(pf)),
+                    [mkAtreeNodeWithSrcPos("Zero",pf)]]
+        op = 1 =>
+            -- 1$Foo => One()$Foo
+            [mkAtreeNodeWithSrcPos("Dollar",pf),
+                pf2Sexpr((pfFromdomDomain)(pf)),
+                    [mkAtreeNodeWithSrcPos("One",pf)]]
+        INTEGERP op =>
+            -- n$Foo => n * One()$Foo
+            [mkAtreeNodeWithSrcPos("*",pf),
+                mkAtree1WithSrcPos(op,pf),
+                    [mkAtreeNodeWithSrcPos("Dollar",pf),
+                        pf2Sexpr((pfFromdomDomain)(pf)),
+                            [mkAtreeNodeWithSrcPos("One",pf)]]]
+
+        [mkAtreeNodeWithSrcPos("Dollar",pf),
+            pf2Sexpr((pfFromdomDomain)(pf)),
+                mkAtreeNodeWithSrcPos(op,pf)]
+
+    (pfSequence?)(pf) =>
+        pfSequence2Atree pf
+
+    (pfExit?)(pf) =>
+        $insideSEQ =>
+            [mkAtreeNodeWithSrcPos("exit",pf),
+                pf2Atree1 (pfExitCond)(pf),
+                    pf2Atree1 (pfExitExpr)(pf)]
+        [mkAtreeNodeWithSrcPos("IF",pf),
+             pf2Atree1 (pfExitCond)(pf),
+                pf2Atree1 (pfExitExpr)(pf), "noBranch"]
+
+    (pfLoop?)(pf) =>
+        [mkAtreeNodeWithSrcPos("REPEAT",pf),
+            :loopIters2Atree  (pf0LoopIterators)(pf)]
+
+    (pfCollect?)(pf) =>
+        pfCollect2Atree(pf)
+
+    (pfForin?)(pf) =>
+        ["IN", :[pf2Atree1 x for x in (pf0ForinLhs)(pf)],
+            pf2Atree1 (pfForinWhole)(pf)]
+
+    (pfWhile?)(pf) =>
+        ["WHILE", pf2Atree1((pfWhileCond)(pf))]
+
+    (pfSuchthat?)(pf) =>
+        $insideRule = 'left =>
+            keyedSystemError('"S2GE0017", ['"pf2Atree1: pfSuchThat"])
+        ["SUCHTHAT", pf2Atree1 (pfSuchthatCond)(pf)]
+
+    (pfDo?)(pf) =>
+        pf2Atree1 (pfDoBody)(pf)
+
+--  (pfTyped?)(pf) =>
+--    type := pfTypedType pf
+--    pfNothing? type => pf2Atree1 pfTypedId pf
+--    [":", pf2Atree1 pfTypedId pf, pf2Atree1 pfTypedType pf]
+
+    (pfAssign?)(pf) =>
+        -- declarations on the lhs are broken out into another
+        -- statement preceding the LET of the id(s)
+        lhsThings := (pf0AssignLhsItems)(pf)
+        if #lhsThings = 1 and (pfTuple?)(first lhsThings) then
+            lhsThings := (pf0TupleParts)(first lhsThings)
+        decls := nil
+        ids   := nil
+        for x in lhsThings repeat
+            (pfTagged?)(x) =>
+                decls := [x, :decls]
+                ids   := [(pfTaggedTag)(x), :ids]
+            ids   := [x, :ids]
+        idList := [pf2Atree1 x for x in reverse ids]
+        if #idList ^= 1 then idList :=
+            [mkAtreeNodeWithSrcPos("Tuple",pf), :idList]
+        else idList := first idList
+        x := [mkAtreeNodeWithSrcPos("LET",pf),
+            idList, pf2Atree1 (pfAssignRhs)(pf)]
+        decls =>
+            [mkAtreeNodeWithSrcPos("SEQ",pf),
+                :[pf2Atree1 decl for decl in nreverse decls], x]
+        x
+
+--  (pfDefinition?)(pf) =>
+--      pfDefinition2Atree pf
+
+--  (pfLambda?)(pf) =>
+--    pfLambda2Atree pf
+--  (pfRestrict?)(pf) =>
+--    ["@", pf2Atree1 pfRestrictExpr pf, pf2Atree1 pfRestrictType pf]
+
+    (pfFree?)(pf) =>
+        [mkAtreeNodeWithSrcPos("free",pf),
+            :[pf2Atree1 item for item in (pf0FreeItems)(pf)]]
+    (pfLocal?)(pf) =>
+        [mkAtreeNodeWithSrcPos("local",pf),
+            :[pf2Atree1 item for item in (pf0LocalItems)(pf)]]
+
+    (pfWrong?)(pf) =>
+        spadThrow()
+
+    -- next 3 are probably be handled in pfApplication2Atree
+
+    (pfAnd?)(pf) =>
+        [mkAtreeNodeWithSrcPos("and",pf),
+            pf2Atree1 (pfAndLeft)(pf),
+                pf2Atree1 (pfAndRight)(pf)]
+    (pfOr?)(pf) =>
+        [mkAtreeNodeWithSrcPos("or",pf),
+            pf2Atree1 (pfOrLeft)(pf),
+                pf2Atree1 (pfOrRight)(pf)]
+    (pfNot?)(pf) =>
+        [mkAtreeNodeWithSrcPos("not",pf),
+            pf2Atree1 (pfNotArg)(pf)]
+
+--  (pfNovalue?)(pf) =>
+--    intSetQuiet()
+--    ["SEQ", pf2Atree1 pfNovalueExpr pf]
+--  (pfRule?)(pf) =>
+--    pfRule2Atree pf
+
+    (pfBreak?)(pf) =>
+        [mkAtreeNodeWithSrcPos("break",pf), (pfBreakFrom)(pf)]
+
+    (pfMacro?)(pf) =>
+        tree := mkAtree1WithSrcPos('(void), pf)
+        putValue(tree,objNewWrap(voidValue(),$Void))
+        putModeSet(tree,[$Void])
+        tree
+
+    (pfReturn?)(pf) =>
+        [mkAtreeNodeWithSrcPos("return",pf),
+            pf2Atree1 (pfReturnExpr)(pf)]
+
+    (pfIterate?)(pf) =>
+        [mkAtreeNodeWithSrcPos("iterate",pf)]
+
+--  (pfWhere?)(pf) =>
+--    args := [pf2Atree1 p for p in pf0WhereContext pf]
+--    #args = 1 =>
+--      ["where", pf2Atree1 pfWhereExpr pf, :args]
+--    ["where", pf2Atree1 pfWhereExpr pf, ["SEQ", :args]]
+
+    mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+
+--  keyedSystemError('"S2GE0017", ['"pf2Atree1"])
+--
+
+pfApplication2Atree pf ==
+    $insideApplication:             local := true
+    ($insideApplication): local := true
+
+    opPf := (pfApplicationOp)(pf)
+    op := packageTran ((opTran)(pfOp2Sex)(opPf))
+    op = "->" =>
+        args := (pf0TupleParts)((pfApplicationArg)(pf))
+        if (pfTuple?)(CAR args) then
+            typeList := [pf2Atree1 arg for arg in (pf0TupleParts)(CAR args)]
+        else
+            typeList := [pf2Atree1 CAR args]
+        args := [pf2Atree1 CADR args, :typeList]
+        [mkAtreeNodeWithSrcPos("Mapping", opPf), :args]
+
+    (symEqual)(op, '":") and $insideRule = 'left =>
+          [mkAtreeNodeWithSrcPos("multiple",opPf),
+              pf2Atree (pfApplicationArg)(pf)]
+
+    (symEqual)(op, '"?") and $insideRule = 'left =>
+          [mkAtreeNodeWithSrcPos("optional",opPf),
+              pf2Atree (pfApplicationArg)(pf)]
+
+    args := (pfApplicationArg)(pf)
+
+    (pfTuple?)(args) =>
+--!     symEqual(op, '"|") and $insideRule = 'left =>
+--!       pfSuchThat2Atree args
+        argAtree := [pf2Atree1 arg for arg in (pf0TupleParts)(args)]
+
+        (symEqual)(op, '">") =>
+            [mkAtreeNodeWithSrcPos("<",opPf), :reverse(argAtree)]
+        (symEqual)(op, '">=") =>
+            [mkAtreeNodeWithSrcPos("not",opPf),
+                [mkAtreeNodeWithSrcPos("<",opPf), :argAtree]]
+        (symEqual)(op, '"<=") =>
+            [mkAtreeNodeWithSrcPos("not",opPf),
+                [mkAtreeNodeWithSrcPos("<",opPf), :reverse(argAtree)]]
+        (symEqual)(op, '"AND") =>
+            [mkAtreeNodeWithSrcPos("and",opPf), :argAtree]
+        (symEqual)(op, '"OR") =>
+            [mkAtreeNodeWithSrcPos("or",opPf), :argAtree]
+        (symEqual) (op, '"Iterate") =>
+            [mkAtreeNodeWithSrcPos("iterate",opPf)]
+        (symEqual)(op, '"by") =>
+            [mkAtreeNodeWithSrcPos("BY",opPf), :argAtree]
+        (symEqual)(op, '"braceFromCurly") =>
+            argAtree and getUnname first argAtree = "SEQ" => argAtree
+            [mkAtreeNodeWithSrcPos("SEQ",opPf), :argAtree]
+        op is [qt, realOp] and (symEqual)(qt, '"QUOTE") =>
+            [mkAtreeNodeWithSrcPos("applyQuote",opPf),
+                mkAtreeNodeWithSrcPos(op,opPf), :argAtree]
+--!     val := (hasOptArgs?)(argSex) => [op, :val]
+        -- handle package call
+        (pfFromdom?)(opPf) =>
+            opAtree := pf2Atree1 opPf
+            [CAR opAtree, CADR opAtree, [CADDR opAtree, :argAtree]]
+        -- regular call
+        [mkAtreeNodeWithSrcPos(op,opPf), :argAtree]
+
+    op is [qt, realOp] and (symEqual)(qt, '"QUOTE") =>
+       [mkAtreeNodeWithSrcPos("applyQuote",opPf),
+           mkAtreeNodeWithSrcPos(op,opPf), pf2Atree1 args]
+    (symEqual)(op, '"braceFromCurly") =>
+        x := pf2Atree1 args
+        x and getUnname x = "SEQ" => x
+        [mkAtreeNodeWithSrcPos("SEQ",opPf), x]
+    (symEqual)(op, '"by") =>
+        [mkAtreeNodeWithSrcPos("BY",opPf), pf2Atree1 args]
+    -- handle package call
+    (pfFromdom?)(opPf) =>
+        opAtree := pf2Atree1 opPf
+        [CAR opAtree, CADR opAtree, [CADDR opAtree, pf2Atree1 args]]
+    -- regular call
+    [mkAtreeNodeWithSrcPos(op,opPf), pf2Atree1 args]
+
+--  pfDefinition2Atree pf ==
+--  --! $insideApplication =>
+--  --!     ["OPTARG", pf2Atree1 CAR pf0DefinitionLhsItems pf,
+--  --!         pf2Atree1 pfDefinitionRhs pf]
+--      idList := [pf2Atree1 x for x in (pf0DefinitionLhsItems)(pf)]
+--      #idList ^= 1 =>
+--          systemError '"lhs of definition must be a single item in the interpreter"
+--      id := first idList
+--      rhs := (pfDefinitionRhs)(pf)
+--      [argList, :body] := pfLambdaTran rhs
+--      ["DEF", (argList = 'id => id; [id, :argList]), :body]
+
+--  pfLambdaTran pf ==
+--    pfLambda? pf =>
+--      argTypeList := nil
+--      argList := nil
+--      for arg in pf0LambdaArgs pf repeat
+--        pfTyped? arg =>
+--          argList := [pfCollectArgTran pfTypedId arg, :argList]
+--          pfNothing? pfTypedType arg =>
+--            argTypeList := [nil, :argTypeList]
+--          argTypeList := [pf2Atree1 pfTypedType arg, :argTypeList]
+--        systemError '"definition args should be typed"
+--      argList := nreverse argList
+--      retType :=
+--        pfNothing? pfLambdaRets pf => nil
+--        pf2Atree1 pfLambdaRets pf
+--      argTypeList := [retType, :nreverse argTypeList]
+--      [argList, :[argTypeList, [nil for arg in argTypeList],
+--        pf2Atree1 pfLambdaBody pf]]
+--    ['id, :['(()), '(()), pf2Atree1 pf]]
+--
+--  pfLambda2Atree pf ==
+--    [argList, :body] := pfLambdaTran pf
+--    ["ADEF", argList, :body]
+--
+--  pfCollectArgTran pf ==
+--    pfCollect? pf =>
+--      conds := [pf2Atree1 x for x in pfParts pfCollectIterators pf]
+--      id := pf2Atree1 pfCollectBody pf
+--      conds is [["|", cond]] =>
+--        ["|", id, cond]
+--      [id, :conds]
+--    pf2Atree1 pf
+--
+
+pfSequence2Atree pf ==
+    $insideSEQ:             local := true
+    ($insideSEQ): local := true
+
+    seq := pfSequence2Atree0([pf2Atree1 x for x in (pf0SequenceArgs)(pf)], pf)
+    seqSex := (pfSequence2Sex0)([pf2Sexpr(x) for x in (pf0SequenceArgs)(pf)])
+    seqSex is ["SEQ", :ruleList] and ruleList is [["rule", :.], :.] =>
+        [mkAtreeNodeWithSrcPos("ruleset",pf),
+            [mkAtreeNodeWithSrcPos("construct",pf), :rest seq]]
+    seq
+
+pfSequence2Atree0(seqList, pf) ==
+    null seqList => "noBranch"
+    seqTranList := []
+    while seqList ^= nil repeat
+        item := first seqList
+        item is [exitVal, cond, value] and getUnname(exitVal) = "exit" =>
+            item := [mkAtreeNodeWithSrcPos("IF",pf), cond, value,
+                pfSequence2Atree0(rest seqList, pf)]
+            seqTranList := [item, :seqTranList]
+            seqList := nil
+        seqTranList := [item ,:seqTranList]
+        seqList := rest seqList
+    #seqTranList = 1 => first seqTranList
+    [mkAtreeNodeWithSrcPos("SEQ",pf), :nreverse seqTranList]
+
+--
+--  float2Atree num ==
+--    eIndex := SEARCH('"e", num)
+--    mantPart :=
+--      eIndex => SUBSEQ(num, 0, eIndex)
+--      num
+--    expPart := (eIndex => READ_-FROM_-STRING SUBSEQ(num, eIndex+1); 0)
+--    dotIndex := SEARCH('".", mantPart)
+--    intPart :=
+--      dotIndex => READ_-FROM_-STRING SUBSEQ(mantPart, 0, dotIndex)
+--      READ_-FROM_-STRING mantPart
+--    fracPartString :=
+--      dotIndex => SUBSEQ(mantPart, dotIndex+1)
+--      '"0"
+--    bfForm := MAKE_-FLOAT(intPart, READ_-FROM_-STRING fracPartString,
+--      LENGTH fracPartString, expPart)
+--    [., frac, :exp] := bfForm
+--    [["$elt", intNewFloat(), 'float], frac, exp, 10]
+--
+
+loopIters2Atree iterList ==
+    -- could probably do a better job of getting accurate SrcPos info onto parts
+    result := nil
+    for iter in iterList repeat
+        -- ON and UNTIL forms are no longer supported
+        sex := pf2Sexpr(iter)
+        sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(incr, iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(incr, iter), mkAtree1WithSrcPos(j,iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, ['SEGMENT, i, j]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(1,iter), mkAtree1WithSrcPos(j,iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, s] =>
+            newIter := ["IN", var, mkAtree1 s]
+            result := [newIter, :result]
+        result := [pf2Atree1(iter), :result]
+    nreverse result
+
+pfCollect2Atree pf ==
+    atree := [mkAtree1WithSrcPos("COLLECT",pf),
+        :loopIters2Atree (pfParts)((pfCollectIterators)(pf)),
+            pf2Atree1 (pfCollectBody)(pf)]
+
+    -- next are for what appears to a parser screw-up
+    sex := ["COLLECT",
+        :(loopIters2Sex)((pfParts)((pfCollectIterators)(pf))),
+            pf2Sexpr (pfCollectBody)(pf)]
+    sex is ["COLLECT", ["|", cond], var] and SYMBOLP var =>
+        [., [., condAtree], varAtree] := atree
+        ["SUCHTHAT", varAtree, condAtree]
+
+    atree
+
+--
+--  pfRule2Atree pf ==
+--    $quotedOpList:local := nil
+--    $predicateList:local := nil
+--    $multiVarPredicateList:local := nil
+--    lhs := pfLhsRule2Atree pfRuleLhsItems pf
+--    rhs := pfRhsRule2Atree pfRuleRhs pf
+--    lhs := ruleLhsTran lhs
+--    rulePredicateTran
+--      $quotedOpList => ["rule", lhs, rhs, ["construct", :$quotedOpList]]
+--      ["rule", lhs, rhs]
+--
+--
+--  ruleLhsTran ruleLhs ==
+--    for pred in $predicateList repeat
+--      [name, predLhs, :predRhs] := pred
+--      vars := patternVarsOf predRhs
+--      CDR vars =>  -- if there is more than one patternVariable
+--        ruleLhs := NSUBST(predLhs, name, ruleLhs)
+--        $multiVarPredicateList := [pred, :$multiVarPredicateList]
+--      predicate :=
+--        [., var] := predLhs
+--        ["suchThat", predLhs, ["ADEF", [var],
+--          '((Boolean) (Expression (Integer))), '(() ()), predRhs]]
+--      ruleLhs := NSUBST(predicate, name, ruleLhs)
+--    ruleLhs
+--
+--  rulePredicateTran rule ==
+--    null $multiVarPredicateList => rule
+--    varList := patternVarsOf [rhs for [.,.,:rhs] in $multiVarPredicateList]
+--    predBody :=
+--      CDR $multiVarPredicateList =>
+--        ['AND, :[:pvarPredTran(rhs, varList) for [.,.,:rhs] in
+--          $multiVarPredicateList]]
+--      [[.,.,:rhs],:.] := $multiVarPredicateList
+--      pvarPredTran(rhs, varList)
+--    ['suchThat, rule,
+--     ['construct, :[["QUOTE", var] for var in varList]],
+--      ['ADEF, '(predicateVariable),
+--       '((Boolean) (List (Expression (Integer)))), '(() ()),
+--        predBody]]
+--
+--  pvarPredTran(rhs, varList) ==
+--    for var in varList for i in 1.. repeat
+--      rhs := NSUBST(['elt, 'predicateVariable, i], var, rhs)
+--    rhs
+--
+--  patternVarsOf expr ==
+--    patternVarsOf1(expr, nil)
+--
+--  patternVarsOf1(expr, varList) ==
+--    NULL expr => varList
+--    ATOM expr =>
+--      null SYMBOLP expr => varList
+--      SymMemQ(expr, varList) => varList
+--      [expr, :varList]
+--    expr is [op, :argl] =>
+--      for arg in argl repeat
+--        varList := patternVarsOf1(arg, varList)
+--      varList
+--    varList
+--
+--  pfLhsRule2Atree lhs ==
+--    $insideRule: local := 'left
+--    ($insideRule): local := 'left
+--    pf2Atree1 lhs
+--
+--
+--  pfRhsRule2Atree rhs ==
+--    $insideRule: local := 'right
+--    ($insideRule): local := 'right
+--    pf2Atree1 rhs
+--
+
+--  pfSuchThat2Atree args ==
+--    name := GENTEMP()
+--    argList := pf0TupleParts args
+--    lhsSex := pf2Atree1 CAR argList
+--    rhsSex := pf2Atree CADR argList
+--    $predicateList := [[name, lhsSex, :rhsSex], :$predicateList]
+--    name
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pf2sex.boot.pamphlet b/src/interp/pf2sex.boot.pamphlet
new file mode 100644
index 00000000..a5ea9b6e
--- /dev/null
+++ b/src/interp/pf2sex.boot.pamphlet
@@ -0,0 +1,526 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pf2sex.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{Changes}
+In the function [[float2Sex]] we need to special case the return value
+if the global variable [[$useBFasDefault]] is set to true. This variable
+allows ``big'' floating point values.
+
+The change can be seen from this email from Greg Vanuxem:
+\begin{verbatim}
+Attached is the patch (pf2sex.patch) that allows the use 
+of DoubleFloat by default in the interpreter. Test it.
+
+(1) -> 1.7+7.2
+
+   (1)  8.9
+                               Type: Float
+(2) -> 1.7-7.2
+
+   (2)  - 5.5
+                               Type: Float
+(3) -> -1.7-7.2
+
+   (3)  - 8.9
+                               Type: Float
+(4) -> )boot $useBFasDefault:=false
+
+(SPADLET |$useBFasDefault| NIL)
+Value = NIL
+
+(4) -> 1.7+7.2
+
+   (4)  8.9000000000000004
+                               Type: DoubleFloat
+(5) -> 1.7-7.2
+
+   (5)  - 5.5
+                               Type: DoubleFloat
+(6) -> -1.7-7.2
+
+   (6)  - 8.9000000000000004
+                               Type: DoubleFloat
+
+
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+$dotdot := INTERN('"..", '"BOOT")
+$specificMsgTags := nil
+
+-- Pftree to s-expression translation.  Used to interface the new parser
+-- technology to the interpreter.  The input is a parseTree and the
+-- output is an old-parser-style s-expression
+
+pf2Sex pf ==
+  intUnsetQuiet()
+  $insideRule:local := false
+  $insideApplication: local := false
+  $insideSEQ: local := false
+  pf2Sex1 pf
+
+pf2Sex1 pf ==
+  pfNothing? pf =>
+    "noBranch"
+  pfSymbol? pf =>
+    $insideRule = 'left =>
+      s := pfSymbolSymbol pf
+      ["constant", ["QUOTE", s]]
+    ["QUOTE", pfSymbolSymbol pf]
+  pfLiteral? pf =>
+    pfLiteral2Sex pf
+  pfId? pf =>
+    $insideRule =>
+      s := pfIdSymbol pf
+      SymMemQ(s, '(%pi %e %i)) => s
+      ["QUOTE", s]
+    pfIdSymbol pf
+  pfApplication? pf =>
+    pfApplication2Sex pf
+  pfTuple? pf =>
+    ["Tuple", :[pf2Sex1 x for x in pf0TupleParts pf]]
+  pfIf? pf =>
+    ['IF, pf2Sex1 pfIfCond pf, pf2Sex1 pfIfThen pf, pf2Sex1 pfIfElse pf]
+  pfTagged? pf =>
+    tag := pfTaggedTag pf
+    tagPart :=
+      pfTuple? tag =>
+        ['Tuple, :[pf2Sex1 arg for arg in pf0TupleParts tag]]
+      pf2Sex1 tag
+    [":", tagPart, pf2Sex1 pfTaggedExpr pf]
+  pfCoerceto? pf =>
+    ["::", pf2Sex1 pfCoercetoExpr pf, pf2Sex1 pfCoercetoType pf]
+  pfPretend? pf =>
+    ["pretend", pf2Sex1 pfPretendExpr pf, pf2Sex1 pfPretendType pf]
+  pfFromdom? pf =>
+    op := opTran  pf2Sex1 pfFromdomWhat pf
+--  if op = "braceFromCurly" then op := "brace"
+    if op = "braceFromCurly" then op := "SEQ"
+    ["$elt", pf2Sex1 pfFromdomDomain pf, op]
+  pfSequence? pf =>
+    pfSequence2Sex pf
+  pfExit? pf =>
+    $insideSEQ => ["exit", pf2Sex1 pfExitCond pf, pf2Sex1 pfExitExpr pf]
+    ["IF", pf2Sex1 pfExitCond pf, pf2Sex1 pfExitExpr pf, "noBranch"]
+  pfLoop? pf =>
+    ["REPEAT", :loopIters2Sex  pf0LoopIterators pf]
+  pfCollect? pf =>
+    pfCollect2Sex pf
+  pfForin? pf =>
+    ["IN", :[pf2Sex1 x for x in pf0ForinLhs pf], pf2Sex1 pfForinWhole pf]
+  pfWhile? pf =>
+    ["WHILE", pf2Sex1 pfWhileCond pf]
+  pfSuchthat? pf =>
+    $insideRule = 'left =>
+      keyedSystemError('"S2GE0017", ['"pf2Sex1: pfSuchThat"])
+    ["|", pf2Sex1 pfSuchthatCond pf]
+  pfDo? pf =>
+    pf2Sex1 pfDoBody pf
+  pfTyped? pf =>
+    type := pfTypedType pf
+    pfNothing? type => pf2Sex1 pfTypedId pf
+    [":", pf2Sex1 pfTypedId pf, pf2Sex1 pfTypedType pf]
+  pfAssign? pf =>
+    idList := [pf2Sex1 x for x in pf0AssignLhsItems pf]
+    if #idList ^= 1 then idList := ['Tuple, :idList]
+    else idList := first idList
+    ["LET", idList, pf2Sex1 pfAssignRhs pf]
+  pfDefinition? pf =>
+    pfDefinition2Sex pf
+  pfLambda? pf =>
+    pfLambda2Sex pf
+  pfMLambda? pf =>
+    "/throwAway"
+  pfRestrict? pf =>
+    ["@", pf2Sex1 pfRestrictExpr pf, pf2Sex1 pfRestrictType pf]
+  pfFree? pf =>
+    ['free, :[pf2Sex1 item for item in pf0FreeItems pf]]
+  pfLocal? pf =>
+    ['local, :[pf2Sex1 item for item in pf0LocalItems pf]]
+  pfWrong? pf =>
+   spadThrow()
+  pfAnd? pf =>
+    ["and", pf2Sex1 pfAndLeft pf, pf2Sex1 pfAndRight pf]
+  pfOr? pf =>
+    ["or", pf2Sex1 pfOrLeft pf, pf2Sex1 pfOrRight pf]
+  pfNot? pf =>
+    ["not", pf2Sex1 pfNotArg pf]
+  pfNovalue? pf =>
+    intSetQuiet()
+    ["SEQ", pf2Sex1 pfNovalueExpr pf]
+  pfRule? pf =>
+    pfRule2Sex pf
+  pfBreak? pf =>
+    ["break", pfBreakFrom pf]
+  pfMacro? pf =>
+    "/throwAway"
+  pfReturn? pf =>
+    ["return", pf2Sex1 pfReturnExpr pf]
+  pfIterate? pf =>
+    ["iterate"]
+  pfWhere? pf =>
+    args := [pf2Sex1 p for p in pf0WhereContext pf]
+    #args = 1 =>
+      ["where", pf2Sex1 pfWhereExpr pf, :args]
+    ["where", pf2Sex1 pfWhereExpr pf, ["SEQ", :args]]
+
+  -- under strange circumstances/piling, system commands can wind
+  -- up in expressions. This just passes it through as a string for
+  -- the user to figure out what happened.
+  pfAbSynOp(pf) = "command" => tokPart(pf)
+
+  keyedSystemError('"S2GE0017", ['"pf2Sex1"])
+
+pfLiteral2Sex pf ==
+  type := pfLiteralClass pf
+  type = 'integer =>
+    READ_-FROM_-STRING pfLiteralString pf
+  type = 'string or type = 'char =>
+    pfLiteralString pf
+  type = 'float =>
+    float2Sex pfLiteralString pf
+  type = 'symbol =>
+    $insideRule =>
+      s := pfSymbolSymbol pf
+      ["QUOTE", s]
+    pfSymbolSymbol pf
+  type = 'expression =>
+      ["QUOTE", pfLeafToken pf]
+  keyedSystemError('"S2GE0017", ['"pfLiteral2Sex: unexpected form"])
+
+symEqual(sym, sym2) == EQ(sym, sym2)
+
+SymMemQ(sy, l) == MEMQ(sy, l)
+
+pmDontQuote? sy ==
+   SymMemQ(sy, '(_+ _- _* _*_* _^ _/ log exp pi sqrt ei li erf ci si dilog _
+              sin cos tan cot sec csc asin acos atan acot asec acsc _
+              sinh cosh tanh coth sech csch asinh acosh atanh acoth asech acsc))
+
+pfOp2Sex pf ==
+  alreadyQuoted := pfSymbol? pf
+  op := pf2Sex1 pf
+  op is ["QUOTE", realOp] =>
+    $insideRule = 'left => realOp
+    $insideRule = 'right =>
+      pmDontQuote? realOp => realOp
+      $quotedOpList := [op, :$quotedOpList]
+      op
+    symEqual(realOp, "|") => realOp
+    symEqual(realOp, ":") => realOp
+    symEqual(realOp, "?") => realOp
+    op
+  op
+
+pfApplication2Sex pf ==
+  $insideApplication: local := true
+  op := pfOp2Sex pfApplicationOp pf
+  op := opTran op
+  op = "->" =>
+    args := pf0TupleParts pfApplicationArg pf
+    if pfTuple? CAR args then
+      typeList := [pf2Sex1 arg for arg in pf0TupleParts CAR args]
+    else
+      typeList := [pf2Sex1 CAR args]
+    args := [pf2Sex1 CADR args, :typeList]
+    ["Mapping", :args]
+  symEqual(op, ":") and $insideRule = 'left =>
+    ["multiple", pf2Sex pfApplicationArg pf]
+  symEqual(op, "?") and $insideRule = 'left =>
+    ["optional", pf2Sex pfApplicationArg pf]
+  args := pfApplicationArg pf
+  pfTuple? args =>
+    symEqual(op, "|") and $insideRule = 'left =>
+      pfSuchThat2Sex args
+    argSex := rest pf2Sex1 args
+    symEqual(op, ">") =>
+      ["<", CADR argSex, CAR argSex]
+    symEqual(op, ">=") =>
+      ["not", ["<", CAR argSex, CADR argSex]]
+    symEqual(op, "<=") =>
+      ["not", ["<", CADR argSex, CAR argSex]]
+--    symEqual(op, "reduce") and (#argSex) = 2 =>
+--      ["REDUCE", first argSex, 0, CADR argSex]
+    symEqual(op, "AND") =>
+      ["and", CAR argSex, CADR argSex]
+    symEqual(op, "OR") =>
+      ["or", CAR argSex, CADR argSex]
+    symEqual(op, "Iterate") =>
+      ["iterate"]
+    symEqual(op, "by") =>
+      ["BY", :argSex]
+    symEqual(op, "braceFromCurly") =>
+--    ["brace", ["construct", :argSex]]
+      argSex is ["SEQ",:.] => argSex
+      ["SEQ", :argSex]
+    op is [qt, realOp] and symEqual(qt, "QUOTE") =>
+       ["applyQuote", op, :argSex]
+    val := hasOptArgs? argSex => [op, :val]
+    [op, :argSex]
+  op is [qt, realOp] and symEqual(qt, "QUOTE") =>
+     ["applyQuote", op, pf2Sex1 args]
+  symEqual(op, "braceFromCurly") =>
+--  ["brace", ["construct", pf2Sex1 args]]
+    x := pf2Sex1 args
+    x is ["SEQ", :.] => x
+    ["SEQ", x]
+  symEqual(op, "by") =>
+      ["BY", pf2Sex1 args]
+  [op, pf2Sex1 args]
+
+hasOptArgs? argSex ==
+  nonOpt := nil
+  opt := nil
+  for arg in argSex repeat
+    arg is ["OPTARG", lhs, rhs] =>
+      opt := [[lhs, rhs], :opt]
+    nonOpt := [arg, :nonOpt]
+  null opt => nil
+  NCONC (nreverse nonOpt, [["construct", :nreverse opt]])
+
+pfDefinition2Sex pf ==
+  $insideApplication =>
+    ["OPTARG", pf2Sex1 CAR pf0DefinitionLhsItems pf,
+     pf2Sex1 pfDefinitionRhs pf]
+  idList := [pf2Sex1 x for x in pf0DefinitionLhsItems pf]
+  #idList ^= 1 =>
+    systemError '"lhs of definition must be a single item in the interpreter"
+  id := first idList
+  rhs := pfDefinitionRhs pf
+  [argList, :body] := pfLambdaTran rhs
+  ["DEF", (argList = 'id => id; [id, :argList]), :body]
+
+pfLambdaTran pf ==
+  pfLambda? pf =>
+    argTypeList := nil
+    argList := nil
+    for arg in pf0LambdaArgs pf repeat
+      pfTyped? arg =>
+        argList := [pfCollectArgTran pfTypedId arg, :argList]
+        pfNothing? pfTypedType arg =>
+          argTypeList := [nil, :argTypeList]
+        argTypeList := [pf2Sex1 pfTypedType arg, :argTypeList]
+      systemError '"definition args should be typed"
+    argList := nreverse argList
+    retType :=
+      pfNothing? pfLambdaRets pf => nil
+      pf2Sex1 pfLambdaRets pf
+    argTypeList := [retType, :nreverse argTypeList]
+    [argList, :[argTypeList, [nil for arg in argTypeList],
+      pf2Sex1 pfLambdaBody pf]]
+  ['id, :['(()), '(()), pf2Sex1 pf]]
+
+pfLambda2Sex pf ==
+  [argList, :body] := pfLambdaTran pf
+  ["ADEF", argList, :body]
+
+pfCollectArgTran pf ==
+  pfCollect? pf =>
+    conds := [pf2Sex1 x for x in pfParts pfCollectIterators pf]
+    id := pf2Sex1 pfCollectBody pf
+    conds is [["|", cond]] =>
+      ["|", id, cond]
+    [id, :conds]
+  pf2Sex1 pf
+
+opTran op ==
+  op = $dotdot => "SEGMENT"
+  op = "[]" => "construct"
+  op = "{}" => "braceFromCurly"
+  op = "IS" => "is"
+  op
+
+pfSequence2Sex pf ==
+  $insideSEQ:local := true
+  seq := pfSequence2Sex0 [pf2Sex1 x for x in pf0SequenceArgs pf]
+  seq is ["SEQ", :ruleList] and ruleList is [["rule", :.], :.] =>
+    ["ruleset", ["construct", :ruleList]]
+  seq
+
+pfSequence2Sex0 seqList ==
+  null seqList => "noBranch"
+  seqTranList := []
+  while seqList ^= nil repeat
+    item := first seqList
+    item is ["exit", cond, value] =>
+      item := ["IF", cond, value, pfSequence2Sex0 rest seqList]
+      seqTranList := [item, :seqTranList]
+      seqList := nil
+    seqTranList := [item ,:seqTranList]
+    seqList := rest seqList
+  #seqTranList = 1 => first seqTranList
+  ["SEQ", :nreverse seqTranList]
+
+float2Sex num ==
+  eIndex := SEARCH('"e", num)
+  mantPart :=
+    eIndex => SUBSEQ(num, 0, eIndex)
+    num
+  expPart := (eIndex => READ_-FROM_-STRING SUBSEQ(num, eIndex+1); 0)
+  dotIndex := SEARCH('".", mantPart)
+  intPart :=
+    dotIndex => READ_-FROM_-STRING SUBSEQ(mantPart, 0, dotIndex)
+    READ_-FROM_-STRING mantPart
+  fracPartString :=
+    dotIndex => SUBSEQ(mantPart, dotIndex+1)
+    '"0"
+  bfForm := MAKE_-FLOAT(intPart, READ_-FROM_-STRING fracPartString,
+    LENGTH fracPartString, expPart)
+  $useBFasDefault =>
+    [., frac, :exp] := bfForm
+    [["$elt", intNewFloat(), 'float], frac, exp, 10]
+  bfForm 
+
+loopIters2Sex iterList ==
+  result := nil
+  for iter in iterList repeat
+    sex := pf2Sex1 iter
+    sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] =>
+      result := [['STEP, var, i, incr], :result]
+    sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] =>
+      result := [['STEP, var, i, incr, j], :result]
+    sex is ['IN, var, ['SEGMENT, i, j]] =>
+      result := [['STEP, var, i, 1, j], :result]
+    result := [sex, :result]
+  nreverse result
+
+pfCollect2Sex pf ==
+  sex := ["COLLECT", :loopIters2Sex pfParts pfCollectIterators pf,
+    pf2Sex1 pfCollectBody pf]
+  sex is ["COLLECT", ["|", cond], var] and SYMBOLP var =>
+    ["|", var, cond]
+  sex
+
+pfRule2Sex pf ==
+  $quotedOpList:local := nil
+  $predicateList:local := nil
+  $multiVarPredicateList:local := nil
+  lhs := pfLhsRule2Sex pfRuleLhsItems pf
+  rhs := pfRhsRule2Sex pfRuleRhs pf
+  lhs := ruleLhsTran lhs
+  rulePredicateTran
+    $quotedOpList => ["rule", lhs, rhs, ["construct", :$quotedOpList]]
+    ["rule", lhs, rhs]
+
+
+ruleLhsTran ruleLhs ==
+  for pred in $predicateList repeat
+    [name, predLhs, :predRhs] := pred
+    vars := patternVarsOf predRhs
+    CDR vars =>  -- if there is more than one patternVariable
+      ruleLhs := NSUBST(predLhs, name, ruleLhs)
+      $multiVarPredicateList := [pred, :$multiVarPredicateList]
+    predicate :=
+      [., var] := predLhs
+      ["suchThat", predLhs, ["ADEF", [var],
+        '((Boolean) (Expression (Integer))), '(() ()), predRhs]]
+    ruleLhs := NSUBST(predicate, name, ruleLhs)
+  ruleLhs
+
+rulePredicateTran rule ==
+  null $multiVarPredicateList => rule
+  varList := patternVarsOf [rhs for [.,.,:rhs] in $multiVarPredicateList]
+  predBody :=
+    CDR $multiVarPredicateList =>
+      ['AND, :[:pvarPredTran(rhs, varList) for [.,.,:rhs] in
+        $multiVarPredicateList]]
+    [[.,.,:rhs],:.] := $multiVarPredicateList
+    pvarPredTran(rhs, varList)
+  ['suchThat, rule,
+   ['construct, :[["QUOTE", var] for var in varList]],
+    ['ADEF, '(predicateVariable),
+     '((Boolean) (List (Expression (Integer)))), '(() ()),
+      predBody]]
+
+pvarPredTran(rhs, varList) ==
+  for var in varList for i in 1.. repeat
+    rhs := NSUBST(['elt, 'predicateVariable, i], var, rhs)
+  rhs
+
+patternVarsOf expr ==
+  patternVarsOf1(expr, nil)
+
+patternVarsOf1(expr, varList) ==
+  NULL expr => varList
+  ATOM expr =>
+    null SYMBOLP expr => varList
+    SymMemQ(expr, varList) => varList
+    [expr, :varList]
+  expr is [op, :argl] =>
+    for arg in argl repeat
+      varList := patternVarsOf1(arg, varList)
+    varList
+  varList
+
+pfLhsRule2Sex lhs ==
+  $insideRule: local := 'left
+  pf2Sex1 lhs
+
+
+pfRhsRule2Sex rhs ==
+  $insideRule: local := 'right
+  pf2Sex1 rhs
+
+pfSuchThat2Sex args ==
+  name := GENTEMP()
+  argList := pf0TupleParts args
+  lhsSex := pf2Sex1 CAR argList
+  rhsSex := pf2Sex CADR argList
+  $predicateList := [[name, lhsSex, :rhsSex], :$predicateList]
+  name
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pile.boot.pamphlet b/src/interp/pile.boot.pamphlet
new file mode 100644
index 00000000..2b457fdb
--- /dev/null
+++ b/src/interp/pile.boot.pamphlet
@@ -0,0 +1,176 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pile.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- insertpiles converts a line-list to a line-forest where
+ 
+-- a line is a token-dequeue and has a column which is an integer.
+-- an A-forest is an A-tree-list
+-- an A-tree has a root which is an A, and subtrees which is an A-forest.
+ 
+-- A forest with more than one tree corresponds to a Scratchpad pile
+-- structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item.
+-- The ( ; and ) tokens are inserted into a >1-forest, otherwise
+-- the root of the first tree is concatenated with its forest.
+-- column t is the number of spaces before the first non-space in line t
+ 
+pileColumn t==CDR tokPosn CAAR t
+pileComment t== EQ(tokType CAAR t,"negcomment")
+pilePlusComment t== EQ(tokType CAAR t,"comment")
+ 
+-- insertpile is used by next so s is non-null
+-- bite off a line-tree, return it and the remaining line-list.
+ 
+insertpile (s)==
+     if npNull s
+     then [false,0,[],s]
+     else
+       [h,t]:=[car s,cdr s]
+       if pilePlusComment h
+       then
+          [h1,t1]:=pilePlusComments s
+          a:=pileTree(-1,t1)
+          cons([pileCforest [:h1,a.2]],a.3)
+       else
+         stream:=CADAR s
+         a:=pileTree(-1,s)
+         cons([[a.2,stream]],a.3)
+ 
+pilePlusComments s==
+      if npNull s
+      then [[],s]
+      else
+       [h,t]:=[car s,cdr s]
+       if pilePlusComment h
+       then
+         [h1,t1]:=pilePlusComments t
+         [cons(h,h1),t1]
+       else [[],s]
+ 
+pileTree(n,s)==
+    if npNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=pileColumn CAR h
+        if hh > n
+        then pileForests(CAR h,hh,t)
+        else [false,n,[],s]
+ 
+eqpileTree(n,s)==
+    if npNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=pileColumn CAR h
+        if hh = n
+        then pileForests(CAR h,hh,t)
+        else [false,n,[],s]
+ 
+pileForest(n,s)==
+     [b,hh,h,t]:= pileTree(n,s)
+     if b
+     then
+       [h1,t1]:=pileForest1(hh,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+pileForest1(n,s)==
+     [b,n1,h,t]:= eqpileTree(n,s)
+     if b
+     then
+       [h1,t1]:=pileForest1(n,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+pileForests(h,n,s)==
+      [h1,t1]:=pileForest(n,s)
+      if npNull h1
+      then [true,n,h,s]
+      else pileForests(pileCtree(h,h1),n,t1)
+ 
+pileCtree(x,y)==dqAppend(x,pileCforest y)
+ 
+-- only enpiles forests with >=2 trees
+ 
+pileCforest x==
+   if null x
+   then []
+   else if null cdr x
+        then
+           f:= car x
+           if EQ(tokPart CAAR f,"IF")
+           then enPile f
+           else f
+        else enPile separatePiles x
+ 
+firstTokPosn t== tokPosn CAAR t
+lastTokPosn  t== tokPosn CADR t
+ 
+separatePiles x==
+  if null x
+  then []
+  else if null cdr x
+       then car x
+       else
+         a:=car x
+         semicolon:=dqUnit tokConstruct("key", "BACKSET",lastTokPosn a)
+         dqConcat [a,semicolon,separatePiles cdr x]
+ 
+enPile x==
+   dqConcat [dqUnit tokConstruct("key","SETTAB",firstTokPosn x),
+             x, _
+             dqUnit tokConstruct("key","BACKTAB",lastTokPosn  x)]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/posit.boot.pamphlet b/src/interp/posit.boot.pamphlet
new file mode 100644
index 00000000..72adfa0c
--- /dev/null
+++ b/src/interp/posit.boot.pamphlet
@@ -0,0 +1,200 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp posit.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+poNoPosition()    == $nopos
+pfNoPosition() == poNoPosition()
+ 
+poNoPosition? pos == EQCAR(pos,'noposition)
+pfNoPosition? pos == poNoPosition? pos
+ 
+pfSourceText pf ==
+    lnString poGetLineObject pfPosn pf
+ 
+pfPosOrNopos pf ==
+    poIsPos? (pos := pfSourcePosition pf) => pos
+    poNoPosition()
+ 
+poIsPos? pos ==
+    PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5
+ 
+lnCreate(extBl, st, gNo, :optFileStuff) ==
+    lNo :=
+        num := IFCAR optFileStuff => num
+        0
+    fN  := IFCAR IFCDR optFileStuff
+    [extBl, st, gNo, lNo, fN]
+ 
+lnString lineObject ==
+    lineObject.1
+ 
+lnExtraBlanks lineObject ==
+    lineObject.0
+ 
+lnGlobalNum lineObject   ==
+    lineObject.2
+ 
+lnSetGlobalNum(lineObject, num) ==
+    lineObject.2 := num
+ 
+lnLocalNum lineObject    ==
+    lineObject.3
+ 
+lnFileName lineObject    ==
+    (fN := lnFileName? lineObject)  => fN
+    ncBug('"there is no file name in %1", [lineObject] )
+ 
+lnFileName? lineObject   ==
+    NOT PAIRP (fN := lineObject.4)  => NIL
+    fN
+ 
+lnPlaceOfOrigin lineObject ==
+    lineObject.4
+ 
+lnImmediate? lineObject  ==
+    not lnFileName? lineObject
+ 
+poGetLineObject posn ==
+    CAR posn
+pfGetLineObject posn == poGetLineObject posn
+ 
+pfSourceToken form ==
+    if pfLeaf? form
+    then pfLeafToken form
+    else if null pfParts form
+         then 'NoToken
+         else pfSourceToken(pfFirst form)
+ 
+pfPosn pf == pfSourcePosition pf
+ 
+pfSourcePosition form ==
+    --null form => pfNoPosition()
+    pfLeaf? form => pfLeafPosition form
+    parts := pfParts form
+    pos := $nopos
+    for p in parts while poNoPosition? pos repeat
+        pos := pfSourcePosition p
+    pos
+ 
+pfSourcePositions form ==
+    if pfLeaf? form
+    then
+     a:=tokPosn form
+     if null a
+     then nil
+     else [a]
+    else  pfSourcePositionlist pfParts form
+ 
+pfSourcePositionlist x==
+      if null x
+      then nil
+      else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x)
+ 
+ 
+poCharPosn posn       == CDR posn
+pfCharPosn posn == poCharPosn posn
+ 
+poLinePosn posn       ==
+    posn => lnLocalNum  poGetLineObject posn  --VECP posn =>
+    CDAR posn
+pfLinePosn posn == poLinePosn posn
+ 
+poGlobalLinePosn posn ==
+    posn => lnGlobalNum poGetLineObject posn
+    ncBug('"old style pos objects have no global positions",[])
+pfGlobalLinePosn posn == poGlobalLinePosn posn
+ 
+poFileName posn       ==
+    posn => lnFileName poGetLineObject posn
+    CAAR posn
+pfFileName posn == poFileName posn
+ 
+poFileName? posn       ==
+    posn = ['noposition] => NIL
+    posn => lnFileName? poGetLineObject posn
+    CAAR posn
+pfFileName? posn == poFileName? posn
+ 
+poPlaceOfOrigin posn ==
+    lnPlaceOfOrigin poGetLineObject posn
+pfPlaceOfOrigin posn == poPlaceOfOrigin posn
+ 
+poNopos? posn ==
+    posn = ['noposition]
+pfNopos? posn == poNopos? posn
+poPosImmediate? txp==
+    poNopos? txp => NIL
+    lnImmediate? poGetLineObject txp
+pfPosImmediate? txp == poPosImmediate? txp
+ 
+poImmediate? txp==
+    lnImmediate? poGetLineObject txp
+pfImmediate? txp == poImmediate? txp
+ 
+ 
+compareposns(a,b)==
+ c:=poGlobalLinePosn a
+ d:=poGlobalLinePosn b
+ if c=d then poCharPosn a>=poCharPosn b else c>=d
+
+pfPrintSrcLines(pf) ==
+  lines := pfSourcePositions pf
+  lno := 0
+  for l in lines repeat
+    line := car l
+    if lno < lnGlobalNum(line) then 
+      FORMAT(true, '"   ~A~%",  lnString line)
+      lno := lnGlobalNum(line)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/postpar.boot.pamphlet b/src/interp/postpar.boot.pamphlet
new file mode 100644
index 00000000..9bf22fff
--- /dev/null
+++ b/src/interp/postpar.boot.pamphlet
@@ -0,0 +1,552 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp postpar.boot}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Yet Another Parser Transformation File
+--These functions are used by for BOOT and SPAD code
+--(see new2OldLisp, e.g.)
+
+postTransform y ==
+  x:= y
+  u:= postTran x
+  if u is ["Tuple",:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
+    [":",["LISTOF",:l,y],t]
+  postTransformCheck u
+  aplTran u
+
+displayPreCompilationErrors() ==
+  n:= #($postStack:= REMDUP NREVERSE $postStack)
+  n=0 => nil
+  errors:=
+    1<n => '"errors"
+    '"error"
+  if $InteractiveMode
+    then sayBrightly ['"   Semantic ",errors,'" detected: "]
+    else
+      heading:=
+        $topOp ^= '$topOp => ['"   ",$topOp,'" has"]
+        ['"   You have"]
+      sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"]
+  if 1<n then
+    (for x in $postStack for i in 1.. repeat sayMath ['"   ",i,'"_) ",:x])
+    else sayMath ['"    ",:first $postStack]
+  TERPRI()
+
+postTran x ==
+  atom x =>
+    postAtom x
+  op := first x
+  SYMBOLP op and (f:= GETL(op,'postTran)) => FUNCALL(f,x)
+  op is ["elt",a,b] =>
+    u:= postTran [b,:rest x]
+    [postTran op,:rest u]
+  op is ["Scripts",:.] =>
+    postScriptsForm(op,"append"/[unTuple postTran y for y in rest x])
+  op^=(y:= postOp op) => [y,:postTranList rest x]
+  postForm x
+
+postTranList x == [postTran y for y in x]
+
+postBigFloat x ==
+  [.,mant,:expon] := x
+  $BOOT => INT2RNUM(mant) * INT2RNUM(10) ** expon
+  eltword := if $InteractiveMode then "$elt" else "elt"
+  postTran [[eltword,'(Float),"float"],[",",[",",mant,expon],10]]
+
+postAdd ["add",a,:b] ==
+  null b => postCapsule a
+  ["add",postTran a,postCapsule first b]
+
+checkWarning msg == postError concat('"Parsing error: ",msg)
+ 
+checkWarningIndentation() ==
+  checkWarning ['"Apparent indentation error following",:bright "add"]
+
+postCapsule x ==
+  x isnt [op,:.] => checkWarningIndentation()
+  INTEGERP op or op = "==" => ["CAPSULE",postBlockItem x]
+  op = ";" => ["CAPSULE",:postBlockItemList postFlatten(x,";")]
+  op = "if" => ["CAPSULE",postBlockItem x]
+  checkWarningIndentation()
+
+postQUOTE x == x
+
+postColon u ==
+  u is [":",x] => [":",postTran x]
+  u is [":",x,y] => [":",postTran x,:postType y]
+
+postColonColon u ==
+  -- for Lisp package calling
+  -- boot syntax is package::fun but probably need to parenthesize it
+  $BOOT and u is ["::",package,fun] =>
+    INTERN(STRINGIMAGE fun, package)
+  postForm u
+
+postAtSign ["@",x,y] == ["@",postTran x,:postType y]
+
+postPretend ["pretend",x,y] == ["pretend",postTran x,:postType y]
+
+postConstruct u ==
+  u is ["construct",b] =>
+    a:= (b is [",",:.] => comma2Tuple b; b)
+    a is ["SEGMENT",p,q] => ["construct",postTranSegment(p,q)]
+    a is ["Tuple",:l] =>
+      or/[x is [":",y] for x in l] => postMakeCons l
+      or/[x is ["SEGMENT",:.] for x in l] => tuple2List l
+      ["construct",:postTranList l]
+    ["construct",postTran a]
+  u
+
+postError msg ==
+  BUMPERRORCOUNT 'precompilation
+  xmsg:=
+    $defOp ^= '$defOp and not InteractiveMode => [$defOp,'": ",:msg]
+    msg
+  $postStack:= [xmsg,:$postStack]
+  nil
+
+postMakeCons l ==
+  null l => "nil"
+  l is [[":",a],:l'] =>
+    l' => ["append",postTran a,postMakeCons l']
+    postTran a
+  ["cons",postTran first l,postMakeCons rest l]
+
+postAtom x ==
+  $BOOT => x
+  x=0 => '(Zero)
+  x=1 => '(One)
+  EQ(x,'T) => 'T_$ -- rename T in spad code to T$
+  IDENTP x and GETDATABASE(x,'NILADIC) => LIST x
+  x
+
+postBlock ["Block",:l,x] ==
+  ["SEQ",:postBlockItemList l,["exit",postTran x]]
+
+postBlockItemList l == [postBlockItem x for x in l]
+
+postBlockItem x ==
+  x:= postTran x
+  x is ["Tuple",:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
+    [":",["LISTOF",:l,y],t]
+  x
+
+postCategory (u is ["CATEGORY",:l]) ==
+  --RDJ: ugh_ please -- someone take away need for PROGN as soon as possible
+  null l => u
+  op :=
+    $insidePostCategoryIfTrue = true => "PROGN"
+    "CATEGORY"
+  [op,:[fn x for x in l]] where fn x ==
+    $insidePostCategoryIfTrue: local := true
+    postTran x
+
+postComma u == postTuple comma2Tuple u
+
+comma2Tuple u == ["Tuple",:postFlatten(u,",")]
+
+postDef [defOp,lhs,rhs] ==
+--+
+  lhs is ["macro",name] => postMDef ["==>",name,rhs]
+
+  if not($BOOT) then recordHeaderDocumentation nil
+  if $maxSignatureLineNumber ^= 0 then
+    $docList := [["constructor",:$headerDocumentation],:$docList]
+    $maxSignatureLineNumber := 0
+    --reset this for next constructor; see recordDocumentation
+  lhs:= postTran lhs
+  [form,targetType]:=
+    lhs is [":",:.] => rest lhs
+    [lhs,nil]
+  if null $InteractiveMode and atom form then form := LIST form
+  newLhs:=
+    atom form => form
+    [op,:argl]:= [(x is [":",a,.] => a; x) for x in form]
+    [op,:postDefArgs argl]
+  argTypeList:=
+    atom form => nil
+    [(x is [":",.,t] => t; nil) for x in rest form]
+  typeList:= [targetType,:argTypeList]
+  if atom form then form := [form]
+  specialCaseForm := [nil for x in form]
+  ["DEF",newLhs,typeList,specialCaseForm,postTran rhs]
+
+postDefArgs argl ==
+  null argl => argl
+  argl is [[":",a],:b] =>
+    b => postError
+      ['"   Argument",:bright a,'"of indefinite length must be last"]
+    atom a or a is ["QUOTE",:.] => a
+    postError
+      ['"   Argument",:bright a,'"of indefinite length must be a name"]
+  [first argl,:postDefArgs rest argl]
+
+postMDef(t) ==
+  [.,lhs,rhs] := t
+  $InteractiveMode and not $BOOT =>
+    lhs := postTran lhs
+    null IDENTP lhs => throwKeyedMsg("S2IP0001",NIL)
+    ["MDEF",lhs,NIL,NIL,postTran rhs]
+  lhs:= postTran lhs
+  [form,targetType]:=
+    lhs is [":",:.] => rest lhs
+    [lhs,nil]
+  form:=
+    atom form => LIST form
+    form
+  newLhs:= [(x is [":",a,:.] => a; x) for x in form]
+  typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
+  ["MDEF",newLhs,typeList,[nil for x in form],postTran rhs]
+
+postElt (u is [.,a,b]) ==
+  a:= postTran a
+  b is ["Sequence",:.] => [["elt",a,"makeRecord"],:postTranList rest b]
+  ["elt",a,postTran b]
+
+postExit ["=>",a,b] == ["IF",postTran a,["exit",postTran b],"noBranch"]
+
+
+postFlatten(x,op) ==
+  x is [ =op,a,b] => [:postFlatten(a,op),:postFlatten(b,op)]
+  LIST x
+
+postForm (u is [op,:argl]) ==
+  x:=
+    atom op =>
+      argl':= postTranList argl
+      op':=
+        true=> op
+        $BOOT => op
+        GET(op,'Led) or GET(op,'Nud) or op = 'IN => op
+        numOfArgs:= (argl' is [["Tuple",:l]] => #l; 1)
+        INTERNL("*",STRINGIMAGE numOfArgs,PNAME op)
+      [op',:argl']
+    op is ["Scripts",:.] => [:postTran op,:postTranList argl]
+    u:= postTranList u
+    if u is [["Tuple",:.],:.] then
+      postError ['"  ",:bright u,
+        '"is illegal because tuples cannot be applied_!",'%l,
+          '"   Did you misuse infix dot?"]
+    u
+  x is [.,["Tuple",:y]] => [first x,:y]
+  x
+
+postQuote [.,a] == ["QUOTE",a]
+
+postScriptsForm(["Scripts",op,a],argl) ==
+  [getScriptName(op,a,#argl),:postTranScripts a,:argl]
+
+postScripts ["Scripts",op,a] ==
+  [getScriptName(op,a,0),:postTranScripts a]
+
+getScriptName(op,a,numberOfFunctionalArgs) ==
+  if null IDENTP op then
+    postError ['"   ",op,'" cannot have scripts"]
+  INTERNL("*",STRINGIMAGE numberOfFunctionalArgs,
+    decodeScripts a,PNAME op)
+
+postTranScripts a ==
+  a is ["PrefixSC",b] => postTranScripts b
+  a is [";",:b] => "append"/[postTranScripts y for y in b]
+  a is [",",:b] =>
+    ("append"/[fn postTran y for y in b]) where
+      fn x ==
+        x is ["Tuple",:y] => y
+        LIST x
+  LIST postTran a
+
+decodeScripts a ==
+  a is ["PrefixSC",b] => STRCONC(STRINGIMAGE 0,decodeScripts b)
+  a is [";",:b] => APPLX('STRCONC,[decodeScripts x for x in b])
+  a is [",",:b] =>
+    STRINGIMAGE fn a where fn a == (a is [",",:b] => +/[fn x for x in b]; 1)
+  STRINGIMAGE 1
+
+postIf t ==
+  t isnt ["if",:l] => t
+  ["IF",:[(null (x:= postTran x) and null $BOOT => "noBranch"; x)
+    for x in l]]
+
+postJoin ["Join",a,:l] ==
+  a:= postTran a
+  l:= postTranList l
+  if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l
+    := LIST ["CATEGORY",b]
+  al:=
+    a is ["Tuple",:c] => c
+    LIST a
+  ["Join",:al,:l]
+
+postMapping u  ==
+  u isnt ["->",source,target] => u
+  ["Mapping",postTran target,:unTuple postTran source]
+
+postOp x ==
+  x=":=" =>
+    $BOOT => "SPADLET"
+    "LET"
+  x=":-" => "LETD"
+  x="Attribute" => "ATTRIBUTE"
+  x
+
+postRepeat ["REPEAT",:m,x] == ["REPEAT",:postIteratorList m,postTran x]
+
+postSEGMENT ["SEGMENT",a,b] ==
+  key:= [a,'"..",:(b => [b]; nil)]
+  postError ['"   Improper placement of segment",:bright key]
+
+postCollect [constructOp,:m,x] ==
+  x is [["elt",D,"construct"],:y] =>
+    postCollect [["elt",D,"COLLECT"],:m,["construct",:y]]
+  itl:= postIteratorList m
+  x:= (x is ["construct",r] => r; x)  --added 84/8/31
+  y:= postTran x
+  finish(constructOp,itl,y) where
+    finish(op,itl,y) ==
+      y is [":",a] => ["REDUCE","append",0,[op,:itl,a]]
+      y is ["Tuple",:l] =>
+        newBody:=
+          or/[x is [":",y] for x in l] => postMakeCons l
+          or/[x is ["SEGMENT",:.] for x in l] => tuple2List l
+          ["construct",:postTranList l]
+        ["REDUCE","append",0,[op,:itl,newBody]]
+      [op,:itl,y]
+
+postTupleCollect [constructOp,:m,x] ==
+  postCollect [constructOp,:m,["construct",x]]
+
+postIteratorList x ==
+  x is [p,:l] =>
+    (p:= postTran p) is ["IN",y,u] =>
+      u is ["|",a,b] => [["IN",y,postInSeq a],["|",b],:postIteratorList l]
+      [["IN",y,postInSeq u],:postIteratorList l]
+    [p,:postIteratorList l]
+  x
+
+postin arg ==
+  arg isnt ["in",i,seq] => systemErrorHere '"postin"
+  ["in",postTran i, postInSeq seq]
+
+postIn arg ==
+  arg isnt ["IN",i,seq] => systemErrorHere '"postIn"
+  ["IN",postTran i,postInSeq seq]
+
+postInSeq seq ==
+  seq is ["SEGMENT",p,q] => postTranSegment(p,q)
+  seq is ["Tuple",:l] => tuple2List l
+  postTran seq
+
+postTranSegment(p,q) == ["SEGMENT",postTran p,(q => postTran q; nil)]
+
+tuple2List l ==
+  l is [a,:l'] =>
+    u:= tuple2List l'
+    a is ["SEGMENT",p,q] =>
+      null u => ["construct",postTranSegment(p,q)]
+      $InteractiveMode and null $BOOT =>
+        ["append",["construct",postTranSegment(p,q)],tuple2List l']
+      ["nconc",["construct",postTranSegment(p,q)],tuple2List l']
+    null u => ["construct",postTran a]
+    ["cons",postTran a,tuple2List l']
+  nil
+
+SEGMENT(a,b) == [i for i in a..b]
+
+postReduce ["Reduce",op,expr] ==
+  $InteractiveMode or expr is ["COLLECT",:.] =>
+    ["REDUCE",op,0,postTran expr]
+  postReduce ["Reduce",op,["COLLECT",["IN",g:= GENSYM(),expr],
+    ["construct",  g]]]
+
+postFlattenLeft(x,op) ==--
+  x is [ =op,a,b] => [:postFlattenLeft(a,op),b]
+  [x]
+
+postSemiColon u == postBlock ["Block",:postFlattenLeft(u,";")]
+
+postSequence ["Sequence",:l] == ['(elt $ makeRecord),:postTranList l]
+
+--------------------> NEW DEFINITION (see br-saturn.boot.pamphlet)
+postSignature ["Signature",op,sig] ==
+  sig is ["->",:.] =>
+    sig1:= postType sig
+    op:= postAtom (STRINGP op => INTERN op; op)
+    ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1]
+
+killColons x ==
+  atom x => x
+  x is ["Record",:.] => x
+  x is ["Union",:.] => x
+  x is [":",.,y] => killColons y
+  [killColons first x,:killColons rest x]
+
+postSlash ['_/,a,b] ==
+  STRINGP a => postTran ["Reduce",INTERN a,b]
+  ['_/,postTran a,postTran b]
+
+removeSuperfluousMapping sig1 ==
+  --get rid of this asap
+  sig1 is [x,:y] and x is ["Mapping",:.] => [rest x,:y]
+  sig1
+
+postType typ ==
+  typ is ["->",source,target] =>
+    source="constant" => [LIST postTran target,"constant"]
+    LIST ["Mapping",postTran target,:unTuple postTran source]
+  typ is ["->",target] => LIST ["Mapping",postTran target]
+  LIST postTran typ
+
+postTuple u ==
+  u is ["Tuple"] => u
+  u is ["Tuple",:l,a] => (["Tuple",:postTranList rest u])
+--u is ["Tuple",:l,a] => (--a:= postTran a; ["Tuple",:postTranList rest u])
+    --RDJ: don't understand need for above statement that is commented out
+
+postWhere ["where",a,b] ==
+  x:=
+    b is ["Block",:c] => c
+    LIST b
+  ["where",postTran a,:postTranList x]
+
+postWith ["with",a] ==
+  $insidePostCategoryIfTrue: local := true
+  a:= postTran a
+  a is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE IF)) => ["CATEGORY",a]
+  a is ["PROGN",:b] => ["CATEGORY",:b]
+  a
+
+postTransformCheck x ==
+  $defOp: local:= nil
+  postcheck x
+
+postcheck x ==
+  atom x => nil
+  x is ["DEF",form,[target,:.],:.] =>
+    (setDefOp form; postcheckTarget target; postcheck rest rest x)
+  x is ["QUOTE",:.] => nil
+  postcheck first x
+  postcheck rest x
+
+setDefOp f ==
+  if f is [":",g,:.] then f := g
+  f := (atom f => f; first f)
+  if $topOp then $defOp:= f else $topOp:= f
+
+postcheckTarget x ==
+  -- doesn't seem that useful!
+  isPackageType x => nil
+  x is ["Join",:.] => nil
+  NIL
+
+isPackageType x == not CONTAINED("$",x)
+
+unTuple x ==
+  x is ["Tuple",:y] => y
+  LIST x
+
+--% APL TRANSFORMATION OF INPUT
+
+aplTran x ==
+  $BOOT => x
+  $GENNO: local := 0
+  u:= aplTran1 x
+  containsBang u => throwKeyedMsg("S2IP0002",NIL)
+  u
+
+containsBang u ==
+  atom u => EQ(u,"_!")
+  u is [="QUOTE",.] => false
+  or/[containsBang x for x in u]
+
+aplTran1 x ==
+  atom x => x
+  [op,:argl1] := x
+  argl := aplTranList argl1
+  -- unary case f ! y
+  op = "_!" =>
+    argl is [f,y] =>
+      y is [op',:y'] and op' = "_!" => aplTran1 [op,op,f,:y']
+      $BOOT => ["COLLECT",["IN",g:=GENVAR(),aplTran1 y],[f,g]]
+      ["map",f,aplTran1 y]
+    x    --do not handle yet
+  -- multiple argument case
+  hasAplExtension argl is [arglAssoc,:futureArgl] =>
+    -- choose the last aggregate type to be result of reshape
+    ["reshape",["COLLECT",:[["IN",g,["ravel",a]] for [g,:a] in arglAssoc],
+      aplTran1 [op,:futureArgl]],CDAR arglAssoc]
+  [op,:argl]
+
+aplTranList x ==
+  atom x => x
+  [aplTran1 first x,:aplTranList rest x]
+
+hasAplExtension argl ==
+  or/[x is ["_!",:.] for x in argl] =>
+    u:= [futureArg for x in argl] where futureArg ==
+      x is ["_!",y] =>
+        z:= deepestExpression y
+        arglAssoc := [[g := GENVAR(),:aplTran1 z],:arglAssoc]
+        substitute(g,z,y)
+      x
+    [arglAssoc,:u]
+  nil
+
+deepestExpression x ==
+  x is ["_!",y] => deepestExpression y
+  x
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp.pamphlet
new file mode 100644
index 00000000..0f3876d1
--- /dev/null
+++ b/src/interp/postprop.lisp.pamphlet
@@ -0,0 +1,152 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp postprop.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|special| (CADR X)))
+        '((LET |compSetq|)      (|Join| |compJoin|)
+          (|Record| |compCat|)
+          (|Union| |compCat|)   (\: |compColon|)
+          (\:\: |compCoerce|)   (CAPSULE |compCapsule|)
+          (|has| |compHas|)     (|is| |compIs|)
+          (|add| |compAdd|)     (CONS |compCons|)
+          (IF |compIf|)         (|exit| |compExit|)
+          (|return| |compReturn|)       (|leave| |compLeave|)
+          (|elt| |compElt|)     (DEF |compDefine|)
+          (MDEF |compMacro|)    (|SubsetCategory| |compSubsetCategory|)
+          (|SubDomain| |compSubDomain|)
+          (|case| |compCase|)   (|String| |compString|)
+          (|RecordCategory| |compConstructorCategory|)
+          (|ListCategory| |compConstructorCategory|)
+          (|VectorCategory| |compConstructorCategory|)
+          (|UnionCategory| |compConstructorCategory|)
+          (CATEGORY |compCategory|)
+          (COLLECT |compRepeatOrCollect|)
+          (COLLECTV |compCollectV|)
+          (REPEAT |compRepeatOrCollect|)
+          (REDUCE |compReduce|) (|where| |compWhere|)
+          (\| |compSuchthat|)   (|construct| |compConstruct|)
+          (SEQ |compSeq|)       (SETQ |compSetq|)
+          (VECTOR |compVector|)))
+
+(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|postTran| (second X)))
+        '((|with| |postWith|)
+          (|Scripts| |postScripts|)
+          (/ |postSlash|)
+          (|construct| |postConstruct|)
+          (|Block| |postBlock|)
+          (QUOTE |postQUOTE|)
+          (COLLECT |postCollect|)
+          (\:BF\: |postBigFloat|)
+          (|in| |postin|)               ; the infix operator version of i
+          (IN |postIn|)                 ; the iterator form of i
+          (REPEAT |postRepeat|)
+          (|TupleCollect| |postTupleCollect|)
+          (|add| |postAdd|)
+          (|Reduce| |postReduce|)
+          (\, |postComma|)
+          (\; |postSemiColon|)
+          (|where| |postWhere|)
+          (\: |postColon|)
+          (\@ |postAtSign|)
+          (|pretend| |postPretend|)
+          (|if| |postIf|)
+          (|Join| |postJoin|)
+          (|Signature| |postSignature|)
+          (CATEGORY |postCategory|)
+          (== |postDef|)
+          (==> |postMDef|)
+          (-> |postMapping|)
+          (=> |postExit|)
+          (|Tuple| |postTuple|)))
+
+(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|parseTran| (CADR X)))
+        '((\<= |parseLessEqual|)
+          (\> |parseGreaterThan|)
+          (\>= |parseGreaterEqual|)
+          ($\<= |parseDollarLessEqual|)
+          ($\> |parseDollarGreaterThan|)
+          ($\>= |parseDollarGreaterEqual|)
+          ($^= |parseDollarNotEqual|)
+          (^ |parseNot|)
+          (^= |parseNotEqual|)
+          (\: |parseColon|)
+          (\:\: |parseCoerce|)
+          (\@ |parseAtSign|)
+          (|and| |parseAnd|)
+          (CATEGORY |parseCategory|)
+          (|construct| |parseConstruct|)
+          (DEF |parseDEF|)
+          (|eqv| |parseEquivalence|)
+          (|exit| |parseExit|)
+          (|has| |parseHas|)
+          (IF |parseIf|)
+          (|implies| |parseImplies|)
+          (IN |parseIn|)
+          (INBY |parseInBy|)
+          (|is| |parseIs|)
+          (|isnt| |parseIsnt|)
+          (|Join| |parseJoin|)
+          (|leave| |parseLeave|)
+          (LET |parseLET|)
+          (LETD |parseLETD|)
+          (MDEF |parseMDEF|)
+          (|not| |parseNot|)
+          (|or| |parseOr|)
+          (|pretend| |parsePretend|)
+          (|return| |parseReturn|)
+          (SEQ |parseSeq|)
+          (VCONS |parseVCONS|)
+          (|where| |parseWhere|)
+          (|xor| |parseExclusiveOr|)))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/preparse.lisp.pamphlet b/src/interp/preparse.lisp.pamphlet
new file mode 100644
index 00000000..12229874
--- /dev/null
+++ b/src/interp/preparse.lisp.pamphlet
@@ -0,0 +1,416 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp preparse.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+NAME:    Pre-Parsing Code
+PURPOSE: BOOT lines are massaged by PREPARSE to make them easier to parse:
+       1. Trailing -- comments are removed (this is already done, actually).
+       2. Comments between { and } are removed.
+       3. BOOT code is column-sensitive. Code which lines up columnarly is
+          parenthesized and semicolonized accordingly.  For example,
+
+               a
+                       b
+                       c
+                               d
+               e
+
+          becomes
+
+               a
+                       (b;
+                        c
+                               d)
+               e
+
+          Note that to do this correctly, we also need to keep track of
+          parentheses already in the code.
+ 
+\end{verbatim}
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(provide 'Boot)
+ 
+(in-package "BOOT")
+ 
+; Global storage
+ 
+(defparameter $INDEX 0                          "File line number of most recently read line.")
+(defparameter $preparse-last-line ()            "Most recently read line.")
+(defparameter $preparseReportIfTrue NIL         "Should we print listings?")
+(defparameter $LineList nil                     "Stack of preparsed lines.")
+(defparameter $EchoLineStack nil                "Stack of lines to list.")
+(defparameter $IOIndex 0                        "Number of latest terminal input line.")
+ 
+(defun Initialize-Preparse (strm)
+  (setq $INDEX 0 $LineList nil $EchoLineStack nil)
+  (setq $preparse-last-line (get-a-line strm)))
+ 
+(defmacro pptest () `(/rp ">scratchpad>test.boot"))
+ 
+(defun /RP (&optional (*boot-input-file* nil) (*boot-output-file* nil)
+                      ($preparseReportIfTrue t))
+  (with-open-stream
+    (in-stream (or (and *boot-input-file* (open *boot-input-file* :direction :input))
+                   *terminal-io*))
+    (declare (special in-stream))
+    (with-open-stream
+      (out-stream (if *boot-output-file*
+                      (open *boot-output-file* :direction :output)
+                      *terminal-io*))
+      (declare (special out-stream))
+      (initialize-preparse in-stream)
+      (do ((lines (PREPARSE in-stream) (PREPARSE in-stream))) ((null lines)))))
+  T)
+ 
+(defun PREPARSE (Strm &aux (stack ()))
+  (SETQ $COMBLOCKLIST NIL $skipme NIL)
+  (when $preparse-last-line
+	(if (pairp $preparse-last-line)
+	    (setq stack $preparse-last-line)
+	  (push $preparse-last-line stack))
+        (setq $INDEX (- $INDEX (length stack))))
+  (let ((U (PREPARSE1 stack)))
+    (if $skipme (preparse strm)
+      (progn
+	(if $preparseReportIfTrue (PARSEPRINT U))
+	(setq |$headerDocumentation| NIL)
+	(SETQ |$docList| NIL)
+	(SETQ |$maxSignatureLineNumber| 0)
+	(SETQ |$constructorLineNumber| (IFCAR (IFCAR U)))
+	U))))
+ 
+(defun PREPARSE1 (LineList)
+ (PROG (($LINELIST LineList) $EchoLineStack NUM A I L PSLOC
+        INSTRING PCOUNT COMSYM STRSYM OPARSYM CPARSYM N NCOMSYM
+        (SLOC -1) (CONTINUE NIL)  (PARENLEV 0) (NCOMBLOCK ())
+        (LINES ()) (LOCS ()) (NUMS ()) functor  )
+ READLOOP (DCQ (NUM . A) (preparseReadLine LineList))
+         (cond ((atEndOfUnit A)
+                (PREPARSE-ECHO LineList)
+                (COND ((NULL LINES) (RETURN NIL))
+                      (NCOMBLOCK
+                       (FINCOMBLOCK NIL NUMS LOCS NCOMBLOCK NIL)))
+                (RETURN (PAIR (NREVERSE NUMS)
+                              (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES))))))
+         (cond ((and (NULL LINES) (> (LENGTH A) 0) (EQ (CHAR A 0) #\) ))
+                ; this is a command line, don't parse it
+                (PREPARSE-ECHO LineList)
+                (setq $preparse-last-line nil) ;don't reread this line
+                (SETQ LINE a)
+		(CATCH 'SPAD_READER (|doSystemCommand| (subseq LINE 1)))
+		(GO READLOOP)))
+         (setq L (LENGTH A))
+         (if (EQ L 0) (GO READLOOP))
+         (setq PSLOC SLOC)
+         (setq I 0 INSTRING () PCOUNT 0)
+ STRLOOP (setq STRSYM (OR (position #\" A :start I ) L))
+         (setq COMSYM (OR (search "--" A :start2 I ) L))
+         (setq NCOMSYM (OR (search "++" A :start2 I ) L))
+         (setq OPARSYM (OR (position #\( A :start I ) L))
+         (setq CPARSYM (OR (position #\) A :start I ) L))
+         (setq N (MIN STRSYM COMSYM NCOMSYM OPARSYM CPARSYM))
+         (cond ((= N L) (GO NOCOMS))
+               ((ESCAPED A N))
+               ((= N STRSYM) (setq INSTRING (NOT INSTRING)))
+               (INSTRING)
+               ((= N COMSYM) (setq A (subseq A 0 N)) (GO NOCOMS)) ; discard trailing comment
+               ((= N NCOMSYM)
+                (setq SLOC (INDENT-POS A))
+                (COND
+                  ((= SLOC N)
+                   (COND ((AND NCOMBLOCK (NOT (= N (CAR NCOMBLOCK))))
+                          (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
+                          (SETQ NCOMBLOCK NIL)))
+                   (SETQ NCOMBLOCK (CONS N (CONS A (IFCDR NCOMBLOCK))))
+                   (SETQ A ""))
+                  ('T (PUSH (STRCONC (GETFULLSTR N " ")
+                                  (SUBSTRING A N ())) $LINELIST)
+                      (SETQ $INDEX (SUB1 $INDEX))
+                      (SETQ A (SUBSEQ A 0 N))))
+         (GO NOCOMS))
+               ((= N OPARSYM) (setq PCOUNT (1+ PCOUNT)))
+               ((= N CPARSYM) (setq PCOUNT (1- PCOUNT))))
+         (setq I (1+ N))
+         (GO STRLOOP)
+ NOCOMS  (setq SLOC (INDENT-POS A))
+         (setq A (DROPTRAILINGBLANKS A))
+         (cond ((NULL SLOC) (setq SLOC PSLOC) (GO READLOOP)))
+         (cond ((EQ (ELT A (MAXINDEX A)) XCAPE)
+                (setq CONTINUE T a (subseq A (MAXINDEX A))))
+               ((setq CONTINUE NIL)))
+         (if (and (null LINES) (= SLOC 0)) ;;test for skipping constructors
+             (if (and |$byConstructors|
+                      (null (search "==>" a))
+                      (not (member (setq functor (intern
+                                    (substring a 0 (STRPOSL ": (=" A 0 NIL))))
+                                   |$byConstructors|)))
+                 (setq $skipme 't)
+               (progn (push functor |$constructorsSeen|) (setq $skipme nil))))
+         (when (and LINES (EQL SLOC 0))
+             (IF (AND NCOMBLOCK (NOT (ZEROP (CAR NCOMBLOCK))))
+               (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist))
+	     (IF (NOT (IS-CONSOLE in-stream))
+		 (setq $preparse-last-line
+		       (nreverse $echolinestack)))
+             (RETURN (PAIR (NREVERSE NUMS)
+                        (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
+         (cond ((> PARENLEV 0) (PUSH NIL LOCS) (setq SLOC PSLOC) (GO REREAD)))
+         (COND (NCOMBLOCK
+                (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
+                (setq NCOMBLOCK ())))
+         (PUSH SLOC LOCS)
+ REREAD  (PREPARSE-ECHO LineList)
+         (PUSH A LINES)
+         (PUSH NUM NUMS)
+         (setq PARENLEV (+ PARENLEV PCOUNT))
+         (when (and (is-console in-stream) (not continue))
+            (setq $preparse-last-line nil)
+             (RETURN (PAIR (NREVERSE NUMS)
+                           (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
+ 
+         (GO READLOOP)))
+ 
+;; NUM is the line number of the current line
+;; OLDNUMS is the list of line numbers of previous lines
+;; OLDLOCS is the list of previous indentation locations
+;; NCBLOCK is the current comment block
+(DEFUN FINCOMBLOCK (NUM OLDNUMS OLDLOCS NCBLOCK linelist)
+  (PUSH
+    (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (REVERSE (CDR NCBLOCK))))
+	      ;; comment for constructor itself paired with 1st line -1
+          ('T
+           (COND ($EchoLineStack
+                  (setq NUM (POP $EchoLineStack))
+                  (PREPARSE-ECHO linelist)
+                  (SETQ $EchoLineStack (LIST NUM))))
+	   (cons
+            ;; scan backwards for line to left of current
+	    (DO ((onums oldnums (cdr onums))
+		 (olocs oldlocs (cdr olocs))
+		 (sloc (car ncblock)))
+		((null onums) nil)
+		(if (and (numberp (car olocs))
+			 (<= (car olocs) sloc))
+		    (return (car onums))))
+	    (REVERSE (CDR NCBLOCK)))))
+    $COMBLOCKLIST))
+ 
+(defun PARSEPRINT (L)
+  (if L
+      (progn (format t "~&~%       ***       PREPARSE      ***~%~%")
+             (dolist (X L) (format t "~5d. ~a~%" (car x) (cdr x)))
+             (format t "~%"))))
+ 
+(DEFUN STOREBLANKS (LINE N)
+   (DO ((I 0 (ADD1 I))) ((= I N) LINE) (SETF (CHAR LINE I) #\ )))
+ 
+(DEFUN INITIAL-SUBSTRING (PATTERN LINE)
+   (let ((ind (mismatch PATTERN LINE)))
+     (OR (NULL IND) (EQL IND (SIZE PATTERN)))))
+ 
+(DEFUN SKIP-IFBLOCK (X)
+   (PROG (LINE IND)
+     (DCQ (IND . LINE) (preparseReadLine1 X))
+      (IF (NOT (STRINGP LINE))  (RETURN (CONS IND LINE)))
+      (IF (ZEROP (SIZE LINE)) (RETURN (SKIP-IFBLOCK X)))
+      (COND ((CHAR= (ELT LINE 0) #\) )
+          (COND
+            ((INITIAL-SUBSTRING ")if" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")elseif" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 7)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")else" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")endif" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")fin" LINE)
+	     (RETURN (CONS IND NIL))))))
+      (RETURN (SKIP-IFBLOCK X)) ) )
+ 
+(DEFUN SKIP-TO-ENDIF (X)
+   (PROG (LINE IND)
+     (DCQ (IND . LINE) (preparseReadLine1 X))
+      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE)))
+            ((INITIAL-SUBSTRING LINE ")endif")
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING LINE ")fin") (RETURN (CONS IND NIL)))
+            ('T (RETURN (SKIP-TO-ENDIF X))))))
+ 
+(DEFUN preparseReadLine (X)
+    (PROG (LINE IND)
+      (DCQ (IND . LINE) (preparseReadLine1 X))
+      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE))))
+      (COND ((ZEROP (SIZE LINE))
+             (RETURN (CONS IND LINE))))
+      (COND ((CHAR= (ELT LINE 0) #\) )
+          (COND
+            ((INITIAL-SUBSTRING ")if" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")elseif" LINE)
+             (RETURN (SKIP-TO-ENDIF X)))
+            ((INITIAL-SUBSTRING ")else" LINE)
+             (RETURN (SKIP-TO-ENDIF X)))
+            ((INITIAL-SUBSTRING ")endif" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")fin" LINE)
+	     (SETQ *EOF* T)
+	     (RETURN (CONS IND NIL)) ) )))
+      (RETURN (CONS IND LINE)) ))
+ 
+(DEFUN preparseReadLine1 (X)
+    (PROG (LINE IND)
+      (SETQ LINE (if $LINELIST
+                     (pop $LINELIST)
+              (expand-tabs (get-a-line in-stream))))
+      (setq $preparse-last-line LINE)
+      (and (stringp line) (incf $INDEX))
+      (COND
+        ( (NOT (STRINGP LINE))
+          (RETURN (CONS $INDEX LINE)) ) )
+      (SETQ LINE (DROPTRAILINGBLANKS LINE))
+      (PUSH (COPY-SEQ LINE) $EchoLineStack)
+    ;; next line must evaluate $INDEX before recursive call
+      (RETURN
+        (CONS
+          $INDEX
+          (COND
+            ( (AND (> (SETQ IND (MAXINDEX LINE)) -1) (char= (ELT LINE IND) #\_))
+              (setq $preparse-last-line
+                    (STRCONC (SUBSTRING LINE 0 IND) (CDR (preparseReadLine1 X))) ))
+            ( 'T
+              LINE ) ))) ) )
+ 
+;;(defun preparseReadLine (X)
+;;  (declare (special $LINELIST $echoLineStack))
+;;  (PROG (LINE IND)
+;;        (setq LINE
+;;              (if $LINELIST
+;;                  (pop $LINELIST)
+;;                  (get-a-line in-stream)))
+;;        (setq $preparse-last-line LINE)
+;;        (and (stringp line) (incf $INDEX))
+;;        (if (NOT (STRINGP LINE)) (RETURN (CONS $INDEX LINE)))
+;;        (setq LINE (DROPTRAILINGBLANKS LINE))
+;;        (if Echo-Meta (PUSH (COPY-SEQ LINE) $EchoLineStack))
+;;        ; next line must evaluate $INDEX before recursive call
+;;        (RETURN
+;;          (CONS $INDEX
+;;                (if (and (> (setq IND (MAXINDEX LINE)) -1)
+;;                       (EQ (ELT LINE IND) #\_))
+;;                    (setq $preparse-last-line
+;;                        (STRCONC (SUBSEQ LINE 0 IND)
+;;                                 (CDR (preparseReadLine X))))
+;;                    LINE)))))
+ 
+(defun PREPARSE-ECHO (linelist)
+  (if Echo-Meta (REPEAT (IN X (REVERSE $EchoLineStack))
+                        (format out-stream "~&;~A~%" X)))
+  (setq $EchoLineStack ()))
+ 
+(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) XCAPE)))
+ 
+(defun atEndOfUnit (X) (NULL (STRINGP X)) )
+ 
+(defun PARSEPILES (LOCS LINES)
+  "Add parens and semis to lines to aid parsing."
+  (mapl #'add-parens-and-semis-to-line (NCONC LINES '(" ")) (nconc locs '(nil)))
+  LINES)
+ 
+(defun add-parens-and-semis-to-line (slines slocs)
+ 
+  "The line to be worked on is (CAR SLINES).  It's indentation is (CAR SLOCS).  There
+is a notion of current indentation. Then:
+ 
+A. Add open paren to beginning of following line if following line's indentation
+   is greater than current, and add close paren to end of last succeeding line
+   with following line's indentation.
+B. Add semicolon to end of line if following line's indentation is the same.
+C. If the entire line consists of the single keyword then or else, leave it alone."
+ 
+  (let ((start-column (car slocs)))
+    (if (and start-column (> start-column 0))
+        (let ((count 0) (i 0))
+          (seq
+           (mapl #'(lambda (next-lines nlocs)
+                     (let ((next-line (car next-lines)) (next-column (car nlocs)))
+                       (incf i)
+                       (if next-column
+                           (progn (setq next-column (abs next-column))
+                                  (if (< next-column start-column) (exit nil))
+                                  (cond ((and (eq next-column start-column)
+                                              (rplaca nlocs (- (car nlocs)))
+                                              (not (infixtok next-line)))
+                                         (setq next-lines (drop (1- i) slines))
+                                         (rplaca next-lines (addclose (car next-lines) #\;))
+                                         (setq count (1+ count))))))))
+                 (cdr slines) (cdr slocs)))
+          (if (> count 0)
+              (progn (setf (char (car slines) (1- (nonblankloc (car slines))))
+                           #\( )
+                     (setq slines (drop (1- i) slines))
+                     (rplaca slines (addclose (car slines) #\) ))))))))
+ 
+(defun INFIXTOK (S) (MEMBER (STRING2ID-N S 1) '(|then| |else|) :test #'eq))
+ 
+ 
+(defun ADDCLOSE (LINE CHAR)
+  (cond ((char= (FETCHCHAR LINE (MAXINDEX LINE)) #\; )
+         (SETELT LINE (MAXINDEX LINE) CHAR)
+         (if (char= CHAR #\;) LINE (suffix #\; LINE)))
+        ((suffix char LINE))))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/profile.boot.pamphlet b/src/interp/profile.boot.pamphlet
new file mode 100644
index 00000000..e3b83f66
--- /dev/null
+++ b/src/interp/profile.boot.pamphlet
@@ -0,0 +1,111 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp profile.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--$profileCompiler := true
+$profileAlist := nil
+
+profileWrite() ==  --called from finalizeLisplib
+  outStream := MAKE_-OUTSTREAM CONCAT(LIBSTREAM_-DIRNAME $libFile,'"/info")
+  _*PRINT_-PRETTY_* :local := 'T
+  PRINT_-FULL(profileTran $profileAlist,outStream)
+  SHUT outStream
+
+profileTran alist ==
+  $profileHash := MAKE_-HASH_-TABLE()
+  for [opSig,:info] in alist repeat 
+    op := opOf opSig
+    sig := KAR KDR opSig
+    HPUT($profileHash,op,[[sig,:info],:HGET($profileHash,op)])
+  [[key,:HGET($profileHash,key)] for key in mySort HKEYS $profileHash]
+
+profileRecord(label,name,info) ==  --name: info is var: type or op: sig
+--$profileAlist is ((op . alist1) ...) where
+--  alist1      is ((label . alist2) ...) where
+--    alist2    is ((name . info) ...)
+  if $insideCapsuleFunctionIfTrue then
+    op := $op
+    argl := CDR $form
+    opSig := [$op,$signatureOfForm]
+  else
+    op := 'constructor
+    argl := nil
+    opSig := [op]
+  if label = 'locals and MEMQ(name,argl) then label := 'arguments
+  alist1        := LASSOC(opSig,$profileAlist)
+  alist2        := LASSOC(label,alist1)
+  newAlist2     := insertAlist(name,info,alist2)
+  newAlist1     := insertAlist(label,newAlist2,alist1)
+  $profileAlist := insertAlist(opSig,newAlist1,$profileAlist)
+  $profileAlist
+
+profileDisplay() ==
+  profileDisplayOp('constructor,LASSOC('constructor,$profileAlist) )
+  for [op,:alist1] in $profileAlist | op ^= 'constructor repeat
+    profileDisplayOp(op,alist1)
+
+profileDisplayOp(op,alist1) ==
+  sayBrightly op
+  if LASSOC('arguments,alist1) then
+    sayBrightly '"  arguments"
+    for [x,:t] in MSORT LASSOC('arguments,alist1) repeat 
+      sayBrightly concat('"     ",x,": ",prefix2String t)
+  if LASSOC('locals,alist1) then
+    sayBrightly '"  locals"
+    for [x,:t] in MSORT LASSOC('locals,alist1) repeat 
+      sayBrightly concat('"     ",x,": ",prefix2String t)
+  for [con,:alist2] in alist1 | not MEMQ(con,'(locals arguments)) repeat
+    sayBrightly concat('"  ",prefix2String con)
+    for [op1,:sig] in MSORT alist2 repeat
+      sayBrightly ['"    ",:formatOpSignature(op1,sig)]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/property.lisp.pamphlet b/src/interp/property.lisp.pamphlet
new file mode 100644
index 00000000..d79d44d3
--- /dev/null
+++ b/src/interp/property.lisp.pamphlet
@@ -0,0 +1,639 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/property.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\begin{verbatim}
+This file contains most of the code that puts properties on
+identifiers in the Scratchpad II system.  If it was not possible
+to actually put the code here, we have pointers to where such
+property list manipulation is being done.
+
+Pointers:
+o  see NEWAUX LISP for some code that puts GENERIC and RENAMETOK
+   properties on identifiers for the parser
+o  coerceIntCommute puts the "commute" property on constructors.
+o  coerceRetract puts the "retract" property on constructors.
+o  there is some code at the end of SPECEVAL BOOT that puts "up"
+   properties on some special handlers.
+
+\end{verbatim}
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+\section{bug fix}
+
+These two lines were commented out in the original sources.
+However both of these lines involved control characters that
+latex cannot handle. control-V and control-H should be the
+actual control characters, not the text replacement shown here.
+;;(control-V |parseUpArrow|) 
+;;(|control-H| |parseLeftArrow|) 
+<<clip>>=
+@
+We have a similar problem with the control-G character.
+;;  (control-G |compContained|)
+<<clip1>>=
+@
+
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+;; following was in NEWSPAD LISP
+
+(MAKEPROP 'END_UNIT 'KEY 'T)
+
+;; following was in OUTINIT LISP
+
+(MAKEPROP 'TAG 'Led '(TAG TAG 122 121))
+(MAKEPROP 'EQUATNUM '|Nud| '(|dummy| |dummy| 0 0))
+(MAKEPROP 'EQUATNUM '|Led| '(|dummy| |dummy| 10000 0))
+(MAKEPROP 'LET '|Led| '(|:=| LET 125 124))
+(MAKEPROP 'RARROW '|Led| '(== DEF 122 121))
+(MAKEPROP 'SEGMENT '|Led| '(|..| SEGMENT 401 699 (|P:Seg|)))
+(MAKEPROP 'SEGMENT '|isSuffix| 'T)
+(MAKEPROP 'EQUAL1 'CHRYBNAM 'EQ)
+
+(REPEAT (IN X '(
+   (LET " := ")
+   (= "=")
+   (|/| "/")
+   (+ "+")
+   (* "*")
+   (** "**")
+   (^ "^")
+   (|:| ":")
+   (|::| "::")
+   (|@| "@")
+   (SEL ".")
+   (|exquo| " exquo ")
+   (|div| " div ")
+   (|quo| " quo ")
+   (|rem| " rem ")
+   (|case| " case ")
+   (|and| " and ")
+   (|or| " or ")
+   (TAG " -> ")
+   (|+->| " +-> ")
+   (RARROW ": ")
+   (SEGMENT "..")
+   (in " in ")
+   (|^=|  "^=")
+   (EL* ":")
+   (JOIN " JOIN ")
+   (EQUATNUM "  ")
+   (IQUOTIENT "//")
+   (= "= ")
+   (|>=| " >= ")
+   (|>| " > ")
+   (|<=| " <= ")
+   (|<| " < ")
+   (\| " \| ")
+   (+ " + ")
+   (- " - ")
+   (MEMBER " in ")
+   (NMEMBER " nin ")
+   (WHERE " WHERE ")
+   (AT " AT ")
+   (MAX " MAX ")
+   (MIN " MIN ")
+       )) (MAKEPROP (CAR X) 'INFIXOP (CADR X)))
+
+(REPEAT (IN X '(
+  (= "=")
+  (|:| ":")
+  (|not| "^ ")
+  (\| " \| ")
+  (SEGMENT "..")  ;" 0.. is represented by (SEGMENT 0)"
+ )) (MAKEPROP (CAR X) 'PREFIXOP (CADR X)))
+
+(REPEAT (IN X '(
+  (+ WIDTH |sumWidth|)
+  (- APP |appneg|)
+  (- WIDTH |minusWidth|)
+  (/ APP |appfrac|)
+  (/ SUBSPAN |fracsub|)
+  (/ SUPERSPAN |fracsuper|)
+  (/ WIDTH |fracwidth|)
+  (AGGSET APP |argsapp|)
+  (AGGSET SUBSPAN |agggsub|)
+  (AGGSET SUPERSPAN |agggsuper|)
+  (AGGSET WIDTH |agggwidth|)
+  (|binom| APP |binomApp|)
+  (|binom| SUBSPAN |binomSub|)
+  (|binom| SUPERSPAN |binomSuper|)
+  (|binom| WIDTH |binomWidth|)
+  (ALTSUPERSUB APP	 |altSuperSubApp|)
+  (ALTSUPERSUB SUBSPAN	 |altSuperSubSub|)
+  (ALTSUPERSUB SUPERSPAN |altSuperSubSuper|)
+  (ALTSUPERSUB WIDTH	 |altSuperSubWidth|)
+  (BOX APP |boxApp|)
+  (BOX SUBSPAN |boxSub|)
+  (BOX SUPERSPAN |boxSuper|)
+  (BOX WIDTH |boxWidth|)
+  (BRACKET SUBSPAN |qTSub|)
+  (BRACKET SUPERSPAN |qTSuper|)
+  (BRACKET WIDTH |qTWidth|)
+  (CENTER APP |centerApp|)
+  (EXT APP |appext|)
+  (EXT SUBSPAN |extsub|)
+  (EXT SUPERSPAN |extsuper|)
+  (EXT WIDTH |extwidth|)
+  (MATRIX APP |appmat|)
+  (MATRIX SUBSPAN |matSub|)
+  (MATRIX SUPERSPAN |matSuper|)
+  (MATRIX WIDTH |matWidth|)
+  (NOTHING APP	     |nothingApp|)
+  (NOTHING SUPERSPAN |nothingSuper|)
+  (NOTHING SUBSPAN   |nothingSub|)
+  (NOTHING WIDTH     |nothingWidth|)
+  (OVER APP |appfrac|)
+  (OVER SUBSPAN |fracsub|)
+  (OVER SUPERSPAN |fracsuper|)
+  (OVER WIDTH |fracwidth|)
+  (OVERLABEL APP |overlabelApp|)
+  (OVERLABEL SUPERSPAN |overlabelSuper|)
+  (OVERLABEL WIDTH |overlabelWidth|)
+  (OVERBAR APP |overbarApp|)
+  (OVERBAR SUPERSPAN |overbarSuper|)
+  (OVERBAR WIDTH |overbarWidth|)
+  (PAREN APP |appparu1|)
+  (PAREN SUBSPAN |qTSub|)
+  (PAREN SUPERSPAN |qTSuper|)
+  (PAREN WIDTH |qTWidth|)
+  (ROOT APP	  |rootApp|)
+  (ROOT SUBSPAN	  |rootSub|)
+  (ROOT SUPERSPAN |rootSuper|)
+  (ROOT WIDTH	  |rootWidth|)
+  (ROW WIDTH |eq0|)
+  (SC APP |appsc|)
+  (SC SUBSPAN |agggsub|)
+  (SC SUPERSPAN |agggsuper|)
+  (SC WIDTH |widthSC|)
+  (SETQ APP |appsetq|)
+  (SETQ WIDTH |letWidth|)
+  (SLASH APP	   |slashApp|)
+  (SLASH SUBSPAN   |slashSub|)
+  (SLASH SUPERSPAN |slashSuper|)
+  (SLASH WIDTH	   |slashWidth|)
+  (SUB APP |appsub|)
+  (SUB SUBSPAN |subSub|)
+  (SUB SUPERSPAN |subSuper|)
+  (SUB WIDTH |suScWidth|)
+  (SUPERSUB APP |superSubApp|)
+  (SUPERSUB SUBSPAN |superSubSub|)
+  (SUPERSUB SUPERSPAN |superSubSuper|)
+  (SUPERSUB WIDTH |superSubWidth|)
+  (VCONCAT APP |vconcatapp|)
+  (VCONCAT SUBSPAN |vConcatSub|)
+  (VCONCAT SUPERSPAN |vConcatSuper|)
+  (VCONCAT WIDTH |vConcatWidth|)
+  (BINOMIAL APP |binomialApp|)
+  (BINOMIAL SUBSPAN |binomialSub|)
+  (BINOMIAL SUPERSPAN |binomialSuper|)
+  (BINOMIAL WIDTH |binomialWidth|)
+  (ZAG APP |zagApp|)
+  (ZAG SUBSPAN |zagSub|)
+  (ZAG SUPERSPAN |zagSuper|)
+  (ZAG WIDTH |zagWidth|)
+)) (PROGN (MAKEPROP (CAR X) (CADR X) (CADDR X)))
+)
+
+(REPEAT (IN X '(
+  (+ APP |plusApp|)
+  (* APP |timesApp|)
+  (* WIDTH |timesWidth|)
+  (** APP |exptApp|)
+  (** WIDTH |exptWidth|)
+  (** SUBSPAN |exptSub|)
+  (** SUPERSPAN |exptSuper|)
+  (^  APP |exptApp|)
+  (^  WIDTH |exptWidth|)
+  (^  SUBSPAN |exptSub|)
+  (^  SUPERSPAN |exptSuper|)
+  (STEP APP |stepApp|)
+  (STEP WIDTH |stepWidth|)
+  (STEP SUBSPAN |stepSub|)
+  (STEP SUPERSPAN |stepSuper|)
+  (IN APP |inApp|)
+  (IN WIDTH |inWidth|)
+  (IN SUBSPAN |inSub|)
+  (IN SUPERSPAN |inSuper|)
+  (AGGLST APP |aggApp|)
+  (AGGLST SUBSPAN |aggSub|)
+  (AGGLST SUPERSPAN |aggSuper|)
+  (CONCATB APP |concatbApp|)
+  (CONCATB SUBSPAN |concatSub|)
+  (CONCATB SUPERSPAN |concatSuper|)
+  (CONCATB WIDTH |concatbWidth|)
+  (CONCAT APP |concatApp|)
+  (CONCAT  SUBSPAN |concatSub|)
+  (CONCAT SUPERSPAN |concatSuper|)
+  (CONCAT WIDTH |concatWidth|)
+  (QUOTE APP |quoteApp|)
+  (QUOTE SUBSPAN |quoteSub|)
+  (QUOTE SUPERSPAN |quoteSuper|)
+  (QUOTE WIDTH |quoteWidth|)
+  (STRING APP |stringApp|)
+  (STRING SUBSPAN |eq0|)
+  (STRING SUPERSPAN |eq0|)
+  (STRING WIDTH |stringWidth|)
+  (SIGMA APP |sigmaApp|)
+  (SIGMA SUBSPAN |sigmaSub|)
+  (SIGMA SUPERSPAN |sigmaSup|)
+  (SIGMA WIDTH |sigmaWidth|)
+  (SIGMA2 APP |sigma2App|)
+  (SIGMA2 SUBSPAN |sigma2Sub|)
+  (SIGMA2 SUPERSPAN |sigma2Sup|)
+  (SIGMA2 WIDTH |sigma2Width|)
+  (INTSIGN APP |intApp|)
+  (INTSIGN SUBSPAN |intSub|)
+  (INTSIGN SUPERSPAN |intSup|)
+  (INTSIGN WIDTH |intWidth|)
+  (INDEFINTEGRAL APP |indefIntegralApp|)
+  (INDEFINTEGRAL SUBSPAN |indefIntegralSub|)
+  (INDEFINTEGRAL SUPERSPAN |indefIntegralSup|)
+  (INDEFINTEGRAL WIDTH |indefIntegralWidth|)
+  (PI APP |piApp|)
+  (PI SUBSPAN |piSub|)
+  (PI SUPERSPAN |piSup|)
+  (PI WIDTH |piWidth|)
+  (PI2 APP |pi2App|)
+  (PI2 SUBSPAN |pi2Sub|)
+  (PI2 SUPERSPAN |pi2Sup|)
+  (PI2 WIDTH |pi2Width|)
+  (AGGLST WIDTH |aggWidth|)
+  (BRACKET APP |bracketApp|)
+  (BRACE APP |braceApp|)
+  (BRACE WIDTH |qTWidth|)
+)) (PROGN (MAKEPROP (CAR X) (CADR X) (CADDR X)))
+)
+
+;; from DEF LISP
+
+(REPEAT (IN X '(
+  (|:| |DEF-:|)
+  (|::| |DEF-::|)
+  (ELT DEF-ELT)
+  (SETELT DEF-SETELT)
+  (LET DEF-LET)
+  (COLLECT DEF-COLLECT)
+  (LESSP DEF-LESSP)
+  (|<| DEF-LESSP)
+  (REPEAT DEF-REPEAT)
+;;(|TRACE,LET| DEF-TRACE-LET)
+  (CATEGORY DEF-CATEGORY)
+  (EQUAL DEF-EQUAL)
+  (|is| DEF-IS)
+  (SEQ DEF-SEQ)
+  (|isnt| DEF-ISNT)
+  (|where| DEF-WHERE)
+)) (PROGN (MAKEPROP (CAR X) '|DEF-TRAN| (CADR X)) (CREATE-SBC (CADR X))))
+
+;; following was in INIT LISP
+
+(REPEAT (IN X '(
+  |Polynomial| |UnivariatePoly| |SquareMatrix| |QuotientField|
+  )) (MAKEPROP X '|status|
+     (CREATE-SBC (INTERNL (STRCONC "status" (STRINGIMAGE X))) )))
+
+(REPEAT (IN X '(
+  |UnivariatePoly| |Matrix| |QuotientField| |Gaussian|
+  )) (MAKEPROP X '|dataCoerce|
+     (CREATE-SBC (INTERNL (STRCONC "coerce" (STRINGIMAGE X))) )))
+
+(REPEAT (IN X '(
+  (|Integer| . (INTEGERP |#1|))
+  ;; (|Float| . (FLOATP |#1|))
+  (|DoubleFloat| . (FLOATP |#1|))
+  ;; (|Symbol| . (IDENTP |#1|))
+  ;;(|Boolean| . (BOOLEANP |#1|))  worthless predicate is always true
+  (|String| . (STRINGP |#1|))
+  (|PrimitiveSymbol| . (IDENTP |#1|))
+  )) (MAKEPROP (CAR X) '|BasicPredicate| (CDR X)))
+
+(MAKEPROP '|Integer| '|Subsets|
+  '((|PositiveInteger| . (|>| * 0))
+    (|NonNegativeInteger| . (|>=| * 0))
+    (|NegativeInteger| . (|<| * 0))
+    (|NonPositiveInteger| . (|<=| * 0))
+    (|NonZeroInteger| . (^= * 0))
+    (|SingleInteger| . (SMINTP *))
+    ))
+
+(MAKEPROP '|NonNegativeInteger| '|Subsets| '(
+  (|PositiveInteger| . (|>| * 0))
+  ))
+
+(MAKEPROP '|NonPositiveInteger| '|Subsets| '(
+  (|NegativeInteger| . (|<| * 0))
+  ))
+
+(FLAG '(|Union| |Record| |Enumration| |Mapping| |Enumeration|) 'FUNCTOR)
+
+(FLAG '(* + AND OR PROGN) 'NARY)
+
+(REPEAT (IN X '(
+  (|Record| |mkRecordFunList|)
+  (|Union| |mkUnionFunList|)
+  (|Mapping| |mkMappingFunList|)
+  (|Enumeration| |mkEnumerationFunList|)
+)) (MAKEPROP (CAR X) '|makeFunctionList| (CREATE-SBC (CADR X))))
+
+(REPEAT (IN X '(
+  (|<=| |parseLessEqual|)
+  (|>| |parseGreaterThan|)
+  (|>=| |parseGreaterEqual|)
+  (|$<=| |parseDollarLessEqual|)
+  (|$>| |parseDollarGreaterThan|)
+  (|$>=| |parseDollarGreaterEqual|)
+  ($^= |parseDollarNotEqual|)
+  (^ |parseNot|)
+  (^= |parseNotEqual|)
+  (\: |parseColon|)
+  (|::| |parseCoerce|)
+  (@ |parseAtSign|)
+<<clip>>
+  (|and| |parseAnd|)
+  (CATEGORY |parseCategory|)
+  (|construct| |parseConstruct|)
+  (DEF |parseDEF|)
+  (|eqv| |parseEquivalence|)
+  (|exit| |parseExit|)
+  (|has| |parseHas|)
+  (IF |parseIf|)
+  (|implies| |parseImplies|)
+  (IN |parseIn|)
+  (INBY |parseInBy|)
+  (|is| |parseIs|)
+  (|isnt| |parseIsnt|)
+  (|Join| |parseJoin|)
+  (|leave| |parseLeave|)
+  (LET |parseLET|)
+  (LETD |parseLETD|)
+  (MDEF |parseMDEF|)
+  (|not| |parseNot|)
+  (|or| |parseOr|)
+  (|pretend| |parsePretend|)
+  (|return| |parseReturn|)
+  (SEGMENT |parseSegment|)
+  (SEQ |parseSeq|)
+  (VCONS |parseVCONS|)
+  (|where| |parseWhere|)
+;;  (|xor| |parseExclusiveOr|)
+)) (MAKEPROP (CAR X) '|parseTran| (CADR X)))
+
+(REPEAT (IN X '(
+  (|with| |postWith|)
+  (|Scripts| |postScripts|)
+  (/ |postSlash|)
+  (|construct| |postConstruct|)
+  (|Block| |postBlock|)
+  (QUOTE |postQUOTE|)
+  (COLLECT |postCollect|)
+  (|:BF:| |postBigFloat|)
+  (|in| |postin|)  ;" the infix operator version of in"
+  (IN |postIn|)	 ;" the iterator form of in"
+  (REPEAT |postRepeat|)
+  (|TupleCollect| |postTupleCollect|)
+  (|add| |postAdd|)
+  (|Reduce| |postReduce|)
+  (\, |postComma|)
+  (\; |postSemiColon|)
+  (|where| |postWhere|)
+  (|::| |postColonColon|)
+  (\: |postColon|)
+  (@ |postAtSign|)
+  (|pretend| |postPretend|)
+  (|if| |postIf|)
+  (|Join| |postJoin|)
+  (|Signature| |postSignature|)
+  (CATEGORY |postCategory|)
+;;(	 |postDef|)
+  (== |postDef|)
+  (|==>| |postMDef|)
+  (|->| |postMapping|)
+  (|=>| |postExit|)
+  (|Tuple| |postTuple|)
+)) (MAKEPROP (CAR X) '|postTran| (CADR X)))
+
+(MAKEPROP 'INTEGER 'ISFUNCTION 'FIXP)
+(MAKEPROP '|Integer| '|isFunction| '|IsInteger|)
+(MAKEPROP '|Boolean| '|isFunction| '|isBoolean|)
+
+;; Many of the following are now in COMPAT LISP
+(REPEAT (IN X '(
+  (+ PLUS)
+  (|and| AND)
+  (|append| APPEND)
+  (|apply| APPLY)
+  (|atom| ATOM)
+  (|brace| REMDUP)
+  (|car| CAR)
+  (|cdr| CDR)
+  (|cons| CONS)
+  (|copy| COPY)
+  (|croak| CROAK)
+  (|drop| DROP)
+  (|exit| EXIT)
+  (|false| NIL)
+  (|first| CAR)
+  (|genvar| GENVAR)
+  (|in| |member|)
+  (|is| IS)
+  (|lastNode| LASTNODE)
+  (|list| LIST)
+  (|mkpf| MKPF)
+  (|nconc| NCONC)
+  (|nil| NIL)
+  (|not| NULL)
+  (|NOT| NULL)
+  (|nreverse| NREVERSE)
+  (|null| NULL)
+  (|or| OR)
+  (|otherwise| 'T)
+  (|removeDuplicates| REMDUP)
+  (|rest| CDR)
+  (|return| RETURN)
+  (|reverse| REVERSE)
+  (|setDifference| SETDIFFERENCE)
+  (|setIntersection| |intersection|)
+  (|setPart| SETELT)
+  (|setUnion| |union|)
+  (|size| SIZE)
+  (|strconc| STRCONC)
+  (|substitute| MSUBST)
+  (SUBST MSUBST)
+  (|take| TAKE)
+  (|true| 'T)
+  (|where| WHERE)
+  (* TIMES)
+  (** EXPT)
+  (^ NULL)
+  (^= NEQUAL)
+  (- SPADDIFFERENCE)
+  (/ QUOTIENT)
+  (= EQUAL)
+  (ASSOC  |assoc|)
+  (DELETE |delete|)
+  (GET GETL)
+  (INTERSECTION |intersection|)
+  (LAST |last|)
+  (MEMBER |member|)
+  (RASSOC |rassoc|)
+  (READ VMREAD)
+  (READ-LINE |read-line|)
+  (REDUCE SPADREDUCE)
+  (REMOVE |remove|)
+  (\| SUCHTHAT)
+  (T T$)
+  (UNION |union|)
+)) (MAKEPROP (CAR X) 'RENAME (CDR X)))
+
+;; these are accessor names for fields in data structures. Thus one would
+;; write datastructure.setName 
+(REPEAT (IN X '(
+  (|setName|  0)
+  (|setLabel| 1)
+  (|setLevel| 2)
+  (|setType|  3)
+  (|setVar|   4)
+  (|setLeaf|  5)
+  (|setDef|   6)
+  (|aGeneral| 4)
+  (|aMode| 1)
+  (|aModeSet| 3)
+  (|aTree| 0)
+  (|attributes| CADDR)
+  (|aValue| 2)
+  (|cacheCount| CADDDDR)
+  (|cacheName| CADR)
+  (|cacheReset| CADDDR)
+  (|cacheType| CADDR)
+  (|env| CADDR)
+  (|expr| CAR)
+  (|first| CAR)
+  (|mmCondition| CAADR)
+  (|mmDC| CAAR)
+  (|mmImplementation| CADADR)
+  (|mmSignature| CDAR)
+  (|mmTarget| CADAR)
+  (|mode| CADR)
+  (|op| CAR)
+  (|opcode| CADR)
+  (|opSig| CADR)
+  (|rest| CDR)
+  (|sig| CDDR)
+  (|source| CDR)
+  (|streamCode| CADDDR)
+  (|streamDef| CADDR)
+  (|streamName| CADR)
+  (|target| CAR)
+)) (MAKEPROP (CAR X) '|SEL,FUNCTION| (CADR X)))
+
+(REPEAT (IN X '(
+  (\| |compSuchthat|)
+  (\@ |compAtSign|)
+  (|:| |compColon|)
+  (\:\: |compCoerce|)
+  (QUOTE |compQuote|)
+<<clip1>>
+  (|add| |compAdd|)
+  (CAPSULE |compCapsule|)
+  (|case| |compCase|)
+  (CATEGORY |compCategory|)
+  (COLLECT |compRepeatOrCollect|)
+  (COLLECTV |compCollectV|)
+  (CONS |compCons|)
+  (|construct| |compConstruct|)
+  (DEF |compDefine|)
+  (|elt| |compElt|)
+  (|exit| |compExit|)
+  (|has| |compHas|)
+  (IF |compIf|)
+  (|import| |compImport|)
+  (|is| |compIs|)
+  (|Join| |compJoin|)
+  (|leave| |compLeave|)
+  (LET |compSetq|)
+  (|ListCategory| |compConstructorCategory|)
+  (MDEF |compMacro|)
+  (|pretend| |compPretend|)
+  (|Record| |compCat|)
+  (|RecordCategory| |compConstructorCategory|)
+  (REDUCE |compReduce|)
+  (REPEAT |compRepeatOrCollect|)
+  (|return| |compReturn|)
+  (SEQ |compSeq|)
+  (SETQ |compSetq|)
+  (|String| |compString|)
+  (|SubDomain| |compSubDomain|)
+  (|SubsetCategory| |compSubsetCategory|)
+  (|Union| |compCat|)
+  (|Mapping| |compCat|)
+  (|UnionCategory| |compConstructorCategory|)
+  (VECTOR |compVector|)
+  (|VectorCategory| |compConstructorCategory|)
+  (|where| |compWhere|)
+)) (MAKEPROP (CAR X) 'SPECIAL (CREATE-SBC (CADR X))))
+
+(REPEAT (IN X '(
+  (\: |compColonInteractive|)
+  (DEF |compDefineInteractive|)
+  (|construct| |compConstructInteractive|)
+  (LET |compSetqInteractive|)
+)) (MAKEPROP (CAR X) 'INTERACTIVE (CREATE-SBC (CADR X))))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pspad1.boot.pamphlet b/src/interp/pspad1.boot.pamphlet
new file mode 100644
index 00000000..e130287c
--- /dev/null
+++ b/src/interp/pspad1.boot.pamphlet
@@ -0,0 +1,768 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/pspad1.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+$escapeWords := ["always", "assert", "but", "define", 
+  "delay", "do", "except", "export", "extend", "fix", "fluid",
+    "from", "generate", "goto", "import", "inline", "never", "select",
+       "try", "yield"]
+$pileStyle := false
+$commentIndentation := 8
+$braceIndentation := 8
+$doNotResetMarginIfTrue := true
+$marginStack := nil
+$numberOfSpills := 0
+$lineFragmentBuffer:= nil
+$pspadRelationAlist := '((_= . _~_=) (_< . _>_=) (_<_= . _>)(_~_= . _=)(_>_= . _<) (_> . _<_=))
+$lineBuffer := nil
+$formatForcePren := nil
+$underScore := char ('__)
+$rightBraceFlag := nil 
+$semicolonFlag := nil
+$newLineWritten := nil
+$comments := nil
+$noColonDeclaration := false
+$renameAlist := '(
+  (SmallInteger . SingleInteger)
+  (SmallFloat . DoubleFloat)
+  (Void . _(_))
+  (xquo . exquo)
+  (setelt . set_!)
+  (_$ . _%)
+  (_$_$ . _$)
+  (_*_* . _^)
+  (_^_= . _~_=)
+  (_^ . _~))
+
+--$opRenameAlist := '(
+--  (and . AND)
+--  (or  . OR)
+--  (not . NOT))
+
+
+--======================================================================
+--               Main Translator Function
+--======================================================================
+--% lisp-fragment to boot-fragment functions
+lisp2Boot x ==
+                  --entry function
+  $fieldNames := nil
+  $eltIfNil: local --changes NEW META to generate ELTs for infix dot
+  $pilesAreOkHere: local:= true
+  $commentsToPrint: local:= nil
+  $lineBuffer: local
+  $braceStack: local := nil
+  $marginStack: local:= [0]
+  --$autoLine is true except when inside a try---if true, lines are allowed to break
+  $autoLine:= true
+  $lineFragmentBuffer:= nil
+  $bc:=0     --brace count
+  $m:= 0
+  $c:= $m
+  $numberOfSpills:= 0
+  $lineLength:= 80
+  format x
+  formatOutput REVERSE $lineFragmentBuffer
+  [fragmentsToLine y for y in REVERSE $lineBuffer]
+ 
+fragmentsToLine fragments ==
+  string:= lispStringList2String fragments
+  line:= GETSTR 240
+  for i in 0..MAXINDEX string repeat line:= SUFFIX(string.i,line)
+  line
+ 
+lispStringList2String x ==
+  null x => '""
+  atom x => STRINGIMAGE x
+  CDR x => APPLY(function STRCONC,MAPCAR(function lispStringList2String,x))
+  lispStringList2String CAR x
+ 
+--% routines for buffer and margin adjustment
+ 
+formatOutput x ==
+  for [currentColumn,start,end,stack] in REVERSE $commentsToPrint repeat
+    startY:= rest start
+    for [loc,comment] in stack repeat
+      commentY:= rest loc
+      gap:= startY-commentY
+      gap>0 => before:= [[commentY,first loc,gap,comment],:before]
+      gap=0 => same:= [[startY,1,gap,comment],:same]
+      true => after:= [[startY,first loc,-gap,comment],:after]
+  if before then putOut before
+  if same then
+    [y,:extraLines]:= "append"/[mkCommentLines u for u in orderList same]
+    line:= fragmentsToLine x
+    x:=
+      #line+#y>$lineLength =>
+        (y:= STRCONC(nBlanks $m,y); extraLines:= [y,:extraLines]; x)
+      [line,y]
+  consLineBuffer x
+  for y in extraLines repeat consLineBuffer LIST y
+  if after then putOut after
+  $commentsToPrint:= nil
+ 
+consLineBuffer x ==  $lineBuffer := [x,:$lineBuffer]
+
+putOut x ==
+  eject ("min"/[gap for [.,.,gap,:.] in x])
+  for u in orderList x repeat addComment u
+ 
+eject n == for i in 2..n repeat consLineBuffer nil
+ 
+addComment u ==
+  for x in mkCommentLines u repeat consLineBuffer LIST x
+ 
+mkCommentLines [.,n,.,s] ==
+  lines:= breakComments s
+  lines1:= [fragmentsToLine [nBlanks n,"_{",first lines],:rest lines]
+  [:l,last]:= lines1
+  [:l,fragmentsToLine [last,"_}"]]
+ 
+breakComments s ==
+  n:= containsString(s,PNAME "ENDOFLINECHR") =>
+    #s>n+12 => [SUBSTRING(s,0,n),:breakComments SUBSTRING(s,n+12,NIL)]
+    LIST SUBSTRING(s,0,n)
+  LIST s
+ 
+containsString(x,y) ==
+                       --if string x contains string y, return start index
+  for i in 0..MAXINDEX x-MAXINDEX y repeat
+    and/[x.(i+j)=y.j for j in 0..MAXINDEX y] => return i
+ 
+--======================================================================
+--               Character/String Buffer Functions
+--======================================================================
+consBuffer item ==
+  if item = '"failed" then item := 'failed
+  n:=
+    STRINGP item => 2+#item
+    IDENTP item => #PNAME item
+    #STRINGIMAGE item
+  columnsLeft:= $lineLength-$c
+  if columnsLeft <= 0 and isCloseDelimiter item then $lineLength := $lineLength + 2
+  columnsLeft:= $lineLength-$c
+  --cheat for semicolons, strings, and delimiters: they are NEVER too long
+  not isSpecialBufferItem item and (n>columnsLeft or columnsLeft < 0) =>
+    $autoLine =>
+                   --is true except within try
+      formatOutput REVERSE $lineFragmentBuffer
+      $c:= REMAINDER($m+2*($numberOfSpills:= $numberOfSpills+1), $lineLength)
+      $lineFragmentBuffer:= LIST nBlanks $c
+      consBuffer item
+    nil
+  $lineFragmentBuffer:=
+    ^item or IDENTP item => [PNAME item,:$lineFragmentBuffer]
+    NUMBERP item or CHARP item => [STRINGIMAGE item,:$lineFragmentBuffer]
+    STRINGP item => ["_"",string2PrintImage item,"_"",:$lineFragmentBuffer]
+    sayBrightly ['"Unexpected line buffer item: ", STRINGIMAGE item]
+    $lineFragmentBuffer
+  $rightBraceFlag := item = "}"
+  $semicolonFlag  := item = "; "   --prevents consecutive semicolons
+  $c:= $c+n
+ 
+isSpecialBufferItem item ==
+  item = "; " or STRINGP item => true
+  false
+
+isCloseDelimiter item ==   EQ(item,")") or EQ(item,"]") or EQ(item,"}") 
+
+--======================================================================
+--               Formatting/Line Control Functions
+--======================================================================
+newLine() ==
+  null $autoLine => nil
+  $newLineWritten := true
+  formatOutput REVERSE $lineFragmentBuffer
+  $lineFragmentBuffer:= LIST nBlanks $m
+  $c:= $m
+ 
+optNewLine() ==
+  $newLineWritten => newLine()
+  $c
+
+spillLine() ==
+  null $autoLine => nil
+  formatOutput REVERSE $lineFragmentBuffer
+  $c:= $m+2*($numberOfSpills:= $numberOfSpills+1)
+  $lineFragmentBuffer:= LIST nBlanks $c
+  $c
+ 
+indent() ==
+  $m:= $m+2*($numberOfSpills+1)
+  $marginStack:= [$m,:$marginStack]
+  $numberOfSpills:= 0
+  $m
+ 
+undent() ==
+--  $doNotResetMarginIfTrue=true => 
+--    pp '"hoho"
+--    $c
+  $marginStack is [m,:r] =>
+    $marginStack := r
+    $m := m
+  0
+
+spill(fn,a) == 
+  u := try FUNCALL(fn,a) => u
+  (nearMargin() or spillLine()) and FUNCALL(fn,a)
+ 
+formatSpill(fn,a) ==
+  u := try FUNCALL(fn,a) => u
+  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,a) 
+  w := stay or undent()
+  v and w
+ 
+formatSpill2(fn,f,a) ==
+  u := try FUNCALL(fn,f,a) => u
+  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,f,a) 
+  w := stay or undent()
+  v and w
+ 
+nearMargin() ==
+  $c=$m or $c=$m+1 => $c
+ 
+--======================================================================
+--               Main Formatting Functions
+--======================================================================
+format(x,:options) ==
+  oldC:= $c
+  qualification := IFCAR options
+  newCOrNil:=
+    x is [op,:argl] =>
+      if op = 'return then argl := rest argl
+      n := #argl
+      op is ['elt,y,"construct"] => formatDollar(y,'construct,argl)
+      op is ['elt,name,p] and UPPER_-CASE_-P (STRINGIMAGE opOf name).0 => 
+        formatDollar(name,p,argl)
+      op = 'elt and UPPER_-CASE_-P (STRINGIMAGE opOf CAR argl).0 => 
+        formatDollar1(CAR argl,CADR argl)
+      fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c)
+      if MEMQ(op,'(AND OR NOT)) then op:= DOWNCASE op
+      n=1 and GETL(op,'Nud) and (lbp:= formatOpBindingPower(op,"Nud","left")) =>
+        formatPrefix(op,first argl,lbp,formatOpBindingPower(op,"Nud","right"),qualification)
+      n=2 and (op = '_$ or getOp(op,'Led)) and (lbp:= formatOpBindingPower(op,"Led","left")) =>
+        formatInfix(op,argl,lbp,formatOpBindingPower(op,"Led","right"),qualification)
+      formatForm x
+    formatAtom x
+  null newCOrNil => ($c:= oldC; nil)
+  null FIXP newCOrNil => error()
+  $c:= newCOrNil
+ 
+
+getOp(op,kind) ==
+  kind = 'Led =>
+    MEMQ(op,'(_div _exquo)) => nil
+    GET(op,'Led)
+  GET(op,'Nud)
+
+formatDollar(name,p,argl) ==
+  name := markMacroTran name
+  n := #argl
+  kind := (n=1 => "Nud"; "Led")
+  IDENTP name and GETL(p,kind) => format([p,:argl],name)
+  formatForcePren [p,:argl] and 
+    (try (format "$$" and formatForcePren name) 
+      or (indent() and format "$__" and formatForcePren name and undent()))
+ 
+formatMacroCheck name ==
+  ATOM name => name
+  u := or/[x for [x,:y] in $globalMacroStack | y = name] => u
+  u := or/[x for [x,:y] in $localMacroStack  | y = name] => u
+  [op,:argl] := name
+  MEMQ(op,'(Record Union)) => 
+    pp ['"Cannot find: ",name]
+    name
+  [op,:[formatMacroCheck x for x in argl]]
+  
+formatDOLLAR ['DOLLAR,x,y] == formatDollar1(y, x)
+
+formatDollar1(name,arg) ==
+  id :=
+    IDENTP name => name
+    name is [p] and GETL(p,'NILADIC) => p
+    name
+  format arg and format "$$" and formatForcePren id
+ 
+ 
+formatForcePren x ==
+  $formatForcePren: local := true
+  format x
+ 
+formatAtom(x,:options) ==
+  if u := LASSOC(x,$renameAlist) then x := u
+  null x or isIdentifier x => 
+    if MEMQ(x,$escapeWords) then 
+      consBuffer $underScore
+    consBuffer ident2PrintImage PNAME x
+  consBuffer x
+ 
+formatFn(fn,x,$m,$c) == FUNCALL(fn,x)
+
+formatFree(['free,:u]) ==
+  format 'free and format " " and formatComma u
+
+formatUnion(['Union,:r]) == 
+  $count : local := 0
+  formatFormNoColonDecl formatTestForPartial ['Union,:[fn x for x in r]] where fn x ==
+    x is [":",y,'Branch] => fn STRINGIMAGE y
+    STRINGP x => [":", INTERN x, ['Enumeration,x]]
+    x is [":",:.] => x
+    tag := INTERN STRCONC("value",STRINGIMAGE ($count := $count + 1))
+    [":", tag, x]      
+
+formatTestForPartial u ==
+  u is ['Union,a,b] and b is [":","failed",:.] and a is [":",.,S] =>
+    ['Partial, S]
+  u
+
+formatEnumeration(y is ['Enumeration,:r]) ==
+  r is [x] => format "'" and format INTERN STRINGIMAGE x and format "'"
+  formatForm y
+
+formatRecord(u) == formatFormNoColonDecl u
+
+formatFormNoColonDecl u ==
+  $noColonDeclaration: local := true
+  formatForm u  
+
+formatElt(u) ==  
+  u is ["elt",a,b] => formatApplication rest u
+  formatForm u
+ 
+formatForm (u) ==
+  [op,:argl] := u
+  if MEMQ(op, '(Record Union)) then 
+    $fieldNames := union(getFieldNames argl,$fieldNames)
+  MEMQ(op,'((QUOTE T) true)) => format "true"
+  MEMQ(op,'(false nil)) => format op
+  u='(Zero) => format 0
+  u='(One) => format 1
+  1=#argl => formatApplication u
+  formatFunctionCall u
+ 
+formatFunctionCall u ==
+  $pilesAreOkHere: local
+  spill("formatFunctionCall1",u)
+ 
+formatFunctionCall1 [op,:argl] ==
+--null argl and getConstructorProperty(op,'niladic) => formatOp op
+  null argl => 
+    GETL(op,'NILADIC) => formatOp op
+    formatOp op and format "()"
+  formatOp op and formatFunctionCallTail argl 
+ 
+formatFunctionCallTail argl == format "_(" and formatComma argl and format "_)"
+
+formatComma argl == 
+  format first argl and (and/[format "," and formatCut x for x in rest argl]) and $c
+ 
+formatOp op ==
+  atom op => formatAtom op
+  formatPren op
+ 
+formatApplication u ==
+  [op,a] := u
+  MEMQ(a, $fieldNames) => formatSelection u
+  atom op => 
+    formatHasDotLeadOp a => formatOpPren(op,a)
+    formatApplication0 u
+  formatSelection u
+
+formatHasDotLeadOp u ==
+  u is [op,:.] and (op = "." or not atom op)
+
+formatApplication0 u ==
+--format as f(x) as f x if possible
+  $pilesAreOkHere: local
+  formatSpill("formatApplication1",u)
+ 
+formatApplication1 u ==
+  [op,x] := u
+  formatHasDollarOp x or $formatForcePren or 
+    pspadBindingPowerOf("left",x) < 1000  => formatOpPren(op,x)
+  try (formatOp op and format " ") and 
+    (try formatApplication2 x or
+      format "(" and formatApplication2 x and format ")")
+
+formatHasDollarOp x ==
+  x is ["elt",a,b] and isTypeProbably? a 
+
+isTypeProbably? x ==
+  IDENTP x and UPPER_-CASE_-P (PNAME x).0
+
+formatOpPren(op,x) == formatOp op and formatPren x
+
+formatApplication2 x ==
+  leadOp := 
+    x is [['elt,.,y],:.] => y
+    opOf x
+  MEMQ(leadOp,'(COLLECT LIST construct)) or
+    pspadBindingPowerOf("left",x)<1000 => formatPren x
+  format x
+
+formatDot ["dot",a,x] ==
+  try (formatOp a and format ".") and
+    ATOM x => format x
+    formatPren x
+ 
+formatSelection u ==
+  $pilesAreOkHere: local
+  formatSpill("formatSelection1",u)
+ 
+formatSelection1 [f,x] == formatSelectionOp f and format "." and 
+    ATOM x => format x
+    formatPren x
+ 
+formatSelectionOp op ==
+  op is [f,.] and not GET(f,'Nud) or 
+    1000 < pspadBindingPowerOf("right",op) => formatSelectionOp1 op
+  formatPren1("formatSelectionOp1",op)
+ 
+formatSelectionOp1 f ==
+  f is [op,:argl] => 
+    argl is [a] => 
+      not ATOM op and ATOM a => formatSelection1 [op,a]
+      formatPren f
+    format f
+  formatOp f
+ 
+formatPren a ==
+  $pilesAreOkHere: local
+  formatSpill("formatPrenAux",a)
+ 
+formatPrenAux a == format "_(" and format a and format "_)"
+ 
+formatPren1(f,a) ==
+  $pilesAreOkHere: local
+  formatSpill2("formatPren1Aux",f,a)
+ 
+formatPren1Aux(f,a) == format "_(" and FUNCALL(f,a) and format "_)"
+ 
+formatLeft(fn,x,op,key) ==
+  lbp:= formatOpBindingPower(op,key,"left")
+  formatOpBindingPower(opOf x,key,"right")<lbp => formatPren1(fn,x)
+  FUNCALL(fn,x)
+ 
+formatRight(fn,x,op,key) ==
+  --are there exceptional cases where piles are ok?
+  x is ['LET,:.] => FUNCALL(fn,x)
+  --decide on basis of binding power whether prens are needed
+  rbp := formatOpBindingPower(op,key,"right")
+  lbp := formatOpBindingPower(opOf x,key,"left")
+  lbp < rbp => formatPren1(fn,x)
+  FUNCALL(fn,x)
+ 
+formatCut a == formatSpill("format",a)
+ 
+--======================================================================
+--               Prefix/Infix Operators
+--======================================================================
+formatPrefix(op,arg,lbp,rbp,:options) ==
+  qualification := IFCAR options
+  $pilesAreOkHere: local
+  formatPrefixOp(op,qualification) and
+    (rbp>formatGetBindingPowerOf("left",arg) => formatPren arg; format arg)
+ 
+formatPrefixOp(op,:options) ==
+  qualification := IFCAR options
+  op=char '" " => format " ="
+  qualification or GET(op,"Nud") and ^MEMQ(op,$spadTightList) => 
+    formatQual(op,qualification) and format " "
+  format op
+
+formatQual(op,D) ==
+  null D => format op
+  format op and format "$$" and format D
+
+formatInfix(op,[a,b],lbp,rbp,:options) ==
+  qualification  := IFCAR options
+  $pilesAreOkHere: local
+  (if formatGetBindingPowerOf("right",a)<lbp then formatPren a else format a) and
+    formatInfixOp(op,qualification) and (if rbp>formatGetBindingPowerOf("left",b) 
+      then formatPren b else format b)
+ 
+formatGetBindingPowerOf(leftOrRight,x) ==
+--  this function is nearly identical with getBindingPowerOf
+--    leftOrRight = "left" => 0
+--    1
+  pspadBindingPowerOf(leftOrRight,x)
+ 
+pspadBindingPowerOf(key,x) ==
+  --binding powers can be found in file NEWAUX LISP
+  x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
+  x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
+  x is ["COND",:.] => (key="left" => 130; key="right" => 0)
+  x is [op,:argl] =>
+    if op is [a,:.] then op:= a
+    op = 'SLASH => pspadBindingPowerOf(key,["/",:argl]) - 1
+    op = 'OVER  => pspadBindingPowerOf(key,["/",:argl])
+    (n:= #argl)=1 =>
+      key="left" and (m:= pspadOpBindingPower(op,"Nud","left")) => m
+      key="right" and (m:= pspadOpBindingPower(op,"Nud","right")) => m
+      1000
+    n>1 =>
+      key="left" and (m:= pspadOpBindingPower(op,"Led","left")) => m
+      key="right" and (m:= pspadOpBindingPower(op,"Led","right")) => m
+      op="ELT" => 1002
+      1000
+    1000
+  1002
+
+pspadOpBindingPower(op,LedOrNud,leftOrRight) ==
+  if op in '(SLASH OVER) then op := "/"
+  MEMQ(op,'(_:)) and LedOrNud = 'Led =>
+    leftOrRight = 'left => 195
+    196
+  exception:=
+    leftOrRight="left" => 0
+    105
+  bp:=
+    leftOrRight="left" => leftBindingPowerOf(op,LedOrNud)
+    rightBindingPowerOf(op,LedOrNud)
+  bp^=exception => bp
+  1000
+
+formatOpBindingPower(op,key,leftOrRight) ==
+  if op in '(SLASH OVER) then op := "/"
+  op = '_$ => 1002
+  MEMQ(op,'(_:)) and key = 'Led =>
+    leftOrRight = 'left => 195
+    196
+  MEMQ(op,'(_^_= _>_=)) => 400
+  op = "not" and key = "Nud" =>
+    leftOrRight = 'left => 1000
+    1001
+  GETL(op,key) is [.,.,:r] =>
+    leftOrRight = 'left => KAR r or 0
+    KAR KDR r or 1
+  1000
+ 
+formatInfixOp(op,:options) ==
+  qualification := IFCAR options
+  qualification or 
+    (op ^= '_$) and ^MEMQ(op,$spadTightList) => format " " and formatQual(op,qualification) and format " "
+  format op
+ 
+--======================================================================
+--            Special Handlers: DEF forms
+--======================================================================
+
+formatDEF def == formatDEF0(def,$DEFdepth + 1)
+
+formatDEF0(["DEF",form,tlist,sclist,body],$DEFdepth) ==
+  if not MEMQ(KAR form,'(Exports Implementation)) then 
+    $form := 
+      form is [":",a,:.] => a
+      form
+  con := opOf $form
+  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
+  $abb :local := constructor? opOf $form
+  if $DEFdepth < 2 then
+    condoc := (u := LASSOC('constructor,$comments)) and KDR KAR u or ['""]
+    $numberOfSpills := -1
+    consComments(condoc,'"+++ ")
+  form := formatDeftranForm(form,tlist)
+  u := ["DEF",form,tlist,sclist,body]
+  v := formatDEF1 u => v
+  $insideDEF: local := $DEFdepth > 1
+  $DEFdepth = 1 =>
+    exname := 'Exports
+    impname := 'Implementation
+    form is [":",.,=exname] or body = impname => nil
+    exports :=
+      form is [":",a,b] => 
+        form := a
+        [["MDEF",exname,'(NIL),'(NIL),b]]
+      nil
+    [op,:argl] := form
+--  decls := [x for x in argl | x is [":",:.]]
+--  form := [op,:[(a is [":",b,t] => b; a) for a in argl]]
+--  $DEFdepth := $DEFdepth - 1  
+    formatWHERE(["where",
+      ["DEF",[":",form,exname],[nil for x in form],sclist,impname],
+        ['PROGN,:exports,["MDEF",impname,'(NIL),'(NIL),body]]])
+  $insideTypeExpression: local := true
+  body := formatDeftran(body,false)
+  body is ["add",a,:b] => formatAddDef(form,a,b) 
+--body is ["with",a,:b] => formatWithDef(form,a,b)
+  tryBreakNB(format form and format " == ",body,"==","Led") 
+
+formatDEF1 ["DEF",form,tlist,b,body] ==
+  $insideDEF: local := $DEFdepth > 1
+  $insideEXPORTS: local := form = 'Exports
+  $insideTypeExpression: local := true
+  form := formatDeftran(form,false)
+  body := formatDeftran(body,false)
+  ---------> terrible, hideous, but temporary, hack
+  if not $insideDEF and body is ['SEQ,:.] then body := ["add", body]
+  prefix := (opOf tlist = 'Category => "define "; nil)
+  body is ["add",a,b] => formatAddDef(form,a,b)
+  body is ["with",a,:b] => formatWithDef(form,a,b,"==",prefix)
+  prefix => 
+    tryBreak(format prefix and format form and format " == ",body,"==","Led") 
+  tryBreak(format form and format " == ",body,"==","Led") 
+
+formatDefForm(form,:options) ==
+  prefix := IFCAR options 
+  $insideTypeExpression : local := true
+  form is [":",form1,["with",a,:b]] => formatWithDef(form1,a,b,":",prefix)
+  prefix => format prefix and format form
+  format form
+
+formatAddDef(form,a,b) ==
+  $insideCAPSULE : local := true
+  $insideDEF     : local := false
+  formatDefForm form or return nil
+  $marginStack := [0]
+  $m := $c := 0
+  $insideTypeExpression : local := false
+  cap := (b => b; "")
+  tryBreakNB(newLine() and format "== " and formatLeft("format",a,"add","Led") 
+      and format " add ", cap,"add","Led")
+
+formatWithDef(form,a,b,separator,:options) ==
+  prefix := IFCAR options
+  $insideEXPORTS : local := true
+  $insideCAPSULE : local := true
+  $insideDEF     : local := false
+  $insideTypeExpression : local := false
+  a1 := formatWithKillSEQ a
+  b => tryBreakNB(formatDefForm(form,prefix) and format separator and format " with " and formatLeft("format",a,"with","Led") 
+      and format " with ",first b,"with","Led")
+  tryBreak(formatDefForm(form,prefix) and format separator and format " with ",a1,"with","Nud")
+ 
+formatWithKillSEQ x ==
+  x is ['SEQ,['exit,.,y]] => ['BRACE, y]
+  x
+
+formatBrace ['BRACE, x]  == format "{" and format x and format "}"
+
+formatWith ["with",a,:b] ==
+  $pilesAreOkHere: local := true
+  b => 
+    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
+  tryBreak(format "with ",a,"with","Nud")
+
+formatWithDefault ["withDefault",a,b] ==
+  if a is ['with,:init,["SEQ",:items,["exit",.,x]]] then
+    part2 := ["SEQ",:items,x,["exit", nil,["defaultDefs", b]]]
+    if IFCAR init then
+      a:= IFCAR init
+      b:= [part2]
+    else
+      a := part2
+      b := nil
+  $pilesAreOkHere: local := true
+  b => 
+    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
+  tryBreak(format "with ",a,"with","Nud")
+
+formatDefaultDefs ["default",a, :b] ==
+  $insideCAPSULE : local := true
+  $insideDEF     : local := false
+  $insideTypeExpression : local := false
+  b => 
+    tryBreak(formatLeft("format",a,"default","Led") and 
+      format " default ", first b,"default","Led")
+  tryBreak(format "default ",a,"default","Nud")
+--format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
+
+formatAdd ["add",a,:b] ==
+  $insideCAPSULE : local := true
+  $insideDEF     : local := false
+  $insideTypeExpression : local := false
+  b => 
+    tryBreakNB(formatLeft("format",a,"and","Led") and 
+      format " and ", first b,"and","Led")
+  tryBreakNB(format "add ",a,"and","Nud")
+--format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
+
+formatMDEF ["MDEF",form,.,.,body] ==
+  form is '(Rep) => formatDEF ["DEF",form,.,.,body]
+  $insideEXPORTS: local := form = 'Exports
+  $insideTypeExpression: local := true
+  body := formatDeftran(body,false)
+  name := opOf form
+  tryBreakNB(format name and format " ==> ",body,"==","Led") 
+   and ($insideCAPSULE and $c or format(";"))
+
+insideCat() == $insideCategoryIfTrue and not $insideFunctorIfTrue 
+   or $noColonDeclaration
+
+formatImport ["import",a] == 
+  addFieldNames a
+  addFieldNames macroExpand(a,$e)
+  format "import from " and formatLocal1 a
+
+addFieldNames a ==
+  a is [op,:r] and MEMQ(op,'(Record Union)) =>
+        $fieldNames := union(getFieldNames r,$fieldNames)
+  a is ['List,:b] => addFieldNames b
+  nil
+
+getFieldNames r ==
+  r is [[":",a,b],:r] => [a,:getFieldNames r]
+  nil
+
+formatLocal ["local",a] == format "local " and formatLocal1 a
+ 
+formatLocal1 a ==
+  $insideTypeExpression: local := true
+  format a
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/pspad2.boot.pamphlet b/src/interp/pspad2.boot.pamphlet
new file mode 100644
index 00000000..54e9a584
--- /dev/null
+++ b/src/interp/pspad2.boot.pamphlet
@@ -0,0 +1,683 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pspad2.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--======================================================================
+--                Constructor Transformation Functions
+--======================================================================
+formatDeftranForm(form,tlist) ==
+  [ttype,:atypeList] := tlist
+  if form is [":",f,t] then 
+    form := f
+    ttype := t
+  if form is ['elt,a,b] then    ----> a.b ====> apply(b,a)
+    form := 
+      isTypeProbably? a =>
+        atypeList := REVERSE atypeList
+        ["$$", b, a]
+      ["apply",a, b]
+  op   := KAR form
+  argl := KDR form
+  if or/[t for t in atypeList] then
+    form := [op,:[(t => [":",a,t]; a) for a in argl for t in atypeList]]
+  if ttype then form := [":",form,ttype]
+  form
+ 
+formatDeftran(u,SEQflag) ==
+  u is ['Join,:x] => formatDeftranJoin(u,SEQflag)
+  u is ['CATEGORY,kind,:l,x] => formatDeftran(['with,['SEQ,:l,['exit,n,x]]],SEQflag)
+  u is ['CAPSULE,:l,x] => formatDeftranCapsule(l,x,SEQflag)
+  u is [op,:.] and MEMQ(op,'(rep per)) => formatDeftranRepper(u,SEQflag)
+  u is [op,:.] and MEMQ(op,'(_: _:_: _pretend _@)) => 
+    formatDeftranColon(u,SEQflag)
+  u is ['PROGN,:l,x] => formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
+  u is ['SEQ,:l,[.,n,x]] => 
+    v := [:l,x]
+    a := "APPEND"/[formatDeftranSEQ(x,true) for x in l]
+    b := formatDeftranSEQ(x,false)
+    if b is [:.,c] and c = '(void) then b := DROP(-1, b)
+    [:m,y] := [:a,:b]
+    ['SEQ,:m,['exit,n,y]]
+--  u is ['not,arg] and (op := LASSOC(KAR arg,'((_= . _^_=) (_< . _>_=)))) =>
+--    formatDeftran([op,:CDR arg],nil)
+  u is ["^",a] => formatDeftran(['not,a],SEQflag)
+  u is ["exquo",a,b] => formatDeftran(['xquo,a,b],SEQflag)
+  u is ['IF,a,b,c] => 
+    a := formatDeftran(a,nil)
+    b := formatDeftran(b,nil)
+    c := formatDeftran(c,nil)
+    null SEQflag and $insideDEF =>
+      [:y,last] := formatDeftranIf(a,b,c)
+      ['SEQ,:y,['exit,1,last]]
+    ['IF,a,b,c]
+  u is ['Union,:argl] => 
+    ['Union,:[x for a in argl 
+      | x := (STRINGP a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]]
+  u is [op,:itl,body] and MEMQ(op,'(REPEAT COLLECT)) and
+    ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) =>
+      formatDeftran([op,:nitl,nbody],SEQflag)
+  u is [":",a,b] => [":",formatDeftran(a,nil),formatDeftran(markMacroTran(b),nil)]
+  u is ["DEF",:.] => formatCapsuleFunction(u)
+  u is [op,:argl]=>[formatDeftran(op,nil),:[formatDeftran(x,nil) for x in argl]]
+  u = 'nil => 'empty
+  u
+
+formatCapsuleFunction ["DEF",form,tlist,b,body] ==
+  $insideDEF : local := true
+  ["DEF", formatDeftran(form,nil),tlist,b,formatDeftran(body,nil)]
+ 
+formatDeftranCapsule(l,x,SEQflag) ==
+  $insideCAPSULE: local := true
+  formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
+
+formatDeftranRepper([op,a],SEQflag) ==
+    a is [op1,b] and MEMQ(op1,'(rep per)) =>
+        op = op1 => formatDeftran(a,SEQflag)
+        formatDeftran(b,SEQflag)
+    a is ["::",b,t] =>
+      b := formatDeftran(b,SEQflag)
+      t := formatDeftran(t,SEQflag)
+      a := ["::",b,t]
+      op = 'per and t = "$" or op = 'rep and t = 'Rep => a
+      [op,a]
+    a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]]
+    a is ['IF,p,b,c] => 
+      formatDeftran(['IF,p,[op,b],[op, c]], SEQflag)
+    a is ['LET,a,b] => formatDeftran(['LET,a,[op,b]],SEQflag)
+    a is ['not,[op,a,b]] and (op1 := LASSOC(op,$pspadRelationAlist)) =>
+      formatDeftran [op1,a,b]
+    a is ['return,n,r] => 
+      MEMQ(opOf r,'(true false)) => a
+      ['return,n,[op,formatDeftran(r,SEQflag)]]
+    a is ['error,:.] => a
+    [op,formatDeftran(a,SEQflag)]
+
+formatDeftranColon([op,a,t],SEQflag) ==  --op is one of :  ::  pretend  @
+    a := formatDeftran(a,SEQflag)
+    t := formatDeftran(t,SEQflag)
+    a is ["UNCOERCE",b] => b
+    a is [op1,b,t1] and t1 = t and MEMQ(op,'(_: _:_: _pretend _@)) =>
+      op1 = "pretend" or op = "pretend" => ["pretend",b,t]
+      null SEQflag and op1 = ":" or op = ":" => ["pretend",b,t]
+      a
+    a is [=op,b,t1] =>
+      t1 = t => a
+      [op,b,t]
+    t = "$" =>
+      a is ['rep,b] => b
+      a is ['per,b] => a
+      [op,a,t]
+    t = "Rep" =>
+      a is ['per,b] => b
+      a is ['rep,b] => a
+      [op,a,t]
+    [op,a,t]
+
+formatSeqRepper(op,x) ==
+  x is ['exit,n,y] => ['exit,n,[op,formatDeftran(y,nil)]]
+  x is ["=>",a,b] => ["=>",formatDeftran(a,nil),[op,formatDeftran(b,nil)]]
+  atom x => x
+  [formatSeqRepper(op,y) for y in x]
+  
+formatDeftranJoin(u,SEQflag) ==
+  ['Join,:cats,lastcat] := u
+  lastcat is ['CATEGORY,kind,:l,x] =>
+    cat := 
+      CDR cats => ['Join,:cats]
+      first cats
+    formatDeftran(['with,cat,['SEQ,:l,['exit,1,x]]],SEQflag)
+  u
+ 
+formatENUM ['MyENUM, x] == format "'" and format x and format "'"
+
+formatDeftranREPEAT(itl,body) == 
+--do nothing unless "itl" contains UNTIL statements
+  u := [x for x in itl | x is ["UNTIL",p]] or return nil
+  nitl := SETDIFFERENCE(itl,u)
+  pred := MKPF([p for ['UNTIL,p] in u],'or)
+  cond := ['IF,pred,['leave,n,nil],'noBranch]
+  nbody :=
+    body is ['SEQ,:l,[.,n,x]] => ['SEQ,:l,x,['exit,n,cond]]
+    ['SEQ,body,['exit,n,cond]]
+  [nitl,:nbody]
+
+formatDeftranSEQ(x,flag) ==
+  u := formatDeftran(x,flag)
+  u is ['SEQ,:.] => rest u
+  [u]
+
+formatDeftranIf(a,b,c) ==
+  b = 'noBranch =>
+    a is [op,:r] and (al := '((_= . _~_=) (_< . _>_=) (_> . _<_=));
+                      iop := LASSOC(op, al) or rassoc(op, al)) =>
+      [["=>",[iop, :r],c]]
+    a is [op,r] and MEMQ(op,'(NOT not NULL null)) =>
+      [["=>", r, c]]
+    [["=>", ['not, a], c]]
+  post := 
+    c = 'noBranch => nil
+    c is ['SEQ,:.] => CDR c
+    [c]
+  [["=>",a,b],:post]
+
+formatWHERE ["where",a,b] ==
+  $insideTypeExpression: local := nil
+  $insideCAPSULE: local := false
+  tryBreak(formatLeft("format",a,"where","Led") and format " where ",b,"where","Led")
+ 
+--======================================================================
+--              Special Handlers:  Categories
+--======================================================================
+formatATTRIBUTE ['ATTRIBUTE,att] == format att
+ 
+formatDeftranCategory ['CATEGORY,kind,:items,item] == ["SEQ",:items,["exit",1,item]]
+
+formatCategory ['Category] == format " " and format "Category"
+  
+formatCATEGORY cat == 
+  con := opOf $form
+  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
+  $insideEXPORTS : local := true
+  format ["with",formatDeftranCategory cat]
+ 
+formatSIGNATURE ['SIGNATURE,op,types,:r] ==
+  MEMQ('constant,r) => format op and format ": " and (u := format first types) and 
+    formatSC() and formatComments(u,op,types)
+  format op and format ": " and (u := format ['Mapping,:types]) and formatSC() and
+    formatComments(u,op,types) 
+  
+formatDefault ["default",a] ==
+  $insideCategoryIfTrue : local := false
+  $insideCAPSULE: local := true
+  $insideTypeExpression: local := false
+  tryBreak(format "default ",a,"with","Nud")
+--======================================================================
+--              Special Handlers:  Control Structures
+--======================================================================
+formatUNCOERCE ['UNCOERCE,x] == format x
+ 
+formatIF ['IF,a,b,c] == 
+  c = 'noBranch => formatIF2(a,b,"if ")
+  b = 'noBranch => formatIF ['IF,['not,a],c,'noBranch]
+  formatIF2(a,b,"if ") and newLine() and formatIF3 c
+
+formatIF2(a,b,prefix) ==  
+  tryBreakNB(format prefix and format a and format " then ",b,"then","Nud")
+
+formatIF3 x == 
+  x is ['IF,a,b,c] => 
+    c = 'noBranch => tryBreak(format "else if " 
+      and format a and format " then ",b,"then","Nud")
+    formatIF2(a,b,"else if ") and newLine() and formatIF3 c
+  tryBreak(format "else ",x,"else","Nud")
+    
+formatBlock(l,x) ==
+  null l => format x
+  $pilesAreOkHere: local
+  format "{ " and format first l and
+    (and/[formatSC() and format y for y in rest l]) 
+      and formatSC() and format x and format " }"
+ 
+formatExit ["exit",.,u] == format u
+
+formatvoid ["void"] == format "()"
+
+formatLeave ["leave",.,u] == format "break"
+ 
+formatCOLLECT u == formatSpill("formatCOLLECT1",u)
+ 
+formatCOLLECT1 ["COLLECT",:iteratorList,body] ==
+  $pilesAreOkHere: local
+  format "[" and format body and format " " and
+    formatSpill("formatIteratorTail",iteratorList)
+ 
+formatIteratorTail iteratorList ==
+  formatIterator first iteratorList and
+    (and/[format " " and formatIterator x for x in rest iteratorList]) and format "]"
+
+--======================================================================
+--                  Special Handlers:  Keywords
+--======================================================================
+ 
+formatColon [":",a,b] ==
+  b is ['with,c,:d] => formatColonWith(a,c,d)
+  if not $insideTypeExpression then 
+    insideCat() => nil
+    format
+      $insideDEF => "local "
+      "default "
+  op := 
+    $insideCAPSULE and not $insideDEF => ": "
+    insideCat() => ": "
+    ":"
+  b := (atom b => b; markMacroTran b)
+  a is ['LISTOF,:c] => formatComma c and format ": " and formatLocal1 b
+  formatInfix(op,[a, b],formatOpBindingPower(":","Led","left"),
+                              formatOpBindingPower(":","Led","right"))
+
+formatColonWith(form,a,b) ==
+  con := opOf $form
+  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
+  $insideEXPORTS : local := true
+  $pilesAreOkHere: local := true
+  $insideTypeExpression : local := false
+  b => tryBreak(formatDefForm form and format ": " 
+        and format a and format " with ",first b,"with","Led")
+  tryBreak(formatDefForm form and format ": with ",a,"with","Nud")
+
+formatCOND ["COND",:l] ==
+  originalC:= $c
+  and/[x is [a,[.,.,b]] for x in l] =>
+    (originalC=$m or indent() and newLine()) and first l is [a,[.,.,b]] and
+      formatIfExit(a,b) and
+        (and/[newLine() and formatIfExit(a,b) for [a,[.,.,b]] in rest l]) and (originalC=$m or undent()) and originalC
+  formatIfThenElse l
+
+formatPROGN ["PROGN",:l] ==
+  l is [:u,x] => formatPiles(u,x)
+  error '"formatPROGN"
+  
+formatELT ["ELT",a,b] == formatApplication [a,b]
+ 
+formatCONS ["CONS",a,b] ==
+  $pilesAreOkHere: local
+  format "[" and formatConstructItem a and formatTail b
+ 
+formatTail x ==
+  null x => format "]"
+  format "," and formatTail1 x 
+ 
+formatTail1 x ==
+  x is ["CONS",a,b] => formatConstructItem a and formatTail b
+  x is ["APPEND",a,b] =>
+    null b => formatConstructItem a and format "]"
+    format ":" and formatConstructItem a and formatTail b
+  format ":" and formatConstructItem x and format "]"
+ 
+-- x = "." => format ""
+formatConstructItem x == format x
+ 
+formatLET ["LET",a,b] == 
+  $insideTypeExpression: local := true
+  a = "Rep" or atom a and constructor? opOf b =>
+    tryBreakNB(formatAtom a and format " == ",b,":=","Led")
+  tryBreakNB((IDENTP a => formatAtom a; format a) and format " := ",b,":=","Led")
+ 
+formatIfExit(a,b) ==
+                       --called from SCOND or COND only
+  $numberOfSpills: local:= 0
+  curMargin:= $m
+  curMarginStack:= $currentMarginStack
+  $doNotResetMarginIfTrue:= true
+  format a and format " => " and formatRight("formatCut",b,"=>","Led") =>
+    ($currentMarginStack:= curMarginStack; $m:= curMargin)
+ 
+formatIfThenElse x == formatSpill("formatIf1",x)
+ 
+formatIf1 x ==
+  x is [[a,:r],:c] and null c =>
+    b:=
+      r is [:l,s] and l => ['SEQ,:l,['exit,.,s]]
+      first r
+    isTrue a => format b
+    format "if " and format a and format " then " and format b
+  format "if " and format a and
+    (try
+      (format " then " and format b and format " else "
+        and formatIfThenElse c) or spillLine()
+          and format " then " and format b and
+--           ($c:= $m:= $m+6) and
+            ($numberOfSpills:= $numberOfSpills-1)
+              and spillLine() and format " else " and formatIfThenElse c)
+ 
+formatQUOTE ["QUOTE",x] == format "('" and format x and format ")"
+
+formatMI ["MI",a,b] == format a
+
+formatMapping ['Mapping,target,:sources] ==
+  $noColonDeclaration: local := true
+  formatTuple ['Tuple,:sources] and format " -> " and format target
+ 
+formatTuple ['Tuple,:types] ==
+  null types => format "()"
+  null rest types => format first types
+  formatFunctionCallTail types
+ 
+formatConstruct(['construct,:u]) == 
+  format "[" and (null u or format first u and
+    "and"/[format "," and formatCut x for x in rest u]) and format "]"
+ 
+formatNextConstructItem x ==
+  try format x or ($m := $m + 2) and newLine() and format x
+ 
+formatREPEAT ["REPEAT",:iteratorList,body] ==
+  tryBreakNB(null iteratorList or (formatIterator first iteratorList and
+    (and/[format " " and formatIterator x for x in rest iteratorList]) and format " ")
+      and format "repeat ",body,"repeat","Led")
+ 
+formatFATARROW ["=>",a,b] == tryBreak(format a and format " => ",b,"=>","Led")
+
+formatMap ["+->",a,b] == 
+  $noColonDeclaration: local := true
+  tryBreak(format a and format " +-> ", b, "+->","Led") 
+
+formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u)
+
+formatreduce ["reduce",op,u] == formatReduce1(op,u)
+
+formatReduce1(op,u) ==
+  if STRINGP op then op := INTERN op
+  id := LASSOC(op,
+    '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One)))
+  formatFunctionCall
+    id => ['reduce,op,u,id]
+    ['reduce,op,u]
+
+formatIterator u ==
+  $noColonDeclaration : local := true
+  u is ["IN",x,y] =>
+    format "for " and formatLeft("format",x,"in","Led") and format " in " and
+      formatRight("format",y,"in","Led")
+  u is ["WHILE",x] => format "while " and formatRight("format",x,"while","Nud")
+  u is ["UNTIL",x] => format "until " and formatRight("format",x,"until","Nud")
+  u is ["|",x] => format "| " and formatRight("format",x,"|","Led")
+  u is ["STEP",i,init,step,:v] =>
+    final := IFCAR v
+    format "for " and formatLeft("format",i,"in","Led") and format " in " and
+      (seg := ['SEGMENT,init,final]) and (formatStepOne? step => format seg; formatBy ['by,seg,step])
+  error "formatIterator"
+
+formatStepOne? step ==
+  step = 1 or step = '(One) => true
+  step is [op,n,.] and MEMQ(op,'(_:_:  _@)) => n = 1 or n = '(One)
+  false
+ 
+formatBy ['by,seg,step] == format seg and format " by " and format step
+ 
+formatSCOND ["SCOND",:l] ==
+  $pilesAreOkHere =>
+                            --called from formatPileLine or formatBlock
+                     --if from formatPileLine
+    initialC:= $c
+    and/[x is [a,["exit",.,b]] for x in l] =>
+      first l is [a,["exit",.,b]] and formatIfExit(a,b) and
+        (and/[newLine() and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and initialC
+    formatIfThenElse l and initialC
+  and/[x is [a,["exit",.,b]] for x in l] =>
+    first l is [a,["exit",.,b]] and formatIfExit(a,b) and
+      (and/[format "; " and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and $c
+   --warning: and/(...) returns T if there are no entries
+  formatIfThenElse l
+ 
+formatSEGMENT ["SEGMENT",a,b] ==
+  $pilesAreOkHere: local
+  (if pspadBindingPowerOf("right",a)<750 then formatPren a else format a) and
+    formatInfixOp ".." and
+      (null b and $c or
+        (if 750>pspadBindingPowerOf("left",b) then formatPren b else format b))
+ 
+formatSexpr x ==
+  atom x =>
+    null x or IDENTP x => consBuffer ident2PrintImage PNAME x
+    consBuffer x
+  spill("formatNonAtom",x)
+ 
+formatNonAtom x ==
+  format "_(" and formatSexpr first x and
+    (and/[format " " and formatSexpr y for y in rest x])
+      and (y:= LASTATOM x => format " . "
+        and formatSexpr y; true) and format "_)"
+ 
+formatCAPSULE ['CAPSULE,:l,x] == 
+  $insideCAPSULE: local := true
+  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+
+formatPAREN [.,:argl] == formatFunctionCallTail argl
+ 
+formatSEQ ["SEQ",:l,[.,.,x]] == 
+  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+ 
+--======================================================================
+--              Comment Handlers
+--======================================================================
+formatCOMMENT ["COMMENT",x,marg,startXY,endXY,commentStack] ==
+  $commentsToPrint:= [[marg,startXY,endXY,commentStack],:$commentsToPrint]
+  format x
+ 
+formatComments(u,op,types) ==
+  $numberOfSpills :local := $commentIndentation/2 - 1
+  not $insideEXPORTS => u
+  alist := LASSOC(op,$comments) or
+    sayBrightly ['"No documentation for ",op]
+    return u
+  ftypes := SUBLISLIS($FormalMapVariableList,rest $form,types)
+  consComments(LASSOC(ftypes,alist),'"++ ")
+  u   
+ 
+consComments(s,plusPlus) ==
+  s is [word,:r] and null atom r => consComments(r, plusPlus)
+  s := first s
+  null s => nil
+  s := consCommentsTran s
+  indent() and newLine() or return nil
+  columnsLeft := $lineLength - $m - 2
+  while (m := MAXINDEX s) >= columnsLeft repeat
+    k := or/[i for i in (columnsLeft - 1)..1 by -1 | s.i = $charBlank] 
+    k := (k => k + 1; columnsLeft)
+    piece := SUBSTRING(s,0,k)
+    formatDoCommentLine [plusPlus,piece]
+    s := SUBSTRING(s,k,nil)
+  formatDoCommentLine [plusPlus,s]
+  undent()
+  $m
+
+consCommentsTran s ==
+  m := MAXINDEX s 
+  k := or/[i for i in 0..(m - 7) | substring?('"\spad{",s,i)] =>
+    r := charPosition(char '_},s,k + 6)
+    r = m + 1 => s
+    STRCONC(SUBSTRING(s,0,k),'"`",SUBSTRING(s,k+6,r-k-6),'"'",consCommentsTran SUBSTRING(s,r+1,nil))
+  s
+  
+formatDoCommentLine line ==
+  $lineBuffer := consLineBuffer [nBlanks $c,:line]
+  $c := $m+2*$numberOfSpills
+
+--======================================================================
+--                  Pile Handlers
+--======================================================================
+formatPreferPile y ==
+  y is ["SEQ",:l,[.,.,x]] => 
+    (u:= formatPiles(l,x)) => u 
+    formatSpill("format",y) 
+  formatSpill("format",y)
+ 
+formatPiles(l,x) ==
+  $insideTypeExpression : local := false
+  not $pilesAreOkHere => nil                  
+  originalC:= $c
+  lines:= [:l,x]
+                                                --piles must begin at margin
+  originalC=$m or indent() and newLine() or return nil
+  null (formatPileLine($m,first lines,false)) => nil
+  not (and/[formatPileLine($m,y,true) for y in rest lines]) => nil
+  (originalC=$m or undent()) and originalC          --==> brace
+ 
+formatPileLine($m,x,newLineIfTrue) ==
+  if newLineIfTrue then newLine() or return nil
+  $numberOfSpills: local:= 0
+  $newLineWritten := nil
+  format x and (x is ['SIGNATURE,:.] or $rightBraceFlag => $c; formatSC())
+    and (x is ['DEF,:.] and optNewLine() or $c)
+
+--======================================================================
+--                       Utility Functions
+--======================================================================
+nBlanks m == "STRCONC"/[char('_  ) for i in 1..m]
+ 
+isNewspadOperator op == GET(op,"Led") or GET(op,"Nud")
+ 
+isTrue x == x="true" or x is '(QUOTE T)
+ 
+nary2Binary(u,op) ==
+  u is [a,b,:t] => (t => nary2Binary([[op,a,b],:t],op); [op,a,b])
+  errhuh()
+ 
+string2PrintImage s ==
+  u:= GETSTR (2*SIZE s)
+  for i in 0..MAXINDEX s repeat
+    (if MEMQ(s.i,'(_( _{ _) _} _! _")) then
+      SUFFIX('__,u); u:= SUFFIX(s.i,u))
+  u
+ 
+ident2PrintImage s ==
+  m := MAXINDEX s
+  if m > 1 and s.(m - 1) = $underScore then s := STRCONC(SUBSTRING(s,0,m-1),s.m)
+  u:= GETSTR (2*SIZE s)
+  if not (ALPHA_-CHAR_-P s.(0) or s.(0)=char '"$") then SUFFIX('__,u)
+  u:= SUFFIX(s.(0),u)
+  for i in 1..MAXINDEX s repeat
+    if not (DIGITP s.i or ALPHA_-CHAR_-P s.i or ((c := s.i) = char '?) 
+      or (c = char '_!)) then SUFFIX('__,u)
+    u:= SUFFIX(s.i,u)
+  INTERN u
+ 
+isIdentifier x ==
+  IDENTP x =>
+    s:= PNAME x
+    #s = 0 => nil
+    ALPHA_-CHAR_-P s.(0) => and/[s.i^=char '" " for i in 1..MAXINDEX s]
+    #s>1 =>
+      or/[ALPHA_-CHAR_-P s.i for i in 1..(m:= MAXINDEX s)] =>
+        and/[s.i^=char '" " for i in 1..m] => true
+ 
+isGensym x == 
+  s := STRINGIMAGE x
+  n := MAXINDEX s
+  s.0 = char '_G and and/[DIGITP s.i for i in 1..n]
+ 
+--======================================================================
+--                       Macro Helpers
+--======================================================================
+tryToFit(s,x) ==
+--% try to format on current line; see macro try in file PSPADAUX LISP
+  --returns nil if unable to format stuff in x on a single line
+  x => ($back:= rest $back; $c)
+  restoreState()
+  nil
+ 
+restoreState(:options) ==
+  back := IFCAR options or $back
+  [
+    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
+      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :back]
+        := back
+  if null options then $back := back
+  [$newLineWritten, $autoLine, $rightBraceFlag,
+      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
+       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
+         $doNotResetMarginIfTrue,$noColonDeclaration]
+           := flags
+  nil
+ 
+saveState(:options) ==
+  flags := 
+    [$newLineWritten, $autoLine, $rightBraceFlag,
+      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
+       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
+         $doNotResetMarginIfTrue,$noColonDeclaration]
+  newState := 
+   [
+    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
+      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :$back]
+  if not KAR options then $back := newState
+  newState
+ 
+formatSC() ==
+  $pileStyle or $semicolonFlag => $c
+  format "; "
+
+wrapBraces(x,y,z) == y
+
+formatLB() ==
+  $pileStyle => $c
+  $numberOfSpills := 
+    $c > $lineLength / 2 => $braceIndentation/3 - 1 
+    $braceIndentation/2 - 1
+  format "{"
+
+restoreC() == --used by macro "embrace"
+  originalC := CAR $braceStack
+  $braceStack := CDR $braceStack
+  formatRB originalC
+ 
+saveC() ==  --used by macro "embrace"
+  $braceStack := [$c,:$braceStack]
+
+saveD() ==  --used by macro "embrace"
+  $braceStack := [$c,:$braceStack]
+
+restoreD() == --used by macro "indentNB"
+  originalC := CAR $braceStack
+  $braceStack := CDR $braceStack
+  originalC
+ 
+formatRB(originalC) == --called only by restoreC
+  while $marginStack and $m > originalC repeat undent()
+  if $m < originalC then $marginStack := [originalC,:$marginStack]
+  $m := originalC
+  $pileStyle => $m
+  newLine() and format "}" and $m    --==> brace
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ptrees.boot.pamphlet b/src/interp/ptrees.boot.pamphlet
new file mode 100644
index 00000000..43471476
--- /dev/null
+++ b/src/interp/ptrees.boot.pamphlet
@@ -0,0 +1,788 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp ptrees.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+Abstract Syntax Trees
+
+This file provides functions to create and examine abstract
+syntax trees.  These are called pform, for short.
+The definition of valid pforms see ABSTRACT BOOT.
+
+!! This file also contains constructors for concrete syntax, although
+!! they should be somewhere else.
+
+THE PFORM DATA STRUCTURE
+ Leaves: [hd, tok, pos]
+ Trees:  [hd, tree, tree, ...]
+ hd is either an id or (id . alist)
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--constructer and selectors for leaf tokens
+
+tokConstruct(hd,tok,:pos)==
+         a:=cons(hd,tok)
+         IFCAR pos =>
+             pfNoPosition? CAR pos=> a
+             ncPutQ(a,"posn",CAR pos)
+             a
+         a
+
+tokType x== ncTag x
+tokPart x== CDR x
+tokPosn x==
+     a:= QASSQ("posn",ncAlist x)
+     if a then CDR a else pfNoPosition()
+
+pfAbSynOp form ==
+    hd := CAR form
+    IFCAR hd or hd
+
+pfAbSynOp?(form, op) ==
+    hd := CAR form
+    EQ(hd, op) or EQCAR(hd, op)
+
+pfLeaf? form ==
+  MEMQ(pfAbSynOp form,
+       '(id idsy symbol string char float expression integer
+          Document error))
+
+pfLeaf(x,y,:z)      == tokConstruct(x,y, IFCAR z or pfNoPosition())
+pfLeafToken form    == tokPart form
+pfLeafPosition form == tokPosn form
+
+pfTree(x,y)         == CONS(x,y)       -- was ==>
+pfParts  form       == CDR form       -- was ==>
+pfFirst  form       == CADR form       -- was ==>
+pfSecond form       == CADDR form       -- was ==>
+
+--% SPECIAL NODES
+pfListOf x          == pfTree('listOf,x)
+pfListOf? x         == pfAbSynOp?(x,'listOf)
+pfAppend list       == APPLY(function APPEND,list)
+
+pfNothing ()        == pfTree('nothing, [])
+pfNothing? form     == pfAbSynOp?(form, 'nothing)
+
+-- SemiColon
+
+pfSemiColon(pfbody) == pfTree('SemiColon, [pfbody])
+pfSemiColon?(pf)    == pfAbSynOp? (pf, 'SemiColon)
+pfSemiColonBody pf   == CADR pf       -- was ==>
+
+--% LEAVES
+pfId(expr)               == pfLeaf('id, expr)
+pfIdPos(expr,pos)        == pfLeaf('id,expr,pos)
+pfId? form               ==
+        pfAbSynOp?(form,'id) or pfAbSynOp?(form,'idsy)
+pfSymbolVariable? form   == pfAbSynOp?(form,'idsy)
+pfIdSymbol form          == tokPart form
+--pfAmpersand(amptok,name) == name
+
+pfDocument strings       == pfLeaf('Document, strings)
+pfDocument? form         == pfAbSynOp?(form, 'Document)
+pfDocumentText form      == tokPart form
+
+pfLiteral? form ==
+      MEMQ(pfAbSynOp form,'(integer symbol expression
+                    one zero char string float))
+
+pfLiteralClass form      == pfAbSynOp form
+pfLiteralString form     == tokPart form
+
+pfStringConstString form     == tokPart form
+
+pfExpression(expr, :optpos) ==
+               pfLeaf("expression", expr, IFCAR optpos)
+pfExpression? form          == pfAbSynOp?(form, 'expression)
+
+pfSymbol(expr, :optpos) ==
+               pfLeaf("symbol", expr, IFCAR optpos)
+
+pfSymb(expr, :optpos) ==
+         if pfLeaf? expr
+         then pfSymbol(tokPart expr,IFCAR optpos)
+         else pfExpression(pfSexpr expr,IFCAR optpos)
+
+pfSymbol? form          == pfAbSynOp?(form, 'symbol)
+
+pfSymbolSymbol form     == tokPart form
+
+--% TREES
+-- parser interface functions
+-- these are potential sources of trouble in macro expansion
+
+-- the comment is attached to all signatutres
+pfWDec(doc,name)   == [pfWDeclare(i,doc) for i in pfParts name]
+
+pfTweakIf form==
+    a:=pfIfElse form
+    b:=if pfNothing? a then pfListOf [] else a
+    pfTree('WIf,[pfIfCond form,pfIfThen form,b])
+
+pfInfApplication(op,left,right)==
+   pfCheckInfop left =>
+       pfWrong(pfDocument ['"infop as argument to infop"],pfListOf [])
+   pfCheckInfop right =>
+       pfWrong(pfDocument ['"infop as argument to infop"],pfListOf [])
+   EQ(pfIdSymbol op,"and")=> pfAnd (left,right)
+   EQ(pfIdSymbol op, "or")=> pfOr (left,right)
+   pfApplication(op,pfTuple pfListOf [left,right])
+
+pfCheckInfop form== false
+
+pfAnd(pfleft, pfright) == pfTree('And, [pfleft, pfright])
+pfAnd?(pf) == pfAbSynOp? (pf, 'And)
+pfAndLeft pf == CADR pf       -- was ==>
+pfAndRight pf == CADDR pf       -- was ==>
+
+pfOr(pfleft, pfright) == pfTree('Or, [pfleft, pfright])
+pfOr?(pf) == pfAbSynOp? (pf, 'Or)
+pfOrLeft pf == CADR pf       -- was ==>
+pfOrRight pf == CADDR pf       -- was ==>
+
+pfNot(arg) == pfTree('Not, [arg])
+pfNot?(pf) == pfAbSynOp? (pf, 'Not)
+pfNotArg pf == CADR pf       -- was ==>
+
+pfEnSequence a==
+           if null a
+           then  pfTuple pfListOf a
+           else if null cdr a
+                then  car a
+                else  pfSequence pfListOf a
+pfFromDom(dom,expr)==
+    if pfApplication? expr
+    then pfApplication(pfFromdom(pfApplicationOp expr,dom),
+                       pfApplicationArg expr)
+    else pfFromdom(expr,dom)
+
+pfReturnTyped(type,body)==pfTree('returntyped,[type,body])
+
+pfLam(variable,body)==-- called from parser
+    rets:= if pfAbSynOp?(body,'returntyped)
+           then pfFirst body
+           else pfNothing ()
+    bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body
+    pfLambda(variable,rets,bdy)
+
+pfTLam(variable,body)==-- called from parser
+    rets:= if pfAbSynOp?(body,'returntyped)
+           then pfFirst body
+           else pfNothing ()
+    bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body
+    pfTLambda(variable,rets,bdy)
+
+pfIfThenOnly(pred,first)==pfIf(pred,first,pfNothing())
+
+pfLp(iterators,body)==
+       pfLoop pfListOf [:iterators,pfDo body]
+pfLoop1 body == pfLoop pfListOf [pfDo body]
+
+
+pfExitNoCond value== pfExit(pfNothing(),value)
+
+pfReturnNoName(value)==pfReturn(value,pfNothing())
+
+pfBrace(a,part)==pfApplication(pfIdPos( "{}",tokPosn a),part)
+
+pfBracket(a,part) ==  pfApplication(pfIdPos( "[]",tokPosn a),part)
+pfBraceBar(a,part)==pfApplication(pfIdPos( "{||}",tokPosn a),part)
+
+pfBracketBar(a,part) ==  pfApplication(pfIdPos( "[||]",tokPosn a),part)
+pfHide(a,part) ==   pfTree("Hide",[part])
+pfHide? x== pfAbSynOp?(x,"Hide")
+pfHidePart x== CADR x
+pfParen(a,part)==part
+
+pfPile(part)==part
+
+pfSpread(l,t)==  [pfTyped(i,t) for i in l]
+
+pfTupleList form== pfParts pfTupleParts form
+
+--The rest have been generated from ABCUT INPUT
+-- 1/31/89
+
+
+--              Add         / Application  / Assign /
+--              Coerceto    / Collect      / ComDefinition  / DeclPart /
+--              Exit        / Export       / Free /
+--              Fromdom     / Id           / If            / Inline /
+--              Iterate     / Lambda /
+--              Break       / Literal      / Local         / Loop   /
+--              MLambda     / Pretend      / Restrict    / Return /
+--              Sequence    / Tagged       / Tuple         / Typing /
+--              Where       / With
+
+pfExpr? pf ==
+     pfAdd? pf or _
+     pfApplication? pf or _
+     pfAssign? pf or _
+     pfCoerceto? pf or _
+     pfCollect? pf or _
+     pfComDefinition? pf or _
+     pfDeclPart? pf or _
+     pfExit? pf or _
+     pfExport? pf or _
+     pfFree? pf or _
+     pfFromdom? pf or _
+     pfId? pf or _
+     pfIf? pf or _
+     pfInline? pf or _
+     pfIterate? pf or _
+     pfLambda? pf or _
+     pfBreak? pf or _
+     pfLiteral? pf or _
+     pfLocal? pf or _
+     pfLoop? pf or _
+     pfMLambda? pf or _
+     pfPretend? pf or _
+     pfRestrict? pf or _
+     pfReturn? pf or _
+     pfTagged? pf or _
+     pfTuple? pf or _
+     pfWhere? pf or _
+     pfWith? pf
+
+
+pfDeclPart? pf ==
+     pfTyping? pf or _
+     pfImport? pf or _
+     pfDefinition? pf or _
+     pfSequence? pf or _
+     pfDWhere? pf or _
+     pfMacro? pf
+
+
+-- Wrong       := (Why: Document, Rubble: [Expr])
+
+pfWrong(pfwhy, pfrubble) == pfTree('Wrong, [pfwhy, pfrubble])
+pfWrong?(pf) == pfAbSynOp? (pf, 'Wrong)
+pfWrongWhy pf == CADR pf       -- was ==>
+pfWrongRubble pf == CADDR pf       -- was ==>
+pf0WrongRubble pf == pfParts pfWrongRubble pf
+
+
+-- Add         := (Base: [Typed],  Addin: Expr)
+
+pfAdd(pfbase, pfaddin,:addon) ==
+    lhs := if addon
+           then first addon
+           else pfNothing()
+    pfTree('Add, [pfbase, pfaddin,lhs])
+
+pfAdd?(pf) == pfAbSynOp? (pf, 'Add)
+pfAddBase pf == CADR pf       -- was ==>
+pfAddAddin pf == CADDR pf       -- was ==>
+pfAddAddon pf == CADDDR pf       -- was ==>
+pf0AddBase pf == pfParts pfAddBase pf
+
+
+
+-- DWhere      := (Context: [DeclPart], Expr: [DeclPart])
+
+pfDWhere(pfcontext, pfexpr) == pfTree('DWhere, [pfcontext, pfexpr])
+pfDWhere?(pf) == pfAbSynOp? (pf, 'DWhere)
+pfDWhereContext pf == CADR pf       -- was ==>
+pfDWhereExpr pf == CADDR pf       -- was ==>
+
+
+
+-- With        := (Base: [Typed],  Within: [WithPart])
+
+pfWith(pfbase, pfwithin,pfwithon) ==
+         pfTree('With, [pfbase, pfwithin,pfwithon])
+pfWith?(pf) == pfAbSynOp? (pf, 'With)
+pfWithBase pf == CADR pf       -- was ==>
+pfWithWithin pf == CADDR pf       -- was ==>
+pfWithWithon pf == CADDDR pf       -- was ==>
+pf0WithBase pf == pfParts pfWithBase pf
+pf0WithWithin pf == pfParts pfWithWithin pf
+
+
+-- WIf         := (Cond: Primary, Then: [WithPart], Else: [WithPart])
+
+pfWIf(pfcond, pfthen, pfelse) == pfTree('WIf, [pfcond, pfthen, pfelse])
+pfWIf?(pf) == pfAbSynOp? (pf, 'WIf)
+pfWIfCond pf == CADR pf       -- was ==>
+pfWIfThen pf == CADDR pf       -- was ==>
+pfWIfElse pf == CADDDR pf       -- was ==>
+
+-- WDeclare    := (Signature: Typed, Doc: ? Document)
+
+pfWDeclare(pfsignature, pfdoc) == pfTree('WDeclare, [pfsignature, _
+pfdoc])
+pfWDeclare?(pf) == pfAbSynOp? (pf, 'WDeclare)
+pfWDeclareSignature pf == CADR pf       -- was ==>
+pfWDeclareDoc pf == CADDR pf       -- was ==>
+
+
+-- Attribute   := (Expr: Primary)
+
+pfAttribute(pfexpr) == pfTree('Attribute, [pfexpr])
+pfAttribute?(pf) == pfAbSynOp? (pf, 'Attribute)
+pfAttributeExpr pf == CADR pf       -- was ==>
+
+
+-- Typed       := (Id: Id,    Type: ? Type)
+
+pfTyped(pfid, pftype) == pfTree('Typed, [pfid, pftype])
+pfTyped?(pf) == pfAbSynOp? (pf, 'Typed)
+pfTypedId pf == CADR pf       -- was ==>
+pfTypedType pf == CADDR pf       -- was ==>
+
+
+-- Application := (Op:   Expr, Arg:    Expr)
+
+pfApplication(pfop, pfarg) ==
+        pfTree('Application, [pfop, pfarg])
+
+pfApplication?(pf) == pfAbSynOp? (pf, 'Application)
+pfApplicationOp pf == CADR pf       -- was ==>
+pfApplicationArg pf == CADDR pf       -- was ==>
+
+
+-- Tuple       := (Parts: [Expr])
+
+pfTupleListOf(pfparts) == pfTuple pfListOf pfparts
+pfTuple(pfparts) == pfTree('Tuple, [pfparts])
+pfTuple?(pf) == pfAbSynOp? (pf, 'Tuple)
+pfTupleParts pf == CADR pf       -- was ==>
+pf0TupleParts pf == pfParts pfTupleParts pf
+
+
+-- Tagged      := (Tag:  Expr, Expr:   Expr)
+
+pfTagged(pftag, pfexpr) == pfTree('Tagged, [pftag, pfexpr])
+pfTagged?(pf) == pfAbSynOp? (pf, 'Tagged)
+pfTaggedTag pf == CADR pf       -- was ==>
+pfTaggedExpr pf == CADDR pf       -- was ==>
+
+
+-- Pretend     := (Expr: Expr, Type:   Type)
+
+pfPretend(pfexpr, pftype) == pfTree('Pretend, [pfexpr, pftype])
+pfPretend?(pf) == pfAbSynOp? (pf, 'Pretend)
+pfPretendExpr pf == CADR pf       -- was ==>
+pfPretendType pf == CADDR pf       -- was ==>
+
+
+-- Restrict    := (Expr: Expr, Type:   Type)
+
+pfRestrict(pfexpr, pftype) == pfTree('Restrict, [pfexpr, pftype])
+pfRestrict?(pf) == pfAbSynOp? (pf, 'Restrict)
+pfRestrictExpr pf == CADR pf       -- was ==>
+pfRestrictType pf == CADDR pf       -- was ==>
+
+pfRetractTo(pfexpr, pftype) == pfTree('RetractTo, [pfexpr, pftype])
+pfRetractTo?(pf) == pfAbSynOp? (pf, 'RetractTo)
+pfRetractToExpr pf == CADR pf       -- was ==>
+pfRetractToType pf == CADDR pf       -- was ==>
+
+
+-- Coerceto    := (Expr: Expr, Type:   Type)
+
+pfCoerceto(pfexpr, pftype) == pfTree('Coerceto, [pfexpr, pftype])
+pfCoerceto?(pf) == pfAbSynOp? (pf, 'Coerceto)
+pfCoercetoExpr pf == CADR pf       -- was ==>
+pfCoercetoType pf == CADDR pf       -- was ==>
+
+
+-- Fromdom     := (What: Id,   Domain: Type)
+
+pfFromdom(pfwhat, pfdomain) == pfTree('Fromdom, [pfwhat, pfdomain])
+pfFromdom?(pf) == pfAbSynOp? (pf, 'Fromdom)
+pfFromdomWhat pf == CADR pf       -- was ==>
+pfFromdomDomain pf == CADDR pf       -- was ==>
+
+
+-- Lambda     := (Args: [Typed], Rets: ? Type, Body: Expr)
+
+pfLambda(pfargs, pfrets, pfbody) == pfTree('Lambda, [pfargs, pfrets, _
+pfbody])
+pfLambda?(pf) == pfAbSynOp? (pf, 'Lambda)
+pfLambdaArgs pf == CADR pf       -- was ==>
+pfLambdaRets pf == CADDR pf       -- was ==>
+pfLambdaBody pf == CADDDR pf       -- was ==>
+pf0LambdaArgs pf == pfParts pfLambdaArgs pf
+pfFix pf== pfApplication(pfId "Y",pf)
+
+
+-- TLambda      := (Args: [Typed], Rets: ? Type, Body: Expr)
+
+pfTLambda(pfargs, pfrets, pfbody) == pfTree('TLambda, [pfargs, pfrets, pfbody])
+pfTLambda?(pf) == pfAbSynOp? (pf, 'TLambda)
+pfTLambdaArgs pf == CADR pf       -- was ==>
+pfTLambdaRets pf == CADDR pf       -- was ==>
+pfTLambdaBody pf == CADDDR pf       -- was ==>
+pf0TLambdaArgs pf == pfParts pfTLambdaArgs pf
+
+
+-- MLambda     := (Args: [Id], Body: Expr)
+
+pfMLambda(pfargs, pfbody) == pfTree('MLambda, [pfargs, pfbody])
+pfMLambda?(pf) == pfAbSynOp? (pf, 'MLambda)
+pfMLambdaArgs pf == CADR pf       -- was ==>
+pfMLambdaBody pf == CADDR pf       -- was ==>
+pf0MLambdaArgs pf == pfParts pfMLambdaArgs pf
+
+
+-- Where       := (Context: [DeclPart], Expr: Expr)
+
+pfWhere(pfcontext, pfexpr) == pfTree('Where, [pfcontext, pfexpr])
+pfWhere?(pf) == pfAbSynOp? (pf, 'Where)
+pfWhereContext pf == CADR pf       -- was ==>
+pfWhereExpr pf == CADDR pf       -- was ==>
+pf0WhereContext pf == pfParts pfWhereContext pf
+
+
+-- If          := (Cond: Expr, Then: Expr, Else: ? Expr)
+
+pfIf(pfcond, pfthen, pfelse) == pfTree('If, [pfcond, pfthen, pfelse])
+pfIf?(pf) == pfAbSynOp? (pf, 'If)
+pfIfCond pf == CADR pf       -- was ==>
+pfIfThen pf == CADDR pf       -- was ==>
+pfIfElse pf == CADDDR pf       -- was ==>
+
+
+-- Sequence    := (Args: [Expr])
+
+pfSequence(pfargs) == pfTree('Sequence, [pfargs])
+pfSequence?(pf) == pfAbSynOp? (pf, 'Sequence)
+pfSequenceArgs pf == CADR pf       -- was ==>
+pf0SequenceArgs pf == pfParts pfSequenceArgs pf
+
+
+-- Novalue     := (Expr: Expr)
+
+pfNovalue(pfexpr) == pfTree('Novalue, [pfexpr])
+pfNovalue?(pf) == pfAbSynOp? (pf, 'Novalue)
+pfNovalueExpr pf == CADR pf       -- was ==>
+
+
+-- Loop        := (Iterators: [Iterator])
+
+pfLoop(pfiterators) == pfTree('Loop, [pfiterators])
+pfLoop?(pf) == pfAbSynOp? (pf, 'Loop)
+pfLoopIterators pf == CADR pf       -- was ==>
+pf0LoopIterators pf == pfParts pfLoopIterators pf
+
+
+-- Collect     := (Body: Expr, Iterators: [Iterator])
+
+pfCollect(pfbody, pfiterators) == pfTree('Collect, [pfbody, _
+pfiterators])
+pfCollect?(pf) == pfAbSynOp? (pf, 'Collect)
+pfCollectBody pf == CADR pf       -- was ==>
+pfCollectIterators pf == CADDR pf       -- was ==>
+pf0CollectIterators pf == pfParts pfCollectIterators pf
+
+
+-- Forin       := (Lhs: [AssLhs], Whole: Expr)
+
+pfForin(pflhs, pfwhole) == pfTree('Forin, [pflhs, pfwhole])
+pfForin?(pf) == pfAbSynOp? (pf, 'Forin)
+pfForinLhs pf == CADR pf       -- was ==>
+pfForinWhole pf == CADDR pf       -- was ==>
+pf0ForinLhs pf == pfParts pfForinLhs pf
+
+
+-- While       := (Cond: Expr)
+
+pfWhile(pfcond) == pfTree('While, [pfcond])
+pfWhile?(pf) == pfAbSynOp? (pf, 'While)
+pfWhileCond pf == CADR pf       -- was ==>
+
+
+-- Until       := (Cond: Expr)
+
+--pfUntil(pfcond) == pfTree('Until, [pfcond])
+--pfUntil?(pf) == pfAbSynOp? (pf, 'Until)
+--pfUntilCond pf == CADR pf       -- was ==>
+
+
+-- Suchthat    := (Cond: Expr)
+
+pfSuchthat(pfcond) == pfTree('Suchthat, [pfcond])
+pfSuchthat?(pf) == pfAbSynOp? (pf, 'Suchthat)
+pfSuchthatCond pf == CADR pf       -- was ==>
+
+
+-- Do          := (Body: Expr)
+
+pfDo(pfbody) == pfTree('Do, [pfbody])
+pfDo?(pf) == pfAbSynOp? (pf, 'Do)
+pfDoBody pf == CADR pf       -- was ==>
+
+
+-- Iterate     := (From: ? Id)
+
+pfIterate(pffrom) == pfTree('Iterate, [pffrom])
+pfIterate?(pf) == pfAbSynOp? (pf, 'Iterate)
+pfIterateFrom pf == CADR pf       -- was ==>
+
+
+-- Break       := (From: ? Id)
+
+pfBreak(pffrom) == pfTree('Break, [pffrom])
+pfBreak?(pf) == pfAbSynOp? (pf, 'Break)
+pfBreakFrom pf == CADR pf       -- was ==>
+
+
+-- Return      := (Expr: ? Expr, From: ? Id)
+
+pfReturn(pfexpr, pffrom) == pfTree('Return, [pfexpr, pffrom])
+pfReturn?(pf) == pfAbSynOp? (pf, 'Return)
+pfReturnExpr pf == CADR pf       -- was ==>
+pfReturnFrom pf == CADDR pf       -- was ==>
+
+
+-- Exit        := (Cond: ? Expr, Expr: ? Expr)
+
+pfExit(pfcond, pfexpr) == pfTree('Exit, [pfcond, pfexpr])
+pfExit?(pf) == pfAbSynOp? (pf, 'Exit)
+pfExitCond pf == CADR pf       -- was ==>
+pfExitExpr pf == CADDR pf       -- was ==>
+
+
+-- Macro       := (Lhs:  Id,     Rhs: ExprorNot)
+
+pfMacro(pflhs, pfrhs) == pfTree('Macro, [pflhs, pfrhs])
+pfMacro?(pf) == pfAbSynOp? (pf, 'Macro)
+pfMacroLhs pf == CADR pf       -- was ==>
+pfMacroRhs pf == CADDR pf       -- was ==>
+
+
+-- Definition  := (LhsItems:  [Typed], Rhs:  Expr)
+
+pfDefinition(pflhsitems, pfrhs) == pfTree('Definition, [pflhsitems, pfrhs])
+pfDefinition?(pf) == pfAbSynOp? (pf, 'Definition)
+pfDefinitionLhsItems pf == CADR pf       -- was ==>
+pfDefinitionRhs pf == CADDR pf       -- was ==>
+pf0DefinitionLhsItems pf == pfParts pfDefinitionLhsItems pf
+
+pfRule(pflhsitems, pfrhs) == pfTree('Rule, [pflhsitems, _
+pfrhs])
+pfRule?(pf) == pfAbSynOp? (pf, 'Rule)
+pfRuleLhsItems pf == CADR pf       -- was ==>
+pfRuleRhs pf == CADDR pf       -- was ==>
+
+-- ComDefinition := (Doc:Document,Def:Definition)
+
+pfComDefinition(pfdoc, pfdef) == pfTree('ComDefinition, [pfdoc, pfdef] )
+pfComDefinition?(pf) == pfAbSynOp? (pf, 'ComDefinition)
+pfComDefinitionDoc pf == CADR pf       -- was ==>
+pfComDefinitionDef pf == CADDR pf       -- was ==>
+
+
+-- DefinitionSequence    := (Args: [DeclPart])
+
+pfDefinitionSequenceArgs pf == CADR pf       -- was ==>
+
+-- Export      := (Def:   Definition)
+
+pfExportDef pf == CADR pf       -- was ==>
+
+-- Assign      := (LhsItems:  [AssLhs], Rhs:  Expr)
+
+pfAssign(pflhsitems, pfrhs) == pfTree('Assign, [pflhsitems, pfrhs])
+pfAssign?(pf) == pfAbSynOp? (pf, 'Assign)
+pfAssignLhsItems pf == CADR pf       -- was ==>
+pfAssignRhs pf == CADDR pf       -- was ==>
+pf0AssignLhsItems pf == pfParts pfAssignLhsItems pf
+
+
+-- Typing      := (Items: [Typed])
+
+pfTyping(pfitems) == pfTree('Typing, [pfitems])
+pfTyping?(pf) == pfAbSynOp? (pf, 'Typing)
+pfTypingItems pf == CADR pf       -- was ==>
+pf0TypingItems pf == pfParts pfTypingItems pf
+
+
+-- Export       := (Items: [Typed])
+
+pfExport(pfitems) == pfTree('Export, [pfitems])
+pfExport?(pf) == pfAbSynOp? (pf, 'Export)
+pfExportItems pf == CADR pf       -- was ==>
+pf0ExportItems pf == pfParts pfExportItems pf
+
+
+-- Local       := (Items: [Typed])
+
+pfLocal(pfitems) == pfTree('Local, [pfitems])
+pfLocal?(pf) == pfAbSynOp? (pf, 'Local)
+pfLocalItems pf == CADR pf       -- was ==>
+pf0LocalItems pf == pfParts pfLocalItems pf
+
+-- Free        := (Items: [Typed])
+
+pfFree(pfitems) == pfTree('Free, [pfitems])
+pfFree?(pf) == pfAbSynOp? (pf, 'Free)
+pfFreeItems pf == CADR pf       -- was ==>
+pf0FreeItems pf == pfParts pfFreeItems pf
+
+
+-- Import      := (Items: [QualType])
+
+pfImport(pfitems) == pfTree('Import, [pfitems])
+pfImport?(pf) == pfAbSynOp? (pf, 'Import)
+pfImportItems pf == CADR pf       -- was ==>
+pf0ImportItems pf == pfParts pfImportItems pf
+
+
+-- Inline      := (Items: [QualType])
+
+pfInline(pfitems) == pfTree('Inline, [pfitems])
+pfInline?(pf) == pfAbSynOp? (pf, 'Inline)
+pfInlineItems pf == CADR pf       -- was ==>
+
+-- QualType    := (Type: Type, Qual: ? Type)
+
+pfQualType(pftype, pfqual) == pfTree('QualType, [pftype, pfqual])
+pfQualType?(pf) == pfAbSynOp? (pf, 'QualType)
+pfQualTypeType pf == CADR pf       -- was ==>
+pfQualTypeQual pf == CADDR pf       -- was ==>
+
+pfSuch(x,y)== pfInfApplication(pfId "|",x,y)
+
+pfTaggedToTyped x==
+  rt:=if pfTagged? x then pfTaggedExpr x else pfNothing()
+  form:= if pfTagged? x then pfTaggedTag x else x
+  not pfId? form =>
+      a:=pfId GENSYM()
+      pfTyped(pfSuch(a,
+           pfInfApplication (pfId "=", a,form)),rt)
+  pfTyped(form,rt)
+
+pfTaggedToTyped1 x==
+    pfCollect1? x => pfCollectVariable1 x
+    pfDefinition? x => pfTyped(x,pfNothing())
+    pfTaggedToTyped x
+
+pfCollectVariable1 x==
+      a := pfApplicationArg x
+      var:=first pf0TupleParts a
+      id:=pfTaggedToTyped var
+      pfTyped(pfSuch(pfTypedId id,CADR pf0TupleParts a),
+              pfTypedType id)
+
+pfPushBody(t,args,body)==
+        if null args
+        then  body
+        else if null rest args
+              then  pfLambda(first args,t,body)
+              else
+                 pfLambda(first args,pfNothing(),
+                     pfPushBody(t,rest args,body))
+
+pfCheckItOut x ==
+  rt:=if pfTagged? x then pfTaggedExpr x else pfNothing()
+  form:= if pfTagged? x then pfTaggedTag x else x
+  pfId? form => [pfListOf [pfTyped(form,rt)],nil,rt]
+  pfCollect1? form =>
+                [pfListOf [pfCollectVariable1 form],nil,rt]
+  pfTuple? form =>
+       [pfListOf [pfTaggedToTyped i for i in pf0TupleParts form],nil,rt]
+  pfDefinition? form =>
+       [pfListOf [pfTyped(form,pfNothing())],nil,rt]
+  pfApplication? form =>
+          ls:=pfFlattenApp form
+          op:= pfTaggedToTyped1 first ls
+          args:=[pfTransformArg i for i in rest ls]
+          [pfListOf [op],args,rt]
+  npTrapForm form
+
+pfCollect1? x==
+        pfApplication? x =>
+              a:=pfApplicationOp x
+              pfId? a => pfIdSymbol a = "|"
+              false
+        false
+
+pfTransformArg  args==
+          argl:= if pfTuple? args then pf0TupleParts args else [args]
+          pfListOf [pfTaggedToTyped1 i for i in argl]
+
+
+pfCheckMacroOut form ==
+  pfId? form => [form,nil]
+  pfApplication? form =>
+          ls:=pfFlattenApp form
+          op:= pfCheckId first ls
+          args:=[pfCheckArg i for i in rest ls]
+          [op,args]
+  npTrapForm form
+
+pfCheckArg args==
+          argl:= if pfTuple? args then pf0TupleParts args else [args]
+          pfListOf [pfCheckId i for i in argl]
+
+pfCheckId form==   if not pfId? form then npTrapForm(form) else form
+
+pfPushMacroBody(args,body)==
+    null args =>   body
+    pfMLambda(first args,pfPushMacroBody(rest args,body))
+
+pfFlattenApp x==
+   pfApplication? x=>
+             pfCollect1? x =>[ x ]
+             append (pfFlattenApp pfApplicationOp x,
+                        pfFlattenApp pfApplicationArg x)
+   [x]
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/ptrop.boot.pamphlet b/src/interp/ptrop.boot.pamphlet
new file mode 100644
index 00000000..70a65623
--- /dev/null
+++ b/src/interp/ptrop.boot.pamphlet
@@ -0,0 +1,98 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp ptrop.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+--% Utility operations on Abstract Syntax Trees
+ 
+-- An S-expression which people can read.
+pfSexpr pform ==
+    strip pform where
+         strip pform ==
+            pfId? pform       => pfIdSymbol pform
+            pfLiteral?  pform => pfLiteralString pform
+            pfLeaf? pform     => tokPart pform
+ 
+            pfApplication? pform =>
+                args :=
+                    a := pfApplicationArg pform
+                    if pfTuple? a then pf0TupleParts a else [a]
+                [strip p for p in cons(pfApplicationOp pform, args)]
+ 
+            cons(pfAbSynOp pform, [strip p for p in pfParts pform])
+ 
+pfCopyWithPos( pform , pos ) == 
+    pfLeaf? pform =>         pfLeaf( pfAbSynOp pform , tokPart pform , pos )
+    pfTree( pfAbSynOp pform , [ pfCopyWithPos( p , pos ) for p in pfParts pform ] )
+ 
+pfMapParts(f, pform) ==
+    pfLeaf? pform => pform
+    parts0 := pfParts pform
+    parts1 := [FUNCALL(f, p) for p in parts0]
+    -- Return the original if no changes.
+    same := true
+    for p0 in parts0 for p1 in parts1 while same repeat same := EQ(p0,p1)
+    same => pform
+    pfTree(pfAbSynOp pform, parts1)
+ 
+ 
+pf0ApplicationArgs pform ==
+    arg := pfApplicationArg pform
+    pf0FlattenSyntacticTuple arg
+ 
+pf0FlattenSyntacticTuple pform ==
+    not pfTuple? pform => [pform]
+    [:pf0FlattenSyntacticTuple p for p in pf0TupleParts pform]
+ 
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/record.boot.pamphlet b/src/interp/record.boot.pamphlet
new file mode 100644
index 00000000..f716f545
--- /dev/null
+++ b/src/interp/record.boot.pamphlet
@@ -0,0 +1,300 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/record.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+                        Usage
+
+)bo inputFile2RecordFile('"<idir>fn.input",'"<odir>a.b")
+  converts input file "fn" to a record file stored at "<odir>fn.record".
+  If you give one argument, <idir> is used for <odir>
+
+)bo htFile2RecordFile('"<idir>fn.ht",'"<odir>a.b")
+   converts HT file "fn" to a record file stored at "<odir>fn.record".
+   If you give one argument, record file goes to "<idir>fn.record".
+   A file "<odir>fn.input" is produced as a side-effect.
+
+)bo htFile2InputFile('"<idir>fn.input",'"<odir>a.b")
+   converts input file "fn" to an input file stored at "<odir>fn.input"
+
+)bo printRecordFile('"<idir>fn.record") to display results recorded
+
+)bo verifyRecordFile('"<idir>fn.record") to verfiy that same output
+   results from running original fn.input file
+\end{verbatim}
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--=======================================================================
+--                      Global Variables
+--=======================================================================
+$backslash := char '_\
+$testOutputLineFlag := nil   -- referenced by charyTop, prnd to stash lines
+$testOutputLineStack := nil  -- saves lines to be printed (needed to convert
+                             -- lines for use in hypertex)
+$runTestFlag := nil          -- referenced by maPrin to stash output
+                             -- by recordAndPrint to not print type/time
+$mkTestFlag := nil           -- referenced by READLN to stash input
+                             -- by maPrin to stash output
+                             -- by recordAndPrint to write i/o onto $testStream
+$mkTestInputStack := nil     -- saves input for $testStream (see READLN)
+$mkTestOutputStack := nil    -- saves output for $testStream (see maPrin)
+$mkTestOutputType := nil     -- saves the type for $testStream
+ 
+--=======================================================================
+--                Function for Creating a `record' file
+--=======================================================================
+inputFile2RecordFile(pathname,:option) ==
+  ifn := PATHNAME_-NAME pathname
+  not isExistingFile pathname => throwKeyedMsg("S2IL0003",[namestring ifn])
+  opath := KAR option or pathname
+  odirect := pathnameDirectory opath
+  opathname := htMkPath(odirect,ifn,'"rec")
+  _*PRINT_-ARRAY_*: local := true
+  $mkTestFlag: local := true
+  $runTestFlag: local := false
+  $mkTestInputStack: local := nil
+  $mkTestOutputStack: local := nil
+  $mkTestOutputType: local := nil
+  $currentLine: local := nil
+  if isExistingFile opathname then DELETE_-FILE opathname
+  $testStream := MAKE_-OUTSTREAM opathname
+  CATCH('SPAD__READER,_/READ(pathname,nil))
+  --for trailing system commands
+  if not null $currentLine then recordAndPrintTest '(ForSystemCommands)
+  SHUT $testStream
+  opathname 
+--=======================================================================
+--                Function for Displaying a `record' file
+--=======================================================================
+printRecordFile(pathname,:option) ==
+  $LINELENGTH : local := KAR option or 76
+  $printTimeIfTrue: local := nil
+  $printTypeIfTrue: local := true
+  stream := DEFIOSTREAM([['FILE,:pathname], '(MODE . INPUT)],80,0)
+  repeat
+    NULL (PEEK_-CHAR ( true, stream , nil, nil )) => return nil
+    [i,t,:o] := dewritify READ stream
+    sayNewLine()
+    for x in i repeat sayBrightly x
+    sayNewLine()
+    for x in o repeat maPrin x
+    if t^= '(Void) then printTypeAndTime(nil,t)
+ 
+testPrin(u,w) == --same as maPrin but lines are stored in $testOutputLineList
+                 --these lines are needed for pasting into HT files
+  $LINELENGTH: local := w
+  $mkTestFlag: local := nil
+  $testOutputLineFlag: local := true
+  $testOutputLineList: local := nil
+  maPrin COPY u
+  res := REVERSE $testOutputLineList
+  for x in res repeat sayBrightly x
+  res
+ 
+--=======================================================================
+--     Function for converting a maPrin expression to HyperTeX format
+--=======================================================================
+hyperize(u,w) ==
+  $LINELENGTH: local := w
+  $mkTestFlag: local := nil
+  $testOutputLineFlag: local := true
+  $testOutputLineList: local := nil
+  maPrin COPY u
+  res := REVERSE $testOutputLineList
+  null res => '""
+  null rest res => first res
+  "STRCONC"/[first res,:[STRCONC("\newline ",x) for x in rest res]]
+ 
+verbatimize u ==
+  u = '"" => u
+  STRCONC('"\begin{verbatim}",u,'"\end{verbatim}")
+--=======================================================================
+--                Function for Verifying a `record' file
+--=======================================================================
+verifyRecordFile(pathname) ==
+  ifn := PATHNAME_-NAME pathname
+  sayBrightly ['"Verifying",:bright ifn]
+  not isExistingFile pathname => throwKeyedMsg("S2IL0003",[namestring ifn])
+  stream := MAKE_-INSTREAM pathname
+  clearCmdAll()
+  result := 'ok
+  for j in 1.. repeat
+    NULL (PEEK_-CHAR ( true, stream ,nil,nil ))=>return nil
+    [i,t,:o] := dewritify READ stream
+    null i => return nil
+    t = 'ForSystemCommands => 
+      return testInput2Output(i,nil)  
+	--read trailing system commands
+    [typ,:output] := testInput2Output(i,j)
+    typ = t =>
+      output = o => 'ok
+      result := 'error
+      wasIs(o,output)
+    result := 'error
+    wasIs(o,output,t,typ)
+  suffix := (result = 'ok => '"is ok"; '"has errors")
+  sayBrightly [:bright ifn,suffix]
+
+testInput2Output(lines,n) ==
+  $mkTestOutputStack: local := nil
+  $mkTestOutputType: local := nil
+  $mkTestFlag: local := nil
+  $runTestFlag: local := true
+  $testOutput: local
+  evaluateLines lines
+  null n => nil     --return from reading trailing system commands
+  typ := $mkTestOutputType
+  output := NREVERSE $mkTestOutputStack
+  [prefix2String typ,:output]
+
+evaluateLines lines ==
+  file := MAKE_-OUTSTREAM '"/tmp/temp.input"
+  for line in lines repeat
+--  stringPrefix?('")read ",line) => 'skip
+    stringPrefix?('")r",line) => 'skip
+    stringPrefix?('")undo )redo",line) => 'skip
+    PRINTEXP(line, file)
+    TERPRI file
+  SHUT file
+  _/EDITFILE: fluid := '"/tmp/temp.input"
+  _/RF()
+    -- can't use _/EDITFILE since it might be reset
+  DELETE_-FILE '"/tmp/temp.input"
+
+
+wasIs(old,new,:typePart) ==
+  sayBrightly '"*************************************************************"
+  if old ^= new then 
+    sayBrightly '"Was ----------> "
+    for x in old repeat maPrin x
+    sayBrightly '"Is -----------> "
+    for x in new repeat maPrin x
+  typePart is [oldtype,newtype] and oldtype ^= newtype =>
+    sayBrightlyNT ['" Type was ---> ",oldtype]
+    pp old
+    sayBrightlyNT ['" Type is  ---> ",newtype]
+    pp new
+
+--=======================================================================
+--              Creating Input Files from HT Files
+--=======================================================================
+htFile2InputFile(pathname,:option) ==
+  ifn := pathnameName pathname
+  not isExistingFile pathname => throwKeyedMsg("S2IL0003",[namestring ifn])
+  opath := KAR option or pathname
+  odirect := pathnameDirectory opath
+  opathname := htMkPath(odirect,ifn,'"input")
+  if isExistingFile opathname then DELETE_-FILE opathname
+  $htStream : local := MAKE_-INSTREAM pathname
+  alist := [[htGetPageName u,:htGetSpadCommands()] 
+              while (u := htExampleFind '"\begin{page}")]
+  SHUT $htStream
+  outStream := MAKE_-OUTSTREAM opathname
+  for [pageName,:commands] in alist repeat
+    PRINTEXP('"-- ",outStream)
+    PRINTEXP(pageName,outStream)
+    TERPRI outStream 
+    PRINTEXP('")cl all",outStream)
+    TERPRI outStream
+    for x in commands repeat 
+      PRINTEXP(htCommandToInputLine x,outStream)
+      TERPRI outStream
+    TERPRI outStream
+  SHUT outStream
+  opathname
+ 
+htCommandToInputLine s == fn(s,0) where fn(s,init) ==
+--similar to htTrimAtBackSlash except removes all \
+  k := or/[i for i in init..MAXINDEX s | s.i = char '_\] =>
+    member(s.(k + 1),[char 'f,char 'b]) => SUBSTRING(s,init,k - init)
+    STRCONC(SUBSTRING(s,init,k - init),fn(s,k + 1))
+  SUBSTRING(s,init,nil)
+ 
+htTrimAtBackSlash s ==
+  backslash := char '_\
+  k := or/[i for i in 0..MAXINDEX s | s.i = backslash 
+          and member(s.(i + 1),[char 'f,char 'b])] => SUBSTRING(s,0,k - 1)
+  s
+ 
+htMkPath(directory,name,typ) ==
+  nameType := STRCONC(name,'".",typ)
+  null directory => nameType
+  STRCONC(directory,nameType)
+      
+--=======================================================================
+--              Creating Record File from HT Files
+--=======================================================================
+htFile2RecordFile(pathname,:option) ==
+  inputFile2RecordFile htFile2InputFile(pathname,KAR option)
+
+--=======================================================================
+--           Function to record and print values into $testStream  
+--=======================================================================
+recordAndPrintTest md ==  --called by recordAndPrint
+  input :=
+    STRINGP $currentLine => [$currentLine]
+    fn $currentLine where fn x ==
+      x is [y,:r] =>     
+        y.(k := MAXINDEX y) = char '__ => 
+          u := fn r
+          [STRCONC(SUBSTRING(y,0,k),'" ",first u),:rest u]
+        [y,:fn r]
+      x
+  output := NREVERSE $mkTestOutputStack -- set by maPrin
+  PRINT(writify [input,prefix2String md,:output],$testStream)
+  $mkTestInputStack := nil
+  $mkTestOutputStack := nil
+ 
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/redefs.boot.pamphlet b/src/interp/redefs.boot.pamphlet
new file mode 100644
index 00000000..519c3fbb
--- /dev/null
+++ b/src/interp/redefs.boot.pamphlet
@@ -0,0 +1,92 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp redefs.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+BLANKS n== MAKE_-FULL_-CVEC (n)
+
+object2String x==
+   STRINGP x=>x
+   IDENTP x=> PNAME x
+   STRINGIMAGE x
+ 
+sayMSG x== shoeConsole x
+sayBrightly x==
+       brightPrint x
+       TERPRI()
+;;char x==CHAR(PNAME x,0)
+pathname x==CONCAT(PNAME(x.0),'".",PNAME(x.1))
+CVECP x== STRINGP x
+concat(:l) == concatList l
+ 
+concatList [x,:y] ==
+  null y => x
+  null x => concatList y
+  concat1(x,concatList y)
+ 
+concat1(x,y) ==
+  null x => y
+  atom x => (null y => x; atom y => [x,y]; [x,:y])
+  null y => x
+  atom y => [:x,y]
+  [:x,:y]
+ 
+--$FILESIZE x==
+--     a:=OPEN MAKE_-INPUT_-FILENAME x
+--     b:=FILE_-LENGTH a
+--     CLOSE a
+--     b
+SPADCATCH(x,y)==CATCH(x,y)
+SPADTHROW(x,y)==THROW(x,y)
+listSort(f,l)== SORT(l,f)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/rulesets.boot.pamphlet b/src/interp/rulesets.boot.pamphlet
new file mode 100644
index 00000000..b2ceefa6
--- /dev/null
+++ b/src/interp/rulesets.boot.pamphlet
@@ -0,0 +1,325 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp rulesets.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Mode and Type Resolution Rule Data and Ruleset Creation
+
+--% resolveTT Rules
+
+-- These rules are applied only once at the outermost position of a term
+-- some things can't be done by term rewriting conveniently (e.g. set
+-- difference), so a form is created which is interpreted by
+-- resolveTTRed later. The meanings of these forms are:
+-- Incl(x,y): y if x is a member of y, failed otherwise
+-- SetEqual(x,y): x if y is a permutation of x, failed otherwise
+-- SetComp(x,y): x-y, if y is a subset of x, failed otherwise
+-- SetInter(x,y): intersection of x and y, if nonempty, failed otherwise
+-- SetDiff(x,y): x-y, if x and y have a nonempty intersection, failed ...
+
+-- These first rules will be expanded for each of MP, DMP and NDMP
+
+SETANDFILEQ($mpolyTTRules,'( _
+  ((Resolve (RN) (mpoly1 x t1)) . (mpoly1 x (Resolve (RN) t1))) _
+  ((Resolve (UP x t1) (mpoly1 y t2)) . _
+    (Resolve t1 (mpoly1 (Incl x y) t2))) _
+  ((Resolve (mpoly1 x t1) (G t2)) . _
+    (mpoly1 x (G (VarEqual t1 t2)))) _
+  ((Resolve (VARIABLE x) (mpoly1 y t2)) . _
+    (mpoly1 (Incl x y) t2)) _
+  ((Resolve (mpoly1 x t1) (mpoly1 y t2)) . _
+    (mpoly1 (SetEqual x y) (Resolve t1 t2))) _
+  ((Resolve (mpoly1 x t1) (mpoly1 y t2)) . _
+    (mpoly1 x (Resolve t1 (mpoly1 (SetComp y x) t2)))) _
+  ((Resolve (mpoly1 x t1) (mpoly1 y t2)) . _
+    (mpoly1 y (Resolve (mpoly1 (SetComp x y) t1) t2))) _
+  ((Resolve (mpoly1 x t1) (mpoly1 y t2)) . _
+    (mpoly1 (SetInter x y) (Resolve _
+      (mpoly1 (SetDiff x y) t1) (mpoly1 (SetDiff y x) t2)))) _
+  ))
+
+-- These are the general rules, excluding those above.
+
+SETANDFILEQ($generalTTRules, '( _
+  ((Resolve (L (L t1)) (M t2)) . (M (Resolve t1 t2))) _
+  ((Resolve (EQ t1) (B)) . (B)) _
+  ((Resolve (SY) t1) . (Resolve (P (I)) t1)) _
+  ((Resolve (M t1) (SM x t2)) . (M (Resolve t1 t2))) _
+  ((Resolve (M t1) (RM x y t2)) . (M (Resolve t1 t2))) _
+  ((Resolve (SM x t1) (RM y y t2)) . _
+    (SM (VarEqual x y) (Resolve t1 t2))) _
+  ((Resolve (V t1) (L t2)) . (V (Resolve t1 t2))) _
+  ((Resolve (FF t1) (FR t2)) . (FR (Resolve t1 t2))) _
+  ((Resolve (F) (RN)) . (F) ) _
+ _
+  ((Resolve (OV x) (OV y)) . (OV (SetUnion x y))) _
+  ((Resolve (P t1) (UP y t2)) . (Resolve (P t1) t2)) _
+ _
+  ((Resolve (UP y t1) (G t2)) . (UP y (G (VarEqual t1 t2)))) _
+  ((Resolve (P t1) (P t2)) . (P (Resolve t1 t2))) _
+  ((Resolve (G t1) (G t2)) . (G (Resolve t1 t2))) _
+  ((Resolve (G t1) (P t2)) . (P (G (VarEqual t1 t2)))) _
+ _
+  ((Resolve (AF t1) (EF t2)) . (EF (Resolve t1 t2))) _
+  ((Resolve (AF t1) (LF t2)) . (LF (Resolve t1 t2))) _
+  ((Resolve (AF t1) (FE t2)) . (FE (Resolve t1 t2))) _
+  ((Resolve (EF t1) (LF t2)) . (LF (Resolve t1 t2))) _
+  ((Resolve (EF t1) (FE t2)) . (FE (Resolve t1 t2))) _
+  ((Resolve (LF t1) (FE t2)) . (FE (Resolve t1 t2))) _
+ _
+  ((Resolve (RN) (P t1)) . (P (Resolve (RN) t1))) _
+  ((Resolve (RN) (UP x t1)) . (UP x (Resolve (RN) t1))) _
+  ((Resolve (RN) (UPS x t1)) . (UPS x (Resolve (RN) t1))) _
+  ((Resolve (RN) (CFPS x t1)) . (CFPS x (Resolve (RN) t1))) _
+ _
+  ((Resolve (RR) (EF t1)) . (EF (Resolve (RR) t1))) _
+  ((Resolve (P t1) (AF t2)) . (AF (Resolve t1 t2 ))) _
+  ((Resolve (P t1) (EF t2)) . (EF (Resolve t1 t2 ))) _
+  ((Resolve (P t1) (LF t2)) . (LF (Resolve t1 t2 ))) _
+ _
+  ((Resolve (MP x t1) (DMP y t2)) . _
+    (MP (SetEqual x y) (Resolve t1 t2))) _
+  ((Resolve (MP x t1) (DMP y t2)) . _
+    (MP x (Resolve t1 (DMP (SetComp y x) t2)))) _
+  ((Resolve (MP x t1) (DMP y t2)) . _
+    (MP y (Resolve (MP (SetComp x y) t1) t2))) _
+  ((Resolve (MP x t1) (DMP y t2)) . _
+    (MP (SetInter x y) (Resolve _
+      (MP (SetDiff x y) t1) (DMP (SetDiff y x) t2)))) _
+ _
+  ((Resolve (MP x t1) (NDMP y t2)) . _
+    (MP (SetEqual x y) (Resolve t1 t2))) _
+  ((Resolve (MP x t1) (NDMP y t2)) . _
+    (MP x (Resolve t1 (NDMP (SetComp y x) t2)))) _
+  ((Resolve (MP x t1) (NDMP y t2)) . _
+    (MP y (Resolve (MP (SetComp x y) t1) t2))) _
+  ((Resolve (MP x t1) (NDMP y t2)) . _
+    (MP (SetInter x y) (Resolve _
+      (MP (SetDiff x y) t1) (NDMP (SetDiff y x) t2)))) _
+ _
+  ((Resolve (DMP x t1) (NDMP y t2)) . _
+    (DMP (SetEqual x y) (Resolve t1 t2))) _
+  ((Resolve (DMP x t1) (NDMP y t2)) . _
+    (DMP x (Resolve t1 (NDMP (SetComp y x) t2)))) _
+  ((Resolve (DMP x t1) (NDMP y t2)) . _
+    (DMP y (Resolve (DMP (SetComp x y) t1) t2))) _
+  ((Resolve (DMP x t1) (NDMP y t2)) . _
+    (DMP (SetInter x y) (Resolve _
+      (DMP (SetDiff x y) t1) (NDMP (SetDiff y x) t2)))) _
+  ))
+
+-- The following creates the ruleset
+
+createResolveTTRules() ==
+  -- expand multivariate polynomial rules
+  mps := '(MP DMP NDMP)
+  mpRules := "append"/[SUBST(mp,'mpoly1,$mpolyTTRules) for mp in mps]
+  $Res := CONS('(t1 t2 x y),
+    EQSUBSTLIST($nameList,$abList,append($generalTTRules,mpRules)))
+  true
+
+--% resolveTM Rules
+
+-- Same rules as for resolveTT, with two exceptions:
+-- Diff(x,y): removes y from x, if possible, failed otherwise
+-- SetIncl(x,y): y if x is a subset of y, failed otherwise
+
+-- These first rules will be expanded for each of MP, DMP and NDMP
+
+SETANDFILEQ($mpolyTMRules,'( _
+  ((Resolve (mpoly1 x t1) (P t2)) . (Resolve t1 (P t2))) _
+  ((Resolve (mpoly1 (x) t1) (UP x t2)) . (UP x (Resolve t1 t2))) _
+  ((Resolve (mpoly1 x t1) (UP y t2)) . _
+    (UP y (Resolve (mpoly1 (Diff x y) t1) t2))) _
+  ((Resolve (UP x t1) (mpoly1 y t2)) . _
+    (Resolve t1 (mpoly1 (Incl x y) t2))) _
+  ((Resolve (VARIABLE x) (mpoly1 y t2)) . _
+    (mpoly1 (Incl x y) (Resolve (I) t2))) _
+  ((Resolve (mpoly1 x t1) (mpoly2 y t2)) . _
+    (Resolve t1 (mpoly2 (SetIncl x y) t2))) _
+  ((Resolve (mpoly1 x t1) (mpoly2 y t2)) . _
+    (mpoly2 y (Resolve (mpoly1 (SetComp x y) t1) t2))) _
+  ((Resolve (mpoly1 x t1) (mpoly2 y t2)) . _
+    (Resolve (mpoly1 (SetDiff x y) t1) (mpoly2 y t2))) _
+ ))
+
+-- These are the general rules, excluding those above.
+
+SETANDFILEQ($generalTMRules,'( _
+  ((Resolve (VARIABLE x) (P t1)) . (P (Resolve (I) t1))) _
+  ((Resolve (VARIABLE x) (UP y t1)) . _
+    (UP (VarEqual x y) (Resolve (I) t1))) _
+  ((Resolve (VARIABLE x) (UPS y t1)) . _
+    (UPS (VarEqual x y) (Resolve (I) t1))) _
+  ((Resolve (VARIABLE x) (CFPS y t1)) . _
+    (CFPS (VarEqual x y) (Resolve (RN) t1))) _
+  ((Resolve (VARIABLE x) (ELFPS y t1)) . _
+    (ELFPS (VarEqual x y) (Resolve (RN) t1))) _
+  ((Resolve (VARIABLE x) (EF t1)) . (EF t1)) _
+  ((Resolve (L (L (SY))) (M _*_*)) . (M (P (I)))) _
+  ((Resolve (L (L (SY))) (SM x _*_*)) . (SM x (P (I)))) _
+  ((Resolve (L (L t1)) (M t2)) . (M (Resolve t1 t2))) _
+  ((Resolve (L (L t1)) (SM x t2)) . (SM x (Resolve t1 t2))) _
+  ((Resolve (L (L t1)) (RM x y t2)) . (RM x y (Resolve t1 t2))) _
+  ((Resolve (SY) t1) . (Resolve (P (I)) t1)) _
+  ((Resolve (VARIABLE x) t1) . (Resolve (P (I)) t1)) _
+  ((Resolve (SM x t1) (M t2)) . (M (Resolve t1 t2))) _
+  ((Resolve (RM x y t1) (M t2)) . (M (Resolve t1 t2))) _
+ _
+  ((Resolve (M t1) (L _*_*)) . (L (L t1))) _
+  ((Resolve (SM x t1) (L _*_*)) . (L (L t1))) _
+  ((Resolve (RM x y t1) (L _*_*)) . (L (L t1))) _
+  ((Resolve (M t1) (L t2)) . (L (Resolve (L t1) t2))) _
+  ((Resolve (SM x t1) (L t2)) . (L (Resolve (L t1) t2))) _
+  ((Resolve (RM x y t1) (L t2)) . (L (Resolve (L t1) t2))) _
+ _
+  ((Resolve (M t1) (V _*_*)) . (V (V t1))) _
+  ((Resolve (SM x t1) (V _*_*)) . (V (V t1))) _
+  ((Resolve (RM x y t1) (V _*_*)) . (V (V t1))) _
+  ((Resolve (M t1) (V t2)) . (V (Resolve (V t1) t2))) _
+  ((Resolve (SM x t1) (V t2)) . (V (Resolve (V t1) t2))) _
+  ((Resolve (RM x y t1) (V t2)) . (V (Resolve (V t1) t2))) _
+ _
+  ((Resolve (L t1) (V t2)) . (V (Resolve t1 t2))) _
+  ((Resolve (V t1) (L t2)) . (L (Resolve t1 t2))) _
+  ((Resolve (FF t1) (FR t2)) . (FR (Resolve t1 t2))) _
+  ((Resolve (UP x t1) (P t2)) . (Resolve t1 (P t2))) _
+ ))
+
+-- Private abbreviation table for resolve rules
+SETANDFILEQ($resolveAbbreviations, '( _
+    (P .  Polynomial) _
+    (G .  Gaussian) _
+    (L .  List) _
+    (M .  Matrix) _
+    (EQ . Equation) _
+    (B .  Boolean) _
+    (SY . Symbol) _
+    (I .  Integer) _
+    (SM . SquareMatrix) _
+    (RM . RectangularMatrix) _
+    (V .  Vector) _
+    (FF . FactoredForm) _
+    (FR . FactoredRing) _
+    (RN . RationalNumber) _
+    (F .  Float) _
+    (OV . OrderedVariableList) _
+    (UP . UnivariatePoly) _
+    (DMP . DistributedMultivariatePolynomial) _
+    (MP . MultivariatePolynomial) _
+    (HDMP . HomogeneousDistributedMultivariatePolynomial) _
+    (QF . QuotientField) _
+    (RF . RationalFunction) _
+    (RE . RadicalExtension) _
+    (RR . RationalRadicals) _
+    (UPS . UnivariatePowerSeries) _
+    (CFPS . ContinuedFractionPowerSeries) _
+    (ELFPS . EllipticFunctionPowerSeries) _
+    (EF . ElementaryFunction) _
+    (VARIABLE . Variable) _
+ ))
+
+SETANDFILEQ($newResolveAbbreviations, '( _
+    (P .  Polynomial) _
+    (G .  Complex) _
+    (L .  List) _
+    (M .  Matrix) _
+    (EQ . Equation) _
+    (B .  Boolean) _
+    (SY . Symbol) _
+    (I .  Integer) _
+    (SM . SquareMatrix) _
+    (RM . RectangularMatrix) _
+    (V .  Vector) _
+    (FF . Factored) _
+    (FR . Factored) _
+    (F .  Float) _
+    (OV . OrderedVariableList) _
+    (UP . UnivariatePolynomial) _
+    (DMP . DistributedMultivariatePolynomial) _
+    (MP . MultivariatePolynomial) _
+    (HDMP . HomogeneousDistributedMultivariatePolynomial) _
+    (QF . Fraction) _
+    (UPS . UnivariatePowerSeries) _
+    (VARIABLE . Variable) _
+ ))
+
+-- The following creates the ruleset
+
+createResolveTMRules() ==
+  -- expand multivariate polynomial rules
+  mps := '(MP DMP NDMP)
+  mpRules0 := "append"/[SUBST(mp,'mpoly1,$mpolyTMRules) for mp in mps]
+  mpRules := "append"/[SUBST(mp,'mpoly2,mpRules0) for mp in mps]
+  $ResMode := CONS('(t1 t2 x y),
+    EQSUBSTLIST($nameList,$abList,append(mpRules,$generalTMRules)))
+  true
+
+createTypeEquivRules() ==
+  -- used by eqType, for example
+  $TypeEQ := CONS('(t1), EQSUBSTLIST($nameList,$abList,'(
+    ((QF (P t1)) . (RF t1))
+      ((QF (I)) . (RN))
+        ((RE (RN)) . (RR)) )))
+  $TypeEqui := CONS(CAR $TypeEQ, [[b,:a] for [a,:b] in CDR $TypeEQ])
+  true
+
+initializeRuleSets() ==
+  $abList: local :=
+    ASSOCLEFT $newResolveAbbreviations
+  $nameList: local :=
+    ASSOCRIGHT $newResolveAbbreviations
+  createResolveTTRules()
+  createResolveTMRules()
+  createTypeEquivRules()
+  $ruleSetsInitialized := true
+  true
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/scan.boot.pamphlet b/src/interp/scan.boot.pamphlet
new file mode 100644
index 00000000..cd117672
--- /dev/null
+++ b/src/interp/scan.boot.pamphlet
@@ -0,0 +1,565 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp scan.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- Scanner
+
+--  lineoftoks  bites off a token-dq from a line-stream
+--  returning the token-dq and the rest of the line-stream
+
+scanIgnoreLine(ln,n)==
+    if null n
+    then n
+    else
+       fst:=QENUM(ln,0)
+       if EQ(fst,CLOSEPAREN)
+       then if incPrefix?('"command",1,ln)
+            then true
+            else nil
+       else n
+
+nextline(s)==
+     if npNull s
+     then false
+     else
+       $f:= CAR s
+       $r:= CDR s
+       $ln := CDR $f
+       $linepos:=CAAR $f
+       $n:=STRPOSL('" ",$ln,0,true)-- spaces at beginning
+       $sz :=# $ln
+       true
+
+
+lineoftoks(s)==
+   $f: local:=nil
+   $r:local :=nil
+   $ln:local :=nil
+   $linepos:local:=nil
+   $n:local:=nil
+   $sz:local := nil
+   $floatok:local:=true
+   if not nextline s
+   then CONS(nil,nil)
+   else
+     if null scanIgnoreLine($ln,$n) -- line of spaces or starts ) or >
+     then cons(nil,$r)
+     else
+      toks:=[]
+      a:= incPrefix?('"command",1,$ln)
+      a =>
+                 $ln:=SUBSTRING($ln,8,nil)
+                 b:= dqUnit constoken($ln,$linepos,["command",$ln],0)
+                 cons([[b,s]],$r)
+
+      while $n<$sz repeat toks:=dqAppend(toks,scanToken())
+      if null toks
+      then cons([],$r)
+      else cons([[toks,s]],$r)
+
+
+scanToken () ==
+      ln:=$ln
+      c:=QENUM($ln,$n)
+      linepos:=$linepos
+      n:=$n
+      ch:=$ln.$n
+      b:=
+            startsComment?()          =>
+                           scanComment()
+                           []
+            startsNegComment?()       =>
+                           scanNegComment()
+                           []
+            c= QUESTION               =>
+                               $n:=$n+1
+                               lfid '"?"
+            punctuation? c            => scanPunct ()
+            startsId? ch              => scanWord  (false)
+            c=SPACE                   =>
+                           scanSpace ()
+                           []
+            c = STRING_CHAR           => scanString ()
+            digit? ch                 => scanNumber ()
+            c=ESCAPE                  => scanEscape()
+            scanError ()
+      null b => nil
+      dqUnit constoken(ln,linepos,b,n+lnExtraBlanks linepos)
+
+-- to pair badge and badgee
+
+-- lfid x== ["id",INTERN x]
+lfid x== ["id",INTERN(x, '"BOOT")]
+
+lfkey x==["key",keyword x]
+
+lfinteger x==
+           ["integer",x]
+--     if EQUAL(x,'"0")
+--     then ["id",INTERN x]
+--     else if EQUAL(x,'"1")
+--          then ["id",INTERN x]
+--          else ["integer",x]
+
+lfrinteger (r,x)==["integer",CONCAT (r,CONCAT('"r",x))]
+--lfrfloat(a,w,v)==["rfloat",CONCAT(a,'"r.",v)]
+lffloat(a,w,e)==["float",CONCAT(a,'".",w,'"e",e)]
+lfstring x==if #x=1 then ["char",x] else ["string",x]
+lfcomment x== ["comment", x]
+lfnegcomment x== ["negcomment", x]
+lferror x==["error",x]
+lfspaces x==["spaces",x]
+
+constoken(ln,lp,b,n)==
+--  [b.0,b.1,cons(lp,n)]
+       a:=cons(b.0,b.1)
+       ncPutQ(a,"posn",cons(lp,n))
+       a
+
+scanEscape()==
+         $n:=$n+1
+         a:=scanEsc()
+         if a then scanWord true else nil
+
+scanEsc()==
+     if $n>=$sz
+     then if nextline($r)
+          then
+             while null $n repeat nextline($r)
+             scanEsc()
+             false
+          else false
+     else
+           n1:=STRPOSL('" ",$ln,$n,true)
+           if null n1
+           then if nextline($r)
+                then
+                  while null $n repeat nextline($r)
+                  scanEsc()
+                  false
+                else false
+           else
+                if $n=n1
+                then true
+                else if QENUM($ln,n1)=ESCAPE
+                     then
+                       $n:=n1+1
+                       scanEsc()
+                       false
+                     else
+                       $n:=n1
+                       startsNegComment?() or startsComment?() =>
+                                 nextline($r)
+                                 scanEsc()
+                                 false
+                       false
+
+startsComment?()==
+    if $n<$sz
+    then
+         if QENUM($ln,$n)=PLUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = PLUSCOMMENT
+          else false
+    else false
+
+startsNegComment?()==
+    if $n< $sz
+    then
+         if QENUM($ln,$n)=MINUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = MINUSCOMMENT
+          else false
+    else false
+
+scanNegComment()==
+      n:=$n
+      $n:=$sz
+      lfnegcomment SUBSTRING($ln,n,nil)
+
+scanComment()==
+      n:=$n
+      $n:=$sz
+      lfcomment SUBSTRING($ln,n,nil)
+
+
+scanPunct()==
+            sss:=subMatch($ln,$n)
+            a:= # sss
+            if a=0
+            then
+               scanError()
+            else
+               $n:=$n+a
+               scanKeyTr sss
+
+scanKeyTr w==
+       if EQ(keyword w,"DOT")
+       then if $floatok
+            then scanPossFloat(w)
+            else lfkey w
+       else
+            $floatok:=not scanCloser? w
+            lfkey w
+
+scanPossFloat (w)==
+     if $n>=$sz or not digit? $ln.$n
+     then lfkey w
+     else
+       w:=spleI(function digit?)
+       scanExponent('"0",w)
+
+scanCloser:=[")","}","]","|)","|}","|]"]
+
+scanCloser? w== MEMQ(keyword w,scanCloser)
+
+scanSpace()==
+           n:=$n
+           $n:=STRPOSL('" ",$ln,$n,true)
+           if null $n then $n:=# $ln
+           $floatok:=true
+           lfspaces ($n-n)
+
+scanString()==
+            $n:=$n+1
+            $floatok:=false
+            lfstring scanS ()
+
+scanS()==
+   if $n>=$sz
+   then
+     ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),"S2CN0001",[])
+     '""
+   else
+           n:=$n
+           strsym :=STRPOS ('"_"",$ln,$n,nil) or $sz
+           escsym:=STRPOS ('"__"
+                          ,$ln,$n,nil)  or $sz
+           mn:=MIN(strsym,escsym)
+           if mn=$sz
+           then
+                 $n:=$sz
+                 ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),
+                         "S2CN0001",[])
+                 SUBSTRING($ln,n,nil)
+           else if mn=strsym
+                then
+                   $n:=mn+1
+                   SUBSTRING($ln,n,mn-n)
+                else     --escape is found first
+                  str:=SUBSTRING($ln,n,mn-n)-- before escape
+                  $n:=mn+1
+                  a:=scanEsc() -- case of end of line when false
+                  b:=if a
+                     then
+                       str:=CONCAT(str,scanTransform($ln.$n))
+                       $n:=$n+1
+                       scanS()
+                      else scanS()
+                  CONCAT(str,b)
+scanTransform x==x
+
+--idChar? x== scanLetter x or DIGITP x or MEMQ(x,'(_? _%))
+
+--scanLetter x==
+--   if not CHARP x
+--   then false
+--   else STRPOSL(scanTrTable,x,0,NIL)
+
+posend(line,n)==
+     while n<#line and idChar? line.n repeat n:=n+1
+     n
+
+--numend(line,n)==
+--     while n<#line and digit? line.n repeat n:=n+1
+--     n
+
+--startsId? x==  scanLetter x or MEMQ(x,'(_? _%))
+digit? x== DIGITP x
+
+scanW(b)==             -- starts pointing to first char
+       n1:=$n         -- store starting character position
+       $n:=$n+1          -- the first character is not tested
+       l:=$sz
+       endid:=posend($ln,$n)
+       if endid=l or QENUM($ln,endid)^=ESCAPE
+       then -- not escaped
+           $n:=endid
+           [b,SUBSTRING($ln,n1,endid-n1)]   -- l overflows
+       else -- escape and endid^=l
+           str:=SUBSTRING($ln,n1,endid-n1)
+           $n:=endid+1
+           a:=scanEsc()
+           bb:=if a -- escape nonspace
+               then scanW(true)
+               else
+                  if $n>=$sz
+                  then [b,'""]
+                  else
+                    if idChar?($ln.$n)
+                    then scanW(b)
+                    else [b,'""]
+           [bb.0 or b,CONCAT(str,bb.1)]
+
+scanWord(esp) ==
+          aaa:=scanW(false)
+          w:=aaa.1
+          $floatok:=false
+          if esp or aaa.0
+          then lfid w
+          else if keyword? w
+               then
+                  $floatok:=true
+                  lfkey w
+               else lfid  w
+
+
+
+spleI(dig)==spleI1(dig,false)
+spleI1(dig,zro) ==
+       n:=$n
+       l:= $sz
+       while $n<l and FUNCALL(dig,($ln.$n)) repeat $n:=$n+1
+       if $n=l or QENUM($ln,$n)^=ESCAPE
+       then if n=$n and zro
+            then '"0"
+            else SUBSTRING($ln,n,$n-n)
+       else  -- escaped
+             str:=SUBSTRING($ln,n,$n-n)
+             $n:=$n+1
+             a:=scanEsc()
+             bb:=spleI1(dig,zro)-- escape, anyno spaces are ignored
+             CONCAT(str,bb)
+
+scanCheckRadix(r,w)==
+       ns:=#w
+       done:=false
+       for i in 0..ns-1  repeat
+         a:=rdigit? w.i
+         if null a or a>=r
+         then  ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n-ns+i),
+                    "S2CN0002", [w.i])
+
+scanNumber() ==
+       a := spleI(function digit?)
+       if $n>=$sz
+       then lfinteger a
+       else
+         if QENUM($ln,$n)^=RADIX_CHAR
+         then
+           if $floatok and QENUM($ln,$n)=DOT
+           then
+             n:=$n
+             $n:=$n+1
+             if  $n<$sz and QENUM($ln,$n)=DOT
+             then
+               $n:=n
+               lfinteger a
+             else
+               w:=spleI1(function digit?,true)
+               scanExponent(a,w)
+           else lfinteger a
+         else
+             $n:=$n+1
+             w:=spleI1(function rdigit?,true)
+             scanCheckRadix(PARSE_-INTEGER a,w)
+             if $n>=$sz
+             then
+                lfrinteger(a,w)
+             else if QENUM($ln,$n)=DOT
+                  then
+                    n:=$n
+                    $n:=$n+1
+                    if  $n<$sz and QENUM($ln,$n)=DOT
+                    then
+                       $n:=n
+                       lfrinteger(a,w)
+                    else
+                    --$n:=$n+1
+                      v:=spleI1(function rdigit?,true)
+                      scanCheckRadix(PARSE_-INTEGER a,v)
+                      scanExponent(CONCAT(a,'"r",w),v)
+                  else lfrinteger(a,w)
+
+scanExponent(a,w)==
+     if $n>=$sz
+     then lffloat(a,w,'"0")
+     else
+        n:=$n
+        c:=QENUM($ln,$n)
+        if c=EXPONENT1 or c=EXPONENT2
+        then
+           $n:=$n+1
+           if $n>=$sz
+           then
+             $n:=n
+             lffloat(a,w,'"0")
+           else if digit?($ln.$n)
+                then
+                  e:=spleI(function digit?)
+                  lffloat(a,w,e)
+                else
+                  c1:=QENUM($ln,$n)
+                  if c1=PLUSCOMMENT or c1=MINUSCOMMENT
+                  then
+                    $n:=$n+1
+                    if $n>=$sz
+                    then
+                      $n:=n
+                      lffloat(a,w,'"0")
+                    else
+                      if digit?($ln.$n)
+                      then
+                        e:=spleI(function digit?)
+                        lffloat(a,w,
+                          (if c1=MINUSCOMMENT then CONCAT('"-",e)else e))
+                      else
+                        $n:=n
+                        lffloat(a,w,'"0")
+        else lffloat(a,w,'"0")
+
+rdigit? x==
+   STRPOS(x,'"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",0,nil)
+
+scanError()==
+      n:=$n
+      $n:=$n+1
+      ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),
+         "S2CN0003",[$ln.n])
+      lferror ($ln.n)
+
+
+keyword st   == HGET(scanKeyTable,st)
+
+keyword? st  ==  not null HGET(scanKeyTable,st)
+
+scanInsert(s,d) ==
+      l := #s
+      h := QENUM(s,0)
+      u := ELT(d,h)
+      n := #u
+      k:=0
+      while l <= #(ELT(u,k)) repeat
+          k:=k+1
+      v := MAKE_-VEC(n+1)
+      for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i))
+      VEC_-SETELT(v,k,s)
+      for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i))
+      VEC_-SETELT(d,h,v)
+      s
+
+subMatch(l,i)==substringMatch(l,scanDict,i)
+
+substringMatch (l,d,i)==
+       h:= QENUM(l, i)
+       u:=ELT(d,h)
+       ll:=SIZE l
+       done:=false
+       s1:='""
+       for j in 0.. SIZE u - 1 while not done repeat
+          s:=ELT(u,j)
+          ls:=SIZE s
+          done:=if ls+i > ll
+                then false
+                else
+                 eql:= true
+                 for k in 1..ls-1 while eql repeat
+                    eql:= EQL(QENUM(s,k),QENUM(l,k+i))
+                 if eql
+                 then
+                   s1:=s
+                   true
+                 else false
+       s1
+
+
+scanKeyTableCons()==
+   KeyTable:=MAKE_-HASHTABLE("CVEC",true)
+   for st in scanKeyWords repeat
+      HPUT(KeyTable,CAR st,CADR st)
+   KeyTable
+
+scanDictCons()==
+      l:= HKEYS scanKeyTable
+      d :=
+          a:=MAKE_-VEC(256)
+          b:=MAKE_-VEC(1)
+          VEC_-SETELT(b,0,MAKE_-CVEC 0)
+          for i in 0..255 repeat VEC_-SETELT(a,i,b)
+          a
+      for s in l repeat scanInsert(s,d)
+      d
+
+
+scanPunCons()==
+    listing := HKEYS scanKeyTable
+    a:=MAKE_-BVEC 256
+--  SETSIZE(a,256)
+    for i in 0..255 repeat BVEC_-SETELT(a,i,0)
+    for k in listing repeat
+       if not startsId? k.0
+       then BVEC_-SETELT(a,QENUM(k,0),1)
+    a
+
+
+
+punctuation? c== scanPun.c=1
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/serror.boot.pamphlet b/src/interp/serror.boot.pamphlet
new file mode 100644
index 00000000..753655e9
--- /dev/null
+++ b/src/interp/serror.boot.pamphlet
@@ -0,0 +1,164 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp serror.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Functions to handle specific errors (mostly syntax)
+ 
+)package "BOOT"
+
+syGeneralErrorHere() ==
+   sySpecificErrorHere('S2CY0002, [])
+ 
+sySpecificErrorHere(key, args) ==
+   sySpecificErrorAtToken($stok, key, args)
+ 
+sySpecificErrorAtToken(tok, key, args) ==
+   pos := tokPosn tok
+   ncSoftError(pos, key, args)
+ 
+syIgnoredFromTo(pos1, pos2) ==
+  if pfGlobalLinePosn pos1 = pfGlobalLinePosn pos2 then
+      ncSoftError(FromTo(pos1,pos2), 'S2CY0005, [])
+  else
+      ncSoftError(From pos1, 'S2CY0003, [])
+      ncSoftError(To   pos2, 'S2CY0004, [])
+ 
+npMissingMate(close,open)==
+   ncSoftError(tokPosn open, 'S2CY0008, [])
+   npMissing close
+ 
+npMissing s==
+   ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s])
+   THROW("TRAPPOINT","TRAPPED")
+ 
+npCompMissing s == npEqKey s or npMissing s
+ 
+pfSourceStok x==
+       if pfLeaf? x
+       then x
+       else if null pfParts x
+            then 'NoToken
+            else pfSourceStok pfFirst x
+ 
+npTrapForm(x)==
+   a:=pfSourceStok x
+   EQ(a,'NoToken)=>
+         syGeneralErrorHere()
+         THROW("TRAPPOINT","TRAPPED")
+   ncSoftError(tokPosn a, 'S2CY0002, [])
+   THROW("TRAPPOINT","TRAPPED")
+ 
+npTrap()==
+   ncSoftError(tokPosn $stok,'S2CY0002,[])
+   THROW("TRAPPOINT","TRAPPED")
+ 
+npRecoverTrap()==
+  npFirstTok()
+  pos1 := tokPosn $stok
+  npMoveTo 0
+  pos2 := tokPosn $stok
+  syIgnoredFromTo(pos1, pos2)
+  npPush [pfWrong(pfDocument ['"pile syntax error"],pfListOf [])]
+ 
+ 
+npListAndRecover(f)==
+   a:=$stack
+   b:=nil
+   $stack:=nil
+   done:=false
+   c:=$inputStream
+   while not done repeat
+     found:=CATCH("TRAPPOINT",APPLY(f,nil))
+     if found="TRAPPED"
+     then
+        $inputStream:=c
+        npRecoverTrap()
+     else if not found
+          then
+            $inputStream:=c
+            syGeneralErrorHere()
+            npRecoverTrap()
+     if npEqKey "BACKSET"
+     then
+        c:=$inputStream
+     else if npEqPeek "BACKTAB"
+          then
+             done:=true
+          else
+            $inputStream:=c
+            syGeneralErrorHere()
+            npRecoverTrap()
+            if npEqPeek "BACKTAB"
+            then done:=true
+            else
+                npNext()
+                c:=$inputStream
+     b:=cons(npPop1(),b)
+   $stack:=a
+   npPush NREVERSE b
+ 
+npMoveTo n==
+      if null $inputStream
+      then true
+      else
+           if npEqPeek "BACKTAB"
+           then if n=0
+                then true
+                else (npNext();npMoveTo(n-1))
+           else if npEqPeek "BACKSET"
+                then if n=0
+                     then true
+                     else (npNext();npMoveTo n)
+                 else if npEqKey "SETTAB"
+                      then npMoveTo(n+1)
+                      else (npNext();npMoveTo n)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/server.boot.pamphlet b/src/interp/server.boot.pamphlet
new file mode 100644
index 00000000..3af5ccdb
--- /dev/null
+++ b/src/interp/server.boot.pamphlet
@@ -0,0 +1,240 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp server.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- Scratchpad-II server
+
+-- Assoc list of interpreter frame names and unique integer identifiers
+
+SETANDFILEQ($frameAlist, nil)
+SETANDFILEQ($frameNumber, 0)
+SETANDFILEQ($currentFrameNum, 0)
+SETANDFILEQ($EndServerSession, false)
+SETANDFILEQ($NeedToSignalSessionManager, false)
+SETANDFILEQ($sockBufferLength, 9217)
+
+serverReadLine(stream) ==
+-- used in place of READ-LINE in a scratchpad server system.
+  FORCE_-OUTPUT()
+  not $SpadServer or not IS_-CONSOLE stream =>
+    READ_-LINE(stream)
+  IN_-STREAM: fluid := stream
+  _*EOF_*: fluid := NIL
+  line :=
+   while not $EndServerSession and not _*EOF_* repeat
+    if $NeedToSignalSessionManager then
+      sockSendInt($SessionManager, $EndOfOutput)
+    $NeedToSignalSessionManager := false
+    action := serverSwitch()
+    action = $CallInterp =>
+      l := READ_-LINE(stream)
+      $NeedToSignalSessionManager := true
+      return l
+    action = $CreateFrame =>
+      frameName := GENTEMP('"frame")
+      addNewInterpreterFrame(frameName)
+      $frameAlist := [[$frameNumber,:frameName], :$frameAlist]
+      $currentFrameNum := $frameNumber
+      sockSendInt($SessionManager, $frameNumber)
+      $frameNumber := $frameNumber + 1
+      sockSendString($SessionManager, MKPROMPT())
+    action = $SwitchFrames =>
+      $currentFrameNum := sockGetInt($SessionManager)
+      currentFrame := LASSOC($currentFrameNum, $frameAlist)
+      changeToNamedInterpreterFrame currentFrame
+    action = $EndSession =>
+      $EndServerSession := true
+    action = $LispCommand =>
+      $NeedToSignalSessionManager := true
+      stringBuf := MAKE_-STRING $sockBufferLength
+      sockGetString($MenuServer, stringBuf, $sockBufferLength)
+      form := unescapeStringsInForm READ_-FROM_-STRING stringBuf
+      protectedEVAL form
+    action = $QuietSpadCommand =>
+      $NeedToSignalSessionManager := true
+      executeQuietCommand()
+    action = $SpadCommand =>
+      $NeedToSignalSessionManager := true
+      stringBuf := MAKE_-STRING 512
+      sockGetString($MenuServer, stringBuf, 512)
+      CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
+        parseAndInterpret stringBuf)))
+      PRINC MKPROMPT()
+      FINISH_-OUTPUT()
+    action = $NonSmanSession =>
+      $SpadServer := nil
+    action = $KillLispSystem => 
+      BYE()
+    NIL
+  line => line
+  ""
+
+parseAndInterpret str ==
+  $InteractiveMode :fluid := true
+  $BOOT: fluid := NIL
+  $SPAD: fluid := true
+  $e:fluid := $InteractiveFrame
+  $useNewParser =>
+    ncParseAndInterpretString str
+  oldParseAndInterpret str
+
+oldParseAndInterpret str ==
+  tree := string2SpadTree str
+  tree => processInteractive(parseTransform postTransform tree, NIL)
+  NIL
+
+executeQuietCommand() ==
+  $QuietCommand: fluid := true
+  stringBuf := MAKE_-STRING 512
+  sockGetString($MenuServer, stringBuf, 512)
+  CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
+    parseAndInterpret stringBuf)))
+
+-- Includued for compatability with old-parser systems
+serverLoop() ==
+  IN_-STREAM: fluid := CURINSTREAM
+  _*EOF_*: fluid := NIL
+  while not $EndServerSession and not _*EOF_* repeat
+    if $Prompt then (PRINC MKPROMPT(); FINISH_-OUTPUT())
+    $Prompt := NIL
+    action := serverSwitch()
+    action = $CallInterp =>
+      CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
+        parseAndInterpret READ_-LINE(CURINSTREAM) )))
+      PRINC MKPROMPT()
+      FINISH_-OUTPUT()
+      sockSendInt($SessionManager, $EndOfOutput)
+    action = $CreateFrame =>
+      frameName := GENTEMP('"frame")
+      addNewInterpreterFrame(frameName)
+      $frameAlist := [[$frameNumber,:frameName], :$frameAlist]
+      $currentFrameNum := $frameNumber
+      sockSendInt($SessionManager, $frameNumber)
+      $frameNumber := $frameNumber + 1
+      sockSendString($SessionManager, MKPROMPT())
+    action = $SwitchFrames =>
+      $currentFrameNum := sockGetInt($SessionManager)
+      currentFrame := LASSOC($currentFrameNum, $frameAlist)
+      changeToNamedInterpreterFrame currentFrame
+    action = $EndSession =>
+      $EndServerSession := true
+    action = $LispCommand =>
+      stringBuf := MAKE_-STRING 512
+      sockGetString($MenuServer, stringBuf, 512)
+      form := unescapeStringsInForm READ_-FROM_-STRING stringBuf
+      EVAL form
+    action = $QuietSpadCommand =>
+      executeQuietCommand()
+    action = $SpadCommand =>
+      stringBuf := MAKE_-STRING 512
+      sockGetString($MenuServer, stringBuf, 512)
+      CATCH('coerceFailure,CATCH('top__level, CATCH('SPAD__READER,
+        parseAndInterpret stringBuf)))
+      PRINC MKPROMPT()
+      FINISH_-OUTPUT()
+      sockSendInt($SessionManager, $EndOfOutput)
+    NIL
+  if _*EOF_* then $Prompt := true
+  NIL
+
+parseAndEvalToHypertex str ==
+  lines := parseAndEvalToStringForHypertex str
+  len := LENGTH lines
+  sockSendInt($MenuServer, len)
+  for s in lines repeat
+    sockSendString($MenuServer, s)
+
+parseAndEvalToString str ==
+  $collectOutput:local := true
+  $outputLines: local := nil
+  $IOindex: local := nil
+  v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str))
+  v = 'restart => ['"error"]
+  NREVERSE $outputLines
+
+parseAndEvalToStringForHypertex str ==
+  $collectOutput:local := true
+  $outputLines: local := nil
+  v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str))
+  v = 'restart => ['"error"]
+  NREVERSE $outputLines
+
+parseAndEvalToStringEqNum str ==
+  $collectOutput:local := true
+  $outputLines: local := nil
+  v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr str))
+  v = 'restart => ['"error"]
+  NREVERSE $outputLines
+
+parseAndInterpToString str ==
+  v := applyWithOutputToString('parseAndEvalStr, [str])
+  breakIntoLines CDR v
+
+parseAndEvalStr string ==
+  $InteractiveMode :fluid := true
+  $BOOT: fluid := NIL
+  $SPAD: fluid := true
+  $e:fluid := $InteractiveFrame
+  parseAndEvalStr1 string
+
+parseAndEvalStr1 string ==
+  string.0 = char '")" =>
+    doSystemCommand SUBSEQ(string, 1)
+  processInteractive(ncParseFromString string, NIL)
+
+protectedEVAL x ==
+  error := true
+  val := NIL
+  UNWIND_-PROTECT((val := EVAL x; error := NIL),
+                   error => (resetStackLimits(); sendHTErrorSignal()))
+  val
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/setq.lisp.pamphlet b/src/interp/setq.lisp.pamphlet
new file mode 100644
index 00000000..15d4d241
--- /dev/null
+++ b/src/interp/setq.lisp.pamphlet
@@ -0,0 +1,807 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/setq.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(setq copyrights '(
+ "Copyright The Numerical Algorithms Group Limited 1991-94."
+ "All rights reserved"
+ "Certain derivative-work portions Copyright (C) 1998 by Leslie Lamport."
+ "Portions (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984."
+ "All rights reserved"))
+
+(in-package "BOOT")
+
+(SETQ |/MAJOR-VERSION| 7)
+(SETQ /VERSION 0)
+(SETQ /RELEASE 0)
+
+(defconstant |$cclSystem|
+#+:CCL 't
+#-:CCL nil
+)
+
+;; These two variables are referred to in setvars.boot.
+#+:kcl (setq input-libraries nil)
+#+:kcl (setq output-library nil)
+
+;; For the browser, used for building local databases when a user compiles
+;; their own code.
+(SETQ |$newConstructorList| nil)
+(SETQ |$newConlist| nil)
+(SETQ |$createLocalLibDb| 't)
+
+
+;; These were originally in SPAD LISP
+
+(SETQ $BOOT NIL)
+(SETQ $NBOOT NIL)
+(setq |$interpOnly| nil)
+(SETQ |$testingSystem| NIL)
+(SETQ |$publicSystem| NIL)
+(SETQ |$newcompMode| NIL)
+(SETQ |$newComp| NIL)
+(SETQ |$newCompCompare| NIL)
+(SETQ |$permitWhere| NIL)
+(SETQ |$newSystem| T)
+(SETQ |$noSubsumption| NIL)
+(SETQ |$bootStrapMode| NIL) ;; if true skip functor bodies
+(SETQ |$compileDontDefineFunctions| 'T)
+(SETQ |$compileOnlyCertainItems| NIL)
+(SETQ |$devaluateList| NIL)
+(SETQ |$doNotCompressHashTableIfTrue| NIL)
+(SETQ |$mutableChecking| NIL)	 ; used in DEFINE BOOT
+(SETQ |$mutableDomains| NIL)	 ; checked in DEFINE BOOT
+(SETQ |$maxSignatureLineNumber| 0)
+(SETQ |$functionLocations| NIL)
+(SETQ |$functorLocalParameters| NIL) ; used in compSymbol
+(SETQ /RELEASE '"UNKNOWN")
+(SETQ |$insideCategoryPackageIfTrue| NIL)
+(SETQ |$insideCompileBodyIfTrue| NIL)
+(SETQ |$globalExposureGroupAlist| NIL)
+(SETQ |$localExposureDataDefault|
+  (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL))
+(SETQ |$localExposureData|
+  (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL))
+(SETQ |$compilingInputFile| NIL)
+(SETQ |$minivectorNames| NIL)
+(setq |$ReadingFile| NIL)
+(setq |$NonNullStream| "NonNullStream")
+(setq |$NullStream| "NullStream")
+(setq |$domPvar| nil)
+(defvar $dalymode nil "if true then leading paren implies lisp cmd")
+(setq |$Newline| #\Newline)
+
+
+(setq |$createUpdateFiles| nil)
+
+(SETQ $FUNNAME NIL)   ;; this and next used in COMP,TRAN,1
+(SETQ $FUNNAME_TAIL '(()))
+(SETQ $LASTPREFIX "S:")    ;"default setting"
+(SETQ |$inLispVM| 'T)
+(SETQ $SPAD_ERRORS (VECTOR 0 0 0))
+(SETQ STAKCOLUMN -1)
+(SETQ ECHOMETA NIL)
+(SETQ |$checkParseIfTrue| 'NIL)
+(SETQ |$oldParserExpandAbbrs| NIL)
+(SETQ $DISPLAY NIL)
+(SETQ |S:SPADKEY| NIL) ;" this is augmented by MAKESPADOP"
+(SETQ $OLDLINE NIL)  ;"used to output command lines"
+(SETQ |/EDIT,FT| 'SPAD)
+(SETQ |/EDIT,FM| 'A)
+(SETQ /EDITFILE NIL)
+(SETQ INITCOLUMN 0)
+(SETQ |$functionTable| NIL)
+(SETQ |$spaddefs| NIL)
+(SETQ |$InteractiveMode| T)
+(SETQ |$xeditIsConsole|	 NIL)
+(SETQ |$echoInputLines|	 NIL)	    ;; This is in SETVART also
+(SETQ |$Slot1DataBase| (MAKE-HASHTABLE 'ID))  ;; See NRUNTIME BOOT
+(SETQ |$pfKeysForBrowse|  NIL)
+(SETQ MARG 0)
+  ;" Margin for testing by ?OP"
+(SETQ LCTRUE '|true|)
+(SETQ |$displayParserOutput| 'T)
+
+(SETQ |$insideReadRulesIfTrue| NIL)
+(SETQ |$consistencyCheck| 'T)
+(SETQ |$useUndo| NIL)
+(SETQ |$ruleSetsInitialized| NIL)
+
+;; tell the system not to use the new parser
+(SETQ |$useNewParser| NIL)
+
+(SETQ |$htPrecedenceTable| NIL)
+
+(SETQ |$NRTmakeCompactDirect| NIL)
+(SETQ |$NRTquick| NIL)
+(SETQ |$NRTmakeShortDirect| NIL)
+(SETQ |$newWorld| NIL)
+(SETQ |$returnNowhereFromGoGet| NIL)
+
+(SETQ |$insideCanCoerceFrom| NIL)
+
+(SETQ |$useCoerceOrCroak| T)
+
+(SETQ |$abbreviateJoin| NIL)
+
+(SETQ |$InterpreterMacroAlist|
+      '((|%i| . (|complex| 0 1))
+	(|%e| . (|exp| 1))
+	(|%pi| . (|pi|))
+	(|SF| . (|DoubleFloat|))
+	(|%infinity| . (|infinity|))
+	(|%plusInfinity| . (|plusInfinity|))
+	(|%minusInfinity| . (|minusInfinity|))))
+
+;; variables controlling companion pages (see copage.boot)
+(SETQ |$HTCompanionWindowID| nil)
+(SETQ |$HTPreviousDomain| nil)
+(SETQ |$HTOperationError| nil)
+
+;; Common lisp control variables
+;;(setq *load-verbose* nil)
+(setq *print-array* nil)
+(setq *print-pretty* nil)
+(setq *print-circle* nil)
+
+;; $SYSCOMMANDS is now defined at the top of i-syscmd.boot
+
+(SETQ |$systemCommands| '(
+;;  COMMAND		 USER LEVEL   - )set userlevel
+   (|abbreviations|		     . |compiler|   )
+   (|boot|			     . |development|)
+   (|cd|			     . |interpreter|)
+   (|clear|			     . |interpreter|)
+   (|close|			     . |interpreter|)
+   (|compiler|			     . |compiler|   )
+   (|copyright|			     . |interpreter|)
+   (|credits|			     . |interpreter|)
+   (|display|			     . |interpreter|)
+   (|edit|			     . |interpreter|)
+   (|fin|			     . |development|)
+   (|frame|			     . |interpreter|)
+   (|help|			     . |interpreter|)
+   (|history|			     . |interpreter|)
+;; (|input|			     . |interpreter|)
+   (|lisp|			     . |development|)
+   (|library|			     . |interpreter|)
+   (|load|			     . |interpreter|)
+   (|ltrace|			     . |interpreter|)
+   (|pquit|			     . |interpreter|)
+   (|quit|			     . |interpreter|)
+   (|read|			     . |interpreter|)
+   (|savesystem|		     . |interpreter|)
+   (|set|			     . |interpreter|)
+   (|show|			     . |interpreter|)
+   (|spool|			     . |interpreter|)
+   (|summary|			     . |interpreter|)
+   (|synonym|			     . |interpreter|)
+   (|system|			     . |interpreter|)
+   (|trace|			     . |interpreter|)
+   (|undo|			     . |interpreter|)
+   (|what|			     . |interpreter|)
+   (|with|			     . |interpreter|)
+   (|workfiles|			     . |development|)
+   (|zsystemdevelopment| . |interpreter|)
+ ))
+
+(SETQ |$noParseCommands| '(
+    |boot|
+    |copyright|
+    |credits|
+    |fin|
+    |lisp|
+    |pquit|
+    |quit|
+    |suspend|
+    |synonym|
+    |system|
+    ))
+
+(SETQ |$tokenCommands| '(
+    |abbreviations|
+    |cd|
+    |clear|
+    |close|
+    |compiler|
+    |depends|
+    |display|
+    |edit|
+    |frame|
+    |frame|
+    |help|
+    |history|
+    |input|
+    |library|
+    |load|
+    |ltrace|
+    |read|
+    |savesystem|
+    |set|
+    |spool|
+    |undo|
+    |what|
+    |with|
+    |workfiles|
+    |zsystemdevelopment|
+    ))
+
+(SETQ |S:SPADTOK| 'SPADSYSTOK)
+(SETQ APLMODE NIL)
+(SETQ RLGENSYMFG NIL)
+(SETQ RLGENSYMLST NIL)
+(SETQ XTOKENREADER 'SPADTOK)
+(SETQ |$delimiterTokenList|
+  '(| |	 |)| |(| |{| |}| |[| |]| ENDOFLINECHR EOI EOL |END_LINE|))
+(SETQ |$generalTokenIfTrue| NIL)
+(SETQ OPASSOC NIL)
+(SETQ SPADSYSKEY '(EOI EOL))
+
+(SETQ $cacheAlist NIL)
+(SETQ $streamAlist NIL)
+
+;; following 2 variables are referenced by PREPARSE1
+
+(defvar |$byConstructors| () "list of constructors to be compiled")
+(defvar |$constructorsSeen| () "list of constructors found")
+
+;; These are for the output routines in OUT BOOT
+
+(SETQ $LINELENGTH 77)
+(SETQ $MARGIN 3)
+(SETQ *TALLPAR NIL)
+(SETQ ALLSTAR NIL)
+(SETQ BLANK " ")
+(SETQ COLON ":")
+(SETQ COMMA ",")
+(SETQ DASH "-")
+(SETQ DOLLAR "$")
+(SETQ EQSIGN "=")
+(SETQ LPAR "(")
+(SETQ MATBORCH "*")
+(SETQ PERIOD ".")
+(SETQ PLUSS "+")
+(SETQ RPAR ")")
+(SETQ SLASH "/")
+(SETQ STAR "*")
+(SETQ UNDERBAR "_")
+(SETQ |$fortranArrayStartingIndex| 0)
+
+;; These were originally in INIT LISP
+
+(SETQ |$systemCreation|
+  (STRCONC (SUBSTRING (CURRENTTIME) 0 8) " at "
+	   (SUBSTRING (CURRENTTIME) 8 5)))
+(SETQ |$systemLastChanged| |$systemCreation|)
+
+(SETQ $LISPLIB NIL)
+(SETQ |$dependeeClosureAlist|	    NIL)
+(SETQ |$userModemaps| NIL)
+(SETQ |$forceDatabaseUpdate| NIL)  ;; see "load" function
+(SETQ |$spadSystemDisks|  '(I J K L))
+(SETQ |$functorForm| NIL)
+
+(SETQ |$InitialCommandSynonymAlist| '(
+       (|?|	     . "what commands")
+       (|ap|	     . "what things")
+       (|apr|	     . "what things")
+       (|apropos|    . "what things")
+       (|cache|	     . "set functions cache")
+       (|cl|	     . "clear")
+       (|cls|	     . "zsystemdevelopment )cls")
+       (|cms|	     . "system")
+       (|co|	     . "compiler")
+       (|d|	     . "display")
+       (|dep|	     . "display dependents")
+       (|dependents| . "display dependents")
+       (|e|	     . "edit")
+       (|expose|     . "set expose add constructor")
+       (|fc|	     . "zsystemdevelopment )c")
+       (|fd|	     . "zsystemdevelopment )d")
+       (|fdt|	     . "zsystemdevelopment )dt")
+       (|fct|	     . "zsystemdevelopment )ct")
+       (|fctl|	     . "zsystemdevelopment )ctl")
+       (|fe|	     . "zsystemdevelopment )e")
+       (|fec|	     . "zsystemdevelopment )ec")
+       (|fect|	     . "zsystemdevelopment )ect")
+       (|fns|	     . "exec spadfn")
+       (|fortran|    . "set output fortran")
+       (|h|	     . "help")
+       (|hd|	     . "system hypertex &")
+       (|kclam|	     . "boot clearClams ( )")
+       (|killcaches| . "boot clearConstructorAndLisplibCaches ( )")
+       (|patch|	     . "zsystemdevelopment )patch")
+       (|pause|	     . "zsystemdevelopment )pause")
+       (|prompt|     . "set message prompt")
+       (|recurrence| . "set functions recurrence")
+       (|restore|    . "history )restore")
+       (|save|	     . "history )save")
+       (|startGraphics|    .  "system $AXIOM/lib/viewman &")
+       (|startNAGLink|     .  "system $AXIOM/lib/nagman &")
+       (|stopGraphics|     .  "lisp (|sockSendSignal| 2 15)")
+       (|stopNAGLink|      .  "lisp (|sockSendSignal| 8 15)")
+       (|time|	     . "set message time")
+       (|type|	     . "set message type")
+       (|unexpose|   . "set expose drop constructor")
+       (|up|	     . "zsystemdevelopment )update")
+       (|version|    . "lisp *yearweek*")
+       (|w|	     . "what")
+       (|wc|	     . "what categories")
+       (|wd|	     . "what domains")
+       (|who|        . "lisp (pprint credits)")
+       (|wp|	     . "what packages")
+       (|ws|	     . "what synonyms")
+))
+
+(SETQ |$CommandSynonymAlist| (COPY |$InitialCommandSynonymAlist|))
+
+(SETQ |$spadLibFT| 'LISPLIB)
+
+(SETQ |$existingFiles| (MAKE-HASHTABLE 'UEQUAL))
+(SETQ |$updateCatTableIfTrue| 'T)
+
+(SETQ |$ConstructorCache| (MAKE-HASHTABLE 'ID))
+(SETQ |$instantRecord| (MAKE-HASHTABLE 'ID))
+(SETQ |$immediateDataSymbol| '|--immediateData--|)
+
+(SETQ |$useIntegerSubdomain| 'T)
+(SETQ |$useNewFloat| 'T)
+
+;; Directories/disks on which to place various kinds of files
+(SETQ |$libraryDirectory| 'A)
+(SETQ |$listingDirectory| 'A)
+
+;; See CLAMMED BOOT for defs of following functions
+(SETQ |$clamList| '(
+  (|canCoerce| |hash| UEQUAL |count|)
+  (|canCoerceFrom| |hash| UEQUAL |count|)
+  (|coerceConvertMmSelection| |hash| UEQUAL |count|)
+; (|getModemapsFromDatabase| |hash| UEQUAL |count|)
+; (|getOperationAlistFromLisplib| |hash| UEQUAL |count|)
+  (|hasFileProperty| |hash| UEQUAL |count|)
+  (|isLegitimateMode| |hash| UEQUAL |count|)
+  (|isValidType| |hash| UEQUAL |count|)
+  (|resolveTT|	 |hash| UEQUAL |count|)
+  (|selectMms1| |hash| UEQUAL |count|)
+  (|underDomainOf|   |hash| UEQUAL |count|)
+;  (|isSubDomain|   |hash| UEQUAL |count|)
+))
+
+;; following is symbol denoting a failed operation
+(SETQ |$failure| (GENSYM))
+;; the following symbol holds the canonical "failed" value
+(SETQ |$failed| "failed")
+
+(SETQ |$constructorDataTable| NIL)
+
+(SETQ |$underDomainAlist| '())
+;;(SETQ |$underDomainAlist| '(
+;;  (|DistributedMultivariatePolynomial| . 2)
+;;  (|MultivariatePolynomial| . 2)
+;;  (|NewDistributedMultivariatePolynomial| . 2)
+;;  (|RectangularMatrix| . 3)
+;;  (|SquareMatrix| . 2)
+;;  (|UnivariatePoly| . 2)
+;;  (|VVectorSpace| . 2)
+;;))
+
+(SETQ |$univariateDomains| '(
+    |UnivariatePolynomial|
+    |UnivariateTaylorSeries|
+    |UnivariateLaurentSeries|
+    |UnivariatePuiseuxSeries|
+    ))
+(SETQ |$multivariateDomains| '(
+    |MultivariatePolynomial|
+    |DistributedMultivariatePolynomial|
+    |HomogeneousDistributedMultivariatePolynomial|
+    |GeneralDistributedMultivariatePolynomial|
+    ))
+
+(SETQ |$Primitives| '(|Union| |Mapping| |Record| |Enumeration|))
+
+(SETQ |$DomainsWithoutLisplibs| '(
+  CAPSULE |Union| |Record| |SubDomain| |Mapping| |Enumeration| |Domain| |Mode|))
+
+(SETQ |$letAssoc| NIL)
+	;" used for trace of assignments in SPAD code -- see macro LETT"
+(SETQ |$useDCQnotLET| NIL)	;; use DCQs for destructuring := patterns
+(SETQ |$QuickCode| T)
+	 ;" controls generation of QREFELT etc."
+(SETQ |$QuickLet| T)
+	 ;" controls generation of LET tracing."
+(SETQ |$lastUntraced| NIL)
+ ;" used for )restore option of )trace."
+(SETQ |$mathTraceList| NIL)
+	 ;" controls mathprint output for )trace."
+(SETQ |$domainTraceNameAssoc| NIL)
+	;"alist of traced domains"
+(SETQ |$tracedMapSignatures| ())
+(SETQ |$highlightAllowed| 'T)
+	 ;" used in BRIGHTPRINT and is a )set variable"
+
+(SETQ |$leftPren| "(")    ;;[for use in SAY expressions]
+(SETQ |$rightPren| ")")
+
+(SETQ |$abbreviationTable| NIL)
+
+(SETQ |$ConstructorNames| '(
+  |SubDomain| |List| |Union| |Record| |Vector|
+      ))
+	   ;" Used in isFunctor test, and compDefine "
+
+(SETQ |$SpecialDomainNames| '(
+  |add| CAPSULE |SubDomain| |List| |Union| |Record| |Vector|
+      ))
+		 ;" Used in isDomainForm, addEmptyCapsuleIfnecessary"
+
+(SETQ |$DomainNames| '(
+   |Integer| |Float| |Symbol| |Boolean| |String| |Expression|
+   |Mapping| |SubDomain| |List| |Union| |Record| |Vector| |Enumeration|
+      ))
+
+(SETQ |$CategoryNames| '(
+   |Category| |CATEGORY| |RecordCategory| |Join| |EnumerationCategory|
+   |StringCategory| |SubsetCategory| |UnionCategory|
+      ))
+
+(|SETQ| |$BasicDomains| '(|Integer| |Float| |Symbol| |Boolean| |String|))
+
+(SETQ |$PrintCompilerMessagesIfTrue| NIL)
+(SETQ |$printStorageIfTrue| NIL) ;; storage info disabled in common lisp
+(SETQ |$mostRecentOpAlist| NIL)
+(SETQ |$noEnv| NIL)
+(SETQ |$croakIfTrue| NIL) ;" see moan in UT"
+(SETQ |$opFilter| NIL)	 ;" used to |/s a function "
+(SETQ |$evalDomain| NIL)
+
+(SETQ |$SideEffectFreeFunctionList| '(
+  |null| |case| |Zero| |One| \: |::| |has| |Mapping|
+  |elt| = |>| |>=| |<| |<=| MEMBER |is| |isnt| ATOM
+  $= |$>| |$>=| |$<| |$<=| $^= $MEMBER
+))
+
+(SETQ |$AnonymousFunction| '(|AnonymousFunction|))
+(SETQ |$Any|   '(|Any|))
+(SETQ |$BFtag| '|:BF:|)
+(SETQ |$Boolean| '(|Boolean|))
+(SETQ |$Category| '(|Category|))
+(SETQ |$Domain| '(|Domain|))
+(SETQ |$Exit|  '(|Exit|))
+(SETQ |$Expression| '(|OutputForm|))
+
+(SETQ |$OutputForm| '(|OutputForm|))
+(SETQ |$BigFloat| '(|Float|))
+(SETQ |$Float| '(|Float|))
+(SETQ |$DoubleFloat| '(|DoubleFloat|))
+
+(SETQ |$FontTable| '(|FontTable|))
+(SETQ |$Integer| '(|Integer|))
+(SETQ |$ComplexInteger| (LIST '|Complex| |$Integer|))
+(SETQ |$Mode|	'(|Mode|))
+(SETQ |$NegativeInteger| '(|NegativeInteger|))
+(SETQ |$NonNegativeInteger| '(|NonNegativeInteger|))
+(SETQ |$NonPositiveInteger| '(|NonPositiveInteger|))
+(SETQ |$PositiveInteger| '(|PositiveInteger|))
+(SETQ |$RationalNumber| '(|Fraction| (|Integer|)))
+(SETQ |$String| '(|String|))
+(SETQ |$StringCategory| '(|StringCategory|))
+(SETQ |$Symbol| '(|Symbol|))
+(SETQ |$Void|  '(|Void|))
+(SETQ |$QuotientField| '|Fraction|)
+(SETQ |$FunctionalExpression| '|Expression|)
+(SETQ |$defaultFunctionTargets| '(()))
+
+;; Old names
+(SETQ |$SmallInteger| '(|SingleInteger|))
+
+;; New Names
+(SETQ |$SingleFloat| '(|SingleFloat|))
+(SETQ |$DoubleFloat| '(|DoubleFloat|))
+(SETQ |$SingleInteger| '(|SingleInteger|))
+
+(SETQ $TOP_LEVEL T)
+(SETQ $NE (LIST (LIST NIL)))
+(SETQ |$InteractiveFrame| (LIST (LIST NIL)))
+(SETQ |$gauss01| '(|gauss| 0 1))
+(SETQ |$LocalFrame| (LIST (LIST NIL)))
+(SETQ |$DomainsInScope| (LIST NIL))
+(SETQ |$EmptyEnvironment| '((NIL)))
+(SETQ |$NETail| (CONS |$EmptyEnvironment| NIL))
+(SETQ |$EmptyMode| '|$EmptyMode|)
+(SETQ |$DummyFunctorNames| '(|Mapping|))
+(SETQ |$form| NIL)
+(SETQ |$DoubleQuote| '"\"")
+(SETQ |$EmptyString| "")
+(SETQ |$EmptyVector| (VECTOR))
+(SETQ |$EmptyList| ())
+(SETQ |$Index| 0)
+(SETQ |$true| ''T)
+(SETQ |$false| NIL)
+(SETQ |$suffix| NIL)
+(SETQ |$BasicPredicates| '(INTEGERP STRINGP FLOATP))
+(SETQ |$coerceIntByMapCounter| 0)
+(SETQ |$reportCoerce| NIL)
+(SETQ |$reportCompilation| NIL)
+(SETQ |$streamCount| 0)
+(SETQ |$cacheCount| 0)
+(SETQ |$streamIndexing| NIL)
+(SETQ |$reportExitModeStack| NIL)
+(SETQ |$prefix| NIL)
+(SETQ |$Polvar| '(WRAPPED . ((1 . 1))))
+(SETQ |$OneCoef| '(1 1 . 1))
+(SETQ |$Lisp| '(|Lisp|))
+(SETQ |$ExpressionOpt| '(|Expression| . OPT))
+(SETQ |$formalArgList| ())
+(SETQ |$FormalMapVariableList|
+  '(|#1| |#2| |#3| |#4| |#5| |#6| |#7| |#8| |#9| |#10|
+    |#11| |#12| |#13| |#14| |#15| |#16| |#17| |#18| |#19| |#20|
+    |#21| |#22| |#23| |#24| |#25| |#26| |#27| |#28| |#29| |#30|
+    |#31| |#32| |#33| |#34| |#35| |#36| |#37| |#38| |#39| |#40|
+    |#41| |#42| |#43| |#44| |#45| |#46| |#47| |#48| |#49| |#50|
+    ))
+(SETQ |$PatternVariableList|
+  '(*1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 *12 *13 *14 *15 *16 *17 *18 *19 *20
+  *21 *22 *23 *24 *25 *26 *27 *28 *29 *30 *31 *32 *33 *34 *35 *36 *37 *38 *39 *40
+  *41 *42 *43 *44 *45 *46 *47 *48 *49 *50))
+(SETQ |$ModeVariableList|
+  '(dv$1 dv$2 dv$3 dv$4 dv$5 dv$6 dv$7 dv$8 dv$9 dv$10 dv$11 dv$12 dv$13 dv$14 dv$15
+	 dv$16 dv$17 dv$18 dv$19 dv$20))
+(SETQ |$DomainVariableList|
+  '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12 $13 $14 $15 $16 $17 $18 $19 $20))
+(SETQ |$TriangleVariableList|
+   '(|t#1| |t#2| |t#3| |t#4| |t#5| |t#6| |t#7| |t#8| |t#9| |t#10|
+     |t#11| |t#12| |t#13| |t#14| |t#15| |t#16| |t#17| |t#18| |t#19| |t#20|
+     |t#21| |t#22| |t#23| |t#24| |t#25| |t#26| |t#27| |t#28| |t#29| |t#30|
+     |t#31| |t#32| |t#33| |t#34| |t#35| |t#36| |t#37| |t#38| |t#39| |t#40|
+     |t#41| |t#42| |t#43| |t#44| |t#45| |t#46| |t#47| |t#48| |t#49| |t#50|))
+
+(SETQ |$PrimitiveDomainNames|
+      '(|List| |Integer| |NonNegativeInteger| |PositiveInteger|
+	|SingleInteger| |String| |Boolean|))
+	    ;" used in mkCategory to avoid generating vector slots"
+	    ;" for primitive domains "
+	    ;" also used by putInLocalDomainReferences and optCall"
+(SETQ |$optimizableConstructorNames|
+   '(|List| |Integer| |PositiveInteger| |NonNegativeInteger| |SingleInteger|
+     |String| |Boolean| |Symbol| |DoubleFloat| |PrimitiveArray| |Vector|))
+	    ;" used by optCallSpecially"
+(SETQ |$Zero| '(|Zero|))
+(SETQ |$One| '(|One|))
+(SETQ |$NonMentionableDomainNames|
+      '($ |Rep| |Record| |Union| |Mapping| |Enumeration|))
+
+;"  modemap:==  ( <map> (p e) (p e) ... (p e) )  "
+;"  modemaplist:= ( modemap ... )  "
+(SETQ |$CategoryFrame| '(((
+  (|Category| .
+    ((|modemap|
+      ( ((|Category|) (|Category|)) (T *) )
+	)))
+  (|Join| .
+    ((|modemap|
+      ( ((|Category|) (|Category|) (|Category|) (|Category|)) (|T| *) )
+      ( ((|Category|) (|Category|) (|List| (|Category|)) (|Category|)) (T *) )
+	)))
+    ))))
+
+(SETQ |$InitialDomainsInScope|
+  '(|$EmptyMode| |$NoValueMode|))
+
+(SETQ |$InitialModemapFrame| '((NIL)))
+
+(SETQ NRTPARSE NIL)
+(SETQ |$NRTflag| T)
+(SETQ |$NRTaddForm| NIL)
+(SETQ |$NRTdeltaList| NIL)
+(SETQ |$NRTbase| 0)
+(SETQ |$NRTdeltaLength| 0)
+(SETQ |$NRTopt| NIL) ;; turns off buggy code
+(SETQ |$Slot1DataBase| NIL)
+(SETQ |$NRTmonitorIfTrue| NIL)
+
+(SETQ |$useConvertForCoercions| NIL)
+
+(MAKEPROP '|One| '|defaultType| |$Integer|)
+(MAKEPROP '|Zero| '|defaultType| |$Integer|)
+
+;; Following were originally in EXPLORE BOOT
+
+(SETQ |$xdatabase|	   NIL)
+(SETQ |$CatOfCatDatabase|  NIL)
+(SETQ |$DomOfCatDatabase|  NIL)
+(SETQ |$JoinOfDomDatabase| NIL)
+(SETQ |$JoinOfCatDatabase| NIL)
+(SETQ |$attributeDb|	   NIL)
+
+(SETQ |$abbreviateIfTrue|  NIL)
+(SETQ |$deltax|	 0)
+(SETQ |$deltay|	 0)
+(SETQ |$displayDomains|	 'T)
+(SETQ |$displayTowardAncestors|	 NIL)
+(SETQ |$focus|	NIL)
+(SETQ |$focusAccessPath|  NIL)
+(SETQ |$minimumSeparation|  3)
+(SETQ |$origMaxColumn|	80)
+(SETQ |$origMaxRow|  20)
+(SETQ |$origMinColumn|	1)
+(SETQ |$origMinRow|  1)
+
+;; ---- start of initial settings for variables used in test.boot
+
+(SETQ |$testOutputLineFlag| NIL)   ;; referenced by charyTop, prnd
+				   ;; to stash lines
+(SETQ |$testOutputLineStack| NIL)  ;; saves lines to be printed
+				   ;; (needed to convert lines for use
+				   ;; in hypertex)
+(SETQ |$runTestFlag| NIL)	   ;; referenced by maPrin to stash
+				   ;; output by recordAndPrint to not
+				   ;; print type/time
+(SETQ |$mkTestFlag| NIL)	   ;; referenced by READLN to stash input
+				   ;; by maPrin to stash output
+				   ;; by recordAndPrint to write i/o
+				   ;; onto $testStream
+(SETQ |$mkTestInputStack| NIL)	   ;; saves input for $testStream
+				   ;; (see READLN)
+(SETQ |$mkTestOutputStack| NIL)	   ;; saves output for $testStream
+				   ;; (see maPrin)
+
+;; ---- end of initial settings for variables used in test.boot
+
+;; Next flag determines whether to use BF as default floating point
+;; type. (actually, now means NewFloat)
+
+(SETQ |$useBFasDefault| 'T)
+
+;; Next are initial values for fluid variables in G-BOOT BOOT
+
+(SETQ |$inDefLET| NIL)
+(SETQ |$inDefIS|  NIL)
+(SETQ |$letGenVarCounter| 1)
+(SETQ |$isGenVarCounter|  1)
+
+;; Next 2 lines originally from CLAM BOOT
+
+;; this node is used in looking up values
+(SETQ |$hashNode| (LIST NIL))
+
+(SETQ ERRORINSTREAM (DEFIOSTREAM
+    '((DEVICE . CONSOLE) (MODE . INPUT) (QUAL . T)) 133 1))
+
+(SETQ ERROROUTSTREAM
+  (DEFIOSTREAM '((DEVICE . CONSOLE)(MODE . OUTPUT)) 80 0) )
+
+(SETQ |$algebraOutputStream|
+  (DEFIOSTREAM '((DEVICE . CONSOLE)(MODE . OUTPUT)) 255 0) )
+
+;; By default, don't generate info files with old compiler.
+(setq |$profileCompiler| nil)
+
+(setq credits '(
+"An alphabetical listing of contributors to AXIOM (to October, 2006):"
+"Cyril Alberga          Roy Adler              Christian Aistleitner"
+"Richard Anderson       George Andrews"
+"Henry Baker            Stephen Balzac         Yurij Baransky"
+"David R. Barton        Gerald Baumgartner     Gilbert Baumslag"
+"Fred Blair             Vladimir Bondarenko    Mark Botch"
+"Alexandre Bouyer       Peter A. Broadbery     Martin Brock"
+"Manuel Bronstein       Florian Bundschuh      Luanne Burns"
+"William Burge"
+"Quentin Carpent        Robert Caviness        Bruce Char"
+"Cheekai Chin           David V. Chudnovsky    Gregory V. Chudnovsky"
+"Josh Cohen             Christophe Conil       Don Coppersmith"
+"George Corliss         Robert Corless         Gary Cornell"
+"Meino Cramer           Claire Di Crescenzo"
+"Timothy Daly Sr.       Timothy Daly Jr.       James H. Davenport"
+"Jean Della Dora        Gabriel Dos Reis       Michael Dewar"
+"Claire DiCrescendo     Sam Dooley             Lionel Ducos"
+"Martin Dunstan         Brian Dupee            Dominique Duval"
+"Robert Edwards         Heow Eide-Goodman      Lars Erickson"
+"Richard Fateman        Bertfried Fauser       Stuart Feldman"
+"Brian Ford             Albrecht Fortenbacher  George Frances"
+"Constantine Frangos    Timothy Freeman        Korrinn Fu"
+"Marc Gaetano           Rudiger Gebauer        Kathy Gerber"
+"Patricia Gianni        Holger Gollan          Teresa Gomez-Diaz"
+"Laureano Gonzalez-Vega Stephen Gortler        Johannes Grabmeier"
+"Matt Grayson           James Griesmer         Vladimir Grinberg"
+"Oswald Gschnitzer      Jocelyn Guidry"
+"Steve Hague            Vilya Harvey           Satoshi Hamaguchi"
+"Martin Hassner         Waldek Hebisch         Ralf Hemmecke"
+"Henderson              Antoine Hersen"
+"Pietro Iglio"
+"Richard Jenks"
+"Kai Kaminski           Grant Keady            Tony Kennedy"
+"Paul Kosinski          Klaus Kusche           Bernhard Kutzler"
+"Larry Lambe            Frederic Lehobey       Michel Levaud"
+"Howard Levy            Rudiger Loos           Michael Lucks"
+"Richard Luczak"
+"Camm Maguire           Bob McElrath           Michael McGettrick"
+"Ian Meikle             David Mentre           Victor S. Miller"
+"Gerard Milmeister      Mohammed Mobarak       H. Michael Moeller"
+"Michael Monagan        Marc Moreno-Maza       Scott Morrison"
+"Mark Murray"
+"William Naylor         C. Andrew Neff         John Nelder"
+"Godfrey Nolan          Arthur Norman          Jinzhong Niu"
+"Michael O'Connor       Kostas Oikonomou"
+"Julian A. Padget       Bill Page              Susan Pelzel"
+"Michel Petitot         Didier Pinchon         Jose Alfredo Portes"
+"Claude Quitte"
+"Norman Ramsey          Michael Richardson     Renaud Rioboo"
+"Jean Rivlin            Nicolas Robidoux       Simon Robinson"
+"Michael Rothstein      Martin Rubey"
+"Philip Santas          Alfred Scheerhorn      William Schelter"
+"Gerhard Schneider      Martin Schoenert       Marshall Schor"
+"Frithjof Schulze       Fritz Schwarz          Nick Simicich"
+"William Sit            Elena Smirnova         Jonathan Steinbach"
+"Christine Sundaresan   Robert Sutor           Moss E. Sweedler"
+"Eugene Surowitz"
+"James Thatcher         Balbir Thomas          Mike Thomas"
+"Dylan Thurston         Barry Trager           Themos T. Tsikas"
+"Gregory Vanuxem"
+"Bernhard Wall          Stephen Watt           Jaap Weel"
+"Juergen Weiss          M. Weller              Mark Wegman"
+"James Wen              Thorsten Werther       Michael Wester"
+"John M. Wiley          Berhard Will           Clifton J. Williamson"
+"Stephen Wilson         Shmuel Winograd        Robert Wisbauer"
+"Sandra Wityak          Waldemar Wiwianka      Knut Wolf"
+"Clifford Yapp          David Yun"
+"Richard Zippel         Evelyn Zoernack        Bruno Zuercher"
+"Dan Zwillinger"
+))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/setvars.boot.pamphlet b/src/interp/setvars.boot.pamphlet
new file mode 100644
index 00000000..2f89c6d5
--- /dev/null
+++ b/src/interp/setvars.boot.pamphlet
@@ -0,0 +1,1829 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp setvars.boot}
+\author{The Axiom Team}
+
+\begin{document}
+
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{Top level function calling conventions}
+Conventions:
+\begin{list}{}
+\item when called with argument "\%initialize", a function will
+set the appropriate variables to their default states.
+\item when called with argument "\%display\%", a function will return a
+current state information suitable for sayBrightly
+\item when called with argument "\%describe\%", a function will print
+a description of itself and any conditions it imposes.
+\item otherwise, a function may interpret its arguments as it sees
+appropriate.
+\end{list}
+Also by convention each top level function named in the FUNCTION 
+slot (see the data structure in setvart.boot.pamphlet\cite{1}) has an
+associated describe function. Thus, for example,
+setOutputFortran is accompanied by function to describe 
+its arguments, such as describeSetOutputFortran.
+\section{Top level set functions}
+The {\bf set} function in this file handles the top level {\bf )set}
+command line functions.
+<<toplevelsetfunctions>>=
+<<initializeSetVariables>>
+<<resetWorkspaceVariables>>
+<<translateYesNo2TrueFalse>>
+<<translateTrueFalse2YesNo>>
+<<set>>
+<<set1>>
+<<displaySetOptionInformation>>
+<<displaySetVariableSettings>>
+@
+\section{initializeSetVariables}
+<<initializeSetVariables>>=
+initializeSetVariables (setTree) ==
+  -- this function passes through the table of set variable information
+  -- and initializes the variables to their default definitions.
+  for setData in setTree repeat
+    st := setData.setType
+    st = 'FUNCTION =>
+      -- here setVar is really the name of a function to call
+      if functionp(setData.setVar)
+        then FUNCALL( setData.setVar,"%initialize%")
+        else sayMSG '"   Function not implemented."
+    st = 'INTEGER  =>
+      SET(setData.setVar, setData.setDef)
+    st = 'STRING  =>
+      SET(setData.setVar, setData.setDef)
+    st = 'LITERALS =>
+      SET(setData.setVar, translateYesNo2TrueFalse setData.setDef)
+    st = 'TREE =>
+      initializeSetVariables(setData.setLeaf)
+
+@
+\subsection{resetWorkspaceVariables}
+<<resetWorkspaceVariables>>=
+resetWorkspaceVariables () ==
+  -- this replaces def in DEBUG LISP
+  -- this function resets many workspace variables to their default
+  -- values. Some things are reset by start and not reset by restart.
+  SETQ(_/COUNTLIST                  , NIL)
+  SETQ(_/EDITFILE                   , NIL)
+  SETQ(_/SOURCEFILES                , NIL)
+  SETQ($sourceFiles                 , NIL)
+  SETQ(_/PRETTY                     , NIL)
+  SETQ(_/SPACELIST                  , NIL)
+  SETQ(_/TIMERLIST                  , NIL)
+  SETQ($existingFiles               , MAKE_-HASHTABLE 'UEQUAL)
+  SETQ($functionTable               , NIL)
+  SETQ($BOOT                        , NIL)
+  SETQ($compileMapFlag              , NIL)
+  SETQ($echoLineStack               , NIL)
+  SETQ($operationNameList           , NIL)
+  SETQ($slamFlag                    , NIL)
+  SETQ($CommandSynonymAlist         , COPY($InitialCommandSynonymAlist))
+  SETQ($UserAbbreviationsAlist      , NIL)
+  SETQ($msgAlist                    , NIL)
+  SETQ($msgDatabase                 , NIL)
+  SETQ($msgDatabaseName             , NIL)
+  SETQ($dependeeClosureAlist        , NIL)
+  SETQ($IOindex                     , 1  )
+  SETQ($coerceIntByMapCounter       , 0  )
+  SETQ($e                           , [[NIL]])
+  SETQ($env                         , [[NIL]])
+
+  -- many variables set by the following
+
+  initializeSetVariables($setOptions)
+
+@
+\subsection{translateYesNo2TrueFalse}
+<<translateYesNo2TrueFalse>>=
+translateYesNo2TrueFalse x ==
+  x in '(yes on) => true
+  x in '(no off)  => false
+  x
+
+@
+\subsection{translateTrueFalse2YesNo}
+<<translateTrueFalse2YesNo>>=
+translateTrueFalse2YesNo x ==
+  x = true  => 'on
+  x = false => 'off
+  x
+
+@
+\subsection{set}
+<<set>>=
+set l ==  set1(l, $setOptions)
+
+@
+\subsection{set1}
+<<set1>>=
+set1(l,setTree) ==
+  null l => displaySetVariableSettings(setTree,"")
+  $setOptionNames : local := [x.0 for x in setTree]
+  arg := selectOption(DOWNCASE CAR l,$setOptionNames,'optionError)
+  setData := [arg,:LASSOC(arg,setTree)]
+
+  -- check is the user is authorized for the set variable
+  null satisfiesUserLevel setData.setLevel =>
+    sayKeyedMsg("S2IZ0007",[$UserLevel,'"set option"])
+
+  1 = #l => displaySetOptionInformation(arg,setData)
+  st := setData.setType
+
+  st = 'FUNCTION =>
+    -- allow the user to set the default
+    setfunarg :=
+      l.1 = 'DEFAULT => "%initialize%"
+--    (arg2 := selectOption(l.1,['default],nil)) => "%initialize%"
+      KDR l
+    if functionp(setData.setVar)
+      then FUNCALL( setData.setVar,setfunarg)
+      else sayMSG '"   Function not implemented."
+    -- if so set, then show option information
+    if $displaySetValue then displaySetOptionInformation(arg,setData)
+    NIL
+
+  st = 'STRING   =>
+    arg2 := l.1
+    if arg2 = 'DEFAULT
+      then SET(setData.setVar, setData.setDef)
+      else if arg2 then SET(setData.setVar, arg2)
+    -- if so set or not a valid choice, then show option information
+    if $displaySetValue or (null arg2) then
+      displaySetOptionInformation(arg,setData)
+    NIL
+
+  st = 'INTEGER  =>
+    -- validate the option, allowing the user to set the default
+    arg2 :=
+      num := l.1
+      (FIXP num) and (num >= (setData.setLeaf).0) and
+        (null (upperlimit := setData.setLeaf.1) or num <= upperlimit) => num
+      selectOption(l.1,['default,:setData.setLeaf],nil)
+    if arg2 = 'DEFAULT
+      then SET(setData.setVar, setData.setDef)
+      else if arg2 then SET(setData.setVar, arg2)
+    -- if so set or not a valid choice, then show option information
+    if $displaySetValue or (null arg2) then
+      displaySetOptionInformation(arg,setData)
+    null arg2 => sayMessage ['" Your value",:bright object2String l.1,
+        '"is not among the valid choices."]
+    NIL
+
+  st = 'LITERALS =>
+    -- validate the option, allowing the user to set the default
+    if (arg2 := selectOption(l.1,['default,:setData.setLeaf],nil)) then
+      if arg2 = 'DEFAULT
+        then SET(setData.setVar, translateYesNo2TrueFalse setData.setDef)
+        else
+          if arg2 = 'nobreak then
+             USE_-FAST_-LINKS 'T
+          if arg2 = 'fastlinks then
+             USE_-FAST_-LINKS 'NIL
+             arg2 := 'break
+          SET(setData.setVar, translateYesNo2TrueFalse arg2)
+    -- if so set or not a valid choice, then show option information
+    if $displaySetValue or (null arg2) then
+      displaySetOptionInformation(arg,setData)
+    null arg2 => sayMessage ['" Your value",:bright object2String l.1,
+        '"is not among the valid choices."]
+    NIL
+
+  -- for a sub-tree, we must recurse
+  st = 'TREE =>
+    set1(KDR l,setData.setLeaf)
+    NIL
+  sayMessage ['"Cannot handle set tree node type",:bright st,"yet"]
+  NIL
+
+@
+\subsection{displaySetOptionInformation}
+<<displaySetOptionInformation>>=
+displaySetOptionInformation(arg,setData) ==
+  st := setData.setType
+  -- if the option is a sub-tree, show the full menu
+  st = 'TREE =>
+    displaySetVariableSettings(setData.setLeaf,setData.setName)
+
+  -- otherwise we want to show the current setting
+  centerAndHighlight (STRCONC('"The ",object2String arg,'" Option"),
+                      $LINELENGTH,specialChar 'hbar)
+  sayBrightly ['%l,:bright '"Description:",setData.setLabel]
+
+  st = 'FUNCTION =>
+    TERPRI()
+    if functionp(setData.setVar)
+      then FUNCALL(setData.setVar,"%describe%")
+      else sayMSG '"   Function not implemented."
+
+  st = 'INTEGER  =>
+    sayMessage ['" The",:bright arg,'"option",
+      '" may be followed by an integer in the range",
+       :bright (setData.setLeaf).0,'"to",'%l,
+        :bright (setData.setLeaf).1,'"inclusive.",
+         '" The current setting is",:bright eval setData.setVar]
+
+  st = 'STRING  =>
+    sayMessage ['" The",:bright arg,'"option",
+      '" is followed by a string enclosed in double quote marks.", '%l,
+         '" The current setting is",:bright ["_"",eval setData.setVar, "_""]]
+
+  st = 'LITERALS =>
+    sayMessage ['" The",:bright arg,'"option",
+      '" may be followed by any one of the following:"]
+    current := translateTrueFalse2YesNo eval setData.setVar
+    for name in setData.setLeaf repeat
+      if name = current
+        then sayBrightly ['" ->",:bright object2String name]
+        else sayBrightly ['"    ",object2String name]
+    sayMessage '" The current setting is indicated within the list."
+    if (setData.setLeaf = '(yes no on off)) or
+      (setData.setLeaf = '(yes no on off long)) then
+       sayMessage [:bright '"yes",'"and",:bright '"no",
+        '"have the same effect as",:bright '"on",'"and",:bright '"off",
+          '"respectively."]
+
+@
+\subsection{displaySetVariableSettings}
+<<displaySetVariableSettings>>=
+displaySetVariableSettings(setTree,label) ==
+  if label = "" then label := '")set"
+    else label := STRCONC('" ",object2String label,'" ")
+  centerAndHighlight(STRCONC('"Current Values of ",label,
+    '" Variables"),$LINELENGTH," ")
+  TERPRI()
+  sayBrightly ["Variable     ",
+               "Description                                ",
+                 "Current Value"]
+  SAY fillerSpaces($LINELENGTH,specialChar 'hbar)
+  subtree := nil
+  for setData in setTree repeat
+    null satisfiesUserLevel setData.setLevel => nil
+    setOption := object2String setData.setName
+    setOption := STRCONC(setOption,fillerSpaces(13-#setOption,'" "),
+                         setData.setLabel)
+    setOption := STRCONC(setOption,fillerSpaces(55-#setOption,'" "))
+    st := setData.setType
+    st = 'FUNCTION =>
+      opt :=
+        functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%")
+        '"unimplemented"
+      if PAIRP opt then opt := [:[o,'" "] for o in opt]
+      sayBrightly concat(setOption,'%b,opt,'%d)
+    st = 'STRING   =>
+      opt := object2String eval setData.setVar
+      sayBrightly [setOption,:bright opt]
+    st = 'INTEGER  =>
+      opt := object2String eval setData.setVar
+      sayBrightly [setOption,:bright opt]
+    st = 'LITERALS =>
+      opt := object2String translateTrueFalse2YesNo eval setData.setVar
+      sayBrightly [setOption,:bright opt]
+    st = 'TREE     =>
+      sayBrightly [setOption,:bright '"..."]
+      subtree := true
+      subname := object2String setData.setName
+  TERPRI()
+  subtree =>
+    sayBrightly ['"Variables with current values of",:bright '"...",
+      '"have further sub-options. For example,"]
+    sayBrightly ['"issue",:bright '")set ",subname,
+      '" to see what the options are for",:bright subname,'".",'%l,
+        '"For more information, issue",:bright '")help set",'"."]
+
+@
+\section{compiler}
+See the section compiler in setvart.boot.pamphlet\cite{1}.
+\begin{verbatim}
+                  Current Values of  compiler  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+output       library in which to place compiled code     
+input        controls libraries from which to load compiled code  
+args         arguments for compiling AXIOM code         
+             -O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete 
+             -DAxiom -Y $AXIOM/algebra 
+
+\end{verbatim}
+<<compilerCode>>=
+<<setAsharpArgs>>
+<<describeAsharpArgs>>
+<<setInputLibrary>>
+<<setOutputLibrary>>
+<<describeOutputLibraryArgs>>
+<<describeInputLibraryArgs>>
+@
+\subsection{setAsharpArgs}
+<<setAsharpArgs>>=
+setAsharpArgs arg ==
+  arg = "%initialize%" =>
+    $asharpCmdlineFlags := '"-O -Fasy -Fao -Flsp -laxiom -Mno-AXL__W__WillObsolete -DAxiom -Y $AXIOM/algebra"
+  arg = "%display%" =>
+    $asharpCmdlineFlags
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeAsharpArgs()
+  $asharpCmdlineFlags := first(arg)
+
+@
+\subsection{describeAsharpArgs}
+<<describeAsharpArgs>>=
+describeAsharpArgs() ==
+  sayBrightly LIST (
+   '%b,'")set compiler args ",'%d,_
+   '"is used to tell AXIOM how to invoke the library compiler ",'%l,_
+   '" when compiling code for AXIOM.",'%l,_
+   '" The args option is followed by a string enclosed in double quotes.",'%l,'%l,_
+   '" The current setting is",'%l,'%b,'"_"",$asharpCmdlineFlags,'"_"",'%d)
+
+@
+\subsection{setInputLibrary}
+<<setInputLibrary>>=
+setInputLibrary arg ==
+  arg = "%initialize%" =>
+   true
+  arg = "%display%" =>
+   [LIBRARY_-NAME(u) for u in INPUT_-LIBRARIES]
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeInputLibraryArgs()
+  arg is [act, filename] and (act := selectOptionLC(act,'(add drop),nil)) =>
+    act = 'add => addInputLibrary TRUENAME STRINGIMAGE filename
+    act = 'drop => dropInputLibrary TRUENAME STRINGIMAGE filename
+  setInputLibrary NIL
+
+@
+\subsection{setOutputLibrary}
+<<setOutputLibrary>>=
+setOutputLibrary arg ==
+  -- Hack to avoid initialising libraries in KCL:
+  not $cclSystem => false
+  arg = "%initialize%" =>
+    $outputLibraryName := nil
+  arg = "%display%" =>
+    $outputLibraryName or '"user.lib" 
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeOutputLibraryArgs()
+  not ONEP(#arg) => setOutputLibrary nil
+  -- If the file already exists then use the complete pathname to help
+  -- keep track of it in the case the user issues )cd commands.
+  if FILEP (fn := STRINGIMAGE first arg) then fn := TRUENAME fn
+  openOutputLibrary($outputLibraryName := fn)
+
+@
+\subsection{describeOutputLibraryArgs}
+<<describeOutputLibraryArgs>>=
+describeOutputLibraryArgs() ==
+  sayBrightly LIST (
+   '%b,'")set compiler output library",'%d,_
+   '"is used to tell the compiler where to place", '%l,_
+   '"compiled code generated by the library compiler.  By default it goes",'%l,_
+   '"in a file called",'%b, '"user.lib", '%d, '"in the current directory." 
+    )
+
+@
+\subsection{describeInputLibraryArgs}
+<<describeInputLibraryArgs>>=
+describeInputLibraryArgs() ==
+  sayBrightly LIST (
+   '%b,'")set compiler input add library",'%d,_
+   '"is used to tell AXIOM to add", '%b, '"library", '%d, '"to",'%l,
+   '"the front of the path which determines where compiled code is loaded from.",_
+   '%l, '%b,'")set compiler input drop library",'%d,_
+   '"is used to tell AXIOM to remove", '%b, '"library", '%d, '%l,_
+   '"from this path."
+    )
+
+@
+\section{expose}
+See the section expose in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+---------------------- The expose Option ----------------------
+
+ Description: control interpreter constructor exposure
+
+   The following groups are explicitly exposed in the current 
+   frame (called initial ):
+                                   basic                                   
+                                categories                                 
+                                  naglink                                  
+                                   anna                                    
+ 
+   The following constructors are explicitly exposed in the 
+   current frame:
+               there are no explicitly exposed constructors                
+ 
+   The following constructors are explicitly hidden in the 
+   current frame:
+                there are no explicitly hidden constructors                
+ 
+   When )set expose is followed by no arguments, the information
+   you now see is displayed. When followed by the initialize 
+   argument, the exposure group data in the file INTERP.EXPOSED 
+   is read and is then available. The arguments add and drop are 
+   used to add or drop exposure groups or explicit constructors 
+   from the local frame exposure data. Issue
+                  )set expose add    or    )set expose drop 
+   for more information.
+\end{verbatim}
+<<exposeCode>>=
+<<setExpose>>
+<<setExposeAdd>>
+<<setExposeAddGroup>>
+<<setExposeAddConstr>>
+<<setExposeDrop>>
+<<setExposeDropGroup>>
+<<setExposeDropConstr>>
+@
+\subsection{setExpose}
+<<setExpose>>=
+setExpose arg ==
+  arg = "%initialize%" => loadExposureGroupData()
+  arg = "%display%" => '"..."
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    --  give msg about exposure groups
+    displayExposedGroups()
+    --  give msg about explicitly exposed constructors
+    sayMSG '" "
+    displayExposedConstructors()
+    --  give msg about explicitly hidden constructors
+    sayMSG '" "
+    displayHiddenConstructors()
+    -- give some more details
+    sayMSG '" "
+    sayKeyedMsg("S2IZ0049D",[namestring pathname ["INTERP","EXPOSED"]])
+
+  arg is [fn,:fnargs] and (fn := selectOptionLC(fn,
+    '(add drop initialize),NIL)) =>
+      fn = 'add  =>  setExposeAdd fnargs
+      fn = 'drop =>  setExposeDrop fnargs
+      fn = 'initialize => setExpose "%initialize%"
+      NIL
+  setExpose NIL
+
+@
+\subsection{setExposeAdd}
+<<setExposeAdd>>=
+setExposeAdd arg ==
+  (null arg) =>
+    centerAndHighlight ("The add Option",$LINELENGTH,specialChar 'hbar)
+    --  give msg about exposure groups
+    displayExposedGroups()
+    --  give msg about explicitly exposed constructors
+    sayMSG '" "
+    displayExposedConstructors()
+    sayMSG '" "
+    sayKeyedMsg("S2IZ0049E",NIL)
+  arg is [fn,:fnargs] and (fn := selectOptionLC(fn,
+    '(group constructor),NIL)) =>
+      fn = 'group  =>  setExposeAddGroup fnargs
+      fn = 'constructor =>  setExposeAddConstr fnargs
+      NIL
+  setExposeAdd NIL
+
+@
+\subsection{setExposeAddGroup}
+<<setExposeAddGroup>>=
+setExposeAddGroup arg ==
+  (null arg) =>
+    centerAndHighlight("The group Option",$LINELENGTH,specialChar 'hbar)
+    --  give msg about exposure groups
+    displayExposedGroups()
+    sayMSG '" "
+    sayKeyedMsg("S2IZ0049G",[namestring pathname ["INTERP","EXPOSED"]])
+    sayMSG '" "
+    sayAsManyPerLineAsPossible [object2String first x for x in
+      $globalExposureGroupAlist]
+  for x in arg repeat
+    if PAIRP x then x := QCAR x
+    x = 'all =>
+      $localExposureData.0 :=[first x for x in $globalExposureGroupAlist]
+      $localExposureData.1 :=NIL
+      $localExposureData.2 :=NIL
+      displayExposedGroups()
+      sayMSG '" "
+      displayExposedConstructors()
+      sayMSG '" "
+      displayHiddenConstructors()
+      clearClams()
+    null GETALIST($globalExposureGroupAlist,x) =>
+      sayKeyedMsg("S2IZ0049H",[x])
+    member(x,$localExposureData.0) =>
+      sayKeyedMsg("S2IZ0049I",[x,$interpreterFrameName])
+    $localExposureData.0 := MSORT cons(x,$localExposureData.0)
+    sayKeyedMsg("S2IZ0049R",[x,$interpreterFrameName])
+    clearClams()
+
+@
+\subsection{setExposeAddConstr}
+<<setExposeAddConstr>>=
+setExposeAddConstr arg ==
+  (null arg) =>
+    centerAndHighlight ("The constructor Option",$LINELENGTH,
+      specialChar 'hbar)
+    --  give msg about explicitly exposed constructors
+    displayExposedConstructors()
+  for x in arg repeat
+    x := unabbrev x
+    if PAIRP x then x := QCAR x
+    -- if the constructor is known, we know what type it is
+    null GETDATABASE(x,'CONSTRUCTORKIND) =>
+      sayKeyedMsg("S2IZ0049J",[x])
+    member(x,$localExposureData.1) =>
+      sayKeyedMsg("S2IZ0049K",[x,$interpreterFrameName])
+    -- if the constructor is explicitly hidden, then remove that
+    if member(x,$localExposureData.2) then
+      $localExposureData.2 := delete(x,$localExposureData.2)
+    $localExposureData.1 := MSORT cons(x,$localExposureData.1)
+    clearClams()
+    sayKeyedMsg("S2IZ0049P",[x,$interpreterFrameName])
+
+@
+\subsection{setExposeDrop}
+<<setExposeDrop>>=
+setExposeDrop arg ==
+  (null arg) =>
+    centerAndHighlight ("The drop Option",$LINELENGTH,specialChar 'hbar)
+    --  give msg about explicitly hidden constructors
+    displayHiddenConstructors()
+    sayMSG '" "
+    sayKeyedMsg("S2IZ0049F",NIL)
+  arg is [fn,:fnargs] and (fn := selectOptionLC(fn,
+    '(group constructor),NIL)) =>
+      fn = 'group  =>  setExposeDropGroup fnargs
+      fn = 'constructor =>  setExposeDropConstr fnargs
+      NIL
+  setExposeDrop NIL
+
+@
+\subsection{setExposeDropGroup}
+<<setExposeDropGroup>>=
+setExposeDropGroup arg ==
+  (null arg) =>
+    centerAndHighlight ("The group Option",$LINELENGTH,specialChar 'hbar)
+    sayKeyedMsg("S2IZ0049L",NIL)
+    sayMSG '" "
+    displayExposedGroups()
+  for x in arg repeat
+    if PAIRP x then x := QCAR x
+    x = 'all =>
+      $localExposureData.0 := NIL
+      $localExposureData.1 := NIL
+      $localExposureData.2 := NIL
+      displayExposedGroups()
+      sayMSG '" "
+      displayExposedConstructors()
+      sayMSG '" "
+      displayHiddenConstructors()
+      clearClams()
+    member(x,$localExposureData.0) =>
+      $localExposureData.0 := delete(x,$localExposureData.0)
+      clearClams()
+      sayKeyedMsg("S2IZ0049S",[x,$interpreterFrameName])
+    GETALIST($globalExposureGroupAlist,x) =>
+      sayKeyedMsg("S2IZ0049I",[x,$interpreterFrameName])
+    sayKeyedMsg("S2IZ0049H",[x])
+
+@
+\subsection{setExposeDropConstr}
+<<setExposeDropConstr>>=
+setExposeDropConstr arg ==
+  (null arg) =>
+    centerAndHighlight ("The constructor Option",$LINELENGTH,
+      specialChar 'hbar)
+    sayKeyedMsg("S2IZ0049N",NIL)
+    sayMSG '" "
+    displayExposedConstructors()
+    sayMSG '" "
+    displayHiddenConstructors()
+  for x in arg repeat
+    x := unabbrev x
+    if PAIRP x then x := QCAR x
+    -- if the constructor is known, we know what type it is
+    null GETDATABASE(x,'CONSTRUCTORKIND) =>
+      sayKeyedMsg("S2IZ0049J",[x])
+    member(x,$localExposureData.2) =>
+      sayKeyedMsg("S2IZ0049O",[x,$interpreterFrameName])
+    if member(x,$localExposureData.1) then
+      $localExposureData.1 := delete(x,$localExposureData.1)
+    $localExposureData.2 := MSORT cons(x,$localExposureData.2)
+    clearClams()
+    sayKeyedMsg("S2IZ0049Q",[x,$interpreterFrameName])
+
+@
+\section{fortran calling}
+See the section calling in servart.boot.pamphlet.
+\begin{verbatim}
+              Current Values of  calling  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+tempfile     set location of temporary data files       /tmp/ 
+directory    set location of generated FORTRAN files    ./ 
+linker       linker arguments (e.g. libraries to search) -lxlf 
+
+\end{verbatim}
+<<fortrancallingCode>>=
+<<setFortTmpDir>>
+<<validateOutputDirectory>>
+<<describeSetFortTmpDir>>
+<<setFortDir>>
+<<describeSetFortDir>>
+<<setLinkerArgs>>
+<<describeSetLinkerArgs>>
+@
+\subsection{setFortTmpDir}
+<<setFortTmpDir>>=
+setFortTmpDir arg ==
+
+  arg = "%initialize%" =>
+    $fortranTmpDir := '"/tmp/"
+
+  arg = "%display%" =>
+    STRINGP $fortranTmpDir => $fortranTmpDir
+    PNAME $fortranTmpDir
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetFortTmpDir()
+
+  -- try to figure out what the argument is
+
+  -- VM code - must be an accessed disk mode [mode]
+  not (mode := validateOutputDirectory arg) =>
+    sayBrightly ['" Sorry, but your argument(s)",:bright arg,
+      '"is(are) not valid.",'%l]
+    describeSetFortTmpDir()
+  $fortranTmpDir := mode
+
+@
+\subsection{validateOutputDirectory}
+<<validateOutputDirectory>>=
+validateOutputDirectory x ==
+  AND(PATHNAME_-DIRECTORY(PROBE_-FILE(CAR(x))), NOT PATHNAME_-NAME  (PROBE_-FILE(CAR(x)))) =>
+    CAR(x)
+  NIL
+
+@
+\subsection{describeSetFortTmpDir}
+<<describeSetFortTmpDir>>=
+describeSetFortTmpDir() ==
+  sayBrightly LIST (
+   '%b,'")set fortran calling tempfile",'%d,_
+   '" is used to tell AXIOM where",'%l,_
+   '" to place intermediate FORTRAN data files . This must be the ",'%l,_
+   '" name of a valid existing directory to which you have permission ",'%l,_
+   '" to write (including the final slash).",'%l,'%l,_
+   '" Syntax:",'%l,_
+   '"   )set fortran calling tempfile DIRECTORYNAME",'%l,'%l,_
+   '" The current setting is",'%b,$fortranTmpDir,'%d)
+
+@
+\subsection{setFortDir}
+<<setFortDir>>=
+setFortDir arg ==
+  arg = "%initialize%" =>
+    $fortranDirectory := '"./"
+
+  arg = "%display%" =>
+    STRINGP $fortranDirectory => $fortranDirectory
+    PNAME $fortranDirectory
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetFortDir()
+
+  -- try to figure out what the argument is
+
+  -- VM code - must be an accessed disk mode [mode]
+  not (mode := validateOutputDirectory arg) =>
+    sayBrightly ['" Sorry, but your argument(s)",:bright arg,
+      '"is(are) not valid.",'%l]
+    describeSetFortDir()
+  $fortranDirectory := mode
+
+@
+\subsection{describeSetFortDir}
+<<describeSetFortDir>>=
+describeSetFortDir() ==
+  sayBrightly LIST (
+   '%b,'")set fortran calling directory",'%d,_
+   '" is used to tell AXIOM where",'%l,_
+   '" to place generated FORTRAN files. This must be the name ",'%l,_
+   '" of a valid existing directory to which you have permission ",'%l,_
+   '" to write (including the final slash).",'%l,'%l,_
+   '" Syntax:",'%l,_
+   '"   )set fortran calling directory DIRECTORYNAME",'%l,'%l,_
+   '" The current setting is",'%b,$fortranDirectory,'%d)
+
+@
+\subsection{setLinkerArgs}
+<<setLinkerArgs>>=
+setLinkerArgs arg ==
+
+  arg = "%initialize%" =>
+    $fortranLibraries := '"-lxlf"
+  arg = "%display%" => object2String $fortranLibraries
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetLinkerArgs()
+  LISTP(arg) and STRINGP(first arg) => 
+    $fortranLibraries := first(arg)
+  describeSetLinkerArgs()
+
+@
+\subsection{describeSetLinkerArgs}
+<<describeSetLinkerArgs>>=
+describeSetLinkerArgs() ==
+  sayBrightly LIST (
+   '%b,'")set fortran calling linkerargs",'%d,_
+   '" is used to pass arguments to the linker",'%l,_
+   '" when using ",'%b,'"mkFort",'%d,_
+   '" to create functions which call Fortran code.",'%l,_
+   '" For example, it might give a list of libraries to be searched,",'%l,_
+   '" and their locations.",'%l,_
+   '" The string is passed verbatim, so must be the correct syntax for",'%l,_
+   '" the particular linker being used.",'%l,'%l,_
+   '" Example: )set fortran calling linker _"-lxlf_"",'%l,'%l,_
+   '" The current setting is",'%b,$fortranLibraries,'%d)
+
+@
+\section{functions}
+See the section functions in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+             Current Values of  functions  Variables                  
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+cache        number of function results to cache        0 
+compile      compile, don't just define function bodies off 
+recurrence   specially compile recurrence relations     on 
+
+\end{verbatim}
+<<functionsCode>>=
+<<setFunctionsCache>>
+<<countCache>>
+<<describeSetFunctionsCache>>
+<<sayAllCacheCounts>>
+<<sayCacheCount>>
+@
+\subsection{setFunctionsCache}
+<<setFunctionsCache>>=
+setFunctionsCache arg ==
+  $options : local := NIL
+  arg = "%initialize%" =>
+    $cacheCount := 0
+    $cacheAlist := NIL
+  arg = "%display%" =>
+    null $cacheAlist => object2String $cacheCount
+    '"..."
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetFunctionsCache()
+    TERPRI()
+    sayAllCacheCounts()
+  n := first arg
+  (n ^= 'all) and ((not FIXP n) or (n < 0)) =>
+    sayMessage ['"Your value of",:bright n,'"is invalid because ..."]
+    describeSetFunctionsCache()
+    terminateSystemCommand()
+  if (rest arg) then $options := [['vars,:rest arg]]
+  countCache n
+
+@
+\subsection{countCache}
+<<countCache>>=
+countCache n ==
+  $options =>
+    $options is [["vars",:l]] =>
+      for x in l repeat
+        NULL IDENTP x => sayKeyedMsg("S2IF0007",[x])
+        $cacheAlist:= insertAlist(x,n,$cacheAlist)
+        cacheCountName:= INTERNL(x,'";COUNT")
+        SET(cacheCountName,n)
+        sayCacheCount(x,n)
+    optionError(CAAR $options,nil)
+  sayCacheCount(nil,$cacheCount:= n)
+
+@
+\subsection{describeSetFunctionsCache}
+<<describeSetFunctionsCache>>=
+describeSetFunctionsCache() ==
+  sayBrightly LIST(
+    '%b,'")set functions cache",'%d,'"is used to tell AXIOM how many",'%l,_
+    '" values computed by interpreter functions should be saved.  This can save ",'%l, _
+    '" quite a bit of time in recursive functions, though one must consider that",'%l,_
+    '" the cached values will take up (perhaps valuable) room in the workspace.",'%l,'%l,_
+    '" The value given  after",'%b,'"cache",'%d,'"must either be the",_
+    '" word",'%b,'"all",'%d,'"or a positive",'%l,_
+    '" integer.  This may be followed by any number of function names whose cache",'%l,_
+    '" sizes you wish to so set.  If no functions are given, the default cache",'%l,_
+    '" size is set.",'%l,'" Examples:",_
+    '"   )set fun cache all         )set fun cache 10 f g Legendre")
+
+@
+\subsection{sayAllCacheCounts}
+<<sayAllCacheCounts>>=
+sayAllCacheCounts () ==
+  sayCacheCount(nil,$cacheCount)
+  $cacheAlist =>
+    TERPRI()
+--    SAY '" However,"
+    for [x,:n] in $cacheAlist | n ^= $cacheCount repeat sayCacheCount(x,n)
+
+@
+\subsection{sayCacheCount}
+<<sayCacheCount>>=
+sayCacheCount(fn,n) ==
+  prefix:=
+    fn => ["function",:bright linearFormatName fn]
+    n = 0 => ["interpreter functions "]
+    ["In general, interpreter functions "]
+  n = 0 =>
+    fn =>
+      sayBrightly ['"   Caching for ",:prefix,
+        '"is turned off"]
+    sayBrightly '" In general, functions will cache no returned values."
+  phrase:=
+    n="all" => [:bright "all","values."]
+    n=1 => [" only the last value."]
+    [" the last",:bright n,"values."]
+  sayBrightly ['"   ",:prefix,'"will cache",:phrase]
+
+@
+\section{history}
+See the section history in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+--------------------- The history Option ----------------------
+
+ Description: save workspace values in a history file
+
+ The history option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<historyCode>>=
+<<setHistory>>
+@
+\subsection{setHistory}
+<<setHistory>>=
+setHistory arg ==
+  -- this is just a front end for the history functions
+  arg = "%initialize%" => nil
+
+  current := object2String translateTrueFalse2YesNo $HiFiAccess
+  arg = "%display%" => current
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    sayMessage ['" The",:bright '"history",'"option",
+      '" may be followed by any one of the following:"]
+    for name in '("on" "off" "yes" "no") repeat
+      if name = current
+        then sayBrightly ['" ->",:bright name]
+        else sayBrightly ['"    ",name]
+    TERPRI()
+    sayBrightly '" The current setting is indicated within the list."
+    sayBrightly [:bright '"yes",'"and",:bright '"no",
+     '"have the same effect as",:bright '"on",'"and",:bright '"off",
+       '"respectively."]
+    if $useInternalHistoryTable
+      then wh := '"memory"
+      else wh := '"a file"
+    sayBrightly ['%l,'" When the history facility is active, the data",
+      '" is kept in ",wh,'"."]
+    sayMessage ['" Issue",:bright '")help history",
+      '"for more information."]
+
+  arg is [fn] and
+   (fn := DOWNCASE(fn)) in '(y n ye yes no on of off) =>
+    $options := [[fn]]
+    historySpad2Cmd()
+  setHistory NIL
+
+@
+\section{kernel}
+See the section kernel in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+              Current Values of  kernel  Variables                    
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+warn         warn when re-definition is attempted       off 
+protect      prevent re-definition of kernel functions  off 
+
+\end{verbatim}
+<<kernelCode>>=
+<<describeProtectedSymbolsWarning>>
+<<protectedSymbolsWarning>>
+<<describeProtectSymbols>>
+<<protectSymbols>>
+@
+\subsection{describeProtectedSymbolsWarning}
+<<describeProtectedSymbolsWarning>>=
+describeProtectedSymbolsWarning() ==
+ sayBrightly LIST(
+  '"Some AXIOM library functions are compiled into the kernel for efficiency",_
+  '%l,'"reasons.  To prevent them being re-defined when loaded from a library",_
+  '%l,'"they are specially protected.  If a user wishes to know when an attempt",_
+  '%l,'"is made to re-define such a function, he or she should issue the command:",_
+  '%l,'"	)set kernel warn on",_
+  '%l,'"To restore the default behaviour, he or she should issue the command:",_
+  '%l,'"	)set kernel warn off")
+
+@
+\subsection{protectedSymbolsWarning}
+<<protectedSymbolsWarning>>=
+protectedSymbolsWarning arg ==
+  arg = "%initialize%" => PROTECTED_-SYMBOL_-WARN(false)
+  arg = "%display%" =>
+    v := PROTECTED_-SYMBOL_-WARN(true)
+    PROTECTED_-SYMBOL_-WARN(v)
+    v => '"on" 
+    '"off"
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeProtectedSymbolsWarning()
+  PROTECTED_-SYMBOL_-WARN translateYesNo2TrueFalse first arg
+
+@
+\subsection{describeProtectSymbols}
+<<describeProtectSymbols>>=
+describeProtectSymbols() ==
+ sayBrightly LIST(
+  '"Some AXIOM library functions are compiled into the kernel for efficiency",_
+  '%l,'"reasons.  To prevent them being re-defined when loaded from a library",_
+  '%l,'"they are specially protected.  If a user wishes to re-define these",_
+  '%l,'"functions, he or she should issue the command:",_
+  '%l,'"	)set kernel protect off",_
+  '%l,'"To restore the default behaviour, he or she should issue the command:",_
+  '%l,'"	)set kernel protect on")
+
+@
+\subsection{protectSymbols}
+<<protectSymbols>>=
+protectSymbols arg ==
+  arg = "%initialize%" => PROTECT_-SYMBOLS(true)
+  arg = "%display%" =>
+    v := PROTECT_-SYMBOLS(true)
+    PROTECT_-SYMBOLS(v)
+    v => '"on" 
+    '"off"
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeProtectSymbols()
+  PROTECT_-SYMBOLS translateYesNo2TrueFalse first arg
+
+@
+\section{naglink}
+See the section naglink in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+              Current Values of  naglink  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+host         internet address of host for NAGLink       localhost 
+persistence  number of (fortran) functions to remember  1 
+messages     show NAGLink messages                      on 
+double       enforce DOUBLE PRECISION ASPs              on 
+
+\end{verbatim}
+<<naglinkCode>>=
+<<setNagHost>>
+<<describeSetNagHost>>
+<<setFortPers>>
+<<describeFortPersistence>>
+@
+\subsection{setNagHost}
+<<setNagHost>>=
+setNagHost arg ==
+  arg = "%initialize%" =>
+    $nagHost := '"localhost"
+  arg = "%display%" =>
+    object2String $nagHost
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetNagHost()
+  $nagHost := object2String arg
+
+@
+\subsection{describeSetNagHost}
+<<describeSetNagHost>>=
+describeSetNagHost() ==
+  sayBrightly LIST (
+   '%b,'")set naglink host",'%d,_
+   '"is used to tell  AXIOM which  host to contact for",'%l,_
+   '" a NAGLink request. An Internet address should be supplied. The host",'%l,_
+   '" specified must be running the NAGLink daemon.",'%l,'%l,_
+   '" The current setting is",'%b,$nagHost,'%d)
+
+@
+\subsection{setFortPers}
+<<setFortPers>>=
+setFortPers arg ==
+  arg = "%initialize%" =>
+    $fortPersistence := 1
+  arg = "%display%" =>
+    $fortPersistence
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeFortPersistence()
+  n := first arg
+  ((not FIXP n) or (n < 0)) =>
+    sayMessage ['"Your value of",:bright n,'"is invalid because ..."]
+    describeFortPersistence()
+    terminateSystemCommand()
+  $fortPersistence := first(arg)
+
+@
+\subsection{describeFortPersistence}
+<<describeFortPersistence>>=
+describeFortPersistence() ==
+  sayBrightly LIST (
+   '%b,'")set naglink persistence",'%d,_
+   '"is used to tell  the ",'%b,"nagd",'%d," daemon how  many ASP",'%l,_
+   '" source and object files to keep around in case you reuse them. This helps",'%l,_
+   '" to avoid needless recompilations. The number specified should be a ",'%l,_
+   '" non-negative integer.", '%l,'%l,_
+   '" The current setting is",'%b,$fortPersistence,'%d)
+
+@
+\section{output algebra}
+See the subsection output algebra in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+--------------------- The algebra Option ----------------------
+
+ Description: display output in algebraic form
+
+ )set output algebra is used to tell AXIOM to turn algebra-style
+  output printing on and off, and where to place the output.  By
+  default, the destination for the output is the screen but 
+  printing is turned off.
+
+Syntax:   )set output algebra <arg>
+    where arg can be one of
+  on          turn algebra printing on (default state)
+  off         turn algebra printing off
+  console     send algebra output to screen (default state)
+  fp<.fe>     send algebra output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .spout.
+
+If you wish to send the output to a file, you may need to issue
+this command twice: once with on and once with the file name. 
+For example, to send algebra output to the file polymer.spout,
+issue the two commands
+
+  )set output algebra on
+  )set output algebra polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  On:CONSOLE 
+\end{verbatim}
+<<outputalgebraCode>>=
+<<setOutputAlgebra>>
+<<describeSetOutputAlgebra>>
+@
+\subsection{setOutputAlgebra}
+<<setOutputAlgebra>>=
+setOutputAlgebra arg ==
+  arg = "%initialize%" =>
+    $algebraOutputStream :=
+      DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+    $algebraOutputFile := '"CONSOLE"
+    $algebraFormat := true
+
+  arg = "%display%" =>
+    if $algebraFormat then label := '"On:" else label := '"Off:"
+    STRCONC(label,$algebraOutputFile)
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetOutputAlgebra()
+
+  -- try to figure out what the argument is
+
+  if arg is [fn] and
+    fn in '(Y N YE YES NO O ON OF OFF CONSOLE y n ye yes no o on of off console)
+      then 'ok
+      else arg := [fn,'spout]
+
+  arg is [fn] =>
+    UPCASE(fn) in '(Y N YE O OF) =>
+      sayKeyedMsg("S2IV0002",'(algebra algebra))
+    UPCASE(fn) in '(NO OFF)  => $algebraFormat := NIL
+    UPCASE(fn) in '(YES ON) => $algebraFormat := true
+    UPCASE(fn) = 'CONSOLE =>
+      SHUT $algebraOutputStream
+      $algebraOutputStream :=
+        DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+      $algebraOutputFile := '"CONSOLE"
+
+  (arg is [fn,ft]) or (arg is [fn,ft,fm]) => -- aha, a file
+    if (ptype := pathnameType fn) then
+      fn := STRCONC(pathnameDirectory fn,pathnameName fn)
+      ft := ptype
+    if null fm then fm := 'A
+    filename := $FILEP(fn,ft,fm)
+    null filename =>
+      sayKeyedMsg("S2IV0003",[fn,ft,fm])
+    (testStream := MAKE_-OUTSTREAM(filename,255,0)) =>
+      SHUT $algebraOutputStream
+      $algebraOutputStream := testStream
+      $algebraOutputFile := object2String filename
+      sayKeyedMsg("S2IV0004",['"Algebra",$algebraOutputFile])
+    sayKeyedMsg("S2IV0003",[fn,ft,fm])
+
+  sayKeyedMsg("S2IV0005",NIL)
+  describeSetOutputAlgebra()
+
+@
+\subsection{describeSetOutputAlgebra}
+<<describeSetOutputAlgebra>>=
+describeSetOutputAlgebra() ==
+  sayBrightly LIST ('%b,'")set output algebra",'%d,_
+   '"is used to tell AXIOM to turn algebra-style output",'%l,_
+   '"printing on and off, and where to place the output.  By default, the",'%l,_
+   '"destination for the output is the screen but printing is turned off.",'%l,_
+   '%l,_
+   '"Syntax:   )set output algebra <arg>",'%l,_
+  '"    where arg can be one of",'%l,_
+  '"  on          turn algebra printing on (default state)",'%l,_
+  '"  off         turn algebra printing off",'%l,_
+  '"  console     send algebra output to screen (default state)",'%l,_
+  '"  fp<.fe>     send algebra output to file with file prefix fp",'%l,_
+  '"              and file extension .fe. If not given, .fe defaults to .spout.",'%l,
+  '%l,_
+  '"If you wish to send the output to a file, you may need to issue this command",'%l,_
+  '"twice: once with",'%b,'"on",'%d,'"and once with the file name. For example, to send",'%l,_
+  '"algebra output to the file",'%b,'"polymer.spout,",'%d,'"issue the two commands",'%l,_
+  '%l,_
+  '"  )set output algebra on",'%l,_
+  '"  )set output algebra polymer",'%l,_
+  '%l,_
+  '"The output is placed in the directory from which you invoked AXIOM or",'%l,_
+  '"the one you set with the )cd system command.",'%l,_
+  '"The current setting is: ",'%b,setOutputAlgebra "%display%",'%d)
+
+
+@
+\section{output characters}
+See the subsection output characters in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+-------------------- The characters Option --------------------
+
+ Description: choose special output character set
+
+
+ The characters option may be followed by any one of the 
+ following:
+
+    default
+ -> plain 
+
+ The current setting is indicated within the list.  This 
+ option  determines the special characters used for algebraic 
+ output. This is what the current choice of special characters 
+ looks like:
+   ulc is shown as +          urc is shown as +       
+   llc is shown as +          lrc is shown as +       
+   vbar is shown as |         hbar is shown as -      
+   quad is shown as ?         lbrk is shown as [      
+   rbrk is shown as ]         lbrc is shown as {      
+   rbrc is shown as }         ttee is shown as +      
+   btee is shown as +         rtee is shown as +      
+   ltee is shown as +         ctee is shown as +      
+   bslash is shown as \    
+\end{verbatim}
+<<outputcharactersCode>>=
+<<setOutputCharacters>>
+@
+\subsection{setOutputCharacters}
+<<setOutputCharacters>>=
+setOutputCharacters arg ==
+  -- this sets the special character set
+  arg = "%initialize%" =>
+    $specialCharacters := $plainRTspecialCharacters
+
+  current :=
+    $specialCharacters = $RTspecialCharacters      => '"default"
+    $specialCharacters = $plainRTspecialCharacters => '"plain"
+    '"unknown"
+  arg = "%display%" => current
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    sayMessage ['" The",:bright '"characters",'"option",
+      '" may be followed by any one of the following:"]
+    for name in '("default" "plain") repeat
+      if name = current
+        then sayBrightly ['" ->",:bright name]
+        else sayBrightly ['"    ",name]
+    TERPRI()
+    sayBrightly '" The current setting is indicated within the list.  This option determines "
+    sayBrightly '" the special characters used for algebraic output.  This is what the"
+    sayBrightly '" current choice of special characters looks like:"
+    l := NIL
+    for [char,:.] in $specialCharacterAlist repeat
+      s := STRCONC('"   ",PNAME char,'" is shown as ",
+        PNAME specialChar(char))
+      l := cons(s,l)
+    sayAsManyPerLineAsPossible reverse l
+
+  arg is [fn] and (fn := DOWNCASE(fn)) =>
+    fn = 'default => $specialCharacters := $RTspecialCharacters
+    fn = 'plain   => $specialCharacters := $plainRTspecialCharacters
+    setOutputCharacters NIL
+  setOutputCharacters NIL
+
+@
+\section{output fortran}
+See the subsection output fortran in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+--------------------- The fortran Option ----------------------
+
+ Description: create output in FORTRAN format
+
+ )set output fortran is used to tell AXIOM to turn FORTRAN-style
+  output printing on and off, and where to place the output.  By
+  default, the destination for the output is the screen but 
+  printing is turned off.
+
+Also See: )set fortran
+
+Syntax:   )set output fortran <arg>
+    where arg can be one of
+  on          turn FORTRAN printing on
+  off         turn FORTRAN printing off (default state)
+  console     send FORTRAN output to screen (default state)
+  fp<.fe>     send FORTRAN output to file with file prefix 
+              fp and file extension .fe. If not given, 
+              .fe defaults to .sfort.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name.
+For example, to send FORTRAN output to the file polymer.sfort,
+ issue the two commands
+
+  )set output fortran on
+  )set output fortran polymer
+
+The output is placed in the directory from which you invoked
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputfortranCode>>=
+<<makeStream>>
+<<setOutputFortran>>
+<<describeSetOutputFortran>>
+@
+\subsection{makeStream}
+<<makeStream>>=
+makeStream(append,filename,i,j) ==
+  append => MAKE_-APPENDSTREAM(filename,i,j)
+  MAKE_-OUTSTREAM(filename,i,j)
+
+@
+\subsection{setOutputFortran}
+<<setOutputFortran>>=
+setOutputFortran arg ==
+  arg = "%initialize%" =>
+    $fortranOutputStream :=
+      DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+    $fortranOutputFile := '"CONSOLE"
+    $fortranFormat := NIL
+
+  arg = "%display%" =>
+    if $fortranFormat then label := '"On:" else label := '"Off:"
+    STRCONC(label,$fortranOutputFile)
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetOutputFortran()
+
+  -- try to figure out what the argument is
+
+  append := NIL
+  quiet := NIL
+  while LISTP arg and UPCASE(first arg) in '(APPEND QUIET) repeat
+    if UPCASE first(arg) = 'APPEND then append := true
+    else if UPCASE first(arg) = 'QUIET then quiet := true
+    arg := rest(arg)
+
+  if arg is [fn] and
+    fn in '(Y N YE YES NO O ON OF OFF CONSOLE y n ye yes no o on of off console)
+      then 'ok
+      else arg := [fn,'sfort]
+
+  arg is [fn] =>
+    UPCASE(fn) in '(Y N YE O OF) =>
+      sayKeyedMsg("S2IV0002",'(FORTRAN fortran))
+    UPCASE(fn) in '(NO OFF)  => $fortranFormat := NIL
+    UPCASE(fn) in '(YES ON)  => $fortranFormat := true
+    UPCASE(fn) = 'CONSOLE =>
+      SHUT $fortranOutputStream
+      $fortranOutputStream :=
+        DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+      $fortranOutputFile := '"CONSOLE"
+
+  (arg is [fn,ft]) or (arg is [fn,ft,fm]) => -- aha, a file
+    if (ptype := pathnameType fn) then
+      fn := STRCONC(pathnameDirectory fn,pathnameName fn)
+      ft := ptype
+    if null fm then fm := 'A
+    filename := $FILEP(fn,ft,fm)
+    null filename => sayKeyedMsg("S2IV0003",[fn,ft,fm])
+    (testStream := makeStream(append,filename,255,0)) =>
+      SHUT $fortranOutputStream
+      $fortranOutputStream := testStream
+      $fortranOutputFile := object2String filename
+      if null quiet then sayKeyedMsg("S2IV0004",['FORTRAN,$fortranOutputFile])
+    if null quiet then sayKeyedMsg("S2IV0003",[fn,ft,fm])
+  if null quiet then sayKeyedMsg("S2IV0005",NIL)
+  describeSetOutputFortran()
+
+@
+\subsection{describeSetOutputFortran}
+<<describeSetOutputFortran>>=
+describeSetOutputFortran() ==
+  sayBrightly LIST ('%b,'")set output fortran",'%d,_
+   '"is used to tell AXIOM to turn FORTRAN-style output",'%l,_
+   '"printing on and off, and where to place the output.  By default, the",'%l,_
+   '"destination for the output is the screen but printing is turned off.",'%l,_
+   '%l,_
+   '"Also See: )set fortran",'%l,
+   '%l,_
+   '"Syntax:   )set output fortran <arg>",'%l,_
+  '"    where arg can be one of",'%l,_
+  '"  on          turn FORTRAN printing on",'%l,_
+  '"  off         turn FORTRAN printing off (default state)",'%l,_
+  '"  console     send FORTRAN output to screen (default state)",'%l,_
+  '"  fp<.fe>     send FORTRAN output to file with file prefix fp and file",'%l,_
+  '"              extension .fe. If not given, .fe defaults to .sfort.",'%l,
+  '%l,_
+  '"If you wish to send the output to a file, you must issue this command",'%l,_
+  '"twice: once with",'%b,'"on",'%d,'"and once with the file name. For example, to send",'%l,_
+  '"FORTRAN output to the file",'%b,'"polymer.sfort,",'%d,'"issue the two commands",'%l,_
+  '%l,_
+  '"  )set output fortran on",'%l,_
+  '"  )set output fortran polymer",'%l,_
+  '%l,_
+  '"The output is placed in the directory from which you invoked AXIOM or",'%l,_
+  '"the one you set with the )cd system command.",'%l,_
+  '"The current setting is: ",'%b,setOutputFortran "%display%",'%d)
+
+@
+\section{output openmath}
+See the subsection output openmath in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+------------------ The openmath Option ------------------------
+
+ Description: create output in OpenMath style
+
+ )set output tex is used to tell AXIOM to turn TeX-style output
+printing on and off, and where to place the output.  By default,
+the destination for the output is the screen but printing is 
+turned off.
+
+Syntax:   )set output tex <arg>
+    where arg can be one of
+  on          turn TeX printing on
+  off         turn TeX printing off (default state)
+  console     send TeX output to screen (default state)
+  fp<.fe>     send TeX output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .som.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name. 
+For example, to send TeX output to the file polymer.som, 
+issue the two commands
+
+  )set output tex on
+  )set output tex polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+<<outputopenmathCode>>=
+<<setOutputOpenMath>>
+<<describeSetOutputOpenMath>>
+@
+\subsection{setOutputOpenMath}
+<<setOutputOpenMath>>=
+setOutputOpenMath arg ==
+  arg = "%initialize%" =>
+    $openMathOutputStream :=
+      DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+    $openMathOutputFile := '"CONSOLE"
+    $openMathFormat := NIL
+
+  arg = "%display%" =>
+    if $openMathFormat then label := '"On:" else label := '"Off:"
+    STRCONC(label,$openMathOutputFile)
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetOutputOpenMath()
+
+  -- try to figure out what the argument is
+
+  if arg is [fn] and
+    fn in '(Y N YE YES NO O ON OF OFF CONSOLE y n ye yes no o on of off console)
+      then 'ok
+      else arg := [fn,'som]
+
+  arg is [fn] =>
+    UPCASE(fn) in '(Y N YE O OF) =>
+      sayKeyedMsg("S2IV0002",'(OpenMath openmath))
+    UPCASE(fn) in '(NO OFF)  => $openMathFormat := NIL
+    UPCASE(fn) in '(YES ON) => $openMathFormat := true
+    UPCASE(fn) = 'CONSOLE =>
+      SHUT $openMathOutputStream
+      $openMathOutputStream :=
+        DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+      $openMathOutputFile := '"CONSOLE"
+
+  (arg is [fn,ft]) or (arg is [fn,ft,fm]) => -- aha, a file
+    if (ptype := pathnameType fn) then
+      fn := STRCONC(pathnameDirectory fn,pathnameName fn)
+      ft := ptype
+    if null fm then fm := 'A
+    filename := $FILEP(fn,ft,fm)
+    null filename =>
+      sayKeyedMsg("S2IV0003",[fn,ft,fm])
+    (testStream := MAKE_-OUTSTREAM(filename,255,0)) =>
+      SHUT $openMathOutputStream
+      $openMathOutputStream := testStream
+      $openMathOutputFile := object2String filename
+      sayKeyedMsg("S2IV0004",['"OpenMath",$openMathOutputFile])
+    sayKeyedMsg("S2IV0003",[fn,ft,fm])
+
+  sayKeyedMsg("S2IV0005",NIL)
+  describeSetOutputOpenMath()
+
+@
+\subsection{describeSetOutputOpenMath}
+<<describeSetOutputOpenMath>>=
+describeSetOutputOpenMath() ==
+  sayBrightly LIST ('%b,'")set output openmath",'%d,_
+   '"is used to tell AXIOM to turn OpenMath output",'%l,_
+   '"printing on and off, and where to place the output.  By default, the",'%l,_
+   '"destination for the output is the screen but printing is turned off.",'%l,_
+   '%l,_
+   '"Syntax:   )set output openmath <arg>",'%l,_
+  '"    where arg can be one of",'%l,_
+  '"  on          turn OpenMath printing on",'%l,_
+  '"  off         turn OpenMath printing off (default state)",'%l,_
+  '"  console     send OpenMath output to screen (default state)",'%l,_
+  '"  fp<.fe>     send OpenMath output to file with file prefix fp and file",'%l,_
+  '"              extension .fe. If not given, .fe defaults to .som.",'%l,
+  '%l,_
+  '"If you wish to send the output to a file, you must issue this command",'%l,_
+  '"twice: once with",'%b,'"on",'%d,'"and once with the file name. For example, to send",'%l,_
+  '"OpenMath output to the file",'%b,'"polymer.som,",'%d,'"issue the two commands",'%l,_
+  '%l,_
+  '"  )set output openmath on",'%l,_
+  '"  )set output openmath polymer",'%l,_
+  '%l,_
+  '"The output is placed in the directory from which you invoked AXIOM or",'%l,_
+  '"the one you set with the )cd system command.",'%l,_
+  '"The current setting is: ",'%b,setOutputOpenMath "%display%",'%d)
+
+@
+\section{output script}
+See the subsection output script in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+---------------------- The script Option ----------------------
+
+ Description: display output in SCRIPT formula format
+
+ )set output script is used to tell AXIOM to turn IBM Script
+ formula-style output printing on and off, and where to place
+ the output.  By default, the destination for the output is the 
+ screen but printing is turned off.
+
+Syntax:   )set output script <arg>
+    where arg can be one of
+  on      turn IBM Script formula printing on
+  off     turn IBM Script formula printing off 
+          (default state)
+  console send IBM Script formula output to screen 
+          (default state)
+  fp<.fe> send IBM Script formula output to file with file 
+          prefix fp and file extension .fe. If not given, 
+          .fe defaults to .sform.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file 
+name. For example, to send IBM Script formula output to 
+the file polymer.sform, issue the two commands
+
+  )set output script on
+  )set output script polymer
+
+The output is placed in the directory from which you 
+invoked AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputscriptCode>>=
+<<setOutputFormula>>
+<<describeSetOutputFormula>>
+@
+\subsection{setOutputFormula}
+<<setOutputFormula>>=
+setOutputFormula arg ==
+  arg = "%initialize%" =>
+    $formulaOutputStream :=
+      DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+    $formulaOutputFile := '"CONSOLE"
+    $formulaFormat := NIL
+
+  arg = "%display%" =>
+    if $formulaFormat then label := '"On:" else label := '"Off:"
+    STRCONC(label,$formulaOutputFile)
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetOutputFormula()
+
+  -- try to figure out what the argument is
+
+  if arg is [fn] and
+    fn in '(Y N YE YES NO O ON OF OFF CONSOLE y n ye yes no o on of off console)
+      then 'ok
+      else arg := [fn,'sform]
+
+  arg is [fn] =>
+    UPCASE(fn) in '(Y N YE O OF) =>
+      sayKeyedMsg("S2IV0002",'(script script))
+    UPCASE(fn) in '(NO OFF)  => $formulaFormat := NIL
+    UPCASE(fn) in '(YES ON) => $formulaFormat := true
+    UPCASE(fn) = 'CONSOLE =>
+      SHUT $formulaOutputStream
+      $formulaOutputStream :=
+        DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+      $formulaOutputFile := '"CONSOLE"
+
+  (arg is [fn,ft]) or (arg is [fn,ft,fm]) => -- aha, a file
+    if (ptype := pathnameType fn) then
+      fn := STRCONC(pathnameDirectory fn,pathnameName fn)
+      ft := ptype
+    if null fm then fm := 'A
+    filename := $FILEP(fn,ft,fm)
+    null filename =>
+      sayKeyedMsg("S2IV0003",[fn,ft,fm])
+    (testStream := MAKE_-OUTSTREAM(filename,255,0)) =>
+      SHUT $formulaOutputStream
+      $formulaOutputStream := testStream
+      $formulaOutputFile := object2String filename
+      sayKeyedMsg("S2IV0004",['"IBM Script formula",$formulaOutputFile])
+    sayKeyedMsg("S2IV0003",[fn,ft,fm])
+
+  sayKeyedMsg("S2IV0005",NIL)
+  describeSetOutputFormula()
+
+@
+\subsection{describeSetOutputFormula}
+<<describeSetOutputFormula>>=
+describeSetOutputFormula() ==
+  sayBrightly LIST ('%b,'")set output script",'%d,_
+   '"is used to tell AXIOM to turn IBM Script formula-style",'%l,_
+   '"output printing on and off, and where to place the output.  By default, the",'%l,_
+   '"destination for the output is the screen but printing is turned off.",'%l,_
+   '%l,_
+   '"Syntax:   )set output script <arg>",'%l,_
+  '"    where arg can be one of",'%l,_
+  '"  on          turn IBM Script formula printing on",'%l,_
+  '"  off         turn IBM Script formula printing off (default state)",'%l,_
+  '"  console     send IBM Script formula output to screen (default state)",'%l,_
+  '"  fp<.fe>     send IBM Script formula output to file with file prefix fp",'%l,_
+  '"              and file extension .fe. If not given, .fe defaults to .sform.",'%l,
+  '%l,_
+  '"If you wish to send the output to a file, you must issue this command",'%l,_
+  '"twice: once with",'%b,'"on",'%d,'"and once with the file name. For example, to send",'%l,_
+  '"IBM Script formula output to the file",'%b,'"polymer.sform,",'%d,'"issue the two commands",'%l,_
+  '%l,_
+  '"  )set output script on",'%l,_
+  '"  )set output script polymer",'%l,_
+  '%l,_
+  '"The output is placed in the directory from which you invoked AXIOM or",'%l,_
+  '"the one you set with the )cd system command.",'%l,_
+  '"The current setting is: ",'%b,setOutputFormula "%display%",'%d)
+
+@
+\section{output tex}
+See the section tex in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+----------------------- The tex Option ------------------------
+
+ Description: create output in TeX style
+
+ )set output tex is used to tell AXIOM to turn TeX-style output
+printing on and off, and where to place the output.  By default,
+the destination for the output is the screen but printing is 
+turned off.
+
+Syntax:   )set output tex <arg>
+    where arg can be one of
+  on          turn TeX printing on
+  off         turn TeX printing off (default state)
+  console     send TeX output to screen (default state)
+  fp<.fe>     send TeX output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .stex.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name. 
+For example, to send TeX output to the file polymer.stex, 
+issue the two commands
+
+  )set output tex on
+  )set output tex polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputtexCode>>=
+<<setOutputTex>>
+<<describeSetOutputTex>>
+@
+\subsection{setOutputTex}
+<<setOutputTex>>=
+setOutputTex arg ==
+  arg = "%initialize%" =>
+    $texOutputStream :=
+      DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+    $texOutputFile := '"CONSOLE"
+    $texFormat := NIL
+
+  arg = "%display%" =>
+    if $texFormat then label := '"On:" else label := '"Off:"
+    STRCONC(label,$texOutputFile)
+
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetOutputTex()
+
+  -- try to figure out what the argument is
+
+  if arg is [fn] and
+    fn in '(Y N YE YES NO O ON OF OFF CONSOLE y n ye yes no o on of off console)
+      then 'ok
+      else arg := [fn,'stex]
+
+  arg is [fn] =>
+    UPCASE(fn) in '(Y N YE O OF) =>
+      sayKeyedMsg("S2IV0002",'(TeX tex))
+    UPCASE(fn) in '(NO OFF)  => $texFormat := NIL
+    UPCASE(fn) in '(YES ON) => $texFormat := true
+    UPCASE(fn) = 'CONSOLE =>
+      SHUT $texOutputStream
+      $texOutputStream :=
+        DEFIOSTREAM('((MODE . OUTPUT) (DEVICE . CONSOLE)),255,0)
+      $texOutputFile := '"CONSOLE"
+
+  (arg is [fn,ft]) or (arg is [fn,ft,fm]) => -- aha, a file
+    if (ptype := pathnameType fn) then
+      fn := STRCONC(pathnameDirectory fn,pathnameName fn)
+      ft := ptype
+    if null fm then fm := 'A
+    filename := $FILEP(fn,ft,fm)
+    null filename =>
+      sayKeyedMsg("S2IV0003",[fn,ft,fm])
+    (testStream := MAKE_-OUTSTREAM(filename,255,0)) =>
+      SHUT $texOutputStream
+      $texOutputStream := testStream
+      $texOutputFile := object2String filename
+      sayKeyedMsg("S2IV0004",['"TeX",$texOutputFile])
+    sayKeyedMsg("S2IV0003",[fn,ft,fm])
+
+  sayKeyedMsg("S2IV0005",NIL)
+  describeSetOutputTex()
+
+@
+\subsection{describeSetOutputTex}
+<<describeSetOutputTex>>=
+describeSetOutputTex() ==
+  sayBrightly LIST ('%b,'")set output tex",'%d,_
+   '"is used to tell AXIOM to turn TeX-style output",'%l,_
+   '"printing on and off, and where to place the output.  By default, the",'%l,_
+   '"destination for the output is the screen but printing is turned off.",'%l,_
+   '%l,_
+   '"Syntax:   )set output tex <arg>",'%l,_
+  '"    where arg can be one of",'%l,_
+  '"  on          turn TeX printing on",'%l,_
+  '"  off         turn TeX printing off (default state)",'%l,_
+  '"  console     send TeX output to screen (default state)",'%l,_
+  '"  fp<.fe>     send TeX output to file with file prefix fp and file",'%l,_
+  '"              extension .fe. If not given, .fe defaults to .stex.",'%l,
+  '%l,_
+  '"If you wish to send the output to a file, you must issue this command",'%l,_
+  '"twice: once with",'%b,'"on",'%d,'"and once with the file name. For example, to send",'%l,_
+  '"TeX output to the file",'%b,'"polymer.stex,",'%d,'"issue the two commands",'%l,_
+  '%l,_
+  '"  )set output tex on",'%l,_
+  '"  )set output tex polymer",'%l,_
+  '%l,_
+  '"The output is placed in the directory from which you invoked AXIOM or",'%l,_
+  '"the one you set with the )cd system command.",'%l,_
+  '"The current setting is: ",'%b,setOutputTex "%display%",'%d)
+
+@
+\section{streams calculate}
+See the section streams in setvart.boot.pamphlet\cite{1}
+\begin{verbatim}
+              Current Values of  streams  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+calculate    specify number of elements to calculate    10 
+showall      display all stream elements computed       off 
+
+\end{verbatim}
+<<streamscalculateCode>>=
+<<setStreamsCalculate>>
+<<describeSetStreamsCalculate>>
+@
+\subsection{setStreamsCalculate}
+<<setStreamsCalculate>>=
+setStreamsCalculate arg ==
+  arg = "%initialize%" =>
+    $streamCount := 10
+  arg = "%display%" =>
+    object2String $streamCount
+  (null arg) or (arg = "%describe%") or (first arg = '_?) =>
+    describeSetStreamsCalculate()
+  n := first arg
+  (n ^= 'all) and ((not FIXP n) or (n < 0)) =>
+    sayMessage ['"Your value of",:bright n,'"is invalid because ..."]
+    describeSetStreamsCalculate()
+    terminateSystemCommand()
+  $streamCount := n
+
+@
+\subsection{describeSetStreamsCalculate}
+<<describeSetStreamsCalculate>>=
+describeSetStreamsCalculate() == sayKeyedMsg("S2IV0001",[$streamCount])
+
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+<<toplevelsetfunctions>>
+<<compilerCode>>
+<<exposeCode>>
+<<fortrancallingCode>>
+<<functionsCode>>
+<<historyCode>>
+<<kernelCode>>
+<<naglinkCode>>
+<<outputalgebraCode>>
+<<outputcharactersCode>>
+<<outputfortranCode>>
+<<outputopenmathCode>>
+<<outputscriptCode>>
+<<outputtexCode>>
+<<streamscalculateCode>>
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} setvart.boot.pamphlet
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/setvart.boot.pamphlet b/src/interp/setvart.boot.pamphlet
new file mode 100644
index 00000000..98dda551
--- /dev/null
+++ b/src/interp/setvart.boot.pamphlet
@@ -0,0 +1,2387 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp setvart.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{Overview}
+This file contains functions to initialize the {\bf )set} command
+in the interpreter. The current list is:
+\begin{verbatim}
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+compiler   Library compiler options                   ... 
+breakmode  execute break processing on error          break 
+expose     control interpreter constructor exposure   ... 
+functions  some interpreter function options          ... 
+fortran    view and set options for FORTRAN output    ... 
+kernel     library functions built into the kernel for 
+           efficiency                                 ...
+hyperdoc   options in using HyperDoc                  ... 
+help       view and set some help options             ... 
+history    save workspace values in a history file    on 
+messages   show messages for various system features  ... 
+naglink    options for NAGLink                        ... 
+output     view and set some output options           ... 
+quit       protected or unprotected quit              unprotected 
+streams    set some options for working with streams  ... 
+system     set some system development variables      ... 
+userlevel  operation access level of system user      development 
+
+Variables with current values of ... have further sub-options. 
+For example, issue )set  system to see what the options are 
+for system. 
+For more information, issue )help set .
+
+\end{verbatim}
+\subsection{The list structure}
+The structure of each list item consists of 7 items.  Consider this 
+example:
+\begin{verbatim}
+  (userlevel
+   "operation access level of system user"
+   interpreter
+   LITERALS
+   $UserLevel
+   (interpreter compiler development)
+   development)
+\end{verbatim}
+The list looks like (the names in bold are accessor names that can be
+found in {\bf property.lisp.pamphlet\cite{1}}. Look for "setName".):
+\begin{list}{}
+\item {\bf 1} {\sl Name} the keyword the user will see. In this example
+the user would say "{\bf )set output userlevel}".
+\item {\bf 2} {\sl Label} the message the user will see. In this example
+the user would see "operation access level of system user".
+\item {\bf 3} {\sl Level} the level where the command will be 
+accepted. There are three levels: interpreter, compiler, development.
+These commands are restricted to keep the user from causing damage.
+\item {\bf 4} {\sl Type} a symbol, one of {\bf FUNCTION}, {\bf INTEGER},
+{\bf STRING}, {\bf LITERALS}, or {\bf TREE}. See the function
+{\bf initializeSetVariables} in the file
+{\bf setvars.boot.pamphlet\cite{2}}.
+\item {\bf 5} {\sl Var} variable which holds the current user setting.
+\item {\bf 6} {\sl Leaf} is a list of all of the user levels
+that expose this command.
+\item {\bf 7} {\sl Def} is the default value of this variable.
+\end{list}
+\section{breakmode}
+\begin{verbatim}
+-------------------- The breakmode Option ---------------------
+
+ Description: execute break processing on error
+
+ The breakmode option may be followed by any one of the 
+ following:
+
+    nobreak
+ -> break 
+    query
+    resume
+    fastlinks
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<breakmode>>=
+  (breakmode
+   "execute break processing on error"
+   interpreter
+   LITERALS
+   $BreakMode
+   (nobreak break query resume fastlinks)
+   nobreak)         -- needed to avoid possible startup looping
+@
+\section{compiler}
+\begin{verbatim}
+                  Current Values of  compiler  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+output       library in which to place compiled code     
+input        controls libraries from which to load compiled code  
+args         arguments for compiling AXIOM code         
+             -O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete 
+             -DAxiom -Y $AXIOM/algebra 
+
+\end{verbatim}
+<<compiler>>=
+   (compiler
+    "Library compiler options"
+    interpreter
+    TREE
+    novar
+    (
+<<compileroutput>>
+<<compilerinput>>
+<<compilerargs>>
+    ))
+@
+\subsection{output}
+\begin{verbatim}
+---------------------- The output Option ----------------------
+
+ Description: library in which to place compiled code
+
+\end{verbatim}
+<<compileroutput>>=
+      (output
+       "library in which to place compiled code"
+       interpreter
+       FUNCTION
+       setOutputLibrary
+       NIL
+       htSetOutputLibrary 
+	)
+@
+\subsection{input}
+\begin{verbatim}
+---------------------- The input Option -----------------------
+
+ Description: controls libraries from which to load compiled code
+
+ )set compiler input add library is used to tell AXIOM to add 
+  library to the front of the path which determines where 
+  compiled code is loaded from.
+ )set compiler input drop library is used to tell AXIOM to remove 
+  library from this path.
+\end{verbatim}
+<<compilerinput>>=
+      (input
+       "controls libraries from which to load compiled code"
+       interpreter
+       FUNCTION
+       setInputLibrary
+       NIL
+       htSetInputLibrary)
+@
+\subsection{args}
+\begin{verbatim}
+----------------------- The args Option -----------------------
+
+ Description: arguments for compiling AXIOM code
+
+ )set compiler args  is used to tell AXIOM how to invoke the 
+  library compiler when compiling code for AXIOM.
+  The args option is followed by a string enclosed in double 
+  quotes.
+
+ The current setting is
+ "-O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete 
+  -DAxiom -Y $AXIOM/algebra" 
+\end{verbatim}
+<<compilerargs>>=
+      (args
+       "arguments for compiling AXIOM code"
+       interpreter
+       FUNCTION
+       setAsharpArgs
+       (("enter compiler options "
+          STRING
+          $asharpCmdlineFlags
+          chkDirectory
+          "-O -Fasy -Fao -Flsp -laxiom -Mno-AXL__W__WillObsolete -DAxiom -Y $AXIOM/algebra"))
+       NIL)
+@
+\section{expose}
+\begin{verbatim}
+---------------------- The expose Option ----------------------
+
+ Description: control interpreter constructor exposure
+
+   The following groups are explicitly exposed in the current 
+   frame (called initial ):
+                                   basic                                   
+                                categories                                 
+                                  naglink                                  
+                                   anna                                    
+ 
+   The following constructors are explicitly exposed in the 
+   current frame:
+               there are no explicitly exposed constructors                
+ 
+   The following constructors are explicitly hidden in the 
+   current frame:
+                there are no explicitly hidden constructors                
+ 
+   When )set expose is followed by no arguments, the information
+   you now see is displayed. When followed by the initialize 
+   argument, the exposure group data in the file INTERP.EXPOSED 
+   is read and is then available. The arguments add and drop are 
+   used to add or drop exposure groups or explicit constructors 
+   from the local frame exposure data. Issue
+                  )set expose add    or    )set expose drop 
+   for more information.
+\end{verbatim}
+<<expose>>=
+  (expose
+   "control interpreter constructor exposure"
+   interpreter
+   FUNCTION
+   setExpose
+   NIL
+   htSetExpose)
+@
+\section{functions}
+\begin{verbatim}
+             Current Values of  functions  Variables                  
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+cache        number of function results to cache        0 
+compile      compile, don't just define function bodies off 
+recurrence   specially compile recurrence relations     on 
+
+\end{verbatim}
+<<functions>>=
+  (functions
+   "some interpreter function options"
+   interpreter
+   TREE
+   novar
+   (
+<<functionscache>>
+<<functionscompile>>
+<<functionsrecurrence>>
+  ))
+@
+\subsection{cache}
+\begin{verbatim}
+---------------------- The cache Option -----------------------
+
+ Description: number of function results to cache
+
+ )set functions cache is used to tell AXIOM how many  values 
+  computed by interpreter functions should be saved.  This can 
+  save quite a bit of time in recursive functions, though one 
+  must consider that the cached values will take up (perhaps 
+  valuable) room in the workspace.
+
+ The value given  after cache must either be the word all or 
+ a positive integer. This may be followed by any number of 
+ function names whose cache sizes you wish to so set.  If no 
+ functions are given, the default cache  size is set.
+
+ Examples:   )set fun cache all
+             )set fun cache 10 f g Legendre
+
+ In general, functions will cache no returned values.
+\end{verbatim}
+<<functionscache>>=
+     (cache
+      "number of function results to cache"
+      interpreter
+      FUNCTION
+      setFunctionsCache
+      NIL
+      htSetCache)
+@
+\subsection{compile}
+Per suggestion by Bill Page this has been defaulted to [[on]].
+\begin{verbatim}
+--------------------- The compile Option ----------------------
+
+ Description: compile, don't just define function bodies
+
+ The compile option may be followed by any one of the following:
+
+ -> on
+    off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<functionscompile>>=
+     (compile
+      "compile, don't just define function bodies"
+      interpreter
+      LITERALS
+      $compileDontDefineFunctions
+      (on off)
+      on)
+@
+\subsection{recurrence}
+\begin{verbatim}
+-------------------- The recurrence Option --------------------
+
+ Description: specially compile recurrence relations
+
+ The recurrence option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<functionsrecurrence>>=
+     (recurrence
+      "specially compile recurrence relations"
+      interpreter
+      LITERALS
+      $compileRecurrence
+      (on off)
+      on)
+@
+\section{fortran}
+\begin{verbatim}
+              Current Values of  fortran  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+ints2floats  where sensible, coerce integers to reals   on 
+fortindent   the number of characters indented          6 
+fortlength   the number of characters on a line         72 
+typedecs     print type and dimension lines             on 
+defaulttype  default generic type for FORTRAN object    REAL 
+precision    precision of generated FORTRAN objects     double 
+intrinsic    whether to use INTRINSIC FORTRAN functions off 
+explength    character limit for FORTRAN expressions    1320 
+segment      split long FORTRAN expressions             on 
+optlevel     FORTRAN optimisation level                 0 
+startindex   starting index for FORTRAN arrays          1 
+calling      options for external FORTRAN calls         ... 
+
+Variables with current values of ... have further sub-options. 
+For example, issue )set calling to see what the options are for 
+calling.
+For more information, issue )help set .
+\end{verbatim}
+<<fortran>>=
+  (fortran
+   "view and set options for FORTRAN output"
+   interpreter
+   TREE
+   novar
+    (
+<<fortranints2floats>>
+<<fortranfortindent>>
+<<fortranfortlength>>
+<<fortrantypedecs>>
+<<fortrandefaulttype>>
+<<fortranprecision>>
+<<fortranintrinsic>>
+<<fortranexplength>>
+<<fortransegment>>
+<<fortranoptlevel>>
+<<fortranstartindex>>
+<<fortrancalling>>
+  ))
+@
+\subsection{ints2floats}
+\begin{verbatim}
+------------------- The ints2floats Option --------------------
+
+ Description: where sensible, coerce integers to reals
+
+ The ints2floats option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortranints2floats>>=
+     (ints2floats
+      "where sensible, coerce integers to reals"
+      interpreter
+      LITERALS
+      $fortInts2Floats
+      (on off)
+      on)
+@
+\subsection{fortindent}
+\begin{verbatim}
+-------------------- The fortindent Option --------------------
+
+ Description: the number of characters indented
+
+ The fortindent option may be followed by an integer in the range 
+ 0 to inclusive. The current setting is 6 
+
+\end{verbatim}
+<<fortranfortindent>>=
+     (fortindent
+      "the number of characters indented"
+      interpreter
+      INTEGER
+      $fortIndent
+      (0 NIL)
+      6)
+@
+\subsection{fortlength}
+\begin{verbatim}
+-------------------- The fortlength Option --------------------
+
+ Description: the number of characters on a line
+
+ The fortlength option may be followed by an integer in the range 
+ 1 to inclusive. The current setting is 72 
+
+\end{verbatim}
+<<fortranfortlength>>=
+     (fortlength
+      "the number of characters on a line"
+      interpreter
+      INTEGER
+      $fortLength
+      (1 NIL)
+      72)
+@
+\subsection{typedecs}
+\begin{verbatim}
+--------------------- The typedecs Option ---------------------
+
+ Description: print type and dimension lines
+
+ The typedecs option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortrantypedecs>>=
+     (typedecs
+      "print type and dimension lines"
+      interpreter
+      LITERALS
+      $printFortranDecs
+      (on off)
+      on)
+@
+\subsection{defaulttype}
+\begin{verbatim}
+------------------- The defaulttype Option --------------------
+
+ Description: default generic type for FORTRAN object
+
+ The defaulttype option may be followed by any one of the 
+ following:
+
+ -> REAL 
+    INTEGER
+    COMPLEX
+    LOGICAL
+    CHARACTER
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortrandefaulttype>>=
+     (defaulttype
+      "default generic type for FORTRAN object"
+      interpreter
+      LITERALS
+      $defaultFortranType
+      (REAL INTEGER COMPLEX LOGICAL CHARACTER)
+      REAL)
+@
+\subsection{precision}
+\begin{verbatim}
+-------------------- The precision Option ---------------------
+
+ Description: precision of generated FORTRAN objects
+
+ The precision option may be followed by any one of the 
+ following:
+
+    single
+ -> double 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortranprecision>>=
+      (precision
+      "precision of generated FORTRAN objects"
+       interpreter
+       LITERALS
+       $fortranPrecision
+       (single double)
+       double)
+@
+\subsection{intrinsic}
+\begin{verbatim}
+-------------------- The intrinsic Option ---------------------
+
+ Description: whether to use INTRINSIC FORTRAN functions
+
+ The intrinsic option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortranintrinsic>>=
+      (intrinsic
+       "whether to use INTRINSIC FORTRAN functions"
+       interpreter
+       LITERALS
+       $useIntrinsicFunctions
+       (on off)
+       off)
+@
+\subsection{explength}
+\begin{verbatim}
+-------------------- The explength Option ---------------------
+
+ Description: character limit for FORTRAN expressions
+
+ The explength option may be followed by an integer in the range 
+ 0 to inclusive. The current setting is 1320 
+
+\end{verbatim}
+<<fortranexplength>>=
+      (explength
+       "character limit for FORTRAN expressions"
+       interpreter
+       INTEGER
+       $maximumFortranExpressionLength
+       (0 NIL)
+       1320)
+@
+\subsection{segment}
+\begin{verbatim}
+--------------------- The segment Option ----------------------
+
+ Description: split long FORTRAN expressions
+
+ The segment option may be followed by any one of the following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<fortransegment>>=
+      (segment
+       "split long FORTRAN expressions"
+       interpreter
+       LITERALS
+       $fortranSegment
+       (on off)
+       on)
+@
+\subsection{optlevel}
+\begin{verbatim}
+--------------------- The optlevel Option ---------------------
+
+ Description: FORTRAN optimisation level
+
+ The optlevel option may be followed by an integer in the range 
+ 0 to 2 inclusive. The current setting is 0 
+
+\end{verbatim}
+<<fortranoptlevel>>=
+      (optlevel
+       "FORTRAN optimisation level"
+       interpreter
+       INTEGER
+       $fortranOptimizationLevel
+       (0 2)
+       0)
+@
+\subsection{startindex}
+\begin{verbatim}
+-------------------- The startindex Option --------------------
+
+ Description: starting index for FORTRAN arrays
+
+ The startindex option may be followed by an integer in the range 
+ 0 to 1 inclusive. The current setting is 1 
+
+\end{verbatim}
+<<fortranstartindex>>=
+      (startindex
+       "starting index for FORTRAN arrays"
+       interpreter
+       INTEGER
+       $fortranArrayStartingIndex
+       (0 1)
+       1)
+@
+\subsection{calling}
+\begin{verbatim}
+              Current Values of  calling  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+tempfile     set location of temporary data files       /tmp/ 
+directory    set location of generated FORTRAN files    ./ 
+linker       linker arguments (e.g. libraries to search) -lxlf 
+
+\end{verbatim}
+<<fortrancalling>>=
+      (calling
+      "options for external FORTRAN calls"
+      interpreter
+      TREE
+      novar
+      (
+<<callingtempfile>>
+<<callingdirectory>>
+<<callinglinker>>
+       )
+      )
+@
+\subsubsection{tempfile}
+\begin{verbatim}
+--------------------- The tempfile Option ---------------------
+
+ Description: set location of temporary data files
+
+ )set fortran calling tempfile  is used to tell AXIOM where
+ to place intermediate FORTRAN data files . This must be the 
+ name of a valid existing directory to which you have permission 
+ to write (including the final slash).
+
+ Syntax:
+   )set fortran calling tempfile DIRECTORYNAME
+
+ The current setting is /tmp/ 
+\end{verbatim}
+<<callingtempfile>>=
+        (tempfile
+         "set location of temporary data files"
+         interpreter
+         FUNCTION
+         setFortTmpDir
+         (("enter directory name for which you have write-permission"
+           DIRECTORY
+           $fortranTmpDir
+           chkDirectory
+           "/tmp/"))
+         NIL)
+@
+\subsubsection{directory}
+\begin{verbatim}
+-------------------- The directory Option ---------------------
+
+ Description: set location of generated FORTRAN files
+
+ )set fortran calling directory  is used to tell AXIOM where
+ to place generated FORTRAN files. This must be the name 
+ of a valid existing directory to which you have permission 
+ to write (including the final slash).
+
+ Syntax:
+   )set fortran calling directory DIRECTORYNAME
+
+ The current setting is ./ 
+\end{verbatim}
+<<callingdirectory>>=
+        (directory
+         "set location of generated FORTRAN files"
+         interpreter
+         FUNCTION
+         setFortDir
+         (("enter directory name for which you have write-permission"
+           DIRECTORY
+           $fortranDirectory
+           chkDirectory
+           "./"))
+         NIL)
+@
+\subsubsection{linker}
+\begin{verbatim}
+---------------------- The linker Option ----------------------
+
+ Description: linker arguments (e.g. libraries to search)
+
+ )set fortran calling linkerargs is used to pass arguments to 
+ the linker when using  mkFort  to create functions which call 
+ Fortran code. For example, it might give a list of libraries 
+ to be searched, and their locations.
+ The string is passed verbatim, so must be the correct syntax for
+ the particular linker being used.
+
+ Example: )set fortran calling linker "-lxlf"
+
+ The current setting is -lxlf 
+\end{verbatim}
+<<callinglinker>>=
+        (linker
+         "linker arguments (e.g. libraries to search)"
+         interpreter
+         FUNCTION
+         setLinkerArgs
+         (("enter linker arguments "
+           STRING
+           $fortranLibraries
+           chkDirectory
+           "-lxlf"))
+         NIL
+         )
+@
+\section{kernel}
+\begin{verbatim}
+              Current Values of  kernel  Variables                    
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+warn         warn when re-definition is attempted       off 
+protect      prevent re-definition of kernel functions  off 
+
+\end{verbatim}
+<<kernel>>=
+  (kernel
+   "library functions built into the kernel for efficiency"
+   interpreter
+   TREE
+   novar
+   (
+<<kernelwarn>>
+<<kernelprotect>>
+   )
+  )
+@
+\subsection{kernelwarn}
+\begin{verbatim}
+----------------------- The warn Option -----------------------
+
+ Description: warn when re-definition is attempted
+
+Some AXIOM library functions are compiled into the kernel for 
+efficiency reasons. To prevent them being re-defined when loaded 
+from a library they are specially protected. If a user wishes to 
+know when an attempt is made to re-define such a function, he or 
+she should issue the command:
+        )set kernel warn on
+To restore the default behaviour, he or she should issue the 
+command:
+        )set kernel warn off
+\end{verbatim}
+<<kernelwarn>>=
+     (warn
+      "warn when re-definition is attempted"
+      interpreter
+      FUNCTION
+      protectedSymbolsWarning
+      NIL
+      htSetKernelWarn)
+@
+\subsection{kernelprotect}
+\begin{verbatim}
+--------------------- The protect Option ----------------------
+
+ Description: prevent re-definition of kernel functions
+
+Some AXIOM library functions are compiled into the kernel for 
+efficiency reasons. To prevent them being re-defined when loaded
+from a library they are specially protected.  If a user wishes 
+to re-define these functions, he or she should issue the command:
+        )set kernel protect off
+To restore the default behaviour, he or she should issue the 
+command:
+        )set kernel protect on
+\end{verbatim}
+<<kernelprotect>>=
+     (protect
+      "prevent re-definition of kernel functions"
+      interpreter
+      FUNCTION
+      protectSymbols
+      NIL
+      htSetKernelProtect)
+@
+\section{hyperdoc}
+\begin{verbatim}
+             Current Values of  hyperdoc  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+fullscreen   use full screen for this facility          off 
+mathwidth    screen width for history output            120 
+
+\end{verbatim}
+<<hyperdoc>>=
+  (hyperdoc
+   "options in using HyperDoc"
+   interpreter
+   TREE
+   novar
+   (
+<<hyperdocfullscreen>>
+<<hyperdocmathwidth>>
+   ))
+@
+\subsection{fullscreen}
+\begin{verbatim}
+-------------------- The fullscreen Option --------------------
+
+ Description: use full screen for this facility
+
+ The fullscreen option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<hyperdocfullscreen>>=
+     (fullscreen
+      "use full screen for this facility"
+      interpreter
+      LITERALS
+      $fullScreenSysVars
+      (on off)
+      off)
+@
+\subsection{mathwidth}
+\begin{verbatim}
+-------------------- The mathwidth Option ---------------------
+
+ Description: screen width for history output
+
+ The mathwidth option may be followed by an integer in the range 
+ 0 to inclusive. The current setting is 120 
+
+\end{verbatim}
+<<hyperdocmathwidth>>=
+     (mathwidth
+      "screen width for history output"
+      interpreter
+      INTEGER
+      $historyDisplayWidth
+      (0 NIL)
+      120)
+@
+\section{help}
+\begin{verbatim}
+               Current Values of  help  Variables                     
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+fullscreen   use fullscreen facility, if possible       off 
+
+\end{verbatim}
+<<help>>=
+  (help
+   "view and set some help options"
+   interpreter
+   TREE
+   novar
+   (
+<<helpfullscreen>>
+   ))
+@
+\subsection{fullscreen}
+\begin{verbatim}
+-------------------- The fullscreen Option --------------------
+
+ Description: use fullscreen facility, if possible
+
+ The fullscreen option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<helpfullscreen>>=
+    (fullscreen
+     "use fullscreen facility, if possible"
+     interpreter
+     LITERALS
+     $useFullScreenHelp
+     (on off)
+     off)
+@
+\section{history}
+\begin{verbatim}
+--------------------- The history Option ----------------------
+
+ Description: save workspace values in a history file
+
+ The history option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<history>>=
+  (history
+   "save workspace values in a history file"
+   interpreter
+   LITERALS
+   $HiFiAccess
+   (on off)
+   on)
+@
+\section{messages}
+\begin{verbatim}
+             Current Values of  messages  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+autoload     print file auto-load messages              off 
+bottomup     display bottom up modemap selection        off 
+coercion     display datatype coercion messages         off 
+dropmap      display old map defn when replaced         off 
+expose       warning for unexposed functions            off 
+file         print msgs also to SPADMSG LISTING         off 
+frame        display messages about frames              off 
+highlighting use highlighting in system messages        off 
+instant      present instantiation summary              off 
+insteach     present instantiation info                 off 
+interponly   say when function code is interpreted      on 
+number       display message number with message        off 
+prompt       set type of input prompt to display        step 
+selection    display function selection msgs            off 
+set          show )set setting after assignment         off 
+startup      display messages on start-up               off 
+summary      print statistics after computation         off 
+testing      print system testing header                off 
+time         print timings after computation            off 
+type         print type after computation               on 
+void         print Void value when it occurs            off 
+any          print the internal type of objects of domain Any on 
+naglink      show NAGLink messages                      on 
+
+\end{verbatim}
+<<messages>>=
+  (messages
+   "show messages for various system features"
+   interpreter
+   TREE
+   novar
+   (
+<<messagesany>>
+<<messagesautoload>>
+<<messagesbottomup>>
+<<messagescoercion>>
+<<messagesdropmap>>
+<<messagesexpose>>
+<<messagesfile>>
+<<messagesframe>>
+<<messageshighlighting>>
+<<messagesinstant>>
+<<messagesinsteach>>
+<<messagesinterponly>>
+<<messagesnaglink>>
+<<messagesnumber>>
+<<messagesprompt>>
+<<messagesselection>>
+<<messagesset>>
+<<messagesstartup>>
+<<messagessummary>>
+<<messagestesting>>
+<<messagestime>>
+<<messagestype>>
+<<messagesvoid>>
+   ))
+@
+\subsection{any}
+\begin{verbatim}
+----------------------- The any Option ------------------------
+
+ Description: print the internal type of objects of domain Any
+
+ The any option may be followed by any one of the following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesany>>=
+     (any
+      "print the internal type of objects of domain Any"
+      interpreter
+      LITERALS
+      $printAnyIfTrue
+      (on off)
+      on)
+@
+\subsection{autoload}
+\begin{verbatim}
+--------------------- The autoload Option ---------------------
+
+ Description: print file auto-load messages
+
+\end{verbatim}
+<<messagesautoload>>=
+     (autoload
+      "print file auto-load messages"
+      interpreter
+      FUNCTION
+      printLoadMessages
+      (on off)
+      on)
+@
+\subsection{bottomup}
+\begin{verbatim}
+--------------------- The bottomup Option ---------------------
+
+ Description: display bottom up modemap selection
+
+ The bottomup option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesbottomup>>=
+     (bottomup
+      "display bottom up modemap selection"
+      development
+      LITERALS
+      $reportBottomUpFlag
+      (on off)
+      off)
+@
+\subsection{coercion}
+\begin{verbatim}
+--------------------- The coercion Option ---------------------
+
+ Description: display datatype coercion messages
+
+ The coercion option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagescoercion>>=
+     (coercion
+      "display datatype coercion messages"
+      development
+      LITERALS
+      $reportCoerceIfTrue
+      (on off)
+      off)
+@
+\subsection{dropmap}
+\begin{verbatim}
+--------------------- The dropmap Option ----------------------
+
+ Description: display old map defn when replaced
+
+ The dropmap option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesdropmap>>=
+     (dropmap
+      "display old map defn when replaced"
+      interpreter
+      LITERALS
+      $displayDroppedMap
+      (on off)
+      off)
+@
+\subsection{expose}
+\begin{verbatim}
+---------------------- The expose Option ----------------------
+
+ Description: warning for unexposed functions
+
+ The expose option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesexpose>>=
+     (expose
+      "warning for unexposed functions"
+      interpreter
+      LITERALS
+      $giveExposureWarning
+      (on off)
+      off)
+@
+\subsection{file}
+\begin{verbatim}
+----------------------- The file Option -----------------------
+
+ Description: print msgs also to SPADMSG LISTING
+
+ The file option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesfile>>=
+     (file
+      "print msgs also to SPADMSG LISTING"
+      development
+      LITERALS
+      $printMsgsToFile
+      (on off)
+      off)
+@
+\subsection{frame}
+\begin{verbatim}
+---------------------- The frame Option -----------------------
+
+ Description: display messages about frames
+
+ The frame option may be followed by any one of the following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesframe>>=
+     (frame
+      "display messages about frames"
+      interpreter
+      LITERALS
+      $frameMessages
+      (on off)
+      off)
+@
+\subsection{highlighting}
+\begin{verbatim}
+------------------- The highlighting Option -------------------
+
+ Description: use highlighting in system messages
+
+ The highlighting option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messageshighlighting>>=
+     (highlighting
+      "use highlighting in system messages"
+      interpreter
+      LITERALS
+      $highlightAllowed
+      (on off)
+      off)
+@
+\subsection{instant}
+\begin{verbatim}
+--------------------- The instant Option ----------------------
+
+ Description: present instantiation summary
+
+ The instant option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesinstant>>=
+     (instant
+      "present instantiation summary"
+      development
+      LITERALS
+      $reportInstantiations
+      (on off)
+      off)
+@
+\subsection{insteach}
+\begin{verbatim}
+--------------------- The insteach Option ---------------------
+
+ Description: present instantiation info
+
+ The insteach option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesinsteach>>=
+     (insteach
+      "present instantiation info"
+      development
+      LITERALS
+      $reportEachInstantiation
+      (on off)
+      off)
+@
+\subsection{interponly}
+\begin{verbatim}
+-------------------- The interponly Option --------------------
+
+ Description: say when function code is interpreted
+
+ The interponly option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesinterponly>>=
+     (interponly
+      "say when function code is interpreted"
+      interpreter
+      LITERALS
+      $reportInterpOnly
+      (on off)
+      on)
+@
+\subsection{naglink}
+\begin{verbatim}
+--------------------- The naglink Option ----------------------
+
+ Description: show NAGLink messages
+
+ The naglink option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesnaglink>>=
+     (naglink
+      "show NAGLink messages"
+      interpreter
+      LITERALS
+      $nagMessages
+      (on off)
+      on)
+@
+\subsection{number}
+\begin{verbatim}
+---------------------- The number Option ----------------------
+
+ Description: display message number with message
+
+ The number option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesnumber>>=
+     (number
+      "display message number with message"
+      interpreter
+      LITERALS
+      $displayMsgNumber
+      (on off)
+      off)
+@
+\subsection{prompt}
+\begin{verbatim}
+---------------------- The prompt Option ----------------------
+
+ Description: set type of input prompt to display
+
+ The prompt option may be followed by any one of the following:
+
+    none
+    frame
+    plain
+ -> step 
+    verbose
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesprompt>>=
+     (prompt
+      "set type of input prompt to display"
+      interpreter
+      LITERALS
+      $inputPromptType
+      (none frame plain step verbose)
+      step)
+@
+\subsection{selection}
+\begin{verbatim}
+-------------------- The selection Option ---------------------
+
+ Description: display function selection msgs
+
+ The selection option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesselection>>=
+     (selection
+      "display function selection msgs"
+      interpreter
+      LITERALS
+      $reportBottomUpFlag
+      (on off)
+      off)
+@
+\subsection{set}
+\begin{verbatim}
+----------------------- The set Option ------------------------
+
+ Description: show )set setting after assignment
+
+ The set option may be followed by any one of the following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesset>>=
+     (set
+      "show )set setting after assignment"
+      interpreter
+      LITERALS
+      $displaySetValue
+      (on off)
+      off)
+@
+\subsection{startup}
+\begin{verbatim}
+--------------------- The startup Option ----------------------
+
+ Description: display messages on start-up
+
+ The startup option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesstartup>>=
+     (startup
+      "display messages on start-up"
+      interpreter
+      LITERALS
+      $displayStartMsgs
+      (on off)
+      on)
+@
+\subsection{summary}
+\begin{verbatim}
+--------------------- The summary Option ----------------------
+
+ Description: print statistics after computation
+
+ The summary option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagessummary>>=
+     (summary
+      "print statistics after computation"
+      interpreter
+      LITERALS
+      $printStatisticsSummaryIfTrue
+      (on off)
+      off)
+@
+\subsection{testing}
+\begin{verbatim}
+--------------------- The testing Option ----------------------
+
+ Description: print system testing header
+
+ The testing option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagestesting>>=
+     (testing
+      "print system testing header"
+      development
+      LITERALS
+      $testingSystem
+      (on off)
+      off)
+@
+\subsection{time}
+\begin{verbatim}
+----------------------- The time Option -----------------------
+
+ Description: print timings after computation
+
+ The time option may be followed by any one of the following:
+
+    on
+ -> off 
+    long
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagestime>>=
+     (time
+      "print timings after computation"
+      interpreter
+      LITERALS
+      $printTimeIfTrue
+      (on off long)
+      off)
+@
+\subsection{type}
+\begin{verbatim}
+----------------------- The type Option -----------------------
+
+ Description: print type after computation
+
+ The type option may be followed by any one of the following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagestype>>=
+     (type
+      "print type after computation"
+      interpreter
+      LITERALS
+      $printTypeIfTrue
+      (on off)
+      on)
+@
+\subsection{void}
+\begin{verbatim}
+----------------------- The void Option -----------------------
+
+ Description: print Void value when it occurs
+
+ The void option may be followed by any one of the following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<messagesvoid>>=
+     (void
+      "print Void value when it occurs"
+      interpreter
+      LITERALS
+      $printVoidIfTrue
+      (on off)
+      off)
+@
+\section{naglink}
+\begin{verbatim}
+              Current Values of  naglink  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+host         internet address of host for NAGLink       localhost 
+persistence  number of (fortran) functions to remember  1 
+messages     show NAGLink messages                      on 
+double       enforce DOUBLE PRECISION ASPs              on 
+
+\end{verbatim}
+<<naglink>>=
+  (naglink
+   "options for NAGLink"
+   interpreter
+   TREE
+   novar
+   (
+<<naglinkhost>>
+<<naglinkpersistence>>
+<<naglinkmessages>>
+<<naglinkdouble>>
+   ))
+@
+\subsection{host}
+\begin{verbatim}
+----------------------- The host Option -----------------------
+
+ Description: internet address of host for NAGLink
+
+ )set naglink host is used to tell  AXIOM which  host to contact
+ for a NAGLink request. An Internet address should be supplied. 
+ The host specified must be running the NAGLink daemon.
+
+ The current setting is localhost 
+\end{verbatim}
+<<naglinkhost>>=
+     (host
+      "internet address of host for NAGLink"
+      interpreter
+      FUNCTION
+      setNagHost
+      (("enter host name"
+        DIRECTORY
+        $nagHost
+        chkDirectory
+        "localhost"))
+      NIL)
+@
+\subsection{persistence}
+\begin{verbatim}
+------------------- The persistence Option --------------------
+
+ Description: number of (fortran) functions to remember
+
+ )set naglink persistence is used to tell  the  nagd  daemon how
+  many ASP source and object files to keep around in case you 
+  reuse them. This helps to avoid needless recompilations. The 
+  number specified should be a non-negative integer.
+
+ The current setting is 1 
+\end{verbatim}
+<<naglinkpersistence>>=
+     (persistence
+      "number of (fortran) functions to remember"
+      interpreter
+      FUNCTION
+      setFortPers
+      (("Requested remote storage (for asps):"
+       INTEGER
+       $fortPersistence
+       (0 NIL)
+       10))
+      NIL)
+@
+\subsection{messages}
+\begin{verbatim}
+--------------------- The messages Option ---------------------
+
+ Description: show NAGLink messages
+
+ The messages option may be followed by any one of the 
+ following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<naglinkmessages>>=
+     (messages
+      "show NAGLink messages"
+      interpreter
+      LITERALS
+      $nagMessages
+      (on off)
+       on)
+@
+\subsection{double}
+\begin{verbatim}
+---------------------- The double Option ----------------------
+
+ Description: enforce DOUBLE PRECISION ASPs
+
+ The double option may be followed by any one of the following:
+
+ -> on 
+    off
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<naglinkdouble>>=
+     (double
+      "enforce DOUBLE PRECISION ASPs"
+      interpreter
+      LITERALS
+      $nagEnforceDouble
+      (on off)
+      on)
+@
+\section{output}
+The result of the {\bf )set output} command is:
+\begin{verbatim}
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+abbreviate  abbreviate type names                    off 
+algebra     display output in algebraic form         On:CONSOLE 
+characters  choose special output character set      plain 
+script      display output in SCRIPT formula format  Off:CONSOLE 
+fortran     create output in FORTRAN format          Off:CONSOLE 
+fraction    how fractions are formatted              vertical 
+length      line length of output displays           77 
+scripts     show subscripts,... linearly             off 
+showeditor  view output of )show in editor           off 
+tex         create output in TeX style               Off:CONSOLE 
+\end{verbatim}
+Since the output option has a bunch of sub-options each suboption 
+is defined within the output structure.
+<<output>>=
+  (output
+   "view and set some output options"
+   interpreter
+   TREE
+   novar
+    (
+<<outputabbreviate>>
+<<outputalgebra>>
+<<outputcharacters>>
+<<outputfortran>>
+<<outputfraction>>
+<<outputlength>>
+<<outputopenmath>>
+<<outputscript>>
+<<outputscripts>>
+<<outputshoweditor>>
+<<outputtex>>
+ ))
+@
+\subsection{abbreviate}
+\begin{verbatim}
+-------------------- The abbreviate Option --------------------
+
+ Description: abbreviate type names
+
+ The abbreviate option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+\end{verbatim}
+<<outputabbreviate>>=
+     (abbreviate
+      "abbreviate type names"
+      interpreter
+      LITERALS
+      $abbreviateTypes
+      (on off)
+      off)
+@
+\subsection{algebra}
+\begin{verbatim}
+--------------------- The algebra Option ----------------------
+
+ Description: display output in algebraic form
+
+ )set output algebra is used to tell AXIOM to turn algebra-style
+  output printing on and off, and where to place the output.  By
+  default, the destination for the output is the screen but 
+  printing is turned off.
+
+Syntax:   )set output algebra <arg>
+    where arg can be one of
+  on          turn algebra printing on (default state)
+  off         turn algebra printing off
+  console     send algebra output to screen (default state)
+  fp<.fe>     send algebra output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .spout.
+
+If you wish to send the output to a file, you may need to issue
+this command twice: once with on and once with the file name. 
+For example, to send algebra output to the file polymer.spout,
+issue the two commands
+
+  )set output algebra on
+  )set output algebra polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  On:CONSOLE 
+\end{verbatim}
+<<outputalgebra>>=
+     (algebra
+      "display output in algebraic form"
+      interpreter
+      FUNCTION
+      setOutputAlgebra
+      (("display output in algebraic form"
+        LITERALS
+        $algebraFormat
+        (off on)
+        on)
+       (break $algebraFormat)
+       ("where algebra printing goes (enter {\em console} or a pathname)?"
+        FILENAME
+        $algebraOutputFile
+        chkOutputFileName
+        "console"))
+      NIL)
+@
+\subsection{characters}
+\begin{verbatim}
+-------------------- The characters Option --------------------
+
+ Description: choose special output character set
+
+
+ The characters option may be followed by any one of the 
+ following:
+
+    default
+ -> plain 
+
+ The current setting is indicated within the list.  This 
+ option  determines the special characters used for algebraic 
+ output. This is what the current choice of special characters 
+ looks like:
+   ulc is shown as +          urc is shown as +       
+   llc is shown as +          lrc is shown as +       
+   vbar is shown as |         hbar is shown as -      
+   quad is shown as ?         lbrk is shown as [      
+   rbrk is shown as ]         lbrc is shown as {      
+   rbrc is shown as }         ttee is shown as +      
+   btee is shown as +         rtee is shown as +      
+   ltee is shown as +         ctee is shown as +      
+   bslash is shown as \    
+\end{verbatim}
+<<outputcharacters>>=
+     (characters
+      "choose special output character set"
+      interpreter
+      FUNCTION
+      setOutputCharacters
+      NIL
+      htSetOutputCharacters)
+@
+\subsection{fortran}
+\begin{verbatim}
+--------------------- The fortran Option ----------------------
+
+ Description: create output in FORTRAN format
+
+ )set output fortran is used to tell AXIOM to turn FORTRAN-style
+  output printing on and off, and where to place the output.  By
+  default, the destination for the output is the screen but 
+  printing is turned off.
+
+Also See: )set fortran
+
+Syntax:   )set output fortran <arg>
+    where arg can be one of
+  on          turn FORTRAN printing on
+  off         turn FORTRAN printing off (default state)
+  console     send FORTRAN output to screen (default state)
+  fp<.fe>     send FORTRAN output to file with file prefix 
+              fp and file extension .fe. If not given, 
+              .fe defaults to .sfort.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name.
+For example, to send FORTRAN output to the file polymer.sfort,
+ issue the two commands
+
+  )set output fortran on
+  )set output fortran polymer
+
+The output is placed in the directory from which you invoked
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputfortran>>=
+     (fortran
+      "create output in FORTRAN format"
+      interpreter
+      FUNCTION
+      setOutputFortran
+      (("create output in FORTRAN format"
+        LITERALS
+        $fortranFormat
+        (off on)
+        off)
+       (break $fortranFormat)
+       ("where FORTRAN output goes (enter {\em console} or a a pathname)"
+        FILENAME
+        $fortranOutputFile
+        chkOutputFileName
+        "console"))
+      NIL)
+@
+\subsection{fraction}
+\begin{verbatim}
+--------------------- The fraction Option ---------------------
+
+ Description: how fractions are formatted
+
+ The fraction option may be followed by any one of the following:
+
+ -> vertical 
+    horizontal
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<outputfraction>>=
+     (fraction
+      "how fractions are formatted"
+      interpreter
+      LITERALS
+      $fractionDisplayType
+      (vertical horizontal)
+      vertical)
+@
+\subsection{length}
+\begin{verbatim}
+---------------------- The length Option ----------------------
+
+ Description: line length of output displays
+
+ The length option may be followed by an integer in the range 
+ 10 to 245 inclusive. The current setting is 77 
+
+\end{verbatim}
+<<outputlength>>=
+     (length
+      "line length of output displays"
+      interpreter
+      INTEGER
+      $LINELENGTH
+      (10 245)
+      77)
+@
+\subsection{openmath}
+\begin{verbatim}
+----------------------- The openmath Option ------------------------
+
+ Description: create output in OpenMath style
+
+ )set output tex is used to tell AXIOM to turn OpenMath output
+printing on and off, and where to place the output.  By default,
+the destination for the output is the screen but printing is 
+turned off.
+
+Syntax:   )set output tex <arg>
+    where arg can be one of
+  on          turn OpenMath printing on
+  off         turn OpenMath printing off (default state)
+  console     send OpenMath output to screen (default state)
+  fp<.fe>     send OpenMath output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .sopen.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name. 
+For example, to send OpenMath output to the file polymer.sopen, 
+issue the two commands
+
+  )set output openmath on
+  )set output openmath polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputopenmath>>=
+     (openmath
+      "create output in OpenMath style"
+      interpreter
+      FUNCTION
+      setOutputOpenMath
+      (("create output in OpenMath format"
+        LITERALS
+        $openMathFormat
+        (off on)
+        off)
+       (break $openMathFormat)
+       ("where TeX output goes (enter {\em console} or a pathname)"
+        FILENAME
+        $openMathOutputFile
+        chkOutputFileName
+        "console"))
+      NIL)
+@
+\subsection{script}
+\begin{verbatim}
+---------------------- The script Option ----------------------
+
+ Description: display output in SCRIPT formula format
+
+ )set output script is used to tell AXIOM to turn IBM Script
+ formula-style output printing on and off, and where to place
+ the output.  By default, the destination for the output is the 
+ screen but printing is turned off.
+
+Syntax:   )set output script <arg>
+    where arg can be one of
+  on      turn IBM Script formula printing on
+  off     turn IBM Script formula printing off 
+          (default state)
+  console send IBM Script formula output to screen 
+          (default state)
+  fp<.fe> send IBM Script formula output to file with file 
+          prefix fp and file extension .fe. If not given, 
+          .fe defaults to .sform.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file 
+name. For example, to send IBM Script formula output to 
+the file polymer.sform, issue the two commands
+
+  )set output script on
+  )set output script polymer
+
+The output is placed in the directory from which you 
+invoked AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputscript>>=
+     (script
+      "display output in SCRIPT formula format"
+      interpreter
+      FUNCTION
+      setOutputFormula
+      (("display output in SCRIPT format"
+        LITERALS
+        $formulaFormat
+        (off on)
+        off)
+       (break $formulaFormat)
+       ("where script output goes (enter {\em console} or a a pathname)"
+        FILENAME
+        $formulaOutputFile
+        chkOutputFileName
+        "console"))
+      NIL)
+@
+\subsection{scripts}
+\begin{verbatim}
+--------------------- The scripts Option ----------------------
+
+ Description: show subscripts,... linearly
+
+ The scripts option may be followed by any one of the following:
+
+    yes
+    no
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<outputscripts>>=
+     (scripts
+      "show subscripts,... linearly"
+      interpreter
+      LITERALS
+      $linearFormatScripts
+      (yes no)
+      no)
+@
+\subsection{showeditor}
+\begin{verbatim}
+-------------------- The showeditor Option --------------------
+
+ Description: view output of )show in editor
+
+ The showeditor option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<outputshoweditor>>=
+     (showeditor
+      "view output of )show in editor"
+      interpreter
+      LITERALS
+      $useEditorForShowOutput
+      (on off)
+      off)
+@
+\subsection{tex}
+\begin{verbatim}
+----------------------- The tex Option ------------------------
+
+ Description: create output in TeX style
+
+ )set output tex is used to tell AXIOM to turn TeX-style output
+printing on and off, and where to place the output.  By default,
+the destination for the output is the screen but printing is 
+turned off.
+
+Syntax:   )set output tex <arg>
+    where arg can be one of
+  on          turn TeX printing on
+  off         turn TeX printing off (default state)
+  console     send TeX output to screen (default state)
+  fp<.fe>     send TeX output to file with file prefix fp
+              and file extension .fe. If not given, 
+              .fe defaults to .stex.
+
+If you wish to send the output to a file, you must issue 
+this command twice: once with on and once with the file name. 
+For example, to send TeX output to the file polymer.stex, 
+issue the two commands
+
+  )set output tex on
+  )set output tex polymer
+
+The output is placed in the directory from which you invoked 
+AXIOM or the one you set with the )cd system command.
+The current setting is:  Off:CONSOLE 
+\end{verbatim}
+<<outputtex>>=
+     (tex
+      "create output in TeX style"
+      interpreter
+      FUNCTION
+      setOutputTex
+      (("create output in TeX format"
+        LITERALS
+        $texFormat
+        (off on)
+        off)
+       (break $texFormat)
+       ("where TeX output goes (enter {\em console} or a pathname)"
+        FILENAME
+        $texOutputFile
+        chkOutputFileName
+        "console"))
+      NIL)
+@
+\section{quit}
+\begin{verbatim}
+----------------------- The quit Option -----------------------
+
+ Description: protected or unprotected quit
+
+ The quit option may be followed by any one of the following:
+
+    protected
+ -> unprotected 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<quit>>=
+  (quit
+   "protected or unprotected quit"
+   interpreter
+   LITERALS
+   $quitCommandType
+   (protected unprotected)
+   protected)
+@
+\section{streams}
+\begin{verbatim}
+              Current Values of  streams  Variables                   
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+calculate    specify number of elements to calculate    10 
+showall      display all stream elements computed       off 
+
+\end{verbatim}
+<<streams>>=
+  (streams
+   "set some options for working with streams"
+   interpreter
+   TREE
+   novar
+   (
+<<streamscalculate>>
+<<streamsshowall>>
+  ))
+@
+\subsection{calculate}
+\begin{verbatim}
+-------------------- The calculate Option ---------------------
+
+ Description: specify number of elements to calculate
+
+   )set streams calculate is used to tell AXIOM how many elements
+    of a stream to calculate when a computation uses the stream. 
+    The value given after calculate must either be the word all 
+    or a positive integer.
+
+      The current setting is 10 .
+\end{verbatim}
+<<streamscalculate>>=
+     (calculate
+      "specify number of elements to calculate"
+      interpreter
+      FUNCTION
+      setStreamsCalculate
+      (("number of initial stream elements you want calculated"
+       INTEGER
+       $streamCount
+       (0 NIL)
+       10))
+      NIL)
+@
+\subsection{showall}
+\begin{verbatim}
+--------------------- The showall Option ----------------------
+
+ Description: display all stream elements computed
+
+ The showall option may be followed by any one of the following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<streamsshowall>>=
+    (showall
+     "display all stream elements computed"
+     interpreter
+     LITERALS
+     $streamsShowAll
+     (on off)
+     off)
+@
+\section{system}
+\begin{verbatim}
+              Current Values of  system  Variables                    
+
+Variable     Description                           Current Value
+-----------------------------------------------------------------
+functioncode show gen. LISP for functions when compiled off 
+optimization show optimized LISP code                   off 
+prettyprint  prettyprint BOOT func's as they compile    off 
+
+\end{verbatim}
+<<system>>=
+  (system
+   "set some system development variables"
+   development
+   TREE
+   novar
+   (
+<<systemfunctioncode>>
+<<systemoptimization>>
+<<systemprettyprint>>
+   ))
+@
+\subsection{functioncode}
+\begin{verbatim}
+------------------- The functioncode Option -------------------
+
+ Description: show gen. LISP for functions when compiled
+
+ The functioncode option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<systemfunctioncode>>=
+     (functioncode
+      "show gen. LISP for functions when compiled"
+      development
+      LITERALS
+      $reportCompilation
+      (on off)
+      off)
+@
+\subsection{optimization}
+\begin{verbatim}
+------------------- The optimization Option -------------------
+
+ Description: show optimized LISP code
+
+ The optimization option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<systemoptimization>>=
+     (optimization
+      "show optimized LISP code"
+      development
+      LITERALS
+      $reportOptimization
+      (on off)
+      off)
+@
+\subsection{prettyprint}
+\begin{verbatim}
+------------------- The prettyprint Option --------------------
+
+ Description: prettyprint BOOT func's as they compile
+
+ The prettyprint option may be followed by any one of the 
+ following:
+
+    on
+ -> off 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<systemprettyprint>>=
+     (prettyprint
+      "prettyprint BOOT func's as they compile"
+      development
+      LITERALS
+      $PRETTYPRINT
+      (on off)
+      off)
+@
+\section{userlevel}
+\begin{verbatim}
+-------------------- The userlevel Option ---------------------
+
+ Description: operation access level of system user
+
+ The userlevel option may be followed by any one of the 
+ following:
+
+    interpreter
+    compiler
+ -> development 
+
+ The current setting is indicated within the list.
+
+\end{verbatim}
+<<userlevel>>=
+  (userlevel
+   "operation access level of system user"
+   interpreter
+   LITERALS
+   $UserLevel
+   (interpreter compiler development)
+   development)
+@
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Table of )set options
+SETANDFILEQ($setOptions,'(
+<<breakmode>>
+<<compiler>>
+<<expose>>
+<<functions>>
+<<fortran>>
+<<kernel>>
+<<hyperdoc>>
+<<help>>
+<<history>>
+<<messages>>
+<<naglink>>
+<<output>>
+<<quit>>
+<<streams>>
+<<system>>
+<<userlevel>>
+ ))
+
+-- The following creates a list of option names in the above table.
+
+SETANDFILEQ($setOptionNames, [x.0 for x in $setOptions])
+
+EVALANDFILEACTQ (initializeSetVariables $setOptions)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} src/interp/property.lisp.pamphlet
+\bibitem{2} src/interp/setvars.boot.pamphlet
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/sfsfun-l.lisp.pamphlet b/src/interp/sfsfun-l.lisp.pamphlet
new file mode 100644
index 00000000..c7c992e0
--- /dev/null
+++ b/src/interp/sfsfun-l.lisp.pamphlet
@@ -0,0 +1,91 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp sfsfun-l.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")
+
+;;
+;; Lisp part of the Scratchpad special function interface.
+;; SMW Feb 91
+;;
+
+;; #-:CCL
+;; (defun |float| (x) (|float| x))
+
+;; Conversion between spad and lisp complex representations
+(defun s-to-c (c) (complex (car c) (cdr c)))
+(defun c-to-s (c) (cons (realpart c) (imagpart c)))
+(defun c-to-r (c)
+    (let ((r (realpart c)) (i (imagpart c)))
+      (if (or (zerop i) (< (abs i) (* 1.0E-10 (abs r))))
+	  r
+	(|error| "Result is not real.")) ))
+
+;; Wrappers for functions in the special function package
+(defun rlngamma  (x)           (|lnrgamma| x) )
+(defun clngamma  (z)   (c-to-s (|lncgamma| (s-to-c z)) ))
+
+;; #-:CCL
+(defun rgamma    (x)           (|rgamma|   x))
+(defun cgamma    (z)   (c-to-s (|cgamma|   (s-to-c z)) ))
+
+(defun rpsi      (n x)         (|rPsi|     n x) )
+(defun cpsi      (n z) (c-to-s (|cPsi|     n (s-to-c z)) ))
+
+(defun rbesselj  (n x) (c-to-r (|BesselJ| n x)) ))
+(defun cbesselj  (v z) (c-to-s (|BesselJ| (s-to-c v) (s-to-c z)) ))
+ 
+(defun rbesseli  (n x) (c-to-r (|BesselI| n x)) ))
+(defun cbesseli  (v z) (c-to-s (|BesselI| (s-to-c v) (s-to-c z)) ))
+
+(defun chyper0f1 (a z) (c-to-s (|chebf01| (s-to-c a) (s-to-c z)) ))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/sfsfun.boot.pamphlet b/src/interp/sfsfun.boot.pamphlet
new file mode 100644
index 00000000..50bd7b5b
--- /dev/null
+++ b/src/interp/sfsfun.boot.pamphlet
@@ -0,0 +1,1031 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp sfsfun.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+NOTEfrom TTT: at least BesselJAsymptOrder needs work
+
+1. This file contains the contents of BWC's original files:
+      floaterrors.boot
+      floatutils.boot
+      rgamma.boot
+      cgamma.boot
+      rpsi.boot
+      cpsi.boot
+      f01.boot
+      chebf01cmake.boot
+      chebevalsf.boot
+      besselIJ.boot
+
+2. All declarations have been commented out with "--@@"
+   since the boot translator is generating bad lisp code from them.
+
+3. The functions PsiAsymptotic, PsiEps and PsiAsymptoticOrder
+   had inconpatible definitions in rpsi.boot and cpsi.boot --
+   the local variables were declared float in one file and COMPLEX in
+   the other.  The type declarations have been commented out and the
+   duplicate definitions have been deleted.
+
+4. BesselIJ was not compiling.  I have modified the code from that
+   file to make it compile.  It should be checked for correctness.
+
+SMW June 25, 1991
+
+"Fixes" to BesselJ, B. Char June 14, 1992.  Needs extensive testing and
+  further fixes to BesselI and BesselJ.
+More fixes to BesselJ, T. Tsikas 24 Feb, 1995.
+
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+-- Used to be SPECFNSF
+)package "BOOT" 
+
+FloatError(formatstring,arg) ==
+--        ERROR(formatstring,arg)
+        ERROR FORMAT([],formatstring,arg)
+
+nangenericcomplex () ==
+        1.0/COMPLEX(0.0)
+
+
+
+fracpart(x) ==
+        CADR(MULTIPLE_-VALUE_-LIST(FLOOR(x)))
+
+intpart(x) ==
+        CAR(MULTIPLE_-VALUE_-LIST(FLOOR(x)))
+
+negintp(x) ==
+        if ZEROP IMAGPART(x) and x<0.0 and ZEROP fracpart(x)
+        then
+                true
+        else
+                false
+
+--- Small float implementation of Gamma function.  Valid for
+--- real arguments.  Maximum error (relative) seems to be
+--- 2-4 ulps for real x 2<x<9, and up to ten ulps for larger x
+--- up to overflow.  See Hart & Cheney.
+--- Bruce Char, April, 1990.
+
+horner(l,x) ==
+        result := 0
+        for el in l repeat
+                result := result *x + el
+        return result
+
+rgamma (x) ==
+        if COMPLEXP(x) then FloatError('"Gamma not implemented for complex value ~D",x)
+	ZEROP (x-1.0) => 1.0
+        if x>20 then gammaStirling(x) else gammaRatapprox(x)
+
+lnrgamma (x) ==
+        if x>20 then lnrgammaRatapprox(x) else LOG(gammaRatapprox(x))
+
+cbeta(z,w) ==
+        cgamma(z)*cgamma(w)/(cgamma(z+w))
+
+gammaStirling(x) ==
+       EXP(lnrgamma(x))
+
+lnrgammaRatapprox(x) ==
+       (x-.5)*LOG(x) - x + LOG(SQRT(2.0*PI)) + phiRatapprox(x)
+
+phiRatapprox(x) ==
+        arg := 1/(x**2)
+        p := horner([.0666629070402007526,_
+                     .6450730291289920251389,_
+                     .670827838343321349614617,_
+                     .12398282342474941538685913],arg);
+        q := horner([1.0,7.996691123663644194772,_
+                      8.09952718948975574728214,_
+                      1.48779388109699298468156],arg);
+        result := p/(x*q)
+        result
+
+gammaRatapprox (x) ==
+        if (x>=2 and x<=3)
+        then
+                result := gammaRatkernel(x)
+        else
+                if x>3
+                then
+                     n := FLOOR(x)-2
+                     a := x-n-2
+                     reducedarg := 2+a
+                     prod := */[reducedarg+i for i in 0..n-1]
+                     result := prod* gammaRatapprox(reducedarg)
+                else
+                   if (2>x and x>0)
+                   then
+                     n := 2-FLOOR(x)
+                     a := x-FLOOR(x)
+                     reducedarg := 2+a
+                     prod := */[x+i for i in 0..n-1]
+                     result := gammaRatapprox(reducedarg)/prod
+                 else
+                        Pi := PI
+                        lx := MULTIPLE_-VALUE_-LIST(FLOOR(x))
+                        intpartx := CAR(lx)+1
+                        restx := CADR(lx)
+                        if ZEROP restx  -- case of negative non-integer value
+                        then
+                          FloatError ('"Gamma undefined for non-positive integers: ~D",x)
+                          result := nangenericcomplex ()
+                        else
+                          result := Pi/(gammaRatapprox(1.0-x)*(-1.0)**(intpartx+1)*SIN(restx*Pi))
+        result
+
+gammaRatkernel(x) ==
+           p := horner(REVERSE([3786.01050348257245475108,_
+                        2077.45979389418732098416,_
+                        893.58180452374981423868,_
+                        222.1123961680117948396,_
+                        48.95434622790993805232,_
+                        6.12606745033608429879,_
+                        .778079585613300575867]),x-2)
+           q := horner(REVERSE([3786.01050348257187258861,_
+                        476.79386050368791516095,_
+                        -867.23098753110299445707,_
+                        83.55005866791976957459,_
+                        50.78847532889540973716,_
+                        -13.40041478578134826274,_
+                        1]),x-2.0)
+           p/q
+
+-- cgamma(z) Gamma function for complex arguments.
+--    Bruce Char    April-May, 1990.
+--
+-- Our text for complex gamma is H. Kuki's paper Complex Gamma
+-- Function with Error Control", CACM vol. 15, no. 4, ppp. 262-267.
+-- (April, 1972.)  It uses the reflection formula and the basic
+-- z+1 recurrence to transform the argument into something that
+-- Stirling's asymptotic formula can handle.
+--
+-- However along the way it does a few tricky things to reduce
+-- problems due to roundoff/cancellation error for particular values.
+
+-- cgammat is auxiliary "t" function (see p. 263 Kuki)
+cgammat(x) ==
+        MAX(0.1, MIN(10.0, 10.0*SQRT(2.0) - ABS(x)))
+
+cgamma (z) ==
+        z2 := IMAGPART(z)
+        z1 := REALPART(z)       --- call real valued gamma if z is real
+        if ZEROP z2
+        then    result := rgamma(z1)
+        else
+                result := clngamma(z1,z2,z)
+                result := EXP(result)
+        result
+
+lncgamma(z) ==
+   clngamma(REALPART z, IMAGPART z, z)
+
+clngamma(z1,z2,z) ==
+        --- conjugate of gamma is gamma of conjugate.  map 2nd and 4th quads
+        --- to first and third quadrants
+        if z1<0.0
+        then if z2 > 0.0
+                then result := CONJUGATE(clngammacase1(z1,-z2,COMPLEX(z1,-z2)))
+                else result := clngammacase1(z1,z2,z)
+        else if z2 < 0.0
+                then result := CONJUGATE(clngammacase23(z1,-z2,_
+                                COMPLEX(z1,-z2)))
+                else result := clngammacase23(z1,z2,z)
+        result
+
+clngammacase1(z1,z2,z) ==
+        result1 := PiMinusLogSinPi(z1,z2,z)
+        result2 := clngamma(1.0-z1,-z2,1.0-z)
+        result1-result2
+
+PiMinusLogSinPi(z1,z2,z) ==
+        cgammaG(z1,z2)  - logH(z1,z2,z)
+
+cgammaG(z1,z2) ==
+        LOG(2*PI) + PI*z2 - COMPLEX(0.0,1.0)*PI*(z1-.5)
+
+logH(z1,z2,z) ==
+        z1bar := CADR(MULTIPLE_-VALUE_-LIST(FLOOR(z1))) ---frac part of z1
+        piz1bar := PI*z1bar
+        piz2 := PI*z2
+        twopiz2 := 2.0*piz2
+        i := COMPLEX(0.0,1.0)
+        part2 := EXP(twopiz2)*(2.0*SIN(piz1bar)**2 + SIN(2.0*piz1bar)*i)
+        part1 := -TANH(piz2)*(1.0+EXP(twopiz2))
+--- part1 is another way of saying 1 - exp(2*Pi*z1bar)
+        LOG(part1+part2)
+
+clngammacase23(z1,z2,z) ==
+        tz2 := cgammat(z2)
+        if (z1 < tz2)
+        then result:= clngammacase2(z1,z2,tz2,z)
+        else result:= clngammacase3(z)
+        result
+
+clngammacase2(z1,z2,tz2,z) ==
+        n := float(CEILING(tz2-z1))
+        zpn := z+n
+        (z-.5)*LOG(zpn) - (zpn) + cgammaBernsum(zpn) - cgammaAdjust(logS(z1,z2,z,n,zpn))
+
+logS(z1,z2,z,n,zpn) ==
+        sum := 0.0
+        for k in 0..(n-1) repeat
+                if z1+k < 5.0 - 0.6*z2
+                then sum := sum + LOG((z+k)/zpn)
+                else sum := sum + LOG(1.0 - (n-k)/zpn)
+        sum
+
+--- on p. 265, Kuki, logS result should have its imaginary part
+--- adjusted by 2 Pi if it is negative.
+cgammaAdjust(z) ==
+        if IMAGPART(z)<0.0
+        then result := z + COMPLEX(0.0, 2.0*PI)
+        else result := z
+        result
+
+clngammacase3(z) ==
+        (z- .5)*LOG(z) - z + cgammaBernsum(z)
+
+cgammaBernsum (z) ==
+        sum := LOG(2.0*PI)/2.0
+        zterm := z
+        zsquaredinv := 1.0/(z*z)
+        l:= [.083333333333333333333, -.0027777777777777777778,_
+                .00079365079365079365079,  -.00059523809523809523810,_
+                .00084175084175084175084, -.0019175269175269175269,_
+                .0064102564102564102564]
+        for m in 1..7 for el in l repeat
+                zterm := zterm*zsquaredinv
+                sum := sum + el*zterm
+        sum
+
+
+
+
+--- nth derivatives of ln gamma for real x, n = 0,1,....
+--- requires files floatutils, rgamma
+$PsiAsymptoticBern := VECTOR(0.0, 0.1666666666666667, -0.03333333333333333, 0.02380952380952381,_
+              -0.03333333333333333, 0.07575757575757576, -0.2531135531135531, 1.166666666666667,_
+              -7.092156862745098, 54.97117794486216, -529.1242424242424, 6192.123188405797,_
+              -86580.25311355311, 1425517.166666667, -27298231.06781609, 601580873.9006424,_
+              -15116315767.09216, 429614643061.1667, -13711655205088.33, 488332318973593.2,_
+              -19296579341940070.0,  841693047573682600.0, -40338071854059460000.0)
+
+
+PsiAsymptotic(n,x) ==
+        xn := x**n
+        xnp1 := xn*x
+        xsq := x*x
+        xterm := xsq
+        factterm := rgamma(n+2)/2.0/rgamma(float(n+1))
+        --- initialize to 1/n!
+        sum := AREF($PsiAsymptoticBern,1)*factterm/xterm
+        for k in 2..22 repeat
+                xterm := xterm * xsq
+                if n=0 then factterm := 1.0/float(2*k)
+                else if n=1 then factterm := 1
+                else factterm := factterm * float(2*k+n-1)*float(2*k+n-2)/(float(2*k)*float(2*k-1))
+                sum := sum + AREF($PsiAsymptoticBern,k)*factterm/xterm
+        PsiEps(n,x) + 1.0/(2.0*xnp1) + 1.0/xn * sum
+
+
+PsiEps(n,x) ==
+        if n = 0
+        then
+                result := -LOG(x)
+        else
+                result :=  1.0/(float(n)*(x**n))
+        result
+
+PsiAsymptoticOrder(n,x,nterms) ==
+        sum := 0
+        xterm := 1.0
+        np1 := n+1
+        for k in 0..nterms repeat
+                xterm := (x+float(k))**np1
+                sum := sum + 1.0/xterm
+        sum
+
+
+rPsi(n,x) ==
+        if x<=0.0
+        then
+                if ZEROP fracpart(x)
+                then FloatError('"singularity encountered at ~D",x)
+                else
+                        m := MOD(n,2)
+                        sign := (-1)**m
+                        if fracpart(x)=.5
+                        then
+                                skipit := 1
+                        else
+                                skipit := 0
+                        sign*((PI**(n+1))*cotdiffeval(n,PI*(-x),skipit) + rPsi(n,1.0-x))
+        else if n=0
+        then
+                - rPsiW(n,x)
+        else
+                rgamma(float(n+1))*rPsiW(n,x)*(-1)**MOD(n+1,2)
+
+---Amos' w function, with w(0,x) picked to be -psi(x) for x>0
+rPsiW(n,x) ==
+        if (x <=0 or n < 0)
+        then
+                HardError('"rPsiW not implemented for negative n or non-positive x")
+        nd := 6         -- magic number for number of digits in a word?
+        alpha := 3.5 + .40*nd
+        beta := 0.21 + (.008677e-3)*(nd-3) + (.0006038e-4)*(nd-3)**2
+        xmin := float(FLOOR(alpha + beta*n) + 1)
+        if n>0
+        then
+                a := MIN(0,1.0/float(n)*LOG(DOUBLE_-FLOAT_-EPSILON/MIN(1.0,x)))
+                c := EXP(a)
+                if ABS(a) >= 0.001
+                then
+                        fln := x/c*(1.0-c)
+                else
+                        fln := -x*a/c
+                bign := FLOOR(fln) + 1
+--- Amos says to use alternative series for large order if ordinary
+--- backwards recurrence too expensive
+                if (bign < 15) and (xmin > 7.0+x)
+                then
+                        return PsiAsymptoticOrder(n,x,bign)
+        if x>= xmin
+        then
+                return PsiAsymptotic(n,x)
+---ordinary case -- use backwards recursion
+        PsiBack(n,x,xmin)
+
+PsiBack(n,x,xmin) ==
+        xintpart := PsiIntpart(x)
+        x0 := x-xintpart                ---frac part of x
+        result := PsiAsymptotic(n,x0+xmin+1.0)
+        for k in xmin..xintpart by -1 repeat
+--- Why not decrement from x?   See Amos p. 498
+                result := result + 1.0/((x0 + float(k))**(n+1))
+        result
+
+
+PsiIntpart(x) ==
+        if x<0
+        then
+                result :=  -PsiInpart(-x)
+        else
+                result := FLOOR(x)
+        return result
+
+
+---Code for computation of derivatives of cot(z), necessary for
+--- polygamma reflection formula.  If you want to compute n-th derivatives of
+---cot(Pi*x), you have to multiply the result of cotdiffeval by Pi**n.
+
+-- MCD: This is defined at the Lisp Level.
+-- COT(z) ==
+--         1.0/TAN(z)
+
+cotdiffeval(n,z,skipit) ==
+---skip=1 if arg z is known to be an exact multiple of Pi/2
+        a := MAKE_-ARRAY(n+2)
+        SETF(AREF(a,0),0.0)
+        SETF(AREF(a,1),1.0)
+        for i in 2..n repeat
+                SETF(AREF(a,i),0.0)
+        for l in 1..n repeat
+                m := MOD(l+1,2)
+                for k in m..l+1 by 2 repeat
+                        if k<1
+                        then
+                                t1 := 0
+                        else
+                                t1 := -AREF(a,k-1)*(k-1)
+                        if k>l
+                        then
+                                t2 := 0
+                        else
+                                t2 := -AREF(a,k+1)*(k+1)
+                        SETF(AREF(a,k), t1+t2)
+        --- evaluate d^N/dX^N cot(z) via Horner-like rule
+        v := COT(z)
+        sq := v**2
+        s := AREF(a,n+1)
+        for i in (n-1)..0 by -2 repeat
+                s := s*sq + AREF(a,i)
+        m := MOD(n,2)
+        if m=0
+        then
+                s := s*v
+        if skipit=1
+        then
+                if m=0
+                then
+                        return 0
+                else
+                        return AREF(a,0)
+        else
+                return s
+--- nth derivatives of ln gamma for complex z, n=0,1,...
+--- requires files rpsi (and dependents), floaterrors
+--- currently defined only in right half plane until reflection formula
+--- works
+
+--- B. Char, June, 1990.
+
+cPsi(n,z) ==
+        x := REALPART(z)
+        y := IMAGPART(z)
+        if ZEROP y 
+        then    --- call real function if real
+                return rPsi(n,x)
+        if y<0.0
+        then    -- if imagpart(z) negative, take conjugate of conjugate
+                conjresult := cPsi(n,COMPLEX(x,-y))
+                return COMPLEX(REALPART(conjresult),-IMAGPART(conjresult))
+        nterms := 22
+        bound := 10.0
+        if x<0.0 --- and ABS(z)>bound and ABS(y)<bound
+        then
+                FloatError('"Psi implementation can't compute at ~S ",[n,z])
+---             return cpsireflect(n,x,y,z)
+        else if (x>0.0 and ABS(z)>bound ) --- or (x<0.0 and ABS(y)>bound)
+        then
+                return PsiXotic(n,PsiAsymptotic(n,z))
+        else            --- use recursion formula
+                m := CEILING(SQRT(bound*bound - y*y) - x + 1.0)
+                result := COMPLEX(0.0,0.0)
+                for k in 0..(m-1) repeat
+                        result := result + 1.0/((z + float(k))**(n+1))
+                return PsiXotic(n,result+PsiAsymptotic(n,z+m))
+
+PsiXotic(n,result) ==
+        rgamma(float(n+1))*(-1)**MOD(n+1,2)*result
+
+cpsireflect(n,z) ==
+        m := MOD(n,2)
+        sign := (-1)**m
+        sign*PI**(n+1)*cotdiffeval(n,PI*z,0) + cPsi(n,1.0-z)
+
+--- c parameter to 0F1, possibly complex
+--- z argument to 0F1
+--- Depends on files floaterror, floatutils
+
+--- Program transcribed from Fortran,, p. 80 Luke 1977
+
+chebf01 (c,z) ==
+--- w scale factor so that 0<z/w<1
+--- n    n+2 coefficients will be produced stored in an array
+---  indexed from 0 to n+1.
+--- See Luke's books for further explanation
+        n := 75 --- ad hoc decision
+---     if ABS(z)/ABS(c) > 200.0 and ABS(z)>10000.0
+---     then
+---             FloatError('"cheb0F1 not implemented for ~S < 1",[c,z])
+        w := 2.0*z
+--- arr will be used to store the Cheb. series coefficients
+        four:= 4.0
+        start := EXPT(10.0, -200)
+        n1 := n+1
+        n2 := n+2
+        a3 := 0.0
+        a2 := 0.0
+        a1 := start     -- arbitrary starting value
+        z1 := four/w
+        ncount := n1
+        arr := MAKE_-ARRAY(n2)
+        SETF(AREF(arr,ncount) , start)  -- start off
+        x1 := n2
+        c1 := 1.0 - c
+        for ncount in n..0 by -1 repeat
+                divfac := 1.0/x1
+                x1 := x1 -1.0
+                SETF(AREF(arr,ncount) ,_
+                        x1*((divfac+z1*(x1-c1))*a1 +_
+                        (1.0/x1 + z1*(x1+c1+1.0))*a2-divfac*a3))
+                a3 := a2
+                a2 := a1
+                a1 := AREF(arr,ncount)
+        SETF(AREF(arr,0),AREF(arr,0)/2.0)
+--  compute scale factor
+        rho := AREF(arr,0)
+        sum := rho
+        p := 1.0
+        for i in 1..n1 repeat
+                rho := rho - p*AREF(arr,i)
+                sum := sum+AREF(arr,i)
+                p := -p
+        for l in 0..n1 repeat
+                SETF(AREF(arr,l), AREF(arr,l)/rho)
+        sum := sum/rho
+---     Now evaluate array at argument
+        b := 0.0
+        temp := 0.0
+        for i in (n+1)..0 by -1 repeat
+                cc := b
+                b := temp
+                temp := -cc + AREF(arr,i)
+        temp
+
+
+brutef01(c,z) ==
+--  Use series definition.  Won't work well if cancellation occurs
+        term := 1.0
+        sum := term
+        n := 0.0
+        oldsum := 0.0
+        maxnterms := 10000
+        for i in 0..maxnterms until oldsum=sum repeat
+                oldsum := sum
+                term := term*z/(c+n)/(n+1.0)
+                sum := sum + term
+                n := n+1.0
+        sum
+
+f01(c,z)==
+        if negintp(c)
+        then
+                FloatError('"0F1 not defined for negative integer parameter value ~S",c)
+-- conditions when we'll permit the computation
+        else if ABS(c)<1000.0 and ABS(z)<1000.0
+        then
+                brutef01(c,z)
+        else if ZEROP IMAGPART(z) and ZEROP IMAGPART(c) and z>=0.0 and c>=0.0
+        then
+                brutef01(c,z)
+---     else
+---             t := SQRT(-z)
+---             c1 := c-1.0
+---             p := PHASE(c)
+---             if ABS(c)>10.0*ABS(t) and p>=0.0 and PHASE(c)<.90*PI
+---             then BesselJAsymptOrder(c1,2*t)*cgamma(c/(t**(c1)))
+---             else if ABS(t)>10.0*ABS(c) and ABS(t)>50.0
+---             then BesselJAsympt(c1,2*t)*cgamma(c/(t**(c1)))
+---             else
+---                     FloatError('"0F1 not implemented for ~S",[c,z])
+        else if (10.0*ABS(c)>ABS(z)) and ABS(c)<1.0E4 and ABS(z)<1.0E4
+        then
+                brutef01(c,z)
+        else
+                FloatError('"0F1 not implemented for ~S",[c,z])
+
+--- c parameter to 0F1
+--- w scale factor so that 0<z/w<1
+--- n    n+2 coefficients will be produced stored in an array
+---  indexed from 0 to n+1.
+--- See Luke's books for further explanation
+
+--- Program transcribed from Fortran,, p. 80 Luke 1977
+chebf01coefmake (c,w,n) ==
+--- arr will be used to store the Cheb. series coefficients
+        four:= 4.0
+        start := EXPT(10.0, -200)
+        n1 := n+1
+        n2 := n+2
+        a3 := 0.0
+        a2 := 0.0
+        a1 := start     -- arbitrary starting value
+        z1 := four/w
+        ncount := n1
+        arr := MAKE_-ARRAY(n2)
+        SETF(AREF(arr,ncount) , start)  -- start off
+        x1 := n2
+        c1 := 1.0 - c
+        for ncount in n..0 by -1 repeat
+                divfac := 1.0/x1
+                x1 := x1 -1.0
+                SETF(AREF(arr,ncount) ,_
+                        x1*((divfac+z1*(x1-c1))*a1 +_
+                        (1.0/x1 + z1*(x1+c1+1.0))*a2-divfac*a3))
+                a3 := a2
+                a2 := a1
+                a1 := AREF(arr,ncount)
+        SETF(AREF(arr,0),AREF(arr,0)/2.0)
+--  compute scale factor
+        rho := AREF(arr,0)
+        sum := rho
+        p := 1.0
+        for i in 1..n1 repeat
+                rho := rho - p*AREF(arr,i)
+                sum := sum+AREF(arr,i)
+                p := -p
+        for l in 0..n1 repeat
+                SETF(AREF(arr,l), AREF(arr,l)/rho)
+        sum := sum/rho
+        return([sum,arr])
+
+
+
+
+---evaluation of Chebychev series of degree n at x, where the series's
+---coefficients are given by the list in descending order (coef. of highest
+---power first)
+
+---May be numerically unstable for certain lists of coefficients;
+--- could possibly reverse sequence of coefficients
+
+--- Cheney and Hart p. 15.
+
+--- B. Char, March 1990
+
+chebeval (coeflist,x) ==
+        b := 0;
+        temp := 0;
+        y := 2*x;
+
+        for el in coeflist repeat
+                c := b;
+                b := temp
+                temp := y*b -c + el
+        (temp -c)/2
+
+
+chebevalarr(coefarr,x,n) ==
+        b := 0;
+        temp := 0;
+        y := 2*x;
+
+        for i in 1..n repeat
+                c := b;
+                b := temp
+                temp := y*b -c + coefarr.i
+        (temp -c)/2
+
+--- If plist is a list of coefficients for the Chebychev approximation
+--- of a function f(x), then chebderiveval computes the Chebychev approximation
+--- of f'(x).  See Luke, "Special Functions and their approximations, vol. 1
+--- Academic Press 1969., p. 329 (from Clenshaw and Cooper)
+
+--- < definition to be supplied>
+
+--- chebstareval(plist,n) computes a Chebychev approximation from a
+--- coefficient list, using shifted Chebychev polynomials of the first kind
+--- The defining relation is that T*(n,x) = T(n,2*x-1).  Thus the interval
+--- [0,1] of T*n is the interval [-1,1] of Tn.
+
+chebstareval(coeflist,x) ==          -- evaluation of T*(n,x)
+        b := 0
+        temp := 0
+        y := 2*(2*x-1)
+
+        for el in coeflist repeat
+                c := b;
+                b := temp
+                temp := y*b -c + el
+        temp - y*b/2
+
+
+chebstarevalarr(coefarr,x,n) ==          -- evaluation of sum(C(n)*T*(n,x))
+
+        b := 0
+        temp := 0
+        y := 2*(2*x-1)
+
+        for i in (n+1)..0 by -1 repeat
+                c := b
+                b := temp
+                temp := y*b -c + AREF(coefarr,i)
+        temp - y*b/2
+
+--Float definitions for Bessel functions I and J.
+--External references:  cgamma, rgamma, chebf01coefmake, chebevalstarsf
+-- floatutils
+
+---BesselJ works for complex and real values of v and z
+BesselJ(v,z) ==
+---Ad hoc boundaries for approximation
+        B1:= 10
+        B2:= 10
+        n := 50         --- number of terms in Chebychev series.
+        --- tests for negative integer order
+        (FLOATP(v) and ZEROP fracpart(v) and (v<0)) or (COMPLEXP(v) and ZEROP IMAGPART(v) and ZEROP fracpart(REALPART(v)) and REALPART(v)<0.0) =>
+	     --- odd or even according to v (9.1.5 A&S)
+	     --- $J_{-n}(z)=(-1)^{n} J_{n}(z)$
+             BesselJ(-v,z)*EXPT(-1.0,v)
+        (FLOATP(z) and  (z<0)) or (COMPLEXP(z) and REALPART(z)<0.0) =>
+          --- negative argument (9.1.35 A&S) 
+	  --- $J_{\nu}(z e^{m \pi i}) = e^{m \nu \pi i} J_{\nu}(z)$
+             BesselJ(v,-z)*EXPT(-1.0,v)
+        ZEROP z and ((FLOATP(v) and (v>=0.0)) or (COMPLEXP(v) and 
+           ZEROP IMAGPART(v) and REALPART(v)>=0.0)) =>  --- zero arg, pos. real order
+            ZEROP v => 1.0  --- J(0,0)=1
+            0.0  --- J(v,0)=0 for real v>0
+        rv := ABS(v)
+        rz := ABS(z)
+        (rz>B1) and (rz > B2*rv) =>  --- asymptotic argument
+            BesselJAsympt(v,z)
+        (rv>B1) and (rv > B2*rz) => --- asymptotic order
+            BesselJAsymptOrder(v,z)
+        (rz< B1) and (rv<B1) =>       --- small order and argument
+                 arg := -(z*z)/4.0
+                 w := 2.0*arg
+                 vp1 := v+1.0
+                 [sum,arr] := chebf01coefmake(vp1,w,n)
+		 ---if we get NaNs then half n
+		 while not _=(sum,sum) repeat
+			n:=FLOOR(n/2)
+                        [sum,arr] := chebf01coefmake(vp1,w,n)
+	         ---now n is safe, can we increase it (we know that 2*n is bad)?
+                 chebstarevalarr(arr,arg/w,n)/cgamma(vp1)*EXPT(z/2.0,v)
+        true => BesselJRecur(v,z)
+        FloatError('"BesselJ not implemented for ~S", [v,z])
+
+BesselJRecur(v,z) ==
+	-- boost order
+        --Numerical.Recipes. suggest so:=v+sqrt(n.s.f.^2*v)
+	so:=15.0*z
+	-- reduce order until non-zero
+        while ZEROP ABS(BesselJAsymptOrder(so,z)) repeat so:=so/2.0 
+	if ABS(so)<ABS(z) then so:=v+18.*SQRT(v)
+	m:= FLOOR(ABS(so-v))+1
+	w:=MAKE_-ARRAY(m)
+	SETF(AREF(w,m-1),BesselJAsymptOrder(v+m-1,z))
+        SETF(AREF(w,m-2),BesselJAsymptOrder(v+m-2,z))
+        for i in m-3 .. 0 by -1 repeat
+          SETF(AREF(w,i), 2.0 * (v+i+1.0) * AREF(w,i+1) /z -AREF(w,i+2)) 
+	AREF(w,0)
+
+BesselI(v,z) ==
+        B1 := 15.0
+        B2 := 10.0
+        ZEROP(z) and FLOATP(v) and (v>=0.0) =>  --- zero arg, pos. real order
+            ZEROP(v) => 1.0  --- I(0,0)=1
+            0.0             --- I(v,0)=0 for real v>0
+--- Transformations for negative integer orders
+        FLOATP(v) and ZEROP(fracpart(v)) and (v<0) => BesselI(-v,z)
+--- Halfplane transformations for Re(z)<0
+        REALPART(z)<0.0 => BesselI(v,-z)*EXPT(-1.0,v)
+--- Conjugation for complex order and real argument
+        REALPART(v)<0.0 and not ZEROP IMAGPART(v) and FLOATP(z) =>
+              CONJUGATE(BesselI(CONJUGATE(v),z))
+---We now know that Re(z)>= 0.0
+        ABS(z) > B1 =>    --- asymptotic argument case
+                                FloatError('"BesselI not implemented for ~S",[v,z])
+        ABS(v) > B1 =>
+                                FloatError('"BesselI not implemented for ~S",[v,z])
+---     case of small argument and order
+        REALPART(v)>= 0.0 =>  besselIback(v,z)
+        REALPART(v)< 0.0 =>
+                        chebterms := 50
+                        besselIcheb(z,v,chebterms)
+        FloatError('"BesselI not implemented for ~S",[v,z])
+
+--- Compute n terms of the chebychev series for f01
+besselIcheb(z,v,n) ==
+        arg := (z*z)/4.0
+        w := 2.0*arg;
+        vp1 := v+1.0;
+        [sum,arr] := chebf01coefmake(vp1,w,n)
+        result := chebstarevalarr(arr,arg/w,n)/cgamma(vp1)*EXPT(z/2.0,v)
+
+besselIback(v,z) ==
+        ipv := IMAGPART(v)
+        rpv := REALPART(v)
+        lm := MULTIPLE_-VALUE_-LIST(FLOOR(rpv))
+        m := CAR(lm)    --- floor of real part of v
+        n := 2*MAX(20,m+10)  --- how large the back recurrence should be
+        tv := CADR(lm)+(v-rpv) ---  fractional part of real part of v
+                        --- plus imaginary part of v
+        vp1 := tv+1.0;
+        result := BesselIBackRecur(v,m,tv,z,'"I",n)
+        result := result/cgamma(vp1)*EXPT(z/2.0,tv)
+
+--- Backward recurrence for Bessel functions.  Luke (1975), p. 247.
+--- works for -Pi< arg z <= Pi and  -Pi < arg v <= Pi
+BesselIBackRecur(largev,argm,v,z,type,n) ==
+--- v + m = largev
+        one := 1.0
+        two := 2.0
+        zero := 0.0
+        start := EXPT(10.0,-40)
+        z2 := two/z
+        m2 := n+3
+        w:=MAKE_-ARRAY(m2+1)
+        SETF(AREF(w,m2), zero) --- start off
+        if type = '"I"
+        then
+                val := one
+        else
+                val := -one
+        m1 := n+2
+        SETF(AREF(w,m1), start)
+        m := n+1
+        xm := float(m)
+        ct1 := z2*(xm+v)
+        --- initialize
+        for m in (n+1)..1 by -1 repeat
+                SETF(AREF(w,m), AREF(w,m+1)*ct1 + val*AREF(w,m+2))
+                ct1 := ct1 - z2
+        m := 1 + FLOOR(n/2)
+        m2 := m + m -1
+        if (v=0)
+        then
+                pn := AREF(w, m2 + 2)
+                for m2 in (2*m-1)..3 by -2 repeat
+                        pn := AREF(w, m2) - val *pn
+                pn := AREF(w,1) - val*(pn+pn)
+        else
+                v1 := v-one
+                xm := float(m)
+                ct1 := v + xm + xm
+                pn := ct1*AREF(w, m2 + 2)
+                for m2 in (m+m -1)..3 by -2 repeat
+                        ct1 := ct1 - two
+                        pn := ct1*AREF(w,m2) - val*pn/xm*(v1+xm)
+                        xm := xm - one
+                pn := AREF(w,1) - val * pn
+        m1 := n+2
+        for m in 1..m1 repeat
+                SETF(AREF(w,m), AREF(w,m)/pn)
+        AREF(w,argm+1)
+
+
+
+
+---Asymptotic functions for large values of z.  See p. 204 Luke 1969 vol. 1.
+
+--- mu is 4*v**2
+--- zsqr is z**2
+--- zfth is z**4
+
+BesselasymptA(mu,zsqr,zfth) ==
+        (mu -1)/(16.0*zsqr) * (1 + (mu - 13.0)/(8.0*zsqr) + _
+                (mu**2 - 53.0*mu + 412.0)/(48.0*zfth))
+
+BesselasymptB(mu,z,zsqr,zfth) ==
+        musqr := mu*mu
+        z + (mu-1.0)/(8.0*z) *(1.0 + (mu - 25.0)/(48.0*zsqr) + _
+                (musqr - 114.0*mu + 1073.0)/(640.0*zfth) +_
+                (5.0*mu*musqr - 1535.0*musqr + 54703.0*mu - 375733.0)/(128.0*zsqr*zfth))
+
+--- Asymptotic series only works when |v| < |z|.
+
+BesselJAsympt (v,z) ==
+        pi := PI
+        mu := 4.0*v*v
+        zsqr := z*z
+        zfth := zsqr*zsqr
+        SQRT(2.0/(pi*z))*EXP(BesselasymptA(mu,zsqr,zfth))*_
+                COS(BesselasymptB(mu,z,zsqr,zfth) - pi*v/2.0 - pi/4.0)
+
+
+---Asymptotic series for I.  See Whittaker, p. 373.
+--- valid for -3/2 Pi < arg z < 1/2 Pi
+
+BesselIAsympt(v,z,n) ==
+        i := COMPLEX(0.0, 1.0)
+        if (REALPART(z) = 0.0)
+        then return EXPT(i,v)*BesselJ(v,-IMAGPART(z))
+        sum1 := 0.0
+        sum2 := 0.0
+        fourvsq := 4.0*v**2
+        two := 2.0
+        eight := 8.0
+        term1 := 1.0
+---             sum1, sum2, fourvsq,two,i,eight,term1])
+        for r in 1..n repeat
+                term1 := -term1 *(fourvsq-(two*float(r)-1.0)**2)/_
+                        (float(r)*eight*z)
+                sum1 := sum1 + term1
+                sum2 := sum2 + ABS(term1)
+        sqrttwopiz := SQRT(two*PI*z)
+        EXP(z)/sqrttwopiz*(1.0 + sum1 ) +_
+                EXP(-(float(n)+.5)*PI*i)*EXP(-z)/sqrttwopiz*(1.0+ sum2)
+
+
+---Asymptotic formula for BesselJ when order is large comes from
+---Debye (1909).  See Olver, Asymptotics and Special Functions, p. 134.
+---Expansion good for 0<=phase(v)<Pi
+---A&S recommend "uniform expansion" with complicated coefficients and Airy function.
+---Debye's Formula is in 9.3.7,9.3.9,9.3.10 of A&S
+---AXIOM recurrence for u_{k} 
+---f(0)==1::EXPR INT
+---f(n)== (t^2)*(1-t^2)*D(f(n-1),t)/2 + (1/8)*integrate( (1-5*t^2)*f(n-1),t)
+BesselJAsymptOrder(v,z) ==
+        sechalpha := z/v
+        alpha := ACOSH(1.0/sechalpha)
+        tanhalpha := SQRT(1.0-(sechalpha*sechalpha))
+    --  cothalpha := 1.0/tanhalpha
+        ca := 1.0/tanhalpha
+
+        Pi := PI
+	ca2:=ca*ca
+	ca4:=ca2*ca2
+	ca8:=ca4*ca4
+        EXP(-v*(alpha-tanhalpha))/SQRT(2.0*Pi*v*tanhalpha)*_
+	(1.0+_
+	horner([              -5.0,                3.0],_
+								ca2)*ca/(v*24.0)+_
+	horner([             385.0,             -462.0,              81.0],_
+								ca2)*ca2/(1152.0*v*v)+_
+	horner([         -425425.0,           765765.0,         -369603.0,             30375.0],_
+								ca2)*ca2*ca/(414720.0*v*v*v)+_
+	horner([       185910725.0,       -446185740.0,       349922430.0,        -94121676.0,         4465125.0],_
+								ca2)*ca4/(39813120.0*v*v*v*v)+_
+	horner([   -188699385875.0,     566098157625.0,   -614135872350.0,     284499769554.0,    -49286948607.0,      1519035525.0],_
+								ca2)*ca4*ca/(6688604160.0*v*v*v*v*v)+_
+	horner([1023694168371875.0,-3685299006138750.0,5104696716244125.0,-3369032068261860.0,1050760774457901.0,-127577298354750.0,2757049477875.0],_
+								ca2)*ca4*ca2/(4815794995200.0*v*v*v*v*v*v))
+		
+
+---  See Olver, p. 376-382.
+BesselIAsymptOrder(v,vz) ==
+        z := vz/v
+        Pi := PI
+---     Use reflection formula (Atlas, p. 492)  if v not in right half plane;  Is this always accurate?
+        if REALPART(v)<0.0
+        then return BesselIAsymptOrder(-v,vz) + 2.0/Pi*SIN(-v*Pi)*BesselKAsymptOrder(-v,vz)
+---     Use the reflection formula (Atlas, p. 496) if z not in right half plane;
+        if REALPART(vz) < 0.0
+        then return EXPT(-1.0,v)*BesselIAsymptOrder(v,-vz)
+        vinv := 1.0/v
+        opzsqroh := SQRT(1.0+z*z)
+        eta := opzsqroh + LOG(z/(1.0+opzsqroh))
+        p := 1.0/opzsqroh
+        p2 := p*p
+        p4 := p2*p2
+        u0p := 1.
+        u1p := 1.0/8.0*p-5.0/24.0*p*p2
+        u2p := (9.0/128.0+(-77.0/192.0+385.0/1152.0*p2)*p2)*p2
+        u3p := (75.0/1024.0+(-4563.0/5120.0+(17017.0/9216.0-85085.0/82944.0*p2)_
+                *p2)*p2)*p2*p
+        u4p := (3675.0/32768.0+(-96833.0/40960.0+(144001.0/16384.0+(-7436429.0/663552.0+37182145.0/7962624.0*p2)*p2)*p2)*p2)*p4
+        u5p := (59535.0/262144.0+(-67608983.0/9175040.0+(250881631.0/5898240.0+(-108313205.0/1179648.0+(5391411025.0/63700992.0-5391411025.0/191102976.0*p2)*p2)*p2)*p2)*p2)*p4*p
+        hornerresult := horner([u5p,u4p,u3p,u2p,u1p,u0p],vinv)
+        EXP(v*eta)/(SQRT(2.0*Pi*v)*SQRT(opzsqroh))*hornerresult
+
+
+---See also Olver, pp. 376-382
+BesselKAsymptOrder (v,vz) ==
+        z := vz/v
+        vinv := 1.0/v
+        opzsqroh := SQRT(1.0+z*z)
+        eta := opzsqroh + LOG(z/(1.0+opzsqroh))
+        p := 1.0/opzsqroh
+        p2 := p**2
+        p4 := p2**2
+        u0p := 1.
+        u1p := (1.0/8.0*p-5.0/24.0*p**3)*(-1.0)
+        u2p := (9.0/128.0+(-77.0/192.0+385.0/1152.0*p2)*p2)*p2
+        u3p := ((75.0/1024.0+(-4563.0/5120.0+(17017.0/9216.0-85085.0/82944.0*p2)_
+                *p2)*p2)*p2*p)*(-1.0)
+        u4p := (3675.0/32768.0+(-96833.0/40960.0+(144001.0/16384.0+(-7436429.0/663552.0+37182145.0/7962624.0*p2)*p2)*p2)*p2)*p4
+        u5p := ((59535.0/262144.0+(-67608983.0/9175040.0+(250881631.0/5898240.0+(-108313205.0/1179648.0+(5391411025.0/63700992.0-5391411025.0/191102976.0*p2)*p2)*p2)*p2)*p2)*p4*p)*(-1.0)
+        hornerresult := horner([u5p,u4p,u3p,u2p,u1p,u0p],vinv)
+        SQRT(PI/(2.0*v))*EXP(-v*eta)/(SQRT(opzsqroh))*hornerresult
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/showimp.boot.pamphlet b/src/interp/showimp.boot.pamphlet
new file mode 100644
index 00000000..ae682ad3
--- /dev/null
+++ b/src/interp/showimp.boot.pamphlet
@@ -0,0 +1,278 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/showimp.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+$returnNowhereFromGoGet := false
+
+showSummary dom ==
+  showPredicates dom
+  showAttributes dom
+  showFrom dom
+  showImp dom
+
+--=======================================================================
+--          Show Where Functions in Domain are Implemented
+--=======================================================================
+showImp(dom,:options) ==
+  sayBrightly '"-------------Operation summary-----------------"
+  missingOnlyFlag := KAR options
+  domainForm := devaluate dom
+  [nam,:$domainArgs] := domainForm
+  $predicateList: local := GETDATABASE(nam,'PREDICATES)
+  predVector := dom.3
+  u := getDomainOpTable(dom,true)
+  --sort into 4 groups: domain exports, unexports, default exports, others
+  for (x := [.,.,:key]) in u repeat
+    key = domainForm => domexports := [x,:domexports]
+    FIXP key => unexports := [x,:unexports]
+    isDefaultPackageForm? key => defexports := [x,:defexports]
+    key = 'nowhere => nowheres := [x,:nowheres]
+    key = 'constant => constants := [x,:constants]
+    others := [x,:others]   --add chain domains go here
+  sayBrightly
+    nowheres => ['"Functions exported but not implemented by",
+      :bright form2String domainForm,'":"] 
+    [:bright form2String domainForm,'"implements all exported operations"]  
+  showDomainsOp1(nowheres,'nowhere)
+  missingOnlyFlag => 'done
+
+  --first display those exported by the domain, then add chain guys
+  u := [:domexports,:constants,:SORTBY('CDDR,others)]
+  while u repeat
+    [.,.,:key] := CAR u
+    sayBrightly
+      key = 'constant => 
+        ["Constants implemented by",:bright form2String key,'":"]
+      ["Functions implemented by",:bright form2String key,'":"]
+    u := showDomainsOp1(u,key)
+  u := SORTBY('CDDR,defexports)
+  while u repeat
+    [.,.,:key] := CAR u
+    defop := INTERN(SUBSTRING((s := PNAME CAR key),0,MAXINDEX s))
+    domainForm := [defop,:CDDR key]
+    sayBrightly ["Default functions from",:bright form2String domainForm,'":"]
+    u := showDomainsOp1(u,key)
+  u := SORTBY('CDDR,unexports)
+  while u repeat
+    [.,.,:key] := CAR u
+    sayBrightly ["Not exported: "]
+    u := showDomainsOp1(u,key)
+
+--=======================================================================
+--          Show Information Directly From Domains
+--=======================================================================
+showFrom(D,:option) ==
+  ops := KAR option
+  alist := nil
+  domainForm := devaluate D
+  [nam,:.] := domainForm
+  $predicateList: local := GETDATABASE(nam,'PREDICATES)
+  for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat
+    u := from?(D,op,sig)
+    x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x])
+    alist := [[u,opSig],:alist]
+  for [conform,:l] in alist repeat
+    sayBrightly concat('"From ",form2String conform,'":")
+    for [op,sig] in l repeat sayBrightly ['"   ",:formatOpSignature(op,sig)]
+ 
+--=======================================================================
+--               Functions implementing showFrom
+--=======================================================================
+getDomainOps D ==
+  domname := D.0
+  conname := CAR domname
+  $predicateList: local := GETDATABASE(conname,'PREDICATES)
+  REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil))
+ 
+getDomainSigs(D,:option) ==
+  domname := D.0
+  conname := CAR domname
+  $predicateList: local := GETDATABASE(conname,'PREDICATES)
+  getDomainSigs1(D,first option)
+  
+getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where
+  u == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)]
+ 
+getDomainDocs(D,:option) ==
+  domname := D.0
+  conname := CAR domname
+  $predicateList: local := GETDATABASE(conname,'PREDICATES)
+  ops := KAR option
+  [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)]
+ 
+--=======================================================================
+--          Getting Inheritance Info from Documentation in Lisplib
+--=======================================================================
+from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig)
+
+getExtensionsOfDomain domain ==
+  u := getDomainExtensionsOfDomain domain
+  cats := getCategoriesOfDomain domain
+  for x in u repeat
+    cats := union(cats,getCategoriesOfDomain EVAL x)
+  [:u,:cats]
+
+getDomainExtensionsOfDomain domain ==
+  acc := nil
+  d := domain
+  while (u := devaluateSlotDomain(5,d)) repeat
+    acc := [u,:acc]
+    d := EVAL u
+  acc
+
+devaluateSlotDomain(u,dollar) ==
+  u = '$ => devaluate dollar
+  FIXP u and VECP (y := dollar.u) => devaluate y
+  u is ['NRTEVAL,y] => MKQ eval y
+  u is ['QUOTE,y] => u
+  u is [op,:argl] => [op,:[devaluateSlotDomain(x,dollar) for x in argl]]
+  devaluate evalSlotDomain(u,dollar)
+ 
+getCategoriesOfDomain domain ==
+  predkeyVec := domain.4.0
+  catforms := CADR domain.4
+  [fn for i in 0..MAXINDEX predkeyVec | test] where 
+     test == predkeyVec.i and 
+       (x := catforms . i) isnt ['DomainSubstitutionMacro,:.]
+     fn ==
+       VECP x => devaluate x
+       devaluateSlotDomain(x,domain)
+
+getInheritanceByDoc(D,op,sig,:options) ==
+--gets inheritance and documentation information by looking in the LISPLIB 	
+--for each ancestor of the domain
+  catList := KAR options or getExtensionsOfDomain D
+  getDocDomainForOpSig(op,sig,devaluate D,D) or
+    or/[fn for x in catList] or '(NIL NIL)
+      where fn == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D)
+ 
+getDocDomainForOpSig(op,sig,dollar,D) ==
+  (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION)))
+    and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)])
+ 
+--=======================================================================
+--               Functions implementing showImp
+--=======================================================================
+showDomainsOp1(u,key) ==
+  while u and CAR u is [op,sig,: =key] repeat
+    sayBrightly ['"   ",:formatOpSignature(op,sig)]
+    u := rest u
+  u
+
+getDomainRefName(dom,nam) ==
+  PAIRP nam => [getDomainRefName(dom,x) for x in nam]
+  not FIXP nam => nam
+  slot := dom.nam
+  VECP slot => slot.0
+  slot is ['SETELT,:.] => getDomainRefName(dom,getDomainSeteltForm slot)
+  slot
+
+getDomainSeteltForm ['SETELT,.,.,form] ==
+  form is ['evalSlotDomain,u,d] => devaluateSlotDomain(u,d)
+  VECP form => systemError()
+  form
+ 
+showPredicates dom ==
+  sayBrightly '"--------------------Predicate summary-------------------"
+  conname := CAR dom.0
+  predvector := dom.3
+  predicateList := GETDATABASE(conname,'PREDICATES)
+  for i in 1.. for p in predicateList repeat
+    prefix := 
+      testBitVector(predvector,i) => '"true : "
+      '"false: "
+    sayBrightly [prefix,:pred2English p]
+ 
+showAttributes dom ==
+  sayBrightly '"--------------------Attribute summary-------------------"
+  conname := CAR dom.0
+  abb := getConstructorAbbreviation conname
+  predvector := dom.3
+  for [a,:p] in dom.2 repeat
+    prefix :=
+      testBitVector(predvector,p) => '"true : "
+      '"false: "
+    sayBrightly concat(prefix,form2String a)
+
+showGoGet dom ==
+  numvec := CDDR dom.4
+  for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op] repeat
+    numOfArgs := numvec.index
+    whereNumber := numvec.(index := index + 1)
+    signumList := 
+      [formatLazyDomainForm(dom,numvec.(index + i)) for i in 0..numOfArgs]
+    index := index + numOfArgs + 1
+    namePart := 
+      concat(bright "from",form2String formatLazyDomainForm(dom,whereNumber))
+    sayBrightly [i,'": ",:formatOpSignature(op,signumList),:namePart]
+
+formatLazyDomain(dom,x) ==
+  VECP x => devaluate x
+  x is [dollar,slotNumber,:form] => formatLazyDomainForm(dom,form)
+  systemError nil
+ 
+formatLazyDomainForm(dom,x) ==
+  x = 0 => ["$"]
+  FIXP x => formatLazyDomain(dom,dom.x)
+  atom x => x
+  x is ['NRTEVAL,y] => (atom y => [y]; y)
+  [first x,:[formatLazyDomainForm(dom,y) for y in rest x]]
+ 
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/simpbool.boot.pamphlet b/src/interp/simpbool.boot.pamphlet
new file mode 100644
index 00000000..88021ab9
--- /dev/null
+++ b/src/interp/simpbool.boot.pamphlet
@@ -0,0 +1,225 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp simpbool.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+simpBool x == dnf2pf reduceDnf be x
+ 
+reduceDnf u ==
+-- (OR (AND ..b..) b) ==> (OR  b  )
+  atom u => u
+  for x in u repeat
+    ok := true
+    for y in u repeat
+      x = y => 'skip
+      dnfContains(x,y) => return (ok := false)
+    ok = true => acc := [x,:acc]
+  nreverse acc
+ 
+dnfContains([a,b],[c,d]) == fn(a,c) and fn(b,d) where
+  fn(x,y) == and/[member(u,x) for u in y]
+ 
+prove x ==
+  world := [p for y in listOfUserIds x | (p := getPredicate y)] =>
+    'false = be mkpf([['NOT,x],:world],'AND) => true
+    'false = be mkpf([x,:world],'AND) => false
+    x
+  'false = (y := be x) => 'false
+  y = 'true => true
+  dnf2pf y
+
+simpBoolGiven(x,world) ==
+  world =>
+    'false = be mkpf([['NOT,x],:world],'AND) => true
+    'false = (y := be mkpf([x,:world],'AND)) => false
+    (u := andReduce(dnf2pf y,world)) is ['AND,:v] and
+      (w := SETDIFFERENCE(v,world)) ^= v => simpBool ['AND,:w] 
+    u
+  'false = (y := be x) => false
+  'true = y => true
+  dnf2pf y
+
+andReduce(x,y) ==
+  x is ['AND,:r] =>
+    y is ['AND,:s] => mkpf(S_-(r,s),'AND)
+    mkpf(S_-(r,[s]),'AND)
+  x
+dnf2pf(x) ==
+  x = 'true => 'T
+  x = 'false => nil
+  atom x => x
+  mkpf(
+    [mkpf([:[k for k in b],:[['not,k] for k in a]],'AND) for [a,b] in x],'OR)
+be x == b2dnf x
+b2dnf x ==
+  x = 'T => 'true
+  x = NIL => 'false
+  atom x => bassert x
+  [op,:argl] := x
+  MEMQ(op,'(AND and)) => band argl
+  MEMQ(op,'(OR or))   => bor argl
+  MEMQ(op,'(NOT not)) => bnot first argl
+  bassert x
+band x ==
+  x is [h,:t] => andDnf(b2dnf h,band t)
+  'true
+bor x ==
+  x is [a,:b] => orDnf(b2dnf a,bor b)
+  'false
+bnot x == notDnf b2dnf x
+bassert x == [[nil,[x]]]
+bassertNot x == [[[x],nil]]
+------------------------Disjunctive Normal Form Code-----------------------
+--        dnf is  true | false | [coaf ... ]
+--        coaf is true | false | [item ... ]
+--        item is anything
+
+orDnf(a,b) ==                   -- or:  (dnf, dnf) -> dnf
+  a = 'false => b
+  b = 'false => a
+  a = 'true or b = 'true => 'true
+  null a => b     --null list means false
+  a is [c] = coafOrDnf(c,b)
+  coafOrDnf(first a,orDnf(rest a,b))
+
+andDnf(a,b) ==                  -- and: (dnf, dnf) -> dnf
+  a = 'true => b
+  b = 'true => a
+  a = 'false or b = 'false => 'false
+  null a => 'false  --null list means false
+  a is [c] => coafAndDnf(c,b)
+  x := coafAndDnf(first a,b)
+  y := andDnf(rest a,b)
+  x = 'false => y
+  y = 'false => x
+  ordUnion(x,y)
+
+notDnf l ==                     -- not: dnf  ->  dnf
+  l = 'true => 'false
+  l = 'false => 'true
+  null l =>     'true --null list means false
+  l is [x] => notCoaf x
+  andDnf(notCoaf first l,notDnf rest l)
+
+coafOrDnf(a,l) ==               -- or:  (coaf, dnf) -> dnf
+  a = 'true or l = 'true => 'true
+  a = 'false => l
+  member(a,l) => l
+  y := notCoaf a
+  x := ordIntersection(y,l)
+  null x => orDel(a,l)
+  x = l => 'true
+  x = y => ordSetDiff(l,x)
+  ordUnion(notDnf ordSetDiff(y,x),l)
+
+coafAndDnf(a,b) ==              --and: (coaf, dnf) -> dnf
+  a = 'true => b
+  a = 'false => 'false
+  [c,:r] := b
+  null r => coafAndCoaf(a,c) 
+  x := coafAndCoaf(a,c)      --dnf
+  y := coafAndDnf(a,r)       --dnf
+  x = 'false => y
+  y = 'false => x
+  ordUnion(x,y)
+
+coafAndCoaf([a,b],[p,q]) ==                  --and: (coaf,coaf) -> dnf
+  ordIntersection(a,q) or ordIntersection(b,p) => 'false
+  [[ordUnion(a,p),ordUnion(b,q)]]
+
+notCoaf [a,b] == [:[[nil,[x]] for x in a],:[[[x],nil] for x in b]]
+
+list1 l ==
+  l isnt [h,:t] => nil
+  null h => list1 t
+  [[h,nil,nil],:list1 t]
+list2 l ==
+  l isnt [h,:t] => nil
+  null h => list2 t
+  [[nil,h,nil],:list2 t]
+list3 l ==
+  l isnt [h,:t] => nil
+  null h => list3 t
+  [[nil,nil,h],:list3 t]
+orDel(a,l) ==
+  l is [h,:t] =>
+    a = h => t
+    ?ORDER(a,h) => [a,:l]
+    [h,:orDel(a,t)]
+  [a]
+ordList l ==
+  l is [h,:t] and t => orDel(h,ordList t)
+  l
+ordUnion(a,b) ==                           
+  a isnt [c,:r] => b
+  b isnt [d,:s] => a
+  c=d => [c,:ordUnion(r,s)]
+  ?ORDER(a,b) => [c,:ordUnion(r,b)]
+  [d,:ordUnion(s,a)]
+ordIntersection(a,b) ==
+  a isnt [h,:t] => nil
+  member(h,b) => [h,:ordIntersection(t,b)]
+  ordIntersection(t,b)
+ordSetDiff(a,b) ==
+  b isnt [h,:t] => a
+  member(h,a) => ordSetDiff(delete(h,a),t)
+  ordSetDiff(a,t)
+-------------
+testPredList u ==
+  for x in u repeat
+    y := simpBool x
+    x = y => nil
+    pp x
+    pp '"==========>"
+    pp y
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/slam.boot.pamphlet b/src/interp/slam.boot.pamphlet
new file mode 100644
index 00000000..4b080f02
--- /dev/null
+++ b/src/interp/slam.boot.pamphlet
@@ -0,0 +1,359 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\File{src/interp/slam.boot} Pamphlet}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
+  -- for an alternate definition of this function which does not allow
+  -- dynamic caching, see SLAMOLD BOOT
+--+
+  $compiledOpNameList := [nam]
+  minivectorName := makeInternalMapMinivectorName(nam)
+  $minivectorNames := [[op,:minivectorName],:$minivectorNames]
+  body := SUBST(minivectorName,"$$$",body)
+  if $compilingInputFile then
+    $minivectorCode := [:$minivectorCode,minivectorName]
+  SET(minivectorName,LIST2REFVEC $minivector)
+  argl := COPY argl     -- play it safe for optimization
+  init :=
+    not(isRecursive and $compileRecurrence and #argl = 1) => nil
+    NRTisRecurrenceRelation(nam,body,minivectorName)
+  init => compileRecurrenceRelation(op,nam,argl,body,init)
+  cacheCount:= getCacheCount op
+  cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
+  cacheCount = 0 or null argl =>
+    function:= [nam,['LAMBDA,[:argl,'envArg],body]]
+    compileInteractive function
+    nam
+  num :=
+    FIXP cacheCount =>
+      cacheCount < 1 =>
+        keyedSystemError("S2IM0019",[cacheCount,op])
+      cacheCount
+    keyedSystemError("S2IM0019",[cacheCount,op])
+  sayKeyedMsg("S2IX0003",[op,num])
+  auxfn := mkAuxiliaryName nam
+  g1:= GENSYM()  --argument or argument list
+  [arg,computeValue] :=
+    null argl => [nil,[auxfn]]
+    argl is [.] => [[g1, 'envArg],[auxfn,g1, 'envArg]]  --g1 is a parameter
+    [g1,['APPLX,MKQ auxfn,g1]]          --g1 is a parameter list
+  cacheName := mkCacheName nam
+  g2:= GENSYM()  --length of cache or arg-value pair
+  g3:= GENSYM()  --value computed by calling function
+  secondPredPair:=
+    null argl => [cacheName]
+    [['SETQ,g3,['assocCircular,g1,cacheName]],['CDR,g3]]
+  thirdPredPair:=
+    null argl => ['(QUOTE T),['SETQ,cacheName,computeValue]]
+    ['(QUOTE T),
+      ['SETQ,g2,computeValue],
+        ['SETQ,g3,
+            ['CAR,['SETQ,cacheName,['predCircular,cacheName,cacheCount]]]],
+          ['RPLACA,g3,g1],
+            ['RPLACD,g3,g2],
+              g2]
+  codeBody:=
+    ['PROG,[g2,g3],['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  -- cannot use envArg in next statement without redoing much
+  -- of above.
+  lamex:= ['LAM,arg,codeBody]
+  mainFunction:= [nam,lamex]
+  computeFunction:= [auxfn,['LAMBDA,[:argl, 'envArg],body]]
+  compileInteractive mainFunction
+  compileInteractive computeFunction
+  cacheType:= 'function
+  cacheResetCode:= ['SETQ,cacheName,['mkCircularAlist,cacheCount]]
+  cacheCountCode:= ['countCircularAlist,cacheName,cacheCount]
+  cacheVector:=
+    mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
+  $e:= put(nam,'cacheInfo, cacheVector,$e)
+  eval cacheResetCode
+  SETANDFILE(cacheName,mkCircularAlist cacheCount)
+  nam
+ 
+getCacheCount fn ==
+  n:= LASSOC(fn,$cacheAlist) => n
+  $cacheCount
+ 
+reportFunctionCacheAll(op,nam,argl,body) ==
+  sayKeyedMsg("S2IX0004",[op])
+  auxfn:= mkAuxiliaryName nam
+  g1:= GENSYM()  --argument or argument list
+  [arg,computeValue] :=
+    null argl => [['envArg],[auxfn, 'envArg]]
+    argl is [.] => [[g1, 'envArg],[auxfn,g1, 'envArg]]  --g1 is a parameter
+    [g1,['APPLX,MKQ auxfn,g1]]          --g1 is a parameter list
+  if null argl then g1:=nil
+  cacheName:= mkCacheName nam
+  g2:= GENSYM()  --value computed by calling function
+  secondPredPair:= [['SETQ,g2,['HGET,cacheName,g1]],g2]
+  thirdPredPair:= ['(QUOTE T),['HPUT,cacheName,g1,computeValue]]
+  codeBody:= ['PROG,[g2],['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  lamex:= ['LAM,arg,codeBody]
+  mainFunction:= [nam,lamex]
+  computeFunction:= [auxfn,['LAMBDA,[:argl, 'envArg],body]]
+  compileInteractive mainFunction
+  compileInteractive computeFunction
+  cacheType:= 'hash_-table
+  cacheResetCode:= ['SETQ,cacheName,['MAKE_-HASHTABLE,''UEQUAL]]
+  cacheCountCode:= ['hashCount,cacheName]
+  cacheVector:=
+    mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
+  $e:= put(nam,'cacheInfo, cacheVector,$e)
+  eval cacheResetCode
+  nam
+ 
+hashCount table ==
+  +/[ADD1 nodeCount HGET(table,key) for key in HKEYS table]
+ 
+mkCircularAlist n ==
+  l:= [[$failed,:$failed] for i in 1..n]
+  RPLACD(LASTNODE l,l)
+ 
+countCircularAlist(cal,n) ==
+  +/[nodeCount x for x in cal for i in 1..n]
+ 
+predCircular(al,n) ==
+  for i in 1..QSSUB1 n repeat al:= QCDR al
+  al
+ 
+assocCircular(x,al) ==  --like ASSOC except that al is circular
+  forwardPointer:= al
+  val:= nil
+  until EQ(forwardPointer,al) repeat
+    EQUAL(CAAR forwardPointer,x) => return (val:= CAR forwardPointer)
+    forwardPointer:= CDR forwardPointer
+  val
+ 
+compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
+  k:= #initCode
+  extraArgumentCode :=
+    extraArguments := [x for x in argl | x ^= sharpArg] =>
+      extraArguments is [x] => x
+      ['LIST,:extraArguments]
+    nil
+  g:= GENSYM()
+  gIndex:= GENSYM()
+  gsList:= [GENSYM() for x in initCode]
+  auxfn := mkAuxiliaryName(nam)
+  $compiledOpNameList := [:$compiledOpNameList,auxfn]
+  stateNam:= GENVAR()
+  stateVar:= GENSYM()
+  stateVal:= GENSYM()
+  lastArg := INTERNL STRCONC('"#",STRINGIMAGE QSADD1 LENGTH argl)
+  decomposeCode:=
+    [['LET,gIndex,['ELT,lastArg,0]],:[['LET,g,['ELT,lastArg,i]]
+      for g in gsList for i in 1..]]
+  gsRev:= REVERSE gsList
+  rotateCode:= [['LET,p,q] for p in gsRev for q in [:rest gsRev,g]]
+  advanceCode:= ['LET,gIndex,['ADD1,gIndex]]
+ 
+  newTripleCode := ['LIST,sharpArg,:gsList]
+  newStateCode :=
+    null extraArguments => ['SETQ,stateNam,newTripleCode]
+    ['HPUT,stateNam,extraArgumentCode,newTripleCode]
+ 
+  computeFunction:= [auxfn,['LAM,cargl,cbody]] where
+    cargl:= [:argl,lastArg]
+    returnValue:= ['PROGN,newStateCode,first gsList]
+    cbody:=
+      endTest:=
+        ['COND, [['EQL,sharpArg,gIndex],['RETURN,returnValue]]]
+      newValueCode:= ['LET,g,SUBST(gIndex,sharpArg,
+        EQSUBSTLIST(gsList,rest $TriangleVariableList,body))]
+      ['PROGN,:decomposeCode,
+        ['REPEAT,['WHILE,'T],['PROGN,endTest,advanceCode,
+          newValueCode,:rotateCode]]]
+  fromScratchInit:=
+    [['LET,gIndex,n],:[['LET,g,x] for g in gsList for x in initCode]]
+  continueInit:=
+    [['LET,gIndex,['ELT,stateVar,0]],
+      :[['LET,g,['ELT,stateVar,i]] for g in gsList for i in 1..]]
+  mainFunction:= [nam,['LAM,margl,mbody]] where
+    margl:= [:argl,'envArg]
+    max:= GENSYM()
+    tripleCode := ['CONS,n,['LIST,:initCode]]
+ 
+    -- initialSetCode initializes the global variable if necessary and
+    --  also binds "stateVar" to its current value
+    initialSetCode :=
+      initialValueCode :=
+        extraArguments => ['MAKE_-HASHTABLE,''UEQUAL]
+        tripleCode
+      cacheResetCode := ['SETQ,stateNam,initialValueCode]
+      ['COND,[['NULL,['AND,['BOUNDP,MKQ stateNam], _
+                          ['PAIRP,stateNam]]],    _
+                 ['LET,stateVar,cacheResetCode]], _
+             [''T, ['LET,stateVar,stateNam]]]
+ 
+    -- when there are extra arguments, initialResetCode resets "stateVar"
+    --  to the hashtable entry for the extra arguments
+    initialResetCode :=
+      null extraArguments => nil
+      [['LET,stateVar,['OR,
+         ['HGET,stateVar,extraArgumentCode],
+          ['HPUT,stateVar,extraArgumentCode,tripleCode]]]]
+ 
+    mbody :=
+      preset := [initialSetCode,:initialResetCode,['LET,max,['ELT,stateVar,0]]]
+      phrase1:= [['AND,['LET,max,['ELT,stateVar,0]],['GE,sharpArg,max]],
+                  [auxfn,:argl,stateVar]]
+      phrase2:= [['GT,sharpArg,['SETQ,max,['DIFFERENCE,max,k]]],
+                  ['ELT,stateVar,['QSADD1,['QSDIFFERENCE,k,['DIFFERENCE,sharpArg,max]]]]]
+      phrase3:= [['GT,sharpArg,n],[auxfn,:argl,['LIST,n,:initCode]]]
+      phrase4:= [['GT,sharpArg,n-k],
+        ['ELT,['LIST,:initCode],['QSDIFFERENCE,n,sharpArg]]]
+      phrase5:= ['(QUOTE T),['recurrenceError,MKQ op,sharpArg]]
+      ['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]]
+  sayKeyedMsg("S2IX0001",[op])
+  compileInteractive computeFunction
+  compileInteractive mainFunction
+  cacheType:= 'recurrence
+  cacheCountCode:= ['nodeCount,stateNam]
+  cacheVector:= mkCacheVec(op,stateNam,cacheType,cacheResetCode,cacheCountCode)
+  $e:= put(nam,'cacheInfo, cacheVector,$e)
+  nam
+ 
+nodeCount x == NUMOFNODES x
+ 
+recurrenceError(op,arg) == throwKeyedMsg("S2IX0002",[op,arg])
+ 
+mkCacheVec(op,nam,kind,resetCode,countCode) ==
+  [op,nam,kind,resetCode,countCode]
+ 
+-- reportCacheStore vl ==
+--   sayMSG concat(centerString('"Name",22,'" "),"   Kind          #Cells")
+--   sayMSG concat(centerString('"----",22,'" "),"   ----          ------")
+--   for x in vl repeat reportCacheStoreFor x
+--
+-- op2String op ==
+--   u:= linearFormatName op
+--   atom u => PNAME u
+--   "STRCONC"/u
+--
+-- reportCacheStorePrint(op,kind,count) ==
+--   ops:= op2String op
+--   opString:= centerString(ops,22,'" ")
+--   kindString:= centerString(PNAME kind,10,'" ")
+--   countString:= centerString(count,19,'" ")
+--   sayMSG concat(opString,kindString,countString)
+--
+-- reportCacheStoreFor op ==
+--   u:= getI(op,'localModemap) =>
+--     for [['local,target,:.],[.,fn],:.] in u repeat
+--       [op1,cacheName,kind,.,countCode]:= getI(fn,'cacheInfo) or
+--         keyedSystemError("S2GE0016",['"reportCacheStoreFor",
+--           '"missing cache information vector"])
+--       reportCacheStorePrint(op,kind,eval countCode)
+--     true
+--   u:= getI(op,"cache") =>
+--     reportCacheStorePrint(op,'variable,nodeCount u)
+--   nil
+ 
+clearCache x ==
+  get(x,'localModemap,$e) or get(x,'mapBody,$e) =>
+    for [map,:sub] in $mapSubNameAlist repeat
+      map=x => _/UNTRACE_,2(sub,NIL)
+    $e:= putHist(x,'localModemap,nil,$e)
+    $e:= putHist(x,'mapBody,nil,$e)
+    $e:= putHist(x,'localVars,nil,$e)
+    sayKeyedMsg("S2IX0007",[x])
+ 
+clearLocalModemaps x ==
+  u:= get(x,"localModemap",$e) =>
+    for sub in ASSOCRIGHT $mapSubNameAlist repeat
+      _/UNTRACE_,2(sub,NIL)
+    $e:= putHist(x,"localModemap",nil,$e)
+    for mm in u repeat
+      [.,fn,:.] := mm
+      if def:= get(fn,'definition,$e) then
+        $e:= putHist(x,'value,mkObj(def,$EmptyMode),$e)
+      if cacheVec:= get(fn,'cacheInfo,$e) then
+        SET(cacheVec.cacheName,NIL)
+      -- now clear the property list of the identifier
+      $e := addIntSymTabBinding(x,nil,$e)
+    sayKeyedMsg("S2IX0007",[x])
+ 
+compileInteractive fn ==
+  if $InteractiveMode then startTimingProcess 'compilation
+  --following not used for common lisp
+  --removeUnnecessaryLastArguments CADR fn
+  if $reportCompilation then
+    sayBrightlyI bright '"Generated LISP code for function:"
+    pp fn
+  optfn :=
+     $InteractiveMode => [timedOptimization fn]
+     [fn]
+  result := compQuietly optfn
+  if $InteractiveMode then stopTimingProcess 'compilation
+  result
+ 
+clearAllSlams x ==
+  fn(x,nil) where
+    fn(thoseToClear,thoseCleared) ==
+      for x in thoseToClear | not MEMQ(x,thoseCleared) repeat
+        slamListName:= mkCacheName x
+        SET(slamListName,nil)
+        thoseCleared:= ADJOIN(x,thoseCleared)
+        someMoreToClear:=
+          setDifference(LASSOC(x,$functorDependencyAlist),[:thoseToClear,:
+            thoseCleared])
+        NCONC(thoseToClear,someMoreToClear)
+ 
+clearSlam("functor")==
+  id:= mkCacheName functor
+  SET(id,nil)
+@
+
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/sockio.lisp.pamphlet b/src/interp/sockio.lisp.pamphlet
new file mode 100644
index 00000000..2a585267
--- /dev/null
+++ b/src/interp/sockio.lisp.pamphlet
@@ -0,0 +1,263 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp sockio.lisp}
+\author{Timothy Daly}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;; load C socket functions
+
+(in-package "BOOT")
+
+#+(and :Lucid (not :ibm/370))
+(progn
+  (system:define-foreign-function :c 'open_server :fixnum)
+  (system:define-foreign-function :c 'sock_get_int :fixnum)
+  (system:define-foreign-function :c 'sock_send_int :fixnum)
+  (system:define-foreign-function :c 'sock_get_string_buf :fixnum)
+  (system:define-foreign-function :c 'sock_send_string_len :fixnum)
+  (system:define-foreign-function :c 'sock_get_float :single)
+  (system:define-foreign-function :c 'sock_send_float :fixnum)
+  (system:define-foreign-function :c 'sock_send_wakeup :fixnum)
+  (system:define-foreign-function :c 'server_switch :fixnum)
+  (system:define-foreign-function :c 'flush_stdout :fixnum)
+  (system:define-foreign-function :c 'sock_send_signal :fixnum)
+  (system:define-foreign-function :c 'print_line :fixnum)
+  (system:define-foreign-function :c 'plus_infininty :single)
+  (system:define-foreign-function :c 'minus_infinity :single)
+  (system:define-foreign-function :c 'NANQ :single)
+)
+
+#+KCL
+(progn
+  (clines "extern double plus_infinity(), minus_infinity(), NANQ();")
+  (clines "extern double sock_get_float();")
+;; GCL may pass strings by value.  'sock_get_string_buf' should fill
+;; string with data read from connection, therefore needs address of
+;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
+;; resolve the problem
+  (clines "int sock_get_string_buf_wrapper(int i, object x, int j)"
+          "{ if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);"
+          "  if (x->st.st_fillp<j)"
+          "    FEerror(\"string too small in sock_get_string_buf_wrapper\",0);"
+          "  return sock_get_string_buf(i, x->st.st_self, j); }")
+  (defentry open_server (string) (int "open_server"))
+  (defentry sock_get_int (int) (int "sock_get_int"))
+  (defentry sock_send_int (int int) (int "sock_send_int"))
+  (defentry sock_get_string_buf (int object int) 
+     (int "sock_get_string_buf_wrapper"))
+  (defentry sock_send_string_len (int string int) (int "sock_send_string_len"))
+  (defentry sock_get_float (int) (double "sock_get_float"))
+  (defentry sock_send_float (int double) (int "sock_send_float"))
+  (defentry sock_send_wakeup (int int) (int "sock_send_wakeup"))
+  (defentry server_switch () (int "server_switch"))
+  (defentry flush_stdout () (int "flush_stdout"))
+  (defentry sock_send_signal (int int) (int "sock_send_signal"))
+  (defentry print_line (string) (int "print_line"))
+  (defentry plus_infinity () (double "plus_infinity"))
+  (defentry minus_infinity () (double "minus_infinity"))
+  (defentry NANQ () (double "NANQ"))
+  )
+
+(defun open-server (name)
+#+(and :lucid :ibm/370) -2
+#-(and :lucid :ibm/370)
+  (open_server name))
+(defun sock-get-int (type)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_get_int type))
+(defun sock-send-int (type val)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_send_int type val))
+(defun sock-get-string (type buf buf-len)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_get_string_buf type buf buf-len))
+(defun sock-send-string (type str)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_send_string_len type str (length str)))
+(defun sock-get-float (type)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_get_float type))
+(defun sock-send-float (type val)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_send_float type val))
+(defun sock-send-wakeup (type)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_send_wakeup type))
+(defun server-switch ()
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (server_switch))
+(defun sock-send-signal (type signal)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (sock_send_signal type signal))
+(defun print-line (str)
+#+(and :lucid :ibm/370) ()
+#-(and :lucid :ibm/370)
+  (print_line str))
+(defun |plusInfinity| () (plus_infinity))
+(defun |minusInfinity| () (minus_infinity))
+
+;; Macros for use in Boot
+
+(defun |openServer| (name)
+  (open_server name))
+(defun |sockGetInt| (type)
+  (sock_get_int type))
+(defun |sockSendInt| (type val)
+  (sock_send_int type val))
+(defun |sockGetString| (type buf buf-len)
+  (sock_get_string_buf type buf buf-len))
+(defun |sockSendString| (type str)
+  (sock_send_string_len type str (length str)))
+(defun |sockGetFloat| (type)
+  (sock_get_float type))
+(defun |sockSendFloat| (type val)
+  (sock_send_float type val))
+(defun |sockSendWakeup| (type)
+  (sock_send_wakeup type))
+(defun |serverSwitch| ()
+  (server_switch))
+(defun |sockSendSignal| (type signal)
+  (sock_send_signal type signal))
+(defun |printLine| (str)
+  (print_line str))
+
+;; Socket types.  This list must be consistent with the one in com.h
+
+(defconstant SessionManager     1)
+(defconstant ViewportServer     2)
+(defconstant MenuServer         3)
+(defconstant SessionIO          4)
+(defconstant MessageServer      5)
+(defconstant InterpWindow       6)
+(defconstant KillSpad		7)
+(defconstant DebugWindow	8)
+(defconstant NAGLinkServer      8)
+(defconstant Forker		9)
+
+;; same constants for use in BOOT
+(defconstant |$SessionManager|  SessionManager)
+(defconstant |$ViewportServer|  ViewportServer)
+(defconstant |$MenuServer|      MenuServer)
+(defconstant |$SessionIO|       SessionIO)
+(defconstant |$MessageServer|   MessageServer)
+(defconstant |$InterpWindow|    InterpWindow)
+(defconstant |$KillSpad|	KillSpad)
+(defconstant |$DebugWindow|     DebugWindow)
+(defconstant |$NAGLinkServer|   NAGLinkServer)
+(defconstant |$Forker|		Forker)
+
+;; Session Manager action requests
+
+(defconstant CreateFrame        1)
+(defconstant SwitchFrames       2)
+(defconstant EndOfOutput        3)
+(defconstant CallInterp         4)
+(defconstant EndSession         5)
+(defconstant LispCommand        6)
+(defconstant SpadCommand        7)
+(defconstant SendXEventToHyperTeX 8)
+(defconstant QuietSpadCommand   9)
+(defconstant CloseClient        10)
+(defconstant QueryClients       11)
+(defconstant QuerySpad		12)
+(defconstant NonSmanSession	13)
+(defconstant KillLispSystem     14)
+
+(defconstant |$CreateFrame|     CreateFrame)
+(defconstant |$SwitchFrames|    SwitchFrames)
+(defconstant |$EndOfOutput|     EndOfOutput)
+(defconstant |$CallInterp|      CallInterp)
+(defconstant |$EndSession|      EndSession)
+(defconstant |$LispCommand|     LispCommand)
+(defconstant |$SpadCommand|     SpadCommand)
+(defconstant |$SendXEventToHyperTeX| SendXEventToHyperTeX)
+(defconstant |$QuietSpadCommand| QuietSpadCommand)
+(defconstant |$CloseClient|     CloseClient)
+(defconstant |$QueryClients|    QueryClients)
+(defconstant |$QuerySpad|	QuerySpad)
+(defconstant |$NonSmanSession|	NonSmanSession)
+(defconstant |$KillLispSystem|  KillLispSystem)
+
+;; signal types (from /usr/include/sys/signal.h)
+#+(and :Lucid (not :ibm/370))
+(progn 
+  (defconstant	SIGUSR1	16)	;; user defined signal 1
+  (defconstant	SIGUSR2	17)	;; user defined signal 2
+  )
+
+#+:RIOS
+(progn 
+  (defconstant	SIGUSR1	30)	;; user defined signal 1
+  (defconstant	SIGUSR2	31)	;; user defined signal 2
+  )
+
+#+:IBMPS2
+(progn
+  (defconstant	SIGUSR1	30)	;; user defined signal 1
+  (defconstant	SIGUSR2	31)	;; user defined signal 2
+  )
+
+(setq |$NaNvalue| (NANQ))
+#-:ccl
+  (setq |$plusInfinity| (* 1.1  MOST-POSITIVE-LONG-FLOAT))
+#+:ccl
+  (setq |$plusInfinity| MOST-POSITIVE-LONG-FLOAT)
+(setq |$minusInfinity| (- |$plusInfinity|))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/spad.lisp.pamphlet b/src/interp/spad.lisp.pamphlet
new file mode 100644
index 00000000..382ffc6a
--- /dev/null
+++ b/src/interp/spad.lisp.pamphlet
@@ -0,0 +1,813 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/spad.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+<<*>>=
+<<license>>
+
+; NAME:	   Scratchpad Package
+; PURPOSE: This is an initialization and system-building file for Scratchpad.
+
+(in-package "BOOT")
+
+;;; Common  Block
+
+(defvar |$UserLevel| '|development|)
+(defvar |$preserveSystemLisplib| t "if nil finalizeLisplib does MA REP")
+(defvar |$incrementalLisplibFlag| nil "checked in compDefineLisplib")
+(defvar |$reportInstantiations| nil)
+(defvar |$reportEachInstantiation| nil)
+(defvar |$reportCounts| nil)
+(defvar |$CategoryDefaults| nil)
+(defvar |$compForModeIfTrue| nil "checked in compSymbol")
+(defvar |$functorForm| nil "checked in addModemap0")
+(defvar |$formalArgList| nil "checked in compSymbol")
+(defvar |$newComp| nil "use new compiler")
+(defvar |$newCompCompare| nil "compare new compiler with old")
+(defvar |$compileOnlyCertainItems| nil "list of functions to compile")
+(defvar |$newCompAtTopLevel| nil "if t uses new compiler")
+(defvar |$doNotCompileJustPrint| nil "switch for compile")
+(defvar |$PrintCompilerMessageIfTrue| t)
+(defvar |$Rep| '|$Rep| "should be bound to gensym? checked in coerce")
+;; the following initialization of $ must not be a defvar
+;; since that make $ special
+(setq $ '$) ;; used in def of Ring which is Algebra($)
+(defvar |$scanIfTrue| nil "if t continue compiling after errors")
+(defvar |$Representation| nil "checked in compNoStacking")
+(defvar |$definition| nil "checked in DomainSubstitutionFunction")
+(defvar |$Attributes| nil "global attribute list used in JoinInner")
+(defvar |$env| nil "checked in isDomainValuedVariable")
+(defvar |$e| nil "checked in isDomainValuedVariable")
+(defvar |$getPutTrace| nil)
+(defvar |$specialCaseKeyList| nil "checked in optCall")
+(defvar |$formulaFormat| nil "if true produce script formula output")
+(defvar |$texFormat| nil "if true produce tex output")
+(defvar |$fortranFormat| nil "if true produce fortran output")
+(defvar |$algebraFormat| t "produce 2-d algebra output")
+(defvar |$kernelWarn| NIL "")
+(defvar |$kernelProtect| NIL "")
+(defvar |$HiFiAccess| nil "if true maintain history file")
+(defvar |$mapReturnTypes| nil)
+(defvar /TRACENAMES NIL)
+
+(defvar INPUTSTREAM t "bogus initialization for now")
+
+(defvar |boot-NewKEY| NIL)
+(setq /WSNAME 'NOBOOT)
+(DEFVAR _ '&)
+(setq $linestack 'begin_unit)
+(setq $maxlinenumber 0)
+(defvar /EDIT-FM 'A1)
+(defvar /EDIT-FT 'SPAD)
+(defvar /RELEASE '"UNKNOWN")
+(defvar /rp '/RP)
+(defvar APLMODE NIL)
+(defvar error-print)
+(defvar ind)
+(defvar INITCOLUMN 0)
+(defvar JUNKTOKLIST '(FOR IN AS INTO OF TO))
+(defvar LCTRUE '|true|)
+(defvar m-chrbuffer)
+(defvar m-chrindex)
+(defvar MARG 0 "Margin for testing by ?OP")
+(defvar NewFlag)
+(defvar ParseMode)
+(defvar RLGENSYMFG NIL)
+(defvar RLGENSYMLST NIL)
+(defvar S-SPADTOK 'SPADSYSTOK)
+(defvar sortpred)
+(defvar SPADSYSKEY '(EOI EOL))
+(defvar STAKCOLUMN -1)
+(setq XTOKENREADER 'SPADTOK)
+(defvar xtrans '|boot-new|)
+(defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
+(setq |$useBFasDefault| T)
+(defvar |InteractiveMode|)
+(defvar |New-LEXPR|)
+(defvar |NewFLAG| t)
+(defvar |uc| 'UC)
+(setq |$lisp2lispRenameAssoc| '((RETURN . |return|)
+	  (EXIT . |exit|)
+	  (AND . |and|)
+	  (OR . |or|)
+	  (NOT . |not|)
+	  (IS . |is|)
+	  (CAR . |first|)
+	  (CDR . |rest|)
+	  (EQUAL . =)
+	  (NEQUAL . ^=)
+	  (PLUS . +)
+	  (TIMES . *)
+	  (QUOTIENT . /)
+	  (EXPT . **)
+	  (SUBST . |substitute|)
+	  (NULL . ^)
+	  (ATOM . |atom|)
+	  (NULL . |null|)
+	  ))
+
+(setq |$spadOpList|
+	'(\.\. - = * / ** + - \< \> \<= \>= ^= \# \' ^
+	  \: \:\: \. =\> == ==\> \| \:=))
+
+(DEFUN INTEGER-BIT (N I) (LOGBITP I N))
+
+(DEFUN /TRANSPAD (X)
+  (PROG (proplist)
+	(setq proplist (LIST '(FLUID . |true|)
+			     (CONS '|special|
+				   (COPY-TREE |$InitialDomainsInScope|))))
+	(SETQ |$tripleCache| NIL)
+	(SETQ |$InteractiveFrame|
+	      (|addBinding| '|$DomainsInScope| proplist
+			  (|addBinding| '|$Information| NIL
+				      (COPY-TREE |$InitialModemapFrame|))))
+	(RETURN (PROGN (S-PROCESS X) NIL))))
+
+(DEFUN /TRANSBOOT (X) (S-PROCESS X) NIL)
+
+(DEFUN /TRANSNBOOT (X) (S-PROCESS X) NIL)
+
+(DEFUN /TRANSMETA (X)
+  (PROG (KEYNAM ROOTFN U)
+	(SETQ ROOTFN (/MFINDROOT (CAR /SOURCEFILES)))
+	(SETQ $LASTPREFIX (GET ROOTFN 'METAPFX))
+	(SETQ KEYNAM (INTERNL $LASTPREFIX (PNAME ROOTFN) "KEY"))
+	(SET KEYNAM (REMDUP (APPEND METAKEYLST (EVAL KEYNAM))))
+	(SETQ U (GETRULEFUNLISTS ROOTFN (LIST X)))
+	(SUBLISNQ (PAIR (CADR U) (CAR U)) X)))
+
+ ;; NIL needed below since END\_UNIT is not generated by current parser
+(defun |isTokenDelimiter| () (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT NIL)))
+
+(defun |traceComp| ()
+  (SETQ |$compCount| 0)
+  (EMBED '|comp|
+     '(LAMBDA (X Y Z)
+	 (PROG (U)
+	       (SETQ |$compCount| (1+ |$compCount|))
+	       (SETQ |yesOrNo| (if (SETQ U (|comp| X Y Z))
+				   (if (EQUAL (SECOND U) Y) '|yes| (SECOND U))
+				 ('T '|no|)))
+	       (|sayBrightly| (CONS (MAKE-FULL-CVEC |$compCount| " ")
+				    (LIST X " --> " Y '|%b| |yesOrNo| '|%d|)))
+	       (SETQ |$compCount| (1- |$compCount|))
+	       (RETURN U)  )))
+  (|comp| $x $m $f)
+  (UNEMBED '|comp|))
+
+(defun READ-SPAD (FN FM TO)
+  (LET ((proplist
+	  (LIST '(FLUID . |true|)
+		(CONS '|special| (COPY-TREE |$InitialDomainsInScope|)))))
+    (SETQ |$InteractiveFrame|
+	  (|addBinding| '|$DomainsInScope| proplist
+		      (|addBinding| '|$Information| NIL
+				  (|makeInitialModemapFrame|))))
+    (READ-SPAD0 FN 'SPAD FM TO)))
+
+(defun READ-INPUT (FN FM TO) (READ-SPAD0 FN 'INPUT FM TO))
+
+(defun READ-SPAD0 (FN FT FM TO)
+  (let (($newspad t)) (READ-SPAD1 FN FT FM TO)))
+
+(defun READ-SPAD-1 () (|New,ENTRY,1|))
+
+(defun BOOT-LEXPR () (SETQ $BOOT 'T) (SPAD-LEXPR1))
+
+(defun NBOOT-LEXPR () (SETQ $NBOOT 'T) (SPAD-LEXPR1))
+
+(defun UNCONS (X)
+  (COND ((ATOM X) X)
+	((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X))))
+	(T (ERROR "UNCONS"))))
+
+(defun OPTIMIZE\&PRINT (X) (PRETTYPRINT (/MDEF X)))
+
+(defun SPAD-PRINTTIME (A B)
+  (let (c msg)
+    (setq C (+ A B))
+    (setq MSG (STRCONC "(" (STRINGIMAGE A) " + " (STRINGIMAGE B)
+		       " = " (STRINGIMAGE C) " MS.)"))
+    (PRINT (STRCONC (STRINGPAD "" (DIFFERENCE 80 (SIZE MSG))) MSG))))
+
+(defun SPAD-MODETRAN (X) (D-TRAN X))
+
+(defun SPAD-MDTR-1 (X)
+  (COND
+    ((ATOM X) (LIST (LIST X)))
+    ((EQCAR X 'LIST) (SPAD-MDTR-2 (CDR X)))
+    (T (CROAK "MODE TRANSFORM ERROR"))))
+
+(defun SPAD-MDTR-2 (L)
+  (COND
+    ((NOT L) L)
+    ((ATOM (FIRST L))
+     (COND
+       ((MEMBER (FIRST L) $DOMVAR) (FIRST L))
+       (T (CONS (LIST (LIST (FIRST L))) (SPAD-MDTR-2 (CDR L))))	 ))
+    (T (CONS (FIRST L) (SPAD-MDTR-2 (CDR L))))))
+
+(defun SPAD-EVAL (X)
+  (COND ((ATOM X) (EVAL X))
+	((CONS (FIRST X) (MAPCAR #'SPAD-EVAL (CDR X))))))
+
+;************************************************************************
+;	  SYSTEM COMMANDS
+;************************************************************************
+
+(defun CLEARDATABASE () (OBEY "ERASE MODEMAP DATABASE"))
+
+(defun erase (FN FT)
+  (OBEY (STRCONC "ERASE " (STRINGIMAGE FN) " " (STRINGIMAGE FT))))
+
+(defun READLISP (UPPER_CASE_FG)
+  (let (v expr val )
+    (setq EXPR (READ-FROM-STRING
+		  (IF UPPER_CASE_FG (string-upcase (line-buffer CURRENT-LINE))
+		      (line-buffer CURRENT-LINE))
+		  t nil :start (Line-CURRENT-INDEX CURRENT-LINE)))
+    (VMPRINT EXPR)
+    (setq VAL ((LAMBDA (|$InteractiveMode|)  (EVAL EXPR)) NIL))
+    (FORMAT t "~&VALUE = ~S" VAL)
+    (TERSYSCOMMAND)))
+
+(defun TERSYSCOMMAND ()
+  (FRESH-LINE)
+  (SETQ CHR 'ENDOFLINECHR)
+  (SETQ TOK 'END_UNIT)
+  (|spadThrow|))
+
+(defun /READ (L Q)
+;  (SETQ /EDIT-FN (OR (KAR L) /EDIT-FN))
+;  (SETQ /EDIT-FT (OR (KAR (KDR L)) 'INPUT))
+;  (SETQ /EDIT-FM (OR (KAR (KDR (KDR L))) '*))
+;  (SETQ /EDITFILE (LIST /EDIT-FN /EDIT-FT /EDIT-FM))
+  (SETQ /EDITFILE L)
+  (COND
+    (Q	(/RQ))
+    ('T (/RF)) )
+  (FLAG |boot-NewKEY| 'KEY)
+  (|terminateSystemCommand|)
+  (|spadPrompt|))
+
+(defun /EDIT (L)
+  (SETQ /EDITFILE L)
+  (/EF)
+  (|terminateSystemCommand|)
+  (|spadPrompt|))
+
+(defun /COMPINTERP (L OPTS)
+  (SETQ /EDITFILE (/MKINFILENAM L))
+  (COND ((EQUAL OPTS "rf") (/RF))
+	((EQUAL OPTS "rq") (/RQ))
+	('T (/RQ-LIB)))
+  (|terminateSystemCommand|)
+  (|spadPrompt|))
+
+(defun CPSAY (X) (let (n) (if (EQ 0 (setq N (OBEY X))) NIL (PRINT N))))
+
+(defun /FLAG (L)
+  (MAKEPROP (FIRST L) 'FLAGS (LET ((X (UNION (CDR L)))) (GET (FIRST L) 'FLAGS)))
+  (SAY (FIRST L) " has flags: " X)
+  (TERSYSCOMMAND))
+
+(defun |fin| ()
+  (SETQ *EOF* 'T)
+  (THROW 'SPAD_READER NIL))
+
+
+(defun STRINGREST (X) (if (EQ (SIZE X) 1) (make-string 0) (SUBSTRING X 1 NIL)))
+
+(defun STREAM2UC (STRM)
+  (LET ((X (ELT (LASTATOM STRM) 1))) (SETELT X 0 (LC2UC (ELT X 0)))))
+
+(defun NEWNAMTRANS (X)
+  (COND
+    ((IDENTP X) (COND ( (GET X 'NEWNAM) (GET X 'NEWNAM)) ('T X)))
+    ((STRINGP X) X)
+    ((*VECP X) (MAPVWOC X (FUNCTION NEWNAMTRANS)))
+    ((ATOM X) X)
+    ((EQCAR X 'QUOTE))
+    (T (CONS (NEWNAMTRANS (FIRST X)) (NEWNAMTRANS (CDR X))))))
+
+(defun GP2COND (L)
+  (COND ((NOT L) (ERROR "GP2COND"))
+	((NOT (CDR L))
+	 (COND ((EQCAR (FIRST L) 'COLON)
+		(CONS (SECOND L) (LIST (LIST T 'FAIL))))
+	       (T (LIST (LIST T (FIRST L)))) ))
+	((EQCAR (FIRST L) 'COLON) (CONS (CDAR L) (GP2COND (CDR L))))
+	(T (ERROR "GP2COND"))))
+
+(FLAG JUNKTOKLIST 'KEY)
+
+(defmacro |report| (L)
+  (SUBST (SECOND L) 'x
+	 '(COND ($reportFlag (sayBrightly x)) ((QUOTE T) NIL))))
+
+(defmacro |DomainSubstitutionMacro| (&rest L)
+  (|DomainSubstitutionFunction| (first L) (second L)))
+
+(defun |sort| (seq spadfn)
+    (sort (copy-seq seq) (function (lambda (x y) (SPADCALL X Y SPADFN)))))
+
+#-Lucid
+(defun QUOTIENT2 (X Y) (values (TRUNCATE X Y)))
+
+#+Lucid
+(defun QUOTIENT2 (X Y) ; following to force error check in division by zero
+  (values (if (zerop y) (truncate 1 Y) (TRUNCATE X Y))))
+
+#-Lucid
+(define-function 'REMAINDER2 #'REM)
+
+#+Lucid
+(defun REMAINDER2 (X Y)
+  (if (zerop y) (REM 1 Y) (REM X Y)))
+
+#-Lucid
+(defun DIVIDE2 (X Y) (multiple-value-call #'cons (TRUNCATE X Y)))
+
+#+Lucid
+(defun DIVIDE2 (X Y)
+  (if (zerop y) (truncate 1 Y)
+    (multiple-value-call #'cons (TRUNCATE X Y))))
+
+(defmacro APPEND2 (x y) `(append ,x ,y))
+
+(defmacro |float| (x &optional (y 0.0d0)) `(float ,x ,y))
+
+(defun |makeSF| (mantissa exponent)
+  (|float| (/ mantissa (expt 2 (- exponent)))))
+
+(define-function 'list1 #'list)
+(define-function '|not| #'NOT)
+
+(defun |random| () (random (expt 2 26)))
+(defun \,plus (x y) (+ x y))
+(defun \,times (x y) (* x y))
+(defun \,difference (x y) (- x y))
+(defun \,max (x y) (max x y))
+(defun \,min (x y) (min x y))
+;; This is used in the domain Boolean (BOOLEAN.NRLIB/code.lsp)
+(defun |BooleanEquality| (x y) (if x y (null y)))
+
+(defun S-PROCESS (X)
+  (let ((|$Index| 0)
+	(*print-pretty* t)
+	($MACROASSOC ())
+	($NEWSPAD T)
+	(|$PolyMode| |$EmptyMode|)
+	(|$compUniquelyIfTrue| nil)
+	|$currentFunction|
+	(|$postStack| nil)
+	|$topOp|
+	(|$semanticErrorStack| ())
+	(|$warningStack| ())
+	(|$exitMode| |$EmptyMode|)
+	(|$exitModeStack| ())
+	(|$returnMode| |$EmptyMode|)
+	(|$leaveMode| |$EmptyMode|)
+	(|$leaveLevelStack| ())
+	$TOP_LEVEL |$insideFunctorIfTrue| |$insideExpressionIfTrue|
+	|$insideCoerceInteractiveHardIfTrue| |$insideWhereIfTrue|
+	|$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form|
+	(|$DomainFrame| '((NIL)))
+	(|$e| |$EmptyEnvironment|)
+	(|$genFVar| 0)
+	(|$genSDVar| 0)
+	(|$VariableCount| 0)
+	(|$previousTime| (TEMPUS-FUGIT))
+	(|$LocalFrame| '((NIL))))
+    (prog ((CURSTRM CUROUTSTREAM) |$s| |$x| |$m| u)
+	  (declare (special CURSTRM |$s| |$x| |$m| CUROUTSTREAM))
+	  (SETQ $TRACEFLAG T)
+	  (if (NOT X) (RETURN NIL))
+	  (setq X (if $BOOT (DEF-RENAME (|new2OldLisp| X))
+		    (|parseTransform| (|postTransform| X))))
+	  (if |$TranslateOnly| (RETURN (SETQ |$Translation| X)))
+	  (when |$postStack| (|displayPreCompilationErrors|) (RETURN NIL))
+	  (COND (|$PrintOnly|
+		 (format t "~S   =====>~%" |$currentLine|)
+		 (RETURN (PRETTYPRINT X))))
+	  (if (NOT $BOOT)
+	      (if |$InteractiveMode|
+		  (|processInteractive| X NIL)
+		(if (setq U (|compTopLevel|	 X |$EmptyMode|
+			     |$InteractiveFrame|))
+		    (SETQ |$InteractiveFrame| (third U))))
+	    (DEF-PROCESS X))
+	  (if |$semanticErrorStack| (|displaySemanticErrors|))
+	  (TERPRI))))
+
+(MAKEPROP 'END_UNIT 'KEY T)
+
+(defun |process| (x)
+  (COND ((NOT (EQ TOK 'END_UNIT))
+	 (SETQ DEBUGMODE 'NO)
+	 (SPAD_SYNTAX_ERROR)
+	 (if |$InteractiveMode| (|spadThrow|))
+	 (S-PROCESS x))))
+
+(defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x))
+
+(defun new () (|New,ENTRY|))
+
+(defun newpo () (let ((|$PrintOnly| t)) (new)))
+
+(defun |New,ENTRY| ()
+   (let ((|$InteractiveMode| t)(inputstream in-stream) )
+      (declare (special inputstream))
+      (spad)))
+
+(defun |New,ENTRY,SYS| ()
+  (let (|$InteractiveMode|)
+    (|New,ENTRY1|)))
+
+(defun |New,ENTRY1| ()
+  (let ((spaderrorstream curoutstream) $boot (curinstream curinstream)
+	(strm curinstream))
+    (SETQ CURINSTREAM *terminal-io*)
+    (|New,ENTRY,1|)
+    (SETQ CURINSTREAM STRM)
+    'END_OF_New))
+
+(setq *PROMPT* 'LISP)
+
+(defun |New,ENTRY,1| ()
+    (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE *PROMPT*
+	  SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT)
+	  $NEWLINSTACK $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS
+	  XTOKENREADER STACK STACKX TRAPFLAG)
+      (SETQ XTRANS '|boot-New|
+	    XTOKENREADER 'NewSYSTOK
+	    SYNTAX_ERROR 'SPAD_SYNTAX_ERROR)
+      (FLAG |boot-NewKEY| 'KEY)
+      (SETQ *PROMPT* 'Scratchpad-II)
+      (PROMPT)
+      (SETQ XCAPE '_)
+      (SETQ COMMENTCHR 'IGNORE)
+      (SETQ COLUMN 0)
+      (SETQ SINGLINEMODE T)   ; SEE NewSYSTOK
+      (SETQ NewFLAG T)
+      (SETQ ULCASEFG T)
+      (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| curinstream))
+      (if (/= 0 (setq N (NOTE STR)))
+	  (progn  (SETQ CURINSTREAM (POINTW N CURINSTREAM)))
+	  )
+      '|END_OF_New|))
+
+(defun |New,ENTRY,2| (RULE FN INPUTSTREAM) (declare (special INPUTSTREAM))
+  (let (zz)
+      (INITIALIZE)
+      (SETQ $previousTime (TEMPUS-FUGIT))
+      (setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|))
+      (REMFLAG |boot-NewKEY| 'KEY)
+      INPUTSTREAM))
+
+(defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM))
+
+(defun New-LEXPR () (New-LEXPR1))
+
+(defun New-LEXPR-Interactive () (setq |$InteractiveMode| t) (New-LEXPR1))
+
+(setq *prompt* 'new)
+
+(defun New-LEXPR1 ()
+  (FLAG |boot-NewKEY| 'KEY)
+  (SETLINE (SUB1 (file-position INPUTSTREAM)) INPUTSTREAM)
+  (SETQ CHR 'ENDOFLINECHR)
+  (NXTTOK)
+  (|boot-Statement|)
+  (CAR STACK))
+
+(defun parserState ()
+  (PRINT (LIST 'CHR= CHR 'NBLNK= NBLNK 'TOK= TOK 'ISID= ISID
+	       'COUNT= COUNT 'COLUMN= COLUMN))
+  (PRINT (LIST 'STACK= STACK 'STACKX= STACKX))
+  (PRINT (LIST '$TOKSTACK= $TOKSTACK 'INPUTSTREAM= INPUTSTREAM)))
+
+(defmacro try (X)
+  `(LET ((|$autoLine|))
+	(declare (special |$autoLine|))
+	(|tryToFit| (|saveState|) ,X)))
+
+(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'format (CADR X)))
+	'((COMMENT |formatCOMMENT|)
+	  (SEQ |formatSEQ|)
+	  (DEF |formatDEF|)
+	  (LET |formatLET|)
+	  (\: |formatColon|)
+	  (ELT |formatELT|)
+	  (SEGMENT |formatSEGMENT|)
+	  (COND |formatCOND|)
+	  (SCOND |formatSCOND|)
+	  (QUOTE |formatQUOTE|)
+	  (CONS |formatCONS|)
+	  (|where| |formatWHERE|)
+	  (APPEND |formatAPPEND|)
+	  (REPEAT |formatREPEAT|)
+	  (COLLECT |formatCOLLECT|)
+	  (REDUCE |formatREDUCE|)))
+
+(defun |boot2Lisp| (LINESET)
+  (let* (($TOP_STACK T) (*PROMPT* 'New) ($MAXLINENUMBER 0)
+	  (NewFLAG T) (XTRANS '|boot-New|) (XCAPE '!)
+	  (COMMENTCHR 'NOTHING)	 (XTOKENREADER 'NewSYSTOK)
+	  ($NBOOT T) (ERRCOL 0) (COUNT 0) (COLUMN 0)
+	  (TRAPFLAG NIL) (OK T)	 (SPADERRORSTREAM CUROUTSTREAM)
+	  ($LINESTACK 'BEGIN_UNIT)
+	  (INPUTSTREAM LINESET)
+	  (CHR 'ENDOFLINECHR))
+    (REMFLAG S-SPADKEY 'KEY)
+    (FLAG |boot-NewKEY| 'KEY)
+    (NXTTOK)   ; causes PREPARSE to be called
+    (|boot-Statement|)
+    (REMFLAG |boot-NewKEY| 'KEY)
+    (FLAG S-SPADKEY 'KEY)
+    (if (NULL OK) (|boot2LispError|))
+    (|new2OldLisp| (CAR STACK))))
+
+(defun /cx (L)
+  "CAUTION: will not work if function in L has DEFLOC with ft=NBOOT"
+  (if (not L) (SETQ L |$LastCxArg|))
+  (SETQ |$LastCxArg| L)
+  (/D-1 L '|lisp2BootAndCompare| NIL NIL))
+
+(defun /foobar (L)
+  (let (($xCount 0))
+    (if (not L) (SETQ L $LastCxArg))
+    (SETQ $LastCxArg L)
+    (/D-1 L 'foobar NIL NIL)))
+
+(defun foobar (X) |$xCount|)
+
+(defun |/cxd| (L)
+  (if (NULL L) (SETQ L $|LastCxArg|))
+  (SETQ |$LastCxArg| L)
+  (/D-1 L '|lispOfBoot2NBootAndCompare| NIL NIL))
+
+(defun |/rx| (L)
+  (let ((DEF-RENAME 'IDENTITY)
+	(DEF-PROCESS '|lispOfBoot2NBootAndCompare|) )
+    (declare (SPECIAL DEF-RENAME DEF-PROCESS))
+    (if (OR (NULL L) (NULL (ATOM (CAR L))))
+	(EVAL (APPEND (CONS '/RF /EDITFILE) L))
+	(CATCH 'FILENAM (/RF-1 L)))))
+
+(defun |/ry| (L)
+  (let ((DEF-RENAME 'IDENTITY)
+	(DEF-PROCESS '|pp|) )
+    (declare (SPECIAL DEF-RENAME DEF-PROCESS))
+   (if (OR (NULL L) (NULL (ATOM (CAR L))))
+       (EVAL (APPEND (CONS '/RF /EDITFILE) L))
+       (CATCH 'FILENAM (/RF-1 L)))))
+
+(defun |/tb| (L)
+  (let ((DEF-RENAME 'IDENTITY) (DEF-PROCESS 'lispOfBoot2NBAC1))
+    (declare (special DEF-RENAME DEF-PROCESS))
+    (if (NULL L)
+	(EVAL (CONS '/RQ /EDITFILE))
+	(CATCH 'FILENAM
+	  (PROG (OUTFILE ($PRETTYPRINT T))
+		(SETQ /EDITFILE (LIST (CAR L) 'BOOT '*))
+		(OBEY (STRCONC "ERASE " (PNAME (CAR /EDITFILE)) " NBOOT E1"))
+		(SETQ OUTFILE (LIST (CAR /EDITFILE) 'NBOOT 'E1))
+		(RETURN (/RF-1 (APPEND /EDITFILE
+				       (LIST (CONS 'TO= OUTFILE))))))))))
+
+(defun |boot2LispError| ()
+  "Print syntax error indication, underline character, scrub line."
+  (COND ((OR (EQ DEBUGMODE 'YES) (NULL (CONSOLEINPUTP INPUTSTREAM)))
+	 (SPAD_LONG_ERROR))
+	(T (SPAD_SHORT_ERROR)))
+  (SETQ OK T))
+
+(defun |getTranslation| (|function| |fn| |ft| |rdr|)
+  (let ((|New-LEXPR| |rdr|) (|$TranslateOnly| T))
+    (declare (special |New-LEXPR| |$TranslateOnly|))
+    (/D-1 (LIST |function| (LIST 'FROM= |fn| |ft|)) 'IDENTITY NIL NIL)
+    |$Translation|))
+
+(defmacro |incTimeSum| (a b)
+  (if (not |$InteractiveTimingStatsIfTrue|) a
+      (let ((key  b) (oldkey (gensym)) (val (gensym)))
+	`(prog (,oldkey ,val)
+	       (setq ,oldkey (|incrementTimeSum| ,key))
+	       (setq ,val ,a)
+	       (|incrementTimeSum| ,oldkey)
+	       (return ,val)))))
+
+(defun GLESSEQP (X Y) (NOT (GGREATERP X Y)))
+
+(defun LEXLESSEQP (X Y) (NOT (LEXGREATERP X Y)))
+
+(defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
+
+(defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
+
+(defmacro |rplac| (&rest L)
+  (let (a b s)
+    (cond
+      ((EQCAR (SETQ A (CAR L)) 'ELT)
+       (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0))
+	      (SETQ S "CA")
+	      (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D")))
+	      (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L)))
+	     ((ERROR "rplac"))))
+      ((PROGN
+	 (SETQ A (CARCDREXPAND (CAR L) NIL))
+	 (SETQ B (CADR L))
+	 (COND
+	   ((CDDR L) (ERROR 'RPLAC))
+	   ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
+	   ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
+	   ((ERROR 'RPLAC))))))))
+
+(DEFUN ASSOCIATER (FN LST)
+  (COND ((NULL LST) NIL)
+	((NULL (CDR LST)) (CAR LST))
+	((LIST FN (CAR LST) (ASSOCIATER FN (CDR LST))))))
+
+(defun ISLOCALOP-1 (IND)
+  "Curindex points at character after '.'"
+  (prog (selector buf termtok (NEWCHR (NEXTCHARACTER)))
+    (if (TERMINATOR NEWCHR) (RETURN NIL))
+    (setq SELECTOR
+	  (do ((x nil))
+	      (nil)
+	    (if (terminator newchr)
+		(reverse x)
+		(push (setq newchr (nextcharacter)) x))))
+    (if (EQUAL NEWCHR '\.) (RETURN (ISLOCALOP-1 IND)))
+    (setq BUF (GETSTR (LENGTH SELECTOR)))
+    (mapc #'(lambda (x) (suffix x buf)) selector)
+    (setq buf (copy-seq selector))
+    (setq TERMTOK (INTERN BUF))
+    (if (NOT (GET TERMTOK 'GENERIC)) (RETURN NIL))
+    (if (OR (GET TERMTOK '|Led|) (GET TERMTOK '|Nud|))
+	(GET TERMTOK IND))
+    (return TERMTOK)))
+; **** X. Random tables
+
+(defvar MATBORCH "*")
+(defvar $MARGIN 3)
+(defvar $LINELENGTH 71)
+(defvar TEMPGENSYMLIST '(|s| |r| |q| |p|))
+(defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|))
+(defvar LITTLEIN " in ")
+(defvar INITALPHLIST ALPHLIST)
+(defvar INITXPARLST '(|i| |j| |k| |l| |m| |n| |p| |q|))
+(defvar PORDLST (COPY-tree INITXPARLST))
+(defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|))
+(defvar LITTLEA '|a|)
+(defvar LITTLEI '|i|)
+(defvar *TALLPAR NIL)
+(defvar ALLSTAR NIL)
+(defvar BLANK " ")
+(defvar PLUSS "+")
+(defvar PERIOD ".")
+(defvar SLASH "/")
+(defvar COMMA ",")
+(defvar LPAR "(")
+(defvar RPAR ")")
+(defvar EQSIGN "=")
+(defvar DASH "-")
+(defvar STAR "*")
+(defvar DOLLAR "$")
+(defvar COLON ":")
+
+; (SETQ |boot-NewKEY| (S- |boot-NewKEY| '(|cp| |cms| |lisp| |boot|)))
+
+(FLAG TEMPGENSYMLIST 'IS-GENSYM)
+
+(MAKEPROP 'COND '|Nud| '(|if| |if| 130 0))
+(MAKEPROP 'CONS '|Led| '(CONS CONS 1000 1000))
+(MAKEPROP 'APPEND '|Led| '(APPEND APPEND 1000 1000))
+(MAKEPROP 'TAG '|Led| '(TAG TAG 122 121))
+(MAKEPROP 'EQUATNUM '|Nud| '(|dummy| |dummy| 0 0))
+(MAKEPROP 'EQUATNUM '|Led| '(|dummy| |dummy| 10000 0))
+(MAKEPROP 'LET '|Led| '(:= LET 125 124))
+(MAKEPROP 'RARROW '|Led| '(== DEF 122 121))
+(MAKEPROP 'SEGMENT '|Led| '(\.\. SEGMENT 401 699 (|boot-Seg|)))
+
+;; NAME:    DECIMAL-LENGTH
+;; PURPOSE: Computes number of decimal digits in print representation of x
+;;  This should made as efficient as possible.
+
+(DEFUN DECIMAL-LENGTH (X)
+   (LET* ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X))))
+	  (X (TRUNCATE (ABS X) (EXPT 10 (1- K)))))
+     (IF (LESSP X 10) K (1+ K))))
+
+;(DEFUN DECIMAL-LENGTH2 (X)
+;   (LET ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X)))))
+;     (IF (< (ABS X) (EXPT 10 K)) K (1+ K))))
+
+
+;; function to create byte and half-word vectors in new runtime system 8/90
+
+#-:CCL
+(defun |makeByteWordVec| (initialvalue)
+  (let ((n (cond ((null initialvalue) 7) ('t (reduce #'max initialvalue)))))
+    (make-array (length initialvalue)
+      :element-type (list 'mod (1+ n))
+      :initial-contents initialvalue)))
+
+#+:CCL
+(defun |makeByteWordVec| (initialvalue)
+   (list-to-vector initialvalue))
+
+#-:CCL
+(defun |makeByteWordVec2| (maxelement initialvalue)
+  (let ((n (cond ((null initialvalue) 7) ('t maxelement))))
+    (make-array (length initialvalue)
+      :element-type (list 'mod (1+ n))
+      :initial-contents initialvalue)))
+
+#+:CCL
+(defun |makeByteWordVec2| (maxelement initialvalue)
+   (list-to-vector initialvalue))
+
+(defun |knownEqualPred| (dom)
+  (let ((fun (|compiledLookup| '= '((|Boolean|) $ $) dom)))
+    (if fun (get (bpiname (car fun)) '|SPADreplace|)
+      nil)))
+
+(defun |hashable| (dom)
+  (memq (|knownEqualPred| dom)
+	#-Lucid '(EQ EQL EQUAL)
+	#+Lucid '(EQ EQL EQUAL EQUALP)
+	))
+
+;; simpler interpface to RDEFIOSTREAM
+(defun RDEFINSTREAM (&rest fn)
+  ;; following line prevents rdefiostream from adding a default filetype
+  (if (null (rest fn)) (setq fn (list (pathname (car fn)))))
+  (rdefiostream (list (cons 'FILE fn) '(mode . INPUT))))
+
+(defun RDEFOUTSTREAM (&rest fn)
+  ;; following line prevents rdefiostream from adding a default filetype
+  (if (null (rest fn)) (setq fn (list (pathname (car fn)))))
+  (rdefiostream (list (cons 'FILE fn) '(mode . OUTPUT))))
+
+(defmacro |spadConstant| (dollar n)
+ `(spadcall (svref ,dollar (the fixnum ,n))))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/spaderror.lisp.pamphlet b/src/interp/spaderror.lisp.pamphlet
new file mode 100644
index 00000000..618a94e4
--- /dev/null
+++ b/src/interp/spaderror.lisp.pamphlet
@@ -0,0 +1,141 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/spaderroor.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+;; this files contains basic routines for error handling
+(in-package "BOOT")
+
+(defun error-format (message args)
+  (let ((|$BreakMode| '|break|))
+    (declare (special |$BreakMode|))
+   (if (stringp message) (apply #'format nil message args) nil)))
+ 
+;;(defmacro |trappedSpadEval| (form) form) ;;nop for now
+
+#+:akcl
+(setq |$quitTag| system::*quit-tag*)
+#+:akcl
+(defun |resetStackLimits| () (system:reset-stack-limits))
+#-:akcl
+(setq |$quitTag| (gensym))
+#-:akcl
+(defun |resetStackLimits| () nil)
+
+;; failed union branch --  value returned for numeric failure
+(setq |$numericFailure| (cons 1 "failed")) 
+
+(defvar |$oldBreakMode|)
+
+;; following macro evaluates form returning Union(type-of form, "failed")
+
+(defmacro |trapNumericErrors| (form)
+  `(let ((|$oldBreakMode| |$BreakMode|)
+	 (|$BreakMode| '|trapNumerics|)
+	 (val))
+     (setq val (catch '|trapNumerics| ,form))
+     (if (eq val |$numericFailure|) val
+       (cons 0 val))))
+
+;;;;;; considering this version for kcl
+;;(defmacro |trapNumericErrors| (form)
+;;   `(let ((val))
+;;      (setq val (errorset ,form))
+;;      (if (NULL val) |$numericFailure| (cons 0 (car val)))))
+
+;; the following form embeds around the akcl error handler
+#+:akcl
+(eval-when
+ (load eval)
+ (unembed 'system:universal-error-handler)
+ (embed 'system:universal-error-handler
+	    '(lambda (type correctable? op
+			   continue-string error-string &rest args)
+	       (block
+		nil
+		(setq |$NeedToSignalSessionManager| T)
+		(if (and (boundp '|$inLispVM|) (boundp '|$BreakMode|))
+		    (cond ((eq |$BreakMode| '|validate|)
+			   (|systemError| (error-format error-string args)))
+			  ((and (eq |$BreakMode| '|trapNumerics|)
+				(eq type :ERROR))
+			   (setq |$BreakMode| nil)			   (throw '|trapNumerics| |$numericFailure|))
+                          ((and (eq |$BreakMode| '|trapNumerics|)
+				(boundp '|$oldBreakMode|)
+				(setq |$BreakMode| |$oldBreakMode|)
+				nil)) ;; resets error handler
+			  ((and (null |$inLispVM|)
+				(memq |$BreakMode| '(|nobreak| |query| |resume|)))
+			   (let ((|$inLispVM| T)) ;; turn off handler
+			     (return
+			      (|systemError| (error-format error-string args)))))
+			  ((eq |$BreakMode| '|letPrint2|)
+			   (setq |$BreakMode| nil)
+			   (throw '|letPrint2| nil))))
+		(apply system:universal-error-handler type correctable? op
+		       continue-string error-string args )))))
+
+
+
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/template.boot.pamphlet b/src/interp/template.boot.pamphlet
new file mode 100644
index 00000000..f37828c7
--- /dev/null
+++ b/src/interp/template.boot.pamphlet
@@ -0,0 +1,359 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp template.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+getOperationAlistFromLisplib x ==
+  -- used to be in clammed.boot. Moved on 1/24/94
+--+
+--  newType? x => GETDATABASE(x, 'OPERATIONALIST)
+  NRTgetOperationAlistFromLisplib x
+
+NRTgetOperationAlistFromLisplib x ==
+  u := GETDATABASE(x, 'OPERATIONALIST)
+--  u := removeZeroOneDestructively u
+  null u => u          -- this can happen for Object
+  CAAR u = '_$unique => rest u
+  f:= addConsDB '(NIL T ELT)
+  for [op,:sigList] in u repeat
+    for items in tails sigList repeat
+      [sig,:r] := first items
+      if r is [.,:s] then
+        if s is [.,:t] then
+          if t is [.] then nil
+          else RPLACD(s,QCDDR f)
+        else RPLACD(r,QCDR f)
+      else RPLACD(first items,f)
+      RPLACA(items,addConsDB CAR items)
+  u and markUnique u
+
+markUnique x ==
+  u := first x
+  RPLACA(x,'(_$unique))
+  RPLACD(x,[u,:rest x])
+  rest x
+
+--=======================================================================
+--                  Instantiation/Run-Time Operations
+--=======================================================================
+
+stuffSlots(dollar,template) ==
+  _$: fluid := dollar
+  dollarTail := [dollar]
+  for i in 5..MAXINDEX template | item := template.i repeat
+    dollar.i :=
+      atom item => [SYMBOL_-FUNCTION item,:dollar]
+      item is ['QUOTE,x] =>
+        x is [.,.,:n] and FIXP n => ['goGet,item,:dollarTail]
+        ['SETELT,dollar,i,['evalSlotDomain,item,dollar]]
+      item is ['CONS,:.] =>
+        item is [.,'IDENTITY,['FUNCALL,a,b]] =>
+          b = '$ => ['makeSpadConstant,eval a,dollar,i]
+          sayBrightlyNT '"Unexpected constant environment!!"
+          pp devaluate b
+          nil
+        sayBrightlyNT '"Unexpected constant format!!"
+        pp devaluate item
+        nil
+      sayBrightlyNT '"Unidentified stuff:"
+      pp item
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+--------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
+evalSlotDomain(u,dollar) ==
+  $returnNowhereFromGoGet: local := false
+  $ : fluid := dollar
+  $lookupDefaults : local := nil -- new world
+  u = '$ => dollar
+  FIXP u =>
+    VECP (y := dollar.u) => y
+    y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous?
+    y is [v,:.] =>
+      VECP v => lazyDomainSet(y,dollar,u)               --old style has [$,code,:lazyt]
+      GETDATABASE(v,'CONSTRUCTOR?) =>
+        lazyDomainSet(y,dollar,u)                       --new style has lazyt
+      y
+    y
+  u is ['NRTEVAL,y] => eval  y
+  u is ['QUOTE,y] => y
+  u is ['Record,:argl] =>
+     FUNCALL('Record0,[[tag,:evalSlotDomain(dom,dollar)]
+                                 for [.,tag,dom] in argl])
+  u is ['Union,:argl] and first argl is ['_:,.,.] =>
+     APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
+                                 for [.,tag,dom] in argl])
+  u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl])
+  systemErrorHere '"evalSlotDomain"
+
+
+--=======================================================================
+--                       Loadtime Operations
+--=======================================================================
+setLoadTime alist ==
+  for [nam,:val] in alist repeat SET(nam,eval val)
+
+setLoadTimeQ alist ==
+  for [nam,:val] in alist repeat SET(nam,val)
+
+makeTemplate vec ==
+--called at instantiation time by setLoadTime
+--the form ['makeTemplate,MKQ $template] is recorded by compDefineFunctor1
+--  $template is set below in NRTdescendCodeTran and NRTaddDeltaOpt
+  newVec := GETREFV SIZE vec
+  for index in 0..MAXINDEX vec repeat
+    item := vec.index
+    null item => nil
+    item is ['local,:.] => nil --this information used to for display of domains
+    newVec.index :=
+      atom item => item
+      null atom first item =>
+        [sig,dcIndex,op,:flag] := item
+        code := 4*index
+        if dcIndex > 0 then
+          code := code + 2   --means "bind"
+          else dcIndex := -dcIndex
+        if flag = 'CONST then code := code + 1 --means "constant"
+        sourceIndex := 8192*dcIndex + code
+        uniqueSig:= addConsDB sig
+        MKQ [op,uniqueSig,:sourceIndex]
+      item is ['CONS,:.] =>  item --constant case
+      MKQ item
+  newVec
+
+makeOpDirect u ==
+  [nam,[addForm,:opList]] := u
+  opList = 'derived => 'derived
+  [[op,:[fn y for y in items]] for [op,:items] in opList] where fn y ==
+        [sig,:r] := y
+        uniqueSig := addConsDB sig
+        predCode := 0
+        isConstant := false
+        r is [subSig,pred,'Subsumed] => [uniqueSig,'subsumed,addConsDB subSig]
+        if r is [n,:s] then
+          slot :=
+            n is [p,:.] => p  --the CDR is linenumber of function definition
+            n
+          if s is [pred,:t] then
+            predCode := (pred = 'T => 0; mkUniquePred pred)
+            if t is [='CONST,:.] then isConstant := true
+        index:= 8192*predCode
+        if NUMBERP slot and slot ^= 0 then index := index + 2*slot
+        if isConstant then index := index + 1
+        [uniqueSig,:index]
+
+--=======================================================================
+--          Creation of System Sig/Pred Vectors & Hash Tables
+--=======================================================================
+
+mkUniquePred pred == putPredHash addConsDB pred
+
+putPredHash pred == --pred MUST have had addConsDB applied to it
+  if pred is [op,:u] and MEMQ(op,'(AND OR NOT)) then
+    for x in u repeat putPredHash x
+  k := HGET($predHash,pred) => k
+  HPUT($predHash,pred,$predVectorFrontier)
+  if $predVectorFrontier > MAXINDEX $predVector
+    then $predVector := extendVectorSize $predVector
+  $predVector.$predVectorFrontier := pred
+  $predVectorFrontier := $predVectorFrontier + 1
+  $predVectorFrontier - 1
+
+extendVectorSize v ==
+  n:= MAXINDEX v
+  m:= (7*n)/5   -- make 40% longer
+  newVec := GETREFV m
+  for i in 0..n repeat newVec.i := v.i
+  newVec
+
+mkSigPredVectors() ==
+  $predHash:= MAKE_-HASHTABLE 'UEQUAL
+  $consDB:= MAKE_-HASHTABLE 'UEQUAL
+  $predVectorFrontier:= 1   --slot 0 in vector will be vacant
+  $predVector:= GETREFV 100
+  for nam in allConstructors() |
+          null (GETDATABASE(nam, 'CONSTRUCTORKIND) = 'package) repeat
+    for [op,:sigList] in GETDATABASE(nam,'OPERATIONALIST) repeat
+      for [sig,:r] in sigList repeat
+        addConsDB sig
+        r is [.,pred,:.] => putPredHash addConsDB pred
+  'done
+
+list2LongerVec(u,n) ==
+  vec := GETREFV ((7*n)/5) -- make 40% longer
+  for i in 0.. for x in u repeat vec.i := x
+  vec
+
+squeezeConsDB u ==
+  fn u where fn u ==
+    VECP u => for i in 0..MAXINDEX u repeat fn u.i
+    PAIRP u =>
+      EQ(x := QCAR u,'QUOTE) => RPLAC(CADR u,addConsDB CADR u)
+      squeezeConsDB x
+      squeezeConsDB QCDR u
+    nil
+  u
+
+mapConsDB x == [addConsDB y for y in x]
+addConsDB x ==
+  min x where
+    min x ==
+      y:=HGET($consDB,x)
+      y => y
+      PAIRP x =>
+        for z in tails x repeat
+          u:=min CAR z
+          if not EQ(u,CAR z) then RPLACA(z,u)
+        HashCheck x
+      REFVECP x =>
+        for i in 0..MAXINDEX x repeat
+          x.i:=min (x.i)
+        HashCheck x
+      STRINGP x => HashCheck x
+      x
+    HashCheck x ==
+      y:=HGET($consDB,x)
+      y => y
+      HPUT($consDB,x,x)
+      x
+  x
+
+--=======================================================================
+--               Functions Creating Lisplib Information
+--=======================================================================
+NRTdescendCodeTran(u,condList) ==
+--NRTbuildFunctor calls to fill $template slots with names of compiled functions
+  null u => nil
+  u is ['LIST] => nil
+  u is [op,.,i,a] and MEMQ(op,'(SETELT QSETREFV)) =>
+    null condList and a is ['CONS,fn,:.] =>
+      RPLACA(u,'LIST)
+      RPLACD(u,nil)
+      $template.i :=
+        fn = 'IDENTITY => a
+        fn is ['dispatchFunction,fn'] => fn'
+        fn
+    nil   --code for this will be generated by the instantiator
+  u is ['COND,:c] =>
+    for [pred,:y] in c|y repeat NRTdescendCodeTran(first y,[pred,:condList])
+  u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList)
+  nil
+
+--=======================================================================
+--                  Miscellaneous Functions
+--=======================================================================
+NRTaddInner x ==
+--called by genDeltaEntry and others that affect $NRTdeltaList
+  PROGN
+    atom x => nil
+    x is ['Record,:l] =>
+      for [.,.,y] in l repeat NRTinnerGetLocalIndex y
+    first x in '(Union Mapping) =>
+      for y in rest x repeat
+         y is [":",.,z] => NRTinnerGetLocalIndex z
+         NRTinnerGetLocalIndex y
+    x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y
+    getConstructorSignature x is [.,:ml] =>
+      for y in rest x for m in ml | not (y = '$) repeat
+        isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y
+    keyedSystemError("S2NR0003",[x])
+  x
+
+-- NRTaddInner should call following function instead of NRTgetLocalIndex
+-- This would prevent putting spurious items in $NRTdeltaList
+NRTinnerGetLocalIndex x ==
+  atom x => x
+  -- following test should skip Unions, Records, Mapping
+  MEMQ(opOf x,'(Union Record Mapping)) => NRTgetLocalIndex x
+  constructor?(x) => NRTgetLocalIndex x
+  NRTaddInner x
+
+assignSlotToPred cond ==
+--called by ProcessCond
+  cond is ['AND,:u] => ['AND,:[assignSlotToPred x for x in u]]
+  cond is ['OR,:u] => ['OR,:[assignSlotToPred x for x in u]]
+  cond is ['NOT,u] => ['NOT,assignSlotToPred u]
+  thisNeedsTOBeFilledIn()
+
+
+measure() ==
+  pp MEASURE (f := SparseUnivariatePolynomial_;)
+  pp MEASURE (o := SparseUnivariatePolynomial_;opDirect)
+  pp MEASURE (t := SparseUnivariatePolynomial_;template)
+  pp measureCommon [o,t]
+  MEASURE [f,o,t]
+
+measureCommon u ==
+--measures bytes which ARE on $consDB
+  $table: local := MAKE_-HASHTABLE 'UEQUAL
+  fn(u,0) where fn(u,n) == n +
+    VECP u => +/[fn(u.i,0) for i in 0..MAXINDEX u]
+    HASH-TABLE-P u =>
+      +/[fn(key,0) + fn(HGET(u,key),0) for key in HKEYS u]
+    PAIRP u =>
+      HGET($table,u) => 0
+      m := fn(first u,0) + fn(rest u,0)
+      HGET($consDB,u) => 8 + m
+      HPUT($table,u,'T)
+      m
+    0
+
+makeSpadConstant [fn,dollar,slot] ==
+  val := FUNCALL(fn,dollar)
+  u:= dollar.slot
+  RPLACA(u,function IDENTITY)
+  RPLACD(u,val)
+  val
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/termrw.boot.pamphlet b/src/interp/termrw.boot.pamphlet
new file mode 100644
index 00000000..bf52c465
--- /dev/null
+++ b/src/interp/termrw.boot.pamphlet
@@ -0,0 +1,197 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp termrw.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+Algorithms for Term Reduction
+ 
+The following assumptions are made:
+
+a term rewrite system is represented by a pair (varlist,varRules) where
+  varlist is the list of rewrite variables (test by MEMQ) and varRules
+  is an alist (no variables may occur in varRules)
+
+the following rewrite functions are available:
+  termRW looks for a fixpoint in applying varRules, where the outermost
+    leftmost is reduced first by term1RW
+  term1RW applies the first rule
+
+subCopy uses an alist (calls of ASSQ) to substitute a list structure
+  no left side of a pair of alist may appear on a righthand side
+  this means, subCopy is an idempotent function
+
+in both cases copying is only done if necessary to avoid destruction
+this means, EQ can be used to check whether something was done
+ 
+\end{verbatim}
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+ 
+termRW(t,R) ==
+  -- reduce t by rewrite system R
+  until b repeat
+    t0:= termRW1(t,R)
+    b:= EQ(t,t0)
+    t:= t0
+  t
+ 
+termRW1(t,R) ==
+  -- tries to do one reduction on the leftmost outermost subterm of t
+  t0:= term1RW(t,R)
+  not EQ(t0,t) or atom t => t0
+  [t1,:t2]:= t
+  tt1:= termRW1(t1,R)
+  tt2:= t2 and termRW1(t2,R)
+  EQ(t1,tt1) and EQ(t2,tt2) => t
+  CONS(tt1,tt2)
+ 
+term1RW(t,R) ==
+  -- tries to reduce t at the top node
+  [vars,:varRules]:= R
+  for r in varRules until not (SL='failed) repeat
+    SL:= termMatch(CAR r,t,NIL,vars)
+    not (SL='failed) =>
+      t:= subCopy(copy CDR r,SL)
+  t
+ 
+term1RWall(t,R) ==
+  -- same as term1RW, but returns a list
+  [vars,:varRules]:= R
+  [not (SL='failed) and subCopy(copy CDR r,SL) for r in varRules |
+    not EQ(SL:= termMatch(CAR r,t,NIL,vars),'failed)]
+ 
+termMatch(tp,t,SL,vars) ==
+  -- t is a term pattern, t a term
+  -- then the result is the augmented substitution SL or 'failed
+  tp=t => SL
+  atom tp =>
+    MEMQ(tp,vars) =>
+      p:= ASSOC(tp,SL) => ( CDR p=t )
+      CONS(CONS(tp,t),SL)
+    'failed
+  atom t => 'failed
+  [tp1,:tp2]:= tp
+  [t1,:t2]:= t
+  SL:= termMatch(tp1,t1,SL,vars)
+  SL='failed => 'failed
+  tp2 and t2 => termMatch(tp2,t2,SL,vars)
+  tp2 or t2 => 'failed
+  SL
+ 
+ 
+--% substitution handling
+ 
+-- isContained(v,t) ==
+--   -- tests (by EQ), whether v occurs in term t
+--   -- v must not be NIL
+--   EQ(v,t) => 'T
+--   atom t => NIL
+--   isContained(v,CAR t) or isContained(v,CDR t)
+ 
+augmentSub(v,t,SL) ==
+  -- destructively adds the pair (v,t) to the substitution list SL
+  -- t doesn't contain any of the variables of SL
+  q:= CONS(v,t)
+  null SL => [q]
+--  for p in SL repeat RPLACD(p,SUBSTQ(t,v,CDR p))
+  CONS(q,SL)
+ 
+mergeSubs(S1,S2) ==
+  -- augments S2 by each pair of S1
+  -- S1 doesn't contain any of the variables of S2
+  null S1 => S2
+  null S2 => S1
+  S3 := [p for p in S2 | not ASSQ(CAR p, S1)]
+--  for p in S1 repeat S3:= augmentSub(CAR p,CDR p,S3)
+  APPEND(S1,S3)
+ 
+subCopy(t,SL) ==
+  -- t is any LISP structure, SL a substitution list for sharp variables
+  -- then t is substituted and copied if necessary
+  SL=NIL => t
+  subCopy0(t,SL)
+ 
+subCopy0(t, SL) ==
+  p := subCopyOrNil(t, SL) => CDR p
+  t
+  
+subCopyOrNil(t,SL) ==
+  -- the same as subCopy, but the result is NIL if nothing was copied
+  p:= ASSOC(t,SL) => p
+  atom t => NIL
+  [t1,:t2]:= t
+  t0:= subCopyOrNil(t1,SL) =>
+    t2 => CONS(t, CONS(CDR t0, subCopy0(t2,SL)))
+    CONS(t,CONS(CDR t0,t2))
+  t2 and ( t0:= subCopyOrNil(t2,SL) ) => CONS(t, CONS(t1,CDR t0))
+  NIL
+ 
+ 
+deepSubCopy(t,SL) ==
+  -- t is any LISP structure, SL a substitution list for sharp variables
+  -- then t is substituted and copied if necessary
+  SL=NIL => t
+  deepSubCopy0(t,SL)
+ 
+deepSubCopy0(t, SL) ==
+  p := deepSubCopyOrNil(t, SL) => CDR p
+  t
+  
+deepSubCopyOrNil(t,SL) ==
+  -- the same as subCopy, but the result is NIL if nothing was copied
+  p:= ASSOC(t,SL) => CONS(t, deepSubCopy0(CDR p, SL))
+  atom t => NIL
+  [t1,:t2]:= t
+  t0:= deepSubCopyOrNil(t1,SL) =>
+    t2 => CONS(t, CONS(CDR t0, deepSubCopy0(t2,SL)))
+    CONS(t,CONS(CDR t0,t2))
+  t2 and ( t0:= deepSubCopyOrNil(t2,SL) ) => CONS(t, CONS(t1,CDR t0))
+ 
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/topics.boot.pamphlet b/src/interp/topics.boot.pamphlet
new file mode 100644
index 00000000..a269b18c
--- /dev/null
+++ b/src/interp/topics.boot.pamphlet
@@ -0,0 +1,263 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/topics.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+$topicsDefaults := '(
+  (basic elt setelt qelt qsetelt eval xRange yRange zRange map map! qsetelt!)
+  (conversion coerce convert retract)
+  (hidden retractIfCan Zero One)
+  (predicate _< _=)
+  (algebraic _+ _- _* _*_* _/ quo rem exquo)
+  (trignometric acos acot acsc asec asin atan cos cot csc sec sin tan)
+  (hyperbolic acosh acoth acsch asech asinh atanh cosh coth csch sech sinh tanh)
+  (destructive setelt qsetelt)
+  (extraction xRange yRange zRange elt qelt)
+  (transformation map map!))
+
+$topicSynonyms := '(
+  (b . basic)
+  (h . hidden)
+  (e . extended)
+  (a . algebraic)
+  (g . algebraic)
+  (c . construct)
+  (d . destructive)
+  (v . conversion)
+  (m . miscellaneous)
+  (x . extraction)
+  (p . predicate)
+  (tg . trignometric)
+  (hy . hyperbolic)
+  (t . transformation))
+
+$groupAssoc := '((extended . 1) (basic . 2) (hidden . 4))
+
+--=======================================================================
+--           Create Hashtable of Operation Properties
+--=======================================================================
+--called at build-time before making DOCUMENTATION property
+mkTopicHashTable() ==                         --given $groupAssoc = ((extended . 1)(basic . 2)(xx . 4)..)
+  $defaultsHash := MAKE_-HASHTABLE 'ID        --keys are ops, value is list of topic names
+  for [kind,:items] in $topicsDefaults repeat --$topicsDefaults is ((<topic> op ...) ..)
+    for item in items repeat 
+      HPUT($defaultsHash,item,[kind,:HGET($defaultsHash,item)])
+  $conTopicHash  := MAKE_-HASHTABLE 'EQL      --key is constructor name; value is
+  instream := OPEN '"topics.data"           
+  while not EOFP instream repeat
+    line := READLINE instream
+    while blankLine? line repeat line := READLINE instream
+    m := MAXINDEX line                        --file "topics.data" has form:
+    m = -1 => 'skip                           --1   ConstructorName:
+    line.0 = char '_- => 'skip                --2      constructorName or operation name
+    line := trimString line                   --3-n    ...
+    m := MAXINDEX line                        --     (blank line) ...
+    line.m ^= (char '_:) => systemError('"wrong heading")
+    con := INTERN SUBSTRING(line,0,m)
+    alist := [lst while not EOFP instream and 
+       not (blankLine? (line := READLINE instream)) and
+         line.0 ^= char '_- for i in 1..
+           | lst := string2OpAlist line]
+    alist => HPUT($conTopicHash,con,alist)
+  --initialize table of topic classes
+  $topicHash := MAKE_-HASHTABLE 'ID           --$topicHash has keys: topic and value: index
+  for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c)
+  $topicIndex := CDR LAST $groupAssoc
+
+  --replace each property list by a topic code
+  --store under each construct an OR of all codes
+  for con in HKEYS $conTopicHash repeat
+    conCode := 0
+    for pair in HGET($conTopicHash,con) repeat 
+      RPLACD(pair,code := topicCode CDR pair)
+      conCode := LOGIOR(conCode,code)
+    HPUT($conTopicHash,con,
+      [['constructor,:conCode],:HGET($conTopicHash,con)])      
+  SHUT instream
+
+--reduce integers stored under names to 1 + its power of 2
+  for key in HKEYS $topicHash repeat 
+    HPUT($topicHash,key,INTEGER_-LENGTH HGET($topicHash,key))
+
+  $conTopicHash   --keys are ops or 'constructor', values are codes
+
+blankLine? line ==
+  MAXINDEX line = -1 or and/[line . j = (char '_ ) for j in 0..MAXINDEX line]
+
+string2OpAlist s ==
+  m := #s
+  k := skipBlanks(s,0,m) or return nil
+  UPPER_-CASE_-P s.k => nil       --skip constructor names
+  k := 0
+  while (k := skipBlanks(s,k,m)) repeat
+    acc := [INTERN SUBSTRING(s,k,-k + (k := charPosition(char '_ ,s,k + 1))),:acc]
+  acc := NREVERSE acc
+  --now add defaults 
+  if u := getDefaultProps first acc then acc := [first acc,:u,:rest acc]
+  acc
+
+getDefaultProps name ==
+  u := HGET($defaultsHash,name)
+  if (s := PNAME name).(m := MAXINDEX s) = char '? then u := ['p,:u]
+  if s.m = char '_! then u := ['destructive,:u]
+  u
+  
+skipBlanks(u,i,m) ==
+  while i < m and u.i = $charBlank repeat i := i + 1
+  i >= m => nil
+  i
+
+--=======================================================================
+--           Compute Topic Code for Operation
+--=======================================================================
+topicCode lst ==
+  u := [y for x in lst] where y ==
+    rename := LASSOC(x,$topicSynonyms) => rename
+    x
+  if null intersection('(basic extended hidden),u) then u := ['extended,:u]
+  bitIndexList := nil
+  for x in REMDUP u repeat
+    bitIndexList := [fn x,:bitIndexList] where fn x ==
+      k := HGET($topicHash,x) => k
+      HPUT($topicHash,x,$topicIndex := $topicIndex * 2)
+      $topicIndex
+  code := +/[i for i in bitIndexList]
+
+--=======================================================================
+--           Add Codes to Documentation Property
+--=======================================================================
+--called to modify DOCUMENTATION property for each "con"
+addTopic2Documentation(con,docAlist) ==
+  alist := HGET($conTopicHash,con) or return docAlist
+  [y for x in docAlist] where y ==
+    [op,:pairlist] := x
+    code := LASSOC(op,alist) or 0
+    for sigDoc in pairlist repeat 
+      sigDoc is [.,.] => RPLACD(rest sigDoc,code)
+      systemError sigDoc
+  docAlist
+    
+--=======================================================================
+--           Test: Display Topics for a given constructor
+--=======================================================================
+td con ==
+  $topicClasses := ASSOCRIGHT mySort
+      [[HGET($topicHash,key),:key] for key in HKEYS $topicHash]      
+  hash := MAKE_-HASHTABLE 'ID
+  tdAdd(con,hash)
+  tdPrint hash 
+
+tdAdd(con,hash) ==
+  v := HGET($conTopicHash,con)
+  u := addTopic2Documentation(con,v)
+--u := GETDATABASE(con,'DOCUMENTATION) 
+  for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ^= 'construct repeat
+    for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x)))
+
+tdPrint hash ==
+  for key in mySort HKEYS hash repeat 
+    sayBrightly [key,'":"]
+    sayBrightlyNT '"   "
+    for x in HGET(hash,key) repeat sayBrightlyNT ['" ",x]
+    TERPRI()
+
+topics con ==
+  --assumes that DOCUMENTATION property already has #s added
+  $topicClasses := ASSOCRIGHT mySort
+      [[HGET($topicHash,key),:key] for key in HKEYS $topicHash]      
+  hash := MAKE_-HASHTABLE 'ID
+  tdAdd(con,hash)
+  for x in REMDUP [CAAR y for y in ancestorsOf(getConstructorForm con,nil)] repeat
+    tdAdd(x,hash)
+  for x in HKEYS hash repeat HPUT(hash,x,mySort HGET(hash,x))
+  tdPrint hash 
+
+code2Classes cc ==
+  cc := 2*cc
+  [x while cc ^= 0 for x in $topicClasses | ODDP (cc := QUOTIENT(cc,2))]
+  
+myLastAtom x == 
+  while x is [.,:x] repeat nil
+  x
+
+--=======================================================================
+--           Transfer Codes to opAlist 
+--=======================================================================
+
+transferClassCodes(conform,opAlist) ==
+  transferCodeCon(opOf conform,opAlist)
+  for x in ancestorsOf(conform,nil) repeat
+    transferCodeCon(CAAR x,opAlist)
+
+transferCodeCon(con,opAlist) ==
+  for pair in GETDATABASE(con,'DOCUMENTATION) 
+    | FIXP (code := myLastAtom pair) repeat
+      u := ASSOC(QCAR pair,opAlist) => RPLACD(LASTNODE u,code)
+
+--=======================================================================
+--           Filter Operation by Topic
+--=======================================================================
+
+filterByTopic(opAlist,topic) ==
+  bitNumber := HGET($topicHash,topic)
+  [x for x in opAlist 
+    | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)]
+
+listOfTopics(conname) ==
+  doc := GETDATABASE(conname,'DOCUMENTATION)
+  u := ASSOC('constructor,doc) or return nil
+  code := myLastAtom u
+--null FIXP code => nil
+  mySort [key for key in HKEYS($topicHash) | LOGBITP(HGET($topicHash,key),code)]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/trace.boot.pamphlet b/src/interp/trace.boot.pamphlet
new file mode 100644
index 00000000..f6890cde
--- /dev/null
+++ b/src/interp/trace.boot.pamphlet
@@ -0,0 +1,853 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/trace.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--% Code for tracing functions
+
+-- This code supports the )trace system command and allows the
+-- tracing of LISP, BOOT and SPAD functions and interpreter maps.
+
+SETANDFILEQ($traceNoisely,NIL)  -- give trace and untrace messages
+
+SETANDFILEQ($reportSpadTrace,NIL)  -- reports traced funs
+
+SETANDFILEQ($optionAlist,NIL)
+
+SETANDFILEQ($tracedMapSignatures, NIL)
+
+SETANDFILEQ($traceOptionList,'(
+    after _
+    before _
+    break_
+    cond_
+    count_
+    depth_
+    local_
+    mathprint _
+    nonquietly_
+    nt_
+    of_
+    only_
+    ops_
+    restore_
+    timer_
+    varbreak _
+    vars_
+    within _
+    ))
+
+trace l == traceSpad2Cmd l
+
+traceSpad2Cmd l ==
+  if l is ['Tuple, l1] then l := l1
+  $mapSubNameAlist:= getMapSubNames(l)
+  trace1 augmentTraceNames(l,$mapSubNameAlist)
+  traceReply()
+
+trace1 l ==
+  $traceNoisely: local := NIL
+  if hasOption($options,'nonquietly) then $traceNoisely := true
+  hasOption($options,'off) =>
+    (ops := hasOption($options,'ops)) or
+      (lops := hasOption($options,'local)) =>
+        null l => throwKeyedMsg("S2IT0019",NIL)
+        constructor := unabbrev
+          atom l => l
+          null rest l =>
+            atom first l => first l
+            first first l
+          NIL
+        not(isFunctor constructor) => throwKeyedMsg("S2IT0020",NIL)
+        if ops then
+          ops := getTraceOption ops
+          NIL
+        if lops then
+          lops := rest getTraceOption lops
+          untraceDomainLocalOps(constructor,lops)
+    (1 < # $options) and not hasOption($options,'nonquietly) =>
+      throwKeyedMsg("S2IT0021",NIL)
+    untrace l
+  hasOption($options,'stats) =>
+    (1 < # $options) =>
+      throwKeyedMsg("S2IT0001",['")trace ... )stats"])
+    [.,:opt] := CAR $options
+    -- look for )trace )stats       to list the statistics
+    --          )trace )stats reset to reset them
+    null opt =>      -- list the statistics
+      centerAndHighlight('"Traced function execution times",78,"-")
+      ptimers ()
+      SAY '" "
+      centerAndHighlight('"Traced function execution counts",78,"-")
+      pcounters ()
+    selectOptionLC(first opt,'(reset),'optionError)
+    resetSpacers()
+    resetTimers()
+    resetCounters()
+    throwKeyedMsg("S2IT0002",NIL)
+  a:= hasOption($options,'restore) =>
+    null(oldL:= $lastUntraced) => nil
+    newOptions:= delete(a,$options)
+    null l => trace1 oldL
+    for x in l repeat
+      x is [domain,:opList] and VECP domain =>
+        sayKeyedMsg("S2IT0003",[devaluate domain])
+      $options:= [:newOptions,:LASSOC(x,$optionAlist)]
+      trace1 LIST x
+  null l => nil
+  l is ["?"] => _?t()
+  traceList:= [transTraceItem x for x in l] or return nil
+  for x in traceList repeat $optionAlist:=
+    ADDASSOC(x,$options,$optionAlist)
+  optionList:= getTraceOptions $options
+  argument:=
+    domainList:= LASSOC("of",optionList) =>
+      LASSOC("ops",optionList) =>
+        throwKeyedMsg("S2IT0004",NIL)
+      opList:=
+        traceList => LIST ["ops",:traceList]
+        nil
+      varList:=
+        y:= LASSOC("vars",optionList) => LIST ["vars",:y]
+        nil
+      [:domainList,:opList,:varList]
+    optionList => [:traceList,:optionList]
+    traceList
+  _/TRACE_,0 [funName for funName in argument]
+  saveMapSig [funName for funName in argument]
+
+getTraceOptions options ==
+  $traceErrorStack: local
+  optionList:= [getTraceOption x for x in options]
+  $traceErrorStack =>
+    null rest $traceErrorStack =>
+      [key,parms] := first $traceErrorStack
+      throwKeyedMsg(key,['"",:parms])
+    throwListOfKeyedMsgs("S2IT0017",[# $traceErrorStack],
+      NREVERSE $traceErrorStack)
+  optionList
+
+saveMapSig(funNames) ==
+  for name in funNames repeat
+    map:= rassoc(name,$mapSubNameAlist) =>
+      $tracedMapSignatures:= ADDASSOC(name,getMapSig(map,name),
+        $tracedMapSignatures)
+
+getMapSig(mapName,subName) ==
+  lmms:= get(mapName,'localModemap,$InteractiveFrame) =>
+    for mm in lmms until sig repeat
+      CADR mm = subName => sig:= CDAR mm
+    sig
+
+getTraceOption (x is [key,:l]) ==
+  key:= selectOptionLC(key,$traceOptionList,'traceOptionError)
+  x := [key,:l]
+  MEMQ(key,'(nonquietly timer nt)) => x
+  key='break =>
+    null l => ['break,'before]
+    opts := [selectOptionLC(y,'(before after),NIL) for y in l]
+    and/[IDENTP y for y in opts] => ['break,:opts]
+    stackTraceOptionError ["S2IT0008",NIL]
+  key='restore =>
+    null l => x
+    stackTraceOptionError ["S2IT0009",[STRCONC('")",object2String key)]]
+  key='only => ['only,:transOnlyOption l]
+  key='within =>
+    l is [a] and IDENTP a => x
+    stackTraceOptionError ["S2IT0010",['")within"]]
+  MEMQ(key,'(cond before after)) =>
+    key:=
+      key="cond" => "when"
+      key
+    l is [a] => [key,:l]
+    stackTraceOptionError ["S2IT0011",[STRCONC('")",object2String key)]]
+  key='depth =>
+    l is [n] and FIXP n => x
+    stackTraceOptionError ["S2IT0012",['")depth"]]
+  key='count =>
+    (null l) or (l is [n] and FIXP n) => x
+    stackTraceOptionError ["S2IT0012",['")count"]]
+  key="of" =>
+    ["of",:[hn y for y in l]] where
+      hn x ==
+        atom x and not UPPER_-CASE_-P (STRINGIMAGE x).(0) =>
+          isDomainOrPackage EVAL x => x
+          stackTraceOptionError ["S2IT0013",[x]]
+        g:= domainToGenvar x => g
+        stackTraceOptionError ["S2IT0013",[x]]
+  MEMQ(key,'(local ops vars)) =>
+    null l or l is ["all"] => [key,:"all"]
+    isListOfIdentifiersOrStrings l => x
+    stackTraceOptionError ["S2IT0015",[STRCONC('")",object2String key)]]
+  key='varbreak =>
+    null l or l is ["all"] => ["varbreak",:"all"]
+    isListOfIdentifiers l => x
+    stackTraceOptionError ["S2IT0016",[STRCONC('")",object2String key)]]
+  key='mathprint =>
+    null l => x
+    stackTraceOptionError ["S2IT0009",[STRCONC('")",object2String key)]]
+  key => throwKeyedMsg("S2IT0005",[key])
+
+traceOptionError(opt,keys) ==
+  null keys => stackTraceOptionError ["S2IT0007",[opt]]
+  commandAmbiguityError("trace option",opt,keys)
+
+resetTimers () ==
+  for timer in _/TIMERLIST repeat
+    SET(INTERN STRCONC(timer,'"_,TIMER"),0)
+
+resetSpacers () ==
+  for spacer in _/SPACELIST repeat
+    SET(INTERN STRCONC(spacer,'"_,SPACE"),0)
+
+resetCounters () ==
+  for k in _/COUNTLIST repeat
+    SET(INTERN STRCONC(k,'"_,COUNT"),0)
+
+ptimers() ==
+  null _/TIMERLIST => sayBrightly '"   no functions are timed"
+  for timer in _/TIMERLIST repeat
+    sayBrightly ["  ",:bright timer,'_:,'" ",
+      EVAL(INTERN STRCONC(timer,'"_,TIMER")) / float $timerTicksPerSecond,'" sec."]
+
+pspacers() ==
+  null _/SPACELIST => sayBrightly '"   no functions have space monitored"
+  for spacer in _/SPACELIST repeat
+    sayBrightly ["  ",:bright spacer,'_:,'" ",
+      EVAL INTERN STRCONC(spacer,'"_,SPACE"),'" bytes"]
+
+pcounters() ==
+  null _/COUNTLIST => sayBrightly '"   no functions are being counted"
+  for k in _/COUNTLIST repeat
+    sayBrightly ["  ",:bright k,'_:,'" ",
+      EVAL INTERN STRCONC(k,'"_,COUNT"),'" times"]
+
+transOnlyOption l ==
+  l is [n,:y] =>
+    FIXP n => [n,:transOnlyOption y]
+    MEMQ(n:= UPCASE n,'(V A C)) => [n,:transOnlyOption y]
+    stackTraceOptionError ["S2IT0006",[n]]
+    transOnlyOption y
+  nil
+
+stackTraceOptionError x ==
+  $traceErrorStack:= [x,:$traceErrorStack]
+  nil
+
+removeOption(op,options) ==
+  [optEntry for (optEntry:=[opt,:.]) in options | opt ^= op]
+
+domainToGenvar x ==
+  $doNotAddEmptyModeIfTrue: local:= true
+  (y:= unabbrevAndLoad x) and GETDATABASE(opOf y,'CONSTRUCTORKIND) = 'domain =>
+    g:= genDomainTraceName y
+    SET(g,evalDomain y)
+    g
+
+genDomainTraceName y ==
+  u:= LASSOC(y,$domainTraceNameAssoc) => u
+  g:= GENVAR()
+  $domainTraceNameAssoc:= [[y,:g],:$domainTraceNameAssoc]
+  g
+
+--this is now called from trace with the )off option
+untrace l ==
+  $lastUntraced:=
+    null l => COPY _/TRACENAMES
+    l
+  untraceList:= [transTraceItem x for x in l]
+  _/UNTRACE_,0 [lassocSub(funName,$mapSubNameAlist) for
+      funName in untraceList]
+  removeTracedMapSigs untraceList
+
+transTraceItem x ==
+  $doNotAddEmptyModeIfTrue: local:=true
+  atom x =>
+    (value:=get(x,"value",$InteractiveFrame)) and
+      (objMode value in '((Mode) (Domain) (SubDomain (Domain)))) =>
+        x := objVal value
+        (y:= domainToGenvar x) => y
+        x
+    UPPER_-CASE_-P (STRINGIMAGE x).(0) =>
+      y := unabbrev x
+      constructor?(y) => y
+      PAIRP(y) and constructor?(CAR y) => CAR y
+      (y:= domainToGenvar x) => y
+      x
+    x
+  VECP first x => transTraceItem devaluate first x
+  y:= domainToGenvar x => y
+  throwKeyedMsg("S2IT0018",[x])
+
+removeTracedMapSigs untraceList ==
+  for name in untraceList repeat
+    REMPROP(name,$tracedMapSignatures)
+
+coerceTraceArgs2E(traceName,subName,args) ==
+  MEMQ(name:= subName,$mathTraceList) =>
+    SPADSYSNAMEP PNAME name => coerceSpadArgs2E(reverse CDR reverse args)
+    [["=",name,objValUnwrap coerceInteractive(objNewWrap(arg,type),$OutputForm)]
+      for name in '(arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 )
+       for arg in args for type in CDR LASSOC(subName,
+        $tracedMapSignatures)]
+  SPADSYSNAMEP PNAME name => reverse CDR reverse args
+  args
+
+coerceSpadArgs2E(args) ==
+  -- following binding is to prevent forcing calculation of stream elements
+  $streamCount:local := 0
+  [["=",name,objValUnwrap coerceInteractive(objNewWrap(arg,type),$OutputForm)]
+      for name in '(arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 )
+        for arg in args for type in CDR $tracedSpadModemap]
+
+subTypes(mm,sublist) ==
+  ATOM mm =>
+    (s:= LASSOC(mm,sublist)) => s
+    mm
+  [subTypes(m,sublist) for m in mm]
+
+coerceTraceFunValue2E(traceName,subName,value) ==
+  MEMQ(name:= subName,$mathTraceList) =>
+    SPADSYSNAMEP PNAME traceName => coerceSpadFunValue2E(value)
+    (u:=LASSOC(subName,$tracedMapSignatures)) =>
+      objValUnwrap coerceInteractive(objNewWrap(value,CAR u),$OutputForm)
+    value
+  value
+
+coerceSpadFunValue2E(value) ==
+  -- following binding is to prevent forcing calculation of stream elements
+  $streamCount:local := 0
+  objValUnwrap coerceInteractive(objNewWrap(value,CAR $tracedSpadModemap),
+    $OutputForm)
+
+isListOfIdentifiers l == and/[IDENTP x for x in l]
+
+isListOfIdentifiersOrStrings l == and/[IDENTP x or STRINGP x for x in l]
+
+getMapSubNames(l) ==
+  subs:= nil
+  for mapName in l repeat
+    lmm:= get(mapName,'localModemap,$InteractiveFrame) =>
+      subs:= APPEND([[mapName,:CADR mm] for mm in lmm],subs)
+  union(subs,getPreviousMapSubNames UNIONQ(_/TRACENAMES,
+    $lastUntraced))
+
+getPreviousMapSubNames(traceNames) ==
+  subs:= nil
+  for mapName in ASSOCLEFT CAAR $InteractiveFrame repeat
+    lmm:= get(mapName,'localModemap,$InteractiveFrame) =>
+      MEMQ(CADAR lmm,traceNames) =>
+        for mm in lmm repeat
+          subs:= [[mapName,:CADR mm],:subs]
+  subs
+
+lassocSub(x,subs)  ==
+  y:= LASSQ(x,subs) => y
+  x
+
+rassocSub(x,subs) ==
+  y:= rassoc(x,subs) => y
+  x
+
+isUncompiledMap(x) ==
+  y:= get(x,'value,$InteractiveFrame) =>
+    (CAAR y) = 'MAP and null get(x,'localModemap,$InteractiveFrame)
+
+isInterpOnlyMap(map) ==
+  x:= get(map,'localModemap,$InteractiveFrame) =>
+    (CAAAR x) = 'interpOnly
+
+augmentTraceNames(l,mapSubNames) ==
+  res:= nil
+  for traceName in l repeat
+    mml:= get(traceName,'localModemap,$InteractiveFrame) =>
+      res:= APPEND([CADR mm for mm in mml],res)
+    res:= [traceName,:res]
+  res
+
+isSubForRedundantMapName(subName) ==
+  mapName:= rassocSub(subName,$mapSubNameAlist) =>
+    tail:=member([mapName,:subName],$mapSubNameAlist) =>
+      MEMQ(mapName,CDR ASSOCLEFT tail)
+
+untraceMapSubNames traceNames ==
+  null($mapSubNameAlist:local:= getPreviousMapSubNames traceNames) => nil
+  for name in (subs:= ASSOCRIGHT $mapSubNameAlist)
+    | MEMQ(name,_/TRACENAMES) repeat
+      _/UNTRACE_,2(name,nil)
+      $lastUntraced:= SETDIFFERENCE($lastUntraced,subs)
+
+funfind("functor","opname") ==
+  ops:= isFunctor functor
+  [u for u in ops | u is [[ =opname,:.],:.]]
+
+isDomainOrPackage dom ==
+  REFVECP dom and #dom>0 and isFunctor opOf dom.(0)
+
+isTraceGensym x == GENSYMP x
+
+spadTrace(domain,options) ==
+  $fromSpadTrace:= true
+  $tracedModemap:local:= nil
+  PAIRP domain and REFVECP CAR domain and (CAR domain).0 = 0 =>
+      aldorTrace(domain,options)
+  not isDomainOrPackage domain => userError '"bad argument to trace"
+  listOfOperations:=
+    [g x for x in getOption("OPS",options)] where
+      g x ==
+        STRINGP x => INTERN x
+        x
+  if listOfVariables := getOption("VARS",options) then
+    options := removeOption("VARS",options)
+  if listOfBreakVars := getOption("VARBREAK",options) then
+    options := removeOption("VARBREAK",options)
+  anyifTrue:= null listOfOperations
+  domainId:= opOf domain.(0)
+  currentEntry:= ASSOC(domain,_/TRACENAMES)
+  currentAlist:= KDR currentEntry
+  opStructureList:= flattenOperationAlist getOperationAlistFromLisplib domainId
+  sigSlotNumberAlist:=
+    [triple
+      --new form is (<op> <signature> <slotNumber> <condition> <kind>)
+      for [op,sig,n,.,kind] in opStructureList | kind = 'ELT
+        and (anyifTrue or MEMQ(op,listOfOperations)) and
+         FIXP n and
+          isTraceable(triple:= [op,sig,n],domain)] where
+            isTraceable(x is [.,.,n,:.],domain) ==
+              atom domain.n => nil
+              functionSlot:= first domain.n
+              GENSYMP functionSlot =>
+                (reportSpadTrace("Already Traced",x); nil)
+              null (BPINAME functionSlot) =>
+                (reportSpadTrace("No function for",x); nil)
+              true
+  if listOfVariables then
+    for [.,.,n] in sigSlotNumberAlist repeat
+      fn := first domain.n
+      $letAssoc := AS_-INSERT(BPINAME fn,
+        listOfVariables,$letAssoc)
+  if listOfBreakVars then
+    for [.,.,n] in sigSlotNumberAlist repeat
+      fn := first domain.n
+      $letAssoc := AS_-INSERT(BPINAME fn,
+        [["BREAK",:listOfBreakVars]],$letAssoc)
+  for (pair:= [op,mm,n]) in sigSlotNumberAlist repeat
+    alias:= spadTraceAlias(domainId,op,n)
+    $tracedModemap:= subTypes(mm,constructSubst(domain.0))
+    traceName:= BPITRACE(first domain.n,alias, options)
+    NCONC(pair,[listOfVariables,first domain.n,traceName,alias])
+    RPLAC(first domain.n,traceName)
+  sigSlotNumberAlist:= [x for x in sigSlotNumberAlist | CDDDR x]
+  if $reportSpadTrace then
+    if $traceNoisely then printDashedLine()
+    for x in orderBySlotNumber sigSlotNumberAlist repeat
+      reportSpadTrace("TRACING",x)
+  if $letAssoc then SETLETPRINTFLAG true
+  currentEntry =>
+    RPLAC(rest currentEntry,[:sigSlotNumberAlist,:currentAlist])
+  SETQ(_/TRACENAMES,[[domain,:sigSlotNumberAlist],:_/TRACENAMES])
+  spadReply()
+
+traceDomainLocalOps(dom,lops,options) ==
+ sayMSG ['"  ",'"The )local option has been withdrawn"]
+ sayMSG ['"  ",'"Use )ltr to trace local functions."]
+ NIL
+--  abb := abbreviate dom
+--  loadLibIfNotLoaded abb
+--  actualLops := getLocalOpsFromLisplib abb
+--  null actualLops =>
+--    sayMSG ['"  ",:bright abb,'"has no local functions to trace."]
+--  lops = 'all => _/TRACE_,1(actualLops,options)
+--  l := NIL
+--  for lop in lops repeat
+--    internalName := INTERN STRCONC(PNAME abb,'";",PNAME lop)
+--    not MEMQ(internalName,actualLops) =>
+--      sayMSG ['"  ",:bright abb,'"does not have a local",
+--        '" function called",:bright lop]
+--    l := cons(internalName,l)
+--  l => _/TRACE_,1(l,options)
+--  nil
+
+untraceDomainLocalOps(dom,lops) ==
+ sayMSG ['"  ",:bright abb,'"has no local functions to untrace."]
+ NIL
+--  lops = "all" => untraceAllDomainLocalOps(dom)
+--  abb := abbreviate dom
+--  loadLibIfNotLoaded abb
+--  actualLops := getLocalOpsFromLisplib abb
+--  null actualLops =>
+--    sayMSG ['"  ",:bright abb,'"has no local functions to untrace."]
+--  l := NIL
+--  for lop in lops repeat
+--    internalName := INTERN STRCONC(PNAME abb,'";",PNAME lop)
+--    not MEMQ(internalName,actualLops) =>
+--      sayMSG ['"  ",:bright abb,'"does not have a local",
+--        '" function called",:bright lop]
+--    l := cons(internalName,l)
+--  l => untrace l
+--  nil
+
+untraceAllDomainLocalOps(dom) == NIL
+--  abb := abbreviate dom
+--  actualLops := getLocalOpsFromLisplib abb
+--  null (l := intersection(actualLops,_/TRACENAMES)) => NIL
+--  _/UNTRACE_,1(l,NIL)
+--  NIL
+
+traceDomainConstructor(domainConstructor,options) ==
+  -- Trace all domains built with the given domain constructor,
+  -- including all presently instantiated domains, and all future
+  -- instantiations, while domain constructor is traced.
+  loadFunctor domainConstructor
+  listOfLocalOps := getOption("LOCAL",options)
+  if listOfLocalOps then
+    traceDomainLocalOps(domainConstructor,listOfLocalOps,
+      [opt for opt in options | opt isnt ['LOCAL,:.]])
+  listOfLocalOps and not getOption("OPS",options) => NIL
+  for [argl,.,:domain] in HGET($ConstructorCache,domainConstructor)
+    repeat spadTrace(domain,options)
+  SETQ(_/TRACENAMES,[domainConstructor,:_/TRACENAMES])
+  innerDomainConstructor := INTERN STRCONC(domainConstructor,'";")
+  if FBOUNDP innerDomainConstructor then domainConstructor := innerDomainConstructor
+  EMBED(domainConstructor,
+    ['LAMBDA, ['_&REST, 'args],
+      ['PROG, ['domain],
+        ['SETQ,'domain,['APPLY,domainConstructor,'args]],
+        ['spadTrace,'domain,MKQ options],
+        ['RETURN,'domain]]] )
+
+untraceDomainConstructor domainConstructor ==
+  --untrace all the domains in domainConstructor, and unembed it
+  SETQ(_/TRACENAMES, 
+    [df for df in _/TRACENAMES | keepTraced?(df, domainConstructor)]) where 
+      keepTraced?(df, domainConstructor) ==
+        (df is [dc,:.]) and (isDomainOrPackage dc) and 
+           ((KAR devaluate dc) = domainConstructor) =>
+               _/UNTRACE_,0 [dc]
+               false
+        true
+  untraceAllDomainLocalOps domainConstructor
+  innerDomainConstructor := INTERN STRCONC(domainConstructor,'";")
+  if FBOUNDP innerDomainConstructor then UNEMBED innerDomainConstructor
+    else UNEMBED domainConstructor
+  SETQ(_/TRACENAMES,delete(domainConstructor,_/TRACENAMES))
+
+flattenOperationAlist(opAlist) ==
+   res:= nil
+   for [op,:mmList] in opAlist repeat
+     res:=[:res,:[[op,:mm] for mm in mmList]]
+   res
+
+mapLetPrint(x,val,currentFunction) ==
+  x:= getAliasIfTracedMapParameter(x,currentFunction)
+  currentFunction:= getBpiNameIfTracedMap currentFunction
+  letPrint(x,val,currentFunction)
+
+-- This is the version for use when we have no idea
+-- what print representation to use for the data object
+
+letPrint(x,val,currentFunction) ==
+  if $letAssoc and
+    ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then
+      if (y="all" or MEMQ(x,y)) and
+        not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then
+         sayBrightlyNT [:bright x,": "]
+         PRIN0 shortenForPrinting val
+         TERPRI()
+      if (y:= hasPair("BREAK",y)) and
+        (y="all" or MEMQ(x,y) and
+          (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+            break [:bright currentFunction,'"breaks after",:bright x,'":= ",
+              shortenForPrinting val]
+  val
+
+-- This is the version for use when we have already
+-- converted the data into type "Expression"
+letPrint2(x,printform,currentFunction) ==
+  $BreakMode:local
+  if $letAssoc and
+    ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then
+      if (y="all" or MEMQ(x,y)) and
+        not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then
+         $BreakMode:='letPrint2
+         flag:=nil
+         CATCH('letPrint2,mathprint ["=",x,printform],flag)
+         if flag='letPrint2 then print printform
+      if (y:= hasPair("BREAK",y)) and
+        (y="all" or MEMQ(x,y) and
+          (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+            break [:bright currentFunction,'"breaks after",:bright x,":= ",
+              printform]
+  x
+
+-- This is the version for use when we have our hands on a function
+-- to convert the data into type "Expression"
+
+letPrint3(x,xval,printfn,currentFunction) ==
+  $BreakMode:local
+  if $letAssoc and
+    ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then
+      if (y="all" or MEMQ(x,y)) and
+        not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then
+         $BreakMode:='letPrint2
+         flag:=nil
+         CATCH('letPrint2,mathprint ["=",x,SPADCALL(xval,printfn)],flag)
+         if flag='letPrint2 then print xval
+      if (y:= hasPair("BREAK",y)) and
+        (y="all" or MEMQ(x,y) and
+          (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+            break [:bright currentFunction,'"breaks after",:bright x,'":= ",
+              xval]
+  x
+
+getAliasIfTracedMapParameter(x,currentFunction) ==
+  isSharpVarWithNum x =>
+    aliasList:= get(currentFunction,'alias,$InteractiveFrame) =>
+      aliasList.(STRING2PINT_-N(SUBSTRING(PNAME x,1,NIL),1)-1)
+  x
+
+getBpiNameIfTracedMap(name) ==
+  lmm:= get(name,'localModemap,$InteractiveFrame) =>
+    MEMQ(bpiName:= CADAR lmm,_/TRACENAMES) => bpiName
+  name
+
+hasPair(key,l) ==
+  atom l => nil
+  l is [[ =key,:a],:.] => a
+  hasPair(key,rest l)
+
+shortenForPrinting val ==
+  isDomainOrPackage val => devaluate val
+  val
+
+spadTraceAlias(domainId,op,n) ==
+  INTERNL(domainId,".",op,",",STRINGIMAGE n)
+
+getOption(opt,l) ==
+  y:= ASSOC(opt,l) => rest y
+
+reportSpadTrace(header,[op,sig,n,:t]) ==
+  null $traceNoisely => nil
+  msg:= [header,'%b,op,":",'%d,rest sig," -> ",first sig," in slot ",n]
+  namePart:= nil --(t is (.,.,name,:.) => (" named ",name); NIL)
+  tracePart:=
+    t is [y,:.] and not null y =>
+      (y="all" => ['%b,"all",'%d,"vars"]; [" vars: ",y])
+    NIL
+  sayBrightly [:msg,:namePart,:tracePart]
+
+orderBySlotNumber l ==
+  ASSOCRIGHT orderList [[n,:x] for (x:= [.,.,n,:.]) in l]
+
+_/TRACEREPLY() ==
+  null _/TRACENAMES => MAKESTRING '"   Nothing is traced."
+  for x in _/TRACENAMES repeat
+    x is [d,:.] and isDomainOrPackage d =>
+      domainList:= [devaluate d,:domainList]
+    functionList:= [x,:functionList]
+  [:functionList,:domainList,"traced"]
+
+spadReply() ==
+  [printName x for x in _/TRACENAMES] where
+    printName x ==
+      x is [d,:.] and isDomainOrPackage d => devaluate d
+      x
+
+spadUntrace(domain,options) ==
+  not isDomainOrPackage domain => userError '"bad argument to untrace"
+  anyifTrue:= null options
+  listOfOperations:= getOption("ops:",options)
+  domainId := devaluate domain
+  null (pair:= ASSOC(domain,_/TRACENAMES)) =>
+    sayMSG ['"   No functions in",
+      :bright prefix2String domainId,'"are now traced."]
+  sigSlotNumberAlist:= rest pair
+  for (pair:= [op,sig,n,lv,bpiPointer,traceName,alias]) in sigSlotNumberAlist |
+    anyifTrue or MEMQ(op,listOfOperations) repeat
+      BPIUNTRACE(traceName,alias)
+      RPLAC(first domain.n,bpiPointer)
+      RPLAC(CDDDR pair,nil)
+      if assocPair:=ASSOC(BPINAME bpiPointer,$letAssoc) then
+        $letAssoc := REMOVER($letAssoc,assocPair)
+        if null $letAssoc then SETLETPRINTFLAG nil
+  newSigSlotNumberAlist:= [x for x in sigSlotNumberAlist | CDDDR x]
+  newSigSlotNumberAlist => RPLAC(rest pair,newSigSlotNumberAlist)
+  SETQ(_/TRACENAMES,DELASC(domain,_/TRACENAMES))
+  spadReply()
+
+prTraceNames() ==
+  (for x in _/TRACENAMES repeat PRINT fn x; nil) where
+    fn x ==
+      x is [d,:t] and isDomainOrPackage d => [devaluate d,:t]
+      x
+
+traceReply() ==
+  $domains: local:= nil
+  $packages: local:= nil
+  $constructors: local:= nil
+  null _/TRACENAMES =>
+    sayMessage '"   Nothing is traced now."
+  sayBrightly '" "
+  for x in _/TRACENAMES repeat
+    x is [d,:.] and (isDomainOrPackage d) => addTraceItem d
+    atom x =>
+      isFunctor x => addTraceItem x
+      (IS__GENVAR x =>
+        addTraceItem EVAL x; functionList:= [x,:functionList])
+    userError '"bad argument to trace"
+  functionList:= "append"/[[rassocSub(x,$mapSubNameAlist),'" "]
+    for x in functionList | ^isSubForRedundantMapName x]
+  if functionList then
+    2 = #functionList =>
+      sayMSG ["   Function traced: ",:functionList]
+    (22 + sayBrightlyLength functionList) <= $LINELENGTH =>
+      sayMSG ["   Functions traced: ",:functionList]
+    sayBrightly "   Functions traced:"
+    sayBrightly flowSegmentedMsg(functionList,$LINELENGTH,6)
+  if $domains then
+    displayList:= concat(prefix2String first $domains,
+          [:concat('",",'" ",prefix2String x) for x in rest $domains])
+    if atom displayList then displayList:= [displayList]
+    sayBrightly '"   Domains traced: "
+    sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6)
+  if $packages then
+    displayList:= concat(prefix2String first $packages,
+          [:concat(", ",prefix2String x) for x in rest $packages])
+    if atom displayList then displayList:= [displayList]
+    sayBrightly '"   Packages traced: "
+    sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6)
+  if $constructors then
+    displayList:= concat(abbreviate first $constructors,
+          [:concat(", ",abbreviate x) for x in rest $constructors])
+    if atom displayList then displayList:= [displayList]
+    sayBrightly '"   Parameterized constructors traced:"
+    sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6)
+
+addTraceItem d ==
+  constructor? d => $constructors:=[d,:$constructors]
+  isDomain d => $domains:= [devaluate d,:$domains]
+  isDomainOrPackage d => $packages:= [devaluate d,:$packages]
+
+_?t() ==
+  null _/TRACENAMES => sayMSG bright '"nothing is traced"
+  for x in _/TRACENAMES | atom x and not IS__GENVAR x repeat
+    if llm:= get(x,'localModemap,$InteractiveFrame) then
+      x:= (LIST (CADAR llm))
+    sayMSG ['"Function",:bright rassocSub(x,$mapSubNameAlist),'"traced"]
+  for x in _/TRACENAMES | x is [d,:l] and isDomainOrPackage d repeat
+    suffix:=
+      isDomain d => '"domain"
+      '"package"
+    sayBrightly ['"   Functions traced in ",suffix,'%b,devaluate d,'%d,":"]
+    for x in orderBySlotNumber l repeat reportSpadTrace("   ",take(4,x))
+    TERPRI()
+
+tracelet(fn,vars) ==
+  if GENSYMP fn and stupidIsSpadFunction EVAL fn then
+    fn := EVAL fn
+    if COMPILED_-FUNCTION_-P fn then fn:=BPINAME fn
+  fn = 'Undef => nil
+  vars:=
+    vars="all" => "all"
+    l:= LASSOC(fn,$letAssoc) => union(vars,l)
+    vars
+  $letAssoc:= [[fn,:vars],:$letAssoc]
+  if $letAssoc then SETLETPRINTFLAG true
+  $TRACELETFLAG : local := true
+  $QuickLet : local := false
+  ^MEMQ(fn,$traceletFunctions) and ^IS__GENVAR fn and COMPILED_-FUNCTION_-P SYMBOL_-FUNCTION fn
+    and not stupidIsSpadFunction fn and not GENSYMP fn =>
+      ($traceletFunctions:= [fn,:$traceletFunctions]; compileBoot fn ;
+       $traceletFunctions:= delete(fn,$traceletFunctions) )
+
+breaklet(fn,vars) ==
+                       --vars is "all" or a list of variables
+  --$letAssoc ==> (.. (=fn .. (BREAK . all))) OR (.. (=fn .. (BREAK . vl)))
+  if GENSYMP fn and stupidIsSpadFunction EVAL fn then
+    fn := EVAL fn
+    if COMPILED_-FUNCTION_-P fn then fn:= BPINAME fn
+  fn = "Undef" => nil
+  fnEntry:= LASSOC(fn,$letAssoc)
+  vars:=
+    pair:= ASSOC("BREAK",fnEntry) => union(vars,rest pair)
+    vars
+  $letAssoc:=
+    null fnEntry => [[fn,:LIST ["BREAK",:vars]],:$letAssoc]
+    pair => (RPLACD(pair,vars); $letAssoc)
+  if $letAssoc then SETLETPRINTFLAG true
+  $QuickLet:local := false
+  ^MEMQ(fn,$traceletFunctions) and not stupidIsSpadFunction fn
+    and not GENSYMP fn =>
+      $traceletFunctions:= [fn,:$traceletFunctions]
+      compileBoot fn
+      $traceletFunctions:= delete(fn,$traceletFunctions)
+
+stupidIsSpadFunction fn ==
+  -- returns true if the function pname has a semi-colon in it
+  -- eventually, this will use isSpadFunction from luke boot
+  STRPOS('"_;",PNAME fn,0,NIL)
+
+break msg ==
+  condition:= MONITOR_,EVALTRAN(_/BREAKCONDITION,nil)
+  -- The next line is to try to deal with some reported cases of unwanted
+  -- backtraces appearing, MCD.
+  ENABLE_-BACKTRACE(nil)
+  EVAL condition =>
+    sayBrightly msg
+    INTERRUPT()
+
+compileBoot fn == _/D_,1(LIST fn,'(_/COMP),nil,nil)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/union.lisp.pamphlet b/src/interp/union.lisp.pamphlet
new file mode 100644
index 00000000..ea734b48
--- /dev/null
+++ b/src/interp/union.lisp.pamphlet
@@ -0,0 +1,185 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/union.lisp} Pamphlet}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(IMPORT-MODULE "vmlisp")
+(in-package "VMLISP")
+;;macros from file vmlisp are necessary to compile this file
+
+(DEFUN |intersection|  (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ V (SETQ H (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP  (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (RETURN (QCDR H)) )
+        ( (|member|
+            (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+            (QCDR H)) )
+        ( (|member| I LIST-OF-ITEMS-2)
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP) ) )
+
+(DEFUN INTERSECTIONQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ V (SETQ H (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP  (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (RETURN (QCDR H)) )
+        ( (QMEMQ
+            (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+            (QCDR H)) )
+        ( (QMEMQ I LIST-OF-ITEMS-2)
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP) ) )
+
+(DEFUN |union| (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ H (SETQ V (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP1 (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (COND
+            ( (PAIRP LIST-OF-ITEMS-2)
+              (SETQ LIST-OF-ITEMS-1 (RESETQ LIST-OF-ITEMS-2 NIL)) )
+            ( 'T
+              (RETURN (QCDR H)) ) ) )
+        ( (NOT
+            (|member|
+              (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+              (QCDR H)))
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP1) ) )
+
+(DEFUN UNIONQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ H (SETQ V (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP1 (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (COND
+            ( (PAIRP LIST-OF-ITEMS-2)
+              (SETQ LIST-OF-ITEMS-1 (RESETQ LIST-OF-ITEMS-2 NIL)) )
+            ( 'T
+              (RETURN (QCDR H)) ) ) )
+        ( (NOT
+            (QMEMQ
+              (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+              (QCDR H)))
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP1) ) )
+
+(DEFUN SETDIFFERENCE (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ H (SETQ V (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP1 (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (RETURN (QCDR H)) )
+        ( (|member|
+            (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+            (QCDR H)) )
+        ( (NOT (|member| I LIST-OF-ITEMS-2))
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP1) ) )
+
+(DEFUN SETDIFFERENCEQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
+    (PROG (I H V)
+      (SETQ H (SETQ V (CONS NIL NIL)))
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-1))
+          (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
+      (COND
+        ( (NOT (LISTP LIST-OF-ITEMS-2))
+          (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
+  LP1 (COND
+        ( (NOT (PAIRP LIST-OF-ITEMS-1))
+          (RETURN (QCDR H)) )
+        ( (QMEMQ
+            (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
+            (QCDR H)) )
+        ( (NOT (QMEMQ I LIST-OF-ITEMS-2))
+          (QRPLACD V (SETQ V (CONS I NIL))) ) )
+      (GO LP1) ) )
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/unlisp.lisp.pamphlet b/src/interp/unlisp.lisp.pamphlet
new file mode 100644
index 00000000..80b854eb
--- /dev/null
+++ b/src/interp/unlisp.lisp.pamphlet
@@ -0,0 +1,1149 @@
+%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/unlisp.lisp} Pamphlet}
+\author{Stephen M. Watt, Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\begin{verbatim}
+Uncommon 1.6
+This package is a Boot interface for Common Lisp.
+SMW 1989, 1990
+
+Operating system interface
+
+The only non-common lisp functions used in this file are in this section.
+The following functions are provided:
+
+  OsRunProgram program &rest args  
+     Run the named program with given arguments.
+     All I/O is to the current places.
+     Value returned is implementation-dependent.
+
+  OsRunProgramToStream program &rest args
+     Run the named program  with given arguments.
+     Input and error output to the current places.
+     Value returned is a stream of the program's standard output.
+
+  OsEnvVarCharacter
+     The character which indicates OS environment variables in a string.
+     On Unix this is "$".
+
+  OsEnvGet name
+     name is a string or a symbol
+     The string associated with the given name is returned.
+     This is from the environment on Unix. On CMS globalvars could be used.
+
+  OsProcessNumber
+     Returns a unique number associated with the current session.
+     On Unix this is the process id.  
+     The same workspace started a second time must give a different result.
+
+\end{verbatim}
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+(in-package "BOOT")  
+
+(defun |OsRunProgram| (program &rest args)
+  #+(and :Lucid (not :ibm/370))   (lucid-os-run-program   program args)
+  #+:CmuLisp (cmulisp-os-run-program program args)
+  #+:KCL     (kcl-os-run-program     program args)
+  #-(or (and :Lucid (not :ibm/370)) :CmuLisp :KCL) nil )
+
+(defun |OsRunProgramToStream| (program &rest args)
+  #+(and :Lcid (not ibm/370))
+     (lucid-os-run-program-to-stream     program args)
+  #+:CmuLisp (cmulisp-os-run-program-to-stream   program args)
+  #+:KCL     (kcl-os-run-program-to-stream       program args)
+  #-(or (and :Lucid (not :ibm/370)) :CmuLisp :KCL)
+     (make-string-output-stream "") )
+
+;Unix:
+(defvar |OsEnvVarCharacter| #\$)
+
+(defun |OsEnvGet| (sym)
+  #+(and :Lucid (not :ibm/370))  (lucid-os-env-get   sym)
+  #+:CmuLisp (cmulisp-os-env-get sym)
+  #+:KCL     (kcl-os-env-get     sym)
+  #-(or (and :Lucid (not :ibm/370)) :CmuLisp :KCL) "" )
+
+(defun |OsProcessNumber| ()
+  #+(and :Lucid (not :ibm/370))    (lucid-os-process-number)
+  #+:CmuLisp  (cmulisp-os-process-number)
+  #+:KCL      (kcl-os-process-number)
+  #-(or (and :Lucid (not :ibm/370)) :CmuLisp :KCL) 42 )
+
+;;;
+;;; Lucid-only implementations
+;;;
+
+#+(and :Lucid (not :ibm/370)) (progn
+(defun lucid-os-run-program (program args)
+  (system:run-aix-program program :arguments args))
+
+(defun lucid-os-run-program-to-stream (program args)
+  (system:run-aix-program program
+        :wait nil
+        :output :stream
+        :arguments args))
+
+(defun lucid-os-env-get (sym)
+   (c-to-lisp-string (getenv (string sym))) )
+
+(defun lucid-os-process-number ()
+  (getpid))
+
+(system:define-foreign-function :c 'getenv  :pointer)
+(system:define-foreign-function :c 'sprintf :pointer)
+(system:define-foreign-function :c 'strlen  :fixnum)
+(system:define-foreign-function :c 'getpid  :fixnum)
+
+(defun c-to-lisp-string (ptr)
+  (let (str len)
+       (setq len (strlen ptr))
+       (setq str (make-array (list len) :element-type 'character))
+       (sprintf str "%s" ptr)  ; Cannot use strcpy because it stops in a \0.
+       str ))
+)
+
+;;;
+;;; Cmulisp-only implementations
+;;;
+
+#+:CmuLisp (progn
+(defun cmulisp-os-run-program (program args)
+  (extensions:run-program program args 
+        :input  't     ; use current standard input  -- default is /dev/null
+        :output 't     ; use current standard output
+        :error  't ))  ; use current standard error
+
+(defun cmulisp-os-run-program-to-stream (program args)
+  (second (multiple-value-list
+    (extensions:run-program program args 
+        :wait   nil        ; don't wait
+        :input  't         ; use current standard input
+        :output :stream    ; slurp the output of the process
+        :error  't )) ))   ; use current standard error
+
+(defun cmulisp-os-env-get (sym) 
+  (let ((key (intern (string sym) (find-package "KEYWORD"))))
+    (cdr (assoc key *environment-list* :test #'eq)) ))
+
+(defun cmulisp-os-process-number () 
+  (Aix::Unix-getpid) )
+)
+
+;;;
+;;; KCL-only implementations
+;;;
+
+#+:KCL (progn
+(defun kcl-os-run-program (program args)
+  (system (format nil "~{~a ~}" (cons program args))) )
+
+(defun kcl-os-run-program-to-stream (program args)
+  (system (format nil "~{~a ~}" (cons program args))) )
+
+(defun kcl-os-env-get (sym) 
+  (system:getenv (string sym)) )
+
+(defun kcl-os-process-number () 
+  77 )
+
+;(defentry |getpid| () (int "getpid"))
+)
+
+;;;;
+;;;; Time
+;;;;
+
+(defun |TimeStampString| ()
+  (multiple-value-bind (sec min hr mody mo yr wkdy daylight zone)
+     (get-decoded-time)
+     (declare (ignore wkdy daylight zone))
+     (format nil "~2,'0d/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" 
+       yr mo mody hr min sec) ))
+        
+;;;;
+;;;; File system interface
+;;;;
+
+;;(defun |FileExists?| (path)
+;;  (probe-file path) )
+;;
+;;(defun |FileRemove| (path)
+;;  (delete-file path) )
+;;
+;;(defun |FileRename| (oldpath newpath)
+;;  (rename-file oldpath newpath) )
+;;
+;;(defun |FileAbsolutePath| (path)
+;;  (truename path) )
+;;
+;;(defun |FileDate| (path)
+;;  (file-write-date path) )
+;;
+;;(defun |TextFileOpenIn| (path)
+;;  (open path 
+;;        :element-type 'character
+;;        :direction :input ))
+;;
+;;(defun |TextFileOpenOut| (path)
+;;  (open path 
+;;        :element-type 'character
+;;        :direction :output 
+;;        :if-exists :supersede 
+;;        :if-does-not-exist :create ))
+;;
+;;(defun |TextFileOpenIO| (path)
+;;  (open path
+;;        :element-type 'character
+;;        :direction :io
+;;        :if-exists :overwrite        ; open at beginning
+;;        :if-does-not-exist :create ))
+;;
+;;(defun |TextFileOpenAppend| (path)
+;;  (open path 
+;;        :element-type 'character
+;;        :direction :output 
+;;        :if-exists :append 
+;;        :if-does-not-exist :create ))
+;;
+;;
+;;(defun |ByteFileOpenIn| (path)
+;;  (open path 
+;;        :element-type 'unsigned-byte
+;;        :direction :input ))
+;;
+;;(defun |ByteFileOpenOut| (path)
+;;  (open path 
+;;        :element-type 'unsigned-byte
+;;        :direction :output 
+;;        :if-exists :supersede 
+;;        :if-does-not-exist :create ))
+;;
+;;(defun |ByteFileOpenIO| (path)
+;;  (open path
+;;        :element-type 'unsigned-byte
+;;        :direction :io
+;;        :if-exists :overwrite        ; open at beginning
+;;        :if-does-not-exist :create ))
+;;
+;;(defun |ByteFileOpenAppend| (path)
+;;  (open path 
+;;        :element-type 'unsigned-byte
+;;        :direction :output 
+;;        :if-exists :append 
+;;        :if-does-not-exist :create ))
+;;
+;;(defun |ReadFileLineAt| (path pos)
+;;  (with-open-file (stream path :direction :input)
+;;        	  (file-position stream pos)
+;;        	  (read-line stream) ))
+;;
+;;(defun |UserHomeDirectory| ()
+;;  (pathname-directory (user-homedir-pathname)) )
+;;
+;;(defun |DirectoryFiles| (path)
+;;  (directory path) )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Lisp Interface
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun |LispReadFromString| (str &optional (startpos 0))
+  (prog (ob nextpos)
+        (multiple-value-setq
+         (ob nextpos)
+         (read-from-string str nil nil :start startpos) )
+        (return (list ob nextpos)) ))
+
+(defun |LispEval| (expr)
+  (eval expr) )
+
+;;; expr must be a defun, defmacro, etc.
+(defun |LispCompile| (expr)
+   (eval expr)
+   (compile (second expr)) )
+   
+(defun |LispCompileFileQuietlyToObject| (source object)
+   (compile-file source :output-file object :messages nil :warnings nil)) 
+
+(defun |LispLoadFileQuietly| (object)
+   (load object :verbose nil :print nil))
+
+(defun |LispCompileFile| (fname)
+  (compile-file fname) )
+
+(defun |LispLoadFile| (fname)
+  (load fname) )
+
+(defun |LispKeyword| (str)
+  (intern str 'keyword) )
+
+;;;
+;;; Control
+;;;
+
+           
+(defmacro |funcall| (&rest args)
+  (cons 'funcall args) )
+
+(defmacro |Catch| (tag expr) 
+  `(catch ,tag ,expr) )
+
+(defmacro |Throw| (tag expr) 
+  `(Throw ,tag ,expr) )
+
+(defmacro |UnwindProtect| (a b)
+  `(unwind-protect ,a ,b) )
+
+;;; This macro catches as much as it can.  
+;;; Systems with a catchall should use it.  
+;;; It is legitimate to not catch anything, if there is no system support.
+;;; 
+;;; If the result was caught, then tagvar is set to the desination tag
+;;; and the thown value is returned.  Otherwise, tagvar is set to nil
+;;; and the first result of the expression is returned.
+
+#+:Lucid 
+(defmacro |CatchAsCan| (tagvar expr)
+  `(let ((catch-result nil) 
+         (expr-result nil) 
+         (normal-exit (gensym)))
+
+        (setq catch-result 
+          (catch 'lucid::top-level 
+            (setq expr-result ,expr)
+            normal-exit))
+        (cond 
+          ((eq catch-result normal-exit)
+            (setq ,tagvar nil)
+            expr-result )
+          ('t
+            (setq ,tagvar 'lucid::top-level)
+            catch-result )) ))
+
+#-:Lucid 
+(defmacro |CatchAsCan| (tagvar expr)
+  `(progn 
+      (setq tagvar nil) 
+      ,expr ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; General
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro |Eq| (a b)
+  `(eq ,a ,b) )
+
+(defvar |Nil| nil)
+
+(defun |DeepCopy| (x)
+  (copy-tree x) )
+
+(defun |SortInPlace| (l pred)
+  (sort l pred) )
+
+(defun |Sort| (l pred)
+  (sort (copy-tree l) pred) )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Streams
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun |Prompt| (line &optional (readfn nil))
+  (format *query-io* "~a" line)
+  (when readfn (apply readfn (list *query-io*))) )
+
+(defun |PlainError| (&rest args)
+  (let ((fmt (plain-print-format-string args)))
+       (error fmt args) ))
+
+(defun |PrettyPrint| (expr &optional (outstream *standard-output*))
+  (write expr :stream outstream :level nil :length nil :pretty 't :escape 't) 
+  (finish-output outstream) )
+
+(defun |PlainPrint| (&rest args)
+  (let ((fmt (plain-print-format-string args)))
+       (format *standard-output* fmt args) ))
+
+(defun |PlainPrintOn| (stream &rest args)
+  (let ((fmt (plain-print-format-string args)))
+       (format stream fmt args) ))
+
+(defun plain-print-format-string (l)
+  (format nil "~~~d{~~a~~}~~%" (length l)) )
+
+
+;;; Lucid 1.01 bug:  Must flush output after each write or else
+;;;                  strange errors arise from invalid buffer reuse.
+
+(defun |WriteLispExpr| (expr &optional (outstream *standard-output*))
+  (let ((*package* (find-package "USER")))
+    (declare (special *package*))
+    (write expr :stream outstream 
+        :level nil :length nil :pretty nil :escape 't ) 
+    (finish-output outstream) ))
+
+(defmacro |WriteByte| (byte &rest outstream)
+  `(write-byte ,byte ,@outstream) )
+
+(defmacro |WriteChar| (char &rest outstream)
+  `(write-char ,char ,@outstream) )
+
+;; Write a string -- no new line.
+(defun |WriteString| (string &optional (outstream *standard-output*))
+  (format outstream "~a" string) 
+  (finish-output outstream) )
+
+;; Write a string then start a new line.
+(defun |WriteLine| (string &optional (outstream *standard-output*))
+  (write-line string outstream) 
+  (finish-output outstream) )    
+
+(defun |ByteFileWriteLine| (string outstream)
+  (let ((n (length string)))
+    (do ((i 0 (+ i 1)))
+        ((= i n))
+        (write-byte (char-code (char string i)) outstream) ))
+  (write-byte (char-code #\Newline) outstream)
+  (finish-output outstream) )
+
+
+
+(defun |ReadLispExpr| (&optional (instream *standard-input*))
+  (let ((*package* (find-package "USER")))
+    (declare (special *package*))
+    (read instream nil nil) ))
+
+(defmacro |ReadByte| (instream)
+  `(read-byte ,instream nil nil) )
+
+(defmacro |ReadChar| (&rest instream)
+  (if instream
+    `(read-char ,@instream nil nil) 
+    '(read-char *standard-input* nil nil) ))
+
+(defun |ReadLine| (&optional (instream *standard-input*))
+  (read-line instream nil nil) )
+
+(defun |ByteFileReadLine| (instream)
+  (do ((buf (make-array '(80) 
+                :element-type 'character 
+                :fill-pointer 0
+                :adjustable 't ))
+       (b (read-byte instream nil nil) (read-byte instream nil nil))
+       (c) )
+
+      ((or (null b) (char= (setq c (code-char b)) #\Newline)) buf)
+     
+      (vector-push-extend c buf) ))
+
+;;; Reads no more than the rest of the current line into the string argument.
+;;; The #\Newline is not included in the string.
+;;;
+;;; The result is an integer, 'T or nil.
+;;;   Nil  the stream was already exhausted.
+;;;   T    the string was filled before the end of line was reached.
+;;;   k    the end of line was reached and k characters were copied.
+;;;
+;;; If the argument "flags" is passed a cons cell, it is updated
+;;; to contain (Eof . Eol).  
+;;; Eof indicates whether the end of file was detected.
+;;; Eol indicates whether the line was terminated by a #\newline.
+
+(defun |ReadLineIntoString| (string &optional (instream *standard-input*) 
+                                              (flags nil) )
+
+  (when (consp flags) (rplaca flags nil) (rplacd flags nil))
+
+  (let ((n (length string))
+        (i 0)
+        (c (read-char instream nil nil)) )
+    
+       (loop
+         (cond 
+           ((null c)
+              (when (consp flags) (rplaca flags 't))
+              (return (if (= i 0) nil i)) )
+           ((char= c #\Newline)
+              (when (consp flags) (rplacd flags 't))
+              (return i) )
+           ((= i n)
+              (unread-char c instream)
+              (return 't) ))
+
+         (setf (char string i) c)
+         (setq i (+ i 1))
+         (setq c (read-char instream nil nil)) )))
+   
+
+;;; Similar to ReadLineIntoString but reads from a ByteFile.
+(defun |ByteFileReadLineIntoString| (string instream &optional (flags nil))
+
+  (when (consp flags) (rplaca flags nil) (rplacd flags nil))
+
+  (let ((n (length string))
+        (i 0)
+        (b nil)
+        (c nil) )
+    
+       (loop
+         (when (= i n) (return 't) )
+         (setq b (read-byte instream nil nil)) 
+         (when (null b)
+           (when (consp flags) (rplaca flags 't))
+           (return i) )
+
+         (setq c (code-char b))
+         (when (char= c #\Newline)
+           (when (consp flags) (rplacd flags 't))
+           (return i) )
+
+         (setf (char string i) c)
+         (setq i (+ i 1)) )))
+
+(defun |ReadBytesIntoVector| 
+           (vector &optional (instream *standard-input*) (flags nil) )
+
+  (when (consp flags) (rplaca flags nil) (rplacd flags nil))
+
+  (let ((n (length vector))
+        (i 0)
+        (b nil) )
+    
+       (loop
+         (when (= i n) (return 't))
+         (setq b (read-byte instream nil nil))
+         (when (null b)
+           (when (consp flags) (rplaca flags 't))
+           (return i) )
+
+         (setf (aref vector i) b)
+         (setq i (+ i 1)) )))
+
+
+(defun |InputStream?| (stream)
+   (input-stream-p stream) )
+
+(defun |OutputStream?| (stream)
+   (output-stream-p stream) )
+
+;;; Whether the position is a record number or character number is 
+;;; implementation specific.  In Common Lisp it is a character number.
+
+(defun |StreamGetPosition| (stream)
+  (file-position stream) )
+
+(defun |StreamSetPosition| (stream pos)
+  (file-position stream pos))
+
+(defun |StreamSize| (stream)
+  (file-length stream))
+
+(defmacro |WithOpenStream| (var stream-form body)
+  `(with-open-stream (,var ,stream-form) ,body) )
+
+;;; Copy up to n characters or eof.
+;;; Return number of characters actually copied
+(defun |StreamCopyChars| (instream outstream n)
+  (do ((i 0 (+ i 1))
+       (c (read-char instream nil nil) (read-char instream nil nil)) )
+      ((or (null c) (= i n))  (finish-output outstream) i)
+
+      (write-char c outstream) ))
+
+(defun |StreamCopyBytes| (instream outstream n)
+  (do ((i 0 (+ i 1))
+       (b (read-byte instream nil nil) (read-byte instream nil nil)) )
+      ((or (null b) (= i n))  (finish-output outstream) i)
+
+      (write-byte b outstream) ))
+
+(defun |StreamEnd?| (instream)
+  (null (peek-char nil instream nil nil)) )
+
+(defun |StreamFlush| (&optional (outstream *standard-output*))
+  (finish-output outstream) )
+
+(defun |StreamClose| (stream)
+  (close stream) )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;;  Types
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Functions for manipulating values of type Xxxx are prefixed with Xxxx.
+;;; E.g., CsetUnion
+;;; Values of type Xxxx are suffixed with Xxxx.
+;;; E.g., AlphaCset
+;;; The primary function for creating object of this type is named Xxxx.
+;;; The type-testing predicate is Xxxx?
+
+;;; xx    := Xxxx(args)
+;;; val   := XxxxGet(xx, key)  or  XxxxGet(xx, key, default)
+;;; val   := XxxxSet(xx, key, val)
+;;; val   := XxxxUnset(xx, key)
+;;;
+;;; xx    := XxxxRemove(val, xx)    XxxxRemoveQ
+;;; truth := XxxxMember?(val, xx)   XxxxMemberQ?
+;;; xx    := XxxxUnion(xx1, xx2)
+;;;
+;;; The suffix "Q" means the test involved is "EQ".  "N" between the
+;;; the type name and the function name proper means the function is
+;;; non-copying (destructive).
+
+;;;
+;;; Pathnames
+;;;
+
+(defvar |TempFileDirectory| (pathname-directory "/tmp/"))
+(defvar |LispFileType| "lisp")
+(defvar |FaslFileType| "bbin")
+
+(defun |Pathname| (name &optional (type nil) (dir 'none))
+  (if (equal dir 'none)
+      (make-pathname :name name :type type :defaults name) 
+      (make-pathname :directory dir :name name :type type) ))
+
+(defun |ToPathname| (string)
+  (pathname string) )
+
+;;; System-wide unique name on each call.
+(defvar *new-pathname-counter* 1)
+
+(defun |NewPathname| (&optional (prefix "t")(type nil)(dir '(:relative)))
+   (let ((name 
+          (format nil "~a~a-~a" 
+            prefix (|OsProcessNumber|) *new-pathname-counter* )))
+     (setq *new-pathname-counter* (+ *new-pathname-counter* 1))
+     (make-pathname :directory dir :name name :type type) ))
+         
+;;; System-wide unique name for the current session.
+(defun |SessionPathname| (&optional (prefix "t")(type nil)(dir '(:relative)))
+   (let ((name (format nil "~a~a" prefix (|OsProcessNumber|))))
+     (make-pathname :directory dir :name name :type type) ))
+  
+(defun |PathnameDirectory| (path)
+  (pathname-directory path) )
+
+(defun |PathnameName| (path)
+  (pathname-name path) )
+
+(defun |PathnameType| (path) 
+  (pathname-type path) )
+
+
+(defun |PathnameWithType| (path type)
+  (make-pathname :type type :defaults path) )
+
+(defun |PathnameWithoutType| (path)
+  (make-pathname :type nil :defaults path) )
+
+
+(defun |PathnameWithDirectory| (path dir)
+  (make-pathname :directory dir :defaults path) )
+
+(defun |PathnameWithoutDirectory| (path)
+  (make-pathname :directory nil :defaults path) )
+
+
+(defun |PathnameString| (path)
+  (namestring path) )
+
+(defun |PathnameToUsualCase| (path)
+  (pathname (|StringLowerCase| (namestring path))) )
+
+
+;; Lucid 1.01 specific  -- uses representation of directories.
+(defun |PathnameAbsolute?| (path)
+  (let ((dir (pathname-directory path)))
+       (not (and (consp dir) (or
+           (eq (car dir) :current) 
+           (eq (car dir) :relative) ))) ))
+
+;; Lucid 1.01 specific  -- uses representation of directories.
+(defun |PathnameWithinDirectory| (dir relpath)
+  (if (|PathnameAbsolute?| relpath)
+    (|PlainError| "The path " relpath " cannot be used within directory " dir)
+    (make-pathname 
+       :directory (append dir (cdr (pathname-directory relpath)))
+       :defaults  relpath )))
+
+;; Unix specific -- uses unix file syntax.
+(defun |PathnameDirectoryOfDirectoryPathname| (dirpath)
+  (pathname-directory 
+    (concatenate 'string  (namestring dirpath) "/junk.bar") ))
+
+;; Unix specific -- uses environment variables.
+(defun |PathnameWithinOsEnvVar| (varname relpath)
+  (let ((envstr (|OsEnvGet| varname)))
+    (parse-namestring (concatenate 'string envstr "/" relpath)) ))
+
+;;;
+;;; Symbols
+;;;
+
+
+;;!! Worry about packages a later day.  
+;;!! For now, the responsibility of setting *package* is on the caller.
+(defun |MakeSymbol| (str)
+  (let ((a (intern str))) a) ) ; Return only 1 value
+
+(defmacro |Symbol?| (ob)
+  `(and ,ob (symbolp ,ob)) )
+
+(defmacro |SymbolString| (sym)
+  `(string ,sym) )
+
+;;;
+;;; Bits
+;;;
+(defmacro  |Bit| (x)
+  (cond 
+   ((eq x 1) 1) 
+   ((eq x 0) 0) 
+   (x 1) 
+   (t 0)))
+
+(defun |Bit?| (x) 
+  (or (eql x 1) (eql x 0)) )
+
+(defvar |TrueBit|  1)
+(defvar |FalseBit| 0)
+
+(defmacro  |BitOn?|   (b) `(eq ,b 1))
+
+(defmacro |BitOr| (x y)
+  `(bit-ior ,x ,y) )
+
+;;;
+;;; General Sequences
+;;;
+;;  ELT and SETELT work on these.
+
+;; Removed because it clashed with size in vmlisp.lisp
+;; (defun SIZE (x)  ;; #x in boot generates (SIZE x)
+;;  (length x))
+
+;;;
+;;; Vectors
+;;;
+(defun |FullVector| (size &optional (init nil))
+  (make-array 
+   (list size)
+   :element-type 't
+   :initial-element init ))
+
+(defun |Vector?| (x)
+   (vectorp x) )
+
+;;;
+;;; Bit Vectors
+;;;
+
+;; Common Lisp simple bit vectors
+
+(defun |FullBvec| (size &optional (init 0))
+  (make-array 
+   (list size)
+   :element-type 'bit
+   :initial-element init ))
+
+;;;
+;;; Characters
+;;;
+
+;;(defun |char| (x) 
+;;  (char (string x) 0) )
+
+(defmacro |Char| (x) 
+  `(char (string ,x) 0) )
+
+(defmacro |Char?| (c) 
+  `(characterp ,c) )
+  ;; (or (characterp a) 
+  ;;     (and (symbolp a) (= (length (symbol-name a)) 1))))
+
+
+(defmacro |CharCode| (c)
+  `(char-code ,c) )
+
+(defmacro |CharGreater?| (c1 c2) 
+  `(char> ,c1 ,c2) )
+
+(defun |CharDigit?| (x)
+  (or 
+   (and (characterp x) (digit-char-p x))
+   (and (stringp x) (= (length x) 1) (digit-char-p (char x 0)))
+   (and (symbolp x) (|CharDigit?| (string x))) ))
+
+(defvar |SpaceChar|   #\Space)
+(defvar |NewlineChar| #\Newline)
+
+;;;
+;;; Character Sets
+;;;
+
+(defun |Cset| (str) 
+  (let 
+   ((cset (make-array
+           (list char-code-limit)
+           :element-type 'bit
+           :initial-element 0 ))
+    (len (length str)) )
+   
+   (do ((i 0 (+ 1 i)))
+       ((= i len))
+       (setf (sbit cset (char-code (char str i))) 1) )
+   cset ))
+
+(defun |CsetMember?| (c cset)
+  (eql 1 (sbit cset (char-code c))) )
+
+(defun |CsetUnion| (cset1 cset2)
+  (bit-ior cset1 cset2) )
+
+(defun |CsetComplement| (cset)
+  (bit-not cset) )
+
+(defun |CsetString| (cset)
+  (let 
+   ((chars '())
+    (len (length cset)))
+   (do ((i 0 (+ 1 i)))
+       ((= i len))
+       (if (eql 1 (sbit cset i)) (push (string (int-char i)) chars)) )
+   (apply #'concatenate (cons 'string (nreverse chars))) ))
+
+(defvar |NumericCset|      (|Cset| "0123456789") )
+(defvar |LowerCaseCset|    (|Cset| "abcdefghijklmnopqrstuvwxyz") )
+(defvar |UpperCaseCset|    (|Cset| "ABCDEFGHIJKLMNOPQRSTUVWXYZ") )
+(defvar |AlphaCset|        (|CsetUnion| |LowerCaseCset| |UpperCaseCset|))
+(defvar |AlphaNumericCset| (|CsetUnion| |AlphaCset| |NumericCset|) )
+(defvar |WhiteSpaceCset|   
+  (|Cset| (coerce 
+    (list #\Space #\Newline #\Tab #\Page #\Linefeed #\Return #\Backspace)
+    'string )) )
+
+;;;
+;;; Character Strings 
+;;;
+
+;;  Common Lisp simple strings
+;;  ELT and SETELT work on these.
+
+
+(defun |FullString| (size &optional (init #\Space))
+  (make-array
+   (list size)
+   :element-type 'character
+   :initial-element init ))
+
+(defun |ToString| (ob)
+  (string ob) )
+
+(defun |StringImage| (ob)
+  (format nil "~a" ob) )
+
+(defun |String?| (ob)
+  (stringp ob) )
+
+(defmacro |StringGetCode| (str ix)
+  `(char-code (char ,str ,ix)) )
+
+(defun |StringConcat| (&rest l)
+  (progn
+   (setq l (mapcar #'string l))
+   (apply #'concatenate 'string l) ))
+
+(defun |StringFromTo| (string from to)
+  (subseq string from (+ to 1)) )
+
+(defun |StringFromToEnd| (string from)
+  (subseq string from) )
+
+(defun |StringFromLong| (string from len)
+  (subseq string from (+ from len)) )
+
+(defun |StringPrefix?| (pref string)
+  (let ((mm (mismatch pref string)))
+       (or (not mm) (eql mm (length pref))) ))
+
+(defun |StringUpperCase| (l)
+  (cond ((stringp l) (string-upcase l))
+        ((symbolp l) (intern (string-upcase (symbol-name l))))
+        ((characterp l) (char-upcase l))
+        ((atom l) l)
+        (t (mapcar #'|StringUpperCase| l)) ))
+
+(defun |StringLowerCase| (l)
+  (cond ((stringp l) (string-downcase l))
+        ((symbolp l) (intern (string-downcase (symbol-name l))))
+        ((characterp l) (char-downcase L))
+        ((atom l) l)
+        (t (mapcar #'|StringLowerCase| l)) ))
+
+(defun |StringGreater?| (s1 s2)
+  (string> s1 s2) )
+
+(defun |StringToInteger| (s)
+  (read-from-string s) )
+
+(defun |StringToFloat| (s)
+  (read-from-string s) )
+
+(defun |StringLength| (s)
+  (length s) )
+
+;;;
+;;; Numbers
+;;;
+
+
+
+(defmacro |Number?|       (x) `(numberp ,x))
+(defmacro |Integer?|      (x) `(integerp ,x))
+(defmacro |Float?|        (x) `(floatp ,x))
+
+(defmacro |Odd?|     (n)   `(oddp ,n))
+(defmacro |Remainder|(a b) `(rem ,a ,b))
+
+(defmacro |DoublePrecision| (x) `(coerce ,x 'double-precision))
+
+(defmacro |Abs|   (x) `(abs  ,x))
+(defmacro |Min|   (x &rest yz) `(min ,x ,@yz))
+(defmacro |Max|   (x &rest yz) `(max ,x ,@yz))
+
+(defmacro |Exp|   (x) `(exp ,x))
+(defmacro |Ln|    (x) `(log ,x))
+(defmacro |Log10| (x) `(log ,x 10))
+(defmacro |Sin|   (x) `(sin ,x))
+(defmacro |Cos|   (x) `(cos ,x))
+(defmacro |Tan|   (x) `(tan ,x))
+(defmacro |Cotan| (x) `(/ 1.0 (tan ,x)))
+(defmacro |Arctan|(x) `(atan ,x))
+
+;;;
+;;; Pairs
+;;;
+
+(defmacro |Pair?| (x) `(consp ,x))
+
+(defmacro |car|    (x) `(car    ,x))
+(defmacro |cdr|    (x) `(cdr    ,x))
+
+(defmacro |caar|   (x) `(caar   ,x))
+(defmacro |cadr|   (x) `(cadr   ,x))
+(defmacro |cdar|   (x) `(cdar   ,x))
+(defmacro |cddr|   (x) `(cddr   ,x))
+
+(defmacro |caaar|  (x) `(caaar  ,x))
+(defmacro |caadr|  (x) `(caadr  ,x))
+(defmacro |cadar|  (x) `(cadar  ,x))
+(defmacro |caddr|  (x) `(caddr  ,x))
+(defmacro |cdaar|  (x) `(cdaar  ,x))
+(defmacro |cdadr|  (x) `(cdadr  ,x))
+(defmacro |cddar|  (x) `(cddar  ,x))
+(defmacro |cdddr|  (x) `(cdddr  ,x))
+
+(defmacro |FastCar|    (x) `(car (the cons ,x)))
+(defmacro |FastCdr|    (x) `(cdr (the cons ,x)))
+
+(defmacro |FastCaar|   (x) `(|FastCar| (|FastCar| ,x)))
+(defmacro |FastCadr|   (x) `(|FastCar| (|FastCdr| ,x)))
+(defmacro |FastCdar|   (x) `(|FastCdr| (|FastCar| ,x)))
+(defmacro |FastCddr|   (x) `(|FastCdr| (|FastCdr| ,x)))
+
+(defmacro |FastCaaar|  (x) `(|FastCar| (|FastCaar| ,x)))
+(defmacro |FastCaadr|  (x) `(|FastCar| (|FastCadr| ,x)))
+(defmacro |FastCadar|  (x) `(|FastCar| (|FastCdar| ,x)))
+(defmacro |FastCaddr|  (x) `(|FastCar| (|FastCddr| ,x)))
+(defmacro |FastCdaar|  (x) `(|FastCdr| (|FastCaar| ,x)))
+(defmacro |FastCdadr|  (x) `(|FastCdr| (|FastCadr| ,x)))
+(defmacro |FastCddar|  (x) `(|FastCdr| (|FastCdar| ,x)))
+(defmacro |FastCdddr|  (x) `(|FastCdr| (|FastCddr| ,x)))
+
+(defmacro |IfCar| (x) `(if (consp ,x) (car ,x)))
+(defmacro |IfCdr| (x) `(if (consp ,x) (cdr ,x)))
+
+(defmacro |EqCar| (l a) `(eq (car ,l) ,a))
+(defmacro |EqCdr| (l d) `(eq (cdr ,l) ,d))
+
+;;;
+;;; Lists
+;;;
+
+
+(defun |ListNReverse| (l)
+  (nreverse l) )
+
+(defun |ListIsLength?| (l n)
+  (if l (= n 0) (|ListIsLength?| (cdr l) (1- n))) )
+
+;;--------------------> NEW DEFINITION (override in vmlisp.lisp.pamphlet)
+(defun |ListMemberQ?| (ob l)
+  (member ob l :test #'eq) )
+
+(defun |ListRemoveQ| (ob l)
+  (remove ob l :test #'eq :count 1) )
+
+(defun |ListNRemoveQ| (ob l)
+  (delete ob l :test #'eq :count 1) )
+
+(defun |ListRemoveDuplicatesQ| (l)
+  (remove-duplicates l :test #'eq) )
+
+(defun |ListUnion| (l1 l2)
+  (union l1 l2 :test #'equal) )
+
+(defun |ListUnionQ| (l1 l2)
+  (union l1 l2 :test #'eq) )
+
+(defun |ListIntersection| (l1 l2)
+  (intersection l1 l2 :test #'equal) )
+
+(defun |ListIntersectionQ| (l1 l2)
+  (intersection l1 l2 :test #'eq) )
+
+(defun |ListAdjoin| (ob l)
+  (adjoin ob l :test #'equal) )
+
+(defun |ListAdjoinQ| (ob l)
+  (adjoin ob l :test #'eq) )
+
+;;;
+;;; Association lists
+;;;
+
+
+(defun |AlistAssoc| (key l)
+  (assoc key l :test #'equal) )
+
+;;--------------------> NEW DEFINITION (override in vmlisp.lisp.pamphlet)
+(defun |AlistAssocQ| (key l)
+  (assoc key l :test #'eq) )
+
+(defun |AlistRemove| (key l)
+  (let ((pr (assoc key l :test #'equal)))
+       (if pr 
+           (remove pr l :test #'equal) 
+           l) ))
+
+(defun |AlistRemoveQ| (key l)
+  (let ((pr (assoc key l :test #'eq)))
+       (if pr 
+           (remove pr l :test #'eq) 
+           l) ))
+
+(defun |AlistAdjoinQ| (pr l)
+  (cons pr (|AlistRemoveQ| (car pr) l)) )
+
+(defun |AlistUnionQ| (l1 l2)
+  (union l1 l2 :test #'eq :key #'car) )
+
+;;;
+;;; Tables
+;;;
+
+;;(defmacro |EqTable| ()
+;;  `(make-hash-table :test #'eq) )
+;;(defmacro |EqualTable| ()
+;;  `(make-hash-table :test #'equal) )
+;;(defmacro |StringTable| ()
+;;  `(make-hash-table :test #'equal) )
+;; following is not used and causes CCL problems
+;;(defmacro |SymbolTable| ()
+;;  `(make-hash-table :test #'eq) )
+
+
+(defmacro |Table?| (ob)
+  `(hash-table-p ,ob) )
+
+(defmacro |TableCount| (tab)
+  `(hash-table-count ,tab) )
+
+(defmacro |TableGet| (tab key &rest default)
+  `(gethash ,key ,tab ,@default) )
+
+(defmacro |TableSet| (tab key val)
+  `(setf (gethash ,key ,tab) ,val) )
+
+(defun |TableUnset| (tab key)
+  (let ((val (gethash key tab)))
+       (remhash key tab)
+       val ))
+
+(defun |TableKeys| (tab)
+  (let ((key-list nil))
+       (maphash 
+        #'(lambda (key val) (declare (ignore val))
+        	  (setq key-list (cons key key-list)) )
+        tab )
+       key-list ))
+
+;; CCL supplies a slightly more efficient version of logs to base 10, which
+;; is useful in the WIDTH function. MCD.
+#+:KCL (defun log10 (u) (log u 10))
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet
new file mode 100644
index 00000000..ec9f4ad1
--- /dev/null
+++ b/src/interp/util.lisp.pamphlet
@@ -0,0 +1,1683 @@
+% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp util.lisp}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+
+\section{util.lisp}
+
+This file is a collection of utility functions that are useful
+for system level work. A couple of the functions, {\bf build-depsys}
+and {\bf build-interpsys} interface to the src/interp/Makefile.
+
+A second group of related functions allows us to rebuild portions
+of the system from the command prompt. This varies from rebuilding
+individual files to whole directories. The most complex functions
+like {\bf makespad} can rebuild the whole algebra tree.
+
+A third group of related functions are used to set up the 
+{\bf autoload} mechanism. These enable whole subsystems to
+be kept out of memory until they are used.
+
+A fourth group of related functions are used to construct and
+search Emacs TAGS files.
+
+A fifth group of related functions are some translated boot
+functions we need to define here so they work and are available
+at load time.
+
+\subsection{Building Depsys (build-depsys)}
+
+The {\bf depsys} image is one of the two images we build from
+the src/interp subdirectory (the other is {\bf interpsys}). We
+use {\bf depsys} as a compile-time image as it contains all of
+the necessary functions and macros to compile any file. The 
+{\bf depsys} image is almost the same as an {\bf interpsys}
+image but it does not have any autoload triggers or databases
+loaded.
+<<build-depsys>>=
+(defun build-depsys (load-files spad)
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (mapcar #'load load-files)
+  (initroot spad)
+  #+:AKCL
+  (init-memory-config :cons 1000 :fixnum 400 :symbol 1000 :package 16
+		      :array 800 :string 1000 :cfun 200 :cpages 2000
+		      :rpages 2000 :hole 4000) )
+;;  (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+;;		      :array 400 :string 500 :cfun 100 :cpages 1000
+;;		      :rpages 1000 :hole 2000) )
+
+@
+
+\subsection{Building Interpsys (build-interpsys)}
+\begin{verbatim}
+;############################################################################
+;# autoload dependencies
+;#
+;# if you are adding a file which is to be autoloaded the following step
+;# information is useful:
+;#  there are 2 cases:
+;#   1) adding files to currently autoloaded parts
+;#	(as of 2/92: browser old parser and old compiler)
+;#   2) adding new files
+;#   case 1:
+;#     a) you have to add the file to the list of files currently there
+;#	  (e.g. see BROBJS above)
+;#     b) add an autolaod rule
+;#	  (e.g. ${AUTO}/parsing.${O}: ${OUT}/parsing.${O})
+;#     c) edit util.lisp to add the 'external' function (those that
+;#	  should trigger the autoload
+;#   case 2:
+;#     build-interpsys (in util.lisp) needs an extra argument for the
+;#     new autoload things and several functions in util.lisp need hacking.
+;############################################################################
+\end{verbatim}
+The {\bf build-interpsys} function takes a list of files to load
+into the image ({\bf load-files}). It also takes several lists of files, 
+one for each subsystem which will be autoloaded. Autoloading is explained
+below. Next it takes a set of shell variables, the most important of 
+which is the {\bf spad} variable. This is normally set to be the same
+as the final build location. This function is called in the 
+src/interp/Makefile. 
+
+This function calls {\bf initroot} to set up pathnames we need. Next
+it sets up the lisp system memory (at present only for AKCL/GCL). Next
+it loads all of the named files, resets a few global state variables,
+loads the databases, sets up autoload triggers and clears out hash tables.
+After this function is called the image is clean and can be saved.
+<<build-interpsys>>=
+(defun build-interpsys (load-files parse-files comp-files browse-files
+	     translate-files nagbr-files asauto-files spad)
+  (initroot spad)
+  #+:AKCL
+  (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+		      :array 400 :string 500 :cfun 100 :cpages 1000
+		      :rpages 1000 :hole 2000)
+  <<compiler-notes>>
+  (mapcar #'|AxiomCore|::|importModule| load-files)
+  (|resetWorkspaceVariables|)
+  (|initHist|)
+  (|initNewWorld|)
+  (compressopen)
+  (interpopen)
+  (create-initializers)
+  (|start| :fin)
+#+:CCL
+  (resethashtables)
+  (setq *load-verbose* nil)
+  (|setBootAutloadProperties| comp-functions comp-files)
+  (|setBootAutloadProperties| parse-functions parse-files)
+  (|setBootAutloadProperties| browse-functions browse-files)
+  (|setBootAutloadProperties| translate-functions translate-files)
+  (|setNAGBootAutloadProperties| nagbr-functions nagbr-files)
+  (|setBootAutloadProperties| asauto-functions asauto-files)
+  (setf (symbol-function 'boot::|addConsDB|) #'identity)
+  (resethashtables) ; the databases into core, then close the streams
+ )
+
+@
+
+\subsubsection{GCL porting changes}
+
+GCL likes to output lines of the form:
+\begin{verbatim}
+;; Note: Tail-recursive call of |matSuperList1| was replaced by iteration.
+\end{verbatim}
+which is pointless and should be removed. Bill Schelter added this while
+he was debugging tail-recursive replacement and it never was removed.
+<<compiler-notes>>=
+  #+:AKCL
+  (setq compiler::*suppress-compiler-notes* t)
+@
+
+
+\subsection{The variables}
+
+Various lisps use different ``extensions'' on the filename to indicate
+that a file has been compiled. We set this variable correctly depending
+on the system we are using.
+<<bin-path>>=
+(defvar *bin-path*
+  #+kcl "o"
+  #+lucid "bbin"
+  #+symbolics "bin"
+  #+cmulisp "fasl"
+  #+:ccl "not done this way at all")
+
+@
+
+\subsubsection{directory-list}
+
+This is the system-wide list of directories to search.
+It is set up in the {\bf reroot} function.
+<<directory-list>>=
+(defvar $directory-list ())
+
+@
+
+
+\subsubsection{relative-directory-list}
+
+The relative directory list specifies a search path for files 
+for the current directory structure. It has been changed from the
+NAG distribution back to the original form. 
+<<relative-directory-list>>=
+(defvar $relative-directory-list
+  '("/../../src/input/"
+    "/share/msgs/"
+    "/../../src/algebra/"
+    "/../../src/interp/"  ; for boot and lisp  files (helps fd)
+    "/doc/spadhelp/" ))
+
+@
+
+
+\subsubsection{library-directory-list}
+
+This is the system-wide search path for library files.
+It is set up in the {\bf reroot} function.
+<<library-directory-list>>=
+(defvar $library-directory-list ())
+
+@
+
+\subsubsection{relative-library-directory-list}
+
+The relative directory list specifies how to find the algebra
+directory from the current {\bf AXIOM} shell variable.
+<<relative-library-directory-list>>=
+(defvar $relative-library-directory-list '("/algebra/"))
+
+@
+
+
+\subsection{The autoload list}
+
+There are several subsystems within {\bf AXIOM} that are not normally
+loaded into a running system. They will be loaded only if you invoke
+one of the functions listed here. Each of these listed functions will
+have their definitions replaced by a special ``autoloader'' function.
+The first time a function named here is called it will trigger a
+load of the associated subsystem, the autoloader functions will get
+overwritten, the function call is retried and now succeeds. Files
+containing functions listed here are assumed to exist in the 
+{\bf autoload} subdirectory. The list of files to load is defined
+in the src/interp/Makefile.
+
+\subsubsection{setBootAutloadProperties}
+
+This function is called by {\bf build-interpsys}. It takes two lists.
+The first is a list of functions that need to be used as 
+``autoload triggers''. The second is a list of files to load if one
+of the trigger functions is called. At system build time each of the
+functions in the first list is set up to load every file in the second
+list. In this way we will automatically load a whole subsystem if we
+touch any function in that subsystem. We call a helper function
+called {\bf setBootAutoLoadProperty} to set up the autoload trigger.
+This helper function is listed below.
+<<setBootAutloadProperties>>=
+(defun |setBootAutloadProperties| (fun-list file-list)
+#+:AKCL
+  (mapc #'(lambda (fun) (|setBootAutoLoadProperty| fun file-list)) fun-list)
+#+:CCL
+  (mapc #'(lambda (fun) (lisp::set-autoload fun file-list)) fun-list)
+)
+
+@
+
+\subsubsection{setBootAutoLoadProperty}
+
+This is a helper function to set up the autoload trigger. It sets
+the function cell of each symbol to {\bf mkBootAutoLoad} which is
+listed below. 
+<<setBootAutoLoadProperty>>=
+(defun |setBootAutoLoadProperty| (func file-list)
+  (setf (symbol-function func) (|mkBootAutoLoad| func file-list)) )
+
+@
+
+\subsubsection{mkBootAutoLoad}
+
+This is how the autoload magic happens. Every function named in the
+autoload lists is actually just another name for this function. When
+the named function is called we call {\bf boot-load} on all of the
+files in the subsystem. This overwrites all of the autoload triggers.
+We then look up the new (real) function definition and call it again
+with the real arguments. Thus the subsystem loads and the original
+call succeeds.
+<<mkBootAutoLoad>>=
+(defun |mkBootAutoLoad| (fn file-list)
+   (function (lambda (&rest args)
+		 (mapc #'boot-load file-list)
+		 (unless (string= (subseq (string fn) 0 4) "LOAD")
+		  (apply (symbol-function fn) args)))))
+
+@
+
+\subsubsection{boot-load}
+
+This function knows where the {\bf autoload} subdirectory lives.
+It is called by {\bf mkBootAutoLoad} above to find the necessary
+files.
+<<boot-load>>=
+(defun boot-load (file)
+  (let ((name (concat $SPADROOT "/autoload/" (pathname-name file))))
+    (if |$printLoadMsgs|
+	(format t "   Loading ~A.~%" name))
+    (load name)))
+
+@
+
+\subsubsection{setNAGBootAutloadProperties}
+
+This is a further refinement of the autoload scheme. Since the
+Numerical Algorithms Group (NAG) fortran library contains many
+functions we subdivide the NAG library subsystem into chapters.
+We use a different helper function {\bf get-NAG-chapter} to decide
+which files to load.
+<<setNAGBootAutloadProperties>>=
+(defun |setNAGBootAutloadProperties| (function-list file-list)
+  (mapcar
+    #'(lambda (f)
+        (|setBootAutloadProperties|
+          (get-NAG-chapter (chapter-name f) function-list)
+          (nag-files f file-list)))
+    file-list))
+
+@
+
+\subsubsection{get-NAG-chapter}
+
+This function is used to find the names of the files to load.
+On solaris 9 under GCL the original implementation will fail because
+the max number of arguments is 63. We rewrite it to get around this
+problem. It originally read:
+\begin{verbatim}
+(defun get-NAG-chapter (chapter function-list)
+ (apply 'append
+  (mapcar
+   #'(lambda (f)
+     (cond 
+      ((equalp chapter (subseq (string f) 0 (length chapter))) (list f ))))
+   function-list)))
+
+\end{verbatim}
+<<get-NAG-chapter>>=
+(defun get-NAG-chapter (chapter function-list)
+ (let ((l (length chapter)) r)
+  (dolist (f function-list)
+   (when (equalp chapter (subseq (string f) 0 l))
+    (push f r)))
+  (nreverse r)))
+
+@
+
+\subsubsection{nag-files}
+
+We analyze the function names to decide which chapter we are in.
+We load files based on the chapter.
+<<nag-files>>=
+(defun nag-files (filename filelist)
+  (apply 'append (mapcar
+     #'(lambda (f)
+         (cond ((equalp (chapter-name filename) (chapter-name f)) (list f))) )
+     filelist)))
+
+@
+
+\subsubsection{chapter-name}
+
+The library names follow a convention that allows us to extract
+the chapter name. 
+<<chapter-name>>=
+(defun chapter-name (f)
+#+:AKCL
+  (apply
+    #'(lambda (s)
+        (cond ((equalp (aref s 0) #\s) "s") (T (reverse (subseq s 0 3)))))
+    (list (string-left-trim "a.o" (reverse f) )) )
+#+:CCL
+  (subseq (string-downcase (string f)) 4 (length (string f)))
+)
+
+@
+
+\subsubsection{parse-functions}
+
+This is the {\bf boot parser} subsystem. It is only needed by 
+developers who translate boot code to Common Lisp.
+<<parse-functions>>=
+(setq parse-functions
+      '(
+;;      loadparser
+	|oldParserAutoloadOnceTrigger|
+	|PARSE-Expression|
+	boot-parse-1
+	BOOT
+	SPAD
+	init-boot/spad-reader))
+
+@
+
+\subsubsection{comp-functions}
+
+This is the {\bf spad compiler} subsystem. It is only needed by
+developers who write or modify algebra code.
+<<comp-functions>>=
+(setq comp-functions
+      '(
+;;      loadcompiler
+	|oldCompilerAutoloadOnceTrigger|
+	|compileSpad2Cmd|
+	|convertSpadToAsFile|
+	|compilerDoit|
+	|compilerDoitWithScreenedLisplib|
+	|mkCategory|
+	|cons5|
+	|sublisV|))
+
+@
+
+\subsubsection{browse-functions}
+
+This is the {\bf browser} subsystem. It will get autoloaded only
+if you use the browse function of the {\bf hypertex} system.
+<<browse-functions>>=
+(setq browse-functions
+      '(
+;;      loadbrowse
+	|browserAutoloadOnceTrigger|
+        |parentsOf|	      ;interop.boot
+	|getParentsFor|	      ;old compiler
+	|folks|		      ;for astran
+	|extendLocalLibdb|    ;)lib needs this
+        |oSearch|
+        |aokSearch|
+        |kSearch|
+        |aSearch|
+        |genSearch|
+        |docSearch|
+        |abSearch|
+        |detailedSearch|
+	|ancestorsOf|
+	|aPage|
+	|dbGetOrigin|
+	|dbGetParams|
+	|dbGetKindString|
+	|dbGetOrigin|
+	|dbComments|
+	|grepConstruct|
+	|buildLibdb|
+	|bcDefiniteIntegrate|
+	|bcDifferentiate|
+	|bcDraw|
+	|bcExpand|
+	|bcIndefiniteIntegrate|
+	|bcLimit|
+	|bcMatrix|
+	|bcProduct|
+	|bcSeries|
+	|bcSolve|
+	|bcSum|
+	|cSearch|
+	|conPage|
+	|dbName|
+	|dbPart|
+        |extendLocalLibdb|
+	|form2HtString|
+	|htGloss|
+	|htGreekSearch|
+	|htHistory|
+	|htSystemCommands|
+	|htSystemVariables|
+	|htTextSearch|
+	|htTutorialSearch|
+	|htUserVariables|
+	|htsv|
+	|oPage|
+	|oPageFrom|
+	|spadSys|
+	|spadType|
+	|syscomPage|
+	|unescapeStringsInForm|))
+
+@
+
+\subsubsection{translate-functions}
+
+This is a little used subsystem to generate {\bf ALDOR} code
+from {\bf Spad} code. Frankly, I'd be amazed if it worked.
+<<translate-functions>>=
+(setq translate-functions '(
+;; .spad to .as translator, in particular
+;;	loadtranslate
+	|spad2AsTranslatorAutoloadOnceTrigger|
+	))
+
+@
+
+\subsubsection{asauto-functions}
+
+This is part of the {\bf ALDOR subsystem}. These will be loaded
+if you compile a {\bf .as} file rather than a {\bf .spad} file.
+{\bf ALDOR} is an external compiler that gets automatically called
+if the file extension is {\bf .as}.
+<<asauto-functions>>=
+(setq asauto-functions '(
+	loadas
+;;	|as|			     ;; now in as.boot
+;;	|astran|		     ;; now in as.boot
+	|spad2AxTranslatorAutoloadOnceTrigger|
+	|sourceFilesToAxcliqueAxFile|
+	|sourceFilesToAxFile|
+	|setExtendedDomains|
+	|makeAxFile|
+        |makeAxcliqueAxFile|
+        |nrlibsToAxFile|
+        |attributesToAxFile| ))
+
+@
+
+\subsubsection{debug-functions}
+
+These are some {\bf debugging} functions that I use. I can't imagine
+why you might autoload them but they don't need to be in a running
+system.
+<<debug-functions>>=
+(setq debug-functions '(
+	loaddebug
+	|showSummary|
+	|showPredicates|
+	|showAttributes|
+	|showFrom|
+	|showImp|))
+
+@
+
+\subsubsection{anna-functions}
+
+The {\bf ANNA} subsystem, invoked thru {\bf hypertex}, is an
+expert system that understands the Numerical Algorithms Group (NAG)
+fortran library. 
+<<anna-functions>>=
+(setq anna-functions '(
+	|annaInt|
+	|annaMInt|
+	|annaOde|
+	|annaOpt|
+	|annaOpt2|
+	|annaPDESolve|
+	|annaOptDefaultSolve1|
+	|annaOptDefaultSolve2|
+	|annaOptDefaultSolve3|
+	|annaOptDefaultSolve4|
+	|annaOptDefaultSolve5|
+	|annaOpt2DefaultSolve|
+	|annaFoo|
+	|annaBar|
+	|annaJoe|
+	|annaSue|
+	|annaAnn|
+	|annaBab|
+	|annaFnar|
+	|annaDan|
+	|annaBlah|
+	|annaTub|
+	|annaRats|
+	|annaMInt|
+	|annaOdeDefaultSolve1|
+	|annaOdeDefaultSolve2|))
+
+@
+
+\subsubsection{nagbr-functions}
+
+The Numerical Algorithms Group (NAG) fortran library has a set
+of cover functions. These functions need to be loaded if you use
+the NAG library.
+<<nagbr-functions>>=
+(setq nagbr-functions '(
+       loadnag
+       |c02aff| |c02agf|
+       |c05adf| |c05nbf| |c05pbf|
+       |c06eaf| |c06ebf| |c06ecf| |c06ekf| |c06fpf| |c06fqf| |c06frf|
+		|c06fuf| |c06gbf| |c06gcf| |c06gqf| |c06gsf|
+       |d01ajf| |d01akf| |d01alf| |d01amf| |d01anf| |d01apf| |d01aqf|
+		|d01asf| |d01bbf| |d01fcf| |d01gaf| |d01gbf|
+       |d02bbf| |d02bhf| |d02cjf| |d02ejf| |d02gaf| |d02gbf| |d02kef|
+		|d02raf|
+       |d03edf| |d03eef| |d03faf|
+       |e01baf| |e01bef| |e01bff| |e01bgf| |e01bhf| |e01daf| |e01saf|
+		|e01sbf| |e01sef|
+       |e02adf| |e02aef| |e02agf| |e02ahf| |e02ajf| |e02akf| |e02baf|
+		|e02bbf| |e02bcf| |e02bdf| |e02bef| |e02daf| |e02dcf|
+		|e02ddf| |e02def| |e02dff| |e02gaf| |e02zaf|
+       |e04dgf| |e04fdf| |e04gcf| |e04jaf| |e04mbf| |e04naf| |e04ucf|
+		|e04ycf|
+       |f01brf| |f01bsf| |f01maf| |f01mcf| |f01qcf| |f01qdf| |f01qef|
+		|f01rcf| |f01rdf| |f01ref|
+       |f02aaf| |f02abf| |f02adf| |f02aef| |f02aff| |f02agf| |f02ajf|
+		|f02akf| |f02awf| |f02axf| |f02bbf| |f02bjf| |f02fjf|
+		|f02wef| |f02xef|
+       |f04adf| |f04arf| |f04asf| |f04atf| |f04axf| |f04faf| |f04jgf|
+		|f04maf| |f04mbf| |f04mcf| |f04qaf|
+       |f07adf| |f07aef| |f07fdf| |f07fef|
+       |s01eaf| |s13aaf| |s13acf| |s13adf| |s14aaf| |s14abf| |s14baf|
+		|s15adf| |s15aef| |s17acf| |s17adf| |s17aef| |s17aff|
+		|s17agf| |s17ahf| |s17ajf| |s17akf| |s17dcf| |s17def|
+		|s17dgf| |s17dhf| |s17dlf| |s18acf| |s18adf| |s18aef|
+		|s18aff| |s18dcf| |s18def| |s19aaf| |s19abf| |s19acf|
+		|s19adf| |s20acf| |s20adf| |s21baf| |s21bbf| |s21bcf|
+		|s21bdf|
+      ))
+
+@
+
+
+\subsection{The command-line build functions}
+
+\subsubsection{translist}
+
+Translate a list of boot files to common lisp.
+<<translist>>=
+(defun translist (fns)
+  (mapcar #'(lambda (f) (format t "translating ~a~%" (concat f ".boot"))
+			(translate f))
+	  fns))
+
+@
+
+\subsubsection{translate}
+
+Translate a single boot file to common lisp
+<<translate>>=
+(defun translate (file) ;; translates a single boot file
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (let (*print-level* *print-length* (fn (pathname-name file))
+	(bootfile  (merge-pathnames file (concat $spadroot "nboot/.boot"))))
+    (declare (special *print-level* *print-length*))
+    (boot bootfile (make-pathname :type "lisp" :defaults bootfile))))
+
+@
+
+\subsubsection{compile-boot-file}
+
+Translate a single boot file to common lisp, compile it 
+and load it.
+<<compile-boot-file>>=
+(defun compile-boot-file (file)
+  "compile and load a boot file"
+  (boot (concat file ".boot") (concat file ".lisp"))
+#+:AKCL
+  (compile-file (concat file ".lisp"))
+#+:AKCL
+  (load (concat file "." *bin-path*))
+#+:CCL
+  (load (concat file ".lisp"))
+)
+
+@
+
+\subsubsection{retranslate-file-if-necessary}
+
+Retranslate a single boot file if it has been changed.
+<<retranslate-file-if-necessary>>=
+(defun retranslate-file-if-necessary (bootfile)
+   (let* ((lfile (make-pathname :type "lisp" :defaults bootfile))
+	  (ldate (our-write-date lfile))
+	  (binfile (make-pathname :type *bin-path*  :defaults bootfile))
+	  (bindate (our-write-date binfile))
+	  (bootdate (our-write-date   bootfile)))
+       (if (and ldate bootdate (> ldate bootdate)) nil
+	   (if (and bindate bootdate (> bindate bootdate)) nil
+	       (progn (format t "translating ~a~%" bootfile)
+		      (boot bootfile lfile) (list bootfile))))))
+
+@
+
+\subsubsection{retranslate-directory}
+
+Translate a directory of boot code to common lisp if the boot code
+is newer.
+<<retranslate-directory>>=
+(defun retranslate-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "boot"))
+	  (files (directory pattern)))
+      (mapcan #'retranslate-file-if-necessary files)))
+
+@
+
+\subsubsection{recompile-NRLIB-if-necessary}
+
+Recompile a single library's lisp file if it is out of date.
+The {\bf recompile-lib-file-if-necessary} is defined in nlib.lisp.
+<<recompile-NRLIB-if-necessary>>=
+(defun recompile-NRLIB-if-necessary (lib)
+  (recompile-lib-file-if-necessary (concat (namestring lib) "/code.lsp"))
+  (lift-NRLIB-name (namestring lib)))
+
+@
+
+\subsubsection{lift-NRLIB-name}
+
+We used to use FOO.NRLIB/code.o files for algebra. However there
+was no need for this additional level of indirection since the rest
+of the information in an NRLIB is now kept in the daase files. Thus
+we lift the FOO.NRLIB/code.o to FOO.o in the final system.
+<<lift-NRLIB-name>>=
+(defun lift-NRLIB-name (f)
+  (obey (concat "cp " f "/code.o " (subseq f 0 (position #\. f)) ".o"))
+  nil)
+
+@
+
+\subsubsection{recompile-lib-directory}
+
+Recompile library lisp code if necessary.
+<<recompile-lib-directory>>=
+(defun recompile-lib-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "NRLIB"))
+	  (files (directory pattern)))
+      (mapcan #'recompile-NRLIB-if-necessary files)))
+
+@
+
+\subsubsection{recompile-all-files}
+
+Force recompilation of all lisp files in a directory.
+<<recompile-all-files>>=
+(defun recompile-all-files (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "lisp"))
+	  (files (directory pattern)))
+     (mapcar #'compile-file files)))
+
+@
+
+\subsubsection{recompile-directory}
+
+This function will compile any lisp code that has changed in a directory.
+<<recompile-directory>>=
+(defun recompile-directory (dir)
+  (let* ((direc (make-directory dir))
+	 (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "lisp"))
+	  (files (directory pattern)))
+      (mapcan #'recompile-file-if-necessary files)))
+
+@
+
+\subsubsection{recompile-file-if-necessary}
+
+This is a helper function that checks the time stamp between
+the given file and its compiled binary. If the file has changed
+since it was last compiled this function will recompile it.
+<<recompile-file-if-necessary>>=
+(defun recompile-file-if-necessary (lfile)
+   (let* ((bfile (make-pathname :type *bin-path* :defaults lfile))
+	  (bdate (our-write-date bfile))
+	  (ldate (our-write-date lfile)))
+       (if (and bdate ldate (> bdate ldate)) nil
+	   (progn
+	     (format t "compiling ~a~%" lfile)
+	     (compile-file lfile)
+	     (list bfile)))))
+
+@
+
+\subsubsection{our-write-date}
+
+Get the write date of a file. In GCL we need to check that it
+exists first. This is a simple helper function.
+<<our-write-date>>=
+(defun our-write-date (file) (and #+kcl (probe-file file)
+				  (file-write-date file)))
+
+@
+
+\subsubsection{fe}
+
+I'm unsure what this does but I believe it is related to an interpreter
+command. Invoking ``)fe'' in the interpreter tries to get at the 
+src/interp/TAGS file.
+<<fe>>=
+(defun fe (function file &optional (compflag nil) &aux (fn (pathname-name file)))
+  (let ((tbootfile (concat "/tmp/" fn ".boot"))
+	(tlispfile (concat "/tmp/" fn ".lisp")))
+    (system::run-aix-program "fc"
+	 :arguments (list (string function)
+			  (namestring
+			   (merge-pathnames file (concat $SPADROOT "nboot/.boot"))))
+	 :if-output-exists :supersede :output tbootfile)
+    (boot tbootfile tlispfile)
+    (if compflag (progn (compile-file tlispfile)
+			(load (make-pathname :type *bin-path* :defaults tlispfile)))
+      (load tlispfile))))
+@
+
+\subsubsection{fc}
+
+I'm unsure what this does but I believe it is related to an interpreter
+command. Invoking ``)fc'' in the interpreter tries to get at the 
+src/interp/TAGS file.
+<<fc>>=
+(defun fc (function file) (fe function file t))
+
+@
+
+\subsubsection{compspadfiles}
+
+The {\bf compspadfiles} function will recompile a list of {\bf spad} files.
+The filelist should be a file containing names of files to compile.
+<<compspadfiles>>=
+(defun compspadfiles (filelist ;; should be a file containing files to compile
+		      &optional (*default-pathname-defaults*
+				 (pathname (concat $SPADROOT "nalgebra/"))))
+   (with-open-file (stream filelist)
+	(do ((fname (read-line stream nil nil) (read-line stream nil nil)))
+	    ((null fname) 'done)
+	  (setq fname (string-right-trim " *" fname))
+	  (when (not (equal (elt fname 0) #\*))
+	      (spad fname (concat (pathname-name fname) ".out"))))))
+
+@
+
+\subsubsection{load-directory}
+
+Load a whole subdirectory of compiled files
+<<load-directory>>=
+(defun load-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type *bin-path*))
+	  (files (directory pattern)))
+      (mapcar #'load files)))
+
+@
+
+\subsubsection{interp-make-directory}
+
+This is used by the ")cd" system command.
+<<interp-make-directory>>=
+(defun interp-make-directory (direc)
+  (setq direc (namestring direc))
+  (if (string= direc "")  $current-directory
+   (if (or (memq :unix *features*)
+	   (memq 'unix *features*))
+    (progn
+      (if (char/= (char $current-directory (1-(length $current-directory))) #\/)
+	  (setq $current-directory (concat $current-directory "/")))
+      (if (char/= (char direc 0) #\/)
+	  (setq direc (concat $current-directory direc)))
+      (if (char/= (char direc (1- (length direc))) #\/)
+	  (setq direc (concat direc "/")))
+      direc)
+    (progn ;; Assume Windows conventions
+      (if (not (or (char= (char $current-directory (1- (length $current-directory))) #\/)
+                   (char= (char $current-directory (1- (length $current-directory))) #\\ )))
+	  (setq $current-directory (concat $current-directory "\\")))
+      (if (not (or (char= (char direc 0) #\/)
+                   (char= (char direc 0) #\\)
+                   (find #\: direc)))
+          (setq direc (concat $current-directory direc)))
+      (if (not (or (char= (char direc (1- (length direc))) #\/)
+                   (char= (char direc (1- (length direc))) #\\ )))
+	  (setq direc (concat direc "\\")))
+      direc))))
+
+@
+
+\subsubsection{make-directory}
+
+Make a directory relative to the {\bf \$spadroot} variable.
+<<make-directory>>=
+(defun make-directory (direc)
+  (setq direc (namestring direc))
+  (if (string= direc "")  $SPADROOT
+   (if (or (memq :unix *features*)
+	   (memq 'unix *features*))
+    (progn
+      (if (char/= (char direc 0) #\/)
+	  (setq direc (concat $SPADROOT "/" direc)))
+      (if (char/= (char direc (1- (length direc))) #\/)
+	  (setq direc (concat direc "/")))
+      direc)
+    (progn ;; Assume Windows conventions
+      (if (not (or (char= (char direc 0) #\/)
+                   (char= (char direc 0) #\\)
+                   (find #\: direc)))
+          (setq direc (concat $SPADROOT "\\" direc)))
+      (if (not (or (char= (char direc (1- (length direc))) #\/)
+                   (char= (char direc (1- (length direc))) #\\ )))
+	  (setq direc (concat direc "\\")))
+      direc))))
+
+@
+
+\subsubsection{recompile-all-libs}
+
+Occasionally it will be necessary to iterate over all of the NRLIB
+directories and compile each of the code.lsp files in every NRLIB.
+This function will do that. A correct call looks like:
+\begin{verbatim}
+(in-package "BOOT")
+(recompile-all-libs "/spad/mnt/${SYS}/algebra")
+\end{verbatim}
+where the [[${SYS}]] variable is same as the one set at build time.
+<<recompile-all-libs>>=
+(defun recompile-all-libs (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "NRLIB"))
+	  (files (directory pattern)))
+     (mapcar
+       #'(lambda (lib) (compile-lib-file (concat (namestring lib) "/code.lsp")))
+       files)))
+
+@
+
+\subsubsection{recompile-all-algebra-files}
+
+We occasionally need to completely rebuild the algebra from the spad
+files. This function will iterate across a directory containing all
+of the spad files and attempt to recompile them. A correct call looks
+like:
+\begin{verbatim}
+(in-package "BOOT")
+(recompile-all-algebra-files "nalg")
+\end{verbatim}
+Note that it will build a pathname from the current {\bf AXIOM}
+shell variable. So if the {\bf AXIOM} shell variable had the value
+\begin{verbatim}
+/spad/mnt/${SYS}
+\end{verbatim}
+(where the [[${SYS}]] variable is the same one set at build time)
+then the wildcard expands to
+\begin{verbatim}
+/spad/mnt/${SYS}/nalg/*.spad
+\end{verbatim}
+and all of the matching files would be recompiled.
+<<recompile-all-algebra-files>>=
+(defun recompile-all-algebra-files (dir) ;; a desperation measure
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "spad"))
+	  (files (directory pattern))
+	  (*default-pathname-defaults* (pathname direc)))
+     (mapcar
+       #'(lambda (fname) (spad fname (concat (pathname-name fname) ".out")))
+       files)))
+
+@
+
+\subsubsection{boottocl}
+
+The {\bf boottocl} function is the workhorse function that translates
+{\bf .boot} files to {\bf Common Lisp}. It basically wraps the actual
+{\bf boot} function call to ensure that we don't truncate lines 
+because of {\bf *print-level*} or {\bf *print-length*}.
+<<boottocl>>=
+(in-package "OLD-BOOT") 
+
+(defun boot (file) ;; translates a single boot file
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (let (*print-level* 
+	*print-length* 
+	(fn (pathname-name file))
+	(*print-pretty* t))
+    (declare (special *print-level* *print-length*))
+    (boot::boot
+      file
+      (merge-pathnames (make-pathname :type "clisp") file))))
+
+@
+
+\subsubsection{yearweek}
+
+We need a way of distinguishing different versions of the system.
+There used to be a way to touch the src/timestamp file whenever
+you checked in a change to the change control subsystem. 
+During make PART=interp (the default for make) we set timestamp
+to the filename of this timestamp file. This function converts it
+to a luser readable string and sets the *yearweek* variable.
+
+The result of this function is a string that is printed as a banner 
+when Axiom starts. The actual printing is done by the function
+[[spadStartUpMsgs]] in [[src/interp/msgdb.boot]]. It uses a 
+format string from the file [[src/doc/msgs/s2-us.msgs]].
+<<yearweek>>=
+(defun yearweek ()
+ "set *yearweek* to the current time string for the version banner"
+  (declare (special timestamp) (special *yearweek*))
+  (if (and (boundp 'timestamp) (probe-file timestamp))
+      (let (sec min hour date month year day dayvec monvec)
+	(setq dayvec '("Monday" "Tuesday" "Wednesday" "Thursday"
+		       "Friday" "Saturday" "Sunday"))
+	(setq monvec '("January" "February" "March" "April" "May" "June"
+		       "July" "August" "September" "October" "November"
+		       "December"))
+	(multiple-value-setq (sec min hour date month year day)
+			     (decode-universal-time
+			      (file-write-date timestamp)))
+	(setq *yearweek*
+	  (copy-seq
+	      (format nil "~a ~a ~d, ~d at ~2,'0d:~2,'0d:~2,'0d "
+		      (elt dayvec day)
+		      (elt monvec (1- month)) date year hour min sec))))
+      (setq *yearweek* "no timestamp")))
+
+@
+
+\subsubsection{makelib}
+
+Make will not compare dates across directories.
+Rather than copy all of the code.lsp files to the MNT directory
+we run this function to compile the files that are out of date
+this function assumes that the shell variables INT and MNT are set.
+
+Also of note: on the rt some files (those in the nooptimize list)
+need to be compiled without optimize due to compiler bugs
+<<makelib>>=
+(defun makelib (mid out stype btype)
+ "iterate over the NRLIBs, compiling ones that are out of date.
+  mid is the directory containing code.lsp
+  out is the directory containing code.o"
+ (let (libs lspdate odate nooptimize (alphabet #\space))
+#+(and :akcl :rt)
+  (setq nooptimize '("FFCAT-.NRLIB" "CHVAR.NRLIB" "PFO.NRLIB" "SUP.NRLIB"
+		     "INTG0.NRLIB" "FSPRMELT.NRLIB" "VECTOR.NRLIB"
+		     "EUCDOM-.NRLIB"))
+  (if (and mid out)
+   (format t "doing directory on ~s...~%" (concatenate 'string mid "/*"))
+   (error "makelib:MID=~a OUT=~a~% these are not set properly~%" mid out))
+#+:akcl (compiler::emit-fn nil)
+#+:akcl (si::chdir mid)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " mid))
+  (setq libs (directory "*.NRLIB"))
+  (unless libs
+   (format t "makelib:directory of ~a returned NIL~%" mid)
+   (bye -1))
+  (princ "checking ")
+  (dolist (lib libs)
+   (unless (char= (schar (pathname-name lib) 0) alphabet)
+    (setq alphabet (schar (pathname-name lib) 0))
+    (princ alphabet)
+    (finish-output))
+   (let (dotlsp doto mntlib intkaf mntkaf intkafdate mntkafdate)
+    (setq dotlsp
+      (concatenate 'string mid "/" (file-namestring lib) "/code." stype))
+    (setq doto
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/code." btype))
+    (setq mntlib
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB"))
+    (setq intkaf
+      (concatenate 'string mid "/" (file-namestring lib) "/index.KAF*"))
+    (setq mntkaf
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/index.KAF*"))
+    (unless (probe-file mntlib)
+     (format t "creating directory ~a~%" mntlib)
+     (vmlisp::obey (concatenate 'string "cp -pr " (namestring lib) " " out))
+     (when (probe-file (concatenate 'string mntlib "/code." stype))
+      (delete-file  (concatenate 'string mntlib "/code." stype))))
+    (setq intkafdate (and (probe-file intkaf) (file-write-date intkaf)))
+    (setq mntkafdate (and (probe-file mntkaf) (file-write-date mntkaf)))
+    (when intkafdate
+     (unless (and mntkafdate (> mntkafdate intkafdate))
+      (format t "~&copying ~s to ~s" intkaf mntkaf)
+      (vmlisp::obey
+       (concatenate 'string "cp " 
+         (namestring intkaf) " " (namestring mntkaf)))))
+    (setq lspdate (and (probe-file dotlsp) (file-write-date dotlsp)))
+    (setq odate (and (probe-file doto) (file-write-date doto)))
+    (when lspdate
+     (unless (and odate (> odate lspdate))
+#+(and :akcl :rt)
+      (if (member (file-namestring lib) nooptimize :test #'string=)
+       (setq compiler::*speed* 0)
+       (setq compiler::*speed* 3))
+      (compile-lib-file dotlsp :output-file doto)))))))
+
+@
+
+\subsubsection{makespad}
+
+Make will not compare dates across directories.
+In particular, it cannot compare the algebra files because there
+is a one-to-many correspondence. This function will walk over
+all of the algebra NRLIB files and find all of the spad files
+that are out of date and need to be recompiled. This function
+creates a file "/tmp/compile.input" to be used later in the
+makefile.
+
+Note that the file /tmp/compile.input is not currently used
+as algebra source recompiles are not necessarily something
+we want done automatically. Nevertheless, in the quest for
+quality we check anyway.
+<<makespad>>=
+(defun makespad (src mid stype)
+ "iterate over the spad files, compiling ones that are out of date.
+  src is the directory containing .spad
+  mid is the directory containing code.lsp
+  out is the directory containing code.o"
+ (let (mntlibs spadwork (alphabet #\space))
+  (labels (
+   (findsrc (mid libname)
+    "return a string name of the source file given the library file
+     name (eg PI) as a string"
+    (let (kaffile index alist)
+     (setq kaffile 
+      (concatenate 'string mid "/" libname ".NRLIB/index.KAF*"))
+     (with-open-file (kaf kaffile)
+      (setq index (read kaf))
+      (file-position kaf index)
+      (setq alist (read kaf))
+     (setq index (third (assoc "sourceFile" alist :test #'string=)))
+      (file-position kaf index)
+     (pathname-name (pathname (read kaf index)))))))
+  (format t "makespad:src=~s mid=~s stype=~s~%" src mid stype)
+  (if (and src mid)
+   (format t "doing directory on ~s...~%" (concatenate 'string src "/*"))
+   (error "makespad:SRC=~a MID=~a not set properly~%" src mid))
+#+:akcl (si::chdir mid)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " mid))
+  (setq mntlibs (directory "*.NRLIB"))
+  (unless mntlibs
+   (format t "makespad:directory of ~a returned NIL~%" src)
+   (bye 1))
+  (princ "checking ")
+  (dolist (lib mntlibs)
+   (unless (char= (schar (pathname-name lib) 0) alphabet)
+    (setq alphabet (schar (pathname-name lib) 0))
+    (princ alphabet)
+    (finish-output))
+   (let (spad spaddate lsp lspdate)
+    (setq spad
+      (concatenate 'string src "/" (findsrc mid (pathname-name lib)) ".spad"))
+    (setq spaddate
+      (and (probe-file spad) (file-write-date spad)))
+    (setq lsp
+      (concatenate 'string mid "/" (pathname-name lib) ".NRLIB/code." stype))
+    (setq lspdate
+      (and (probe-file lsp) (file-write-date lsp)))
+    (cond
+     ((and spaddate lspdate (<= spaddate lspdate)))
+     ((and spaddate lspdate (> spaddate lspdate))
+       (setq spadwork (adjoin spad spadwork :test #'string=)))
+     ((and spaddate (not lspdate)) 
+       (setq spadwork (adjoin spad spadwork :test #'string=)))
+     ((and (not spaddate) lspdate)
+       (format t "makespad:missing spad file ~a for lisp file ~a~%" spad lsp))
+     ((and (not spaddate) (not lspdate))
+       (format t "makespad:NRLIB ~a exist but is spad ~a and lsp ~a don't~%"
+         lib spad lsp)))))
+   (with-open-file (tmp "/tmp/compile.input" :direction :output)
+    (dolist (spad spadwork)
+     (format t "~a is out of date~%" spad)
+     (format tmp ")co ~a~%" spad))))))
+
+@
+
+\subsubsection{libcheck}
+
+We need to ensure that the INTERP.EXPOSED list, which is a list
+of the exposed constructors, is consistent with the actual libraries.
+<<libcheck>>=
+(defun libcheck (int)
+ "check that INTERP.EXPOSED and NRLIBs are consistent"
+ (let (interp nrlibs)
+ (labels (
+  (CONSTRUCTORNAME (nrlib)
+   "find the long name of a constructor given an abbreviation string"
+   (let (file sourcefile name)
+    (setq file (findsrc nrlib))
+    (setq sourcefile
+      (concatenate 'string int "/" file ".spad"))
+    (when (and file (probe-file sourcefile))
+     (setq name (searchsource sourcefile nrlib)))))
+  (NOCAT (longnames)
+   "remove the categories from the list of long names"
+   (remove-if 
+    #'(lambda (x) 
+       (let ((c (schar x (1- (length x)))))
+        (or (char= c #\&) (char= c #\-)))) longnames))
+  (FINDSRC (libname)
+   "return a string name of the source file given the library file
+    name (eg PI) as a string"
+   (let (kaffile index alist result)
+    (setq kaffile 
+     (concatenate 'string int "/" libname ".NRLIB/index.KAF*"))
+    (if (probe-file kaffile)
+     (with-open-file (kaf kaffile)
+      (setq index (read kaf))
+      (file-position kaf index)
+      (setq alist (read kaf))
+     (setq index (third (assoc "sourceFile" alist :test #'string=)))
+      (file-position kaf index)
+     (setq result (pathname-name (pathname (read kaf index))))))
+     (format t "~a does not exist~%" kaffile)
+    result))
+  (READINTERP ()
+   "read INTERP.EXPOSED and return a sorted abbreviation list"
+   (let (expr names longnames)
+    (with-open-file (in (concatenate 'string int "/INTERP.EXPOSED"))
+     (catch 'eof
+      (loop
+       (setq expr (read-line in nil 'eof))
+       (when (eq expr 'eof) (throw 'eof nil))
+       (when
+        (and
+         (> (length expr) 58)
+         (char= (schar expr 0) #\space) 
+         (not (char= (schar expr 8) #\space)))
+         (push (string-trim '(#\space) (subseq expr 8 57)) longnames)
+         (push (string-right-trim '(#\space) (subseq expr 58)) names)))))
+    (setq longnames (sort longnames #'string<))
+    (setq names (sort names #'string<))
+    (values names longnames)))
+  (READLIBS (algebra)
+   "read the NRLIB directory and return a sorted abbreviation list"
+   (let (libs nrlibs)
+#+:akcl (si::chdir algebra)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " algebra))
+    (setq nrlibs (directory "*.NRLIB"))
+    (unless nrlibs
+     (error "libcheck: (directory ~s) returned NIL~%" 
+         (concatenate 'string algebra "/*.NRLIB")))
+    (dolist (lib nrlibs)
+     (push (pathname-name lib) libs))
+    (sort libs #'string<)))
+  (SEARCHSOURCE (sourcefile nrlib)
+   "search a sourcefile for the long constructor name of the nrlib string"
+   (let (in expr start)
+    (setq nrlib (concatenate 'string " " nrlib " "))
+    (catch 'done
+     (with-open-file (in sourcefile)
+      (loop
+       (setq expr (read-line in nil 'done))
+       (when (eq expr 'done) (throw 'done nil))
+       (when (and (> (length expr) 4)
+                (string= ")abb" (subseq expr 0 4))
+                (search nrlib expr :test #'string=)
+                (setq start (position #\space expr :from-end t :test #'char=)))
+        (throw 'done (string-trim '(#\space) (subseq expr start)))))))))
+  (SRCABBREVS (sourcefile)
+   (let (in expr start end names longnames)
+    (catch 'done
+     (with-open-file (in sourcefile)
+      (loop
+       (setq expr (read-line in nil 'done))
+       (when (eq expr 'done) (throw 'done nil))
+       (when (and (> (length expr) 4)
+             (string= ")abb" (subseq expr 0 4)))
+        (setq point (position #\space expr :from-end t :test #'char=))
+        (push (string-trim '(#\space) (subseq expr point)) longnames)
+        (setq mark
+         (position #\space 
+          (string-right-trim '(#\space)
+           (subseq expr 0 (1- point))) :from-end t))
+        (push (string-trim '(#\space) (subseq expr mark point)) names)))))
+    (values names longnames)))
+  (SRCSCAN ()
+   (let (longnames names)
+#+:gcl (system::chdir int)
+#-:gcl (vmlisp::obey (concatenate 'string "cd " int))
+    (setq spads (directory "*.spad"))
+    (dolist (spad spads)
+     (multiple-value-setq (short long) (srcabbrevs spad))
+     (setq names (nconc names short))
+     (setq longnames (nconc longnames long)))
+    (setq names (sort names #'string<))
+    (setq longnames (sort longnames #'string<))
+    (values names longnames))))
+  (multiple-value-setq (abbrevs constructors) (readinterp))
+  (setq nrlibs (readlibs int))
+  (dolist (lib (set-difference nrlibs abbrevs :test #'string=))
+    (format t "libcheck:~a/~a.NRLIB is not in INTERP.EXPOSED~%" int lib))
+  (dolist (expose (set-difference abbrevs nrlibs :test #'string=))
+    (format t "libcheck:~a is in INTERP.EXPOSED with no NRLIB~%" expose))
+  (multiple-value-setq (srcabbrevs srcconstructors) (srcscan))
+  (setq abbrevs (nocat abbrevs))
+  (setq constructors (nocat constructors))
+  (dolist (item (set-difference srcabbrevs abbrevs :test #'string=))
+    (format t "libcheck:~a is in ~a but not in INTERP.EXPOSED~%" item
+     (findsrc item)))
+  (dolist (item (set-difference abbrevs srcabbrevs :test #'string=))
+    (format t "libcheck:~a is in INTERP.EXPOSED but has no spad sourcfile~%"
+      item))
+  (dolist (item (set-difference srcconstructors constructors :test #'string=))
+    (format t "libcheck:~a is not in INTERP.EXPOSED~%" item))
+  (dolist (item (set-difference constructors srcconstructors :test #'string=))
+    (format t "libcheck:~a has no spad source file~%" item)))))
+
+@
+
+
+\subsection{Constructing TAGS}
+
+TAGS are useful for finding functions if you run Emacs. We have a
+set of functions that construct TAGS files for Axiom.
+\subsubsection{make-tags-file}
+Run the etags command on all of the lisp code. Then run the
+{\bf spadtags-from-directory} function on the boot code. The
+final TAGS file is constructed in the {\bf tmp} directory.
+<<make-tags-file>>=
+(defun make-tags-file ()
+#+:gcl (system:chdir "/tmp")
+#-:gcl (vmlisp::obey (concatenate 'string "cd " "/tmp"))
+  (obey (concat "etags " (make-absolute-filename "../../src/interp/*.lisp")))
+  (spadtags-from-directory "../../src/interp" "boot")
+  (obey "cat /tmp/boot.TAGS >> /tmp/TAGS"))
+
+@
+
+\subsubsection{spadtags-from-directory}
+
+This function will walk across a directory and call 
+{\bf spadtags-from-file} on each file.
+<<spadtags-from-directory>>=
+(defun spadtags-from-directory (dir type)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type type))
+	  (files (directory pattern)))
+     (with-open-file
+      (tagstream (concatenate 'string "/tmp/" type ".TAGS") :direction :output
+		 :if-exists :supersede :if-does-not-exist :create)
+      (dolist (file files (namestring tagstream))
+	      (print (list "processing:" file))
+	      (write-char #\page tagstream)
+	      (terpri tagstream)
+	      (write-string (namestring file) tagstream)
+	      (write-char #\, tagstream)
+	      (princ (spadtags-from-file file) tagstream)
+	      (terpri tagstream)
+	      (with-open-file (stream "/tmp/*TAGS")
+		 (do ((line (read-line stream nil nil)
+			    (read-line stream nil nil)))
+		     ((null line) nil)
+		     (write-line line tagstream)))))))
+
+@
+
+\subsubsection{spadtags-from-file}
+
+This function knows how to find function names in {\bf boot} code
+so we can add them to the TAGS file using standard etags format.
+<<spadtags-from-file>>=
+(defun spadtags-from-file (spadfile)
+  (with-open-file (tagstream "/tmp/*TAGS" :direction :output
+			     :if-exists :supersede :if-does-not-exist :create)
+    (with-open-file (stream spadfile)
+       (do ((char-count 0 (file-position stream))
+	    (line (read-line stream nil nil) (read-line stream nil nil))
+	    (line-count 1 (1+ line-count)))
+	   ((null line) (file-length tagstream))
+	   (if (/= (length line) 0)
+	       (let ((firstchar (elt line 0)) (end nil)
+		     (len (length line)))
+		 (cond ((member firstchar '(#\space #\{ #\} #\tab )
+				:test #'char= ) "skip")
+		       ((string= line ")abb" :end1 (min 4 len))
+			(setq end (position #\space line :from-end t
+					    :test-not #'eql)
+			      end (and end (position #\space line :from-end t
+						     :end end)))
+			(write-tag-line line tagstream end
+					line-count char-count))
+		       ((char= firstchar #\)) "skip")
+		       ((and (> len 1) (string= line "--" :end1 2)) "skip")
+		       ((and (> len 1) (string= line "++" :end1 2)) "skip")
+		       ((search "==>" line) "skip")
+		       ((and (setq end (position #\space line)
+				   end (or (position #\( line :end end) end)
+				   end (or (position #\: line :end end) end)
+				   end (or (position #\[ line :end end) end))
+			     (equal end 0)) "skip")
+		       ((position #\] line :end end) "skip")
+		       ((string= line "SETANDFILEQ" :end1 end) "skip")
+		       ((string= line "EVALANDFILEACTQ" :end1 end) "skip")
+		       (t (write-tag-line line tagstream
+					  (if (numberp end) (+ end 1) end)
+					  line-count char-count))  )))))))
+
+@
+
+\subsubsection{write-tag-line}
+
+This function knows how to write a single line into a TAGS file
+using the etags file format.
+<<write-tag-line>>=
+(defun write-tag-line (line tagstream endcol line-count char-count)
+  (write-string line tagstream :end endcol)
+  (write-char #\rubout tagstream)
+  (princ line-count tagstream)
+  (write-char #\, tagstream)
+  (princ char-count tagstream)
+  (terpri tagstream))
+
+@
+
+\subsubsection{blankcharp}
+
+This is a trivial predicate for calls to {\bf position-if-not} in the
+{\bf findtag} function.
+<<blankcharp>>=
+(defun blankcharp (c) (char= c #\Space))
+
+@
+
+\subsubsection{findtag}
+
+The {\bf findtag} function is a user-level function to figure out
+which file contains a given tag. This is sometimes useful if Emacs
+is not around or TAGS are not loaded.
+<<findtag>>=
+(defun findtag (tag &optional (tagfile (concat $spadroot "/../../src/interp/TAGS")) )
+  ;; tag is an identifier
+    (with-open-file (tagstream tagfile)
+	(do ((tagline (read-line tagstream nil nil)
+		      (read-line tagstream nil nil))
+	     (*package* (symbol-package tag))
+	     (sourcefile)
+	     (stringtag (string tag))
+	     (pos)
+	     (tpos)
+	     (type))
+	    ((null tagline) ())
+	    (cond ((char= (char tagline 0) #\Page)
+		   (setq tagline (read-line tagstream nil nil))
+		   (setq sourcefile (subseq tagline 0
+					    (position #\, tagline)))
+		   (setq type (pathname-type sourcefile)))
+		  ((string= type "lisp")
+		   (if (match-lisp-tag tag tagline)
+		       (return (cons sourcefile tagline))))
+		  ((> (mismatch ")abb" tagline) 3)
+		   (setq pos (position #\Space tagline :start 3))
+		   (setq pos (position-if-not #'blankcharp tagline
+					      :start pos))
+		   (setq pos (position #\Space tagline :start pos))
+		   (setq pos (position-if-not #'blankcharp tagline
+					      :start pos))
+		   (setq tpos (mismatch stringtag tagline :start2 pos))
+		   (if (and (= tpos (length (string tag)))
+			    (member (char tagline (+ pos tpos)) '(#\Space #\Rubout)))
+		       (return (cons sourcefile tagline))))
+		  ((setq pos (mismatch stringtag tagline))
+		   (if (and (= pos (length stringtag))
+			    (> (length tagline) pos)
+			    (member (char tagline pos)
+				    '( #\Space #\( #\:) ))
+		       (return (cons sourcefile tagline))))))))
+
+@
+
+\subsubsection{match-lisp-tag}
+
+The {\bf match-lisp-tag} function is used by {\bf findtag}. This
+function assumes that \\ can only appear as first character of name.
+<<match-lisp-tag>>=
+(defun match-lisp-tag (tag tagline &optional (prefix nil)
+			   &aux (stringtag (string tag)) pos tpos)
+  (when (and (if prefix
+		 (= (mismatch prefix tagline :test #'char-equal)
+		    (length prefix))
+	       t)
+	     (numberp (setq pos (position #\Space tagline)))
+	     (numberp (setq pos (position-if-not #'blankcharp tagline
+						 :start pos))))
+	(if (char= (char tagline pos) #\') (incf pos))
+	(if (member (char tagline pos) '( #\\ #\|))
+	    (setq tpos (1+ pos))
+	  (setq tpos pos))
+	(and (= (mismatch stringtag tagline :start2 tpos :test #'char-equal)
+		(length stringtag))
+	     (eq tag (read-from-string tagline nil nil :start pos))) ))
+
+@
+
+
+\subsection{Translated Boot functions}
+
+\subsubsection{string2BootTree}
+
+<<string2BootTree>>=
+(DEFUN |string2BootTree| (S)
+  (init-boot/spad-reader)
+  (LET* ((BOOT-LINE-STACK (LIST (CONS 1 S)))
+     ($BOOT T)
+     ($SPAD NIL)
+     (XTOKENREADER 'GET-BOOT-TOKEN)
+     (LINE-HANDLER 'NEXT-BOOT-LINE)
+     (PARSEOUT (PROGN (|PARSE-Expression|) (POP-STACK-1))))
+    (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER))
+    (DEF-RENAME (|new2OldLisp| PARSEOUT))))
+
+@
+
+\subsubsection{string2SpadTree}
+
+<<string2SpadTree>>=
+(DEFUN |string2SpadTree| (LINE)
+  (DECLARE (SPECIAL LINE))
+  (if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) ))
+    (|processSynonyms|))
+  (ioclear)
+  (LET* ((BOOT-LINE-STACK (LIST (CONS 1 LINE)))
+     ($BOOT NIL)
+     ($SPAD T)
+     (XTOKENREADER 'GET-BOOT-TOKEN)
+     (LINE-HANDLER 'NEXT-BOOT-LINE)
+     (PARSEOUT (PROG2 (|PARSE-NewExpr|) (POP-STACK-1))))
+    (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER))
+    PARSEOUT))
+
+@
+
+\subsubsection{processSynonyms}
+
+;;--------------------> NEW DEFINITION (see i-syscmd.boot.pamphlet)
+<<processSynonyms>>=
+(defun |processSynonyms| () nil) ;;dummy def for depsys, redefined later
+
+@
+
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+#-:common-lisp (IMPORT-MODULE "vmlisp")
+
+(in-package "BOOT")
+(export '($spadroot $directory-list $current-directory reroot
+	  make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|))
+
+<<our-write-date>>
+<<make-directory>>
+<<interp-make-directory>>
+<<bin-path>>
+<<load-directory>>
+<<compspadfiles>>
+<<recompile-all-algebra-files>>
+<<fe>>
+<<fc>>
+<<recompile-directory>>
+<<recompile-file-if-necessary>>
+<<recompile-all-files>>
+<<recompile-lib-directory>>
+<<recompile-all-libs>>
+<<recompile-NRLIB-if-necessary>>
+<<lift-NRLIB-name>>
+<<retranslate-directory>>
+<<retranslate-file-if-necessary>>
+<<make-tags-file>>
+<<spadtags-from-directory>>
+<<spadtags-from-file>>
+<<write-tag-line>>
+<<blankcharp>>
+<<findtag>>
+<<match-lisp-tag>>
+<<compile-boot-file>>
+<<translate>>
+<<translist>>
+<<relative-directory-list>>
+<<relative-library-directory-list>>
+<<directory-list>>
+<<library-directory-list>>
+<<boottocl>>
+
+(in-package "BOOT")
+
+<<parse-functions>>
+<<comp-functions>>
+<<browse-functions>>
+<<translate-functions>>
+<<asauto-functions>>
+<<debug-functions>>
+<<anna-functions>>
+<<nagbr-functions>>
+<<setBootAutloadProperties>>
+<<boot-load>>
+<<setBootAutoLoadProperty>>
+<<mkBootAutoLoad>>
+<<build-interpsys>>
+<<setNAGBootAutloadProperties>>
+<<get-NAG-chapter>>
+<<nag-files>>
+<<chapter-name>>
+<<build-depsys>>
+
+<<string2BootTree>>
+<<string2SpadTree>>
+<<processSynonyms>>
+
+;; the following are for conditional reading
+#+:ieee-floating-point (setq $ieee t)
+#-:ieee-floating-point (setq $ieee nil)
+(setq |$opSysName| '"shell")
+#+:CCL (defun machine-type () "unknown")
+(setq |$machineType| (machine-type))
+; spad-clear-input patches around fact that akcl clear-input leaves newlines chars
+(defun spad-clear-input (st) (clear-input st) (if (listen st) (read-char st)))
+
+<<yearweek>>
+(defun sourcepath (f)
+ "find the sourcefile in the system directories"
+ (let (axiom algebra naglink)
+  (setq axiom (|getEnv| "AXIOM"))
+  (setq algebra (concatenate 'string axiom "/../../src/algebra/" f ".spad"))
+  (setq naglink (concatenate 'string axiom "/../../src/naglink/" f ".spad"))
+  (cond
+   ((probe-file algebra) algebra)
+   ((probe-file naglink) naglink)
+   ('else nil))))
+
+(defun srcabbrevs (sourcefile)
+ "read spad source files and return the constructor names and abbrevs"
+ (let (expr point mark names longnames)
+  (catch 'done
+   (with-open-file (in sourcefile)
+    (loop
+     (setq expr (read-line in nil 'done))
+     (when (eq expr 'done) (throw 'done nil))
+     (when (and (> (length expr) 4) (string= ")abb" (subseq expr 0 4)))
+      (setq expr (string-right-trim '(#\space #\tab) expr))
+      (setq point (position #\space expr :from-end t :test #'char=))
+      (push (subseq expr (1+ point)) longnames)
+      (setq expr (string-right-trim '(#\space #\tab)
+		       (subseq expr 0 point)))
+      (setq mark (position #\space expr  :from-end t))
+      (push (subseq expr (1+ mark)) names)))))
+  (values longnames names)))
+
+
+#+(and :AKCL (not (or :dos :win32)))
+(in-package "COMPILER")
+#+(and :AKCL (not (or :dos :win32)))
+(defun gazonk-name ( &aux tem)
+ "return the name of the intermediate compiler file"
+ (dotimes (i 1000)
+  (setq tem (merge-pathnames (format nil "/tmp/gazonk~d.lsp" i)))
+  (unless (probe-file tem)
+    (return-from gazonk-name (pathname tem))))
+ (error "1000 gazonk names used already!"))
+
+(in-package "BOOT")
+
+(defun |tr| (fn)
+  (|oldCompilerAutoloadOnceTrigger|)
+  (|browserAutoloadOnceTrigger|)
+  (|spad2AsTranslatorAutoloadOnceTrigger|)
+  (|convertSpadFile| fn) )
+
+<<makelib>>
+<<makespad>>
+<<libcheck>>
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/varini.boot.pamphlet b/src/interp/varini.boot.pamphlet
new file mode 100644
index 00000000..0d7c050a
--- /dev/null
+++ b/src/interp/varini.boot.pamphlet
@@ -0,0 +1,281 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp varini.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- Variables to control whether old software calls the new compiler.
+$ncConverse  :=    NIL
+$newcompMode :=    NIL        -- )comp means new compiler.
+$newComp     :=    true       -- Start workspace in new compiler.
+ 
+-- Files used by the compiler.
+$erLocMsgDatabaseName     := pathname '(co_-eng msgs a)
+$erGlbMsgDatabaseName     := pathname '(co_-eng msgs i)
+$LanguageConstantFileName := pathname '(stlang input _*)
+$WorkspaceProfileName     := pathname '(spadprof input _*)
+$OldLibraryDatabaseName   := pathname '(modemap database _*)
+
+$SpadNcLibraryRelPath     := '"lib/lang"         
+$SpadNcLibraryRelPathSrc  := '"src/lib/lang/"         
+$SpadNcIncludeRelPath     := '"src/include/lang/" 
+
+--$LibrariesSearchPath      := [PathnameDirectory '"./x",
+--                              SpadDirectory $SpadNcLibraryRelPath , 
+--			      SpadDirectory $SpadNcLibraryRelPathSrc]
+
+--$IncludesSearchPath       := [PathnameDirectory '"./x",
+--                              SpadDirectory $SpadNcIncludeRelPath]
+
+$warmstab := nil
+ 
+-- Variables to control phases and their output
+ 
+$ncRead :=              true
+$ncmRead :=             NIL
+ 
+$ncParse :=             true
+$ncmParse :=            NIL
+ 
+$ncAbsck :=             true
+$ncmAbsck :=            NIL
+ 
+$ncMacro :=             true
+$ncmMacro :=            NIL
+ 
+$ncScope :=           false
+$ncmScope :=            NIL
+ 
+$ncAnalyze :=           true
+$ncmSemantics :=        NIL
+ 
+$ncInterpretSetr :=     false
+ 
+$ncParseSetr :=       false
+$ncmParseSetr :=        NIL
+ 
+$ncGenerateSAM :=       true
+$ncmSAM :=              NIL
+$ncLastSamCode :=       NIL
+ 
+$ncSamOptimize :=     false
+$ncmSamOptimize :=      NIL
+$ncLastOptimizedCode := NIL
+ 
+$ncSamPack :=         false
+$ncmSamPack :=          NIL
+$ncLastPackedSam :=     NIL
+ 
+$ncGenerateConcrete :=  true
+$ncmConCode :=          NIL
+$ncLastConcreteCode :=  NIL
+ 
+$ncLibrary          :=  true
+$ncmLibrary         :=  NIL
+ 
+$ncGenerateMachine :=   true
+$ncmCodeSize :=         NIL
+$ncLastMachineCode :=   NIL
+ 
+$ncInterpretSam   :=    false
+$ncExecuteMachine :=    true
+ 
+$ncReportStep :=        true
+ 
+-- Variables to control debugging output
+--they are manipulated in setvart boot
+$debugApply :=        false   -- trace application matching
+$debugApply0 :=       false   -- trace even more
+$debugSemAnalyze :=   false   -- trace results of semAnalyze
+$debugRead :=         false
+$debugParse :=        false
+$debugCheck :=        false
+$debugMacro :=        false
+$debugScope :=        false
+$debugParseSetr :=    false
+$debugGenSam :=       false
+$debugSamOpt :=       false
+$debugSamPack :=      false
+$debugGenCon :=       false
+$debugGenMach :=      false
+$debugExecute :=      false
+$debugReport :=       false
+ 
+-- Variables to control what other parts of the compiler are executed.
+$ncDoSpecialCases :=  true
+$LispViaSam :=        false
+ 
+-- Variables to control other compiler output.
+ 
+-- note flags to control the error message facility must have
+-- the prefix $ncm, since catExcpts (in ncsetvar boot) strips the
+-- prefix and uses the name.  ie. $ncmWarning ==> "Warning"
+$ncmPhase :=      NIL
+$ncmWarning :=    'T
+$ncmStatistic :=  NIL
+$ncmRemark :=     'T
+$statTmSpShow :=   4
+$compBugPrefix :=      '"Bug!"
+$compUnimplPrefix :=   '"Unimp"
+$compDebugPrefix :=    '"Debug"
+$compStatisticPrefix :='"Stat"
+$compErrorPrefix :=    '"Error"
+$compWarningPrefix :=  '"Warn"
+$compRemarkPrefix :=   '"Note"
+$compSayPrefix :=      '"Msg"
+
+$charNumSymVector := NIL
+ 
+-- Modes
+$ExitMode :=          'ExitMode
+$FullMode :=          'FullMode
+$NoValueMode :=       'NoValueMode
+$ValueMode :=         'ValueMode
+ 
+--error message facility
+$nopos   := ['noposition]
+$showKeyNum   :=        NIL
+$specificMsgTags :=     NIL
+ 
+--compiler option stuff
+$ncCodeDebug := true
+$ncCodeTrace := true
+$ncSamInline := true
+ 
+-- Variables used in the SEMantic ANAlysis
+ 
+--from SEFO BOOT
+$sefoDerivedAttributes := [ 'type, 'tfinfo, 'signature, 'pooled ]
+ 
+--from NCMODE BOOT
+$ValueMode   := 'ValueMode
+$NoValueMode := 'NoValueMode
+$FullMode    := 'FullMode
+$ExitMode    := 'ExitMode
+ 
+-- Miscellaneous nonsense.
+$newcompInteractiveRecovery := 'T
+$newcompErrorCount :=           0
+$floatdolla :=        ['$elt, ['BigFloat], 'bigfloat]
+$floatilla :=         [ 'elt, ['BigFloat], 'bigfloat]
+$newcompStats :=      NIL
+$newcompAbbrevType := true
+$stabLibLevelNo :=    -1
+$SyntheticSourcePosition := 'Synthetic
+$Typeless :=          NIL
+ 
+$catAbTab := '(
+    ($ncmWarning     .   "warn" ) _
+    ($ncmRemark      .   "rem"  ) _
+    ($ncmStatistic   .   "stat" ) )
+$phaseAbTab := '(
+    (Reading             . "Rd" ) _
+    (Parsing             . "Pa" ) _
+    (Checking            . "Ck" ) _
+    (Macroing            . "Ma" ) _
+    (Scoping             . "Sc" ) _
+    (Analyzing           . "An" ) _
+    (Interpreting        . "In" ) _
+    (ParseSetr           . "Ps" ) _
+    (GeneratingSAM       . "Sg" ) _
+    (SamOptimize         . "So" ) _
+    (SamPack             . "Sp" ) _
+    (GeneratingConcrete  . "Cg" ) _
+    (GeneratingMachine   . "Mg" ) _
+    (Executing           . "Ex" ) _
+    (Reporting           . "Rp" ) )
+
+-- Items from STATS BOOT
+-- $timerTicksPerSecond := INTERNAL_-TIME_-UNITS_-PER_-SECOND
+$LINELENGTH := 80
+ 
+-- Items from MSG BOOT I
+$showMsgCaller := nil  --## was F
+$preLength := 11
+$LOGLENGTH := $LINELENGTH - 6
+$specificMsgTags := []
+ 
+$imPrTagGuys := ['unimple, 'bug, 'debug, 'say, 'warn]
+$toWhereGuys := ['fileOnly, 'screenOnly ]
+$imPrGuys    := ['imPr]
+$repGuys     := ['noRep, 'rep]
+$attrCats    := ['$imPrGuys, '$toWhereGuys, '$repGuys]
+ 
+ 
+-- Soon to be obsolete
+$showConcrete1 := NIL
+$showConcrete2 := NIL
+$showPhases :=    'T
+$showSAM :=       NIL
+$showform :=      NIL
+$showsetr :=      NIL
+$showval :=       'T
+$tafon :=         NIL
+ 
+-- Inits for pseudo kaf files
+--$CURRENT_-DIRECTORY := fileCurrentDirectory()
+$DIRECTORY_-LIST    := []
+
+--caching for inline code
+$gotSam := nil
+--$cachedInlineTable := EqTable()
+
+--debugging variables for Simon.
+$simon := nil
+$ncmTLambdaDown := nil
+
+$ncMsgList := nil
+$oldLibraryInterface := nil  -- don't consider old library information.
+
+--## Bug in RIOS version of KCL
+NeedAtLeastOneFunctionInThisFile(x) == x
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet
new file mode 100644
index 00000000..17b98975
--- /dev/null
+++ b/src/interp/vmlisp.lisp.pamphlet
@@ -0,0 +1,2115 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/vmlisp.lisp} Pamphlet}
+\author{Lars Ericson, Barry Trager, Martial Schor, Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+
+\section{The [[VMLISP]] package}
+
+This is the package that originally contained the \Tool{VMLisp} macros
+but in fact contains macros to support several other lisps. It
+is essentially the place where most of the macros to support
+idioms from prior ports (like [[rdefiostream]] and [[fileactq]])
+<<*>>=
+<<license>>
+(defpackage "VMLISP"
+  #+:common-lisp (:use "COMMON-LISP-USER" "COMMON-LISP")
+  #-:common-lisp (:use "USER" "SYSTEM" "LISP")
+  (:use "AxiomCore"))
+
+@
+
+We plan to move the content of [[VMLISP]] to [[BOOT]].
+
+
+\subsection{Exported symbols}
+
+
+<<*>>=
+;;; Definitions for package VMLISP of type EXPORT
+(in-package "VMLISP")
+(export
+    '(VMLISP::SINTP VMLISP::$FCOPY 
+         VMLISP::PUT VMLISP::PNAME
+	 VMLISP::QVELT-1 VMLISP::QSETVELT-1 vmlisp::throw-protect
+	 VMLISP::EQCAR
+	 VMLISP::DEFIOSTREAM VMLISP::RDEFIOSTREAM VMLISP::MLAMBDA
+	 VMLISP::QSLESSP VMLISP::QSDIFFERENCE VMLISP::QSQUOTIENT
+	 VMLISP::ERROROUTSTREAM VMLISP::CREATE-SBC VMLISP::LASTPAIR
+	 VMLISP::EQSUBSTLIST VMLISP::QCAAAR VMLISP::$TOTAL-ELAPSED-TIME
+	 VMLISP::QUOTIENT VMLISP::SORTGREATERP VMLISP::LIBSTREAM-DIRNAME
+	 VMLISP::QSETREFV VMLISP::QSTRINGLENGTH VMLISP::EVALFUN
+	 VMLISP::QCDAR VMLISP::TEMPUS-FUGIT VMLISP::QSPLUS VMLISP::QSABSVAL
+	 VMLISP::QSZEROP VMLISP::QSMIN VMLISP::QSLEFTSHIFT
+	 VMLISP::SETDIFFERENCE VMLISP::RPLQ VMLISP::CATCHALL
+	 VMLISP::RECOMPILE-DIRECTORY VMLISP::MDEF VMLISP::LINTP
+	 VMLISP::NILFN VMLISP::TAB VMLISP::QCDDR VMLISP::IOSTATE
+	 VMLISP::SFP VMLISP::NE VMLISP::STRGREATERP VMLISP::|startsId?|
+	 VMLISP::USE-VMLISP-SYNTAX VMLISP::RCLASS VMLISP::|idChar?|
+	 VMLISP::SEQ VMLISP::FIXP VMLISP::MAKE-CVEC VMLISP::MAKE-BVEC
+	 VMLISP::|F,PRINT-ONE| VMLISP::HASHUEQUAL VMLISP::$OUTFILEP
+	 VMLISP::TIMES VMLISP::DIFFERENCE VMLISP::MSUBST VMLISP::DIVIDE
+	 VMLISP::|remove| VMLISP::GETL VMLISP::QCADAR VMLISP::QCAAAAR
+	 VMLISP::RECLAIM VMLISP::ORADDTEMPDEFS VMLISP::NAMEDERRSET
+	 VMLISP::TRIMSTRING VMLISP::CURRINDEX VMLISP::EVALANDFILEACTQ
+	 VMLISP::LISPLIB VMLISP::FLUID VMLISP::MDEFX VMLISP::COMP370
+	 VMLISP::NEQ VMLISP::GETREFV VMLISP::|log| VMLISP::QVSIZE
+	 VMLISP::MBPIP VMLISP::RPLNODE VMLISP::QSORT
+	 VMLISP::PLACEP VMLISP::RREAD VMLISP::BINTP VMLISP::QSODDP
+	 VMLISP::O VMLISP::RVECP VMLISP::CHAR2NUM VMLISP::POPP
+	 VMLISP::QCDAADR VMLISP::HKEYS VMLISP::HASHCVEC VMLISP::HASHID
+	 VMLISP::REMOVEQ VMLISP::LISTOFFUNCTIONS
+	 VMLISP::QCADAAR VMLISP::ABSVAL VMLISP::VMPRINT
+	 VMLISP::MAKE-APPENDSTREAM VMLISP::MAKE-INPUT-FILENAME
+	 VMLISP::MAKE-INSTREAM VMLISP::HASHTABLEP VMLISP::UPCASE
+	 VMLISP::LOADCOND VMLISP::STRPOSL VMLISP::STATEP VMLISP::QCDADR
+	 VMLISP::HREMPROP VMLISP::LAM VMLISP::FBPIP VMLISP::NCONC2
+	 VMLISP::GETFULLSTR VMLISP::I VMLISP::HREM
+	 VMLISP::*LISP-BIN-FILETYPE* VMLISP::INT2RNUM VMLISP::EBCDIC
+	 VMLISP::$INFILEP VMLISP::BFP VMLISP::NUMP VMLISP::UNEMBED
+	 VMLISP::PAIRP VMLISP::BOOLEANP VMLISP::FIX VMLISP::REMAINDER
+	 VMLISP::RE-ENABLE-INT VMLISP::QCAADDR VMLISP::QCDDADR
+	 VMLISP::$LISTFILE VMLISP::IVECP VMLISP::LIST2VEC
+	 VMLISP::|LAM,FILEACTQ| VMLISP::LISTOFQUOTES
+	 VMLISP::$ERASE VMLISP::QSDEC1 VMLISP::QSDIFFERENCE
+	 VMLISP::QSSUB1 VMLISP::QCAR VMLISP::EVA1FUN VMLISP::IS-CONSOLE
+	 VMLISP::MAKESTRING VMLISP::CUROUTSTREAM VMLISP::QCDDDR
+	 VMLISP::QCDADAR VMLISP::MAKE-ABSOLUTE-FILENAME VMLISP::SUFFIX
+	 VMLISP::FUNARGP VMLISP::VM/ VMLISP::QRPLACA VMLISP::GGREATERP
+	 VMLISP::CGREATERP VMLISP::RNUMP VMLISP::RESETQ VMLISP::QRPLACD
+	 VMLISP::SORTBY VMLISP::CVECP VMLISP::SETELT VMLISP::HGET
+	 VMLISP::$DIRECTORY-LIST VMLISP::LN VMLISP::|member|
+	 VMLISP::$LIBRARY-DIRECTORY-LIST VMLISP::VEC-SETELT
+	 VMLISP::QCSIZE VMLISP::QCADDDR VMLISP::RWRITE VMLISP::SUBLOAD
+	 VMLISP::STRINGIMAGE VMLISP::$CLEAR VMLISP::|read-line|
+	 VMLISP::PROPLIST VMLISP::INTP VMLISP::OUTPUT VMLISP::CONSOLE
+	 VMLISP::QCDDDAR VMLISP::ADDOPTIONS VMLISP::$FILETYPE-TABLE
+	 VMLISP::QSMINUSP VMLISP::|assoc| VMLISP::SETSIZE VMLISP::QCDR
+	 VMLISP::EFFACE VMLISP::COPY VMLISP::DOWNCASE VMLISP::LC2UC
+	 VMLISP::EMBED VMLISP::SETANDFILEQ VMLISP::QSMAX
+	 VMLISP::LIST2REFVEC VMLISP::MACRO-INVALIDARGS VMLISP::EMBEDDED
+	 VMLISP::REFVECP VMLISP::CLOSEDFN VMLISP::MAKE-HASHTABLE
+	 VMLISP::MAKE-FILENAME VMLISP::|$defaultMsgDatabaseName|
+	 VMLISP::LEXGREATERP
+	 VMLISP::IDENTP VMLISP::QSINC1 VMLISP::QESET VMLISP::MRP
+	 VMLISP::LESSP VMLISP::RPLPAIR VMLISP::QVELT VMLISP::QRPLQ
+	 VMLISP::MACERR VMLISP::*FILEACTQ-APPLY* VMLISP::HPUT*
+	 VMLISP::$FILEP VMLISP::MAKE-FULL-CVEC VMLISP::HCLEAR
+	 VMLISP::ERRORINSTREAM VMLISP::HPUTPROP 
+	 VMLISP::STRING2ID-N VMLISP::CALLBELOW VMLISP::BPINAME
+	 VMLISP::CHANGELENGTH VMLISP::ECQ VMLISP::OBEY VMLISP::QASSQ
+	 VMLISP::DCQ VMLISP::SHUT VMLISP::FILE VMLISP::HPUT
+	 VMLISP::MAKEPROP VMLISP::GREATERP VMLISP::MEMQ
+	 VMLISP::REROOT VMLISP::DIG2FIX VMLISP::L-CASE
+	 VMLISP::TEREAD VMLISP::QSREMAINDER VMLISP::$FINDFILE
+	 VMLISP::EQQ VMLISP::PRETTYPRINT VMLISP::HASHEQ VMLISP::LOG2
+	 VMLISP::U-CASE VMLISP::NREMOVE VMLISP::QREFELT VMLISP::SIZE
+	 VMLISP::EOFP VMLISP::QCDAAR VMLISP::RSHUT VMLISP::ADD1
+	 VMLISP::QMEMQ VMLISP::SUBSTRING VMLISP::LOADVOL
+	 VMLISP::QSTIMES VMLISP::STRINGLENGTH VMLISP::NEXT
+	 VMLISP::DEVICE VMLISP::MAPELT VMLISP::LENGTHOFBPI
+	 VMLISP::DIGITP VMLISP::QLENGTH VMLISP::QCAAADR VMLISP::CVEC
+	 VMLISP::VEC2LIST VMLISP::MODE VMLISP::MAKE-VEC VMLISP::GCMSG
+	 VMLISP::CONCAT VMLISP::$SHOWLINE VMLISP::QCAADR VMLISP::QCDDAR
+	 VMLISP::QCDAAAR VMLISP::RDROPITEMS VMLISP::VECP
+	 VMLISP::|union| VMLISP::ONE-OF VMLISP::NULLOUTSTREAM
+	 VMLISP::QSGREATERP VMLISP::MINUS VMLISP::MAXINDEX
+	 VMLISP::GETSTR VMLISP::QCADADR VMLISP::PRIN2CVEC
+	 VMLISP::CURRENTTIME VMLISP::$REPLACE VMLISP::UNIONQ
+	 VMLISP::NREMOVEQ VMLISP::CURINSTREAM VMLISP::MAKE-OUTSTREAM
+	 VMLISP::APPLX VMLISP::LASTNODE VMLISP::SUBSTQ VMLISP::TRUEFN
+	 VMLISP::|last| VMLISP::RPLACSTR VMLISP::SETQP VMLISP::QCADDR
+	 VMLISP::QCAADAR VMLISP::QCDDAAR VMLISP::|intersection|
+	 VMLISP::HASHTABLE-CLASS VMLISP::$CURRENT-DIRECTORY
+	 VMLISP::*COMP370-APPLY* VMLISP::QSETVELT VMLISP::MOVEVEC
+	 VMLISP::ID VMLISP::DEFINE-FUNCTION VMLISP::MSUBSTQ VMLISP::|nsubst|
+	 VMLISP::LISTOFFLUIDS VMLISP::SUB1 VMLISP::NUMBEROFARGS
+	 VMLISP::VMREAD VMLISP::SMINTP VMLISP::$SCREENSIZE
+	 VMLISP::LISTOFFREES VMLISP::QCDADDR VMLISP::COMPRREAD
+	 VMLISP::GENSYMP VMLISP::IFCAR VMLISP::QSETQ
+	 VMLISP::QCADDAR VMLISP::*LISP-SOURCE-FILETYPE* VMLISP::KOMPILE
+	 VMLISP::INPUT VMLISP::PAPPP VMLISP::UEQUAL VMLISP::COMPRWRITE
+	 VMLISP::SUBRP VMLISP::ASSEMBLE VMLISP::|LAM,EVALANDFILEACTQ|
+	 VMLISP::|$msgDatabaseName| VMLISP::IFCDR VMLISP::QVMAXINDEX
+	 VMLISP::$SPADROOT VMLISP::PRIN0 VMLISP::PRETTYPRIN0
+	 VMLISP::STACKLIFO VMLISP::ASSQ VMLISP::PRINTEXP
+	 VMLISP::QCDDDDR VMLISP::QSADD1
+	 VMLISP::SETDIFFERENCEQ VMLISP::STRPOS VMLISP::CONSTANT
+	 VMLISP::QCAAR VMLISP::HCOUNT VMLISP::RCOPYITEMS
+	 VMLISP::QSMINUS VMLISP::EVA1 VMLISP::OPTIONLIST
+	 VMLISP::NUM2CHAR VMLISP::QENUM VMLISP::QEQQ
+	 VMLISP::$TOTAL-GC-TIME VMLISP::CHARP VMLISP::QCADR
+	 VMLISP::INTERSECTIONQ VMLISP::DSETQ VMLISP::FETCHCHAR
+	 VMLISP::STRCONC VMLISP::MACRO-MISSINGARGS VMLISP::RPACKFILE
+	 VMLISP::EXIT VMLISP::PLUS VMLISP::RKEYIDS
+	 VMLISP::COMPILE-LIB-FILE VMLISP::RECOMPILE-LIB-FILE-IF-NECESSARY))
+
+@
+
+
+\section{The StringImage Fix}
+
+In GCL 2.5 there is a bug in the write-to-string function.
+It should respect *print-escape* but it does not. That is,
+\begin{verbatim}
+
+In GCL 2.4.1:
+(setq *print-escape* nil)
+(write-to-string '|a|) ==> "a"
+
+In GCL 2.5:
+(setq *print-escape* nil)
+(write-to-string '|a|) ==> "|a|"
+
+\end{verbatim}
+The form2LispString function uses stringimage and fails.
+The princ-to-string function assumes *print-escape* is nil
+and works properly.
+
+<<stringimage fix>>=
+;(define-function 'prin2cvec #'write-to-string)
+(define-function 'prin2cvec #'princ-to-string)
+;(define-function 'stringimage #'write-to-string)
+(define-function 'stringimage #'princ-to-string)
+
+@
+
+
+<<*>>=
+;      VM LISP EMULATION PACKAGE
+;      Lars Ericson, Barry Trager, Martial Schor, tim daly, LVMCL, et al
+;      IBM Thomas J. Watson Research Center
+;      Summer, 1986
+;  see /spad/daly.changes
+
+; This emulation package version is written for Symbolics Common Lisp.
+; Emulation commentary refers to LISP/VM, IBM Program Number 5798-DQZ,
+; as described in the LISP/VM User's Guide, document SH20-6477-1.
+; Main comment section headings refer to sections in the User's Guide.
+
+; If you are using this, you are probably in Common Lisp, yes?
+
+(in-package "VMLISP")
+
+; #-:common-lisp 
+;  (setq *features* (adjoin :common-lisp *features*))
+
+;; DEFVARS
+
+(defvar *comp370-apply* nil "function (name def) for comp370 to apply")
+
+(defvar curinstream (make-synonym-stream '*standard-input*))
+
+(defvar curoutstream (make-synonym-stream '*standard-output*))
+
+(defvar *embedded-functions* nil)
+
+(defvar errorinstream (make-synonym-stream '*terminal-io*))
+
+(defvar erroroutstream (make-synonym-stream '*terminal-io*))
+
+(defvar *fileactq-apply* nil "function to apply in fileactq")
+
+(defvar *lam-name* nil "name to be used by lam macro if non-nil")
+
+(defvar macerrorcount 0  "Put some documentation in here someday")
+
+(defvar *read-place-holder* (make-symbol "%.EOF")
+   "default value returned by read and read-line at end-of-file")
+
+;; DEFMACROS
+
+
+(defmacro absval (x)
+ `(abs ,x))
+
+#-:CCL
+(defmacro add1 (x)
+ `(1+ ,x))
+
+(defmacro assemble (&rest ignore) 
+ (declare (ignore ignore))
+  nil)
+
+(defmacro applx (&rest args)
+ `(apply ,@args))
+
+#-(or LispM Lucid :CCL)
+(defmacro assq (a b)
+ `(assoc ,a ,b :test #'eq))
+
+#+:CCL
+(defmacro assq (a b) `(atsoc ,a ,b))
+
+#-:CCL
+(defmacro bintp (n)
+ `(typep ,n 'bignum))
+#+:CCL
+(defun bintp (n) (and (integerp n) (not (fixp n))))
+
+(defmacro |char| (x)
+  (if (and (consp x) (eq (car x) 'quote)) (character (cadr x))
+    `(character ,x)))
+
+(defmacro closedfn (form)
+ `(function ,form))
+
+(defmacro |copyList| (x) 
+ `(copy-list ,x))
+
+(defmacro create-sbc (x) x)  ;a no-op for common lisp
+
+(defmacro cvecp (x)
+ `(stringp ,x))
+
+(defmacro dcq (&rest args)
+ (cons 'setqp args))
+
+#-:CCL
+(defmacro difference (&rest args)
+ `(- ,@args))
+
+(defmacro dsetq (&whole form pattern exp)
+ (dodsetq form pattern exp))
+
+(defmacro ecq (&rest args)
+ (cons 'eqq args))
+
+;;def needed to prevent recursion in def of eqcar
+(eval-when 
+ #+:common-lisp (:compile-toplevel :load-toplevel :execute)
+ #-:common-lisp (compile load eval)
+ (defun equable (x) 
+   (or (null x) 
+       (and (consp x) (eq (car x) 'quote) 
+	    (symbolp (cadr x))))))
+
+#-:CCL
+(defmacro eqcar (x y)
+ (let ((test
+        (cond
+         ((equable y) 'eq)
+	 ((integerp y) 'i=)
+	 ('eql))))
+  (if (atom x)
+   `(and (consp ,x) (,test (qcar ,x) ,y))
+    (let ((xx (gensym)))
+     `(let ((,xx ,x))
+       (and (consp ,xx) (,test (qcar ,xx) ,y)))))))
+
+(defmacro eqq (pattern exp)
+ `(,(ecqexp pattern nil) ,exp))
+
+(defmacro |equal| (x y)
+ `(equalp ,x ,y))
+
+(defmacro evalandfileactq (name &optional (form name))
+ `(eval-when (eval load) ,form))  
+
+(defmacro exit (&rest value)
+ `(return-from seq ,@value))
+
+(defmacro fetchchar (x i)
+ `(char ,x ,i))
+
+#-:CCL  ;; fixp in ccl tests for fixnum
+(defmacro fixp (x)
+ `(integerp ,x))
+
+#-:CCL
+(defmacro greaterp (&rest args)
+ `(> ,@args))
+
+(defmacro i= (x y) ;; integer equality
+  (if (typep y 'fixnum)
+      (let ((gx (gensym)))
+	`(let ((,gx ,x))
+	   (and (typep ,gx 'fixnum) (eql (the fixnum ,gx) ,y))))
+    (let ((gx (gensym)) (gy (gensym)))
+      `(let ((,gx ,x) (,gy ,y))
+	 (cond ((and (typep ,gx 'fixnum) (typep ,gy 'fixnum))
+		(eql (the fixnum ,gx) (the fixnum ,gy)))
+	       ((eql (the integer ,gx) (the integer,gy))))))))
+
+(defmacro |idChar?| (x)
+ `(or (alphanumericp ,x) (member ,x '(#\? #\% #\' #\!) :test #'char=)))
+ 
+(defmacro identp (x) 
+ (if (atom x)
+  `(and ,x (symbolp ,x))
+   (let ((xx (gensym)))
+    `(let ((,xx ,x))
+      (and ,xx (symbolp ,xx))))))
+
+(defmacro ifcar (x)
+  (if (atom x)
+      `(and (consp ,x) (qcar ,x))
+    (let ((xx (gensym)))
+      `(let ((,xx ,x))
+	 (and (consp ,xx) (qcar ,xx))))))
+
+(defmacro ifcdr (x)
+  (if (atom x)
+      `(and (consp ,x) (qcdr ,x))
+    (let ((xx (gensym)))
+      `(let ((,xx ,x))
+	 (and (consp ,xx) (qcdr ,xx))))))
+
+(defmacro intp (x)
+ `(integerp ,x))
+
+(defmacro lam (&rest body)
+ (list 'quote (*lam (copy-tree body))))
+
+(defmacro lastnode (l)
+ `(last ,l))
+
+(defmacro lastpair (l)
+ `(last ,l))
+
+#-:CCL
+(defmacro lessp (&rest args)
+ `(< ,@args))
+
+(defmacro lintp (n)
+ `(typep ,n 'bignum))
+
+(defmacro makestring (a) a)
+
+(defmacro mapelt (f vec)
+ `(map 'vector ,f ,vec))
+
+(defmacro maxindex (x)
+ `(the fixnum (1- (the fixnum (length ,x)))))
+
+#-(or LispM Lucid :CCL)
+(defmacro memq (a b)
+ `(member ,a ,b :test #'eq))
+
+#-:CCL
+(defmacro minus (x)
+ `(- ,x))
+
+(defmacro mrp (x)
+ `(special-form-p ,x))
+
+(defmacro namederrset (id iexp &rest item)
+ (declare (ignore item))
+  `(catch ,id ,iexp))
+
+(defmacro ne (a b) `(not (equal ,a ,b)))
+
+;;; This may need adjustment in CCL where NEQ means (NOT (EQUAL ..)))
+#-:CCL
+(defmacro neq (a b) `(not (eq ,a ,b)))
+
+#-:CCL
+(defmacro nreverse0 (x)
+  (if (atom x)
+      `(if (atom ,x) ,x (nreverse ,x))
+    (let ((xx (gensym)))
+      `(let ((,xx ,x))
+	 (if (atom ,xx) ,xx (nreverse ,xx))))))
+
+(defmacro nump (n)
+ `(numberp ,n))
+
+(defmacro |opOf| (x) ;(if (atom x) x (qcar x))
+  (if (atom x)
+      `(if (consp ,x) (qcar ,x) ,x)
+    (let ((xx (gensym)))
+      `(let ((,xx ,x))
+	 (if (consp ,xx) (qcar ,xx) ,xx)))))
+
+(defmacro oraddtempdefs (filearg)
+ `(eval-when (compile) (load ,filearg)))
+
+(defmacro pairp (x)
+ `(consp ,x)) 
+
+#-:CCL
+(defmacro plus (&rest args)
+ `(+ ,@ args))
+
+; (defmacro qassq (a b)
+;  `(assoc ,a ,b :test #'eq))
+(defmacro qassq (a b) `(assq ,a ,b))
+
+#-:CCL
+(defmacro qcar (x)
+ `(car (the cons ,x)))
+#-:CCL
+(defmacro qcdr (x)
+ `(cdr (the cons ,x)))
+
+#-:CCL
+(defmacro qcaar (x)
+ `(car (the cons (car (the cons ,x)))))
+#-:CCL
+(defmacro qcadr (x)
+ `(car (the cons (cdr (the cons ,x)))))
+#-:CCL
+(defmacro qcdar (x)
+ `(cdr (the cons (car (the cons ,x)))))
+#-:CCL
+(defmacro qcddr (x)
+ `(cdr (the cons (cdr (the cons ,x)))))
+
+(defmacro qcaaar (x)
+ `(car (the cons (car (the cons (car (the cons ,x)))))))
+(defmacro qcaadr (x)
+ `(car (the cons (car (the cons (cdr (the cons ,x)))))))
+(defmacro qcadar (x)
+ `(car (the cons (cdr (the cons (car (the cons ,x)))))))
+(defmacro qcaddr (x)
+ `(car (the cons (cdr (the cons (cdr (the cons ,x)))))))
+(defmacro qcdaar (x)
+ `(cdr (the cons (car (the cons (car (the cons ,x)))))))
+(defmacro qcdadr (x)
+ `(cdr (the cons (car (the cons (cdr (the cons ,x)))))))
+(defmacro qcddar (x)
+ `(cdr (the cons (cdr (the cons (car (the cons ,x)))))))
+(defmacro qcdddr (x)
+ `(cdr (the cons (cdr (the cons (cdr (the cons ,x)))))))
+
+(defmacro qcaaaar (x)
+ `(car (the cons (car (the cons (car (the cons (car (the cons ,x)))))))))
+(defmacro qcaaadr (x)
+ `(car (the cons (car (the cons (car (the cons (cdr (the cons ,x)))))))))
+(defmacro qcaadar (x)
+ `(car (the cons (car (the cons (cdr (the cons (car (the cons ,x)))))))))
+(defmacro qcaaddr (x)
+ `(car (the cons (car (the cons (cdr (the cons (cdr (the cons ,x)))))))))
+(defmacro qcadaar (x)
+ `(car (the cons (cdr (the cons (car (the cons (car (the cons ,x)))))))))
+(defmacro qcadadr (x)
+ `(car (the cons (cdr (the cons (car (the cons (cdr (the cons ,x)))))))))
+(defmacro qcaddar (x)
+ `(car (the cons (cdr (the cons (cdr (the cons (car (the cons ,x)))))))))
+(defmacro qcadddr (x)
+ `(car (the cons (cdr (the cons (cdr (the cons (cdr (the cons ,x)))))))))
+(defmacro qcdaaar (x)
+ `(cdr (the cons (car (the cons (car (the cons (car (the cons ,x)))))))))
+(defmacro qcdaadr (x)
+ `(cdr (the cons (car (the cons (car (the cons (cdr (the cons ,x)))))))))
+(defmacro qcdadar (x)
+ `(cdr (the cons (car (the cons (cdr (the cons (car (the cons ,x)))))))))
+(defmacro qcdaddr (x)
+ `(cdr (the cons (car (the cons (cdr (the cons (cdr (the cons ,x)))))))))
+(defmacro qcddaar (x)
+ `(cdr (the cons (cdr (the cons (car (the cons (car (the cons ,x)))))))))
+(defmacro qcddadr (x)
+ `(cdr (the cons (cdr (the cons (car (the cons (cdr (the cons ,x)))))))))
+(defmacro qcdddar (x)
+ `(cdr (the cons (cdr (the cons (cdr (the cons (car (the cons ,x)))))))))
+(defmacro qcddddr (x)
+ `(cdr (the cons (cdr (the cons (cdr (the cons (cdr (the cons ,x)))))))))
+
+(defmacro qcsize (x)
+ `(the fixnum (length (the simple-string ,x))))
+
+(defmacro qeqq (pattern exp)
+ `(,(ecqexp pattern 1) ,exp))
+
+(defmacro qlength (a)
+ `(length ,a))
+
+; (defmacro qmemq (a b)
+; `(member ,a ,b :test #'eq))
+(defmacro qmemq (a b) `(memq ,a ,b))
+
+(defmacro qrefelt (vec ind)
+ `(svref ,vec ,ind))
+
+(defmacro qrplaca (a b)
+ `(rplaca (the cons ,a) ,b))
+
+(defmacro qrplacd (a b)
+ `(rplacd (the cons ,a) ,b))
+
+(defmacro qrplq (&whole form pattern exp)
+ (if (or (consp pattern) (simple-vector-p pattern))
+  `(,(rcqexp pattern) ,exp)
+   (macro-invalidargs 'qrplq form "form must be updateable.")))
+
+(defmacro qsadd1 (x)
+ `(the fixnum (1+ (the fixnum ,x))))
+
+(defmacro qsdec1 (x)
+ `(the fixnum (1- (the fixnum ,x))))
+
+(defmacro qsdifference (x y)
+ `(the fixnum (- (the fixnum ,x) (the fixnum ,y))))
+
+(defmacro qsetq (&whole form pattern exp)
+ (declare (ignore form))
+  `(,(dcqexp pattern '=) ,exp))
+
+(defmacro qsetrefv (vec ind val)
+ `(setf (svref ,vec (the fixnum ,ind)) ,val))
+
+(defmacro qsetvelt (vec ind val)
+ `(setf (svref ,vec (the fixnum ,ind)) ,val))
+
+(defmacro qsetvelt-1 (vec ind val)
+ `(setf (svref ,vec (the fixnum (1- (the fixnum ,ind)))) ,val))
+
+(defmacro qsgreaterp (a b)
+ `(> (the fixnum ,a) (the fixnum ,b)))
+
+(defmacro qsinc1 (x)
+ `(the fixnum (1+ (the fixnum ,x))))
+
+(defmacro qsleftshift (a b)
+ `(the fixnum (ash (the fixnum ,a) (the fixnum ,b))))
+
+(defmacro qslessp (a b)
+ `(< (the fixnum ,a) (the fixnum ,b)))
+
+(defmacro qsmax (x y)
+ `(the fixnum (max (the fixnum ,x) (the fixnum ,y))))
+
+(defmacro qsmin (x y)
+ `(the fixnum (min (the fixnum ,x) (the fixnum ,y))))
+
+(defmacro qsminus (x)
+ `(the fixnum (minus (the fixnum ,x))))
+
+(defmacro qsminusp (x)
+ `(minusp (the fixnum ,x)))
+
+(defmacro qsoddp (x)
+ `(oddp (the fixnum ,x)))
+
+(defmacro qsabsval (x)
+  `(the fixnum (abs (the fixnum ,x))))
+
+(defmacro qsplus (x y)
+ `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
+
+(defmacro qssub1 (x)
+ `(the fixnum (1- (the fixnum ,x))))
+
+(defmacro qstimes (x y)
+ `(the fixnum (* (the fixnum ,x) (the fixnum ,y))))
+
+(defmacro qstringlength (x)
+ `(the fixnum (length (the simple-string ,x))))
+
+(defmacro qszerop (x)
+ `(zerop (the fixnum ,x)))
+
+(defmacro qvelt (vec ind)
+ `(svref ,vec (the fixnum ,ind)))
+
+(defmacro qvelt-1 (vec ind)
+ `(svref ,vec (the fixnum (1- (the fixnum ,ind)))))
+
+(defmacro qvmaxindex (x)
+ `(the fixnum (1- (the fixnum (length (the simple-vector ,x))))))
+
+(defmacro qvsize (x)
+ `(the fixnum (length (the simple-vector ,x))))
+
+; #-:CCL
+; (defmacro refvecp (v)
+;  `(typep ,v '(vector t)))
+; #+:CCL
+; (defun refvecp (v) (and (vectorp v) (not (stringp v))))
+(defmacro refvecp (v) `(simple-vector-p ,v))
+
+(defmacro resetq (a b)
+ `(prog1 ,a (setq ,a ,b)))
+
+(defmacro rnump (n)
+ `(floatp ,n))
+
+(defmacro rplq (&whole form exp pattern)
+ (if (or (consp pattern) (simple-vector-p pattern))
+  `(,(rcqexp pattern) ,exp)
+   (macro-invalidargs 'rplq form "form must be updateable.")))
+
+(defmacro rvecp (v)
+ `(typep ,v '(vector float)))
+
+(defmacro setandfileq (id item)
+ `(eval-when (eval load) 
+   (setq ,id ,item)
+   (lam\,fileactq ',id (list 'setq ',id (list 'quote ,id)))))
+
+#-:CCL
+(defmacro setelt (vec ind val)
+ `(setf (elt ,vec ,ind) ,val))
+
+(defmacro setqp (&whole form pattern exp)
+ (declare (ignore form))
+  `(,(dcqexp pattern '=) ,exp))
+
+(defmacro seq (&rest form)
+  (let* ((body (reverse form))
+         (val `(return-from seq ,(pop body))))
+    (nsubstitute '(progn) nil body) ;don't treat NIL as a label
+    `(block seq (tagbody ,@(nreverse body) ,val))))
+
+(defmacro sfp (x)
+ `(special-form-p ,x))
+
+#-:CCL
+(defmacro sintp (n)
+ `(typep ,n 'fixnum))
+#+:CCL
+(defmacro sintp (n)
+  `(fixp ,n))
+
+#-:CCL
+(defmacro smintp (n)
+ `(typep ,n 'fixnum))
+#+:CCL
+(defmacro smintp (n)
+  `(fixp ,n))
+
+(defmacro |startsId?| (x)
+ `(or (alpha-char-p ,x) (member ,x '(#\? #\% #\!) :test #'char=)))
+
+(defmacro stringlength (x)
+ `(length (the string ,x)))
+
+(defmacro subrp (x)
+ `(compiled-function-p ,x))
+
+#-:CCL
+(defmacro sub1 (x)
+ `(1- ,x))
+
+(defmacro throw-protect (exp1 exp2)
+ `(unwind-protect ,exp1 ,exp2))
+
+#-:CCL
+(defmacro times (&rest args)
+ `(* ,@args))
+
+(defmacro vec-setelt (vec ind val)
+ `(setf (svref ,vec ,ind) ,val))
+
+; #-:CCL
+; (defmacro vecp (v)
+;  `(typep ,v '(vector t)))
+; #+:CCL
+; (defun vecp (v) (and (vectorp v) (not (stringp v))))
+(defmacro vecp (v) `(simple-vector-p ,v))
+
+#-:CCL
+(defmacro zero? (x)
+  `(and (typep ,x 'fixnum) (zerop (the fixnum ,x))))
+#+:CCL
+(defmacro zero? (x) `(zerop ,x))
+
+;; defuns
+
+#-(or :CCL (and :Lucid (not :rios)))
+(defun define-function (f v)
+ (setf (symbol-function f) v))
+#+:CCL
+(defun define-function (f v)
+ (setf (symbol-function f) v)
+ (setf (get f 's:newname) v))
+
+(define-function 'tempus-fugit #'get-internal-run-time)
+
+(defun $TOTAL-ELAPSED-TIME ()
+   (list (get-internal-run-time) (get-internal-real-time)))
+
+#-(OR IBCL KCL :CMULISP :CCL)
+(defun $TOTAL-GC-TIME () (list 0 0))
+
+#+:CCL
+(defun $TOTAL-GC-TIME () (list (gctime) (gctime)))
+
+#+IBCL
+(defun $TOTAL-GC-TIME (&aux (gcruntime (system:gbc-time-report)))
+  (list gcruntime gcruntime))
+
+#+KCL
+(defun $TOTAL-GC-TIME (&aux (gcruntime (system:gbc-time)))
+  (if (minusp gcruntime)
+      (setq gcruntime (system:gbc-time 0)))
+  (list gcruntime gcruntime))
+
+;;; note: this requires the 11/9/89 gc patch in code/lisp/daly/misc.lisp
+#+:cmulisp
+(defun $TOTAL-GC-TIME ()
+ (declare (special ext::*gc-runtime* ext::*gc-walltime*))
+ (list ext::*gc-runtime* ext::*gc-walltime*))
+
+; 7.0 Macros
+
+; 7.2 Creating Macro Expressions
+
+; 5.2 Functions
+
+; 5.2.2 Lambda Expressions
+
+(defun *LAM (body)
+  (cond  ((NOT (ISQUOTEDP (first BODY))) (cons 'LAMBDA BODY))
+         ((LET* ((BV (DEQUOTE (first BODY)))
+                 (CONTROL (QUOTESOF (first BODY)))
+                 (BODY (cdr BODY))
+                 (ARGS (GENSYM))
+                 (INNER-FUNC (or *lam-name* (gentemp))))
+            (COMP370 (LIST INNER-FUNC `(LAMBDA ,BV . ,BODY)))
+            `(MLAMBDA ,ARGS
+                      (CONS (QUOTE ,INNER-FUNC)
+                            (WRAP (cdr ,ARGS) ',CONTROL)))))))
+
+(defun WRAP (LIST-OF-ITEMS WRAPPER)
+ (prog nil
+  (COND ((OR (NOT (PAIRP LIST-OF-ITEMS)) (not WRAPPER))
+         (RETURN LIST-OF-ITEMS))
+        ((NOT (consp WRAPPER))
+         (SETQ WRAPPER (LOTSOF WRAPPER))))
+  (RETURN
+    (CONS (if (first WRAPPER)
+              `(,(first WRAPPER) ,(first LIST-OF-ITEMS))
+              (first LIST-OF-ITEMS))
+          (WRAP (cdr LIST-OF-ITEMS) (cdr WRAPPER))))))
+
+(defun ISQUOTEDP (bv)
+  (COND ((NOT (consp BV)) NIL)
+        ((EQ (first BV) 'QUOTE))
+        ((AND (consp (first BV)) (EQ (QCAAR BV) 'QUOTE)))
+        ((ISQUOTEDP (cdr BV)))))
+
+(defun QUOTESOF (BV)
+  (COND ((NOT (consp BV)) NIL)
+      ((EQ (first BV) 'QUOTE) 'QUOTE)
+      ((CONS (COND ((NOT (consp (first BV))) nil)
+                   ((EQ (QCAAR BV) 'QUOTE) 'QUOTE)
+                   (T NIL))
+             (QUOTESOF (cdr BV))))))
+
+(defun DEQUOTE (BV)
+  (COND ((NOT (consp BV)) BV)
+        ((EQ 'QUOTE (first BV)) (second BV))
+        ((CONS (if (EQ 'QUOTE (IFCAR (CAR BV))) (CADAR BV) (first BV))
+               (DEQUOTE (cdr BV))))))
+
+(defun lotsof (&rest items)
+  (setq items (copy-list items))
+  (nconc items items))
+
+; 7.4 Using Macros
+
+; Beats me how to simulate macro expansion "in the environment of sd"...:
+
+(defun MDEF (arg item &optional sd)
+ (declare (ignore sd))
+  (macroexpand `(,arg ,item)))
+
+(define-function 'MDEFX #'MDEF)
+
+; 8.0 Operator Definition and Transformation
+
+; 8.1 Definition and Transformation Operations
+
+(defun COMP370 (fnlist)
+  (cond ((atom (car fnlist)) (list (COMPILE1 fnlist)))
+        (t (MAPCAR #'(lambda (x) (COMPILE1 x)) fnlist))))
+
+#+:CCL (proclaim '(special *vars* *decl*)) ;; declare not handled right
+
+(defun COMPILE1 (fn)
+  (let* (nargs
+         (fname (car fn))
+         (lamda (cadr fn))
+         (ltype (car lamda))
+         *vars* *decl* args
+         (body (cddr lamda)))
+    (declare (special *vars* *decl*))
+    (if (eq ltype 'LAM)
+        (let ((*lam-name* (intern (concat fname "\,LAM"))))
+          (setq lamda (eval lamda) ltype (car lamda) body (cddr lamda))))
+    (let ((dectest (car body)))
+      (if (and (eqcar dectest 'declare) (eqcar (cadr dectest) 'special))
+	  (setq *decl* (cdr (cadr dectest)) body (cdr body))))
+    (setq args (remove-fluids (cadr lamda)))
+    (cond ((and (eq ltype 'lambda) (simple-arglist args)) (setq nargs args))
+          (t (setq nargs (gensym))
+     #+LispM (setq body `((dsetq ,args (copy-list ,nargs)) ,@body))
+     #-LispM (setq body `((dsetq ,args  ,nargs) ,@body))
+             (cond ((eq ltype 'lambda) (setq nargs `(&rest ,nargs &aux ,@*vars*)))
+                   ((eq ltype 'mlambda)
+                    (setq nargs `(&whole ,nargs &rest ,(gensym) &aux ,@*vars*)))
+                   (t (error "bad function type")))))
+    (cond (*decl* (setq body (cons `(declare (special ,@ *decl*)) body))))
+    (setq body
+          (cond ((eq ltype 'lambda) `(defun ,fname ,nargs . ,body))
+                ((eq ltype 'mlambda) `(defmacro ,fname ,nargs . ,body))))
+    (if *COMP370-APPLY* (funcall *COMP370-APPLY* fname body))
+
+    body))
+
+(defun simple-arglist (arglist)
+  (or (null arglist)
+      (and (consp arglist) (null (cdr (last arglist)))
+           (every #'symbolp arglist))))
+
+(defun remove-fluids (arglist &aux f v) ;updates specials *decl* and *vars*
+  (declare (special *decl* *vars*))
+   (cond ((null arglist) arglist)
+         ((symbolp arglist) (push arglist *vars*) arglist)
+                ;if atom but not symbol, ignore value
+         ((atom arglist) (push (setq arglist (gentemp)) *vars*) arglist)
+         ((and (setq f (car arglist))
+               (eq f 'fluid)
+               (listp (cdr arglist))
+               (setq v (cadr arglist))
+               (identp v)
+               (null (cddr arglist)))
+          (push v *decl*)
+          (push v *vars*)
+          v)
+         (t (cons (remove-fluids (car arglist))
+                  (remove-fluids (cdr arglist))))))
+
+(define-function 'KOMPILE #'COMP370)
+
+; 9.4 Vectors and Bpis
+
+(defun IVECP (x) (and (vectorp x) (subtypep (array-element-type x) 'integer)))
+
+(defun mbpip (item) (and (symbolp item) ;cannot know a compiled macro in CLISP
+                         (compiled-function-p (macro-function item))))
+
+(defun FBPIP (item) (or (compiled-function-p item)
+			(and (symbolp item) (fboundp item)
+			     (not (macro-function item))
+			     (compiled-function-p (symbol-function item)))))
+
+; 9.5 Identifiers
+
+#-:CCL
+(defun gensymp (x) (and (symbolp x) (null (symbol-package x))))
+
+(defun digitp (x)
+  (or (and (symbolp x) (digitp (symbol-name x)))
+      (and (characterp x) (digit-char-p x))
+      (and (stringp x) (= (length x) 1) (digit-char-p (char x 0)))))
+
+(defun dig2fix (x)
+  (if (symbolp x)
+    (digit-char-p (char (symbol-name x) 0))
+    (digit-char-p x)))
+
+#-:CCL
+(defun LN (x) (LOG x))
+#-:CCL
+(defun LOG2 (x) (LOG x 2.0))
+(defun |log| (x) (LOG x 10.0))
+
+; 9.13 Streams
+
+#+Lucid
+(defun IS-CONSOLE (stream)
+    (and (streamp stream)
+         (or (not (consp (pathname-directory stream)))
+             (equal (qcar (pathname-directory stream)) "dev")
+	     (null (pathname-name stream) ))))
+
+#+KCL
+(defun IS-CONSOLE (stream)
+  (and (streamp stream) (output-stream-p stream)
+       (eq (system:fp-output-stream stream)
+           (system:fp-output-stream *terminal-io*))))
+
+#-(OR Lucid KCL :CCL)
+(defun IS-CONSOLE (stream) (EQ stream *terminal-io*))
+
+; 10.0 Control Structures
+
+; 10.8.4 Auxiliary Operators
+
+(defun nilfn (&rest ignore)
+ (declare (ignore ignore)) 
+ ())
+
+; 11.0 Operations on Identifiers
+
+; 11.1 Creation
+
+(defun upcase (l)
+  (cond ((stringp l) (string-upcase l))
+        ((identp l) (intern (string-upcase (symbol-name l))))
+        ((characterp l) (char-upcase l))
+        ((atom l) l)
+        (t (mapcar #'upcase l))))
+
+(define-function 'U-CASE #'upcase)
+(define-function 'LC2UC #'upcase)
+
+(defun downcase (l)
+  (cond ((stringp l) (string-downcase l))
+        ((identp l) (intern (string-downcase (symbol-name l))))
+        ((characterp l) (char-downcase L))
+        ((atom l) l)
+        (t (mapcar #'downcase l))))
+
+(define-function 'L-CASE #'downcase)
+
+; 11.2 Accessing
+
+;; note it is important that PNAME returns nil not an error for non-symbols
+(defun pname (x)
+  (cond ((symbolp x) (symbol-name x))
+	((characterp x) (string x))
+	(t nil)))
+
+;; property lists in vmlisp are alists
+(defun PROPLIST (x)
+  (if (symbolp x)
+#-:CCL
+   (plist2alist (symbol-plist x))
+#+:CCL
+   (plist2alist (plist x))
+    nil))
+
+(defun plist2alist (x)
+  (if (null x) 
+      nil
+      (cons (cons (first x) (second x)) (plist2alist (cddr x)))))
+
+#-:CCL
+(defun put (sym ind val) (setf (get sym ind) val))
+
+(define-function 'MAKEPROP #'put)
+
+; 12.0 Operations on Numbers
+
+; 12.1 Conversion
+
+(define-function 'FIX #'truncate)
+(define-function 'INT2RNUM #'float)
+
+; 12.2 Predicates
+
+;(define-function 'lessp #'<)
+
+;(define-function 'greaterp #'>)
+
+
+;(define-function 'fixp #'integerp)
+
+; 12.3 Computation
+
+;(define-function 'add1 #'1+)
+;(define-function 'sub1 #'1-)
+;(define-function 'plus #'+)
+;(define-function 'times #'*)
+;(define-function 'difference #'-)
+;(define-function 'minus #'-)
+;(define-function 'absval #'abs)
+
+#-:CCL
+(defun QUOTIENT (x y)
+  (cond ((or (floatp x) (floatp y)) (lisp:/ x y))
+        (t (truncate x y))))
+#+:CCL
+(defun QUOTIENT (x y)
+  (cond ((or (floatp x) (floatp y)) (/ x y))
+        (t (truncate x y))))
+
+(define-function 'vm/ #'quotient)
+
+#-:CCL
+(defun REMAINDER (x y)
+  (if (and (integerp x) (integerp y))
+      (rem x y)
+      (- x (* y (QUOTIENT x y)))))
+
+#-:CCL
+(defun DIVIDE (x y)
+  (if (and (integerp x) (integerp y))
+      (multiple-value-list (truncate x y))
+      (list (QUOTIENT x y) (REMAINDER x y))))
+
+(defun QSQUOTIENT (a b) (the fixnum (truncate (the fixnum a) (the fixnum b))))
+
+(defun QSREMAINDER (a b) (the fixnum (rem (the fixnum a) (the fixnum b))))
+
+
+;(defun IFCAR (x) (if (consp x) (car (the cons x))))
+
+;(defun IFCDR (x) (if (consp x) (cdr (the cons x))))
+
+; 13.3 Updating
+
+
+(defun RPLPAIR (pair1 pair2)
+  (RPLACA pair1 (CAR pair2))
+  (RPLACD pair1 (CDR pair2)) pair1)
+
+(defun RPLNODE (pair1 ca2 cd2)
+ (RPLACA pair1 ca2) 
+ (RPLACD pair1 cd2) pair1)
+
+; 14.0 Operations on Lists
+
+; 14.1 Creation
+
+(defun VEC2LIST (vec) (coerce vec 'list))
+
+; note default test for union, intersection and set-difference is eql
+;; following are defined so as to preserve ordering in union.lisp
+;;(defun SETDIFFERENCE (l1 l2) (set-difference l1 l2 :test #'equalp))
+;;(defun SETDIFFERENCEQ (l1 l2) (set-difference l1 l2 :test #'eq))
+;;(defun |union| (l1 l2) (union l1 l2 :test #'equalp))
+;;(defun UNIONQ (l1 l2) (union l1 l2 :test #'eq))
+;;(defun |intersection| (l1 l2) (intersection l1 l2 :test #'equalp))
+;;(defun INTERSECTIONQ (l1 l2) (intersection l1 l2 :test #'eq))
+(defun |member| (item sequence)
+   (cond ((symbolp item) (member item sequence :test #'eq))
+	 ((stringp item) (member item sequence :test #'equal))
+	 ((and (atom item) (not (arrayp item))) (member item sequence))
+	 (T (member item sequence :test #'equalp))))
+
+(defun |remove| (list item &optional (count 1))
+  (if (integerp count)
+      (remove item list :count count :test #'equalp)
+      (remove item list :test #'equalp)))
+
+(defun REMOVEQ (list item &optional (count 1))
+  (if (integerp count)
+      (remove item list :count count :test #'eq)
+      (remove item list :test #'eq)))
+
+; 14.2 Accessing
+
+;(define-function 'lastnode #'last)
+;(define-function 'lastpair #'last)
+(defun |last| (x) (car (lastpair x)))
+
+; 14.3 Searching
+
+#+:CCL (DEFMACRO |assoc| (X Y) `(ASSOC** ,X ,Y))
+#-:CCL
+(DEFUN |assoc| (X Y)
+  "Return the pair associated with key X in association list Y."
+  ; ignores non-nil list terminators
+  ; ignores non-pair a-list entries
+  (cond ((symbolp X)
+	 (PROG NIL
+	       A  (COND ((ATOM Y) (RETURN NIL))
+			((NOT (consp (CAR Y))) )
+			((EQ (CAAR Y) X) (RETURN (CAR Y))) )
+	       (SETQ Y (CDR Y))
+	       (GO A)))
+	((or (numberp x) (characterp x))
+	 (PROG NIL
+	       A  (COND ((ATOM Y) (RETURN NIL))
+			((NOT (consp (CAR Y))) )
+			((EQL (CAAR Y) X) (RETURN (CAR Y))) )
+	       (SETQ Y (CDR Y))
+	       (GO A)))
+	(t
+	 (PROG NIL
+	       A  (COND ((ATOM Y) (RETURN NIL))
+			((NOT (consp (CAR Y))) )
+			((EQUAL (CAAR Y) X) (RETURN (CAR Y))) )
+	       (SETQ Y (CDR Y))
+	       (GO A)))))
+; 14.5 Updating
+
+(defun NREMOVE (list item &optional (count 1))
+  (if (integerp count)
+      (delete item list :count count :test #'equal)
+      (delete item list :test #'equal)))
+
+(defun NREMOVEQ (list item &optional (count 1))
+  (if (integerp count)
+      (delete item list :count count )
+      (delete item list )))
+
+(defun EFFACE (item list) (delete item list :count 1 :test #'equal))
+
+(defun NCONC2 (x y) (NCONC x y)) ;NCONC with exactly two arguments
+
+; 14.6 Miscellaneous
+
+(defun QSORT (l)
+ (declare (special sortgreaterp))
+  (NREVERSE (sort (copy-seq l) SORTGREATERP)))
+
+(defun SORTBY (keyfn l)
+ (declare (special sortgreaterp))
+  (nreverse (sort (copy-seq l) SORTGREATERP :key keyfn)))
+
+; 16.0 Operations on Vectors
+
+; 16.1 Creation
+
+(defun MAKE-VEC (n) (make-array n))
+
+(define-function 'GETREFV #'make-array)
+
+@
+Waldek Hebisch points out that, in the expression:
+\begin{verbatim}
+  reduce(+,[1.0/i for i in 1..20000])
+\end{verbatim}
+a significant amount of the time is spent in this function.
+A special case was added to significantly reduce the execution time.
+This was a problem in GCL as of 2.6.8pre and may be fixed in future
+releases. If it is fixed then the original definition, which was
+\begin{verbatim}
+(defun LIST2VEC (list) (coerce list 'vector))
+\end{verbatim}
+can be restored.
+<<*>>=
+(defun LIST2VEC (list)
+ (if (consp list)
+  (let* ((len (length list))
+         (vec (make-array len)))
+    (dotimes (i len)
+     (setf (aref vec i) (pop list)))
+    vec)
+  (coerce list 'vector)))
+
+(define-function 'LIST2REFVEC #'LIST2VEC)
+
+; 16.2 Accessing
+
+
+;(define-function 'FETCHCHAR #'char)
+
+;; Oddly, LENGTH is more efficient than LIST-LENGTH in CCL, since the former
+;; is compiled and the latter is byte-coded!
+(defun size (l) 
+  (cond ((vectorp l) (length l))
+#+:CCL  ((stringp l) (length l)) ;; Until ACN fixes his lisp -> C translator.
+#-:CCL  ((consp l)   (list-length l))
+#+:CCL  ((consp l)   (length l))
+	(t           0)))
+
+(define-function 'MOVEVEC #'replace)
+
+; 17.0 Operations on Character and Bit Vectors
+
+(defun charp (a) (or (characterp a)
+                     (and (identp a) (= (length (symbol-name a)) 1))))
+
+(defun NUM2CHAR (n) (code-char n))
+
+(defun CHAR2NUM (c) (char-code (character c)))
+
+(defun CGREATERP (s1 s2) (string> (string s1) (string s2)))
+
+(define-function 'STRGREATERP #'CGREATERP)
+
+; 17.1 Creation
+
+
+#-AKCL
+(defun concat (a b &rest l)
+   (let ((type (cond ((bit-vector-p a) 'bit-vector) (t 'string))))
+      (cond ((eq type 'string)
+	     (setq a (string a) b (string b))
+             (if l (setq l (mapcar #'string l)))))
+      (if l (apply #'concatenate type a b l)
+	(concatenate type a b))) )
+#+AKCL
+(defun concat (a b &rest l)
+  (if (bit-vector-p a)
+      (if l (apply #'concatenate 'bit-vector a b l)
+	(concatenate 'bit-vector a b))
+    (if l (apply #'system:string-concatenate a b l)
+      (system:string-concatenate a b))))
+
+(define-function 'strconc #'concat)
+
+(defun make-cvec (sint) (make-array sint :fill-pointer 0 :element-type 'character))
+
+;(define-function 'CVECP #'stringp)
+
+(define-function 'getstr #'make-cvec)
+
+(defun make-full-cvec (sint &optional (char #\space))
+  (make-string sint :initial-element (character char)))
+
+(define-function 'getfullstr #'make-full-cvec)
+
+; 17.2 Accessing
+
+(defun QENUM (cvec ind) (char-code (char cvec ind)))
+
+(defun QESET (cvec ind charnum)
+  (setf (char cvec ind) (code-char charnum)))
+
+(defun string2id-n (cvec sint)
+  (if (< sint 1)
+      nil
+      (let ((start (position-if-not #'(lambda (x) (char= x #\Space)) cvec)))
+        (if start
+            (let ((end (or (position #\Space cvec :start start) (length cvec))))
+              (if (= sint 1)
+                  (intern (subseq cvec start end))
+                  (string2id-n (subseq cvec end) (1- sint))))
+            0))))
+
+(defun substring (cvec start length)
+  (setq cvec (string cvec))
+  (if length (subseq cvec start (+ start length)) (subseq cvec start)))
+
+; 17.3 Searching
+
+;;- (defun strpos (what in start dontcare)
+;;-    (setq what (string what) in (string in))
+;;-    (if dontcare (progn (setq dontcare (character dontcare))
+;;- 		       (search what in :start2 start
+;;- 			       :test #'(lambda (x y) (or (eql x dontcare)
+;;- 							 (eql x y)))))
+;;-                 (search what in :start2 start)))
+
+(defun strpos (what in start dontcare)
+   (setq what (string what) in (string in))
+   (if dontcare (progn (setq dontcare (character dontcare))
+		       (search what in :start2 start
+			       :test #'(lambda (x y) (or (eql x dontcare)
+							 (eql x y)))))
+                (if (= start 0)
+                   (search what in)
+                   (search what in :start2 start))
+   ))
+
+; In the following, table should be a string:
+
+(defun strposl (table cvec sint item)
+  (setq cvec (string cvec))
+  (if (not item)
+      (position table cvec :test #'(lambda (x y) (position y x)) :start sint)
+      (position table cvec :test-not #'(lambda (x y) (position y x)) :start sint)))
+
+; 17.4 Updating operators
+
+(defun suffix (id cvec)
+  "Suffixes the first char of the symbol or char ID to the string CVEC,
+    changing CVEC."
+  (unless (characterp id) (setq id (elt (string id) 0)))
+  (cond ((array-has-fill-pointer-p cvec)
+	 (vector-push-extend id cvec)
+	 cvec)
+	((adjustable-array-p cvec)
+	 (let ((l (length cvec)))
+	   (adjust-array cvec (1+ l))
+	   (setf (elt cvec l) id)
+	   cvec))
+	(t (concat cvec id))))
+
+(defun setsize (vector size) (adjust-array vector size))
+
+(define-function 'changelength #'setsize)
+
+(defun trimstring (x) x)
+
+;;-- (defun rplacstr (cvec1 start1 length1 cvec2
+;;--                        &optional (start2 0) (length2 nil)
+;;--                        &aux end1 end2)
+;;--   (setq cvec2 (string cvec2))
+;;--   (if (null start1) (setq start1 0))
+;;--   (if (null start2) (setq start2 0))
+;;--   (if (null length1) (setq length1 (- (length cvec1) start1)))
+;;--   (if (null length2) (setq length2 (- (length cvec2) start2)))
+;;--   (if (numberp length1) (setq end1 (+ start1 length1)))
+;;--   (if (numberp length2) (setq end2 (+ start2 length2)))
+;;--   (if (/= length1 length2)
+;;--       (concatenate 'string (subseq cvec1 0 start1)
+;;--                            (subseq cvec2 start2 end2)
+;;--                            (subseq cvec1 end1))
+;;--       (replace cvec1 cvec2 :start1 start1 :end1 end1
+;;--              :start2 start2 :end2 end2)))
+
+; The following version has been provided to avoid reliance on the
+; Common Lisp concatenate and replace functions. These built-in Lisp
+; functions would probably end up doing the character-by-character
+; copying shown here, but would also need to cope with generic sorts
+; of sequences and unwarranted keyword generality
+
+(defun rplacstr (cvec1 start1 length1 cvec2
+                       &optional start2 length2
+                       &aux end1 end2)
+  (setq cvec2 (string cvec2))
+  (if (null start1) (setq start1 0))
+  (if (null start2) (setq start2 0))
+  (if (null length1) (setq length1 (- (length cvec1) start1)))
+  (if (null length2) (setq length2 (- (length cvec2) start2)))
+  (setq end1 (+ start1 length1))
+  (setq end2 (+ start2 length2))
+  (if (= length1 length2)
+      (do ()
+          ((= start1 end1) cvec1)
+          (setf (aref cvec1 start1) (aref cvec2 start2))
+          (setq start1 (1+ start1))
+          (setq start2 (1+ start2)))
+      (let* ((l1 (length cvec1))
+#+:CCL       (r (lisp::make-simple-string (- (+ l1 length2) length1)))
+#-:CCL       (r (lisp::make-string (- (+ l1 length2) length1)))
+             (i 0))
+         (do ((j 0 (1+ j)))
+             ((= j start1))
+             (setf (aref r i) (aref cvec1 j))
+             (setq i (1+ i)))
+         (do ((j start2 (1+ j)))
+             ((= j end2))
+             (setf (aref r i) (aref cvec2 j))
+             (setq i (1+ i)))
+         (do ((j end1 (1+ j)))
+             ((= j l1))
+             (setf (aref r i) (aref cvec1 j))
+             (setq i (1+ i)))
+         r)
+  ))
+
+; 19.0 Operations on Arbitrary Objects
+
+; 19.1 Creating
+
+(defun MSUBST (new old tree) (subst new old tree :test #'equal))
+; note subst isn't guaranteed to copy
+(defun |nsubst| (new old tree) (nsubst new old tree :test #'equal))
+(define-function 'MSUBSTQ #'subst) ;default test is eql
+(define-function 'SUBSTQ #'SUBST) ;default test is eql subst is not guaranteed to copy
+
+(defun copy (x) (copy-tree x)) ; not right since should descend vectors
+
+(defun eqsubstlist (new old list) (sublis (mapcar #'cons old new) list))
+
+; Gen code for SETQP expr
+
+(eval-when (compile load eval)
+ (defun DCQEXP (FORM EQTAG)
+  (PROG (SV pvl avl CODE)
+        (declare (special pvl avl))
+        (setq SV (GENSYM))
+        (setq CODE (DCQGENEXP SV FORM EQTAG NIL))
+        (RETURN
+          `(LAMBDA (,sv)
+             (PROG ,pvl
+                   ,@code
+                   (RETURN 'true)
+                BAD (RETURN NIL) ) ))))
+)
+; Generate Expr code for DCQ
+(eval-when (compile load eval)
+ (defun DCQGENEXP (SV FORM EQTAG QFLAG)
+  (PROG (D A I L C W)
+        (declare (special pvl avl))
+    (COND ((EQ FORM SV) (RETURN NIL))
+          ((IDENTP FORM) (RETURN `((setq ,form ,sv)) ))
+          ((simple-vector-p FORM)
+           (RETURN (SEQ
+             (setq L (length FORM))
+             (IF (EQ L 0)
+                 (RETURN (COND ((NULL QFLAG)
+                                `((cond ((not (simple-vector-p ,sv)) (go bad))))))))
+             (setq I (1- L))
+         LP  (setq A (elt FORM I))
+             (COND ((AND (NULL W) (OR (consp A) (simple-vector-p A)))
+                    (COND ((consp AVL) (setq W (car (RESETQ AVL (cdr AVL)))))
+                          ((setq PVL (CONS (setq W (GENSYM)) PVL))))))
+             (setq C (NCONC (COND ((IDENTP A) `((setq ,a (ELT ,sv ,i))))
+                                  ((OR (consp A) (simple-vector-p A))
+                                   `((setq ,w (ELT ,sv ,i))
+                                     ,@(dcqgenexp w a eqtag qflag))))
+                            C))
+             (if (EQ I 0) (GO RET))
+             (setq I (1- I))
+             (GO LP)
+         RET (if W (setq AVL (CONS W AVL)))
+             (COND ((NULL QFLAG)
+                    `((COND ((OR (NOT (simple-vector-p ,sv)) (< (length ,sv) ,l))
+                             (GO BAD)))
+                      ,@c))
+                   ('T C)))))
+          ((NOT (consp FORM)) (RETURN NIL))
+          ((AND EQTAG (EQ (car FORM) EQTAG))
+           (RETURN
+             (COND
+               ((OR (NOT (EQ 3 (LENGTH FORM))) (NOT (IDENTP (car (setq FORM (cdr FORM))))))
+                (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM (MAKESTRING "invalid pattern.")))
+               (`((setq ,(car form) ,sv)  ,@(DCQGENEXP SV (CADR FORM) EQTAG QFLAG)))))))
+    (setq A (car FORM))
+    (setq D (cdr FORM))
+    (setq C (COND ((IDENTP A) `((setq ,a (CAR ,sv))))
+                  ((OR (consp A) (simple-vector-p A))
+                   (COND ((AND (NULL D) (IDENTP SV)) )
+                         ((COND ((consp AVL) (setq W (car (RESETQ AVL (cdr AVL)))))
+                                ((setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) ) )
+                   (COND ((AND (consp A) EQTAG (EQ (car A) EQTAG))
+                          (DCQGENEXP (LIST 'CAR SV) A EQTAG QFLAG) )
+                         (`((setq ,(or w sv) (CAR ,sv))
+                            ,@(DCQGENEXP (OR W SV) A EQTAG QFLAG)))))))
+    (setq C (NCONC C (COND ((IDENTP D) `((setq ,d (CDR ,sv))))
+                           ((OR (consp D) (simple-vector-p D))
+                            (COND
+                              ((OR W (IDENTP SV)) )
+                              ((COND ((consp AVL)
+                                      (setq W (car (RESETQ AVL (cdr AVL)))) )
+                                     ((setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) ) )
+                            (COND ((AND (consp D) EQTAG (EQ (car D) EQTAG))
+                                   (DCQGENEXP (LIST 'CDR SV) D EQTAG QFLAG) )
+                                  (`((setq ,(or w sv) (CDR ,sv))
+                                     ,@(DCQGENEXP (OR W SV) D EQTAG QFLAG))))))))
+    (COND (W (setq AVL (CONS W AVL))))
+    (RETURN (COND ((NULL QFLAG) `((COND ((ATOM ,sv) (GO BAD))) ,@c)) (C)))))
+)
+
+
+; 19.3 Searching
+
+; Generate code for EQQ
+
+(eval-when (compile load eval)
+ (defun ECQEXP (FORM QFLAG)
+  (PROG (SV PVL CODE)
+        (declare (special pvl))
+        (setq SV (GENSYM))
+        (setq CODE (ECQGENEXP SV FORM QFLAG))
+        (RETURN
+              `(LAMBDA (,sv)
+                 (PROG ,pvl
+                       ,@code
+                       (RETURN 'true)
+                    BAD (RETURN NIL) ) ))))
+)
+
+; Generate code for EQQ innards
+
+(eval-when (compile load eval)
+ (defun ECQGENEXP (SV FORM QFLAG)
+  (PROG (D A I L C W)
+        (declare (special pvl))
+        (COND
+          ((EQ FORM SV) (RETURN NIL))
+          ((OR
+              (IDENTP FORM)
+              (NUMP FORM)
+              (AND (consp FORM) (EQ (qcar FORM) 'QUOTE)))
+           (RETURN
+             `((COND ((NOT (EQ ,form ,sv)) (GO BAD))) )))
+          ((simple-vector-p FORM)
+           (RETURN (SEQ
+              (setq L (length FORM))
+              (if (EQ L 0)
+                  (RETURN
+                    (COND ((NULL QFLAG)
+                           `((COND ((NOT (simple-vector-p ,sv)) (GO BAD))) )))
+                    ))
+              (setq I (1- L))
+           LP (setq A (elt FORM I))
+              (if (AND (NULL W) (OR (consp A) (simple-vector-p A)))
+                  (push (setq W (GENSYM)) PVL))
+              (setq C
+                    (NCONC
+                      (COND
+                        ( (OR
+                            (IDENTP A)
+                            (NUMP A)
+                            (AND (consp A) (EQ (qcar A) 'QUOTE)))
+                         `((COND ( (NOT (EQ ,a (ELT ,sv ,i)))
+                                  (GO BAD) ) ) ) )
+                        ( (OR (consp A) (simple-vector-p A))
+                         `((setq ,w (ELT ,sv ,i))
+                           ,@(ECQGENEXP W A QFLAG))))
+                      C) )
+              (if (EQ I 0) (GO RET) )
+              (setq I (1- I))
+              (GO LP)
+           RET
+              (COND
+                ( (NULL QFLAG)
+                 `((COND ( (OR
+                             (NOT (simple-vector-p ,sv))
+                             (< (length ,sv) ,l))
+                          (GO BAD) ) )
+                   ,@c))
+                ( 'T C ) )) ))
+          ( (NOT (consp FORM))
+           (RETURN NIL) ) )
+        (setq A (car FORM))
+        (setq D (cdr FORM))
+        (if (OR (consp A) (simple-vector-p A) (consp D) (simple-vector-p D))
+           (setq PVL (CONS (setq W (GENSYM)) PVL)))
+        (setq C
+              (COND
+                ( (OR (IDENTP A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+                 `((COND ((NOT (EQ ,a (CAR ,sv))) (GO BAD))) ))
+                ( (OR (consp A) (simple-vector-p A))
+                 `((setq ,w (CAR ,sv))
+                   ,@(ECQGENEXP W A QFLAG)))))
+        (setq C
+              (NCONC
+                C
+                (COND
+                  ( (OR (IDENTP D) (NUMP D) (AND (consp D)
+                                                 (EQ (car D) 'QUOTE)))
+                   `((COND ((NOT (EQ ,d (CDR ,sv))) (GO BAD))) ))
+                  ( (OR (consp D) (simple-vector-p D))
+                   `((setq ,sv (CDR ,sv))
+                     ,@(ECQGENEXP SV D QFLAG))))))
+        (RETURN
+          (COND
+            ( (NULL QFLAG)
+             `((COND ( (ATOM ,sv)
+                      (GO BAD) ) )
+               ,@c))
+            ( 'T
+             C ) )) ) )
+)
+
+; 19.4 Updating
+
+; Generate code for RPLQ exprs
+
+(eval-when (compile load eval)
+ (defun RCQEXP (FORM)
+    (PROG (SV PVL CODE)
+          (declare (special pvl))
+      (setq SV (GENSYM))
+      (setq CODE (RCQGENEXP SV FORM NIL))
+      (RETURN
+        `(LAMBDA (,sv)
+              (PROG ,pvl
+                ,@code
+                (RETURN 'true)
+            BAD (RETURN NIL) ) ))))
+)
+
+; Generate code for RPLQ expr innards
+
+(eval-when (compile load eval)
+ (defun RCQGENEXP (SV FORM QFLAG)
+    (PROG (D A I L C W)
+          (declare (special pvl))
+      (COND
+        ( (EQ FORM SV)
+          (RETURN NIL) )
+        ( (simple-vector-p FORM)
+         (RETURN (SEQ
+            (setq L (length FORM))
+            (if (EQ L 0) (RETURN NIL))
+            (setq I (1- L))
+        LP  (setq A (elt FORM I))
+            (COND
+              ( (AND
+                  (NULL W)
+                  (OR (AND (consp A) (NOT (EQ (car A) 'QUOTE)))
+                           (simple-vector-p A)))
+                (setq PVL (CONS (setq W (GENSYM)) PVL)) ) )
+            (setq C
+              (NCONC
+                (COND
+                  ( (OR
+                      (IDENTP A)
+                      (NUMP A)
+                      (AND (consp A) (EQ (car A) 'QUOTE)))
+                    `((SETELT ,sv ,i ,a)))
+                  ( (OR (consp A) (simple-vector-p A))
+                    `((setq ,w (ELT ,sv ,i))
+                      ,@(RCQGENEXP W A QFLAG))))
+                C) )
+            (COND
+              ( (EQ I 0)
+                (GO RET) ) )
+            (setq I (1- I))
+            (GO LP)
+        RET (RETURN
+              (COND
+                ( (NULL QFLAG)
+                  `((COND ( (OR
+                              (NOT (simple-vector-p ,sv))
+                              (< (length ,sv) ,l))
+                            (GO BAD) ) )
+                    ,@c))
+                ( 'T
+                  C ) )) )))
+        ( (NOT (consp FORM))
+          (RETURN NIL) ) )
+      (setq A (car FORM))
+      (setq D (cdr FORM))
+      (cond
+        ( (or (and (consp A) (NOT (EQ (car A) 'QUOTE))) (simple-vector-p A))
+          (setq PVL (CONS (setq W (GENSYM)) PVL)) ) )
+      (setq C
+        (COND
+          ( (OR (IDENTP A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+            `((rplaca ,sv ,a)))
+          ( (OR (consp A) (simple-vector-p A))
+            `((setq ,w (CAR ,sv))
+              ,@(RCQGENEXP W A QFLAG)))))
+      (setq C
+        (NCONC
+          C
+          (COND
+            ( (OR (IDENTP D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE)))
+              `((RPLACD ,sv ,d)))
+            ( (OR (consp D) (simple-vector-p D))
+              `((setq ,sv (CDR ,sv))
+                ,@(RCQGENEXP SV D QFLAG))))))
+      (RETURN
+        (COND
+          ( (NULL QFLAG)
+            `((COND ( (ATOM ,sv)
+                      (GO BAD) ) )
+              ,@c))
+          ( 'T
+            C ) )) ) )
+)
+
+; 22.0 Internal and External Forms
+
+; 23.0 Reading
+
+
+(define-function 'next #'read-char)
+
+; 24.0 Printing
+
+<<stringimage fix>>
+(define-function 'printexp #'princ)
+(define-function 'prin0  #'prin1)
+
+(defun |F,PRINT-ONE| (form &optional (stream *standard-output*))
+ (declare (ignore stream))
+    (let ((*print-level* 4) (*print-length* 4))
+       (prin1 form) (terpri)))
+
+(defun prettyprint (x &optional (stream *standard-output*))
+  (prettyprin0 x stream) (terpri stream))
+
+(defun prettyprin0 (x &optional (stream *standard-output*))
+  (let ((*print-pretty* t) (*print-array* t))
+    (prin1 x stream)))
+
+(defun vmprint (x &optional (stream *standard-output*))
+  (prin1 x stream) (terpri stream))
+
+(defun tab (sint &optional (stream t))
+  (format stream "~vT" sint))
+
+; 27.0 Stream I/O
+
+
+; 27.1 Creation
+
+(defun MAKE-INSTREAM (filespec &optional (recnum 0))
+ (declare (ignore recnum))
+   (cond ((numberp filespec) (make-synonym-stream '*terminal-io*))
+         ((null filespec) (error "not handled yet"))
+         (t (open (make-input-filename filespec)
+                  :direction :input :if-does-not-exist nil))))
+
+(defun MAKE-OUTSTREAM (filespec &optional (width nil) (recnum 0))
+ (declare (ignore width) (ignore recnum))
+   (cond ((numberp filespec) (make-synonym-stream '*terminal-io*))
+         ((null filespec) (error "not handled yet"))
+         (t (open (make-filename filespec) :direction :output))))
+
+(defun MAKE-APPENDSTREAM (filespec &optional (width nil) (recnum 0))
+ "fortran support"
+ (declare (ignore width) (ignore recnum))
+ (cond 
+  ((numberp filespec) (make-synonym-stream '*terminal-io*))
+  ((null filespec) (error "make-appendstream: not handled yet"))
+  ('else (open (make-filename filespec) :direction :output
+          :if-exists :append :if-does-not-exist :create))))
+
+(defun DEFIOSTREAM (stream-alist buffer-size char-position)
+ (declare (ignore buffer-size))
+   (let ((mode (or (cdr (assoc 'MODE stream-alist)) 'INPUT))
+         (filename (cdr (assoc 'FILE stream-alist)))
+         (dev (cdr (assoc 'DEVICE stream-alist))))
+      (if (EQ dev 'CONSOLE) (make-synonym-stream '*terminal-io*)
+	(let ((strm (case mode
+			  ((OUTPUT O) (open (make-filename filename)
+					    :direction :output))
+			  ((INPUT I) (open (make-input-filename filename)
+					   :direction :input)))))
+	  (if (and (numberp char-position) (> char-position 0))
+	      (file-position strm char-position))
+	  strm))))
+
+(defun shut (st) (if (is-console st) st
+		   (if (streamp st) (close st) -1)))
+
+(defun EOFP (stream) (null (peek-char nil stream nil nil)))
+
+; 28.0 Key addressed I/O
+
+
+; 46.0 Call tracing
+
+
+(defun EMBEDDED () (mapcar #'car *embedded-functions*))
+
+(defun EMBED (CURRENT-BINDING NEW-DEFINITION)
+  (PROG
+#+:CCL (OP BV BODY OLD-DEF *COMP)
+#-:CCL (OP BV BODY OLD-DEF)
+      (COND
+        ( (NOT (IDENTP CURRENT-BINDING))
+          (SETQ CURRENT-BINDING
+                (error (format nil "invalid argument ~s to EMBED" CURRENT-BINDING))) ) )
+      (SETQ OLD-DEF (symbol-function CURRENT-BINDING))
+      (SETQ NEW-DEFINITION
+        (SETF (symbol-function CURRENT-BINDING)
+          (COND
+            ( (NOT (consp NEW-DEFINITION))
+              NEW-DEFINITION )
+            ( (AND
+                (DCQ (OP BV . BODY) NEW-DEFINITION)
+                (OR (EQ OP 'LAMBDA) (EQ OP 'MLAMBDA)))
+              (COND
+                ( (NOT (MEMQ CURRENT-BINDING (FLAT-BV-LIST BV)))
+                 `(,OP ,BV ((LAMBDA (,CURRENT-BINDING) . ,BODY) ',OLD-DEF))
+                   )
+                ( 'T
+                  NEW-DEFINITION ) ) )
+            ( 'T
+              `((LAMBDA (,CURRENT-BINDING) ,NEW-DEFINITION) ',OLD-DEF)))
+            ) )
+#+:CCL (IF (CONSP NEW-DEFINITION) (SETQ NEW-DEFINITION (CDR NEW-DEFINITION)))
+      (push (LIST CURRENT-BINDING NEW-DEFINITION OLD-DEF) *embedded-functions*)
+      (RETURN CURRENT-BINDING) ) )
+
+(defun UNEMBED (CURRENT-BINDING)
+    (PROG
+#+:CCL  (TMP E-LIST CUR-DEF *COMP)
+#-:CCL  (TMP E-LIST CUR-DEF)
+      (SETQ E-LIST *embedded-functions*)
+      (SETQ CUR-DEF (symbol-function CURRENT-BINDING))
+#+:CCL (IF (CONSP CUR-DEF) (SETQ CUR-DEF (CDR CUR-DEF)))
+      (COND
+        ( (NOT (consp E-LIST))
+          NIL )
+        ( (ECQ ((CURRENT-BINDING CUR-DEF)) E-LIST)
+          (SETF (symbol-function CURRENT-BINDING) (QCADDAR E-LIST))
+          (SETQ *embedded-functions* (QCDR E-LIST))
+          (RETURN CURRENT-BINDING) )
+        ( 'T
+          (SEQ
+            (SETQ TMP E-LIST)
+        LP  (COND
+              ( (NOT (consp (QCDR TMP)))
+                (EXIT NIL) )
+              ( (NULL (ECQ ((CURRENT-BINDING CUR-DEF)) (QCDR TMP)))
+                (SETQ TMP (QCDR TMP))
+                (GO LP) )
+              ( 'T
+                (SETF (symbol-function  CURRENT-BINDING) (QCAR (QCDDADR TMP)))
+                (RPLACD TMP (QCDDR TMP))
+                (RETURN CURRENT-BINDING) ) ) ) ) )
+      (RETURN NIL) ))
+
+(defun FLAT-BV-LIST (BV-LIST)
+  (PROG (TMP1)
+      (RETURN
+        (COND
+          ( (VARP BV-LIST)
+            (LIST BV-LIST) )
+          ( (REFVECP BV-LIST)
+            (FLAT-BV-LIST (VEC2LIST (MAPELT #'FLAT-BV-LIST BV-LIST))) )
+          ( (NOT (consp BV-LIST))
+            NIL )
+          ( (EQ '= (SETQ TMP1 (QCAR BV-LIST)))
+            (FLAT-BV-LIST (QCDR BV-LIST)) )
+          ( (VARP TMP1)
+            (CONS TMP1 (FLAT-BV-LIST (QCDR BV-LIST))) )
+          ( (AND (NOT (consp TMP1)) (NOT (REFVECP TMP1)))
+            (FLAT-BV-LIST (QCDR BV-LIST)) )
+          ( 'T
+            (NCONC (FLAT-BV-LIST TMP1) (FLAT-BV-LIST (QCDR BV-LIST))) ) )) ))
+
+(defun VARP (TEST-ITEM)
+    (COND
+      ( (IDENTP TEST-ITEM)
+        TEST-ITEM )
+      ( (AND
+          (consp TEST-ITEM)
+          (OR (EQ (QCAR TEST-ITEM) 'FLUID) (EQ (QCAR TEST-ITEM) 'LEX))
+          (consp (QCDR TEST-ITEM))
+          (IDENTP (QCADR TEST-ITEM)))
+        TEST-ITEM )
+      ( 'T
+        NIL ) ) )
+
+; 48.0 Miscellaneous CMS Interactions
+
+(defun CurrentTime ()
+  (multiple-value-bind (sec min hour day month year) (get-decoded-time)
+    (format nil "~2,'0D/~2,'0D/~2,'0D~2,'0D:~2,'0D:~2,'0D"
+	    month day (rem year 100) hour min sec)))
+
+(defun $screensize () '(24 80))          ; You tell me!!
+
+; 97.0 Stuff In The Manual But Wierdly Documented
+
+(defun EBCDIC (x) (int-char x))
+
+;; This isn't really compatible but is as close as you can get in common lisp
+;; In place of ((one-of 1 2 3) l)  you should use
+;;   (funcall (one-of 1 2 3) l)
+
+(defun doDSETQ (form pattern exp)
+  (let (PVL AVL)
+    (declare (special PVL AVL))
+    (COND ((IDENTP PATTERN)
+           (LIST 'SETQ PATTERN EXP))
+          ((AND (NOT (consp PATTERN)) (NOT (simple-vector-p PATTERN)))
+           (MACRO-INVALIDARGS 'DSETQ FORM "constant target."))
+          ((let* ((SV (GENSYM))
+                  (E-PART (DCQGENEXP (LIST 'IDENTITY SV) PATTERN '= NIL)))
+             (setq e-part
+                   `(LAMBDA (,sv)
+                      (PROG ,pvl
+                            ,@e-part
+                            (RETURN ,sv)
+                         BAD (RETURN (SETQERROR ,sv)))))
+             `(,e-part ,exp))))))
+
+(defun SETQERROR (&rest FORM) (error (format nil "in destructuring ~S" FORM)))
+
+
+
+
+(defun MACRO-INVALIDARGS (NAME FORM MESSAGE)
+    (setq MACERRORCOUNT  (+ 1 (eval 'MACERRORCOUNT)))
+    (error (format nil 
+                   "invalid arguments to macro ~S with invalid argument ~S, ~S"
+                   name form message)))
+
+(defun MACRO-MISSINGARGS (NAME ignore N)
+  (declare (ignore ignore))
+  (setq MACERRORCOUNT (+ 1 (eval 'MACERRORCOUNT)))
+  (let ((nargs (abs N)))
+    (error (concatenate 'string (symbol-name NAME) " requires "
+			(if (minusp N) "at least " "exactly ")
+			(case nargs (0 "no") (1 "one") (2 "two") (3 "three")
+			      (4 "four") (5 "five") (6 "six")
+			      (t (princ-to-string nargs)))
+			(if (eq nargs 1) " argument," " arguments,")))))
+
+(defun MACERR (MESSAGE &rest ignore)
+  (declare (ignore ignore))
+      (setq MACERRORCOUNT (+ 1 (eval 'MACERRORCOUNT)))
+      (error
+        (LIST "in the expression:" MESSAGE))
+      ())
+
+#+Lucid
+(defun numberofargs (x)
+  (setq x (system::arglist x))
+  (let ((nx (- (length x) (length (memq '&aux x)))))
+    (if (memq '&rest x) (setq nx (- (1- nx))))
+    (if (memq '&optional x) (setq nx (- (1- (abs nx)))))
+    nx))
+
+; 98.0 Stuff Not In The VMLisp Manual That We Like
+
+; A version of GET that works with lists
+
+; (defun getl (sym key )
+;   (cond ((consp sym) (cdr (assoc key sym :test #'eq)))
+;         ((symbolp sym) (get sym key))))
+(defun getl (sym key )
+  (cond ((consp sym) (cdr (assq key sym)))
+        ((symbolp sym) (get sym key))))
+
+; The following should actually position the cursor at the sint'th line of the screen:
+
+(defun $showline (cvec sint) (terpri) sint (princ cvec))
+
+; 99.0 Ancient Stuff We Decided To Keep
+
+(defun LAM\,EVALANDFILEACTQ (name &optional (form name))
+    (LAM\,FILEACTQ name form) (eval form))
+
+(defun LAM\,FILEACTQ (name form)
+       (if *FILEACTQ-APPLY* (FUNCALL *FILEACTQ-APPLY* name form)))
+
+(defun CALLBELOW (&rest junk) junk) ; to invoke system dependent code?
+
+(define-function 'EVA1 #'eval) ;EVA1 and VMLISP EVAL make lexicals visible
+(define-function 'EVALFUN #'eval) ;EVALFUN drops lexicals before evaluating
+(define-function 'EVA1FUN #'EVALFUN)
+
+(defun PLACEP (item) (eq item *read-place-holder*))
+(defun VMREAD (&optional (st *standard-input*) (eofval *read-place-holder*))
+  (read st nil eofval))
+(defun |read-line| (st &optional (eofval *read-place-holder*))
+  (read-line st nil eofval))
+
+(defun STATEP (item)
+ (declare (ignore item))
+   nil) ;no state objects
+(defun FUNARGP (item)
+ (declare (ignore item))
+  nil) ;can't tell closures from other functions
+(defun PAPPP (item)
+ (declare (ignore item))
+  nil) ;no partial application objects
+
+#+Lucid
+(defun gcmsg (x)
+   (prog1 (not system::*gc-silence*) (setq system::*gc-silence* (not x))))
+#+(OR IBCL KCL)
+(defun gcmsg (x)
+   (prog1 system:*gbc-message* (setq system:*gbc-message* x)))
+#+:cmulisp
+(defun gcmsg (x)
+   (prog1 ext:*gc-verbose* (setq ext:*gc-verbose* x)))
+#+:allegro
+(defun gcmsg (x))
+
+#+Lucid
+(defun reclaim () (system:gc))
+#+:cmulisp
+(defun reclaim () (ext:gc))
+#+(OR IBCL KCL)
+(defun reclaim () (gbc t))
+#+:allegro
+(defun reclaim () (excl::gc t))
+#+:CCL
+(defun reclaim () (gc))
+
+#+Lucid
+(defun BPINAME (func)
+  (if (functionp func)
+      (if (symbolp func) func
+	(let ((name (svref func 0)))
+	  (if (and (consp name) (eq (car name) 'SYSTEM::NAMED-LAMBDA))
+	      (cadr name)
+	    name)) )))
+
+#+(OR IBCL KCL)
+(defun BPINAME (func)
+  (if (functionp func)
+      (cond ((symbolp func) func)
+	    ((and (consp func) (eq (car func) 'LAMBDA-BLOCK))
+	      (cadr func))
+	    ((compiled-function-p func)
+	     (system:compiled-function-name func))
+	    ('t func))))
+#+:cmulisp
+(defun BPINAME (func)
+ (when (functionp func)
+  (cond
+    ((symbolp func) func)
+    ((and (consp func) (eq (car func) 'lambda)) (second (third func)))
+    ((compiled-function-p func)
+      (system::%primitive header-ref func system::%function-name-slot))
+    ('else func))))
+#+:allegro
+(defun bpiname (func)
+ func)
+#+:CCL
+(defun bpiname (x)
+   (if (symbolp x)
+     (intern (symbol-name (symbol-function x)) "BOOT")
+    nil))
+
+(defun LISTOFQUOTES (bpi)
+ (declare (ignore bpi))
+  ())
+
+#+Lucid
+(defun LISTOFFREES (bpi)
+  (if (compiled-function-p bpi)
+      (let ((end (- (lucid::procedure-length bpi) 2)))
+	(do ((i 3 (1+ i))
+	     (ans nil))
+	    ((> i end) ans)
+	    (let ((locexp (svref bpi i)))
+	      (if (symbolp locexp) (push locexp ans)))))))
+
+#-Lucid
+(defun LISTOFFREES (bpi)
+ (declare (ignore bpi))
+ ())
+
+  
+#+(and :Lucid (not :ibm/370))
+(defun OBEY (S)
+  (system::run-aix-program (make-absolute-filename "/lib/obey")
+		       :arguments	(list "-c" S)))
+#+:cmulisp
+(defun OBEY (S)
+   (ext:run-program (make-absolute-filename "/lib/obey")
+		    (list "-c" S) :input t :output t))
+#+(OR IBCL KCL :CCL)
+(defun OBEY (S) (SYSTEM S))
+
+#+:allegro
+(defun OBEY (S) (excl::run-shell-command s))
+
+(defun RE-ENABLE-INT (number-of-handler) number-of-handler)
+
+
+(defun QUOREM (i j r) ; never used, refed in parini.boot
+  (multiple-value-bind (x y) (truncate i j)
+   (rplaca (the cons r) x) (rplacd (the cons r) y)))
+
+(defun MAKE-BVEC (n)
+ (make-array (list n) :element-type 'bit :initial-element 0))
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/wi1.boot.pamphlet b/src/interp/wi1.boot.pamphlet
new file mode 100644
index 00000000..88c1d032
--- /dev/null
+++ b/src/interp/wi1.boot.pamphlet
@@ -0,0 +1,1288 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/wi1.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+-- !! do not delete the next function !
+
+spad2AsTranslatorAutoloadOnceTrigger() == nil
+
+pairList(u,v) == [[x,:y] for x in u for y in v]
+
+--======================================================================
+--    Temporary definitions---for tracing and debugging
+--======================================================================
+tr fn ==
+  $convertingSpadFile : local := true
+  $options: local := nil
+  sfn  := STRINGIMAGE fn
+  newname := STRCONC(sfn,'".as")
+  $outStream :local := MAKE_-OUTSTREAM newname
+  markSay '"#pile"
+  markSay('"#include _"axiom.as_"")
+  markTerpri()
+  CATCH("SPAD__READER",compiler [INTERN sfn])
+  SHUT $outStream
+
+stackMessage msg ==
+--if msg isnt ["cannot coerce: ",:.] then foobum msg
+  $compErrorMessageStack:= [msg,:$compErrorMessageStack]
+  nil
+
+ppFull x ==
+  _*PRINT_-LEVEL_* : local := nil
+  _*PRINT_-DEPTH_*  : local := nil
+  _*PRINT_-LENGTH_* : local := nil
+  pp x
+
+put(x,prop,val,e) ==
+--if prop = 'mode and CONTAINED('PART,val) then foobar val
+  $InteractiveMode and not EQ(e,$CategoryFrame) =>
+    putIntSymTab(x,prop,val,e)
+  --e must never be $CapsuleModemapFrame
+  null atom x => put(first x,prop,val,e)
+  newProplist:= augProplistOf(x,prop,val,e)
+  prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
+    SAY ["**** modemap PUT on CapsuleModemapFrame: ",val]
+    $CapsuleModemapFrame:=
+      addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame),
+	$CapsuleModemapFrame)
+    e
+  addBinding(x,newProplist,e)
+
+addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) ==
+--if CONTAINED('PART,proplist) then foobar proplist
+  EQ(proplist,getProplist(var,e)) => e
+  $InteractiveMode => addBindingInteractive(var,proplist,e)
+  if curContour is [[ =var,:.],:.] then curContour:= rest curContour
+		 --Previous line should save some space
+  [[[lx,:curContour],:tailContour],:tailEnv] where lx:= [var,:proplist]
+
+--======================================================================
+--		      From define.boot
+--======================================================================
+compJoin(["Join",:argl],m,e) ==
+  catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl]
+  catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil)
+  catList':=
+    [extract for x in catList] where
+      extract() ==
+        x := markKillAll x
+        isCategoryForm(x,e) =>
+          parameters:=
+            union("append"/[getParms(y,e) for y in rest x],parameters)
+              where getParms(y,e) ==
+                atom y =>
+                  isDomainForm(y,e) => LIST y
+                  nil
+                y is ['LENGTH,y'] => [y,y']
+                LIST y
+          x
+        x is ["DomainSubstitutionMacro",pl,body] =>
+          (parameters:= union(pl,parameters); body)
+        x is ["mkCategory",:.] => x
+        atom x and getmode(x,e)=$Category => x
+        stackSemanticError(["invalid argument to Join: ",x],nil)
+        x
+  T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
+  convert(T,m)
+
+
+compDefineFunctor(dfOriginal,m,e,prefix,fal) ==
+  df := markInsertParts dfOriginal
+  $domainShell: local -- holds the category of the object being compiled
+  $profileCompiler: local := true
+  $profileAlist:    local := nil
+  $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
+  compDefineFunctor1(df,m,e,prefix,fal)
+
+compDefineLisplib(df,m,e,prefix,fal,fn) ==
+  ["DEF",[op,:.],:.] := df
+  --fn= compDefineCategory OR compDefineFunctor
+  sayMSG fillerSpaces(72,'"-")
+  $LISPLIB: local := 'T
+  $op: local := op
+  $lisplibAttributes: local := NIL
+  $lisplibPredicates: local := NIL -- set by makePredicateBitVector
+  $lisplibCategoriesExtended: local := NIL -- this is always nil. why? (tpd)
+  $lisplibForm: local := NIL
+  $lisplibKind: local := NIL
+  $lisplibModemap: local := NIL
+  $lisplibModemapAlist: local := NIL
+  $lisplibSlot1 : local := NIL	 -- used by NRT mechanisms
+  $lisplibOperationAlist: local := NIL
+  $lisplibSuperDomain: local := NIL
+  $libFile: local := NIL
+  $lisplibVariableAlist: local := NIL
+  $lisplibRelatedDomains: local := NIL	 --from ++ Related Domains: see c-doc
+  $lisplibCategory: local := nil
+  --for categories, is rhs of definition; otherwise, is target of functor
+  --will eventually become the "constructorCategory" property in lisplib
+  --set in compDefineCategory if category, otherwise in finalizeLisplib
+  libName := getConstructorAbbreviation op
+ -- $incrementalLisplibFlag seems never to be set so next line not used
+ -- originalLisplibCategory:= getLisplib(libName,'constructorCategory)
+  BOUNDP '$compileDocumentation and $compileDocumentation =>
+     compileDocumentation libName
+  sayMSG ['"   initializing ",$spadLibFT,:bright libName,
+    '"for",:bright op]
+  initializeLisplib libName
+  sayMSG ['"   compiling into ",$spadLibFT,:bright libName]
+  res:= FUNCALL(fn,df,m,e,prefix,fal)
+  sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
+--finalizeLisplib libName
+  FRESH_-LINE $algebraOutputStream
+  sayMSG fillerSpaces(72,'"-")
+  unloadOneConstructor(op,libName)
+  res
+
+compTopLevel(x,m,e) ==
+--+ signals that target is derived from lhs-- see NRTmakeSlot1Info
+  $NRTderivedTargetIfTrue: local := false
+  $killOptimizeIfTrue: local:= false
+  $forceAdd: local:= false
+  $compTimeSum: local := 0
+  $resolveTimeSum: local := 0
+  $packagesUsed: local := []
+  -- The next line allows the new compiler to be tested interactively.
+  compFun := if $newCompAtTopLevel=true then 'newComp else 'compOrCroak
+  if x is ["where",:.] then x := markWhereTran x
+  def :=
+    x is ["where",a,:.] => a
+    x
+  $originalTarget : local :=
+    def is ["DEF",.,[target,:.],:.] => target
+    'sorry
+  x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
+    ([val,mode,.]:= FUNCALL(compFun,x,m,e); [val,mode,e])
+	--keep old environment after top level function defs
+  FUNCALL(compFun,x,m,e)
+
+markWhereTran ["where",["DEF",form,sig,clist,body],:tail] ==
+  items :=
+    tail is [['SEQ,:l,['exit,n,x]]] => [:l,x]
+    [first tail]
+  [op,:argl] := form
+  [target,:atypeList] := sig
+  decls := [[":",a,b] for a in argl for b in atypeList | b]
+--  not (and/[null x for x in atypeList]) =>
+--    systemError ['"unexpected WHERE argument list: ",:atypeList]
+  for x in items repeat
+    x is [":",a,b] =>
+      a is ['LISTOF,:r] =>
+	for y in r repeat decls := [[":",y,b],:decls]
+      decls := [x,:decls]
+    x is [key,fn,p,q,bd] and MEMQ(key,'(DEF MDEF)) and p='(NIL) and q='(NIL) =>
+      fn = target or fn is [=target] => ttype := bd
+      fn = body	  or fn is [=body]   => body  := bd
+      macros := [x,:macros]
+    systemError ['"unexpected WHERE item: ",x]
+  nargtypes := [p for arg in argl |
+		  p := or/[t for d in decls | d is [.,=arg,t]] or
+		    systemError ['"Missing WHERE declaration for :", arg]]
+  nform := form
+  ntarget := ttype or target
+  ndef := ['DEF,nform,[ntarget,:nargtypes],clist,body]
+  result :=
+    REVERSE macros is [:m,e] =>
+      mpart :=
+	m => ['SEQ,:m,['exit,1,e]]
+	e
+      ['where,ndef,mpart]
+    ndef
+  result
+
+compPART(u,m,e) ==
+--------new------------------------------------------94/10/11
+  ['PART,.,x] := u
+  T := comp(x,m,e) => markAny('compPART,u, T)
+  nil
+
+xxxxx x == x
+
+qt(n,T) ==
+  null T => nil
+  if null getProplist('R,T.env) then xxxxx n
+  T
+
+qe(n,e) ==
+  if null getProplist('R,e) then xxxxx n
+  e
+
+comp(x,m,e) ==
+  qe(7,e)
+  T := qt(8,comp0(x,m,e)) => qt(9,markComp(x,T))
+--T := m = "$" and comp(x,$EmptyMode,e) => coerce(T, m)
+  --------------------------------------------------------94/11/10
+  nil
+
+comp0(x,m,e) ==
+  qe(8,e)
+--version of comp which skips the marking (see compReduce1)
+  T:= compNoStacking(x,m,e) =>
+    $compStack:= nil
+    qt(10,T)
+  $compStack:= [[x,m,e,$exitModeStack],:$compStack]
+  nil
+
+compNoStacking(xOrig,m,e) ==
+  $partExpression: local := nil
+  xOrig := markKillAllRecursive xOrig
+-->xOrig is ['PART,n,x] => compNoStackingAux(xOrig,m,e)
+----------------------------------------------------------94/10/11
+  qt(11,compNoStacking0(xOrig,m,e))
+
+markKillAllRecursive x ==
+  x is [op,:r] =>
+--->op = 'PART => markKillAllRecursive CADR r
+    op = 'PART => ['PART, CAR r, markKillAllRecursive CADR r]
+----------------------------------------------------------94/10/11
+    constructor? op => markKillAll x
+    op = 'elt and constructor? opOf CAR r =>
+      ['elt,markKillAllRecursive CAR r,CADR r]
+    x
+  x
+
+compNoStackingAux($partExpression,m,e) ==
+-----------------not used---------------------94/10/11
+  x := CADDR $partExpression
+  T := compNoStacking0(x,m,e) or return nil
+  markParts($partExpression,T)
+
+compNoStacking0(x,m,e) ==
+  qe(1,e)
+  T := compNoStacking01(x,m,qe(51,e))
+  qt(52,T)
+
+compNoStacking01(x,m,e) ==
+--compNoStacking0(x,m,e) ==
+  if CONTAINED('MI,m) then m := markKillAll(m)
+  T:= comp2(x,m,e) =>
+    (m=$EmptyMode and T.mode=IFCAR(get('Rep,'value,e)) => 
+       [T.expr,"Rep",T.env]; qt(12,T))
+	 --$Representation is bound in compDefineFunctor, set by doIt
+	 --this hack says that when something is undeclared, $ is
+	 --preferred to the underlying representation -- RDJ 9/12/83
+  T := compNoStacking1(x,m,e,$compStack)
+  qt(13,T)
+
+compNoStacking1(x,m,e,$compStack) ==
+  u:= get(if m="$" then "Rep" else m,"value",e) =>
+    m1 := markKillAll u.expr
+--------------------> new <-------------------------
+    T:= comp2(x,m1,e) => coerce(T,m)
+    nil
+--------------------> new <-------------------------
+  nil
+
+compWithMappingMode(x,m,oldE) ==
+  ["Mapping",m',:sl] := m
+  $killOptimizeIfTrue: local:= true
+  e:= oldE
+  x := markKillAll x
+  ------------------
+  m := markKillAll m
+  ------------------
+--if x is ['PART,.,y] then x := y
+---------------------------------
+  isFunctor x =>
+    if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and
+      (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl]
+	) and extendsCategoryForm("$",target,m') then return [x,m,e]
+  if STRINGP x then x:= INTERN x
+  for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
+    [.,.,e]:= compMakeDeclaration([":",v,m],$EmptyMode,e)
+  not null vl and not hasFormalMapVariable(x, vl) => return
+    [u,.,.] := comp([x,:vl],m',e) or return nil
+    extractCodeAndConstructTriple(u, m, oldE)
+  null vl and (t := comp([x], m', e)) => return
+    [u,.,.] := t
+    extractCodeAndConstructTriple(u, m, oldE)
+  [u,.,.]:= comp(x,m',e) or return nil
+  originalFun := u
+  if originalFun is ['WI,a,b] then u := b
+  uu := ['LAMBDA,vl,u]
+  --------------------------> 11/28 drop COMP-TRAN, optimizations
+  T := [uu,m,oldE]
+  originalFun is ['WI,a,b] => markLambda(vl,a,m,T)
+  markLambda(vl,originalFun,m,T)
+
+compAtom(x,m,e) ==
+  T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => markCompAtom(x,T)
+  x="nil" =>
+    T:=
+      modeIsAggregateOf('List,m,e) is [.,R]=> compList(x,['List,R],e)
+      modeIsAggregateOf('Vector,m,e) is [.,R]=> compVector(x,['Vector,R],e)
+    T => convert(T,m)
+-->
+  FIXP x and MEMQ(opOf m, '(Integer NonNegativeInteger PositiveInteger SmallInteger)) => markAt [x,m,e]
+--  FIXP x and (T := [x, $Integer,e]) and (T' := convert(T,m)) => markAt(T, T')
+  t:=
+    isSymbol x =>
+      compSymbol(x,m,e) or return nil
+    m = $Expression and primitiveType x => [x,m,e]
+    STRINGP x => 
+      x ^= '"failed" and (member('(Symbol), $localImportStack) or
+        member('(Symbol), $globalImportStack)) => markAt [x, '(String), e]
+      [x, x, e]
+    [x,primitiveType x or return nil,e]
+  convert(t,m)
+
+extractCodeAndConstructTriple(u, m, oldE) ==
+  u := markKillAll u
+  u is ["call",fn,:.] =>
+    if fn is ["applyFun",a] then fn := a
+    [fn,m,oldE]
+  [op,:.,env] := u
+  [["CONS",["function",op],env],m,oldE]
+
+compSymbol(s,m,e) ==
+  s="$NoValue" => ["$NoValue",$NoValueMode,e]
+  isFluid s => [s,getmode(s,e) or return nil,e]
+  s="true" => ['(QUOTE T),$Boolean,e]
+  s="false" => [false,$Boolean,e]
+  s=m or get(s,"isLiteral",e) => [["QUOTE",s],s,e]
+  v:= get(s,"value",e) =>
+--+
+    MEMQ(s,$functorLocalParameters) =>
+	NRTgetLocalIndex s
+	[s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
+    [s,v.mode,e] --s has been SETQd
+  m':= getmode(s,e) =>
+    if not member(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
+      not isFunction(s,e) and null ($compForModeIfTrue=true) then errorRef s
+    [s,m',e] --s is a declared argument
+  MEMQ(s,$FormalMapVariableList) => stackMessage ["no mode found for",s]
+--->
+  m = $Symbol or m = $Expression => [['QUOTE,s],m,e]
+                                   ---> was ['QUOTE, s]
+  not isFunction(s,e) => errorRef s
+
+compForm(form,m,e) ==
+  if form is [['PART,.,op],:r] then form := [op,:r]
+  ----------------------------------------------------- 94/10/16
+  T:=
+    compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return
+      stackMessageIfNone ["cannot compile","%b",form,"%d"]
+  T
+
+compForm1(form,m,e) ==
+  [op,:argl] := form
+  $NumberOfArgsIfInteger: local:= #argl --see compElt
+  op="error" =>
+    [[op,:[([.,.,e]:=outputComp(x,e)).expr
+      for x in argl]],m,e]
+  op is ['MI,a,b] => compForm1([markKillExpr b,:argl],m,e)
+  op is ["elt",domain,op'] =>
+    domain := markKillAll domain
+    domain="Lisp" =>
+      --op'='QUOTE and null rest argl => [first argl,m,e]
+      val := [op',:[([.,.,e]:= compOrCroak(x,$EmptyMode,e)).expr for x in argl]]
+      markLisp([val,m,e],m)
+-------> new <-------------
+--    foobar domain
+--    markImport(domain,true)
+-------> new <-------------
+    domain=$Expression and op'="construct" => compExpressionList(argl,m,e)
+    (op'="COLLECT") and coerceable(domain,m,e) =>
+      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
+-------> new <-------------
+    domain= 'Rep and
+      (ans := compForm2([op',:argl],SUBST('Rep,'_$,m),e:= addDomain(domain,e),
+	[SUBST('Rep,'_$,x) for x in getFormModemaps([op',:argl],e)
+	  | x is [[ =domain,:.],:.]])) => ans
+-------> new <-------------
+    ans := compForm2([op',:argl],m,e:= addDomain(domain,e),
+      [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]]) => ans
+    (op'="construct") and coerceable(domain,m,e) =>
+      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
+    nil
+
+  e:= addDomain(m,e) --???unneccessary because of comp2's call???
+  (mmList:= getFormModemaps(form,e)) and (T:= compForm2(form,m,e,mmList)) => T
+  compToApply(op,argl,m,e)
+
+--% WI and MI
+
+compForm3(form is [op,:argl],m,e,modemapList) ==
+--order modemaps so that ones from Rep are moved to the front
+  modemapList := compFormOrderModemaps(modemapList,m = "$")
+  qe(22,e)
+  T:=
+    or/
+      [compFormWithModemap(form,m,e,first (mml:= ml))
+	for ml in tails modemapList] or return nil
+  qt(14,T)
+  result := 
+    $compUniquelyIfTrue =>
+      or/[compFormWithModemap(form,m,e,mm) for mm in rest mml] =>
+        THROW("compUniquely",nil)
+      qt(15,T)
+    qt(16,T)
+  qt(17,markAny('compForm3,form,result))
+
+compFormOrderModemaps(mml,targetIsDollar?) ==
+--order modemaps so that ones from Rep are moved to the front
+--exceptions: if $ is the target and there are 2 modemaps with
+--            identical signatures, move the $ one ahead
+  repMms := [mm for (mm:= [[dc,:.],:.]) in mml | dc = 'Rep]
+  if repMms and targetIsDollar? then 
+    dollarMms := [mm for (mm := [[dc,:sig],:.]) in mml | dc = "$"
+       and or/[mm1 for (mm1:= [[dc1,:sig1],:.]) in repMms | sig1 = sig]]
+    repMms := [:dollarMms, :repMms]
+  null repMms => mml
+  [:repMms,:SETDIFFERENCE(mml,repMms)]
+
+compWI(["WI",a,b],m,E) ==
+  u := comp(b,m,E)
+  pp (u => "====> ok"; 'NO)
+  u
+
+compMI(["MI",a,b],m,E) ==
+  u := comp(b,m,E)
+  pp (u => "====> ok"; 'NO)
+  u
+
+compWhere([.,form,:exprList],m,eInit) ==
+  $insideExpressionIfTrue: local:= false
+  $insideWhereIfTrue: local:= true
+--  if not $insideFunctorIfTrue then
+--   $originalTarget :=
+--    form is ['DEF,a,osig,:.] and osig is [otarget,:.] =>
+--	exprList is [['SEQ,:l,['exit,n,y]]] and (u := [:l,y]) and
+--	  (ntarget := or/[def for x in u | x is [op,a',:.,def] and ([op,a',otarget]) and
+--	    MEMQ(op,'(DEF MDEF)) and (a' = otarget or a' is [=otarget])]) =>
+--	      [ntarget,:rest osig]
+--	osig
+--    nil
+--  foobum exprList
+  e:= eInit
+  u:=
+    for item in exprList repeat
+      [.,.,e]:= comp(item,$EmptyMode,e) or return "failed"
+  u="failed" => return nil
+  $insideWhereIfTrue:= false
+  [x,m,eAfter]:= comp(macroExpand(form,eBefore:= e),m,e) or return nil
+  eFinal:=
+    del:= deltaContour(eAfter,eBefore) => addContour(del,eInit)
+    eInit
+  [x,m,eFinal]
+
+compMacro(form,m,e) ==
+  $macroIfTrue: local:= true
+  ["MDEF",lhs,signature,specialCases,rhs]:= form := markKillAll form
+  firstForm := ["MDEF",first lhs,'(NIL),'(NIL),rhs]
+  markMacro(first lhs,rhs)
+  rhs :=
+    rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
+    rhs is ['Join,:.]	  => ['"-- the constructor category"]
+    rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
+    rhs is ['add,:.]	  => ['"-- the constructor capsule"]
+    formatUnabbreviated rhs
+  sayBrightly ['"   processing macro definition",'%b,
+    :formatUnabbreviated lhs,'" ==> ",:rhs,'%d]
+  ["MDEF",lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
+  m=$EmptyMode or m=$NoValueMode =>
+    ["/throwAway",$NoValueMode,put(first lhs,"macro",rhs,e)]
+
+--compMacro(form,m,e) ==
+--  $macroIfTrue: local:= true
+--  ["MDEF",lhs,signature,specialCases,rhs]:= form
+--  rhs :=
+--    rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
+--    rhs is ['Join,:.]	    => ['"-- the constructor category"]
+--    rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
+--    rhs is ['add,:.]	    => ['"-- the constructor capsule"]
+--    formatUnabbreviated rhs
+--  sayBrightly ['"   processing macro definition",'%b,
+--    :formatUnabbreviated lhs,'" ==> ",:rhs,'%d]
+--  ["MDEF",lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
+--  m=$EmptyMode or m=$NoValueMode =>
+--    rhs := markMacro(lhs,rhs)
+--    ["/throwAway",$NoValueMode,put(first lhs,"macro",rhs,e)]
+
+compSetq(oform,m,E) ==
+  ["LET",form,val] := oform
+  T := compSetq1(form,val,m,E) => markSetq(oform,T)
+  nil
+
+compSetq1(oform,val,m,E) ==
+  form := markKillAll oform
+  IDENTP form => setqSingle(form,val,m,E)
+  form is [":",x,y] =>
+    [.,.,E']:= compMakeDeclaration(form,$EmptyMode,E)
+    compSetq(["LET",x,val],m,E')
+  form is [op,:l] =>
+    op="CONS"  => setqMultiple(uncons form,val,m,E)
+    op="Tuple" => setqMultiple(l,val,m,E)
+    setqSetelt(oform,form,val,m,E)
+
+setqSetelt(oform,[v,:s],val,m,E) ==
+  T:= comp0(["setelt",:oform,val],m,E) or return nil
+--->                  -------
+  markComp(oform,T)
+
+setqSingle(id,val,m,E) ==
+  $insideSetqSingleIfTrue: local:= true
+    --used for comping domain forms within functions
+  currentProplist:= getProplist(id,E)
+  m'':= get(id,'mode,E) or getmode(id,E) or 
+       (if m=$NoValueMode then $EmptyMode else m)
+-----------------------> new <-------------------------
+  trialT := m'' = "$" and get("Rep",'value,E) and comp(val,'Rep,E)
+-----------------------> new <-------------------------
+  T:=
+    (trialT and coerce(trialT,m'')) or eval or return nil where
+      eval() ==
+	T:= comp(val,m'',E) => T
+	not get(id,"mode",E) and m'' ^= (maxm'':=maxSuperType(m'',E)) and
+	   (T:=comp(val,maxm'',E)) => T
+	(T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) =>
+	  assignError(val,T.mode,id,m'')
+  T':= [x,m',e']:= convert(T,m) or return nil
+  if $profileCompiler = true then
+    null IDENTP id => nil
+    key :=
+      MEMQ(id,rest $form) => 'arguments
+      'locals
+    profileRecord(key,id,T.mode)
+  newProplist:= consProplistOf(id,currentProplist,"value",markKillAll removeEnv T)
+  e':= (PAIRP id => e'; addBinding(id,newProplist,e'))
+  x1 := markKillAll x
+  if isDomainForm(x1,e') then
+    if isDomainInScope(id,e') then
+      stackWarning ["domain valued variable","%b",id,"%d",
+	"has been reassigned within its scope"]
+    e':= augModemapsFromDomain1(id,x1,e')
+      --all we do now is to allocate a slot number for lhs
+      --e.g. the LET form below will be changed by putInLocalDomainReferences
+--+
+  if (k:=NRTassocIndex(id))
+     then
+       $markFreeStack := [id,:$markFreeStack]
+       form:=['SETELT,"$",k,x]
+     else form:=
+	 $QuickLet => ["LET",id,x]
+	 ["LET",id,x,
+	    (isDomainForm(x,e') => ['ELT,id,0];CAR outputComp(id,e'))]
+  [form,m',e']
+
+setqMultiple(nameList,val,m,e) ==
+  val is ["CONS",:.] and m=$NoValueMode =>
+    setqMultipleExplicit(nameList,uncons val,m,e)
+  val is ["Tuple",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
+  --1. create a gensym, %add to local environment, compile and assign rhs
+  g:= genVariable()
+  e:= addBinding(g,nil,e)
+  T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil
+  e:= put(g,"mode",m1,e)
+  [x,m',e]:= convert(T,m) or return nil
+  --1.1 exit if result is a list
+  m1 is ["List",D] =>
+    for y in nameList repeat e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
+    convert([["PROGN",x,["LET",nameList,g],g],m',e],m)
+  --2. verify that the #nameList = number of parts of right-hand-side
+  selectorModePairs:=
+						--list of modes
+    decompose(m1,#nameList,e) or return nil where
+      decompose(t,length,e) ==
+	t is ["Record",:l] => [[name,:mode] for [":",name,mode] in l]
+	comp(t,$EmptyMode,e) is [.,["RecordCategory",:l],.] =>
+	  [[name,:mode] for [":",name,mode] in l]
+	stackMessage ["no multiple assigns to mode: ",t]
+  #nameList^=#selectorModePairs =>
+    stackMessage [val," must decompose into ",#nameList," components"]
+  -- 3.generate code; return
+  assignList:=
+    [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
+      for x in nameList for [y,:z] in selectorModePairs]
+  if assignList="failed" then NIL
+  else [MKPROGN [x,:assignList,g],m',e]
+
+setqMultipleExplicit(nameList,valList,m,e) ==
+  #nameList^=#valList =>
+    stackMessage ["Multiple assignment error; # of items in: ",nameList,
+      "must = # in: ",valList]
+  gensymList:= [genVariable() for name in nameList]
+  for g in gensymList for name in nameList repeat
+    e := put(g,"mode",get(name,"mode",e),e)
+  assignList:=
+	     --should be fixed to declare genVar when possible
+    [[.,.,e]:= compSetq1(g,val,$EmptyMode,e) or return "failed"
+      for g in gensymList for val in valList for name in nameList]
+  assignList="failed" => nil
+  reAssignList:=
+    [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
+      for g in gensymList for name in nameList]
+  reAssignList="failed" => nil
+  T := [["PROGN",:[T.expr for T in assignList],
+    :[T.expr for T in reAssignList]], $NoValueMode, (LAST reAssignList).env]
+  markMultipleExplicit(nameList,valList,T)
+
+canReturn(expr,level,exitCount,ValueFlag) ==  --SPAD: exit and friends
+  atom expr => ValueFlag and level=exitCount
+  (op:= first expr)="QUOTE" => ValueFlag and level=exitCount
+  MEMQ(op,'(WI MI)) => canReturn(CADDR expr,level,count,ValueFlag)
+  op="TAGGEDexit" =>
+    expr is [.,count,data] => canReturn(data.expr,level,count,count=level)
+  level=exitCount and not ValueFlag => nil
+  op="SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr]
+  op="TAGGEDreturn" => nil
+  op="CATCH" =>
+    [.,gs,data]:= expr
+    (findThrow(gs,data,level,exitCount,ValueFlag) => true) where
+      findThrow(gs,expr,level,exitCount,ValueFlag) ==
+	atom expr => nil
+	expr is ["THROW", =gs,data] => true
+	    --this is pessimistic, but I know of no more accurate idea
+	expr is ["SEQ",:l] =>
+	  or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
+	or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
+    canReturn(data,level,exitCount,ValueFlag)
+  op = "COND" =>
+    level = exitCount =>
+      or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
+    or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
+		for v in rest expr]
+  op="IF" =>
+    expr is [.,a,b,c]
+    if not canReturn(a,0,0,true) and not (BOUNDP '$convert2NewCompiler and $convert2NewCompiler) then
+      SAY "IF statement can not cause consequents to be executed"
+      pp expr
+    canReturn(a,level,exitCount,nil) or canReturn(b,level,exitCount,ValueFlag)
+      or canReturn(c,level,exitCount,ValueFlag)
+  --now we have an ordinary form
+  atom op => and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
+  op is ["XLAM",args,bods] =>
+    and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
+  systemErrorHere '"canReturn" --for the time being
+
+compList(l,m is ["List",mUnder],e) ==
+  markImport m
+  markImport mUnder
+  null l => [NIL,m,e]
+  Tl:= [[.,mUnder,e]:=
+    comp(x,mUnder,e) or return "failed" for i in 1.. for x in l]
+  Tl="failed" => nil
+  T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e]
+
+compVector(l,m is ["Vector",mUnder],e) ==
+  markImport m
+  markImport mUnder
+  null l => [$EmptyVector,m,e]
+  Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
+  Tl="failed" => nil
+  [["VECTOR",:[T.expr for T in Tl]],m,e]
+
+compColon([":",f,t],m,e) ==
+  $insideExpressionIfTrue=true => compPretend(["pretend",f,t],m,e)
+    --if inside an expression, ":" means to convert to m "on faith"
+  f := markKillAll f
+  $lhsOfColon: local:= f
+  t:=
+    t := markKillAll t
+    atom t and (t':= ASSOC(t,getDomainsInScope e)) => t'
+    isDomainForm(t,e) and not $insideCategoryIfTrue =>
+      (if not member(t,getDomainsInScope e) then e:= addDomain(t,e); t)
+    isDomainForm(t,e) or isCategoryForm(t,e) => t
+    t is ["Mapping",m',:r] => t
+    unknownTypeError t
+    t
+  if $insideCapsuleFunctionIfTrue then markDeclaredImport t
+  f is ["LISTOF",:l] =>
+    (for x in l repeat T:= [.,.,e]:= compColon([":",x,t],m,e); T)
+  e:=
+    f is [op,:argl] and not (t is ["Mapping",:.]) =>
+      --for MPOLY--replace parameters by formal arguments: RDJ 3/83
+      newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList),
+	[(x is [":",a,m] => a; x) for x in argl],t)
+      signature:=
+	["Mapping",newTarget,:
+	  [(x is [":",a,m] => m;
+	      getmode(x,e) or systemErrorHere '"compColonOld") for x in argl]]
+      put(op,"mode",signature,e)
+    put(f,"mode",t,e)
+  if not $bootStrapMode and $insideFunctorIfTrue and
+    makeCategoryForm(t,e) is [catform,e] then
+	e:= put(f,"value",[genSomeVariable(),t,$noEnv],e)
+  ["/throwAway",getmode(f,e),e]
+
+compConstruct(form,m,e) == (T := compConstruct1(form,m,e)) and markConstruct(form,T) 
+  
+compConstruct1(form is ["construct",:l],m,e) ==
+  y:= modeIsAggregateOf("List",m,e) =>
+    T:= compList(l,["List",CADR y],e) => convert(T,m)
+  y:= modeIsAggregateOf("Vector",m,e) =>
+    T:= compVector(l,["Vector",CADR y],e) => convert(T,m)
+  T:= compForm(form,m,e) => T
+  for D in getDomainsInScope e repeat
+    (y:=modeIsAggregateOf("List",D,e)) and
+      (T:= compList(l,["List",CADR y],e)) and (T':= convert(T,m)) =>
+         return T'
+    (y:=modeIsAggregateOf("Vector",D,e)) and
+      (T:= compVector(l,["Vector",CADR y],e)) and (T':= convert(T,m)) =>
+         return T'
+
+compPretend(u := ["pretend",x,t],m,e) ==
+  t := markKillAll t
+  m := markKillAll m
+  e:= addDomain(t,e)
+  T:= comp(x,t,e) or comp(x,$EmptyMode,e) or return nil
+  if T.mode=t then warningMessage:= ["pretend",t," -- should replace by @"]
+  T1:= [T.expr,t,T.env]
+  t = "$" and m = "Rep" => markPretend(T1,T1)  -->! WATCH OUT: correct? !<--
+  T':= coerce(T1,m) =>
+    warningMessage =>
+      stackWarning warningMessage
+      markCompColonInside("@",T')
+    markPretend(T1,T')
+  nil
+
+compAtSign(["@",x,m'],m,e) ==
+  m' := markKillAll m'
+  m  := markKillAll m
+  e:= addDomain(m',e)
+  T:= comp(x,m',e) or return nil
+  coerce(T,m)
+
+compColonInside(x,m,e,m') ==
+  m' := markKillAll m'
+  e:= addDomain(m',e)
+  T:= comp(x,$EmptyMode,e) or return nil
+  if T.mode=m' then warningMessage:= [":",m'," -- should replace by ::"]
+  T:= [T.expr,m',T.env]
+  m := markKillAll m
+  T':= coerce(T,m) =>
+    warningMessage =>
+      stackWarning warningMessage
+      markCompColonInside("@",T')
+    stackWarning [":",m'," -- should replace by pretend"]
+    markCompColonInside("pretend",T')
+  nil
+
+resolve(min, mout) ==
+  din  := markKillAll min
+  dout := markKillAll mout
+  din=$NoValueMode or dout=$NoValueMode => $NoValueMode
+  dout=$EmptyMode => din
+  STRINGP din and dout = '(Symbol) => dout   ------> hack 8/14/94
+  STRINGP dout and din = '(Symbol) => din    ------> hack 8/14/94
+  din^=dout and (STRINGP din or STRINGP dout) =>
+    modeEqual(dout,$String) => dout
+    modeEqual(din,$String) =>  nil
+    mkUnion(din,dout)
+  dout
+
+coerce(T,m) ==
+  T := [T.expr,markKillAll T.mode,T.env]
+  m := markKillAll m
+  if not get(m, 'isLiteral,T.env) then markImport m
+  $InteractiveMode =>
+    keyedSystemError("S2GE0016",['"coerce",
+      '"function coerce called from the interpreter."])
+--==================> changes <======================
+--The following line is inappropriate for our needs:::
+--rplac(CADR T,substitute("$",$Rep,CADR T))
+  T' := coerce0(T,m) => T'
+  T := [T.expr,fullSubstitute("$",$Representation,T.mode),T.env]
+--==================> changes <======================
+  coerce0(T,m)
+
+coerce0(T,m) ==
+  T':= coerceEasy(T,m) => T'
+  T':= coerceSubset(T,m) => markCoerce(T,T','AUTOSUBSET)
+  T':= coerceHard(T,m)	 => markCoerce(T,T','AUTOHARD)
+  T':= coerceExtraHard(T,m) => T'
+  T.expr = "$fromCoerceable$" or isSomeDomainVariable m => nil
+  T' := coerceRep(T,m) => markCoerce(T,T','AUTOREP)
+  stackMessage fn(T.expr,T.mode,m) where
+      -- if from from coerceable, this coerce was just a trial coercion
+      -- from compFormWithModemap to filter through the modemaps
+    fn(x,m1,m2) ==
+      ["Cannot coerce","%b",x,"%d","%l","      of mode","%b",m1,"%d","%l",
+	"      to mode","%b",m2,"%d"]
+
+coerceSubset(T := [x,m,e],m') ==
+  m = $SmallInteger =>
+    m' = $Integer => [x,m',e]
+    m' = (r := get(x,'range,e)) or isSubset(r,m',e) => [x,r,e]
+    nil
+--  pp [m, m']
+  isSubset(m,m',e) or m="Rep" and m'="$" => [x,m',e]
+  m is ['SubDomain,=m',:.] => [x,m',e]
+  (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and
+     -- obviously this is temporary
+    eval substitute(x,"#1",pred) => [x,m',e]
+  (pred:= isSubset(m',maxSuperType(m,e),e)) and INTEGERP x -- again temporary
+    and eval substitute(x,"*",pred) =>
+      [x,m',e]
+  nil
+
+coerceRep(T,m) ==
+  md := T.mode
+  atom md => nil
+  CONTAINED('Rep,md) and SUBST('$,'Rep,md) = m or
+    CONTAINED('Rep,m) and SUBST('$,'Rep,m) = md => T
+  nil
+
+--- GET rid of XLAMs
+spadCompileOrSetq form ==
+	--bizarre hack to take account of the existence of "known" functions
+	--good for performance (LISPLLIB size, BPI size, NILSEC)
+  [nam,[lam,vl,body]] := form
+  CONTAINED("",body) => sayBrightly ['"  ",:bright nam,'" not compiled"]
+  if vl is [:vl',E] and body is [nam',: =vl'] then
+      LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam']
+      sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
+  else if (ATOM body or and/[ATOM x for x in body])
+	 and vl is [:vl',E] and not CONTAINED(E,body) then
+	   macform := ['XLAM,vl',body]
+	   LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
+	   sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
+  $insideCapsuleFunctionIfTrue => first COMP LIST form
+  compileConstructor form
+
+coerceHard(T,m) ==
+  $e: local:= T.env
+  m':= T.mode
+  STRINGP m' and modeEqual(m,$String) => [T.expr,m,$e]
+  modeEqual(m',m) or
+    (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and
+      modeEqual(m'',m) or
+        (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and
+          modeEqual(m'',m') => [T.expr,m,T.env]
+  STRINGP T.expr and T.expr=m => [T.expr,m,$e]
+  isCategoryForm(m,$e) =>
+      $bootStrapMode = true => [T.expr,m,$e]
+      extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e]
+      nil
+  nil
+
+coerceExtraHard(T is [x,m',e],m) ==
+  T':= autoCoerceByModemap(T,m) => T'
+  isUnionMode(m',e) is ["Union",:l] and (t:= hasType(x,e)) and
+    member(t,l) and (T':= autoCoerceByModemap(T,t)) and
+      (T'':= coerce(T',m)) => T''
+  m' is ['Record,:.] and m = $Expression =>
+      [['coerceRe2E,x,['ELT,COPY m',0]],m,e]
+  nil
+
+compCoerce(u := ["::",x,m'],m,e) ==
+  m' := markKillAll m'
+  e:= addDomain(m',e)
+  m := markKillAll m
+--------------> new code <-------------------
+  T:= compCoerce1(x,m',e) => coerce(T,m)
+  T := comp(x,$EmptyMode,e) or return nil
+  T.mode = $SmallInteger and
+    MEMQ(opOf m,'(NonNegativeInteger PositiveInteger)) =>
+      compCoerce(["::",["::",x,$Integer],m'],m,e)
+--------------> new code <-------------------
+  getmode(m',e) is ["Mapping",["UnionCategory",:l]] =>
+    l := [markKillAll x for x in l]
+    T:= (or/[compCoerce1(x,m1,e) for m1 in l]) or return nil
+    coerce([T.expr,m',T.env],m)
+
+compCoerce1(x,m',e) ==
+  T:= comp(x,m',e)
+  if null T then T := comp(x,$EmptyMode,e)
+  null T => return nil
+  m1:=
+    STRINGP T.mode => $String
+    T.mode
+  m':=resolve(m1,m')
+  T:=[T.expr,m1,T.env]
+  T':= coerce(T,m') => T'
+  T':= coerceByModemap(T,m') => T'
+  pred:=isSubset(m',T.mode,e) =>
+    gg:=GENSYM()
+    pred:= substitute(gg,"*",pred)
+    code:= ['PROG1,['LET,gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
+    [code,m',T.env]
+
+coerceByModemap([x,m,e],m') ==
+--+ modified 6/27 for new runtime system
+  u:=
+    [modemap
+      for (modemap:= [map,cexpr]) in getModemapList("coerce",1,e) | map is [.,t,
+        s] and (modeEqual(t,m') or isSubset(t,m',e))
+           and (modeEqual(s,m) or isSubset(m,s,e))] or return nil
+  mm:=first u  -- patch for non-trival conditons
+  fn := genDeltaEntry ['coerce,:mm]
+  T := [["call",fn,x],m',e]
+  markCoerceByModemap(x,m,m',markCallCoerce(x,m',T),nil)
+ 
+autoCoerceByModemap([x,source,e],target) ==
+  u:=
+    [cexpr
+      for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e) | map is [
+        .,t,s] and modeEqual(t,target) and modeEqual(s,source)] or return nil
+  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+  markCoerceByModemap(x,source,target,[["call",fn,x],target,e],true)
+
+--======================================================================
+--		      From compiler.boot
+--======================================================================
+--comp3x(x,m,$e) ==
+
+comp3(x,m,$e) ==
+    --returns a Triple or %else nil to signalcan't do'
+  $e:= addDomain(m,$e)
+  e:= $e --for debugging purposes
+  m is ["Mapping",:.] => compWithMappingMode(x,m,e)
+  m is ["QUOTE",a] => (x=a => [x,m,$e]; nil)
+  STRINGP m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil)
+  ^x or atom x => compAtom(x,m,e)
+  op:= first x
+  getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
+  op is ["KAPPA",sig,varlist,body] => compApply(sig,varlist,body,rest x,m,e)
+  op=":" => compColon(x,m,e)
+  op="::" => compCoerce(x,m,e)
+  not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
+    compTypeOf(x,m,e)
+  ------------special jump out code for PART (don't want $insideExpressionIfTrue=true)--
+  x is ['PART,:.] => compPART(x,m,e)
+  ----------------------------------
+  t:= qt(14,compExpression(x,m,e))
+  t is [x',m',e'] and not member(m',getDomainsInScope e') =>
+    qt(15,[x',m',addDomain(m',e')])
+  qt(16,t)
+
+yyyyy x == x
+compExpression(x,m,e) ==
+  $insideExpressionIfTrue: local:= true
+  if x is ['LET,['PART,.,w],[['elt,B,'new],['PART,.,["#",['PART,.,l]]],:.],:.] then yyyyy x 
+  x := compRenameOp x
+  atom first x and (fn:= GETL(first x,"SPECIAL")) =>
+    FUNCALL(fn,x,m,e)
+  compForm(x,m,e)
+
+compRenameOp x ==   ----------> new 12/3/94
+  x is [op,:r] and op is ['PART,.,op1] =>
+    [op1,:r]
+  x
+
+compCase(["case",x,m1],m,e) ==
+  m' := markKillAll m1
+  e:= addDomain(m',e)
+  T:= compCase1(x,m',e) => coerce(T,m)
+  nil
+
+compCase1(x,m,e) ==
+  x1 :=
+    x is ['PART,.,a] => a
+    x
+  [x',m',e']:= comp(x1,$EmptyMode,e) or return nil
+  if m' = "$" then (m' := IFCAR get('Rep,'value,e)) and (switchMode := true)
+  --------------------------------------------------------------------------
+  m' isnt ['Union,:r] => nil
+  mml := [mm for (mm := [map,cexpr]) in getModemapList("case",2,e') 
+    | map is [.,.,s,t] and modeEqual(t,m) and 
+         (modeEqual(s,m') or switchMode and modeEqual(s,"$"))]
+        or return nil
+  u := [cexpr for [.,cexpr] in mml] 
+  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+  tag := genCaseTag(m, r, 1) or return nil
+  x1 :=
+    switchMode => markRepper('rep, x)
+    x
+  markCase(x, tag, markCaseWas(x1,[["call",fn,x'],$Boolean,e']))
+
+genCaseTag(t,l,n) ==
+  l is [x, :l] =>
+    x = t     => 
+      STRINGP x => INTERN x
+      INTERN STRCONC("value", STRINGIMAGE n)
+    x is ["::",=t,:.] => t
+    STRINGP x => genCaseTag(t, l, n)
+    genCaseTag(t, l, n + 1)
+  nil
+
+compIf(["IF",aOrig,b,c],m,E) ==
+  a := markKillButIfs aOrig
+  [xa,ma,Ea,Einv]:= compBoolean(a,aOrig,$Boolean,E) or return nil
+  [xb,mb,Eb]:= Tb:= compFromIf(b,m,Ea) or return nil
+  [xc,mc,Ec]:= Tc:= compFromIf(c,resolve(mb,m),Einv) or return nil
+  xb':= coerce(Tb,mc) or return nil
+  x:= ["IF",xa,quotify xb'.expr,quotify xc]
+  (returnEnv:= Env(xb'.env,Ec,xb'.expr,xc,E)) where
+    Env(bEnv,cEnv,b,c,E) ==
+      canReturn(b,0,0,true) =>
+        (canReturn(c,0,0,true) => intersectionEnvironment(bEnv,cEnv); bEnv)
+      canReturn(c,0,0,true) => cEnv
+      E
+  [x,mc,returnEnv]
+
+compBoolean(p,pWas,m,Einit) ==
+  op := opOf p
+  [p',m,E]:= 
+    fop := LASSOC(op,'((and . compAnd) (or . compOr) (not . compNot))) =>
+       APPLY(fop,[p,pWas,m,Einit]) or return nil
+    T := comp(p,m,Einit) or return nil
+    markAny('compBoolean,pWas,T) 
+  [p',m,getSuccessEnvironment(markKillAll p,E),
+	getInverseEnvironment(markKillAll p,E)]
+
+compAnd([op,:args], pWas, m, e) ==
+--called ONLY from compBoolean
+  cargs := [T.expr for x in args 
+              | [.,.,e,.] := T := compBoolean(x,x,$Boolean,e) or return nil]
+  null cargs => nil
+  coerce(markAny('compAnd,pWas,[["AND",:cargs],$Boolean,e]),m)
+
+compOr([op,:args], pWas, m, e) ==
+--called ONLY from compBoolean
+  cargs := [T.expr for x in args 
+              | [.,.,.,e] := T := compBoolean(x,x,$Boolean,e) or return nil]
+  null cargs => nil
+  coerce(markAny('compOr,pWas, [["OR",:cargs],$Boolean,e]),m)
+
+compNot([op,arg], pWas, m, e) ==
+--called ONLY from compBoolean
+  [x,m1,.,ei] := compBoolean(arg,arg,$Boolean,e) or return nil
+  coerce(markAny('compNot, pWas, [["NOT",x],$Boolean,ei]),m)
+
+compDefine(form,m,e) ==
+  $tripleCache: local:= nil
+  $tripleHits: local:= 0
+  $macroIfTrue: local
+  $packagesUsed: local
+  ['DEF,.,originalSignature,.,body] := form
+  if not $insideFunctorIfTrue then
+    $originalBody := COPY body
+  compDefine1(form,m,e)
+
+compDefine1(form,m,e) ==
+  $insideExpressionIfTrue: local:= false
+  --1. decompose after macro-expanding form
+  ['DEF,lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
+  $insideWhereIfTrue and isMacro(form,e) and (m=$EmptyMode or m=$NoValueMode)
+     => [lhs,m,put(first lhs,'macro,rhs,e)]
+  null signature.target and not MEMQ(KAR rhs,$ConstructorNames) and
+    (sig:= getSignatureFromMode(lhs,e)) =>
+  -- here signature of lhs is determined by a previous declaration
+      compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e)
+  if signature.target=$Category then $insideCategoryIfTrue:= true
+  if signature.target is ['Mapping,:map] then
+    signature:= map
+    form:= ['DEF,lhs,signature,specialCases,rhs]
+
+
+-- RDJ (11/83): when argument and return types are all declared,
+--  or arguments have types declared in the environment,
+--  and there is no existing modemap for this signature, add
+--  the modemap by a declaration, then strip off declarations and recurse
+  e := compDefineAddSignature(lhs,signature,e)
+-- 2. if signature list for arguments is not empty, replace ('DEF,..) by
+--	 ('where,('DEF,..),..) with an empty signature list;
+--     otherwise, fill in all NILs in the signature
+  not (and/[null x for x in rest signature]) => compDefWhereClause(form,m,e)
+  signature.target=$Category =>
+    compDefineCategory(form,m,e,nil,$formalArgList)
+  isDomainForm(rhs,e) and not $insideFunctorIfTrue =>
+    if null signature.target then signature:=
+      [getTargetFromRhs(lhs,rhs,giveFormalParametersValues(rest lhs,e)),:
+	  rest signature]
+    rhs:= addEmptyCapsuleIfNecessary(signature.target,rhs)
+    compDefineFunctor(['DEF,lhs,signature,specialCases,rhs],m,e,nil,
+      $formalArgList)
+  null $form => stackAndThrow ['"bad == form ",form]
+  newPrefix:=
+    $prefix => INTERN STRCONC(encodeItem $prefix,'",",encodeItem $op)
+    getAbbreviation($op,#rest $form)
+  compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList)
+
+compDefineCategory(df,m,e,prefix,fal) ==
+  $domainShell: local -- holds the category of the object being compiled
+  $lisplibCategory: local
+  not $insideFunctorIfTrue and $LISPLIB =>
+    compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
+  compDefineCategory1(df,m,e,prefix,fal)
+
+compDefineCategory1(df,m,e,prefix,fal) ==
+  $DEFdepth     : local := 0		--for conversion to new compiler 3/93
+  $capsuleStack : local := nil		--for conversion to new compiler 3/93
+  $predicateStack:local := nil          --for conversion to new compiler 3/93
+  $signatureStack:local := nil          --for conversion to new compiler 3/93
+  $importStack	: local := nil		--for conversion to new compiler 3/93
+  $globalImportStack  : local := nil	--for conversion to new compiler 3/93
+  $catAddForm  : local := nil           --for conversion to new compiler 2/95
+  $globalDeclareStack : local := nil
+  $globalImportDefAlist: local:= nil
+  $localMacroStack  : local := nil	--for conversion to new compiler 3/93
+  $freeStack   : local := nil		--for conversion to new compiler 3/93
+  $domainLevelVariableList: local := nil--for conversion to new compiler 3/93
+  $categoryTranForm : local := nil	--for conversion to new compiler 10/93
+  ['DEF,form,sig,sc,body] := df
+  body := markKillAll body --these parts will be replaced by compDefineLisplib
+  categoryCapsule :=
+--+
+    body is ['add,cat,capsule] =>
+      body := cat
+      capsule
+    nil
+  [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
+--+ next two lines
+--  if BOUNDP '$convertingSpadFile and $convertingSpadFile then nil
+--  else
+  if categoryCapsule and not $bootStrapMode then
+    [.,.,e] :=
+      $insideCategoryPackageIfTrue: local := true  --see NRTmakeSlot1
+      $categoryPredicateList: local :=
+	  makeCategoryPredicates(form,$lisplibCategory)
+      defform := mkCategoryPackage(form,cat,categoryCapsule)
+      ['DEF,[.,arg,:.],:.] := defform
+      $categoryNameForDollar :local := arg
+      compDefine1(defform,$EmptyMode,e)
+  else
+    [body,T] := $categoryTranForm
+    markFinish(body,T)
+
+  [d,m,e]
+
+compDefineCategory2(form,signature,specialCases,body,m,e,
+  $prefix,$formalArgList) ==
+    --1. bind global variables
+    $insideCategoryIfTrue: local:= true
+    $TOP__LEVEL: local
+    $definition: local
+		 --used by DomainSubstitutionFunction
+    $form: local
+    $op: local
+    $extraParms: local
+	     --Set in DomainSubstitutionFunction, used further down
+--  1.1	 augment e to add declaration $: <form>
+    [$op,:argl]:= $definition:= form
+    e:= addBinding("$",[['mode,:$definition]],e)
+
+--  2. obtain signature
+    signature':=
+      [first signature,:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
+    e:= giveFormalParametersValues(argl,e)
+
+--   3. replace arguments by $1,..., substitute into body,
+--     and introduce declarations into environment
+    sargl:= TAKE(# argl, $TriangleVariableList)
+    $functorForm:= $form:= [$op,:sargl]
+    $formalArgList:= [:sargl,:$formalArgList]
+    aList:= [[a,:sa] for a in argl for sa in sargl]
+    formalBody:= SUBLIS(aList,body)
+    signature' := SUBLIS(aList,signature')
+--Begin lines for category default definitions
+    $functionStats: local:= [0,0]
+    $functorStats: local:= [0,0]
+    $frontier: local := 0
+    $getDomainCode: local := nil
+    $addForm: local:= nil
+    for x in sargl for t in rest signature' repeat
+      [.,.,e]:= compMakeDeclaration([":",x,t],m,e)
+
+--   4. compile body in environment of %type declarations for arguments
+    op':= $op
+    -- following line causes cats with no with or Join to be fresh copies
+    if opOf(formalBody)^='Join and opOf(formalBody)^='mkCategory then
+	   formalBody := ['Join, formalBody]
+    T := compOrCroak(formalBody,signature'.target,e)
+--------------------> new <-------------------
+    $catAddForm :=
+      $originalBody is ['add,y,:.] => y
+      $originalBody
+    $categoryTranForm := [$originalBody,[$form,['Mapping,:signature'],T.env]]
+--------------------> new <-------------------
+    body:= optFunctorBody markKillAll T.expr
+    if $extraParms then
+      formals:=actuals:=nil
+      for u in $extraParms repeat
+	formals:=[CAR u,:formals]
+	actuals:=[MKQ CDR u,:actuals]
+      body := ['sublisV,['PAIR,['QUOTE,formals],['LIST,:actuals]],body]
+    if argl then body:=	 -- always subst for args after extraparms
+	['sublisV,['PAIR,['QUOTE,sargl],['LIST,:
+	  [['devaluate,u] for u in sargl]]],body]
+    body:=
+      ['PROG1,['LET,g:= GENSYM(),body],['SETELT,g,0,mkConstructor $functorForm]]
+    fun:= compile [op',['LAM,sargl,body]]
+
+--  5. give operator a 'modemap property
+    pairlis:= [[a,:v] for a in argl for v in $FormalMapVariableList]
+    parSignature:= SUBLIS(pairlis,signature')
+    parForm:= SUBLIS(pairlis,form)
+----	lisplibWrite('"compilerInfo",
+----	  ['SETQ,'$CategoryFrame,
+----	   ['put,['QUOTE,op'],'
+----	    (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
+----	      MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
+    --Equivalent to the following two lines, we hope
+    if null sargl then
+      evalAndRwriteLispForm('NILADIC,
+	    ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
+
+--   6. put modemaps into InteractiveModemapFrame
+    $domainShell :=
+      BOUNDP '$convertingSpadFile and $convertingSpadFile => nil
+      eval [op',:MAPCAR('MKQ,sargl)]
+    $lisplibCategory:= formalBody
+----	if $LISPLIB then
+----	  $lisplibForm:= form
+----	  $lisplibKind:= 'category
+----	  modemap:= [[parForm,:parSignature],[true,op']]
+----	  $lisplibModemap:= modemap
+----	  $lisplibCategory:= formalBody
+----	  form':=[op',:sargl]
+----	  augLisplibModemapsFromCategory(form',formalBody,signature')
+    [fun,'(Category),e]
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/wi2.boot.pamphlet b/src/interp/wi2.boot.pamphlet
new file mode 100644
index 00000000..75e650a3
--- /dev/null
+++ b/src/interp/wi2.boot.pamphlet
@@ -0,0 +1,1256 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/wi2.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
+    ['DEF,form,signature,$functorSpecialCases,body] := df
+    signature := markKillAll signature
+    if NRTPARSE = true then
+      [lineNumber,:$functorSpecialCases] := $functorSpecialCases
+--  1. bind global variables
+    $addForm: local
+    $viewNames: local:= nil
+ 
+            --This list is only used in genDomainViewName, for generating names
+            --for alternate views, if they do not already exist.
+            --format: Alist: (domain name . sublist)
+            --sublist is alist: category . name of view
+    $functionStats: local:= [0,0]
+    $functorStats: local:= [0,0]
+    $DEFdepth :    local  := 0            --for conversion to new compiler 3/93
+    $capsuleStack : local := nil          --for conversion to new compiler 3/93
+    $predicateStack:local := nil          --for conversion to new compiler 3/93
+    $signatureStack:local := nil          --for conversion to new compiler 3/93
+    $importStack  : local := nil          --for conversion to new compiler 3/93
+    $globalImportStack  : local := nil    --for conversion to new compiler 3/93
+    $globalDeclareStack : local := nil
+    $globalImportDefAlist: local:= nil
+    $localMacroStack  : local := nil      --for conversion to new compiler 3/93
+    $freeStack   : local := nil           --for conversion to new compiler 3/93
+    $domainLevelVariableList: local := nil--for conversion to new compiler 3/93
+    $localLoopVariables: local := nil
+    $pathStack : local := nil
+    $form: local
+    $op: local
+    $signature: local
+    $functorTarget: local
+    $Representation: local
+         --Set in doIt, accessed in the compiler - compNoStacking
+    $LocalDomainAlist: local  --set in doIt, accessed in genDeltaEntry
+    $LocalDomainAlist:= nil
+    $functorForm: local
+    $functorLocalParameters: local
+    $CheckVectorList: local
+                  --prevents CheckVector from printing out same message twice
+    $getDomainCode: local -- code for getting views
+    $insideFunctorIfTrue: local:= true
+    $functorsUsed: local --not currently used, finds dependent functors
+    $setelt: local :=
+      $QuickCode = true => 'QSETREFV
+      'SETELT
+    $TOP__LEVEL: local
+    $genFVar: local:= 0
+    $genSDVar: local:= 0
+    originale:= $e
+    [$op,:argl]:= form
+    $formalArgList:= [:argl,:$formalArgList]
+    $pairlis := [[a,:v] for a in argl for v in $FormalMapVariableList]
+    $mutableDomain: local :=
+      -- all defaulting packages should have caching turned off
+       isCategoryPackageName $op or   
+         (if BOUNDP '$mutableDomains then MEMQ($op,$mutableDomains)
+            else false )   --true if domain has mutable state
+    signature':=
+      [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]]
+    $functorForm:= $form:= [$op,:argl]
+    $globalImportStack := 
+       [markKillAll x for x in rest $functorForm for typ in rest signature' 
+           | GETDATABASE(opOf typ,'CONSTRUCTORKIND) = 'category]
+    if null first signature' then signature':=
+      modemap2Signature getModemap($form,$e)
+    target:= first signature'
+    $functorTarget:= target
+    $e:= giveFormalParametersValues(argl,$e)
+    [ds,.,$e]:= compMakeCategoryObject(target,$e) or
+--+ copy needed since slot1 is reset; compMake.. can return a cached vector
+      sayBrightly '"   cannot produce category object:"
+      pp target
+      return nil
+    $domainShell:= COPY_-SEQ ds
+    $attributesName:local := INTERN STRCONC(PNAME $op,'";attributes")
+    attributeList := ds.2 --see below under "loadTimeAlist"
+--+ 7 lines for $NRT follow
+    $goGetList: local := nil
+-->--these globals used by NRTmakeCategoryAlist, set by NRTsetVector4Part1
+    $condAlist: local := nil
+    $uncondAlist: local := nil
+-->>-- next global initialized here, reset by NRTbuildFunctor
+    $NRTslot1PredicateList: local :=
+      REMDUP [CADR x for x in attributeList]
+-->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT)
+    $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList
+    $NRTslot1Info: local  --set in NRTmakeSlot1 called by NRTbuildFunctor
+       --this is used below to set $lisplibSlot1 global
+    $NRTbase: local := 6 -- equals length of $domainShell
+    $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
+    $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
+    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
+    $NRTaddList: local := nil --list of fncts not defined in capsule (added)
+    $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
+    $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
+    $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
+    -- the above optimizes the calls to local domains
+    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
+    $functionLocations: local := nil --locations of defined functions in source
+    -- generate slots for arguments first, then for $NRTaddForm in compAdd
+    for x in argl repeat NRTgetLocalIndex x
+    [.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e)
+    --The following loop sees if we can economise on ADDed operations
+    --by using those of Rep, if that is the same. Example: DIRPROD
+    if $insideCategoryPackageIfTrue^= true  then
+      if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector))
+         and FindRep(cb) = ab
+               where FindRep cb ==
+                 u:=
+                   while cb repeat
+                     ATOM cb => return nil
+                     cb is [['LET,'Rep,v,:.],:.] => return (u:=v)
+                     cb:=CDR cb
+                 u
+      then $e:= augModemapsFromCategoryRep('_$,ab,cb,target,$e)
+      else $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e)
+    $signature:= signature'
+    operationAlist:= SUBLIS($pairlis,$domainShell.(1))
+    parSignature:= SUBLIS($pairlis,signature')
+    parForm:= SUBLIS($pairlis,form)
+ 
+--  (3.1) now make a list of the functor's local parameters; for
+--  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
+--  in this case, D is replaced by D1,..,Dn (gensyms) which are set
+--  to the A1,..,An view of D
+    if isPackageFunction() then $functorLocalParameters:=
+      [nil,:
+        [nil
+          for i in 6..MAXINDEX $domainShell |
+            $domainShell.i is [.,.,['ELT,'_$,.]]]]
+    --leave space for vector ops and package name to be stored
+--+
+    $functorLocalParameters:=
+      argPars :=
+        makeFunctorArgumentParameters(argl,rest signature',first signature')
+ -- must do above to bring categories into scope --see line 5 of genDomainView
+      argl
+--  4. compile body in environment of %type declarations for arguments
+    op':= $op
+    rettype:= signature'.target
+    SETQ($myFunctorBody, body)  -------->  new  <--------
+    T:= compFunctorBody(body,rettype,$e,parForm)
+---------------> new <---------------------
+    BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+       return markFinish($originalBody,[$form,['Mapping,:signature'],T.env])
+---------------> new <---------------------
+    -- If only compiling certain items, then ignore the body shell.
+    $compileOnlyCertainItems =>
+       reportOnFunctorCompilation()
+       [nil, ['Mapping, :signature'], originale]
+ 
+    body':= T.expr
+    lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM
+    fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']])
+    --The above statement stops substitutions gettting in one another's way
+--+
+    operationAlist := SUBLIS($pairlis,$lisplibOperationAlist)
+    if $LISPLIB then
+      augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
+    reportOnFunctorCompilation()
+ 
+--  5. give operator a 'modemap property
+--   if $functorsUsed then MAKEPROP(op',"NEEDS",$functorsUsed)
+    $insideFunctorIfTrue:= false
+    if $LISPLIB then
+      $lisplibKind:=
+        $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package
+        'domain
+      $lisplibForm:= form
+      modemap:= [[parForm,:parSignature],[true,op']]
+      $lisplibModemap:= modemap
+      if null $bootStrapMode then
+        $NRTslot1Info := NRTmakeSlot1Info()
+        $isOpPackageName: local := isCategoryPackageName $op
+        if $isOpPackageName then lisplibWrite('"slot1DataBase",
+          ['updateSlot1DataBase,MKQ $NRTslot1Info],$libFile)
+        $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations)
+        $lisplibCategoriesExtended := SUBLIS($pairlis,$lisplibCategoriesExtended)
+        -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended
+        libFn := getConstructorAbbreviation op'
+        $lookupFunction: local :=
+            NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm)
+            --either lookupComplete (for forgetful guys) or lookupIncomplete
+        $byteAddress :local := 0
+        $byteVec :local := nil
+        $NRTslot1PredicateList :=
+          [simpBool x for x in $NRTslot1PredicateList]
+        rwriteLispForm('loadTimeStuff,
+          ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
+      $lisplibSlot1 := $NRTslot1Info --NIL or set by $NRTmakeSlot1
+      $lisplibOperationAlist:= operationAlist
+      $lisplibMissingFunctions:= $CheckVectorList
+    lisplibWrite('"compilerInfo",
+       ['SETQ,'$CategoryFrame,
+        ['put,['QUOTE,op'],'
+         (QUOTE isFunctor),
+          ['QUOTE,operationAlist],['addModemap,['QUOTE,op'],['
+           QUOTE,parForm],['QUOTE,parSignature],true,['QUOTE,op'],
+            ['put,['QUOTE,op' ],'(QUOTE mode),
+             ['QUOTE,['Mapping,:parSignature]],'$CategoryFrame]]]], $libFile)
+    if null argl then
+      evalAndRwriteLispForm('NILADIC,
+            ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'NILADIC], true])
+    [fun,['Mapping,:signature'],originale]
+
+makeFunctorArgumentParameters(argl,sigl,target) ==
+  $alternateViewList: local:= nil
+  $forceAdd: local:= true
+  $ConditionalOperators: local
+  target := markKillAll target
+  ("append"/[fn(a,augmentSig(s,findExtras(a,target)))
+              for a in argl for s in sigl]) where
+    findExtras(a,target) ==
+      --  see if conditional information implies anything else
+      --  in the signature of a
+      target is ['Join,:l] => "union"/[findExtras(a,x) for x in l]
+      target is ['CATEGORY,.,:l] => "union"/[findExtras1(a,x) for x in l] where
+        findExtras1(a,x) ==
+          x is ['AND,:l] => "union"/[findExtras1(a,y) for y in l]
+          x is ['OR,:l] => "union"/[findExtras1(a,y) for y in l]
+          x is ['IF,c,p,q] =>
+            union(findExtrasP(a,c),
+                  union(findExtras1(a,p),findExtras1(a,q))) where
+              findExtrasP(a,x) ==
+                x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
+                x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
+                x is ['has,=a,y] and y is ['SIGNATURE,:.] => [y]
+                nil
+        nil
+    augmentSig(s,ss) ==
+       -- if we find something extra, add it to the signature
+      null ss => s
+      for u in ss repeat
+        $ConditionalOperators:=[CDR u,:$ConditionalOperators]
+      s is ['Join,:sl] =>
+        u:=ASSQ('CATEGORY,ss) =>
+          SUBST([:u,:ss],u,s)
+        ['Join,:sl,['CATEGORY,'package,:ss]]
+      ['Join,s,['CATEGORY,'package,:ss]]
+    fn(a,s) ==
+      isCategoryForm(s,$CategoryFrame) =>
+        s is ["Join",:catlist] => genDomainViewList0(a,rest s)
+        [genDomainView(a,a,s,"getDomainView")]
+      [a]
+
+compDefineCapsuleFunction(df,m,oldE,$prefix,$formalArgList) ==
+    ['DEF,form,originalSignature,specialCases,body] := df
+    signature := markKillAll originalSignature
+    $markFreeStack: local := nil       --holds "free variables"
+    $localImportStack : local := nil   --local import stack for function
+    $localDeclareStack: local := nil   
+    $localLoopVariables: local := nil
+    originalDef := COPY df
+    [lineNumber,:specialCases] := specialCases
+    e := oldE
+    --1. bind global variables
+    $form: local
+    $op: local
+    $functionStats: local:= [0,0]
+    $argumentConditionList: local
+    $finalEnv: local
+             --used by ReplaceExitEtc to get a common environment
+    $initCapsuleErrorCount: local:= #$semanticErrorStack
+    $insideCapsuleFunctionIfTrue: local:= true
+    $CapsuleModemapFrame: local:= e
+    $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
+    $insideExpressionIfTrue: local:= true
+    $returnMode:= m
+    [$op,:argl]:= form
+    $form:= [$op,:argl]
+    argl:= stripOffArgumentConditions argl
+    $formalArgList:= [:argl,:$formalArgList]
+ 
+    --let target and local signatures help determine modes of arguments
+    argModeList:=
+      identSig:= hasSigInTargetCategory(argl,form,first signature,e) =>
+        (e:= checkAndDeclare(argl,form,identSig,e); rest identSig)
+      [getArgumentModeOrMoan(a,form,e) for a in argl]
+    argModeList:= stripOffSubdomainConditions(argModeList,argl)
+    signature':= [first signature,:argModeList]
+    if null identSig then  --make $op a local function
+      oldE := put($op,'mode,['Mapping,:signature'],oldE)
+ 
+    --obtain target type if not given
+    if null first signature' then signature':=
+      identSig => identSig
+      getSignature($op,rest signature',e) or return nil
+    e:= giveFormalParametersValues(argl,e)
+ 
+    $signatureOfForm:= signature' --this global is bound in compCapsuleItems
+    $functionLocations := [[[$op,$signatureOfForm],:lineNumber],
+      :$functionLocations]
+    e:= addDomain(first signature',e)
+    e:= compArgumentConditions e
+ 
+    if $profileCompiler then
+      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
+ 
+ 
+    --4. introduce needed domains into extendedEnv
+    for domain in signature' repeat e:= addDomain(domain,e)
+ 
+    --6. compile body in environment with extended environment
+    rettype:= resolve(signature'.target,$returnMode)
+ 
+    localOrExported :=
+      null member($op,$formalArgList) and
+        getmode($op,e) is ['Mapping,:.] => 'local
+      'exported
+ 
+    --6a skip if compiling only certain items but not this one
+    -- could be moved closer to the top
+    formattedSig := formatUnabbreviated ['Mapping,:signature']
+    $compileOnlyCertainItems and _
+      not member($op, $compileOnlyCertainItems) =>
+        sayBrightly ['"   skipping ", localOrExported,:bright $op]
+        [nil,['Mapping,:signature'],oldE]
+    sayBrightly ['"   compiling ",localOrExported,
+      :bright $op,'": ",:formattedSig]
+---------------------> new <---------------------------------
+    returnType := signature'.target
+--  trialT := returnType = "$" and get("Rep",'value,e) and comp(body,'Rep,e)
+    trialT := returnType = "$" and comp(body,$EmptyMode,e)
+    ------------------------------------------------------  11/1/94    
+    -- try comp-ing in $EmptyMode; if succeed 
+    --   if we succeed then trialT.mode = "$" or "Rep"
+    --   do a coerce to get the correct result
+    T := (trialT and coerce(trialT,returnType)) 
+         -------------------------------------- 11/1/94
+          or CATCH('compCapsuleBody, compOrCroak(body,returnType,e))
+    markChanges(originalDef,T,$signatureOfForm)
+    [nil,['Mapping,:signature'],oldE]
+    ---------------------------------
+ 
+compCapsuleInner(itemList,m,e) ==
+  e:= addInformation(m,e)
+           --puts a new 'special' property of $Information
+  data:= ["PROGN",:itemList]
+      --RPLACd by compCapsuleItems and Friends
+  e:= compCapsuleItems(itemList,nil,e)
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+     [nil,m,e] --nonsense but that's fine
+  localParList:= $functorLocalParameters
+  if $addForm then data:= ['add,$addForm,data]
+  code:=
+    $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data
+    processFunctorOrPackage($form,$signature,data,localParList,m,e)
+  [MKPF([:$getDomainCode,code],"PROGN"),m,e]
+
+compSingleCapsuleItem(item,$predl,$e) ==
+  $localImportStack : local := nil
+  $localDeclareStack: local := nil
+  $markFreeStack: local := nil
+  newItem := macroExpandInPlace(item,qe(25,$e))
+  qe(26,$e)
+  doIt(newItem, $predl)
+  qe(27,$e)
+  $e
+ 
+compImport(["import",:doms],m,e) ==
+  for dom in doms repeat 
+    dom := markKillAll dom
+    markImport dom
+    e:=addDomain(dom,e)
+  ["/throwAway",$NoValueMode,e]
+ 
+mkUnion(a,b) ==
+  b="$" and $Rep is ["Union",:l] => b
+  a is ["Union",:l] =>
+    b is ["Union",:l'] => ["Union",:setUnion(l,l')]
+    member(b, l) => a
+    ["Union",:setUnion([b],l)]
+  b is ["Union",:l] => 
+    member(a, l) => b
+    ["Union",:setUnion([a],l)]
+  STRINGP a => ["Union",b,a]
+  ["Union",a,b]
+
+compForMode(x,m,e) ==
+  $compForModeIfTrue: local:= true
+  $convert2NewCompiler: local := nil
+  comp(x,m,e)
+ 
+compMakeCategoryObject(c,$e) ==
+  not isCategoryForm(c,$e) => nil
+  c := markKillAll c
+  u:= mkEvalableCategoryForm c => [eval markKillAll u,$Category,$e]
+  nil
+ 
+macroExpand(x,e) ==   --not worked out yet
+  atom x => (u:= get(x,'macro,e) => macroExpand(u,e); x)
+  x is ['DEF,lhs,sig,spCases,rhs] =>
+    ['DEF,macroExpand(lhs,e), macroExpandList(sig,e),macroExpandList(spCases,e),
+      macroExpand(rhs,e)]
+  x is ['MI,a,b] => 
+      ['MI,a,macroExpand(b,e)]
+  macroExpandList(x,e)
+ 
+getSuccessEnvironment(a,e) ==
+  -- the next four lines try to ensure that explicit special-case tests
+  --  prevent implicit ones from being generated
+  a is ["has",x,m] =>
+    x := unLet x   
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
+    e
+  a is ["is",id,m] =>
+    id := unLet id
+    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
+         e:=put(id,"specialCase",m,e)
+         currentProplist:= getProplist(id,e)
+         [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
+         newProplist:= consProplistOf(id,currentProplist,"value",removeEnv T)
+         addBinding(id,newProplist,e)
+    e
+  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
+    put(x,"condition",[a,:get(x,"condition",e)],e)
+  e
+ 
+getInverseEnvironment(a,E) ==
+  atom a => E
+  [op,:argl]:= a
+-- the next five lines try to ensure that explicit special-case tests
+-- prevent implicit ones from being generated
+  op="has" =>
+    [x,m]:= argl
+    x := unLet x
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
+    E
+  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
+           --the next two lines are necessary to get 3-branched Unions to work
+           -- old-style unions, that is
+    if corrupted? get(x,"condition",E) then systemError 'condition
+    (get(x,"condition",E) is [["OR",:oldpred]]) and member(a,oldpred) =>
+      put(x,"condition",LIST MKPF(delete(a,oldpred),"OR"),E)
+    getUnionMode(x,E) is ["Union",:l] or systemError 'Union
+    if corrupted? l then systemError 'list
+    l':= delete(m,l)
+    for u in l' repeat
+       if u is ['_:,=m,:.] then l':= delete(u,l')
+    newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
+    put(x,"condition",[newpred,:get(x,"condition",E)],E)
+  E
+
+unLet x ==
+  x is ['LET,u,:.] => unLet u
+  x
+
+corrupted? u ==
+  u is [op,:r] =>
+    MEMQ(op,'(WI MI PART)) => true
+    or/[corrupted? x for x in r]
+  false
+
+--======================================================================
+--                    From apply.boot
+--======================================================================
+applyMapping([op,:argl],m,e,ml) ==
+  #argl^=#ml-1 => nil
+  isCategoryForm(first ml,e) =>
+                                --is op a functor?
+    pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
+    ml' := SUBLIS(pairlis, ml)
+    argl':=
+      [T.expr for x in argl for m' in rest ml'] where
+        T() == [.,.,e]:= comp(x,m',e) or return "failed"
+    if argl'="failed" then return nil
+    form:= [op,:argl']
+---------------------> new <----------------------------
+    if constructor? op then form := markKillAll form
+---------------------> new <----------------------------
+    convert([form,first ml',e],m)
+  argl':=
+    [T.expr for x in argl for m' in rest ml] where
+      T() == [.,.,e]:= comp(x,m',e) or return "failed"
+  if argl'="failed" then return nil
+  form:=
+    not member(op,$formalArgList) and ATOM op and not get(op,'value,e) =>
+      nprefix := $prefix or
+   -- following needed for referencing local funs at capsule level
+        getAbbreviation($op,#rest $form)
+      [op',:argl',"$"] where
+        op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
+    ['call,['applyFun,op],:argl']
+  pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
+  convert([form,SUBLIS(pairlis,first ml),e],m)
+ 
+compFormWithModemap(form,m,e,modemap) ==
+  compFormWithModemap1(form,m,e,modemap,true) or compFormWithModemap1(form,m,e,modemap,false)
+
+compFormWithModemap1(form,m,e,modemap,Rep2Dollar?) ==
+  [op,:argl] := form := markKillExpr form
+  [[dc,:.],:.] := modemap
+----------> new: <-----------
+  if Rep2Dollar? then 
+    if dc = 'Rep then
+      modemap := SUBST('Rep,'_$,modemap)
+      m       := SUBST('Rep,'_$,m)
+    else return nil
+----------> new: <-----------
+  [map:= [.,target,:.],[pred,impl]]:= modemap
+  -- this fails if the subsuming modemap is conditional
+  --impl is ['Subsumed,:.] => nil
+  if isCategoryForm(target,e) and isFunctor op then
+    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
+    [map:= [.,target,:.],:cexpr]:= modemap
+  sv:=listOfSharpVars map
+  if sv then
+     -- SAY [ "compiling ", op, " in compFormWithModemap,
+     -- mode= ",map," sharp vars=",sv]
+    for x in argl for ss in $FormalMapVariableList repeat
+      if ss in sv then
+        [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap)
+        -- SAY ["new map is",map]
+  not (target':= coerceable(target,m,e)) => nil
+  markMap := map
+  map:= [target',:rest map]
+  [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil
+ 
+  --generate code; return
+  T:=
+    e':=
+      Tl => (LAST Tl).env
+      e
+    [x',m',e'] where
+      m':= SUBLIS(sl,map.(1))
+      x':=
+        form':= [f,:[t.expr for t in Tl]]
+        m'=$Category or isCategoryForm(m',e) => form'
+        -- try to deal with new-style Unions where we know the conditions
+        op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and
+          (c:=get(z,'condition,e)) and
+            c is [['case,=z,c1]] and
+              (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
+-- first is a full tag, as placed by getInverseEnvironment
+-- second is what getSuccessEnvironment will place there
+                ["CDR",z]
+        markTran(form,form',markMap,e')
+  qt(18,T)
+  convert(T,m)
+
+convert(T,m) ==
+  tcheck T
+  qe(23,T.env)
+  coerce(T,resolve(T.mode,m) or return nil)
+
+compElt(origForm,m,E) ==
+  form := markKillAll origForm
+  form isnt ["elt",aDomain,anOp] => compForm(origForm,m,E)
+  aDomain="Lisp" =>
+    markLisp([anOp',m,E],E)where anOp'() == (anOp=$Zero => 0; anOp=$One => 1; anOp)
+  isDomainForm(aDomain,E) =>
+    markImport opOf aDomain
+    E:= addDomain(aDomain,E)
+    mmList:= getModemapListFromDomain(anOp,0,aDomain,E)
+    modemap:=
+      n:=#mmList
+      1=n => mmList.(0)
+      0=n =>
+        return
+          stackMessage ['"Operation ","%b",anOp,"%d",
+                         '"missing from domain: ", aDomain]
+      stackWarning ['"more than 1 modemap for: ",anOp,
+                  '" with dc=",aDomain,'" ===>"
+        ,mmList]
+      mmList.(0)
+----------> new: <-----------
+    if aDomain = 'Rep then
+      modemap := SUBST('Rep,'_$,modemap)
+      m       := SUBST('Rep,'_$,m)
+----------> new: <-----------
+    [sig,[pred,val]]:= modemap
+    #sig^=2 and ^val is ["elt",:.] => nil --what does the second clause do ????
+--+
+    val := genDeltaEntry [opOf anOp,:modemap]
+    x := markTran(origForm,[val],sig,[E])
+    [x,first rest sig,E] --implies fn calls used to access constants
+  compForm(origForm,m,E)
+ 
+pause op == op
+compApplyModemap(form,modemap,$e,sl) ==
+  [op,:argl] := form                   --form to be compiled
+  [[mc,mr,:margl],:fnsel] := modemap   --modemap we are testing
+ 
+  -- $e     is the current environment
+  -- sl     substitution list, nil means bottom-up, otherwise top-down
+ 
+  -- 0.  fail immediately if #argl=#margl
+ 
+  if #argl^=#margl then return nil
+ 
+  -- 1.  use modemap to evaluate arguments, returning failed if
+  --     not possible
+ 
+  lt:=
+    [[.,m',$e]:=
+      comp(y,g,$e) or return "failed" where
+        g:= SUBLIS(sl,m) where
+            sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl]
+  lt="failed" => return nil
+ 
+  -- 2.  coerce each argument to final domain, returning failed
+  --     if not possible
+ 
+  lt':= [coerce(y,d) or return "failed"
+         for y in lt for d in SUBLIS(sl,margl)]
+  lt'="failed" => return nil
+ 
+  -- 3.  obtain domain-specific function, if possible, and return
+ 
+  --$bindings is bound by compMapCond
+  [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil
+ 
+--+ can no longer trust what the modemap says for a reference into
+--+ an exterior domain (it is calculating the displacement based on view
+--+ information which is no longer valid; thus ignore this index and
+--+ store the signature instead.
+ 
+--$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) =>
+  f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
+    [genDeltaEntry [op,:modemap],lt',$bindings]
+  markImport mc
+  [f,lt',$bindings]
+ 
+compMapCond''(cexpr,dc) ==
+  cexpr=true => true
+  --cexpr = "true" => true
+---------------> new <----------------------
+  cexpr is [op,:l] and MEMQ(op,'(_and AND)) => and/[compMapCond''(u,dc) for u in l]
+  cexpr is [op,:l] and MEMQ(op,'(_or OR))   => or/[compMapCond''(u,dc) for u in l]
+---------------> new <----------------------
+  cexpr is ["not",u] => not compMapCond''(u,dc)
+  cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
+        --for the time being we'll stop here - shouldn't happen so far
+        --$disregardConditionIfTrue => true
+        --stackSemanticError(("not known that",'%b,name,
+        -- '%d,"has",'%b,cat,'%d),nil)
+  --now it must be an attribute
+  member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true
+  --for the time being we'll stop here - shouldn't happen so far
+  stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d]
+  false
+ 
+--======================================================================
+--                    From nruncomp.boot
+--======================================================================
+NRTgetLocalIndex1(item,killBindingIfTrue) ==
+  k := NRTassocIndex item => k
+  item = $NRTaddForm => 5
+  item = '$ => 0 
+  item = '_$_$ => 2
+  value:=
+    MEMQ(item,$formalArgList) => item
+    nil
+  atom item and null MEMQ(item,'($ _$_$)) 
+   and null value =>  --give slots to atoms
+    $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+    $NRTdeltaListComp:=[item,:$NRTdeltaListComp]
+    $NRTdeltaLength := $NRTdeltaLength+1
+    $NRTbase + $NRTdeltaLength - 1
+  $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+  saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+  saveIndex := $NRTbase + $NRTdeltaLength
+  $NRTdeltaLength := $NRTdeltaLength+1
+  compEntry:=  item
+               ----94/11/07
+  --      WAS: compOrCroak(item,$EmptyMode,$e).expr
+  RPLACA(saveNRTdeltaListComp,compEntry)
+  saveIndex
+
+optDeltaEntry(op,sig,dc,eltOrConst) ==
+  return nil    --------> kill it
+  $killOptimizeIfTrue = true => nil
+  ndc :=
+    dc = '$ => $functorForm
+    atom dc and (dcval := get(dc,'value,$e)) => dcval.expr
+    dc
+--if (atom dc) and (dcval := get(dc,'value,$e))
+--   then ndc := dcval.expr
+--   else ndc := dc
+  sig := SUBST(ndc,dc,sig)
+  not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
+  dcval := optCallEval ndc
+  -- MSUBST guarantees to use EQUAL testing
+  sig := MSUBST(devaluate dcval, ndc, sig)
+  if rest ndc then
+     for new in rest devaluate dcval for old in rest ndc repeat
+       sig := MSUBST(new,old,sig)
+     -- optCallEval sends (List X) to (LIst (Integer)) etc,
+     -- so we should make the same transformation
+  fn := compiledLookup(op,sig,dcval)
+  if null fn then
+    -- following code is to handle selectors like first, rest
+     nsig := [quoteSelector tt for tt in sig] where
+       quoteSelector(x) ==
+         not(IDENTP x) => x
+         get(x,'value,$e) => x
+         x='$ => x
+	 MKQ x
+     fn := compiledLookup(op,nsig,dcval)
+     if null fn then return nil
+  eltOrConst="CONST" => 
+     hehe fn
+     [op]                    -----------> return just the op here
+--   ['XLAM,'ignore,MKQ SPADCALL fn]
+  GETL(compileTimeBindingOf first fn,'SPADreplace)
+ 
+genDeltaEntry opMmPair ==
+--called from compApplyModemap
+--$NRTdeltaLength=0.. always equals length of $NRTdeltaList
+  [.,[odc,:.],.] := opMmPair
+  --opModemapPair := SUBLIS($LocalDomainAlist,opMmPair)
+  [op,[dc,:sig],[.,cform:=[eltOrConst,:.]]] := opMmPair
+  if $profileCompiler = true then 
+    profileRecord(dc,op,sig)
+--  markImport dc
+  eltOrConst = 'XLAM => cform
+  if eltOrConst = 'Subsumed then eltOrConst := 'ELT
+    -- following hack needed to invert Rep to $ substitution
+  if odc = 'Rep and cform is [.,.,osig] then sig:=osig
+  newimp := optDeltaEntry(op,sig,dc,eltOrConst) => newimp
+  setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] =>
+    ['applyFun,['compiledLookupCheck,MKQ op,
+         mkList consSig(sig,dc),consDomainForm(dc,nil)]]
+ --if null atom dc then
+ --   sig := substitute('$,dc,sig)
+ --   cform := substitute('$,dc,cform)
+  opModemapPair :=
+    [op,[dc,:[genDeltaSig x for x in sig]],['T,cform]] -- force pred to T
+  if null NRTassocIndex dc and dc ^= $NRTaddForm and
+    (member(dc,$functorLocalParameters) or null atom dc) then
+    --create "domain" entry to $NRTdeltaList
+      $NRTdeltaList:= [['domain,NRTaddInner dc,:dc],:$NRTdeltaList]
+      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      compEntry:=
+        dc
+      RPLACA(saveNRTdeltaListComp,compEntry)
+      chk(saveNRTdeltaListComp,102)
+  u :=
+    [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index ==
+      (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1
+        --n + 1 since $NRTdeltaLength is 1 too large
+      $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+      $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      0
+  u
+
+--======================================================================
+--                    From nruncomp.boot
+--======================================================================
+parseIf t ==
+  t isnt [p,a,b] => t
+  ifTran(parseTran p,parseTran a,parseTran b) where
+    ifTran(p,a,b) ==
+      null($InteractiveMode) and p='true  => a
+      null($InteractiveMode) and p='false  => b
+      p is ['not,p'] => ifTran(p',b,a)
+      p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
+      p is ['SEQ,:l,['exit,1,p']] =>
+        ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]]
+         --this assumes that l has no exits
+      a is ['IF, =p,a',.] => ['IF,p,a',b]
+      b is ['IF, =p,.,b'] => ['IF,p,a,b']
+--      makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] =>
+--        parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]]
+      ['IF,p,a,b]
+
+--======================================================================
+--                         From parse.boot
+--======================================================================
+parseNot u ==  ['not,parseTran first u]
+
+makeSimplePredicateOrNil p == nil
+ 
+--======================================================================
+--                         From g-cndata.boot
+--======================================================================
+mkUserConstructorAbbreviation(c,a,type) ==
+  if $AnalyzeOnly or $convert2NewCompiler then
+    $abbreviationStack := [[type,a,:c],:$abbreviationStack]
+  if not atom c then c:= CAR c  --  Existing constructors will be wrapped
+  constructorAbbreviationErrorCheck(c,a,type,'abbreviationError)
+  clearClams()
+  clearConstructorCache(c)
+  installConstructor(c,type)
+  setAutoLoadProperty(c)
+ 
+--======================================================================
+--                         From iterator.boot
+--======================================================================
+
+compreduce(form is [.,op,x],m,e) ==
+  T := compForm(form,m,e) or return nil
+  y := T.expr
+  RPLACA(y,"REDUCE")
+  ------------------<== distinquish this as the special reduce form
+  (y is ["REDUCE",:.]) and (id:= getIdentity(op,e)) and (u := comp0(id,m,e)) and
+    # getNumberTypesInScope() > 1 => markSimpleReduce([:y, ["@",u.expr,m]], T)
+  T
+
+compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) ==
+-------------------------------> 11/28 all new to preserve collect forms
+  markImport m
+  [collectOp,:itl,body]:= collectForm
+  $e:= e
+  itl:= [([.,$e]:= compIterator(x,$e) or return "failed").(0) for x in itl]
+  itl="failed" => return nil
+  e:= $e
+  T0 := comp0(body,m,e) or return nil
+  md := T0.mode
+  T1 := compOrCroak(collectForm,["List",md],e) 
+  T  := [["REDUCE",op,nil,T1.expr],md,T1.env]
+  markReduce(form,T)
+ 
+compIterator(it,e) ==
+  it is ["IN",x,y] =>
+    --these two lines must be in this order, to get "for f in list f"
+    --to give  an error message if f is undefined
+  ---------------> new <---------------------
+    [y',m,e] := markInValue(y, e)
+    x := markKillAll x
+    ------------------
+    $formalArgList:= [x,:$formalArgList]
+    [.,mUnder]:=
+      modeIsAggregateOf("List",m,e) or modeIsAggregateOf("Vector",m,e) or return
+         stackMessage ["mode: ",m," must be a list or vector of some mode"]
+    if null get(x,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",x,mUnder],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),mUnder,e],e)
+    markReduceIn(it, [["IN",x,y'],e])
+  it is ["ON",x,y] =>
+---------------> new <---------------------
+    x := markKillAll x
+    ------------------
+    $formalArgList:= [x,:$formalArgList]
+    y := markKillAll y
+    markImport m
+---------------> new <---------------------
+    [y',m,e]:= comp(y,$EmptyMode,e) or return nil
+    [.,mUnder]:=
+      modeIsAggregateOf("List",m,e) or return
+        stackMessage ["mode: ",m," must be a list of other modes"]
+    if null get(x,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",x,m],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),m,e],e)
+    [["ON",x,y'],e]
+  it is ["STEP",oindex,start,inc,:optFinal] =>
+    index := markKillAll oindex
+    $formalArgList:= [index,:$formalArgList]
+    --if all start/inc/end compile as small integers, then loop
+    --is compiled as a small integer loop
+    final':= nil
+---------------> new <---------------------
+    u := smallIntegerStep(it,index,start,inc,optFinal,e) => u
+---------------> new <---------------------
+    [start,.,e]:=
+      comp(markKillAll start,$Integer,e) or return
+        stackMessage ["start value of index: ",start," must be an integer"]
+    [inc,.,e]:=
+      comp(markKillAll inc,$Integer,e) or return
+        stackMessage ["index increment:",inc," must be an integer"]
+    if optFinal is [final] then
+      [final,.,e]:=
+        comp(markKillAll final,$Integer,e) or return
+          stackMessage ["final value of index: ",final," must be an integer"]
+      optFinal:= [final]
+    indexmode:=
+      comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger
+      $Integer
+--  markImport ['Segment,indexmode]
+    if null get(index,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil
+    e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+    markReduceStep(it, [["STEP",markStep(index),start,inc,:optFinal],e])
+  it is ["WHILE",p] =>
+    [p',m,e]:=
+      comp(p,$Boolean,e) or return
+        stackMessage ["WHILE operand: ",p," is not Boolean valued"]
+    markReduceWhile(it, [["WHILE",p'],e])
+  it is ["UNTIL",p] => markReduceUntil(it, ($until:= p; ['$until,e]))
+  it is ["|",x] =>
+    u:=
+      comp(x,$Boolean,e) or return
+        stackMessage ["SUCHTHAT operand: ",x," is not Boolean value"]
+    markReduceSuchthat(it, [["|",u.expr],u.env])
+  nil
+
+smallIntegerStep(it,index,start,inc,optFinal,e) ==
+  start    := markKillAll start
+  inc      := markKillAll inc
+  optFinal := markKillAll optFinal
+  startNum := source2Number start
+  incNum   := source2Number inc
+  mode := get(index,"mode",e) 
+--fail if
+----> a) index has a mode that is not $SmallInteger
+----> b) one of start,inc, final won't comp as a $SmallInteger
+  mode and mode ^= $SmallInteger => nil
+  null (start':= comp(start,$SmallInteger,e)) => nil
+  null (inc':= comp(inc,$SmallInteger,start'.env)) => nil
+  if optFinal is [final] and not (final':= comp(final,$SmallInteger,inc'.env)) then
+--    not (FIXP startNum and FIXP incNum) => return nil
+--    null FIXP startNum or ABSVAL startNum > 100 => return nil
+    -----> assume that optFinal is $SmallInteger
+    T := comp(final,$EmptyMode,inc'.env) or return nil
+    final' := T
+    maxSuperType(T.mode,e) ^= $Integer => return nil
+    givenRange := T.mode
+  indexmode:= $SmallInteger
+  [.,.,e]:= compMakeDeclaration([":",index,indexmode],$EmptyMode,
+     (final' => final'.env; inc'.env)) or return nil
+  range :=
+    FIXP startNum and FIXP incNum =>
+      startNum >  0 and incNum > 0 => $PositiveInteger
+      startNum <  0 and incNum < 0 => $NegativeInteger
+      incNum >  0 => $NonNegativeInteger   --startNum = 0
+      $NonPositiveInteger
+    givenRange => givenRange
+    nil
+  e:= put(index,"range",range,e)
+  e:= put(index,"value",[genSomeVariable(),indexmode,e],e)
+  noptFinal := 
+    final' => 
+      [final'.expr]
+    nil
+  [markStepSI(it,["ISTEP",index,start'.expr,inc'.expr,:noptFinal]),e]
+
+source2Number n ==
+  n := markKillAll n
+  n = $Zero => 0
+  n = $One  => 1
+  n
+
+compRepeatOrCollect(form,m,e) ==
+  fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList
+    ,e) where
+      fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
+        $until: local
+        [repeatOrCollect,:itl,body]:= form
+        itl':=
+          [([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl]
+        itl'="failed" => nil
+        targetMode:= first $exitModeStack
+--        pp '"---------"
+--        pp targetMode
+        bodyMode:=
+          repeatOrCollect="COLLECT" =>
+            targetMode = '$EmptyMode => '$EmptyMode
+            (u:=modeIsAggregateOf('List,targetMode,e)) =>
+              CADR u
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) =>
+              repeatOrCollect:='COLLECTV
+              CADR u
+            stackMessage('"Invalid collect bodytype")
+            return nil
+            -- If we're doing a collect, and the type isn't conformable
+            -- then we've boobed. JHD 26.July.1990
+          $NoValueMode
+        [body',m',e']:= T :=
+          -- (m1:= listOrVectorElementMode targetMode) and comp(body,m1,e) or
+            compOrCroak(body,bodyMode,e) or return nil
+        markRepeatBody(body, T)
+        if $until then
+          [untilCode,.,e']:= comp($until,$Boolean,e')
+          itl':= substitute(["UNTIL",untilCode],'$until,itl')
+        form':= [repeatOrCollect,:itl',body']
+        m'':=
+          repeatOrCollect="COLLECT" =>
+            (u:=modeIsAggregateOf('List,targetMode,e)) => CAR u
+            ["List",m']
+          repeatOrCollect="COLLECTV" =>
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) => CAR u
+            ["Vector",m']
+          m'
+--------> new <--------------
+        markImport m''
+--------> new <--------------
+        markRepeat(form,coerceExit([form',m'',e'],targetMode))
+ 
+chaseInferences(origPred,$e) ==
+  pred := markKillAll origPred
+  ----------------------------12/4/94 do this immediately
+  foo hasToInfo pred where
+    foo pred ==
+      knownInfo pred => nil
+      $e:= actOnInfo(pred,$e)
+      pred:= infoToHas pred
+      for u in get("$Information","special",$e) repeat
+        u is ["COND",:l] =>
+          for [ante,:conseq] in l repeat
+            ante=pred => [foo w for w in conseq]
+            ante is ["and",:ante'] and member(pred,ante') =>
+              ante':= delete(pred,ante')
+              v':=
+                LENGTH ante'=1 => first ante'
+                ["and",:ante']
+              v':= ["COND",[v',:conseq]]
+              member(v',get("$Information","special",$e)) => nil
+              $e:=
+                put("$Information","special",[v',:
+                  get("$Information","special",$e)],$e)
+            nil
+  $e
+ 
+--======================================================================
+--                   doit Code
+--======================================================================
+doIt(item,$predl) ==
+  $GENNO: local:= 0
+  $coerceList: local := nil
+  --->                 
+  if item is ['PART,.,a] then item := a
+  -------------------------------------
+  item is ['SEQ,:.] => doItSeq item
+  isDomainForm(item,$e) => doItDomain item
+  item is ['LET,:.] => doItLet item
+  item is [":",a,t] => [.,.,$e]:= 
+    markDeclaredImport markKillAll t
+    compOrCroak(item,$EmptyMode,$e)
+  item is ['import,:doms] =>
+     item := ['import,:(doms := markKillAll doms)]
+     for dom in doms repeat
+       sayBrightly ['"   importing ",:formatUnabbreviated dom]
+     [.,.,$e] := compOrCroak(item,$EmptyMode,$e)
+     wiReplaceNode(item,'(PROGN),10)
+  item is ["IF",:.] => doItIf(item,$predl,$e)
+  item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e)
+  item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
+  item is ['DEF,:.] => doItDef item
+  T:= compOrCroak(item,$EmptyMode,$e) => doItExpression(item,T)
+  true => cannotDo()
+
+holdIt item == item
+ 
+doItIf(item is [.,p,x,y],$predl,$e) ==
+  olde:= $e
+  [p',.,$e]:= qt(19,comp(p,$Boolean,$e)) or userError ['"not a Boolean:",p]
+  oldFLP:=$functorLocalParameters
+  if x^="noBranch" then
+--> new <-----------------------
+    qe(20,compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(markKillAll p,$e)))
+---> new                                                 -----------
+    x':=localExtras(oldFLP)
+          where localExtras(oldFLP) ==
+            EQ(oldFLP,$functorLocalParameters) => NIL
+            flp1:=$functorLocalParameters
+            oldFLP':=oldFLP
+            n:=0
+            while oldFLP' repeat
+              oldFLP':=CDR oldFLP'
+              flp1:=CDR flp1
+              n:=n+1
+            -- Now we have to add code to compile all the elements
+            -- of functorLocalParameters that were added during the
+            -- conditional compilation
+            nils:=ans:=[]
+            for u in flp1 repeat -- is =u form always an ATOM?
+              if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode])
+                then
+                  nils:=[u,:nils]
+                else
+                  gv := GENSYM()
+                  ans:=[['LET,gv,u],:ans]
+                  nils:=[gv,:nils]
+              n:=n+1
+
+            $functorLocalParameters:=[:oldFLP,:REVERSE nils]
+            REVERSE ans
+  oldFLP:=$functorLocalParameters
+  if y^="noBranch" then
+--> new <-----------------------
+    qe(21,compSingleCapsuleItem(y,[['not, p],:$predl],getInverseEnvironment(markKillAll p,olde)))
+-->                                                      ----------- 
+    y':=localExtras(oldFLP)
+  wiReplaceNode(item,["COND",[p',x,:x'],['(QUOTE T),y,:y']],12)
+
+doItSeq item == 
+  ['SEQ,:l,['exit,1,x]] := item
+  RPLACA(item,"PROGN")
+  RPLACA(LASTNODE item,x)
+  for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e)
+
+doItDomain item ==
+  -- convert naked top level domains to import
+  u:= ['import, [first item,:rest item]]
+  markImport CADR u
+  stackWarning ["Use: import ", [first item,:rest item]]
+--wiReplaceNode(item, u, 14)
+  RPLACA(item, first u)
+  RPLACD(item, rest u)
+  doIt(item,$predl)
+
+doItLet item ==
+  qe(3,$e)
+  res := doItLet1 item
+  qe(4,$e)
+  res
+ 
+doItLet1 item ==
+  ['LET,lhs,rhs,:.] := item
+  not (compOrCroak(item,$EmptyMode,$e) is [code,.,$e]) =>
+      stackSemanticError(["cannot compile assigned value to",:bright lhs],nil)
+  qe(5,$e)
+  code := markKillAll code
+  not (code is ['LET,lhs',rhs',:.] and atom lhs') =>
+      code is ["PROGN",:.] =>
+         stackSemanticError(["multiple assignment ",item," not allowed"],nil)
+      wiReplaceNode(item, code, 24)
+  lhs:= lhs'
+  if not member(KAR rhs,$NonMentionableDomainNames) and
+      not MEMQ(lhs, $functorLocalParameters) then
+         $functorLocalParameters:= [:$functorLocalParameters,lhs]
+  if (rhs' := rhsOfLetIsDomainForm code) then
+      if isFunctor rhs' then
+        $functorsUsed:= insert(opOf rhs',$functorsUsed)
+        $packagesUsed:= insert([opOf rhs'],$packagesUsed)
+        $globalImportDefAlist := pp [[lhs, :rhs'],:$globalImportDefAlist]
+      if lhs="Rep" then
+        $Representation:= (get("Rep",'value,$e)).(0)
+           --$Representation bound by compDefineFunctor, used in compNoStacking
+--+
+        if $NRTopt = true
+          then NRTgetLocalIndex $Representation
+--+
+      $LocalDomainAlist:= --see genDeltaEntry
+        [[lhs,:SUBLIS($LocalDomainAlist,get(lhs,'value,$e).0)],:$LocalDomainAlist]
+--+
+  qe(6,$e)
+  code is ['LET,:.] =>
+      rhsCode:= rhs'
+      op := ($QuickCode => 'QSETREFV;'SETELT)
+      wiReplaceNode(item,[op,'$,NRTgetLocalIndexClear lhs,rhsCode], 16)
+  wiReplaceNode(item, code, 18)
+
+rhsOfLetIsDomainForm code ==
+  code is ['LET,.,rhs',:.] =>
+    isDomainForm(rhs',$e) => rhs'
+    isDomainForm(rhs' := markKillAll rhs',$e) => rhs'
+    false
+  false
+
+doItDef item == 
+  ['DEF,[op,:.],:.] := item
+  body:= isMacro(item,$e) => $e:= put(op,'macro,body,$e)
+  [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e)
+  chk(item,3)
+  RPLACA(item,"CodeDefine")
+        --Note that DescendCode, in CodeDefine, is looking for this
+  RPLACD(CADR item,[$signatureOfForm])
+  chk(item,4)
+      --This is how the signature is updated for buildFunctor to recognise
+--+
+  functionPart:= ['dispatchFunction,t.expr]
+  wiReplaceNode(CDDR item,[functionPart], 20)
+  chk(item, 30)
+
+doItExpression(item,T) ==
+  SETQ($ITEM,COPY item)
+  SETQ($T1,COPY T.expr)
+  chk(T.expr, 304)
+  u := markCapsuleExpression(item, T)
+  [code,.,$e]:= u
+  wiReplaceNode(item,code, 22)
+
+wiReplaceNode(node,ocode,key) ==
+  ncode := CONS(first ocode, rest ocode)
+  code := replaceNodeInStructureBy(node,ncode)
+  SETQ($NODE,COPY node)
+  SETQ($NODE1, COPY first code)
+  SETQ($NODE2, COPY rest  code)
+  RPLACA(node,first code)
+  RPLACD(node,rest  code)
+  chk(code, key)
+  chk(node, key + 1)
+
+replaceNodeInStructureBy(node, x) == 
+  $nodeCopy: local := [CAR node,:CDR node]
+  replaceNodeBy(node, x)
+  node
+
+replaceNodeBy(node, x) ==
+  atom x => nil
+  for y in tails x | EQCAR(x,node) repeat RPLAC(CAR x, $nodeCopy)
+  nil  
+
+chk(x,key) == fn(x,0,key) where fn(x,cnt,key) ==
+  cnt > 10000 => 
+    sayBrightly ["--> ", key, " <---"]
+    hahaha(key)
+  atom x => cnt
+  VECP x => systemError nil
+  for y in x repeat cnt := fn(y, cnt + 1, key)
+  cnt
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/word.boot.pamphlet b/src/interp/word.boot.pamphlet
new file mode 100644
index 00000000..ac76dca3
--- /dev/null
+++ b/src/interp/word.boot.pamphlet
@@ -0,0 +1,422 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp word.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+--=======================================================================
+--                        Build Directories
+--=======================================================================
+buildFunctionTable(dicts) ==
+  sayKeyedMsg("S2GL0011",NIL)
+  buildWordTable getListOfFunctionNames dicts
+ 
+buildWordTable u ==
+  table:= MAKE_-HASHTABLE 'ID
+  for s in u repeat
+    key := UPCASE s.0
+    HPUT(table,key,[[s,:wordsOfString s],:HGET(table,key)])
+  for key in HKEYS table repeat
+    HPUT(table,key,
+      listSort(function GLESSEQP,removeDupOrderedAlist
+        listSort(function GLESSEQP, HGET(table,key),function CAR),
+          function CADR))
+  table
+ 
+writeFunctionTables(filemode) ==
+  $functionTable := NIL
+  writeFunctionTable(filemode,'SPADU,'(SPAD))
+  $functionTable := NIL
+  writeFunctionTable(filemode,'SPADD,'(SPADSYS))
+  $functionTable := NIL
+  writeFunctionTable(filemode,'SPADC,'(SPADSYS SCRATCHPAD_-COMPILER))
+  $functionTable := NIL
+  'done
+ 
+writeFunctionTable(filemode,name,dicts) ==
+  _$ERASE makePathname(name,'DATABASE,filemode)
+  stream:= writeLib1(name,'DATABASE,filemode)
+  if not $functionTable then
+    $functionTable:= buildFunctionTable dicts
+  for key in HKEYS $functionTable repeat
+    rwrite(object2Identifier key,HGET($functionTable,key),stream)
+  RSHUT stream
+  'done
+ 
+readFunctionTable() ==
+  sayKeyedMsg("S2GL0011",NIL)
+  name :=
+    $wordDictionary = 'user => 'SPADU
+    $wordDictionary = 'development => 'SPADD
+    'SPADC
+  stream:= readLib(name,'DATABASE)
+  table:= MAKE_-HASHTABLE 'ID
+  for key in RKEYIDS makePathname(name,'DATABASE,"*") repeat
+    HPUT(table,kk:=object2Identifier key, rread(kk,stream,nil))
+  RSHUT stream
+  table
+ 
+removeDupOrderedAlist u ==
+  -- removes duplicate entries in ordered alist
+  -- (where duplicates are adjacent)
+  for x in tails u repeat
+    (y := rest x) and first first x = first first y => RPLACD(x,rest y)
+  u
+ 
+getListOfFunctionNames(fnames) ==
+  -- fnames is a list of directories
+  res := nil
+  for fn in fnames repeat
+    null IOSTATE(fn,'DIRECT,'_*) => 'iterate
+    stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,fn,'DIRECT,'_*]],80,0)
+    while (not PLACEP (x:= READ_-LINE stream)) repeat
+      (s := SIZE x) < 26 => 'iterate
+      res:= [SUBSTRING(x,26,NIL),:res]
+    SHUT stream
+  res
+ 
+wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s]
+ 
+wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s]
+ 
+wordsOfString1(s,j) ==
+  k := or/[i for i in j..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] =>
+    tailWords:=
+      isBreakCharacter s.(k+1) =>
+        n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not isBreakCharacter s.i]
+        null n => [SUBSTRING(s,k,nil)]
+        n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)]
+      m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] =>
+        [SUBSTRING(s,k,m-k),:wordsOfString1(s,m)]
+      [SUBSTRING(s,k,nil)]
+    k > j+1 => [SUBSTRING(s,j,k-j),:tailWords]
+    tailWords
+  nil
+ 
+isBreakCharacter x == null SMALL__LITER x
+ 
+-- SETANDFILEQ($functionTable,buildFunctionTable())
+ 
+--=======================================================================
+--               Augment Function Directories
+--=======================================================================
+add2WordFunctionTable fn ==
+--called from DEF
+  $functionTable and
+    null LASSOC(s := PNAME fn,HGET($functionTable,(key := UPCASE s.0))) =>
+      HPUT($functionTable,key,[[s,:wordsOfString s],:HGET($functionTable,key)])
+ 
+--=======================================================================
+--                       Guess Function Name
+--=======================================================================
+guess word ==
+  u := bootFind word => INTERN u
+  nil
+ 
+bootFind word ==
+  not $useWordFacility => NIL
+  list:= bootSearch word
+  PNAME word in list => nil --mismatch of directories: pretend it was not found
+  null list => centerAndHighlight('"no match found",80,'" ")
+  1 = #list => doYouWant? first list
+  pickANumber(word,list)
+ 
+doYouWant? nam ==
+  center80 ['"Do you mean",:bright nam,'"?"]
+  center80 ['"If so, type",:bright 'y,"or",:bright 'yes]
+  center80 ['"Anything else means",:bright 'no]
+  x := UPCASE queryUser nil
+  MEMQ(STRING2ID_-N(x,1),'(Y YES)) => nam
+  nil
+ 
+pickANumber(word,list) ==
+  clearScreen()
+  centerNoHighlight(['"You asked for",:bright word],80,'"-")
+  centerAndHighlight('"Do you mean one of the following?",80,'" ")
+  n:= #list
+  xx:= (n > 99 => 3; n > 9 => 2; 1)
+  maxWidth:= 38 - 2*(1+xx)
+  [short,long] := say2Split(list,nil,nil,maxWidth)
+  extra:=
+    REMAINDER(length := # short,2) ^= 0 => 1
+    0
+  halfLength:= length/2
+  firstList:= TAKE(halfLength,short)
+  secondList:= TAKE(-halfLength,short)
+  secondStartIndex:= halfLength + extra
+  shortList:=
+    "append"/[[[:bright i,fillerSpaces(xx-WIDTH i,'" "),x],
+      [:bright(i+secondStartIndex),fillerSpaces(xx-WIDTH (i+halfLength),'" "),y]]
+        for i in 1.. for x in firstList for y in secondList]
+  say2PerLineThatFit shortList
+  i:= 1 + halfLength
+  if extra=1 then
+    sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,'" "),list.(i-1)]
+  for x in long for i in (1+length).. repeat
+    sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,'" "),x]
+  center80 ['"If so: type a number between",:bright 1,'"and",:bright n,"and ENTER"]
+  center80 ['"Anything else means",:bright 'no]
+  y := queryUser nil
+  x:= string2Integer y
+  FIXP x and x >= 1 and x <= #list => list.(x-1)
+  nil
+ 
+bootSearch word ==
+--if not $functionTable then $functionTable:= buildFunctionTable()
+  if not $functionTable then $functionTable:= readFunctionTable()
+  key := PNAME word
+  list :=
+    hasWildCard? key =>
+      pattern := patternTran key -- converts * to &
+      pattern.0 ^= '_& =>
+        [x for [x,:.] in HGET($functionTable,UPCASE pattern.0)|
+          match?(pattern,COPY x)]
+      "append"/[[x for [x,:.] in HGET($functionTable,k)| match?(pattern,COPY x)]
+                  for k in HKEYS $functionTable]
+    findApproximateWords(PNAME word,$functionTable)
+  list
+ 
+findApproximateWords(word,table) ==
+  words:= wordsOfString word
+  upperWord:= UPCASE COPY word
+  n := #words
+  threshold:=
+    n = 1 => 3
+    4
+  alist:= HGET(table,UPCASE word.0)
+ 
+  --first try to break up as list of words
+  firstTry := [x for [x,:wordList] in alist | p] where p ==
+    n = #wordList =>
+      sum := 0
+      for entry in wordList for part in words while sum < threshold repeat
+        sum:= sum + deltaWordEntry(part,entry)
+      sum < threshold => true
+      n < 3 => false
+      sum := 0
+      badWord := false
+      for entry in wordList for part in words while sum < threshold repeat
+        k:= deltaWordEntry(part,entry)
+        k < 2 => sum:= sum + k
+        null badWord => badWord := true
+        sum := 1000
+      sum < threshold
+    n+1 = #wordList =>    --assume one word is missing
+      sum := 0
+      badWord := false
+      for entries in tails wordList for part in words
+           while sum < threshold repeat
+        entry := first entries
+        k:= deltaWordEntry(part,entry)
+        k < 2 => sum:= sum + k
+        null badWord =>
+          badWord := true
+          entries := rest entries      --skip this bad word
+          entry := first entries
+          k := deltaWordEntry(part,entry)
+          k < 2 => sum := sum + k
+          sum := 1000
+        sum := 1000
+      sum < threshold
+    n-1 = #wordList =>    --assume one word too many
+      sum := 0
+      badWord := false
+      for entry in wordList for parts in tails words
+           while sum < threshold repeat
+        part := first parts
+        k:= deltaWordEntry(part,entry)
+        k < 2 => sum:= sum + k
+        null badWord =>
+          badWord := true
+          parts := rest parts      --skip this bad word
+          part := first parts
+          k := deltaWordEntry(part,entry)
+          k < 2 => sum := sum + k
+          sum := 1000
+        sum := 1000
+      sum < threshold
+    false
+  firstTry => firstTry
+ 
+  --no winners, so try flattening to upper case and checking again
+ 
+  wordSize := SIZE word
+  lastThreshold := MAX(3,wordSize/2)
+  vec := GETREFV lastThreshold
+  for [x,:.] in alist repeat
+    k := deltaWordEntry(upperWord,UPCASE COPY x)
+    k < lastThreshold => vec.k := [x,:vec.k]
+  or/[vec.k for k in 0..MAXINDEX vec]
+ 
+guessFromList(key,stringList) ==
+  threshold := MAX(3,(SIZE key)/2)
+  vec := GETREFV threshold
+  for x in stringList repeat
+    k := deltaWordEntry(key,x)
+    k < threshold => vec.k := [x,:vec.k]
+  or/[vec.k for k in 0..MAXINDEX vec]
+ 
+deltaWordEntry(word,entry) ==
+  word = entry => 0
+  ABS(diff := SIZE word - SIZE entry) > 4 => 1000
+  canForgeWord(word,entry)
+ 
+--+ Note these are optimized definitions below-- see commented out versions
+--+   to understand the algorithm
+canForgeWord(word,entry) ==
+  forge(word,0,MAXINDEX word,entry,0,MAXINDEX entry,0)
+ 
+forge(word,w,W,entry,e,E,n) ==
+  w > W =>
+    e > E => n
+    QSADD1 QSPLUS(E-e,n)
+  e > E => QSADD1 QSPLUS(W-w,n)
+  word.w = entry.e => forge(word,w+1,W,entry,e+1,E,n)
+  w=W or e=E => forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+  word.w=entry.(e+1) =>
+    word.(w+1) = entry.e => forge(word,w+2,W,entry,e+2,E,QSADD1 n)
+    forge(word,w+1,W,entry,e+2,E,QSADD1 n)
+  word.(w+1)=entry.e => forge(word,w+2,W,entry,e+1,E,QSADD1 n)
+ 
+  (deltaW := W-w) > 1 and (deltaE := E-e) > 1 =>
+    --if word is long, can we delete chars to match 2 consective chars
+    deltaW >= deltaE and
+      (k := or/[j for j in (w+2)..(W-1) | word.j = entry.e])
+        and word.(k+1) = entry.(e+1) =>
+          forge(word,k+2,W,entry,e+2,E,QSPLUS(k-w,n))
+    deltaW <= deltaE and
+    --if word is short, can we insert chars so as to match 2 consecutive chars
+      (k := or/[j for j in (e+2)..(E-1) | word.w = entry.j])
+        and word.(w+1) = entry.(k+1) =>
+          forge(word,w+2,W,entry,k+2,E,QSPLUS(n,k-e))
+    forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+  --check for two consecutive matches down the line
+  forge(word,w+1,W,entry,e+1,E,QSADD1 n)
+ 
+--+ DO NOT REMOVE DEFINITIONS BELOW which explain the algorithm
+--+ canForgeWord(word,entry) ==--
+--+ [d,i,s,t] := forge(word,0,MAXINDEX word,entry,0,MAXINDEX entry,0,0,0,0)
+--+ --d=deletions, i=insertions, s=substitutions, t=transpositions
+--+ --list is formed only for tuning purposes-- remove later on
+--+ d + i + s + t
+ 
+--+forge(word,w,W,entry,e,E,d,i,s,t) ==
+--+  w > W =>
+--+    e > E => [d,i,s,t]
+--+    [d,E-e+i+1,s,t]
+--+  e > E => [W-w+d+1,i,s,t]
+--+  word.w = entry.e => forge(word,w+1,W,entry,e+1,E,d,i,s,t)
+--+  w=W or e=E => forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+--+  word.w=entry.(e+1) =>
+--+    word.(w+1) = entry.e => forge(word,w+2,W,entry,e+2,E,d,i,s,t+1)
+--+    forge(word,w+1,W,entry,e+2,E,d,i+1,s,t)
+--+  word.(w+1)=entry.e => forge(word,w+2,W,entry,e+1,E,d+1,i,s,t)
+--+
+--+  (deltaW := W-w) > 1 and (deltaE := E-e) > 1 =>
+--+    --if word is long, can we delete chars to match 2 consective chars
+--+    deltaW >= deltaE and
+--+      (k := or/[j for j in (w+2)..(W-1) | word.j = entry.e])
+--+        and word.(k+1) = entry.(e+1) =>
+--+          forge(word,k+2,W,entry,e+2,E,d+k-w,i,s,t)
+--+    deltaW <= deltaE and
+--+    --if word is short, can we insert chars so as to match 2 consecutive chars
+--+      (k := or/[j for j in (e+2)..(E-1) | word.w = entry.j])
+--+        and word.(w+1) = entry.(k+1) =>
+--+          forge(word,w+2,W,entry,k+2,E,d,i+k-e,s,t)
+--+    forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+--+  --check for two consecutive matches down the line
+--+  forge(word,w+1,W,entry,e+1,E,d,i,s+1,t)
+ 
+--=======================================================================
+--                          String Pattern Matching
+--=======================================================================
+patternTran pattern ==
+  null hasWildCard? pattern and LITER pattern.0 and
+    UPCASE copy pattern = pattern =>
+      name:= abbreviation? INTERN pattern
+        or browseError [:bright pattern,
+          '"is not a constructor abbreviation"]
+      DOWNCASE PNAME name
+  maskConvert DOWNCASE pattern
+ 
+hasWildCard? str ==
+  or/[str.i = '_? and (i=0 or not(str.(i-1) = '__ )) for i in 0..MAXINDEX str]
+ 
+maskConvert str ==
+--replace all ? not preceded by an underscore by &
+  buf:= GETSTR(#str)
+  j:= 0  --index into res
+  final := MAXINDEX str
+  for i in 0..final repeat
+    char := str.i
+    if char = '__ and i < final then
+      i:= i+1
+      char := str.i
+     else if char = '_? then char := '_&
+    SUFFIX(char,buf)
+  buf
+ 
+ 
+infix?(s,t,x) == #s + #t >= #x and prefix?(s,x) and suffix?(t,x)
+ 
+prefix?(s,t) == substring?(s,t,0)
+ 
+suffix?(s,t) ==
+  m := #s; n := #t
+  if m > n then return false
+  substring?(s,t,(n-m))
+ 
+obSearch x ==
+  vec:= OBARRAY()
+  pattern:= PNAME x
+  [y for i in 0..MAXINDEX OBARRAY() |
+    (IDENTP (y := vec.i) or CVEC y) and match?(pattern,COPY y)]
+ 
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/xrun.boot.pamphlet b/src/interp/xrun.boot.pamphlet
new file mode 100644
index 00000000..9dcc9040
--- /dev/null
+++ b/src/interp/xrun.boot.pamphlet
@@ -0,0 +1,518 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp xrun.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{License}
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+$noSubsumption:=true
+--$MERGELIB := nil
+------- from nrunopt.boot -----------
+
+--------------------> NEW DEFINITION (see nrunopt.boot.pamphlet)
+NRTmakeCategoryAlist() ==
+  $depthAssocCache: local := MAKE_-HASHTABLE 'ID
+  $catAncestorAlist: local := NIL
+  pcAlist := [:[[x,:'T] for x in $uncondAlist],:$condAlist]
+  $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
+  opcAlist := NREVERSE SORTBY(function NRTcatCompare,pcAlist)
+  newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
+  slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist)
+		   | (k := predicateBitIndex b) ^= -1]
+  slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
+  sixEtc := [5 + i for i in 1..#$pairlis]
+  formals := ASSOCRIGHT $pairlis
+  for x in slot1 repeat
+       RPLACA(x,EQSUBSTLIST(CONS("$$",sixEtc),CONS('$,formals),CAR x))
+  -----------code to make a new style slot4 -----------------
+  predList := ASSOCRIGHT slot1	--is list of predicate indices
+  maxPredList := "MAX"/predList
+  catformvec := ASSOCLEFT slot1
+  maxElement := "MAX"/$byteVec
+  ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList],
+    ['CONS, MKQ LIST2VEC slot0,
+      ['CONS, MKQ LIST2VEC [encodeCatform x for x in catformvec],
+	['makeByteWordVec2,maxElement,MKQ $byteVec]]]]
+  --NOTE: this is new form: old form satisfies VECP CDDR form
+
+--------------------> NEW DEFINITION (see nrunopt.boot.pamphlet)
+encodeCatform x ==
+  k := NRTassocIndex x => k
+  atom x or atom rest x => x
+  [first x,:[encodeCatform y for y in rest x]]
+
+------- from nrunfast.boot -----------
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+replaceGoGetSlot env ==
+  [thisDomain,index,:op] := env
+  thisDomainForm := devaluate thisDomain
+  bytevec := getDomainByteVector thisDomain
+  numOfArgs := bytevec.index
+  goGetDomainSlotIndex := bytevec.(index := QSADD1 index)
+  goGetDomain :=
+     goGetDomainSlotIndex = 0 => thisDomain
+     thisDomain.goGetDomainSlotIndex
+  if PAIRP goGetDomain then
+     goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex)
+  sig :=
+    [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain)
+      for i in 0..numOfArgs]
+  thisSlot := bytevec.(QSADD1 index)
+  if $monitorNewWorld then
+    sayLooking(concat('"%l","..",form2String thisDomainForm,
+      '" wants",'"%l",'"  "),op,sig,goGetDomain)
+  slot :=  basicLookup(op,sig,goGetDomain,goGetDomain)
+  slot = nil =>
+    $returnNowhereFromGoGet = true =>
+      ['nowhere,:goGetDomain]  --see newGetDomainOpTable
+    sayBrightly concat('"Function: ",formatOpSignature(op,sig),
+      '" is missing from domain: ",form2String goGetDomain.0)
+    keyedSystemError("S2NR0001",[op,sig,goGetDomain.0])
+  if $monitorNewWorld then
+    sayLooking1(['"goget stuffing slot",:bright thisSlot,'"of "],thisDomain)
+  SETELT(thisDomain,thisSlot,slot)
+  if $monitorNewWorld then
+    sayLooking1('"<------",[CAR slot,:devaluate CDR slot])
+  slot
+
+--=======================================================
+--	  Expand Signature from Encoded Slot Form
+--=======================================================
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+newExpandGoGetTypeSlot(slot,dollar,domain) ==
+  newExpandTypeSlot(slot,domain,domain)
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+newExpandTypeSlot(slot, dollar, domain) ==
+--> returns domain form for dollar.slot
+   newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain)
+
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+newExpandLocalType(lazyt,dollar,domain) ==
+  VECP lazyt => lazyt.0
+  ATOM lazyt => lazyt
+  lazyt is [vec,.,:lazyForm] and VECP vec =>		  --old style
+    newExpandLocalTypeForm(lazyForm,dollar,domain)
+  newExpandLocalTypeForm(lazyt,dollar,domain)		  --new style
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
+  MEMQ(functorName, '(Record Union)) and first argl is [":",:.] =>
+    [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)]
+				 for [.,tag,dom] in argl]]
+  MEMQ(functorName, '(Union Mapping)) =>
+	  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
+  functorName = 'QUOTE => [functorName,:argl]
+  coSig := GETDATABASE(functorName,'COSIG)
+  NULL coSig => error ["bad functorName", functorName]
+  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
+	for a in argl for flag in rest coSig]]
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
+  u = '$ => u
+  INTEGERP u =>
+     typeFlag => newExpandTypeSlot(u, dollar,domain)
+     domain.u
+  u is ['NRTEVAL,y] => nrtEval(y,domain)
+  u is ['QUOTE,y] => y
+  u = "$$" => domain.0
+  atom u => u	--can be first, rest, etc.
+  newExpandLocalTypeForm(u,dollar,domain)
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+nrtEval(expr,dom) ==
+  $:fluid := dom
+  eval expr
+
+sigDomainVal(dollar,domain,index) ==
+--returns a domain or a lazy slot
+  index = 0 => "$"
+  index = 2 => domain
+  domain.index
+
+--------------------> NEW DEFINITION (see nrunfast.boot.pamphlet)
+lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
+  if s = '$ then
+--  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
+    s := devaluate dollar -- calls from HasCategory can have $s
+  INTEGERP a =>
+    not typeFlag => s = domain.a
+    a = 6 and $isDefaultingPackage => s = devaluate dollar
+    VECP (d := domainVal(dollar,domain,a)) =>
+      s = d.0 => true
+      domainArg := ($isDefaultingPackage => domain.6.0; domain.0)
+      KAR s = QCAR d.0 and
+	lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg)
+    --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain)	   --old style (erase)
+    lazyMatch(replaceSharpCalls s,d,dollar,domain)	 --new style
+  a = '$ => s = devaluate dollar
+  a = "$$" => s = devaluate domain
+  STRINGP a =>
+    STRINGP s => a = s
+    s is ['QUOTE,y] and PNAME y = a
+    IDENTP s and PNAME s = a
+  atom a =>  a = s
+  op := opOf a
+  op  = 'NRTEVAL => s = nrtEval(CADR a,domain)
+  op = 'QUOTE => s = CADR a
+  lazyMatch(s,a,dollar,domain)
+  --above line is temporarily necessary until system is compiled 8/15/90
+--s = a
+
+------- from template.boot -----------
+
+--------------------> NEW DEFINITION (see template.boot.pamphlet)
+evalSlotDomain(u,dollar) ==
+  $returnNowhereFromGoGet: local := false
+  $ : fluid := dollar
+  $lookupDefaults : local := nil -- new world
+  u = '$ => dollar
+  u = "$$" => dollar
+  FIXP u =>
+    VECP (y := dollar.u) => y
+    y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous?
+    y is [v,:.] =>
+      VECP v => lazyDomainSet(y,dollar,u)		--old style has [$,code,:lazyt]
+      constructor? v or MEMQ(v,'(Record Union Mapping)) =>
+	lazyDomainSet(y,dollar,u)			--new style has lazyt
+      y
+    y
+  u is ['NRTEVAL,y] => eval  y
+  u is ['QUOTE,y] => y
+  u is ['Record,:argl] =>
+     FUNCALL('Record0,[[tag,:evalSlotDomain(dom,dollar)]
+				 for [.,tag,dom] in argl])
+  u is ['Union,:argl] and first argl is ['_:,.,.] =>
+     APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
+				 for [.,tag,dom] in argl])
+  u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl])
+  systemErrorHere '"evalSlotDomain"
+
+
+------- from nrungo.boot -----------
+
+--------------------> NEW DEFINITION (see nrungo.boot.pamphlet)
+lazyCompareSigEqual(s,tslot,dollar,domain) ==
+  tslot = '$ => s = tslot -- devaluate dollar  --needed for browser
+  INTEGERP tslot and PAIRP(lazyt:=domain.tslot) and PAIRP s =>
+      lazyt is [.,.,.,[.,item,.]] and
+	item is [.,[functorName,:.]] and functorName = CAR s =>
+	  compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain)
+      nil
+  compareSigEqual(s,NRTreplaceLocalTypes(tslot,domain),dollar,domain)
+
+------- from i-funsel.boot -----------
+
+--------------------> NEW DEFINITION (see i-funsel.boot.pamphlet)
+findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
+  -- looks for a modemap for op with signature	args1 -> tar
+  --   in the domain of computation dc
+  -- tar may be NIL (= unknown)
+  null isLegitimateMode(tar, nil, nil) => nil
+  dcName:= CAR dc
+  member(dcName,'(Union Record Mapping Enumeration)) =>
+    -- First cut code that ignores args2, $Coerce and $SubDom
+    -- When domains no longer have to have Set, the hard coded 6 and 7
+    -- should go.
+    op = '_= =>
+	#args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL
+	tar and tar ^= '(Boolean) => NIL
+	[[[dc, '(Boolean), dc, dc], ['(Boolean),'$,'$], [NIL, NIL]]]
+    op = 'coerce =>
+	#args1 ^= 1 
+        dcName='Enumeration and (args1.0=$Symbol or tar=dc)=>
+           [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]]
+        args1.0 ^= dc => NIL
+	tar and tar ^= $Expression => NIL
+	[[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]]
+    member(dcName,'(Record Union)) =>
+      findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom)
+    NIL
+  fun:= NIL
+  ( p := ASSQ(op,getOperationAlistFromLisplib dcName) ) and
+    SL := constructSubst dc
+    -- if the arglist is homogeneous, first look for homogeneous
+    -- functions. If we don't find any, look at remaining ones
+    if isHomogeneousList args1 then
+      q := NIL
+      r := NIL
+      for mm in CDR p repeat
+	-- CDAR of mm is the signature argument list
+	if isHomogeneousList CDAR mm then q := [mm,:q]
+	else r := [mm,:r]
+      q := allOrMatchingMms(q,args1,tar,dc)
+      for mm in q repeat
+	fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+      r := reverse r
+    else r := CDR p
+    r := allOrMatchingMms(r,args1,tar,dc)
+    if not fun then    -- consider remaining modemaps
+      for mm in r repeat
+	fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+  if not fun and $reportBottomUpFlag then
+    sayMSG concat
+      ['"   -> no appropriate",:bright op,'"found in",
+	:bright prefix2String dc]
+  fun
+
+--------------------> NEW DEFINITION (see i-funsel.boot.pamphlet)
+findFunctionInDomain1(omm,op,tar,args1,args2,SL) ==
+  dc:= CDR (dollarPair := ASSQ('$,SL))
+  -- need to drop '$ from SL
+  mm:= subCopy(omm, SL)
+  -- tests whether modemap mm is appropriate for the function
+  -- defined by op, target type tar and argument types args
+  $RTC:local:= NIL
+  -- $RTC is a list of run-time checks to be performed
+
+  [sig,slot,cond,y] := mm
+  [osig,:.]  := omm
+  osig := subCopy(osig, SUBSTQ(CONS('$,'$), dollarPair, SL))
+  if CONTAINED('_#, sig) or CONTAINED('construct,sig) then
+    sig := [replaceSharpCalls t for t in sig]
+  matchMmCond cond and matchMmSig(mm,tar,args1,args2) and
+    EQ(y,'Subsumed) and
+      -- hmmmm: do Union check in following because (as in DP)
+      -- Unions are subsumed by total modemaps which are in the
+      -- mm list in findFunctionInDomain.
+      y := 'ELT	     -- if subsumed fails try it again
+      not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and
+	(f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f
+    EQ(y,'ELT) => [[CONS(dc,sig),osig,nreverse $RTC]]
+    EQ(y,'CONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
+    EQ(y,'ASCONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
+    y is ['XLAM,:.] => [[CONS(dc,sig),y,nreverse $RTC]]
+    sayKeyedMsg("S2IF0006",[y])
+    NIL
+
+--------------------> NEW DEFINITION (see i-funsel.boot.pamphlet)
+findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
+  -- looks for a modemap for op with signature	args1 -> tar
+  --   in the domain of computation dc
+  -- tar may be NIL (= unknown)
+  dcName:= CAR dc
+  not MEMQ(dcName,'(Record Union Enumeration)) => NIL
+  fun:= NIL
+ --  cat := constructorCategory dc
+  makeFunc := GETL(dcName,"makeFunctionList") or
+      systemErrorHere '"findFunctionInCategory"
+  [funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame)
+  -- get list of implementations and remove sharps
+  maxargs := -1
+  impls := nil
+  for [a,b,d] in funlist repeat
+    not EQ(a,op) => nil
+    d is ['XLAM,xargs,:.] =>
+      if PAIRP(xargs) then maxargs := MAX(maxargs,#xargs)
+      else maxargs := MAX(maxargs,1)
+      impls := cons([b,nil,true,d],impls)
+    impls := cons([b,d,true,d],impls)
+  impls := NREVERSE impls
+  if maxargs ^= -1 then
+    SL:= NIL
+    for i in 1..maxargs repeat
+      impls := SUBSTQ(GENSYM(),INTERNL('"#",STRINGIMAGE i),impls)
+  impls and
+    SL:= constructSubst dc
+    for mm in impls repeat
+      fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
+  if not fun and $reportBottomUpFlag then
+    sayMSG concat
+      ['"   -> no appropriate",:bright op,'"found in",
+	:bright prefix2String dc]
+  fun
+
+------- from i-eval.boot -----------
+
+--------------------> NEW DEFINITION (see i-eval.boot.pamphlet)
+evalForm(op,opName,argl,mmS) ==
+  -- applies the first applicable function
+  for mm in mmS until form repeat
+    [sig,fun,cond]:= mm
+    (CAR sig) = 'interpOnly => form := CAR sig
+    #argl ^= #CDDR sig => 'skip ---> RDJ 6/95
+    form:=
+      $genValue or null cond =>
+	[getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL
+	 for x in argl for t in CDDR sig]
+      [getArgValueComp2(x,t,c,sideEffectedArg?(t,sig,opName),opName) or return NIL
+	for x in argl for t in CDDR sig for c in cond]
+    form or null argl =>
+      dc:= CAR sig
+      form :=
+	dc='local => --[fun,:form]
+	  atom fun =>
+	    fun in $localVars => ['SPADCALL,:form,fun]
+	    [fun,:form,NIL]
+	  ['SPADCALL,:form,fun]
+	dc is ["__FreeFunction__",:freeFun] =>
+	  ['SPADCALL,:form,freeFun]
+	fun is ['XLAM,xargs,:xbody] =>
+	  rec :=  first form
+	  xbody is [['RECORDELT,.,ind,len]] =>
+	    optRECORDELT([CAAR xbody,rec,ind,len])
+	  xbody is [['SETRECORDELT,.,ind,len,.]] =>
+	    optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form])
+	  xbody is [['RECORDCOPY,.,len]] =>
+	    optRECORDCOPY([CAAR xbody,rec,len])
+	  ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)]
+	dcVector := evalDomain dc
+	fun0 :=
+	  newType? CAAR mm =>
+	    mm' := first ncSigTransform mm
+	    ncGetFunction(opName, first mm', rest mm')
+	  NRTcompileEvalForm(opName,fun,dcVector)
+	null fun0 => throwKeyedMsg("S2IE0008",[opName])
+	[bpi,:domain] := fun0
+	EQ(bpi,function Undef) =>
+	 sayKeyedMsg("S2IE0009",[opName,formatSignature CDR sig,CAR sig])
+	 NIL
+	if $NRTmonitorIfTrue = true then
+	  sayBrightlyNT ['"Applying ",first fun0,'" to:"]
+	  pp [devaluateDeeply x for x in form]
+	_$:fluid := domain
+	['SPADCALL, :form, fun0]
+  not form => nil
+--  not form => throwKeyedMsg("S2IE0008",[opName])
+  form='interpOnly => rewriteMap(op,opName,argl)
+  targetType := CADR sig
+  if CONTAINED('_#,targetType) then targetType := NRTtypeHack targetType
+  evalFormMkValue(op,form,targetType)
+
+------- from clammed.boot -----------
+
+--------------------> NEW DEFINITION (see interop.boot.pamphlet)
+coerceConvertMmSelection(funName,m1,m2) ==
+  -- calls selectMms with $Coerce=NIL and tests for required
+  -- target type. funName is either 'coerce or 'convert.
+  $declaredMode : local:= NIL
+  $reportBottomUpFlag : local:= NIL
+  l := selectMms1(funName,m2,[m1],[m1],NIL)
+  mmS := [[sig,[targ,arg],:pred] for x in l | x is [sig,[.,arg],:pred] and
+    hasCorrectTarget(m2,sig) and sig is [dc,targ,oarg] and oarg = m1]
+  mmS and CAR mmS
+
+------- from i-coerce.boot -----------
+
+--------------------> NEW DEFINITION (see i-coerce.boot.pamphlet)
+coerceByFunction(T,m2) ==
+  -- using the new modemap selection without coercions
+  -- should not be called by canCoerceFrom
+  x := objVal T
+  x = '_$fromCoerceable_$ => NIL
+  m2 is ['Union,:.] => NIL
+  m1 := objMode T
+  m2 is ['Boolean,:.] and m1 is ['Equation,ud] =>
+    dcVector := evalDomain ud
+    fun :=
+      isWrapped x =>
+	NRTcompiledLookup("=", [$Boolean, '$, '$], dcVector)
+      NRTcompileEvalForm("=", [$Boolean, '$, '$], dcVector)
+    [fn,:d]:= fun
+    isWrapped x =>
+      x:= unwrap x
+      mkObjWrap(SPADCALL(CAR x,CDR x,fun),m2)
+    x isnt ['SPADCALL,a,b,:.] => keyedSystemError("S2IC0015",NIL)
+    code := ['SPADCALL, a, b, fun]
+    objNew(code,$Boolean)
+  -- If more than one function is found, any should suffice, I think -scm
+  if not (mm := coerceConvertMmSelection(funName := 'coerce,m1,m2)) then
+    mm := coerceConvertMmSelection(funName := 'convert,m1,m2)
+  mm =>
+    [[dc,tar,:args],slot,.]:= mm
+    dcVector := evalDomain(dc)
+    fun:=
+--+
+      isWrapped x =>
+	NRTcompiledLookup(funName,slot,dcVector)
+      NRTcompileEvalForm(funName,slot,dcVector)
+    [fn,:d]:= fun
+    fn = function Undef => NIL
+    isWrapped x =>
+--+
+      $: fluid := dcVector
+      val := CATCH('coerceFailure, SPADCALL(unwrap x,fun))
+      (val = $coerceFailure) => NIL
+      objNewWrap(val,m2)
+    env := fun
+    code := ['failCheck, ['SPADCALL, x, env]]
+--  tar is ['Union,:.] => objNew(['failCheck,code],m2)
+    objNew(code,m2)
+  -- try going back to types like RN instead of QF I
+  m1' := eqType m1
+  m2' := eqType m2
+  (m1 ^= m1') or (m2 ^= m2') => coerceByFunction(objNew(x,m1'),m2')
+  NIL
+
+--------------------> NEW DEFINITION (see i-coerce.boot.pamphlet)
+equalOne(object, domain) ==
+  -- tries using constant One and "=" from domain
+  -- object should not be wrapped
+  algEqual(object, getConstantFromDomain('(One),domain), domain)
+
+--------------------> NEW DEFINITION (see i-coerce.boot.pamphlet)
+equalZero(object, domain) ==
+  -- tries using constant Zero and "=" from domain
+  -- object should not be wrapped
+  algEqual(object, getConstantFromDomain('(Zero),domain), domain)
+
+--------------------> NEW DEFINITION (see i-coerce.boot.pamphlet)
+algEqual(object1, object2, domain) ==
+  -- sees if 2 objects of the same domain are equal by using the
+  -- "=" from the domain
+  -- objects should not be wrapped
+--  eqfunc := getFunctionFromDomain("=",domain,[domain,domain])
+  eqfunc := compiledLookupCheck("=",[$Boolean,'$,'$],evalDomain domain)
+  SPADCALL(object1,object2, eqfunc)
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/interp/xruncomp.boot.pamphlet b/src/interp/xruncomp.boot.pamphlet
new file mode 100644
index 00000000..3d8c2c55
--- /dev/null
+++ b/src/interp/xruncomp.boot.pamphlet
@@ -0,0 +1,354 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/xruncomp.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+<<*>>=
+<<license>>
+
+------- from info.boot -----------
+
+-- modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n))
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+evalAndSub(domainName,viewName,functorForm,form,$e) ==
+  $lhsOfColon: local:= domainName
+  isCategory form => [substNames(domainName,viewName,functorForm,form.(1)),$e]
+  --next lines necessary-- see MPOLY for which $ is actual arg. --- RDJ 3/83
+  if CONTAINED("$$",form) then $e:= put("$$","mode",get("$","mode",$e),$e)
+  opAlist:= getOperationAlist(domainName,functorForm,form)
+  substAlist:= substNames(domainName,viewName,functorForm,opAlist)
+  [substAlist,$e]
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+substNames(domainName,viewName,functorForm,opalist) ==
+  functorForm := SUBSTQ("$$","$", functorForm)
+  nameForDollar :=
+    isCategoryPackageName functorForm => CADR functorForm
+    domainName
+    
+       -- following calls to SUBSTQ must copy to save RPLAC's in
+       -- putInLocalDomainReferences
+  [[:SUBSTQ("$","$$",SUBSTQ(nameForDollar,"$",modemapform)),
+       [sel, viewName,if domainName = "$" then pos else
+                                         CADAR modemapform]]
+     for [:modemapform,[sel,"$",pos]] in
+          EQSUBSTLIST(KDR functorForm,$FormalMapVariableList, opalist)]
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+addModemap1(op,mc,sig,pred,fn,e) ==
+   --mc is the "mode of computation"; fn the "implementation"
+  if mc='Rep then
+--     if fn is [kind,'Rep,.] and
+               -- save old sig for NRUNTIME
+--       (kind = 'ELT or kind = 'CONST) then fn:=[kind,'Rep,sig]
+     sig:= substitute("$",'Rep,sig)
+  currentProplist:= getProplist(op,e) or nil
+  newModemapList:=
+    mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil)
+  newProplist:= augProplist(currentProplist,'modemap,newModemapList)
+  newProplist':= augProplist(newProplist,"FLUID",true)
+  unErrorRef op
+        --There may have been a warning about op having no value
+  addBinding(op,newProplist',e)
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+addConstructorModemaps(name,form is [functorName,:.],e) ==
+  $InteractiveMode: local:= nil
+  e:= putDomainsInScope(name,e) --frame
+  fn := GETL(functorName,"makeFunctionList")
+  [funList,e]:= FUNCALL(fn,name,form,e)
+  for [op,sig,opcode] in funList repeat
+    if opcode is [sel,dc,n] and sel='ELT then
+          nsig := substitute("$$$",name,sig)
+          nsig := substitute('$,"$$$",substitute("$$",'$,nsig))
+          opcode := [sel,dc,nsig]
+    e:= addModemap(op,name,sig,true,opcode,e)
+  e
+
+------- from info.boot -----------
+
+--------------------> NEW DEFINITION (see info.boot.pamphlet)
+actOnInfo(u,$e) ==
+  null u => $e
+  u is ["PROGN",:l] => (for v in l repeat $e:= actOnInfo(v,$e); $e)
+  $e:=
+    put("$Information","special",Info:= [u,:get("$Information","special",$e)],$e
+      )
+  u is ["COND",:l] =>
+      --there is nowhere %else that this sort of thing exists
+    for [ante,:conseq] in l repeat
+      if member(hasToInfo ante,Info) then for v in conseq repeat
+        $e:= actOnInfo(v,$e)
+    $e
+  u is ["ATTRIBUTE",name,att] =>
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["ATTRIBUTE",att]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+      --there is nowhere %else that this sort of thing exists
+  u is ["SIGNATURE",name,operator,modemap] =>
+    implem:=
+      (implem:=ASSOC([name,:modemap],get(operator,'modemap,$e))) =>
+          CADADR implem
+      name = "$" => ['ELT,name,-1]
+      ['ELT,name,substitute('$,name,modemap)]
+    $e:= addModemap(operator,name,modemap,true,implem,$e)
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["SIGNATURE",operator,modemap]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+  u is ["has",name,cat] =>
+    [vval,vmode,venv]:= GetValue name
+    cat=vmode => $e --stating the already known
+    u:= compMakeCategoryObject(cat,$e) =>
+         --we are adding information about a category
+      [catvec,.,$e]:= u
+      [ocatvec,.,$e]:= compMakeCategoryObject(vmode,$e)
+      -- member(vmode,CAR catvec.4) =>
+      --    JHD 82/08/08 01:40 This does not mean that we can ignore the
+      --    extension, since this may not be compatible with the view we
+      --    were passed
+ 
+      --we are adding a principal descendant of what was already known
+      --    $e:= augModemapsFromCategory(name,name,nil,catvec,$e)
+      --    SAY("augmenting ",name,": ",cat)
+      --    put(name, "value", (vval, cat, venv), $e)
+      member(cat,first ocatvec.4) or
+         ASSOC(cat,CADR ocatvec.4) is [.,'T,.] => $e
+        --SAY("Category extension error:
+        --cat shouldn't be a join
+                      --what was being asserted is an ancestor of what was known
+      if name="$"
+        then $e:= augModemapsFromCategory(name,name,name,cat,$e)
+        else
+          viewName:=genDomainViewName(name,cat)
+          genDomainView(viewName,name,cat,"HasCategory")
+          if not MEMQ(viewName,$functorLocalParameters) then
+             $functorLocalParameters:=[:$functorLocalParameters,viewName]
+      SAY("augmenting ",name,": ",cat)
+      $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+    SAY("extension of ",vval," to ",cat," ignored")
+    $e
+  systemError '"knownInfo"
+
+------- from nruncomp.boot -----------
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+genDeltaEntry opMmPair ==
+--called from compApplyModemap
+--$NRTdeltaLength=0.. always equals length of $NRTdeltaList
+  [.,[odc,:.],.] := opMmPair
+  --opModemapPair := SUBLIS($LocalDomainAlist,opMmPair)
+  [op,[dc,:sig],[.,cform:=[eltOrConst,.,nsig]]] := opMmPair
+  if $profileCompiler = true then profileRecord(dc,op,sig)
+  eltOrConst = 'XLAM => cform
+  if eltOrConst = 'Subsumed then eltOrConst := 'ELT
+  if atom dc then
+    dc = "$" => nsig := sig
+    if NUMBERP nsig then nsig := substitute('$,dc,substitute("$$","$",sig))
+    -- following hack needed to invert Rep to $ substitution
+--  if odc = 'Rep and cform is [.,.,osig] then sig:=osig
+  newimp := optDeltaEntry(op,nsig,dc,eltOrConst) => newimp
+  setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] =>
+    ['applyFun,['compiledLookupCheck,MKQ op,
+         mkList consSig(nsig,dc),consDomainForm(dc,nil)]]
+  odc := dc
+  if null atom dc then dc := substitute("$$",'$,dc)
+ --   sig := substitute('$,dc,sig)
+ --   cform := substitute('$,dc,cform)
+  opModemapPair :=
+    [op,[dc,:[genDeltaSig x for x in nsig]],['T,cform]] -- force pred to T
+  if null NRTassocIndex dc and dc ^= $NRTaddForm and
+    (member(dc,$functorLocalParameters) or null atom dc) then
+    --create "domain" entry to $NRTdeltaList
+      $NRTdeltaList:= [['domain,NRTaddInner dc,:dc],:$NRTdeltaList]
+      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      compEntry:= compOrCroak(odc,$EmptyMode,$e).expr
+--      dc
+      RPLACA(saveNRTdeltaListComp,compEntry)
+  u :=
+    [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index ==
+      (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1
+        --n + 1 since $NRTdeltaLength is 1 too large
+      $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+      $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      0
+  u
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
+  --converts a domain form to a lazy domain form; everything other than 
+  --the operation name should be assigned a slot
+  null firstTime and (k:= NRTassocIndex x) => k
+  VECP x => systemErrorHere '"NRTencode"
+  PAIRP x =>
+    QCAR x='Record or x is ['Union,['_:,a,b],:.] =>
+      [QCAR x,:[['_:,a,encode(b,c,false)]
+        for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]]
+    constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) =>
+      [QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]]
+    ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm]
+  MEMQ(x,$formalArgList) =>
+    v := $FormalMapVariableList.(POSN1(x,$formalArgList))
+    firstTime => ['local,v]
+    v
+  x = '$ => x
+  x = "$$" => x
+  ['QUOTE,x]
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+consDomainName(x,dc) ==
+  x = dc => ''$
+  x = '$ => ''$
+  x = "$$" => ['devaluate,'$]
+  x is [op,:argl] =>
+    (op = 'Record) or (op = 'Union and argl is [[":",:.],:.])  =>
+       mkList [MKQ op,
+         :[['LIST,MKQ '_:,MKQ tag,consDomainName(dom,dc)]
+                   for [.,tag,dom] in argl]]
+    isFunctor op or op = 'Mapping or constructor? op =>
+         -- call to constructor? needed if op was compiled in $bootStrapMode
+        mkList [MKQ op,:[consDomainName(y,dc) for y in argl]]
+    substitute('$,"$$",x)
+  x = [] => x
+  (y := LASSOC(x,$devaluateList)) => y
+  k:=NRTassocIndex x =>
+    ['devaluate,['ELT,'$,k]]
+  get(x,'value,$e) =>
+    isDomainForm(x,$e) => ['devaluate,x]
+    x
+  MKQ x
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+NRTassignCapsuleFunctionSlot(op,sig) ==
+--called from compDefineCapsuleFunction
+  opSig := [op,sig]
+  [.,.,implementation] := NRTisExported? opSig or return nil
+    --if opSig is not exported, it is local and need not be assigned
+  if $insideCategoryPackageIfTrue then
+      sig := substitute('$,CADR($functorForm),sig)
+  sig := [genDeltaSig x for x in sig]
+  opModemapPair := [op,['_$,:sig],['T,implementation]]
+  POSN1(opModemapPair,$NRTdeltaList) => nil   --already there
+  $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+  $NRTdeltaListComp := [nil,:$NRTdeltaListComp]
+  $NRTdeltaLength := $NRTdeltaLength+1
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+changeDirectoryInSlot1() ==  --called by NRTbuildFunctor
+  --3 cases:
+  --  if called inside NRTbuildFunctor, $NRTdeltaLength gives different locs
+  --  otherwise called from compFunctorBody (all lookups are forwarded):
+  --    $NRTdeltaList = nil  ===> all slot numbers become nil
+  $lisplibOperationAlist := [sigloc entry for entry in $domainShell.1] where
+    sigloc [opsig,pred,fnsel] ==
+        if pred ^= 'T then
+          pred := simpBool pred
+          $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+        fnsel is [op,a,:.] and (op = 'ELT or op = 'CONST) =>
+          if $insideCategoryPackageIfTrue then
+              opsig := substitute('$,CADR($functorForm),opsig)
+          [opsig,pred,[op,a,vectorLocation(first opsig,CADR opsig)]]
+        [opsig,pred,fnsel]
+  sortedOplist := listSort(function GLESSEQP,
+                           COPY_-LIST $lisplibOperationAlist,function CADR)
+  $lastPred :local := nil
+  $newEnv :local := $e
+  $domainShell.1 := [fn entry for entry in sortedOplist] where
+    fn [[op,sig],pred,fnsel] ==
+       if $lastPred ^= pred then
+            $newEnv := deepChaseInferences(pred,$e)
+            $lastPred := pred
+       newfnsel :=
+         fnsel is ['Subsumed,op1,sig1] =>
+           ['Subsumed,op1,genSlotSig(sig1,'T,$newEnv)]
+         fnsel
+       [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel]
+
+------- from compiler.boot -----------
+
+--------------------> NEW DEFINITION (see compiler.boot.pamphlet)
+getFormModemaps(form is [op,:argl],e) ==
+  op is ["elt",domain,op1] =>
+    [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]]
+  null atom op => nil
+  modemapList:= get(op,"modemap",e)
+  if $insideCategoryPackageIfTrue then
+    modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ^= '$]
+  if op="elt"
+     then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil
+     else
+      if op="setelt" then modemapList:=
+        seteltModemapFilter(CADR argl,modemapList,e) or return nil
+  nargs:= #argl
+  finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList | #sig=nargs]
+  modemapList and null finalModemapList =>
+    stackMessage ["no modemap for","%b",op,"%d","with ",nargs," arguments"]
+  finalModemapList
+
+------- from functor.boot -----------
+
+--------------------> NEW DEFINITION (see functor.boot.pamphlet)
+LookUpSigSlots(sig,siglist) ==
+--+ must kill any implementations below of the form (ELT $ NIL)
+  if $insideCategoryPackageIfTrue then
+           sig := substitute('$,CADR($functorForm),sig)
+  siglist := $lisplibOperationAlist
+  REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u)
+              and KADDR implem]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}