* template.boot: New.

	* template.boot.pamphlet: Move content to template.boot.  Remove.
	* termrw.boot: New.
	* termrw.boot.pamphlet: Move content to template.boot.  Remove.
	* topics.boot: New.
	* topics.boot.pamphlet: Move content to topics.boot.  Remove.
	* trace.boot: New.
	* trace.boot.pamphlet: Move content to trace.boot.  Remove.
	* varini.boot: New.
	* varini.boot.pamphlet: Move content to varini.boot.  Remove.
	* xrun.boot: New.
	* xrun.boot.pamphlet: Move content to xrun.boot.  Remove
	* xruncomp.boot: New.
	* xruncomp.boot.pamphlet: Move content to xruncomp.boot.  Remove.
	* Makefile.pamphlet (<<xruncomp.clisp>>): Remove.
	(<<trace.lisp>>): Likewise.
	(<<topics.clisp>>): Likewise.
	(<<template.clisp>>): Likewise.
	(<<termrw.clisp>>): Likewise.

1 files changed, 496 insertions, 0 deletions

diff --git a/src/interp/xrun.boot b/src/interp/xrun.boot
new file mode 100644
index 00000000..b6be04c5
--- /dev/null
+++ b/src/interp/xrun.boot
@@ -0,0 +1,496 @@
+-- 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.
+
+
+)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)