(FILECREATED " 3-Apr-86 07:28:36" {ERIS}<TAMARIN>WORK>SIMULATE>TEFNS.;31 23942
changes to: (FNS TE.GETPTR.N TE.PUTPTR.N TE.CAR TE.CDR TE.ADDBASE TE.VARK← TE.PUTBASEBYTE
TE.ASH TE.TYPEP.O TE.IPLUS TE.IDIFFERENCE TE.ITIMES TE.IQUOTIENT
TE.IREMAINDER TE.NEG)
previous date: "25-Mar-86 08:14:23" {ERIS}<TAMARIN>WORK>SIMULATE>TEFNS.;24)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEFNSCOMS)
(RPAQQ TEFNSCOMS ((FNS (* * CONSTANTS)
TE.'T TE.'NIL TE.'0 TE.'1 TE.'UNBIND TE.SICX TE.ACONST TE.PCONST TE.ICONST
TE.FCONST (* * PROCEDURE CALLING AND RETURNING)
TE.FN0 TE.FN1 TE.FN2 TE.FN3 TE.FN4 TE.FN5 TE.FN6 TE.FN7 TE.APPLYFN TE.RETURN
TE.MYALINK TE.MYCLINK TE.MYCLINK← TE.CONTEXTSWITCH TE.DISINT TE.ENBINT (*
* JUMP INSTRUCTIONS)
TE.JUMPK TE.JUMPX TE.JUMPXX TE.TJUMPK TE.TJUMPX TE.FJUMPK TE.FJUMPX TE.NOP (
* * INTEGER ARITHMETIC OPERATIONS)
TE.PLUS TE.DIFFERENCE TE.TIMES TE.QUOTIENT TE.IPLUS TE.IDIFFERENCE TE.ITIMES
TE.IQUOTIENT TE.IREMAINDER (* * INTEGER SHIFTS)
TE.LLSH.N TE.LRSH.N TE.ASH (* * LOGICAL INTEGER OPERATIONS)
TE.LOGOR TE.LOGXOR TE.LOGAND (* * COMPARISONS)
TE.EQ TE.EQL TE.EQUAL TE.GREATERP TE.IGREATERP (* * VARIABLE REFERENCING)
TE.VARK TE.VARX TE.VARK← TE.VARX← TE.VARK←NIL TE.VARK←UNBIND TE.FVARX
TE.FVARX← TE.FVARM TE.FVARM← TE.GVAR TE.GVAR← TE.VARM TE.VARM← (* *
ADDRESSING
ROUTINES)
TE.ADDBASE TE.GETPTR.N TE.PUTPTR.N TE.RPLPTR.N TE.GETBASEBYTE TE.PUTBASEBYTE
(* * STACK OPERATIONS)
TE.COPY TE.POP TE.DUMMY TE.DUNBIND TE.UNBIND (* * UNARY STACK INSTRUCTIONS)
TE.NEG TE.CAR TE.CDR TE.LISTP TE.INTEGERP TE.POINTERP TE.FLOATP TE.NUMBERP
TE.TYPEP.N TE.TYPEP.O TE.DTEST.O TE.NTYPE TE.SETTYPE.N TE.SETSUBTYP.N (*
* TESTING ROUTINES)
TFUN.GETREGABS
(* *))))
(DEFINEQ
(TE.'T
[LAMBDA NIL (* rtk "24-Mar-86 17:16")
TS.TCONST])
(TE.'NIL
[LAMBDA NIL (* edited: "11-Mar-86 13:18")
TS.NILCONST])
(TE.'0
[LAMBDA NIL (* edited: "11-Mar-86 13:18")
(TS.NEWTINT 0])
(TE.'1
[LAMBDA NIL (* edited: "11-Mar-86 13:18")
(TS.NEWTINT 1])
(TE.'UNBIND
[LAMBDA NIL (* rtk "24-Mar-86 17:18")
TS.UNBINDCONST])
(TE.SICX
[LAMBDA (C) (* edited: "11-Mar-86 13:18")
(TS.NEWTINT C])
(TE.ACONST
[LAMBDA (ATOM#) (* edited: "12-Mar-86 10:42")
(* * Make Atom type from Atom number given)
(TS.NEWTPTR TS.ATOMSUBTYP ATOM#])
(TE.PCONST
[LAMBDA (PTR) (* edited: "12-Mar-86 10:13")
(* * Make new pointer. For now assuming that all pointer type information is in the 4 bytes of the code stream)
PTR])
(TE.ICONST
[LAMBDA (INT) (* edited: "12-Mar-86 10:14")
(* * This assumes that INT in the code stream does NOT have type bits set)
(TS.NEWTINT INT])
(TE.FCONST
[LAMBDA (FLOAT) (* edited: "12-Mar-86 10:41")
(TS.NEWTFLOAT FLOAT])
(TE.FN0
[LAMBDA (FN) (* rtk "26-Feb-86 16:39")
(TS.TAMFUNCTIONCALL FN 0])
(TE.FN1
[LAMBDA (P1 FN) (* edited: "11-Mar-86 15:37")
(TS.TAMFUNCTIONCALL FN 1])
(TE.FN2
[LAMBDA (P1 P2 FN) (* edited: "11-Mar-86 15:36")
(TS.TAMFUNCTIONCALL FN 2])
(TE.FN3
[LAMBDA (P1 P2 P3 FN) (* edited: "11-Mar-86 15:36")
(TS.TAMFUNCTIONCALL FN 3])
(TE.FN4
[LAMBDA (P1 P2 P3 P4 FN) (* edited: "11-Mar-86 15:35")
(TS.TAMFUNCTIONCALL FN 4])
(TE.FN5
[LAMBDA (P1 P2 P3 P4 P5 FN) (* edited: "11-Mar-86 15:35")
(TS.TAMFUNCTIONCALL FN 5])
(TE.FN6
[LAMBDA (P1 P2 P3 P4 P5 P6 FN) (* edited: "11-Mar-86 15:35")
(TS.TAMFUNCTIONCALL FN 6])
(TE.FN7
[LAMBDA (P1 P2 P3 P4 P5 P6 P7 FN) (* edited: "11-Mar-86 15:37")
(TS.TAMFUNCTIONCALL FN 7])
(TE.APPLYFN
[LAMBDA NIL (* edited: "10-Mar-86 16:17")
(BREAK1 NIL T (APPLAYFN not implemented yet)
NIL])
(TE.RETURN
[LAMBDA NIL (* rtk "26-Feb-86 14:44")
(TS.TAMFUNCTIONRETURN])
(TE.MYALINK
[LAMBDA NIL (* rtk "25-Mar-86 07:12")
(TS.PUNTPREVIOUSFRAMES (WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)))
(FETCH (TFRAME ALINK) OF STACKFRAME])
(TE.MYCLINK
[LAMBDA NIL (* edited: "14-Mar-86 16:55")
(TS.PUNTPREVIOUSFRAMES (WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)))
(fetch (TFRAME CLINK) of STACKFRAME])
(TE.MYCLINK←
[LAMBDA (X) (* rtk "25-Mar-86 07:11")
(TS.PUNTPREVIOUSFRAMES (WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)))
(REPLACE (TFRAME CLINK) OF STACKFRAME WITH X])
(TE.CONTEXTSWITCH
[LAMBDA NIL (* rtk "24-Mar-86 18:07")
NIL])
(TE.DISINT
[LAMBDA NIL (* rtk "24-Mar-86 18:07")
NIL])
(TE.ENBINT
[LAMBDA NIL (* rtk "24-Mar-86 18:08")
NIL])
(TE.JUMPK
[LAMBDA NIL (* rtk "24-Mar-86 18:05")
(TS.PUTFRAMEPROP STACKFRAME (QUOTE PC)
(IPLUS (TS.GETFRAMEPROP STACKFRAME (QUOTE PC))
(TS.GETOPCODEOFFSET)
1])
(TE.JUMPX
[LAMBDA (OFFSETBYTE) (* rtk "26-Feb-86 17:14")
(TS.PUTFRAMEPROP STACKFRAME (QUOTE PC)
(IDIFFERENCE (IPLUS (TS.GETFRAMEPROP STACKFRAME (QUOTE PC))
(RSH (LLSH OFFSETBYTE 24)
24))
2])
(TE.JUMPXX
[LAMBDA (WORDOFFSET) (* edited: "10-Mar-86 16:25")
(TS.PUTFRAMEPROP STACKFRAME (QUOTE PC)
(IDIFFERENCE (IPLUS (TS.GETFRAMEPROP STACKFRAME (QUOTE PC))
(RSH (LLSH WORDOFFSET 16)
16))
3])
(TE.TJUMPK
[LAMBDA (VAL) (* rtk "24-Mar-86 18:06")
(if (EQP VAL TS.NILCONST)
then NIL
else (TE.JUMPK])
(TE.TJUMPX
[LAMBDA (VAL OFFSETBYTE) (* edited: " 7-Mar-86 16:52")
(IF (EQUAL VAL TS.NILCONST)
THEN NIL
ELSE (TE.JUMPX OFFSETBYTE])
(TE.FJUMPK
[LAMBDA (VAL) (* rtk "24-Mar-86 18:06")
(if (EQP VAL TS.NILCONST)
then (TE.JUMPK)
else NIL])
(TE.FJUMPX
[LAMBDA (VAL OFFSETBYTE) (* edited: " 7-Mar-86 16:52")
(if (EQUAL VAL TS.NILCONST)
then (TE.JUMPX OFFSETBYTE)
else NIL])
(TE.NOP
[LAMBDA NIL (* rtk "24-Mar-86 18:01")
(FOR I FROM 1 TO (TS.GETOPCODEOFFSET) DO (TS.FETCH])
(TE.PLUS
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:14")
(* * Same as IPLUS except UFN does not coerce to integer)
(TE.IPLUS A1 A2])
(TE.DIFFERENCE
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:15")
(* * Same as IDIFFERENCE except UFN does not coerce to integer)
(IDIFFERENCE A1 A2])
(TE.TIMES
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:16")
(* * Same as ITIMES except UFN does not coerce to integer)
(ITIMES A1 A2])
(TE.QUOTIENT
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:17")
(* * Same as IQUOTIENT except UFN does not coerce to integer)
(IQUOTIENT A1 A2])
(TE.IPLUS
[LAMBDA (A1 A2) (* rtk "27-Mar-86 16:04")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then [PROG [(X (IPLUS (TTOD A1)
(TTOD A2]
(RETURN (if (AND (GEQ TS.MAXINT X)
(LEQ TS.MININT X))
then (TS.NEWTINT X)
else (TS.UFNCALL]
else (TS.UFNCALL])
(TE.IDIFFERENCE
[LAMBDA (A1 A2) (* rtk "27-Mar-86 16:06")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then [PROG [(X (IDIFFERENCE (TTOD A1)
(TTOD A2]
(RETURN (if (AND (GEQ TS.MAXINT X)
(LEQ TS.MININT X))
then (TS.NEWTINT X)
else (TS.UFNCALL]
else (TS.UFNCALL])
(TE.ITIMES
[LAMBDA (A1 A2) (* rtk "27-Mar-86 16:06")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then [PROG [(X (ITIMES (TTOD A1)
(TTOD A2]
(RETURN (IF (AND (GEQ TS.MAXINT X)
(LEQ TS.MININT X))
THEN (TS.NEWTINT X)
ELSE (TS.UFNCALL]
else (TS.UFNCALL])
(TE.IQUOTIENT
[LAMBDA (A1 A2) (* rtk "27-Mar-86 16:10")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if [AND (TS.INTEGERP A1)
(TS.INTEGERP A2)
(NOT (ZEROP (TTOD A2]
then
(* * overflow possible on minint / -1 = maxint + 1)
[PROG [(X (IQUOTIENT (TTOD A1)
(TTOD A2]
(RETURN (IF (AND (GEQ TS.MAXINT X)
(LEQ TS.MININT X))
THEN (TS.NEWTINT X)
ELSE (TS.UFNCALL]
else (TS.UFNCALL])
(TE.IREMAINDER
[LAMBDA (A1 A2) (* rtk "27-Mar-86 16:10")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if [AND (TS.INTEGERP A1)
(TS.INTEGERP A2)
(NOT (ZEROP (TTOD A2]
then
(* * Overflow possible with REM: -1 & minint = maxint + 1)
[PROG [(X (IREMAINDER (TTOD A1)
(TTOD A2]
(RETURN (IF (AND (GEQ TS.MAXINT X)
(LEQ TS.MININT X))
THEN (TS.NEWTINT X)
ELSE (TS.UFNCALL]
else (TS.UFNCALL])
(TE.LLSH.N
[LAMBDA (A1 ALPHA) (* rtk "24-Mar-86 17:48")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (TS.INTEGERP A1)
then (TS.NEWTINT (LLSH (fetch (TCELL INT) of A1)
ALPHA))
else (TS.UFNCALL])
(TE.LRSH.N
[LAMBDA (A1 ALPHA) (* rtk "24-Mar-86 17:49")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (TS.INTEGERP A1)
then (TS.NEWTINT (LRSH (fetch (TCELL INT) of A1)
ALPHA))
else (TS.UFNCALL])
(TE.ASH
[LAMBDA (A1 A2) (* rtk "27-Mar-86 17:56")
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then (TS.NEWTINT (LSH (TTOD A1)
(TTOD A2)))
else (TS.UFNCALL])
(TE.LOGOR
[LAMBDA (A1 A2) (* rtk "24-Mar-86 17:53")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then (TS.NEWTINT (LOGOR (fetch (TCELL INT) of A1)
(fetch (TCELL INT) of A2)))
else (TS.UFNCALL])
(TE.LOGXOR
[LAMBDA (A1 A2) (* rtk "24-Mar-86 17:53")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then (TS.NEWTINT (LOGXOR (fetch (TCELL INT) of A1)
(fetch (TCELL INT) of A2)))
else (TS.UFNCALL])
(TE.LOGAND
[LAMBDA (A1 A2) (* rtk "24-Mar-86 17:54")
(* * Check types; if OK, do operation in D-world (fetch converts INT field to D-integer) then reconvert and return)
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then (TS.NEWTINT (LOGAND (fetch (TCELL INT) of A1)
(fetch (TCELL INT) of A2)))
else (TS.UFNCALL])
(TE.EQ
[LAMBDA (A1 A2) (* edited: "11-Mar-86 15:57")
(DTOT (EQP A1 A2])
(TE.EQL
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:22")
(IF (EQP A1 A2)
THEN TS.TCONST
ELSEIF (AND (TS.NUMBERP A1)
(TS.NUMBERP A2))
THEN (TS.UFNCALL)
ELSE TS.NILCONST])
(TE.EQUAL
[LAMBDA NIL (* rtk "24-Mar-86 17:40")
NIL])
(TE.GREATERP
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:24")
(* * Same as IGREATERP except UFN does not coerce to integers before comparison)
(TE.IGREATERP A1 A2])
(TE.IGREATERP
[LAMBDA (A1 A2) (* rtk "25-Mar-86 07:23")
(if (AND (TS.INTEGERP A1)
(TS.INTEGERP A2))
then (if (IGREATERP (fetch (TCELL INT) of A1)
(fetch (TCELL INT) of A2))
then TS.TCONST
else TS.NILCONST)
else (TS.UFNCALL])
(TE.VARK
[LAMBDA NIL (* edited: "11-Mar-86 13:45")
(TE.VARX (TS.GETOPCODEOFFSET])
(TE.VARX
[LAMBDA (OFFSET) (* edited: "11-Mar-86 13:22")
(TS.VARREF OFFSET])
(TE.VARK←
[LAMBDA (TOS) (* rtk " 1-Apr-86 07:32")
(TE.VARX← TOS (TS.GETOPCODEOFFSET])
(TE.VARX←
[LAMBDA (TOS OFFSET) (* edited: "11-Mar-86 13:45")
(TS.VARSTORE OFFSET TOS])
(TE.VARK←NIL
[LAMBDA NIL (* rtk " 7-Mar-86 12:04")
(TS.VARSTORE (TS.GETOPCODEOFFSET)
TS.NILCONST])
(TE.VARK←UNBIND
[LAMBDA NIL (* rtk " 7-Mar-86 12:04")
(TS.VARSTORE (TS.GETOPCODEOFFSET)
TS.UNBINDCONST])
(TE.FVARX
[LAMBDA (OFFSET) (* edited: "14-Mar-86 18:07")
(if (TS.UNBOUNDP (TS.VARREF OFFSET))
then (TS.UFNCALL)
else (TMEM.GETMEM (TS.VARREF OFFSET])
(TE.FVARX←
[LAMBDA (TOS OFFSET) (* edited: "14-Mar-86 18:20")
(if (TS.UNBOUNDP (TS.VARREF OFFSET))
then (TS.UFNCALL)
else (TMEM.SETMEM (TS.VARREF OFFSET)
TOS))
TOS])
(TE.FVARM
[LAMBDA NIL (* rtk "24-Mar-86 17:22")
NIL])
(TE.FVARM←
[LAMBDA NIL (* rtk "24-Mar-86 17:22")
NIL])
(TE.GVAR
[LAMBDA (ATOM#) (* edited: "11-Mar-86 13:48")
(* * Global values for T-atoms stored as T-GVAL property of D-atom)
(IF (FMEMB (QUOTE T-GVAL)
(PROPNAMES (\INDEXATOMVAL ATOM#)))
THEN (GETPROP (\INDEXATOMVAL ATOM#)
(QUOTE T-GVAL))
ELSE (BREAK1 NIL T (Unbound Global Atom in T\GVAR)
NIL])
(TE.GVAR←
[LAMBDA (TOS ATOM#) (* edited: "11-Mar-86 13:49")
(PUTPROP (\INDEXATOMVAL ATOM#)
(QUOTE T-GVAL)
TOS])
(TE.VARM
[LAMBDA NIL (* rtk "24-Mar-86 17:24")
NIL])
(TE.VARM←
[LAMBDA NIL (* rtk "24-Mar-86 17:24")
NIL])
(TE.ADDBASE
[LAMBDA (X D) (* rtk " 2-Apr-86 16:18")
(if (TS.POINTERP X)
then (PROG (VAL)
[SETQ VAL (IPLUS (if (EVENP (fetch (TCELL PTR) of X))
then (fetch (TCELL PTR) of X)
else (BREAK1 NIL T (Pointer is Odd in TE.ADDBASE)
NIL))
(if (TS.INTEGERP D)
then (if (EVENP D)
then (TTOD D)
else (BREAK1 NIL T (Offset is Odd in TE.ADDBASE)
NIL))
else (BREAK1 NIL T (Type not Integer in TE.ADDBASE)
NIL]
(RETURN (TS.NEWTPTR (fetch (TCELL SUBTYP) of X)
VAL)))
else (BREAK1 NIL T (Need Pointer in TE.ADDBASE)
NIL])
(TE.GETPTR.N
[LAMBDA (X D) (* rtk " 2-Apr-86 17:17")
(if (TS.POINTERP X)
then (TMEM.GETMEM (TE.ADDBASE X (DTOT D)))
else (TS.UFNCALL])
(TE.PUTPTR.N
[LAMBDA (X V D) (* rtk " 2-Apr-86 17:13")
(if (TS.POINTERP X)
then (TMEM.SETMEM (TE.ADDBASE X (DTOT D))
V)
else (TS.UFNCALL))
(* * Return Ptr on the stack)
X])
(TE.RPLPTR.N
[LAMBDA (X V D) (* rtk "25-Mar-86 07:27")
(* * Same as PUTPTR for not (need to add reference counting))
(if (TS.POINTERP X)
then (TMEM.SETMEM (TE.ADDBASE X D)
V)
else (TS.UFNCALL))
X (* Return Ptr on the stack)
])
(TE.GETBASEBYTE
[LAMBDA (X D) (* edited: "14-Mar-86 15:40")
(* * RETURNS BYTE ADDRESSED BY PTR X AND OFFSET D. RESULT IS RETURNED AS TARARIN INTEGER)
(PROG (VALUE)
(RETURN (if (TS.INTEGERP D)
then [SETQ VALUE (TE.GETPTR.N X (TE.LRSH1 (LOGAND (TE.LRSH1 D)
4294967294]
(TS.NEWINTP (SELECTQ (LOGAND 3 (TTOD D))
(0 (LRSH VALUE 24))
(1 (LRSH VALUE 16))
(2 (LRSH VALUE 8))
(VALUE)))
else (BREAK1 NIL T (Offset not Integer)
NIL])
(TE.PUTBASEBYTE
[LAMBDA (X D V) (* rtk "27-Mar-86 18:07")
(PROG (WORD32)
(if (AND (TS.INTEGERP V)
(TS.INTEGERP D))
then (SETQ V (.COERCE.TO.BYTE. (TTOD V)))
[SETQ WORD32 (TE.GETPTR.N X (TE.LRSH1 (TE.LRSH1 D]
(TE.PUTPTR.N X (TE.LRSH1 (TE.LRSH1 D))
(SELECTQ (LOGAND 3 (TTOD D))
(0 (LOGOR (LOGAND WORD32 16777215)
(LRSH V 24)))
(1 (LOGOR (LOGAND WORD32 4278255615)
(LRSH V 16)))
(2 (LOGOR (LOGAND WORD32 4294902015)
(LRSH V 8)))
(LOGOR (LOGAND WORD32 4294967040)
V)))
else (BREAK1 NIL T (Offset or Value not Integer in TE.PUTBASEBYTE)
NIL))
(RETURN V])
(TE.COPY
[LAMBDA NIL (* edited: "11-Mar-86 13:50")
(TS.REFTOS])
(TE.POP
[LAMBDA (TOS) (* rtk "25-Mar-86 07:27")
TS.NILCONST])
(TE.DUMMY
[LAMBDA NIL (* edited: "11-Mar-86 13:54")
TS.NILCONST])
(TE.DUNBIND
[LAMBDA (ALPHA) (* edited: "12-Mar-86 10:01")
(IF (AND (GREATERP ALPHA (FETCH (TFRAME OVERHEADCELLS) OF T))
(LEQ ALPHA (FETCH (TFRAME TFRAMEWORDSIZE) OF T)))
THEN (TS.PUTFRAMEPROP STACKFRAME (QUOTE SP)
ALPHA)
ELSE (BREAK1 NIL T (Illegal Stack Pointer Value)
NIL])
(TE.UNBIND
[LAMBDA (ALPHA) (* edited: "12-Mar-86 10:04")
(PROG ((X (TS.REFTOS)))
(TE.DUNBIND ALPHA)
(TS.PUTFRAMEPROP STACKFRAME (TS.GETFRAMEPROP STACKFRAME (QUOTE SP))
X])
(TE.NEG
[LAMBDA (TOS) (* rtk "27-Mar-86 16:21")
(IF (TS.INTEGERP TOS)
THEN (DTOT (IDIFFERENCE 0 (TTOD TOS)))
ELSE (TS.UFNCALL])
(TE.CAR
[LAMBDA (PTR) (* rtk " 2-Apr-86 17:16")
(COND
((TS.LISTP PTR)
(TE.GETPTR.N PTR 0))
((EQP PTR TS.NILCONST)
TS.NILCONST)
(T (TS.UFNCALL])
(TE.CDR
[LAMBDA (PTR) (* rtk " 3-Apr-86 07:26")
(COND
((TS.LISTP PTR)
(TE.GETPTR.N PTR TS.WORDINCR))
((EQP PTR TS.NILCONST)
TS.NILCONST)
(T (TS.UFNCALL])
(TE.LISTP
[LAMBDA (TOS) (* edited: "12-Mar-86 17:10")
(DTOT (TS.LISTP TOS])
(TE.INTEGERP
[LAMBDA (TOS) (* edited: "12-Mar-86 17:14")
(DTOT (TS.INTEGERP TOS])
(TE.POINTERP
[LAMBDA (TOS) (* edited: "12-Mar-86 17:16")
(DTOT (TS.POINTERP TOS])
(TE.FLOATP
[LAMBDA (TOS) (* edited: "12-Mar-86 17:17")
(DTOT (TS.FLOATP TOS])
(TE.NUMBERP
[LAMBDA (TOS) (* edited: "12-Mar-86 17:15")
(DTOT (OR (TS.INTEGERP TOS)
(TS.NUMBERP TOS)
(TS.FLOATP TOS])
(TE.TYPEP.N
[LAMBDA (TOS ALPHA) (* edited: "12-Mar-86 10:28")
(if (EQ ALPHA (fetch (TCELL FULLTYP) of TOS))
then TOS
else TS.NILCONST])
(TE.TYPEP.O
[LAMBDA (TOS TYPE) (* rtk "27-Mar-86 12:36")
(IF (TS.POINTERP TOS)
THEN (TE.TYPE.N (TMEM.GETMEM TOS)
TYPE)
ELSE TS.NILCONST])
(TE.DTEST.O
[LAMBDA (TOS ALPHA) (* rtk "24-Mar-86 17:37")
(PROG (X (TE.TEST.O TOS ALPHA))
(RETURN (IF (EQ X TS.NILCONST)
THEN (TS.UFNCALL)
ELSE X])
(TE.NTYPE
[LAMBDA NIL (* rtk "24-Mar-86 17:38")
NIL])
(TE.SETTYPE.N
[LAMBDA NIL (* rtk "24-Mar-86 17:38")
NIL])
(TE.SETSUBTYP.N
[LAMBDA NIL (* rtk "24-Mar-86 17:39")
NIL])
(TFUN.GETREGABS
[LAMBDA (FNHDR DOFFSET) (* edited: "14-Mar-86 16:34")
(\GETBASEFIXP FNHDR DOFFSET])
)
(PUTPROPS TEFNS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1870 23866 (TE.'T 1880 . 1997) (TE.'NIL 1999 . 2124) (TE.'0 2126 . 2251) (TE.'1 2253 .
2378) (TE.'UNBIND 2380 . 2507) (TE.SICX 2509 . 2636) (TE.ACONST 2638 . 2846) (TE.PCONST 2848 . 3096) (
TE.ICONST 3098 . 3321) (TE.FCONST 3323 . 3458) (TE.FN0 3460 . 3593) (TE.FN1 3595 . 3732) (TE.FN2 3734
. 3871) (TE.FN3 3873 . 4010) (TE.FN4 4012 . 4149) (TE.FN5 4151 . 4288) (TE.FN6 4290 . 4427) (TE.FN7
4429 . 4566) (TE.APPLYFN 4568 . 4738) (TE.RETURN 4740 . 4873) (TE.MYALINK 4875 . 5111) (TE.MYCLINK
5113 . 5353) (TE.MYCLINK← 5355 . 5605) (TE.CONTEXTSWITCH 5607 . 5729) (TE.DISINT 5731 . 5846) (
TE.ENBINT 5848 . 5963) (TE.JUMPK 5965 . 6205) (TE.JUMPX 6207 . 6479) (TE.JUMPXX 6481 . 6758) (
TE.TJUMPK 6760 . 6944) (TE.TJUMPX 6946 . 7147) (TE.FJUMPK 7149 . 7334) (TE.FJUMPX 7336 . 7538) (TE.NOP
7540 . 7715) (TE.PLUS 7717 . 7921) (TE.DIFFERENCE 7923 . 8138) (TE.TIMES 8140 . 8340) (TE.QUOTIENT
8342 . 8551) (TE.IPLUS 8553 . 9061) (TE.IDIFFERENCE 9063 . 9589) (TE.ITIMES 9591 . 10102) (
TE.IQUOTIENT 10104 . 10731) (TE.IREMAINDER 10733 . 11370) (TE.LLSH.N 11372 . 11743) (TE.LRSH.N 11745
. 12116) (TE.ASH 12118 . 12362) (TE.LOGOR 12364 . 12795) (TE.LOGXOR 12797 . 13231) (TE.LOGAND 13233
. 13667) (TE.EQ 13669 . 13797) (TE.EQL 13799 . 14058) (TE.EQUAL 14060 . 14174) (TE.GREATERP 14176 .
14411) (TE.IGREATERP 14413 . 14761) (TE.VARK 14763 . 14909) (TE.VARX 14911 . 15042) (TE.VARK← 15044 .
15192) (TE.VARX← 15194 . 15332) (TE.VARK←NIL 15334 . 15496) (TE.VARK←UNBIND 15498 . 15666) (TE.FVARX
15668 . 15892) (TE.FVARX← 15894 . 16139) (TE.FVARM 16141 . 16255) (TE.FVARM← 16257 . 16372) (TE.GVAR
16374 . 16772) (TE.GVAR← 16774 . 16950) (TE.VARM 16952 . 17065) (TE.VARM← 17067 . 17181) (TE.ADDBASE
17183 . 17940) (TE.GETPTR.N 17942 . 18158) (TE.PUTPTR.N 18160 . 18440) (TE.RPLPTR.N 18442 . 18839) (
TE.GETBASEBYTE 18841 . 19449) (TE.PUTBASEBYTE 19451 . 20237) (TE.COPY 20239 . 20363) (TE.POP 20365 .
20485) (TE.DUMMY 20487 . 20613) (TE.DUNBIND 20615 . 21001) (TE.UNBIND 21003 . 21261) (TE.NEG 21263 .
21468) (TE.CAR 21470 . 21696) (TE.CDR 21698 . 21934) (TE.LISTP 21936 . 22070) (TE.INTEGERP 22072 .
22212) (TE.POINTERP 22214 . 22354) (TE.FLOATP 22356 . 22492) (TE.NUMBERP 22494 . 22684) (TE.TYPEP.N
22686 . 22901) (TE.TYPEP.O 22903 . 23118) (TE.DTEST.O 23120 . 23356) (TE.NTYPE 23358 . 23472) (
TE.SETTYPE.N 23474 . 23592) (TE.SETSUBTYP.N 23594 . 23714) (TFUN.GETREGABS 23716 . 23864)))))
STOP