(FILECREATED " 5-MAR-83 00:26:43" <BLISP>CMACROS.;48
 3645   

      changes to:  (FNS \FIXCODEPTR)

      previous date: "13-FEB-83 16:38:06" <BLISP>CMACROS.;47)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT CMACROSCOMS)

(RPAQQ CMACROSCOMS
 ((* IMPLEMENTS PSEUDO DEFINITIONS FOR HILOC, VAG2, ETC. IN INTERLISP-10)
		    (DECLARE: FIRST (P (SELECTQ (SYSTEMTYPE)
						((ALTO D)
						 (SHOULDNT))
						NIL)))
		    (FNS \FIXCODEPTR \HILOC \LOLOC \VAG2 CATOMNAME)
		    [P [MAPC (QUOTE (\ATOMVALINDEX \ATOMDEFINDEX \ATOMPNAMEINDEX \ATOMPROPINDEX))
			     (FUNCTION (LAMBDA (X)
					       (MOVD? (QUOTE \LOLOC)
						      X]
		       (MAPC (QUOTE (\INDEXATOMVAL \INDEXATOMDEF \INDEXATOMPNAME \INDEXATOMPROP))
			     (FUNCTION (LAMBDA (X)
					       (MOVD? (QUOTE CATOMNAME)
						      X]
		    [VARS (ATOMLIST (QUOTE (0)))
			  (PTRLIST (QUOTE (0]
		    (DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS ATOMLIST PTRLIST))))



(* IMPLEMENTS PSEUDO DEFINITIONS FOR HILOC, VAG2, ETC. IN INTERLISP-10)


(DECLARE: FIRST 
(SELECTQ (SYSTEMTYPE)
	 ((ALTO D)
	  (SHOULDNT))
	 NIL)
)
(DEFINEQ

(\FIXCODEPTR

  [LAMBDA (A POS PTR)              (* lmm " 5-MAR-83 00:26")

                                   (* CMACROS VERSION)

    (\FIXCODENUM A POS (\LOLOC
 PTR))
    (\BYTESETA A (IDIFFERENCE POS 2)
	       (\HILOC
 PTR))
    PTR])

(\HILOC

  [LAMBDA (X)                      (* lmm "10-AUG-81 21:10")

                                   (* CMACROS VERSION)

    (COND
      ((LITATOM X)
	0)
      ((AND (FIXP X)
	    (IGREATERP X -177777Q)
	    (IGREATERP 0 X))
	17Q)
      ((AND (FIXP X)
	    (IGEQ X 0)
	    (IGEQ 177777Q X))
	16Q)
      (T 2])

(\LOLOC

  [LAMBDA (X)                      (* lmm "13-FEB-83 15:58")

                                   (* CMACROS VERSION)

    (COND
      [(LITATOM X)
	(COND
	  ((NULL X)
	    0)
	  (T ([LAMBDA (R)
		 (COND
		   (R (FLENGTH R))
		   (T (FRPLACD ATOMLIST (CONS X (CDR ATOMLIST)))
		      (CAR (FRPLACA ATOMLIST (ADD1 (CAR ATOMLIST]
	       (FMEMB X ATOMLIST]
      ((AND (FIXP X)
	    (IGREATERP X -177777Q)
	    (IGEQ 177777Q X))
	(LOGAND X 177777Q))
      (T ([LAMBDA (R)
	     (COND
	       (R (FLENGTH R))
	       (T (FRPLACD PTRLIST (CONS X (CDR PTRLIST)))
		  (CAR (FRPLACA PTRLIST (ADD1 (CAR PTRLIST]
	   (MEMBER X PTRLIST])

(\VAG2

  [LAMBDA (HI LO)                  (* lmm "13-FEB-83 15:58")

                                   (* CMACROS VERSION)

                                   (* edited (21-SEP-75 . 2744Q))

    (COND
      [(ZEROP HI)
	(COND
	  ((ZEROP LO)
	    NIL)
	  (T (CAR (FNTH ATOMLIST (IPLUS (IDIFFERENCE (CAR ATOMLIST)
						     LO)
					2]
      ((EQ HI 16Q)
	LO)
      ((EQ HI 17Q)
	(IMINUS (LOGXOR 177777Q LO)))
      [(EQ HI 2)
	(CAR (FNTH PTRLIST (IPLUS (IDIFFERENCE (CAR PTRLIST)
					       LO)
				  2]
      (T (SHOULDNT])

(CATOMNAME

  [LAMBDA (X)                      (* lmm "13-FEB-83 16:08")

    (\VAG2
 0 X])
)
[MAPC (QUOTE (\ATOMVALINDEX \ATOMDEFINDEX \ATOMPNAMEINDEX \ATOMPROPINDEX))
      (FUNCTION (LAMBDA (X)
			(MOVD? (QUOTE \LOLOC)
			       X]
[MAPC (QUOTE (\INDEXATOMVAL \INDEXATOMDEF \INDEXATOMPNAME \INDEXATOMPROP))
      (FUNCTION (LAMBDA (X)
			(MOVD? (QUOTE CATOMNAME)
			       X]

(RPAQQ ATOMLIST
 (0))

(RPAQQ PTRLIST
 (0))
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS ATOMLIST PTRLIST)
)
)
(PUTPROPS CMACROS COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1142 3099 (\FIXCODEPTR 1154 . 1414) (\HILOC 1418 . 1756) (\LOLOC 1760 . 2427) (\VAG2 
2431 . 2990) (CATOMNAME 2994 . 3096)))))
STOP