(FILECREATED "23-Nov-84 16:54:56" {ERIS}<LISPNEW>PATCHES>DLAPVARPATCH.;1
 4879   

      changes to:  (VARS DLAPVARPATCHCOMS))


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DLAPVARPATCHCOMS)

(RPAQQ DLAPVARPATCHCOMS
 ((FNS DASSEM.DWRITEFN DASSEM.SAVELOCALVARS)
			 (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
								DLAP))))
(DEFINEQ

(DASSEM.DWRITEFN

  [LAMBDA (FN FRAMENAME ARGTYPE ARGS LOCALS FREEVARS CD)     (* lmm "23-Nov-84 16:49")

    (
RESETLST

      (
RESETSAVE
 (
RADIX
 8))
      (
PROG
 ((
NARGS
 (
LENGTH
 ARGS))
	     (NLOCALS (
LENGTH
 LOCALS))
	     (NFREEVARS (
LENGTH
 FREEVARS))
	     LOCALVARINFO)                                   (* WRITE OUT DEFINITION)

	    (
PROG
 ([LC (
FLENGTH
 (
NCONC1
 CD (
QUOTE
 -X-]
		   NAMETABLE)
	          [
PROGN
 

          (* Construct the name table. Is a flattened list of entries <code, index, varname>, where code is one of P, I, F.

	  First come PVAR's, in reverse order of binding, then IVAR's, then FVAR's. Thus free variable lookup can search the 

	  table in order. We build NAMETABLE backwards, consing onto front)



			 [
COND

			   (
FREEVARS
 (for
 X in
 FREEVARS as
 I from
 NLOCALS do
 (push
 NAMETABLE
										   (
CDR
 X)
										   I
										   (
QUOTE
 F)))
                                                             (* Fine, but backwards: the FVARS need to be in order, 

							     while the PVARS want to be in reverse order)

				     (
SETQ
 NAMETABLE (
DREVERSE
 NAMETABLE]
			 [for
 X in
 ARGS as
 I from
 0 do
 (
COND

							 ((
NEQ
 (
CAR
 X)
							       (
QUOTE
 HVAR))
							   (push
 NAMETABLE (
QUOTE
 I)
								 I
								 (
CDR
 X)))
							 (T 
                                                             (* Need to save localvar args for ARGLIST)

							    (push
 LOCALVARINFO I (
CDR
 X]
			 [for
 X in
 LOCALS as
 I from
 0 do
 (
COND

							   ((
NEQ
 (
CAR
 X)
								 (
QUOTE
 HVAR))
							     (push
 NAMETABLE (
QUOTE
 P)
								   I
								   (
CDR
 X)))
							   ((
AND
 (
EQ
 ARGTYPE 2)
								 (
EQ
 I 0))
							     (push
 LOCALVARINFO I (
CDR
 X]
			 (
COND

			   ((
AND
 LOCALVARINFO (DASSEM.SAVELOCALVARS
 FN))
                                                             (* Keep this separate, so for now DCODERD can easily 

							     discard it)

			     (push
 NAMETABLE (
QUOTE
 L)
				   LOCALVARINFO]
	          (
COND

		    ((
NEQ
 FRAMENAME FN)
		      (push
 NAMETABLE (
QUOTE
 NAME)
			    FRAMENAME)))
	          (
SELECTQ
 LAPFLG
			   ((2 T)
			     (
DASSEM.DPRINTLAP
 FN NAMETABLE ARGTYPE CD))
			   NIL)
	          [
COND

		    (LCFIL (
RESETSAVE
 (
OUTPUT
 LCFIL))
			   (
RESETSAVE
 (
SETREADTABLE
 CODERDTBL))
			   (
PROG
 [FNFIX ATOMFIX PTRFIX (COFD (
GETOFD
 LCFIL (
QUOTE
 OUTPUT]
			         (
PRIN4
 FN NIL FILERDTBL)
			         (
PRIN3
 " ")
			         (
PRIN4
 CODEINDICATOR NIL FILERDTBL)
			         (
TERPRI
)
			         (
PRIN4
 NAMETABLE)
			         (
PRIN3
 " ")
			         (
\BOUT
 COFD (
LRSH
 LC 8))
			         (
\BOUT
 COFD (
LOGAND
 LC 255))
			         (
\BOUT
 COFD NLOCALS)
			         (
\BOUT
 COFD NFREEVARS)
			         (
\BOUT
 COFD ARGTYPE)
			         (
\BOUT
 COFD NARGS)
			         [for
 X in
 CD as
 LOC from
 0
				    do
 (
\BOUT
 COFD (
COND

						[(
NLISTP
 X)
						  (
COND

						    ((
AND
 (
FIXP
 X)
							  (
IGEQ
 X 0)
							  (
ILEQ
 X 255))
						      X)
						    (T (fetch
 OP# of
 (
\FINDOP
 X T]
						(T (
SELECTQ
 (
CAR
 X)
							    (FN (push
 FNFIX LOC (
CDR
 X))
								0)
							    (
ATOM
 (push
 ATOMFIX LOC (
CDR
 X))
								  0)
							    (PTR (push
 PTRFIX LOC (
CDR
 X))
								 0)
							    (
IPLUS
 (fetch
 OP#
								      of
 (
\FINDOP
 (
CAR
 X)
										  T))
								   (
CADR
 X]
			         (
PRIN4
 FNFIX)
			         (
TERPRI
)
			         (
PRIN4
 ATOMFIX)
			         (
TERPRI
)
			         (
PRIN3
 "(")
			         [for
 X in
 PTRFIX
				    do
 (
SPACES
 1)
				       (
COND

					 ((
EQ
 (
CAR
 X)
					      LOADTIMECONSTANTMARKER)
					   (
BOUT
 NIL (
CHARCODE
 ↑Y))
					   (
PRIN4
 (
CDR
 X)))
					 (T (
PRIN4
 X]
			         (
PRIN3
 ")")
			         (
TERPRI
]
	          (
COND

		    (STRF (
DASSEM.DSTOREFNDEF
 FN CD LC ARGTYPE NARGS NLOCALS NFREEVARS NAMETABLE)))
	          (
RETURN
 FN])

(DASSEM.SAVELOCALVARS

  [LAMBDA (FN)
    T])
)
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP)
	   DLAP)
)
(PUTPROPS DLAPVARPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (379 4729 (DASSEM.DWRITEFN 389 . 4677) (DASSEM.SAVELOCALVARS 4679 . 4727)))))
STOP