(FILECREATED "31-Jan-86 14:21:22" {ERINYES}<HERRING>COMPILER>DDISASM.;37 19523  

      changes to:  (FNS DDISASM.EMITNAME&TYPE DDISASM.HELP DDISASM.DIGESTANAMETABLE 
                        DDISASM.IVARLOOKUP)

      previous date: "28-Jan-86 17:45:11" {ERINYES}<HERRING>COMPILER>DDISASM.;33)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DDISASMCOMS)

(RPAQQ DDISASMCOMS ((* * see associated doc: D2T.tedit)
                    (GLOBALVARS \DDISASM.LABELUSED)
                    (INITVARS \DDISASM.LABELUSED)
                    (FNS DDISASM)
                    (FNS DDISASM.DIGESTHEADER DDISASM.DIGESTBOTHNAMETABLES DDISASM.DIGESTANAMETABLE)
                    (FNS DDISASM.DIGESTCODE DDISASM.APPLYDOPCODE DDISASM.BIND DDISASM.GETSLOTNR 
                         DDISASM.GETATOMARG DDISASM.GETTYPEPARG DDISASM.GETJUMPTOARG)
                    (FNS DDISASM.EMITPSEUDOOPS DDISASM.EMITNAME&TYPE DDISASM.EMITHEADER)
                    (FNS DDISASM.IVARLOOKUP DDISASM.PVARLOOKUP DDISASM.FVARLOOKUP DDISASM.PFVARLOOKUP
                         )
                    (FNS DDISASM.HELP)))
(* * see associated doc: D2T.tedit)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \DDISASM.LABELUSED)
)

(RPAQ? \DDISASM.LABELUSED NIL)
(DEFINEQ

(DDISASM

  [LAMBDA (FN ERRFILE)                                       (* jmh "23-Nov-85 16:12")


          (* * returns (#errs . instrlist) -- error messages printed to <OR ERRFILE T> -- also see DDISASM.HELP)



    (DECLARE
 (
GLOBALVARS
 \DDISASM.LABELUSED))
    (LET ((CA (
OR
 (MCODEP FN)
		    [
AND
 (
LITATOM
 FN)
			   (MCODEP (
GETPROP
 FN (
QUOTE
 CODE]
		    (
ERROR
 FN "not compiled code")))
	  (NERRS 0)
	  ERRS FNTYPE NTPVARS LTPVARS CGPVARS NTIVARS LTIVARS FVARS INTERMEDIATEINSTRS 
	  OUTPUTINSTRSTCONC)                                 (* e.g. NT/LT/CGPVARS are NameTable /LocalnameTable 

							     /CompilerGenerated PVARS)

         (DECLARE
 (
SPECVARS
 NERRS ERRFILE ERRS CA FNTYPE NTPVARS LTPVARS CGPVARS NTIVARS LTIVARS 
				FVARS))
         [
OR
 \DDISASM.LABELUSED (
SETQ
 \DDISASM.LABELUSED (
HASHARRAY
 (fetch
 (
ARRAYP
 LENGTH)
									     of
 CA]
         (
CLRHASH
 \DDISASM.LABELUSED)

          (* * pass 1 -- digest)



         (DDISASM.DIGESTHEADER
)
         (DDISASM.DIGESTBOTHNAMETABLES
)
         (
SETQ
 INTERMEDIATEINSTRS (DDISASM.DIGESTCODE
))

          (* * pass 2 -- emit)



         (
SETQ
 OUTPUTINSTRSTCONC (DDISASM.EMITPSEUDOOPS
))
         (for
 I in
 INTERMEDIATEINSTRS
	    do
 (if
 (
GETHASH
 (
CAR
 I)
				  \DDISASM.LABELUSED)
		     then
 (
TCONC
 OUTPUTINSTRSTCONC (
CAR
 I)))
		 (
TCONC
 OUTPUTINSTRSTCONC (
CDR
 I)))
         (
CONS
 NERRS (
CAR
 OUTPUTINSTRSTCONC])
)
(DEFINEQ

(DDISASM.DIGESTHEADER

  [LAMBDA NIL
    (DECLARE
 (
USEDFREE
 CA FNTYPE))                       (* jmh "12-Nov-85 14:10")

    (
SETQ
 FNTYPE (
SELECTQ
 (fetch
 (CODEARRAY ARGTYPE) of
 CA)
			      (0 (
QUOTE
 LAMBDA))
			      (1 (
QUOTE
 NLAMBDA))
			      (2 (
QUOTE
 LAMBDA*))
			      (3 (
QUOTE
 NLAMBDA*))
			      (DDISASM.HELP
 "impossible argtype"])

(DDISASM.DIGESTBOTHNAMETABLES

  [LAMBDA NIL                                                (* jmh "12-Nov-85 14:10")


          (* * digest name table and local-var table -- no value returned)



    (DECLARE
 (
USEDFREE
 CA NTPVARS LTPVARS CGPVARS NTIVARS LTIVARS FVARS))
    (LET (TABLESTART TABLENELTS PIFVARS)

          (* * global name table)



         (
SETQ
 TABLESTART (UNFOLD (fetch
 (CODEARRAY OVERHEADWORDS) of
 T)
				    BYTESPERWORD))
         (
SETQ
 TABLENELTS (fetch
 (CODEARRAY NTSIZE) of
 CA))
         (
SETQ
 PIFVARS (DDISASM.DIGESTANAMETABLE
 TABLESTART TABLENELTS))
         (
SETQ
 NTPVARS (
CAR
 PIFVARS))
         (
SETQ
 NTIVARS (
CADR
 PIFVARS))
         (
SETQ
 FVARS (
CDDR
 PIFVARS))

          (* * local name table)



         [
SETQ
 TABLESTART (
IPLUS
 TABLESTART (
IMAX
 BYTESPERQUAD (UNFOLD TABLENELTS
									     (
ITIMES
 2 BYTESPERWORD]
         (
SETQ
 TABLENELTS (FOLDLO (
IDIFFERENCE
 (fetch
 (CODEARRAY STARTPC) of
 CA)
						   TABLESTART)
				    BYTESPERCELL))
         (
SETQ
 PIFVARS (DDISASM.DIGESTANAMETABLE
 TABLESTART TABLENELTS))
         (
SETQ
 LTPVARS (
CAR
 PIFVARS))
         (
SETQ
 LTIVARS (
CADR
 PIFVARS))
         (if
 (
CDDR
 PIFVARS)
	     then
 (DDISASM.HELP
 "local FVARs" (
CDDR
 PIFVARS])

(DDISASM.DIGESTANAMETABLE
  [LAMBDA (TABLESTART TABLENELTS)                                          (* jmh 
                                                                           "29-Jan-86 12:49")
            
            (* * digests a name table => (pvars ivars . fvars) each a list of
            (name . slot#) in order of occurrence)

    (DECLARE (USEDFREE CA))
    (LET ((TABLESIZE (UNFOLD TABLENELTS BYTESPERWORD))
          VARNAME NAME NR PVARS IVARS FVARS)
         [for N from 1 to TABLENELTS as NTPTR from TABLESTART by BYTESPERWORD
            while [NOT (ZEROP (SETQ VARNAME (CODELT2 CA NTPTR]
            do (SETQ NAME (\INDEXATOMVAL VARNAME))
               [SETQ NR (CODELT CA (ADD1 (IPLUS NTPTR TABLESIZE]
               (SELECTC (CODELT CA (IPLUS NTPTR TABLESIZE))
                   ((LRSH IVARCODE 8) 
                        (push IVARS (LIST NAME (IDIFFERENCE -1 NR))))
                   ((LRSH PVARCODE 8) 
                        (push PVARS (LIST NAME NR)))
                   (push FVARS (LIST NAME NR]
         (CONS (REVERSE PVARS)
               (CONS (REVERSE IVARS)
                     (REVERSE FVARS])
)
(DEFINEQ

(DDISASM.DIGESTCODE

  [LAMBDA NIL                                                (* jmh "12-Nov-85 14:10")


          (* * process the byte code -- collect list of (label=PC op . symbolic-args), noting what labels are jumped to or 

	  are BINDs)



    (DECLARE
 (
USEDFREE
 CA))
    (repeatuntil
 (
ZEROP
 BO) bind
 PC BO DOPCODE first
 (
SETQ
 PC (fetch
 (CODEARRAY STARTPC)
									   of
 CA))
       collect
 (
SETQ
 BO (CODELT CA PC))
		 (
SETQ
 DOPCODE (if
 (
\FINDOP
 BO)
				   else
 (DDISASM.HELP
 "no dopcode")))
		 (
PROG1
 (
CONS
 PC (DDISASM.APPLYDOPCODE
 PC BO DOPCODE))
			  (add
 PC (
ADD1
 (fetch
 OPNARGS of
 DOPCODE])

(DDISASM.APPLYDOPCODE

  [LAMBDA (PC B0 DOPCODE)                                    (* jmh "28-Jan-86 14:12")


          (* * returns an instr as (CONS opname (APPEND symbolic-args errs-if-any)))



    (DECLARE
 (
GLOBALVARS
 \DDISASM.LABELUSED)
	     (
USEDFREE
 CA FNTYPE NERRS ERRS ERRFILE))
    (LET* [(OPCODENAME (fetch
 (OPCODE OPCODENAME) of
 DOPCODE))
	   (OPNARGS (fetch
 (OPCODE OPNARGS) of
 DOPCODE))
	   (OPPRINT (fetch
 (OPCODE OPPRINT) of
 DOPCODE))
	   [B1 (if
 (
IGEQ
 OPNARGS 1)
		   then
 (CODELT CA (
IPLUS
 1 PC]
	   [B2 (if
 (
IGEQ
 OPNARGS 2)
		   then
 (CODELT CA (
IPLUS
 2 PC]
	   [B3 (if
 (
IGEQ
 OPNARGS 3)
		   then
 (CODELT CA (
IPLUS
 3 PC]
	   (INSTR (
SELECTQ
 OPPRINT
			   [NIL (
SELECTQ
 OPCODENAME
					 (BIND (DDISASM.BIND
 B1 B2))
					 ((-X- UNBIND DUNBIND)
					   (
LIST
 OPCODENAME))
					 (
PROGN
 (push
 ERRS "unimplemented NIL-opprint")
						(
LIST
 OPCODENAME]
			   [(T SUBRCALL)
			     (
SELECTQ
 OPCODENAME
				      [(GETBITS.N.FD PUTBITS.N.FD)
					(
LIST
 OPCODENAME B1 (
LOGAND
 15 (
LRSH
 B2 4))
					      (
ADD1
 (
LOGAND
 15 B2]
				      (if
 (
LISTP
 (fetch
 (OPCODE OP#) of
 DOPCODE))
					  then
 (if
 (
NOT
 (
ZEROP
 OPNARGS))
						   then
 (push
 ERRS "op# list & opnargs>0"))
					       [
LIST
 OPCODENAME (
IDIFFERENCE

						       B0
						       (
CAR
 (fetch
 (OPCODE OP#) of
 DOPCODE]
					else
 (
CONS
 OPCODENAME (for
 I from
 1 to
 OPNARGS
								 collect
 (CODELT CA (
IPLUS
 I PC]
			   ((JUMP JUMPX JUMPXX)
			     (LET ((TARGET (DDISASM.GETJUMPTOARG
 PC B0 DOPCODE)))
			          (
PUTHASH
 TARGET T \DDISASM.LABELUSED)
			          (
LIST
 OPCODENAME TARGET)))
			   [IVAR (
LIST
 OPCODENAME (if
 (
NEQ
 FNTYPE (
QUOTE
 LAMBDA*))
						      then
 (DDISASM.IVARLOOKUP
 (DDISASM.GETSLOTNR

										 PC B0 DOPCODE))
						    else
 (DDISASM.GETSLOTNR
 PC B0 DOPCODE]
			   [PVAR (
LIST
 OPCODENAME (DDISASM.PVARLOOKUP
 (DDISASM.GETSLOTNR
 PC B0 
											 DOPCODE]
			   [FVAR (
LIST
 OPCODENAME (DDISASM.FVARLOOKUP
 (DDISASM.GETSLOTNR
 PC B0 
											 DOPCODE]
			   (
ATOM
 (
LIST
 OPCODENAME (DDISASM.GETATOMARG
 B1 B2)))
			   (FN (
LIST
 OPCODENAME (DDISASM.GETATOMARG
 B1 B2)))
			   (FNX (
LIST
 OPCODENAME B1 (DDISASM.GETATOMARG
 B2 B3)))
			   (SIC (
LIST
 (
QUOTE
 SIC)
				      B1))
			   (SNIC (
LIST
 (
QUOTE
 SNIC)
				       (
IPLUS
 B1 -256)))
			   (SICX (
LIST
 (
QUOTE
 SICX)
				       (
LOGOR
 (
LLSH
 B1 8)
					      B2)))
			   [GCONST (
LIST
 (
QUOTE
 GCONST)
					 (1ST (
\VAG2
 B1 (
IPLUS
 (
LLSH
 B2 8)
							       B3]
			   (TYPEP (
LIST
 OPCODENAME (DDISASM.GETTYPEPARG
 B1)))
			   (if
 (
LISTP
 OPPRINT)
			       then
 [if
 (
NEQ
 OPNARGS 1)
					then
 (push
 ERRS "opprint is listp but opnargs not 1")
					     (
LIST
 OPCODENAME)
				      else
 (
LIST
 OPCODENAME (LET [(X (
NTH
 OPPRINT (
ADD1
 B1]
							         (if
 (
LISTP
 X)
								     then
 (
CAR
 X)
								   else
 B1]
			     else
 (
PROGN
 (push
 ERRS "unimplemented opprint")
					 (
LIST
 OPCODENAME]
          (if
 ERRS
	      then
 (add
 NERRS (
LENGTH
 ERRS))
		   (
NCONC
 INSTR (
CONS
 "*DDisAsm errs*" (
REVERSE
 ERRS)))
		   (printout (
OR
 ERRFILE T)
			     .PPV INSTR T))
      INSTR])

(DDISASM.BIND

  [LAMBDA (B1 B2)                                            (* jmh "16-Oct-85 17:15")


          (* * returns (BIND nonnil-vars nil-vars) with nonnil-vars in reverse the order in which the BIND will bind them by 

	  popping values off the stack)



    (DECLARE
 (
USEDFREE
 CA))
    (LET* [(NNVARS (
LRSH
 B1 4))
	   (NVVARS (
LOGAND
 B1 15))
	   [NVARS (
REVERSE
 (for
 N from
 1 to
 NNVARS as
 SLOT from
 B2 by
 -1
				collect
 (DDISASM.PFVARLOOKUP
 SLOT]
	   (VVARS (
REVERSE
 (for
 N from
 1 to
 NVVARS as
 SLOT from
 (
IDIFFERENCE
 B2 NNVARS)
				by
 -1 collect
 (DDISASM.PFVARLOOKUP
 SLOT]
          (
LIST
 (
QUOTE
 BIND)
		  VVARS NVARS])

(DDISASM.GETSLOTNR

  [LAMBDA (PC B0 DOPCODE)                                    (* jmh " 8-Dec-85 17:04")


          (* * get slot-number argument from all of the byte code of a variable-reference instr -- an alpha-byte arg will be 

	  divided by 2)



    (DECLARE
 (
USEDFREE
 CA ERRS))
    (LET (OPNRRANGE)
         (
SELECTQ
 (fetch
 (OPCODE OPNARGS) of
 DOPCODE)
		    [0 (
SETQ
 OPNRRANGE (fetch
 (OPCODE OP#) of
 DOPCODE))
		       (if
 (
AND
 (
LISTP
 OPNRRANGE)
				    (
NUMBERP
 (
CAR
 OPNRRANGE)))
			   then
 (
IDIFFERENCE
 B0 (
CAR
 OPNRRANGE))
			 else
 (
PROG1
 0 (push
 ERRS "no OP# range"]
		    (1 (
LRSH
 (CODELT CA (
ADD1
 PC))
			       1))
		    (
PROGN
 (push
 ERRS "opnargs>1")
			     0])

(DDISASM.GETATOMARG

  [LAMBDA (B1 B2)                                            (* jmh "29-Oct-85 15:29")

    (DECLARE
 (
USEDFREE
 ERRS))
    (if
 (\INDEXATOMVAL (
LOGOR
 (
LLSH
 B1 8)
				  B2))
      else
 (push
 ERRS "unknown atom")
	     (
QUOTE
 ?])

(DDISASM.GETTYPEPARG

  [LAMBDA (B1)                                               (* jmh "16-Oct-85 16:07")

    (if
 (
EQ
 B1 \ARRAYP)
	then
 (
QUOTE
 ARRAYP)
      elseif
 (
EQ
 B1 \STRINGP)
	then
 (
QUOTE
 STRINGP)
      elseif
 (
EQ
 B1 \FLOATP)
	then
 (
QUOTE
 FLOATP)
      elseif
 (
EQ
 B1 \SMALLP)
	then
 (
QUOTE
 SMALLP)
      elseif
 (
EQ
 B1 \STACKP)
	then
 (
QUOTE
 STACKP)
      elseif
 (
EQ
 B1 \FIXP)
	then
 (
QUOTE
 FIXP)
      elseif
 (
EQ
 B1 \LITATOM)
	then
 (
QUOTE
 LITATOM)
      else
 B1])

(DDISASM.GETJUMPTOARG

  [LAMBDA (PC B0 DOPCODE)
    (DECLARE
 (
USEDFREE
 CA ERRS))                         (* jmh "10-Nov-85 14:06")

    (
SELECTQ
 (fetch
 (OPCODE OPNARGS) of
 DOPCODE)
	       (0 (LET ((OP#RANGE (fetch
 (OPCODE OP#) of
 DOPCODE)))
		       (if
 (
AND
 (
LISTP
 OP#RANGE)
				    (
NUMBERP
 (
CAR
 OP#RANGE)))
			   then
 (
IPLUS
 PC 2 (
IDIFFERENCE
 B0 (
CAR
 OP#RANGE)))
			 else
 (push
 ERRS "no k without OP# range")
				0)))
	       [1 (LET [(D (CODELT CA (
ADD1
 PC]
		       (
IPLUS
 PC (if
 (
ILESSP
 D 128)
				       then
 D
				     else
 (
IDIFFERENCE
 D 256]
	       [2 (LET [(D (
LOGOR
 (
LLSH
 (CODELT CA (
ADD1
 PC))
					    8)
				    (CODELT CA (
IPLUS
 2 PC]
		       (
IPLUS
 PC (if
 (
ILESSP
 D 32768)
				       then
 D
				     else
 (
IDIFFERENCE
 D 65536]
	       (
PROG1
 0 (push
 ERRS "opnargs>2"])
)
(DEFINEQ

(DDISASM.EMITPSEUDOOPS

  [LAMBDA NIL                                                (* jmh " 8-Dec-85 14:57")


          (* * returns a TCONC)



    (DECLARE
 (
USEDFREE
 NTIVARS LTIVARS NTPVARS LTPVARS CGPVARS FVARS))
    (LET ((OUTPUTINSTRSTCONC (
CONS
)))
         (
TCONC
 OUTPUTINSTRSTCONC (DDISASM.EMITNAME&TYPE
))
         (
TCONC
 OUTPUTINSTRSTCONC (DDISASM.EMITHEADER
))
         (if
 NTPVARS
	     then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 PVARS:)
						       NTPVARS)))
         (if
 NTIVARS
	     then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 IVARS:)
						       NTIVARS)))
         (if
 FVARS
	     then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 FVARS:)
						       FVARS)))
         [if
 (
OR
 LTIVARS LTPVARS CGPVARS)
	     then
 (
TCONC
 OUTPUTINSTRSTCONC (
QUOTE
 LOCAL:))
		    (if
 LTPVARS
			then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 PVARS:)
								  NTPVARS)))
		    (if
 LTIVARS
			then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 IVARS:)
								  LTIVARS)))
		    (if
 CGPVARS
			then
 (
TCONC
 OUTPUTINSTRSTCONC (
CONS
 (
QUOTE
 PVARS:)
								  CGPVARS]
         (
TCONC
 OUTPUTINSTRSTCONC (
QUOTE
 CODE:))
     OUTPUTINSTRSTCONC])

(DDISASM.EMITNAME&TYPE
  [LAMBDA NIL                                                              (* jmh 
                                                                           "29-Jan-86 20:18")
            
            (* * returns (N/LAMBDA: name arglist))

    (DECLARE (USEDFREE CA FNTYPE NTIVARS LTIVARS))
    (LET [(IVARS (APPEND NTIVARS (APPEND LTIVARS]
         (LIST (SELECTQ FNTYPE
                   ([LAMBDA LAMBDA*] 
                        (QUOTE LAMBDA:))
                   ([NLAMBDA NLAMBDA*] 
                        (QUOTE NLAMBDA:))
                   (DDISASM.HELP "bad argtype" FNTYPE))
               (fetch (CODEARRAY FRAMENAME) of CA)
               (SELECTQ FNTYPE
                   ([LAMBDA NLAMBDA] 
                        [SORT IVARS (FUNCTION (LAMBDA (A B)
                                                (ILESSP (CADR B)
                                                       (CADR A])
                   (NLAMBDA* (if (EQ 1 (LENGTH IVARS))
                                 then (CAR IVARS)
                               else (DDISASM.HELP "nlambda* but #ivars not 1")))
                   (LAMBDA* (if [AND (NULL IVARS)
                                     (LET ((X (DDISASM.PVARLOOKUP 0 T)))
                                          (OR (NULL X)
                                              (NOT (LITATOM (CAR X]
                                then (SETQ LTIVARS (LIST (LIST "dummy$ivar" 0)))
                                     (SETQ IVARS LTIVARS))
                            (if IVARS
                                then (if (EQ 1 (LENGTH IVARS))
                                         then (CAR IVARS)
                                       else (DDISASM.HELP "lambda* but #ivars >1"))
                              else (DDISASM.PVARLOOKUP 0)))
                   (DDISASM.HELP "bad argtype" FNTYPE])

(DDISASM.EMITHEADER

  [LAMBDA NIL                                                (* jmh "30-Oct-85 18:22")


          (* * returns (DFNHEADER: . property-list))



    (DECLARE
 (
USEDFREE
 CA))
    (
LIST
 (
QUOTE
 DFNHEADER:)
	    (
QUOTE
 STKMIN:)
	    (fetch
 (CODEARRAY STKMIN) of
 CA)
	    (
QUOTE
 PV:)
	    (fetch
 (CODEARRAY PV) of
 CA)
	    (
QUOTE
 STARTPC:)
	    (fetch
 (CODEARRAY STARTPC) of
 CA)
	    (
QUOTE
 NTSIZE:)
	    (fetch
 (CODEARRAY NTSIZE) of
 CA)
	    (
QUOTE
 NLOCALS:)
	    (fetch
 (CODEARRAY NLOCALS) of
 CA)
	    (
QUOTE
 FVAROFFSET:)
	    (fetch
 (CODEARRAY FVAROFFSET) of
 CA])
)
(DEFINEQ

(DDISASM.IVARLOOKUP
  [LAMBDA (NR)                                                             (* jmh 
                                                                           "29-Jan-86 12:51")
            
            (* * returns <name canonical-ivar-nr> of the IVAR with slot NR --
            canonical ivar nr is -1,-2,.. per ivar list in fn decl)

    (DECLARE (USEDFREE ERRS NTIVARS LTIVARS))
    (SETQ NR (IDIFFERENCE -1 NR))
    (OR (for X in NTIVARS thereis (EQ NR (CADR X)))
        (for X in LTIVARS thereis (EQ NR (CADR X)))
        (PROGN (push ERRS "ivar lookup failed")
               (QUOTE (? -1])

(DDISASM.PVARLOOKUP

  [LAMBDA (NR DONTCREATE?)                                   (* jmh "28-Jan-86 11:29")


          (* * returns <name slot> of the PVAR with slot NR -- makes PVAR with name "pvar" if necessary unless DONTCREATE?)



    (DECLARE
 (
GLOBALVARS
 PRXFLG)
	     (
USEDFREE
 NTPVARS LTPVARS CGPVARS))
    (
OR
 (for
 X in
 NTPVARS thereis
 (
EQ
 NR (
CADR
 X)))
	(for
 X in
 LTPVARS thereis
 (
EQ
 NR (
CADR
 X)))
	(for
 X in
 CGPVARS thereis
 (
EQ
 NR (
CADR
 X)))
	(
AND
 (
NULL
 DONTCREATE?)
	     (LET ((X (
LIST
 "pvar" NR)))
	          (push
 CGPVARS X)
	      X])

(DDISASM.FVARLOOKUP

  [LAMBDA (NR ERROK)                                         (* jmh " 8-Dec-85 13:40")


          (* * returns <name slot> of the FVAR with slot NR -- or, if ERROK, then NIL='none')



    (DECLARE
 (
USEDFREE
 ERRS FVARS))
    (
OR
 (for
 X in
 FVARS thereis
 (
EQ
 NR (
CADR
 X)))
	  (if
 (
NOT
 ERROK)
	      then
 (push
 ERRS "fvar lookup failed")
		     (
QUOTE
 (? -1])

(DDISASM.PFVARLOOKUP

  [LAMBDA (NR)                                               (* jmh "15-Oct-85 15:38")

    (if
 (DDISASM.FVARLOOKUP
 NR T)
      else
 (DDISASM.PVARLOOKUP
 NR])
)
(DEFINEQ

(DDISASM.HELP
  [LAMBDA (MSG1 MSG2)                                                      (* jmh 
                                                                           "29-Jan-86 18:58")
    (DECLARE (USEDFREE ERRFILE))
    (if (NULL ERRFILE)
        then (HELP MSG1 MSG2)
      else (ASM.HELP MSG1 MSG2])
)
(PUTPROPS DDISASM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1273 2825 (DDISASM 1283 . 2823)) (2826 5740 (DDISASM.DIGESTHEADER 2836 . 3228) (
DDISASM.DIGESTBOTHNAMETABLES 3230 . 4593) (DDISASM.DIGESTANAMETABLE 4595 . 5738)) (5741 13337 (
DDISASM.DIGESTCODE 5751 . 6463) (DDISASM.APPLYDOPCODE 6465 . 9978) (DDISASM.BIND 9980 . 10724) (
DDISASM.GETSLOTNR 10726 . 11511) (DDISASM.GETATOMARG 11513 . 11797) (DDISASM.GETTYPEPARG 11799 . 12391
) (DDISASM.GETJUMPTOARG 12393 . 13335)) (13338 17189 (DDISASM.EMITPSEUDOOPS 13348 . 14651) (
DDISASM.EMITNAME&TYPE 14653 . 16507) (DDISASM.EMITHEADER 16509 . 17187)) (17190 19118 (
DDISASM.IVARLOOKUP 17200 . 17818) (DDISASM.PVARLOOKUP 17820 . 18472) (DDISASM.FVARLOOKUP 18474 . 18913
) (DDISASM.PFVARLOOKUP 18915 . 19116)) (19119 19440 (DDISASM.HELP 19129 . 19438)))))
STOP