(FILECREATED "12-Jun-86 18:08:32" {ERIS}<TAMARIN>WORK>DT>TASM.;27 16554
changes to: (VARS TASMCOMS T.LAMBDA0.EV T.LAMBDA1.EV T.LAMBDA2.EV T.LAMBDA3.EV T.LAMBDA4.EV
T.LAMBDA5.EV T.LAMBDA6.EV)
(FNS T.GETMACHINE T.SIC.GENC T.GCONST.GENC T.EqCheck.GENC T.EqCheckConsOf2.GENC
TASMV TASMV.1 T.LETTING.GENC CheckNumEq.TasmFn T.CheckNumEq.GENC T.RAID.GENC)
(RECORDS TFNHDR)
previous date: "10-Apr-86 12:09:20" {ERIS}<TAMARIN>WORK>DT>TASM.;15)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TASMCOMS)
(RPAQQ TASMCOMS ((FILES ASM TACCESS)
(COMS (* * fns that know what a Tamarin is)
(FNS T.GETMACHINE TASM TPC PC)
(INITVARS TPC.RESUMELIST))
(COMS (* * other front-end fns)
(FNS TASMV TASMV.1)
(INITVARS TASMV.RESUMELIST))
(COMS (* * generics)
(FNS T.FN.GENC T.SIC.GENC T.GCONST.GENC)
(PROP TASMFN FN SIC GCONST))
(COMS (* * 1-1 opcode substitution generics -- take off the suffix -2)
(FNS T.PLUS2.GENC T.TIMES2.GENC T.IPLUS2.GENC T.ITIMES2.GENC T.FPLUS2.GENC
T.FTIMES2.GENC T.LOGAND2.GENC T.LOGOR2.GENC T.LOGXOR2.GENC)
(PROP TASMFN PLUS2 TIMES2 IPLUS2 ITIMES2 FPLUS2 FTIMES2 LOGAND2 LOGOR2
LOGXOR2))
(COMS (* * 1-1 opcode substitution generics -- other)
(FNS T.LSH.GENC)
(PROP TASMFN LSH))
(COMS (* * entry vectors -- nospreads not implemented -- FN7 implemented the same
way as FN0..6, for testing purposes)
(GLOBALVARS T.LAMBDA*.EV T.NLAMBDA*.EV)
(VARS T.LAMBDA*.EV T.NLAMBDA*.EV))))
(FILESLOAD ASM TACCESS)
(* * fns that know what a Tamarin is)
(DEFINEQ
(T.GETMACHINE
[LAMBDA NIL (* jmh "12-Jun-86 14:03")
(* * load SPECVARS for Tamarin -- called by ASM, some kind of PRINTCODE, possibly others)
[PROGN (* layout stuff)
(DECLARE (USEDFREE TAM.OUTPUTSTYLE TAM.LINKINFO TAM.FNHDRSTYLE TAM.NTSTYLE
TAM.VARALLOCSTYLE TAM.1STVARSLOT))
[AND (BOUNDP (QUOTE TAM.OUTPUTSTYLE))
(SETQ TAM.OUTPUTSTYLE (PROG1 (QUOTE B)
(* array of bytes)
]
[AND (BOUNDP (QUOTE TAM.LINKINFO))
(SETQ TAM.LINKINFO (PROG1 (QUOTE T)
(* a Tcodep is list, CAR= array, CDR= list of link infos, each of which is list: CAR= thing to be loaded into
Tamarin and its Tamarin representation patched into the tcodep, CADR= number of less significant bytes of this
representation to patch in, CADDR= byte offset in tcodep at which to patch leftmost byte)
]
[AND (BOUNDP (QUOTE TAM.FNHDRSTYLE))
(SETQ TAM.FNHDRSTYLE (PROG1 NIL (* Tamarin fn hdr as far as it is known to date --
including 8-word entry vector)]
[AND (BOUNDP (QUOTE TAM.NTSTYLE))
(SETQ TAM.NTSTYLE (PROG1 (QUOTE D)
(* using D-machine standard name table format for now)
]
[AND (BOUNDP (QUOTE TAM.VARALLOCSTYLE))
(SETQ TAM.VARALLOCSTYLE (PROG1 NIL
(* Tamarin var alloc style -- ivars are pvars in 1st 7
slots -- 8th slot not used -- frame has max size ...)
]
(AND (BOUNDP (QUOTE TAM.1STVARSLOT))
(SETQ TAM.1STVARSLOT (PROG1 8
(* when TAM.VARALLOCSTYLE = Tamarin then have to say what the slot# of the first ivar slot is -- if this changes,
have to change the entry-vector templates too -- pvar slots start 8 after this)
]
[PROGN (* place to hang standardized entry vector code)
(DECLARE (USEDFREE TAM.LAMBDAEVS TAM.NLAMBDAEVS TAM.LAMBDA*EV TAM.NLAMBDA*EV)
(GLOBALVARS T.LAMBDA*.EV T.NLAMBDA*.EV))
(* * this whole thing is temporary now, as the meaning of "entry vector" is changing -- for now, we expect only
LAMBDA-spread functions, and they require no entry vector code -- I'm leaving this apparatus in in case some kind
of entry vector might be needed before the compiler comes on line)
(* * ideally should refuse 7-arg LAMBDA and NLAMBDA spreads, but convenient to accept them, for testing)
[AND (BOUNDP (QUOTE TAM.LAMBDAEVS))
(SETQ TAM.LAMBDAEVS (PROG1 NIL (* entry vectors for LAMBDA spread expecting 0..7
args)]
[AND (BOUNDP (QUOTE TAM.LAMBDA*EV))
(SETQ TAM.LAMBDA*EV (PROG1 T.LAMBDA*.EV
(* entry vectors for LAMBDA nospread)]
[AND (BOUNDP (QUOTE TAM.NLAMBDAEVS))
(SETQ TAM.NLAMBDAEVS (PROG1 TAM.LAMBDAEVS
(* entry vectors for NLAMBDA spread expecting 0..7
args)]
(AND (BOUNDP (QUOTE TAM.NLAMBDA*EV))
(SETQ TAM.NLAMBDA*EV (PROG1 T.NLAMBDA*.EV
(* entry vectors for NLAMBDA nospread)]
[PROGN (* code generation)
(DECLARE (USEDFREE TAM.ASMFNPROPS TAM.OPCODEPROPS TAM.OPCODEARRAY))
[AND (BOUNDP (QUOTE TAM.ASMFNPROPS))
(SETQ TAM.ASMFNPROPS (PROG1 (QUOTE (TASMFN))
(* Tamarin-specific generics are the TASMFN property
of CAR-of instr)
]
[AND (BOUNDP (QUOTE TAM.OPCODEPROPS))
(SETQ TAM.OPCODEPROPS (PROG1 (QUOTE (TOPCODE))
(* Tamarin OPCODE records are the TOPCODE property of
CAR-of instr)
]
(AND (BOUNDP (QUOTE TAM.OPCODEARRAY))
(SETQ TAM.OPCODEARRAY (PROG1 \TAMOPCODEARRAY
(* array mapping op byte to OPCODE record for Tamarin)
]
(PROGN (* code generation)
(DECLARE (USEDFREE TAM.STACKSTYLE TAM.MAXSTACK TAM.ALPHASTYLE TAM.VARXSTYLE
TAM.OPKSTYLE TAM.JUMPSTYLE))
[AND (BOUNDP (QUOTE TAM.STACKSTYLE))
(SETQ TAM.STACKSTYLE (PROG1 NIL (* Tamarin stack style -- TUNBIND + TDUNBIND vs BIND +
UNBIND + DUNBIND)]
[AND (BOUNDP (QUOTE TAM.MAXSTACK))
(SETQ TAM.MAXSTACK (PROG1 39 (* Tamarin frame size less 1)]
[AND (BOUNDP (QUOTE TAM.ALPHASTYLE))
(SETQ TAM.ALPHASTYLE (PROG1 NIL (* Tamarin -- multi-byte args in instruction stream
presented least significant byte first)
]
[AND (BOUNDP (QUOTE TAM.VARXSTYLE))
(SETQ TAM.VARXSTYLE (PROG1 NIL (* Tamarin -- xVARX alpha-byte is in cells rel to var
area of stack frame -- also LAMBDA* ivar opcodes not
treated specially)]
[AND (BOUNDP (QUOTE TAM.OPKSTYLE))
(SETQ TAM.OPKSTYLE (PROG1 NIL
(* Tamarin -- implicit argument of a 1-byte opcode that has one, is its right 4 bits -- and the OP# range of the
opcode describes which instances of the opcode exist)
]
(AND (BOUNDP (QUOTE TAM.JUMPSTYLE))
(SETQ TAM.JUMPSTYLE (PROG1 NIL
(* Tamarin -- <1> all jumps are counted from the byte after the jump instruction, <2> all jumps have unsigned
offsets, all jumps but NJUMPX NJUMPXX are forward, those are backward)
])
(TASM
[LAMBDA (IL OPTIONS ERRFILE) (* jmh
" 4-Mar-86 17:49")
(ASM IL (QUOTE T)
OPTIONS ERRFILE])
(TPC
[LAMBDA (FN) (* jmh "10-Apr-86 09:58")
(DT.XXLIST (QUOTE TPC)
[FUNCTION (LAMBDA (FN)
(printout T " printcode of TCODE of " FN " --" T)
(PC.1 FN (QUOTE T]
(QUOTE DT.LASTARG)
(QUOTE TPC.RESUMELIST)
FN])
(PC
[LAMBDA (FN) (* jmh " 8-Apr-86 15:10")
(TPC FN])
)
(RPAQ? TPC.RESUMELIST NIL)
(* * other front-end fns)
(DEFINEQ
(TASMV
[LAMBDA (V) (* jmh "31-May-86 11:46")
(DT.XXLIST (QUOTE TASMV)
(FUNCTION [LAMBDA (V)
(printout T V T)
(TASMV.1 V])
(QUOTE DT.LASTARG)
(QUOTE TASMV.RESUMELIST)
V])
(TASMV.1
[LAMBDA (V) (* jmh "31-May-86 11:52")
(* * V should be a litatom whose value is a list -- TASM the list and hang the resulting TCODEP on V -- otherwise
just TASM V)
(LET (result)
(if (AND (LITATOM V)
(LISTP (EVAL V)))
then (SETQ result (TASM (EVAL V)))
(PUTPROP V (QUOTE TCODE)
(CDR result))
(SETQ result (LIST (CAR result)
(CADR result)))
else (DT.HELP "arg not litatom with list value"))
(if (ZEROP (CAR result))
then (CADR result])
)
(RPAQ? TASMV.RESUMELIST NIL)
(* * generics)
(DEFINEQ
(T.FN.GENC
[LAMBDA (INSTR) (* jmh
"20-Feb-86 17:47")
(* * returns list of one instr, unless error in which case returns NIL)
(if [NOT (AND (EQ 3 (LENGTH INSTR))
(ASM.RANGE? (CADR INSTR)
0 255)
(CADDR INSTR)
(LITATOM (CADDR INSTR]
then (ASM.ERR "should have 2 args: a 0..7 and an atom")
else (LIST (LIST (SELECTQ (CADR INSTR)
(0 (QUOTE FN0))
(1 (QUOTE FN1))
(2 (QUOTE FN2))
(3 (QUOTE FN3))
(4 (QUOTE FN4))
(5 (QUOTE FN5))
(6 (QUOTE FN6))
(QUOTE FN7))
(CADDR INSTR])
(T.SIC.GENC
[LAMBDA (INSTR) (* jmh "30-May-86 17:30")
(* * returns a list of instrs, unless error in which case returns NIL)
(LET (X NEG? OUT)
(if (AND (EQ 2 (LENGTH INSTR))
(NUMBERP (CADR INSTR)))
then (SETQ X (CADR INSTR))
else (ASM.ERR "should have 1 numeric arg")
(SETQ X 0))
[if (ASM.RANGE? X -65535 65535)
then (if (MINUSP X)
then (SETQ NEG? T)
(SETQ X (MINUS X)))
[SETQ OUT (LIST (if (ZEROP X)
then (LIST (QUOTE '0))
elseif (AND (EQ X 1)
(ASM.GETOPCODE (QUOTE '1)))
then (LIST (QUOTE '1))
else (LIST (if (ILESSP X 256)
then (QUOTE SICX)
else (QUOTE SICXX))
X]
[if NEG?
then (NCONC1 OUT (LIST (QUOTE NEG]
else (SETQ OUT (LIST (LIST (QUOTE ICONST)
X]
OUT])
(T.GCONST.GENC
[LAMBDA (INSTR) (* jmh "30-May-86 17:32")
(if (NUMBERP (CADR INSTR))
then (* pass numbers to the SIC generic)
[ASM.EATCODE (LIST (LIST (QUOTE SIC)
(CADR INSTR]
NIL
elseif (NULL (CADR INSTR))
then (LIST (QUOTE ('NIL)))
elseif (EQ T (CADR INSTR))
then (LIST (QUOTE ('T)))
elseif (LITATOM (CADR INSTR))
then (LIST (LIST (QUOTE ACONST)
(CADR INSTR)))
else (LIST (LIST (QUOTE PCONST)
(CADR INSTR])
)
(PUTPROPS FN TASMFN T.FN.GENC)
(PUTPROPS SIC TASMFN T.SIC.GENC)
(PUTPROPS GCONST TASMFN T.GCONST.GENC)
(* * 1-1 opcode substitution generics -- take off the suffix -2)
(DEFINEQ
(T.PLUS2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:37")
(LIST (CONS (QUOTE PLUS)
(CDR INSTR])
(T.TIMES2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:37")
(LIST (CONS (QUOTE TIMES)
(CDR INSTR])
(T.IPLUS2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:37")
(LIST (CONS (QUOTE IPLUS)
(CDR INSTR])
(T.ITIMES2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:38")
(LIST (CONS (QUOTE ITIMES)
(CDR INSTR])
(T.FPLUS2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:38")
(LIST (CONS (QUOTE FPLUS)
(CDR INSTR])
(T.FTIMES2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:38")
(LIST (CONS (QUOTE FTIMES)
(CDR INSTR])
(T.LOGAND2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:38")
(LIST (CONS (QUOTE LOGAND)
(CDR INSTR])
(T.LOGOR2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:39")
(LIST (CONS (QUOTE LOGOR)
(CDR INSTR])
(T.LOGXOR2.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 11:39")
(LIST (CONS (QUOTE LOGXOR)
(CDR INSTR])
)
(PUTPROPS PLUS2 TASMFN T.PLUS2.GENC)
(PUTPROPS TIMES2 TASMFN T.TIMES2.GENC)
(PUTPROPS IPLUS2 TASMFN T.IPLUS2.GENC)
(PUTPROPS ITIMES2 TASMFN T.ITIMES2.GENC)
(PUTPROPS FPLUS2 TASMFN T.FPLUS2.GENC)
(PUTPROPS FTIMES2 TASMFN T.FTIMES2.GENC)
(PUTPROPS LOGAND2 TASMFN T.LOGAND2.GENC)
(PUTPROPS LOGOR2 TASMFN T.LOGOR2.GENC)
(PUTPROPS LOGXOR2 TASMFN T.LOGXOR2.GENC)
(* * 1-1 opcode substitution generics -- other)
(DEFINEQ
(T.LSH.GENC
[LAMBDA (INSTR) (* jmh
"27-Mar-86 13:20")
(LIST (CONS (QUOTE ASH)
(CDR INSTR])
)
(PUTPROPS LSH TASMFN T.LSH.GENC)
(* * entry vectors -- nospreads not implemented -- FN7 implemented the same way as FN0..6, for
testing purposes)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS T.LAMBDA*.EV T.NLAMBDA*.EV)
)
(RPAQQ T.LAMBDA*.EV ((DONT DO THIS -- dont know entry vector for LAMBDA nospread)))
(RPAQQ T.NLAMBDA*.EV ((DONT DO THIS -- dont know entry vector for NLAMBDA nospread)))
(PUTPROPS TASM COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1636 8760 (T.GETMACHINE 1646 . 8033) (TASM 8035 . 8274) (TPC 8276 . 8636) (PC 8638 .
8758)) (8825 9808 (TASMV 8835 . 9115) (TASMV.1 9117 . 9806)) (9864 12756 (T.FN.GENC 9874 . 10911) (
T.SIC.GENC 10913 . 12029) (T.GCONST.GENC 12031 . 12754)) (12946 15338 (T.PLUS2.GENC 12956 . 13216) (
T.TIMES2.GENC 13218 . 13480) (T.IPLUS2.GENC 13482 . 13744) (T.ITIMES2.GENC 13746 . 14010) (
T.FPLUS2.GENC 14012 . 14274) (T.FTIMES2.GENC 14276 . 14540) (T.LOGAND2.GENC 14542 . 14806) (
T.LOGOR2.GENC 14808 . 15070) (T.LOGXOR2.GENC 15072 . 15336)) (15795 16064 (T.LSH.GENC 15805 . 16062)))
))
STOP