(FILECREATED " 5-Feb-87 07:31:53" {ERIS}<TAMARIN>UCODE>TESTOPS.;87 34347
changes to: (VARS inttest TESTOPSCOMS qjumptest looptest memwritetest)
previous date: "19-Sep-86 16:26:23" {ERIS}<TAMARIN>UCODE>TESTOPS.;82)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TESTOPSCOMS)
(RPAQQ TESTOPSCOMS ((VARS simtest simtracetest)
(VARS test testeqops testgregops testbinops testunaryops testcarcdrops testconstops2
testpredops testshiftops teststackops testconstops testtypeops testops testops2
testovarops testash)
(* * Variable referencing)
(VARS testvarops testgvarops fvartest refcounttest)
(* * Jump Tests)
(VARS testjumpops smalljumps jumperror tfsmalljumps negjumpx negjumpxx ibuftest)
(* * Function Call)
(VARS testfnops undefntest applytest fulltest fnops ufn1test ufn1dtest ufn2test frameadjust
ufndump dumploadtest)
(* * Interrupt Tests)
(VARS irqtest irqenbtest)
(* * Virtual Memory Tests)
(VARS vmtest vmtest2 vmtest3)
(* * Special Opcodes)
(VARS testwoct)
(* * test vectors)
(VARS looptest memwritetest inttest qjumptest)
(* * Initialization)
(VARS tamSetUp tamInit)
(* * Special Loadups)
(VARS dotak dotak2)
(FNS Testfn tak)))
(RPAQQ simtest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← COPY GETBASEPTR.N [CADR (FASSOC (QUOTE nextlink)
(GETPROP (QUOTE k)
(QUOTE uField]
SICX
(LOGOR (TamTagRep (QUOTE Frame))
1)
SETSUBTYPE PUTBASEPTR.N [CADR (FASSOC (QUOTE nextlink)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
256))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE frameflagcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
232))
IREGX←
[CADR (FASSOC (QUOTE intcode)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
128))
IREGX←
[CADR (FASSOC (QUOTE pfcode)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
320))
IREGX←
[CADR (FASSOC (QUOTE refcountcode)
(GETPROP (QUOTE k)
(QUOTE uField]
ACONST
(EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
192))
PUTBASEPTR.N LLSH.N ENBINT 'NIL VAR8← POP 'T VAR9← VAR8 SWAP SICX 2 COPY '1 PLUS
INTEGERP TJUMPX 1 STOP COPY '1 PLUS JUMP15 STOP STOP STOP STOP STOP STOP STOP
STOP STOP STOP STOP STOP STOP STOP STOP NEG ICONST (EvalBytes
4
(TamRep (QUOTE Int)
268435461))
SICX 3 DIFFERENCE POP SICX 3 NEG ASH SETTYPE.N (TamTagRep (QUOTE Float))
SICX
(TamTagRep (QUOTE Int))
SETSUBTYPE SICX 3 FLAGTYPEP.N 3 POP SUBTYPEP.N (LOGOR (TamTagRep (QUOTE Atm))
1)
GETTYPEBITS 'NIL GETPTRBITS GVAR [EvalBytes
3
(AddAtom (QUOTE B)
(AddList (QUOTE (11 (12 13)
14]
GVAR
[EvalBytes 3 (AddAtom (QUOTE A)
(AddList (QUOTE (1 (11 (12 13)
14)
3 4 5 6]
CAR GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
CDR CDR GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
SICX 2 '1 ACONST (EvalBytes 3 (AddAtom (QUOTE fn)))
APPLYFN STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
'0 '1 MOVETOS 17 SETTOS 16 '1 OVAR1.X← 8 VAR8 '0 EQ TJUMPX 9 VAR8 SICX 1
DIFFERENCE FN1 (EvalBytes 3 (AddAtom (QUOTE fn)))
RETURN OVAR1.X 8 GVAR (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
SETTOS 20 ICONST (EvalBytes 4 (TamRep (QUOTE Int)
536870912))
LLSH.N 1 RETURN (EvalBytes 0 (AddFnHeader (QUOTE PfFn)
128))
VAR8 ICONST (EvalBytes 4 (TamRep 16777215))
LOGAND LRSH.N 10 SETTYPE.N (TamRep (QUOTE Ptr))
COPY GETBASEPTR.N 0 VAR9← ICONST (EvalBytes 4 (TamRep 3))
LOGOR PUTBASEPTR.N 0 RESET-VMM RETNP (EvalBytes 0 (AddFnHeader (QUOTE llsh)
192))
NOP '1 RETNP (EvalBytes 0 (AddFnHeader (QUOTE irqfn)
232))
'1 RETEI (EvalBytes 0 (AddFnHeader (QUOTE FrameFn)
256))
MYCLINK RETNP (EvalBytes 0 (AddFnHeader (QUOTE RcFn)
320))
RETNP @ 2048 (EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 24))
(EvalBytes -4 (TamRep 28))
@ 4161 (EvalBytes -4 (TamRep (QUOTE Int)
5))
(EvalBytes 0 (AddFnHeader (QUOTE Ovfn)
2103296))
JUMPXX
(EvalBytes 2 4042)
@ 4201464 NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP '0 '1 'NIL 'T NOP NOP NOP RETURN))
(RPAQQ simtracetest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← PCONST (EvalBytes 4 (TamRep (QUOTE Code)
64))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE intcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
ENBINT 'NIL SETOUTPUTINT DISINT WRITEOCTNIL.N 16 SETMEMLOCK
WRITEOCTUNBOUND.N 16 CLRMEMLOCK WRITEOCTNIL.N 16 ENBINT CLROUTPUTINT
WRITEOCTUNBOUND.N 16 NJUMPX 16 (EvalBytes 0 (AddFnHeader (QUOTE IrqFn)
64))
'0 RETEI))
(RPAQQ test (@ 0 'NIL IREGX← 258 GVAR (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
POP IREGX← 258 GVAR (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
POP IREGX← 258 GVAR (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
POP IREGX← 258 GVAR (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
STOP))
(RPAQQ testeqops (@ 0 STOP))
(RPAQQ testgregops (@ 0 '1 IREGX← 0 '1 PLUS IREGX← 1 '0 IREGX← 39 IREGX 0 IREGX 1 IREGX 39 STOP))
(RPAQQ testbinops (@ 0 '0 '1 GREATERP '1 '1 GREATERP '1 '0 GREATERP ICONST
(EvalBytes 4 (TamRep (QUOTE Int)
536870911))
ICONST
(EvalBytes 4 (TamRep (QUOTE Int)
536870910))
GREATERP ICONST (EvalBytes 4 (TamRep (QUOTE Int)
1073741822))
ICONST
(EvalBytes 4 (TamRep (QUOTE Int)
1073741823))
GREATERP ICONST (EvalBytes 4 (TamRep (QUOTE Int)
1073741823))
ICONST
(EvalBytes 4 (TamRep (QUOTE Int)
1073741822))
GREATERP '1 SICX 3 PLUS '1 DIFFERENCE '0 '1 LOGAND '1 LOGOR ASH '1 DIFFERENCE
SICX 7 LOGOR SICX 5 LOGAND STOP))
(RPAQQ testunaryops (@ 0 '1 NEG NEG '0 NEG NEG '1 LLSH.N 1 '1 LLSH.N 0 '1 LLSH.N 28 '1 LRSH.N 1 '1
LRSH.N 0 '1 LRSH.N 28 STOP))
(RPAQQ testcarcdrops (@ 0 GVAR [EvalBytes 3 (AddAtom (QUOTE B)
(AddList (QUOTE (11 (12 13)
14]
GVAR
[EvalBytes 3 (AddAtom (QUOTE A)
(AddList (QUOTE (1 (11 (12 13)
14)
3 4 5 6]
CAR GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
CDR CDR CDR CAR GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
CDR CAR CDR CAR STOP))
(RPAQQ testconstops2 (@ 0 NOP DUNBIND 13 ACONST 1 3 7 ICONST 1 3 7 0 FCONST 63 1 3 7 XCONST 63 1 3
7 PCONST 27 0 0 0 STOP))
(RPAQQ testpredops (@ 0 '1 INTEGERP 'T INTEGERP FCONST 1 0 0 0 FLOATP '1 FLOATP PCONST 0 0 0 0
POINTERP '1 POINTERP PCONST 0 0 0 (TamTagRep (QUOTE List))
LISTP '1 LISTP XCONST 0 0 0 0 XTYPEP 'T XTYPEP STOP))
(RPAQQ testshiftops (@ 0 '1 '1 ASH ICONST (EvalBytes 4 (TamRep -1))
ASH SICX 30 NEG ASH (EvalBytes 4 (TamRep -30))
ASH))
(RPAQQ teststackops (@ 0 '0 '1 SWAP COPY '1 SWAP UNBIND 30 '1 STOP))
(RPAQQ testconstops (@ 0 'T 'NIL '0 '1 'UNBOUND SICX 255 SICXX 1 2 ICONST 1 3 7 0 ACONST
(EvalBytes 3 (AddAtom (QUOTE A)))
FCONST 63 1 3 7 XCONST 63 1 3 7 PCONST (EvalBytes 4 (AddAtom (QUOTE A)))
PCONST
[EvalBytes 4 (AddList (QUOTE (A B C 1 2 3]
STOP))
(RPAQQ testtypeops (@ 0 '0 PCONST 0 0 0 (TamTagRep (QUOTE Atm))
GETTYPEBITS POP SICX (TamTagRep (QUOTE List))
SETSUBTYPE '0 PCONST 0 0 0 (TamTagRep (QUOTE List))
GETTYPEBITS POP SICX (TamTagRep (QUOTE Atm))
SETSUBTYPE '1 GETTYPEBITS 'T GETTYPEBITS FCONST 0 0 0 1 GETTYPEBITS XCONST 0
0 0 1 GETTYPEBITS 'T GETPTRBITS PCONST 0 0 0 (TamTagRep (QUOTE List))
SUBTYPEP.N
(TamTagRep (QUOTE List))
'NIL SUBTYPEP.N (TamTagRep (QUOTE Atm))
'NIL SUBTYPEP.N (ADD1 (TamTagRep (QUOTE Atm)))
'NIL FLAGTYPEP.N (TamTagRep (QUOTE Atm))
PCONST 0 0 0 (TamTagRep (QUOTE List))
FLAGTYPEP.N
(TamTagRep (QUOTE List))
'NIL FLAGTYPEP.N (ADD1 (TamTagRep (QUOTE Atm)))
'1 SETTYPE.N (TamTagRep (QUOTE Int))
'1 SETTYPE.N (TamTagRep (QUOTE Float))
'1 SETTYPE.N (TamTagRep (QUOTE Xtype))
'1 SETTYPE.N (TamTagRep (QUOTE Ptr))
'1 SETTYPE.N (TamTagRep (QUOTE List))
STOP))
(RPAQQ testops (@ 0 '1 '1 '1 '1 '1 '1 '1 '1 '1 '1 '1 SICX 5 SICX 4 GREATERP '1 SICX 2 NEG GREATERP
'1 NEG SICX 2 NEG GREATERP '1 NEG '1 GREATERP STOP))
(RPAQQ testops2 (@ 0 NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP STOP))
(RPAQQ testovarops (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← SICX 5 VARX← 6 VARX← 7 '0 FN1 (EvalBytes 3 (AddAtom (QUOTE fn)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)))
VAR8 OVAR1.X← 6 OVAR1.X 7 RETURN))
(RPAQQ testash (@ 0 '1 '1 ASH '1 NEG ASH '0 ASH ICONST (EvalBytes 4 (TamRep (QUOTE Int)
1073741823))
SICX 2 NEG ASH SICX 2 ASH STOP))
(* * Variable referencing)
(RPAQQ testvarops (@ 0 DUNBIND 13 VAR6←NIL VAR7←UNBOUND '0 '1 VAR6← POP VAR7←↑ VARX 6 VAR6 VARX 7
VAR7 VARX← 6 POP VARX← 7 POP VARX 6 VARX 7 STOP))
(RPAQQ testgvarops (@ 0 ACONST (EvalBytes 3 (AddAtom (QUOTE A)
(TamRep (QUOTE Int)
5)))
'1 GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
PCONST
(EvalBytes 4 (AddAtom (QUOTE A)))
'1 PUTBASEPTR.N 1 GVAR (EvalBytes 3 (AddAtom (QUOTE A)))
STOP))
(RPAQQ fvartest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← SICX 5 VARX← 6 SICX 6 VARX← 7 '0 FN0 (EvalBytes 3 (AddAtom
(QUOTE fn)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)))
MYCLINK SICX 10 ADDBASE SICX (TamTagRep (QUOTE Ptr)
1)
SETSUBTYPE VAR6← VAR13← SICX 2 ADDBASE VAR7← POP FVARX 6 '1 PLUS FVARX← 6 VAR13
'1 ADDBASE FVARX← 7 FVARM 2 '1 PLUS FVARM← 2 VAR13 '1 ADDBASE VAR6← ACONST
(EvalBytes 3 (AddAtom (QUOTE test)
(TamRep (QUOTE Int)
1)))
'1 ADDBASE FVARX← 6 FVARM 1 '1 PLUS FVARM← 1 GVAR (EvalBytes
3
(AddAtom (QUOTE test)))
RETURN))
(RPAQQ refcounttest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (TamRep (QUOTE Code)
256))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE refcountcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (AddAtom (QUOTE test)))
SICX 3 RPLPTR.N 1 GVAR (EvalBytes 3 (AddAtom (QUOTE test)
(TamRep 15)))
'1 PLUS GVAR← (EvalBytes 3 (AddAtom (QUOTE test)))
PCONST
(EvalBytes 4 (AddAtom (QUOTE test)))
'1 ADDBASE VAR6← FVARX 6 '1 PLUS FVARX← 6 GVAR (EvalBytes
3
(AddAtom (QUOTE test)))
GVAR
[EvalBytes 3 (AddAtom (QUOTE B)
(AddList (QUOTE (11 (12 13)
14]
SICX 1 SETF-CAR SICX 2 SETF-CDR GVAR (EvalBytes 3 (AddAtom (QUOTE B)))
CAR GVAR (EvalBytes 3 (AddAtom (QUOTE B)))
CDR STOP (EvalBytes 0 (AddFnHeader (QUOTE RC)
256))
'1 RETNP))
(* * Jump Tests)
(RPAQQ testjumpops (@ 0 'T TJUMPX 0 'T TJUMPX 2 '0 '1 'NIL TJUMPX 2 '0 '1 'NIL FJUMPX 2 '0 '1 'T
FJUMPX 2 'T NTJUMPX 2 '0 '1 'T 'NIL NTJUMPX 2 NFJUMPX 2 'NIL NFJUMPX 3 STOP
STOP STOP 'T STOP))
(RPAQQ smalljumps (@ 0 NOP NOP1 STOP NOP2 STOP STOP NOP3 STOP STOP STOP NOP4 STOP STOP STOP STOP
JUMP5 STOP STOP STOP STOP STOP JUMP6 STOP STOP STOP STOP STOP STOP JUMP7 STOP
STOP STOP STOP STOP STOP STOP JUMP8 STOP STOP STOP STOP STOP STOP STOP STOP
JUMP9 STOP STOP STOP STOP STOP STOP STOP STOP STOP JUMP10 STOP STOP STOP STOP
STOP STOP STOP STOP STOP STOP JUMP11 STOP STOP STOP STOP STOP STOP STOP STOP
STOP STOP STOP JUMP12 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
STOP JUMP13 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
JUMP14 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
JUMP15 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
STOP '1 STOP))
(RPAQQ jumperror (@ 0 JUMPX 103 STOP NOP2 STOP STOP NOP3 STOP STOP STOP NOP4 STOP STOP STOP STOP
JUMP5 STOP STOP STOP STOP STOP JUMP6 STOP STOP STOP STOP STOP STOP JUMP7 STOP
STOP STOP STOP STOP STOP STOP JUMP8 STOP STOP STOP STOP STOP STOP STOP STOP
JUMP9 STOP STOP STOP STOP STOP STOP STOP STOP STOP JUMP10 STOP STOP STOP STOP
STOP STOP STOP STOP STOP STOP JUMP11 STOP STOP STOP STOP STOP STOP STOP STOP
STOP STOP STOP JUMP12 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
STOP JUMP13 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
JUMP14 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
JUMP15 STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP
STOP '1 STOP))
(RPAQQ tfsmalljumps (@ 0 'NIL TJUMP2 'T TJUMP2 STOP STOP 'T TJUMP0 'NIL TJUMP0 'T TJUMP15 STOP STOP
STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP '0 'T
FJUMP2 'NIL FJUMP2 STOP STOP 'NIL FJUMP0 'T FJUMP0 'NIL FJUMP15 STOP STOP
STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP '1 STOP))
(RPAQQ negjumpx (@ 0 '1 '1 PLUS NJUMPX 4 STOP))
(RPAQQ negjumpxx (@ 0 '1 '1 PLUS NJUMPXX 5 0 STOP))
(RPAQQ ibuftest (@ 0 '0 VARX← 0 NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP PCONST
(EvalBytes 4 (AddAtom (QUOTE IrqFn)))
GETBASEPTR.N 2 IREGX← (LOGAND [CADR (FASSOC (QUOTE intcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
ENBINT SICX 0 '1 PLUS ICONST (EvalBytes 4 (TamRep 175304714 0))
POP NJUMPX 10 STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE IrqFn)
(NextFnAddr)))
'1 RETEI))
(* * Function Call)
(RPAQQ testfnops (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← SICX 5 FN1 (EvalBytes 3 (AddAtom (QUOTE fn)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)))
VAR8 '0 EQ FJUMPX 4 MYCLINK SICX 255 RETURN VAR8 SICX 1 DIFFERENCE FN1
(EvalBytes 3 (AddAtom (QUOTE fn)))
RETURN))
(RPAQQ undefntest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← PCONST (EvalBytes 4 (TamRep (QUOTE Code)
64))
IREGX←
[CADR (FASSOC (QUOTE undeffn)
(GETPROP (QUOTE k)
(QUOTE uField]
SICX 5 FN1 (EvalBytes 3 (AddAtom (QUOTE udf)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
VARX
[CADR (FASSOC (QUOTE pvar)
(GETPROP (QUOTE k)
(QUOTE uField]
RETURN))
(RPAQQ applytest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← '0 PCONST (EvalBytes 4 (TamRep (QUOTE Code)
64))
APPLYFN SICX 5 '1 ACONST (EvalBytes 3 (AddAtom (QUOTE fn)))
APPLYFN STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
SICX 255 RETURN))
(RPAQQ fulltest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← ACONST (EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
256))
PUTBASEPTR.N LLSH.N 'NIL VAR6← POP 'T VAR7← POP VAR7 VAR6 SWAP SICX 2 FN1
(EvalBytes 3 (AddAtom (QUOTE fn)
NIL
(TamRep (QUOTE Code)
64)))
COPY '1 PLUS INTEGERP TJUMPX 1 STOP COPY '1 PLUS JUMP15 STOP STOP STOP STOP STOP
STOP STOP STOP STOP STOP STOP STOP STOP STOP STOP ICONST
(EvalBytes 4 (TamRep (QUOTE Int)
268435461))
SICX 3 DIFFERENCE SETTYPE.N (TamTagRep (QUOTE Ptr))
SICX
(TamTagRep (QUOTE Int))
SETSUBTYPE SICX 3 STOP @ 64 (EvalBytes 16 0)
(EvalBytes -4 (TamRep (QUOTE Int)
12))
(EvalBytes -4 (TamRep (QUOTE Int)
512))
(EvalBytes -4 (TamRep (QUOTE Code)
64))
(EvalBytes -4 (TamRep (QUOTE Code)
64))
@ 128 NOP VAR6 '0 EQ TJUMPX 9 VAR6 SICX 1 DIFFERENCE FN1
(EvalBytes 3 (AddAtom (QUOTE fn)))
RETURN ICONST (EvalBytes 4 (TamRep (QUOTE Int)
536870912))
LLSH.N 1 RETURN @ 256 (EvalBytes 16 0)
(EvalBytes -4 (TamRep (QUOTE Int)
12))
(EvalBytes -4 (TamRep (QUOTE Int)
1280))
(EvalBytes -4 (TamRep (QUOTE Code)
256))
(EvalBytes -4 (TamRep (QUOTE Code)
256))
@ 320 NOP NOP '0 RETURN))
(RPAQQ fnops (@ 0 '0 VARX← 0 FN1 [EvalBytes 3 (AddAtom (QUOTE Testfn)
NIL
(AddCode (QUOTE Testfn]
STOP))
(RPAQQ ufn1test [@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← ACONST (EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
64))
PUTBASEPTR.N NEG 'T NEG '0 STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE ufn)
64))
VAR8 '0 RETURN STOP (EvalBytes 0 (AddAtom (QUOTE UfnTable)
(TamRep (QUOTE Ptr)
FreeMemIndex])
(RPAQQ ufn1dtest [@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← ACONST (EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
64))
PUTBASEPTR.N LLSH.N 'T LLSH.N 1 '1 STOP STOP (EvalBytes 0 (AddFnHeader
(QUOTE ufn)
64))
VAR8 VAR9 '0 RETURN STOP (EvalBytes 0 (AddAtom (QUOTE UfnTable)
(TamRep (QUOTE Ptr)
FreeMemIndex])
(RPAQQ ufn2test [@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← ACONST (EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
64))
PUTBASEPTR.N PLUS 'T '0 PLUS '1 STOP STOP (EvalBytes 0 (AddFnHeader
(QUOTE ufn)
64))
VAR8 VAR9 '0 RETURN STOP (EvalBytes 0 (AddAtom (QUOTE UfnTable)
(TamRep (QUOTE Ptr)
FreeMemIndex])
(RPAQQ frameadjust (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← COPY GETBASEPTR.N [CADR (FASSOC (QUOTE nextlink)
(GETPROP (QUOTE k)
(QUOTE uField]
SICX
(LOGOR (TamTagRep (QUOTE Frame))
1)
SETSUBTYPE PUTBASEPTR.N [CADR (FASSOC (QUOTE nextlink)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
256))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE frameflagcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
SICX 0 FN1 (EvalBytes 3 (AddAtom (QUOTE fn)
NIL
(TamRep (QUOTE Code)
64)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
MYCLINK VAR8 '0 EQ TJUMPX 9 VAR8 SICX 1 DIFFERENCE FN1
(EvalBytes 3 (AddAtom (QUOTE fn)))
RETURN '1 RETURN (EvalBytes 0 (AddFnHeader (QUOTE ffn)
256))
NOP '1 RETNP))
(RPAQQ ufndump (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← ACONST (EvalBytes 3 (AddAtom (QUOTE UfnTable)))
IREGX←
(LOGAND [CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
256))
PUTBASEPTR.N LLSH.N SICX 3 FN1 (EvalBytes 3 (AddAtom (QUOTE fn)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
VAR8 '0 EQ TJUMPX 9 VAR8 SICX 1 DIFFERENCE FN1 (EvalBytes 3 (AddAtom
(QUOTE fn)))
RETURN ICONST (EvalBytes 4 (TamRep (QUOTE Int)
268435456))
LLSH.N 1 'T RETURN (EvalBytes 0 (AddFnHeader (QUOTE ufn)
256))
'1 RETURN))
(RPAQQ dumploadtest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← SICX 5 FN0 (EvalBytes 3 (AddAtom (QUOTE fn)
NIL
(TamRep (QUOTE Code)
64)))
STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE fn)
64))
MYCLINK '0 RETURN))
(* * Interrupt Tests)
(RPAQQ irqtest (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 8))
MYCLINK← PCONST (EvalBytes 4 (AddAtom (QUOTE IrqFn)))
GETBASEPTR.N 2 IREGX← (LOGAND [CADR (FASSOC (QUOTE intcode)
(GETPROP (QUOTE k)
(QUOTE uField]
63)
ENBINT SICX 0 '1 PLUS NJUMPX 4 STOP STOP (EvalBytes 0 (AddFnHeader (QUOTE IrqFn)
(NextFnAddr)))
'1 RETEI))
(RPAQQ irqenbtest (@ 0 DISINT DISINT DISINT ENBINT ENBINT ENBINT ENBINT STOP))
(* * Virtual Memory Tests)
(RPAQQ vmtest (@ 0 PCONST (EvalBytes 4 (TamRep (QUOTE Code)
64))
IREGX←
[CADR (FASSOC (QUOTE pfcode)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Ptr)
2097216))
COPY GETBASEPTR.N 0 '1 PLUS PUTBASEPTR.N 0 PCONST (EvalBytes 4
(TamRep (QUOTE Ptr)
2098240))
GETBASEPTR.N 0 PCONST (EvalBytes 4 (TamRep (QUOTE Ptr)
2097216))
GETBASEPTR.N 0 STOP (EvalBytes 0 (AddFnHeader (QUOTE PfFn)
64))
VAR8 LRSH.N 9 VAR7← ICONST (EvalBytes 4 4096)
VAR8← '0 VAR9← SICX 3 GREATERP TJUMPX 39 VAR8 VAR9 PLUS VAR10← SETTYPE.N
(TamTagRep (QUOTE Ptr))
COPY GETBASEPTR.N 0 SETTYPE.N (TamTagRep (QUOTE Int))
VAR7 VAR10 EQ TJUMPX 8 ICONST (EvalBytes 4 (TamRep 4096))
LOGOR JUMPX 6 ICONST (EvalBytes 4 (TamRep 511))
LOGAND SETTYPE.N (TamTagRep (QUOTE Ptr))
PUTBASEPTR.N 0 VAR9 '1 PLUS NJUMPX 45 RESET-VMM RETNP @ 2048 (EvalBytes -4 16)
(EvalBytes -4 17)
(EvalBytes -4 30)
(EvalBytes -4 2)
@ 4160 (EvalBytes -4 (TamRep (QUOTE Int)
5))))
(RPAQQ vmtest2 (@ 0 PCONST (EvalBytes 4 (TamRep (QUOTE Code)
64))
IREGX←
[CADR (FASSOC (QUOTE pfcode)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Ptr)
4194369))
'1 PUTBASEPTR.N 0 GVAR (EvalBytes 3 (TamRep (QUOTE Atm)
4194368))
GVAR←
(EvalBytes 3 (TamRep (QUOTE Atm)
4194368))
STOP
(EvalBytes 0 (AddFnHeader (QUOTE pfn)
64))
VAR8 LRSH.N 10 SETTYPE.N (TamTagRep (QUOTE Ptr))
COPY GETBASEPTR.N 0 VAR9← '1 LOGAND '1 EQ TJUMPX 7 ICONST (EvalBytes
4
(TamRep 1073741820))
JUMPX 5 ICONST (EvalBytes 4 (TamRep 1073741822))
VAR9 LOGAND PUTBASEPTR.N 0 RESET-VMM RETNP @ 4096 (EvalBytes -4 (TamRep 19))
(EvalBytes -4 19)
(EvalBytes -4 23)
(EvalBytes -4 23)
@ 4161 (EvalBytes -4 (TamRep (QUOTE Int)
5))))
(RPAQQ vmtest3 (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (TamRep (QUOTE Code)
128))
IREGX←
[CADR (FASSOC (QUOTE pfcode)
(GETPROP (QUOTE k)
(QUOTE uField]
PCONST
(EvalBytes 4 (TamRep (QUOTE Code)
64))
IREGX←
[CADR (FASSOC (QUOTE refcountcode)
(GETPROP (QUOTE k)
(QUOTE uField]
GVAR
(EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
'1 PLUS GVAR← (EvalBytes 3 (TamRep (QUOTE Ptr)
2097216))
PCONST
(EvalBytes 4 (TamRep (QUOTE Ptr)
2098177))
COPY GETBASEPTR.N 64 '1 PLUS PUTBASEPTR.N 64 PCONST (EvalBytes
4
(TamRep (QUOTE Ptr)
2099201))
COPY GETBASEPTR.N 64 '1 PLUS RPLPTR.N 64 FN0 (EvalBytes 3 (AddAtom (QUOTE Ovfn)))
STOP
(EvalBytes 0 (AddFnHeader (QUOTE RcFn)
64))
RETNP
(EvalBytes 0 (AddFnHeader (QUOTE PfFn)
128))
VAR8 ICONST (EvalBytes 4 (TamRep 16777215))
LOGAND LRSH.N 10 SETTYPE.N (TamRep (QUOTE Ptr))
COPY GETBASEPTR.N 0 VAR9← '1 LOGAND '1 EQ FJUMPX 7 ICONST (EvalBytes
4
(TamRep 3))
JUMPX 5 ICONST (EvalBytes 4 (TamRep 1))
VAR9 LOGOR PUTBASEPTR.N 0 RESET-VMM RETNP @ 2048 (EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 16))
(EvalBytes -4 (TamRep 24))
(EvalBytes -4 (TamRep 28))
@ 4161 (EvalBytes -4 (TamRep (QUOTE Int)
5))
(EvalBytes 0 (AddFnHeader (QUOTE Ovfn)
2103296))
JUMPXX
(EvalBytes 2 4042)
@ 4201464 NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP '0 '1 'NIL 'T NOP NOP NOP RETURN))
(* * Special Opcodes)
(RPAQQ testwoct (@ 0 RESET-VMM WRITEOCTNIL.N 32 WRITEOCTUNBOUND.N 32 WRITEOCTNIL.N 24
WRITEOCTUNBOUND.N 24 STOP))
(* * test vectors)
(RPAQQ looptest (@ 0 '1 VARX← 6 NOP NOP1 STOP '1 VARX 6 PLUS VARX← 6 SICX 8 GREATERP TJUMP2 NJUMPX
15))
(RPAQQ memwritetest (@ 0 '1 VARX← 6 PCONST (EvalBytes 4 1000)
VARX 6 '1 PLUS VARX← 6 PUTBASEPTR.N 0 NJUMPX 10 STOP))
(RPAQQ inttest (@ 0 SetOutputInt SetOutputInt SetOutputInt SetOutputInt ClrOutputInt ClrOutputInt
ClrOutputInt ClrOutputInt SetOutputInt SetOutputInt SetOutputInt SetOutputInt
ClrOutputInt ClrOutputInt ClrOutputInt ClrOutputInt SetOutputInt SetOutputInt
SetOutputInt SetOutputInt ClrOutputInt ClrOutputInt ClrOutputInt ClrOutputInt
SetOutputInt SetOutputInt SetOutputInt SetOutputInt ClrOutputInt ClrOutputInt
ClrOutputInt ClrOutputInt SetOutputInt SetOutputInt SetOutputInt SetOutputInt
ClrOutputInt ClrOutputInt ClrOutputInt ClrOutputInt SetOutputInt SetOutputInt
SetOutputInt SetOutputInt ClrOutputInt ClrOutputInt ClrOutputInt ClrOutputInt
SetOutputInt SetOutputInt SetOutputInt SetOutputInt ClrOutputInt ClrOutputInt
ClrOutputInt ClrOutputInt SetOutputInt SetOutputInt SetOutputInt SetOutputInt
ClrOutputInt ClrOutputInt ClrOutputInt ClrOutputInt STOP))
(RPAQQ qjumptest (@ 0 JUMPX 32 NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP
NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP NJUMPX 36))
(* * Initialization)
(RPAQQ tamSetUp ((* * standard initialization of Tam memory is <AssembleOps this T> then <DoCycle>
-- leaves memory clear except as follows, and leaves some Tam internal
registers set up -- still each normal AssembleOps argument has to start with
something like "* tamInit")
(* * note FreeMemIndex is allocation pointer seen in both D-machine and Tamarin
worlds -- AssembleOps passes its value back and forth between worlds -- this
requires that all allocation in the Tamarin from the D-machine side be done
within a call to AssembleOps)
(* * * * * * * UFN TABLE * * * * * * * * * *)
(* * all of the entries of ufn table initially point to a dummy function that just
STOPs)
(EvalBytes 0 (AddAtom (QUOTE UfnTable)
(TamRep (QUOTE Int)
256)))
[EvalBytes 0 (LET ((codeAddr (TamRep (QUOTE Code)
512)))
(printout T "loading ufn table..." T)
(for addr from 256 to 511 do (MemoryAccess addr codeAddr T]
(* * the default ufn fn that just STOPs)
(EvalBytes 0 (AddFnHeader 512))
STOP STOP STOP STOP STOP STOP STOP STOP (* 8 bytes unused in this quadword)
(* * * * * * * * ATOMS THAT HOLD THINGS * * * * * * * * *)
(* * UfnTable, above, is an atom whose value is the address of the ufn table as an
Int)
(* * FrameFlagCode is an atom whose function definition just RETNPs)
(EvalBytes 0 (SETQ tamSetUp.FnBase 524))
(EvalBytes 0 (AddAtom (QUOTE FrameFlagCode)
NIL
(TamRep (QUOTE Code)
tamSetUp.FnBase)))
(EvalBytes 0 (AddFnHeader tamSetUp.FnBase))
RETEI RETEI RETEI RETEI RETEI RETEI RETEI RETEI (* 8 bytes unused in this quadword)
(* * IntCode is an atom whose function definition just RETEIs)
(EvalBytes 0 (SETQ tamSetUp.FnBase 536))
(EvalBytes 0 (AddAtom (QUOTE IntCode)
NIL
(TamRep (QUOTE Code)
tamSetUp.FnBase)))
(EvalBytes 0 (AddFnHeader tamSetUp.FnBase))
RETEI RETEI RETEI RETEI RETEI RETEI RETEI RETEI (* 8 bytes unused in this quadword)
(* * UndefFn is an atom whose function definition just RETURNs)
(EvalBytes 0 (SETQ tamSetUp.FnBase 548))
(EvalBytes 0 (AddAtom (QUOTE UndefFn)
NIL
(TamRep (QUOTE Code)
tamSetUp.FnBase)))
(EvalBytes 0 (AddFnHeader tamSetUp.FnBase))
RETURN RETURN RETURN RETURN RETURN RETURN RETURN RETURN (* 8 bytes unused in this
quadword)
(* * PFCode is atom whose function definition is to clear not present bit)
(EvalBytes 0 (SETQ tamSetUp.FnBase 560))
(EvalBytes 0 (AddAtom (QUOTE PFCode)
NIL
(TamRep (QUOTE Code)
tamSetUp.FnBase)))
(EvalBytes 0 (AddFnHeader tamSetUp.FnBase))
VAR8 LRSH.N 9 SETTYPE.N (TamTagRep (QUOTE Ptr))
COPY GETBASEPTR.N 0 ICONST (EvalBytes 4 (TamRep 511))
LOGAND PUTBASEPTR.N 0 RESET-VMM RETNP (* * * Set VM Table * * *)
(EvalBytes 0 (AddVmTable))
(* 8 bytes unused in this quadword)
(* * TopFrame is atom whose value points to the top stack frame <initial value for
MYCLINK> -- also allocate some frames)
[EvalBytes 0 (AddAtom (QUOTE TopFrame)
(TamRep (QUOTE Frame)
(InitStackFrames 16]
(* * * * * * * * CONS UFN * * * * * * * * *)
(* * just uses the 2 words pointed to by FreeMemIndex, and increments FreeMemIndex)
(EvalBytes 0 (SETQ tamSetUp.FnBase 572))
(EvalBytes 0 (MemoryAccess (IPLUS (CAR (GETPROP (QUOTE CONS)
(QUOTE TamarinOp)))
(ReadAtom (QUOTE UfnTable)
(QUOTE val)
T))
(TamRep (QUOTE Code)
tamSetUp.FnBase)))
(EvalBytes 0 (AddFnHeader tamSetUp.FnBase))
NOP
(* * first get pointer to val cell of FreeMemIndex and the value itself)
ACONST
(EvalBytes 3 (AddAtom (QUOTE FreeMemIndex)))
COPY GETBASEPTR.N 1 (* * smash the CAR and CDR into place -- no net stack change)
VAR8 PUTBASEPTR.N 0 VAR9 PUTBASEPTR.N 1 (* * make a copy of old value of
FreeMemIndex, with Listp type bits, and
save it -- no net stack change)
COPY SICX (TamTagRep (QUOTE List))
SETSUBTYPE VAR10←↑ (* * increment FreeMemIndex)
SICX 2 ADDBASE PUTBASEPTR.N 1 (* * return the Listp)
VAR10 RETURN (* * * * * * * * * INITIALIZE INTERNAL REGS * * * * * * * *)
(* * code to be DoCycle'd to to initialize Tam registers)
@ 0 (* * clear stack pointer for the setup code)
'0 VARX← 0 (* * ireg -> ufn table)
ICONST
[EvalBytes 4 (LOGAND (MASK.1'S 0 24)
(ReadAtom (QUOTE UfnTable)
(QUOTE val]
IREGX←
[CADR (FASSOC (QUOTE ufnbase)
(GETPROP (QUOTE k)
(QUOTE uField]
(* * ireg -> FrameFlagCode)
PCONST
(EvalBytes 4 (ReadAtom (QUOTE FrameFlagCode)
(QUOTE def)))
IREGX←
[CADR (FASSOC (QUOTE frameflagcode)
(GETPROP (QUOTE k)
(QUOTE uField]
(* * ireg -> IntCode)
PCONST
(EvalBytes 4 (ReadAtom (QUOTE IntCode)
(QUOTE def)))
IREGX←
[CADR (FASSOC (QUOTE intcode)
(GETPROP (QUOTE k)
(QUOTE uField]
(* * ireg -> UndefFn)
PCONST
(EvalBytes 4 (ReadAtom (QUOTE UndefFn)
(QUOTE def)))
IREGX←
[CADR (FASSOC (QUOTE undeffn)
(GETPROP (QUOTE k)
(QUOTE uField]
(* * ireg -> PFCode)
PCONST
(EvalBytes 4 (ReadAtom (QUOTE PFCode)
(QUOTE def)))
IREGX←
[CADR (FASSOC (QUOTE pfcode)
(GETPROP (QUOTE k)
(QUOTE uField]
(* * done)
STOP))
(RPAQQ tamInit ((* * every normal AssembleOps input should start with "* this" just after the "@ 0")
(* * clear stack pointer)
'0 VARX← 0 (* * point MYCLINK to stack frames)
PCONST
(EvalBytes 4 (ReadAtom (QUOTE TopFrame)
(QUOTE val)))
MYCLINK←))
(* * Special Loadups)
(RPAQQ dotak (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 50))
MYCLINK← SICX 18 SICX 12 SICX 6 FN3 [EvalBytes 3 (AddAtom (QUOTE tak)
NIL
(AddCode (QUOTE tak]
STOP))
(RPAQQ dotak2 (@ 0 '0 VARX← 0 PCONST (EvalBytes 4 (InitStackFrames 20))
MYCLINK← SICX 18 SICX 12 SICX 6 FN3 (EvalBytes 3 (AddAtom (QUOTE tak)))
(EvalBytes 0 (AddFnHeader (QUOTE tak)
(NextFnAddr)))
VAR8 COPY VAR9 GREATERP TJUMP2 VAR10 RETURN '1 DIFFERENCE VAR9 VAR10 FN3
(EvalBytes 3 (AddAtom (QUOTE tak)))
VAR9 '1 DIFFERENCE VAR10 VAR8 FN3 (EvalBytes 3 (AddAtom (QUOTE tak)))
VAR10 '1 DIFFERENCE VAR8 VAR9 FN3 (EvalBytes 3 (AddAtom (QUOTE tak)))
VAR10← POP VAR9← POP VAR8← NJUMPX 39 NOP RETURN STOP))
(DEFINEQ
(Testfn
[LAMBDA (Arg) (* rtk "19-May-86 13:30")
(PLUS Arg 1])
(tak
[LAMBDA (x y z) (* rtk "10-Jun-86 10:08")
(COND
((NOT (LESSP y x))
z)
(T (tak (tak (SUB1 x)
y z)
(tak (SUB1 y)
z x)
(tak (SUB1 z)
x y])
)
(PUTPROPS TESTOPS COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (33845 34264 (Testfn 33855 . 33979) (tak 33981 . 34262)))))
STOP