(FILECREATED " 9-Feb-86 19:49:57" {DSK}<LISPFILES2>INSTRS.;1 9161
changes to: (VARS INSTRSCOMS)
previous date: " 7-Feb-86 17:10:53" {DSK}<LISPFILES2>INSTRS.;1)
(PRETTYCOMPRINT INSTRSCOMS)
(RPAQQ INSTRSCOMS ((ADDVARS (GLOBALVARS QP.PERMANENT.OFFSET)
(GLOBALVARS QP.EXTENSION.OPCODE)
(GLOBALVARS QP.EXTENSION.HARRAY)
(GLOBALVARS QP.INSTRUCTION.HARRAY)
(GLOBALVARS QP.extendW)
(GLOBALVARS QP.extendR)
(GLOBALVARS QP.opcode))
(FNS QP.DESCRIBE.INSTRUCTIONS QP.OP.CODE QP.init.instrs QP.list.instrs)
(P (QP.init.instrs))))
(ADDTOVAR GLOBALVARS QP.PERMANENT.OFFSET)
(ADDTOVAR GLOBALVARS QP.EXTENSION.OPCODE)
(ADDTOVAR GLOBALVARS QP.EXTENSION.HARRAY)
(ADDTOVAR GLOBALVARS QP.INSTRUCTION.HARRAY)
(ADDTOVAR GLOBALVARS QP.extendW)
(ADDTOVAR GLOBALVARS QP.extendR)
(ADDTOVAR GLOBALVARS QP.opcode)
(DEFINEQ
(QP.DESCRIBE.INSTRUCTIONS
[LAMBDA (ARGS)
(PROG (COUNTER SECONDARY LAST INSTR FIRST)
(SETQ QP.opcode (ARRAY 384 (QUOTE POINTER)
(QUOTE SHOULDNT)
0))
(SETQ QP.extendR (\ALLOCBLOCK 128 NIL NIL 128))
(SETQ QP.extendW (\ADDBASE QP.extendR 1))
(SETQ QP.INSTRUCTION.HARRAY (HARRAY 500))
(SETQ QP.EXTENSION.HARRAY (HARRAY 200))
(SETQ QP.PERMANENT.OFFSET 2)
(SETQ QP.EXTENSION.OPCODE 2)
(SETQ COUNTER 0)
(SETQ SECONDARY 0)
(for ENTRY in ARGS
do (SETQ INSTR (CAR ENTRY))
(SETQ FIRST (CADR ENTRY))
(if (EQ FIRST (QUOTE extend))
then (SETQ SECONDARY (IPLUS SECONDARY 2))
(PUTHASH INSTR QP.EXTENSION.OPCODE QP.INSTRUCTION.HARRAY)
(PUTHASH SECONDARY ENTRY QP.EXTENSION.HARRAY)
(PUTHASH INSTR SECONDARY QP.EXTENSION.HARRAY)
[\PUTBASE QP.extendR SECONDARY (\LOLOC (SETA
QP.opcode
(IPLUS SECONDARY 256)
(PACK* (QUOTE R.)
INSTR]
[\PUTBASE QP.extendW SECONDARY (\LOLOC (SETA
QP.opcode
(IPLUS SECONDARY 257)
(PACK* (QUOTE W.)
INSTR]
elseif (EQ FIRST (QUOTE *))
then (SETQ COUNTER (IPLUS COUNTER 2))
(PUTHASH COUNTER (APPEND ENTRY (LIST LAST))
QP.INSTRUCTION.HARRAY)
(PUTHASH INSTR COUNTER QP.INSTRUCTION.HARRAY)
(SETA QP.opcode COUNTER (PACK* (QUOTE R.)
INSTR))
(SETA QP.opcode (ADD1 COUNTER)
(PACK* (QUOTE W.)
INSTR))
else (SETQ COUNTER (IPLUS COUNTER 2))
(SETQ LAST INSTR)
(PUTHASH INSTR COUNTER QP.INSTRUCTION.HARRAY)
(PUTHASH COUNTER [LET ((SECOND (CADDR ENTRY)))
(if (NULL FIRST)
then ENTRY
elseif (NULL SECOND)
then (LIST INSTR FIRST (CDR ENTRY))
else (LIST INSTR (PACK* FIRST
(QUOTE %.)
SECOND)
(CDR ENTRY]
QP.INSTRUCTION.HARRAY)
(SETA QP.opcode COUNTER (PACK* (QUOTE R.)
INSTR))
(SETA QP.opcode (ADD1 COUNTER)
(PACK* (QUOTE W.)
INSTR])
(QP.OP.CODE
[LAMBDA (INSTRUCTION)
(if (GETHASH INSTRUCTION QP.EXTENSION.HARRAY)
then (IPLUS (GETHASH INSTRUCTION QP.EXTENSION.HARRAY)
512)
else (GETHASH INSTRUCTION QP.INSTRUCTION.HARRAY])
(QP.init.instrs
[LAMBDA NIL
(QP.DESCRIBE.INSTRUCTIONS (QUOTE ((extend byte)
(add extend)
(add.neg.word extend word)
(add.pos.word extend word)
(allocate)
(body.cut)
(boolean.and extend)
(boolean.not extend)
(boolean.or extend)
(boolean.xor extend)
(call size procedure)
(call.lisp byte)
(compare extend)
(cut.proceed)
(deallocate)
(depart procedure)
(depart.cut)
(divide extend)
(either size offset)
(equal.to extend)
(equal.to.else offset)
(execute procedure)
(fail)
(fix extend)
(float extend)
(get.Ai.boxed a1 cell)
(get.AiM.boxed *)
(get.Ai.constant a1 cell)
(get.AiM.constant *)
(get.Ai.float a1 cell)
(get.AiM.float *)
(get.Ai.list a1)
(get.AiM.list *)
(get.Ai.nil a1)
(get.AiM.nil *)
(get.Ai.structure a1 functor)
(get.AiM.structure *)
(get.Ai.symbol a1 atom)
(get.AiM.symbol *)
(get.Ai.value.Xn a1 a2)
(get.AiM.value.Xn *)
(get.Ai.value.XnM *)
(get.AiM.value.XnM *)
(get.Ai.value.Yn a1 y2)
(get.AiM.value.Yn *)
(get.Ai.variable.Yn a1 y2)
(get.AiM.variable.Yn *)
(greater.than extend)
(greater.than.else offset)
(head.cut)
(initialize.Yn y1)
(integer.divide extend)
(is.a byte)
(jump.to offset)
(just.me.else clause)
(left.shift extend)
(less.than extend)
(less.than.else offset)
(load.constant extend cell)
(load.neg.word extend word)
(load.pos.word extend word)
(load.value.Xn a1)
(load.value.XnM *)
(load.value.Yn y1)
(minus extend)
(modulus extend)
(multiply extend)
(not.equal.to extend)
(not.equal.to.else offset)
(not.less.than extend)
(not.less.than.else offset)
(not.greater.than extend)
(not.greater.than.else offset)
(or offset)
(or.finally)
(proceed)
(progress)
(put.Ai.constant a1 cell)
(put.AiM.constant *)
(put.Ai.list a1)
(put.AiM.list *)
(put.Ai.nil a1)
(put.AiM.nil *)
(put.Ai.structure a1 functor)
(put.AiM.structure *)
(put.Ai.symbol a1 atom)
(put.AiM.symbol *)
(put.Ai.unsafe.Yn a2 y1)
(put.AiM.unsafe.Yn *)
(put.Ai.value.Xn a2 a1)
(put.Ai.value.XnM *)
(put.AiM.value.Xn *)
(put.AiM.value.XnM *)
(put.Ai.value.Yn a2 y1)
(put.AiM.value.Yn *)
(put.Ai.variable.Yn a2 y1)
(put.AiM.variable.Yn *)
(put.Ai.void a1)
(put.AiM.void *)
(raw.float extend)
(interpret.me)
(retry.me.else clause)
(right.shift extend)
(send.variable.Ai a1)
(send.variable.AiM *)
(start.calling functor)
(store.float extend cell)
(store.integer extend cell)
(store.value.Xn a1)
(store.value.XnM *)
(store.value.Yn y1)
(store.variable.Xn a1)
(store.variable.XnM *)
(store.variable.Yn y1)
(subtract extend)
(trust.me.else clause)
(try.me.else clause)
(unify.boxed cell)
(unify.constant cell)
(unify.float cell)
(unify.list)
(unify.local.Xn a1)
(unify.local.XnM *)
(unify.local.Yn y1)
(unify.nil)
(unify.structure functor)
(unify.symbol atom)
(unify.value.Xn a1)
(unify.value.XnM *)
(unify.value.Yn y1)
(unify.variable.Xn a1)
(unify.variable.XnM *)
(unify.variable.Yn y1)
(unify.void byte)
(send.direct.Ai a1)
(send.direct.AiM *)
(trap procedure)
(just.index.else clause)
(try.index.else clause)
(retry.index.else clause)
(trust.index.else clause)
(ignore.me)
(ignore.me.but.keep.me)
(retry.at)
(fail.on.retry)
(store.skeleton extend)
(load.choice.point)
(cut.to.choice.point)
(load.cur.clause)
(apply)
(arg)
(functor)
(gettopval atom)
(settopval atom)
(get.word)
(get.addr)
(put.word extend)
(put.addr extend])
(QP.list.instrs
[LAMBDA (FLAG)
[SETQ FLAG (NOT (FBOUNDP (QUOTE R.call]
(PRINTOUT T "Normal Instructions" T T)
(for I from 0 to 255 when [AND (NEQ (ELT QP.opcode I)
(QUOTE SHOULDNT))
(OR FLAG (FBOUNDP (ELT QP.opcode I]
do (PRINTOUT T .I3 I " = " (ELT QP.opcode I)
" ("
(TIMES I 256)
")" T))
(PRINTOUT T T "Extended Instructions" T T)
(for I from 256 to 383 when [AND (NEQ (ELT QP.opcode I)
(QUOTE SHOULDNT))
(OR FLAG (FBOUNDP (ELT QP.opcode I]
do (PRINTOUT T .I3 (DIFFERENCE I 256)
" = "
(ELT QP.opcode I)
" ("
(PLUS I 256)
")" T))
(PRINTOUT T T])
)
(QP.init.instrs)
(DECLARE: DONTCOPY
(FILEMAP (NIL (919 9122 (QP.DESCRIBE.INSTRUCTIONS 929 . 3438) (QP.OP.CODE 3440 . 3676) (QP.init.instrs
3678 . 8288) (QP.list.instrs 8290 . 9120)))))
STOP