(FILECREATED "31-Dec-84 13:17:59" {DANTE}<LISPUSERS>BOUNDARY.;2
 9695   

      changes to:  (MACROS BOUNDARY.UNION BOUNDARY.UNION*)

      previous date: "24-Oct-84 16:15:13" {DANTE}<LISPUSERS>BOUNDARY.;1)


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

(PRETTYCOMPRINT BOUNDARYCOMS)

(RPAQQ BOUNDARYCOMS
 ((RECORDS BOUNDARY)
		     (MACROS BOUNDARY.INTERSECTION BOUNDARY.INTERSECTION* BOUNDARY.INTERSECTION** 
			     BOUNDARY.INTERSECTP BOUNDARY.INTERSECTP* BOUNDARY.INTERSECTP** 
			     BOUNDARY.POP BOUNDARY.PUSH BOUNDARY.UNION BOUNDARY.UNION* 
			     BOUNDARY.UNION**)
		     (PROP GLOBALVAR BOUNDARY.FREELIST)
		     (VARS (BOUNDARY.FREELIST NIL))
		     (FNS BOUNDARY.CREATE BOUNDARY.DIFFERENCE BOUNDARY.MERGE BOUNDARY.RELEASE)))
[DECLARE: EVAL@COMPILE 

(DATATYPE BOUNDARY
 (LEFT.BOUND BOTTOM.BOUND RIGHT.BOUND TOP.BOUND NEXT.BOUND))
]
(/DECLAREDATATYPE (QUOTE BOUNDARY)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE 

(PUTPROPS BOUNDARY.INTERSECTION MACRO
 (OPENLAMBDA (X Y)
						  (BOUNDARY.INTERSECTION* X
									  (
AND
 (
OR
 (type?
 BOUNDARY Y)
										   (
\ILLEGAL.ARG

										     Y))
									       (ffetch
 LEFT.BOUND
										  of
 Y))
									  (ffetch
 BOTTOM.BOUND
									     of
 Y)
									  (ffetch
 RIGHT.BOUND
									     of
 Y)
									  (ffetch
 TOP.BOUND
									     of
 Y))))

(PUTPROPS BOUNDARY.INTERSECTION* MACRO
 (OPENLAMBDA (X Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)
						   (BOUNDARY.INTERSECTION**(
AND
 (
OR
 (type?
 BOUNDARY X)
										    (
\ILLEGAL.ARG

										      X))
										(ffetch
 LEFT.BOUND
										   of
 X))
						     (ffetch
 BOTTOM.BOUND of
 X)
						     (ffetch
 RIGHT.BOUND of
 X)
						     (ffetch
 TOP.BOUND of
 X)
						     Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)))

(PUTPROPS BOUNDARY.INTERSECTION** MACRO
 [OPENLAMBDA (X.LEFT X.BOTTOM X.RIGHT X.TOP Y.LEFT Y.BOTTOM 
							    Y.RIGHT Y.TOP)
                                                             (* mgb: "21-Oct-84 20:21")

						    (
AND
 (BOUNDARY.INTERSECTP** X.LEFT X.BOTTOM 
										X.RIGHT X.TOP Y.LEFT 
										Y.BOTTOM Y.RIGHT 
										Y.TOP)
							 (
BOUNDARY.CREATE
 (
IMAX
 X.LEFT Y.LEFT)
									  (
IMAX
 X.BOTTOM Y.BOTTOM)
									  (
IMIN
 X.RIGHT Y.RIGHT)
									  (
IMIN
 X.TOP Y.TOP])

(PUTPROPS BOUNDARY.INTERSECTP MACRO
 (OPENLAMBDA (X Y)
						(BOUNDARY.INTERSECTP* X
								      (
AND
 (
OR
 (type?
 BOUNDARY Y)
									       (
\ILLEGAL.ARG
 Y))
									   (ffetch
 LEFT.BOUND
									      of
 Y))
								      (ffetch
 BOTTOM.BOUND
									 of
 Y)
								      (ffetch
 RIGHT.BOUND
									 of
 Y)
								      (ffetch
 TOP.BOUND of
 Y))))

(PUTPROPS BOUNDARY.INTERSECTP* MACRO
 (OPENLAMBDA (X Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)
						 (BOUNDARY.INTERSECTP**(
AND
 (
OR
 (type?
 BOUNDARY X)
										(
\ILLEGAL.ARG
 X))
									    (ffetch
 LEFT.BOUND
									       of
 X))
						   (ffetch
 BOTTOM.BOUND of
 X)
						   (ffetch
 RIGHT.BOUND of
 X)
						   (ffetch
 TOP.BOUND of
 X)
						   Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)))

(PUTPROPS BOUNDARY.INTERSECTP** MACRO
 (OPENLAMBDA (X.LEFT X.BOTTOM X.RIGHT X.TOP Y.LEFT Y.BOTTOM 
							  Y.RIGHT Y.TOP)
                                                             (* mgb: "21-Oct-84 20:21")

						  (
AND
 (
ILESSP
 X.LEFT Y.RIGHT)
						       (
ILESSP
 X.BOTTOM Y.TOP)
						       (
ILESSP
 Y.LEFT X.RIGHT)
						       (
ILESSP
 Y.BOTTOM X.TOP))))

(PUTPROPS BOUNDARY.POP MACRO
 [(STACK)
			      (
PROG1
 STACK (change
 STACK (fetch
 NEXT.BOUND of
 STACK])

(PUTPROPS BOUNDARY.PUSH MACRO
 ((STACK ITEM)
			       (replace
 NEXT.BOUND of
 ITEM with
 STACK)
			       (change
 STACK ITEM)))

(PUTPROPS BOUNDARY.UNION MACRO
 (OPENLAMBDA (X Y)
					   (BOUNDARY.UNION* X (
AND
 (
OR
 (type?
 BOUNDARY Y)
								       (
\ILLEGAL.ARG
 Y))
								   (ffetch
 LEFT.BOUND of
 Y))
							    (ffetch
 BOTTOM.BOUND of
 Y)
							    (ffetch
 RIGHT.BOUND of
 Y)
							    (ffetch
 TOP.BOUND of
 Y))))

(PUTPROPS BOUNDARY.UNION* MACRO
 (OPENLAMBDA (X Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)
					    (BOUNDARY.UNION**(
AND
 (
OR
 (type?
 BOUNDARY X)
								      (
\ILLEGAL.ARG
 X))
								  (ffetch
 LEFT.BOUND of
 X))
					      (ffetch
 BOTTOM.BOUND of
 X)
					      (ffetch
 RIGHT.BOUND of
 X)
					      (ffetch
 TOP.BOUND of
 X)
					      Y.LEFT Y.BOTTOM Y.RIGHT Y.TOP)))

(PUTPROPS BOUNDARY.UNION** MACRO
 (OPENLAMBDA (X.LEFT X.BOTTOM X.RIGHT X.TOP Y.LEFT Y.BOTTOM Y.RIGHT 
						     Y.TOP)
                                                             (* mgb: "21-Oct-84 20:28")

					     (
BOUNDARY.CREATE
 (
IMIN
 X.LEFT Y.LEFT)
							      (
IMIN
 X.BOTTOM Y.BOTTOM)
							      (
IMAX
 X.RIGHT Y.RIGHT)
							      (
IMAX
 X.TOP Y.TOP))))
)

(PUTPROPS BOUNDARY.FREELIST GLOBALVAR
 T)

(RPAQQ BOUNDARY.FREELIST
 NIL)
(DEFINEQ

(BOUNDARY.CREATE

  [LAMBDA (LEFT BOTTOM RIGHT TOP NEXT)                       (* mgb: "21-Oct-84 20:38")

    (DECLARE
 (LOCALVARS . T))
    (COND
      (BOUNDARY.FREELIST (create
 BOUNDARY
				 LEFT.BOUND ← LEFT
				 BOTTOM.BOUND ← BOTTOM
				 RIGHT.BOUND ← RIGHT
				 TOP.BOUND ← TOP
				 NEXT.BOUND ← NEXT smashing
 (BOUNDARY.POP BOUNDARY.FREELIST)))
      (T (create
 BOUNDARY
		 LEFT.BOUND ← LEFT
		 BOTTOM.BOUND ← BOTTOM
		 RIGHT.BOUND ← RIGHT
		 TOP.BOUND ← TOP
		 NEXT.BOUND ← NEXT])

(BOUNDARY.DIFFERENCE

  [LAMBDA (OUTER INNER)                                      (* mgb: "21-Oct-84 20:52")

    (DECLARE
 (LOCALVARS . T))
    (AND (OR (type?
 BOUNDARY OUTER)
	     (\ILLEGAL.ARG OUTER))
	 (OR (type?
 BOUNDARY INNER)
	     (\ILLEGAL.ARG INNER))
	 (PROG ((O.L (ffetch
 LEFT.BOUND of
 OUTER))
		(O.B (ffetch
 BOTTOM.BOUND of
 OUTER))
		(O.R (ffetch
 RIGHT.BOUND of
 OUTER))
		(O.T (ffetch
 TOP.BOUND of
 OUTER))
		(I.L (ffetch
 LEFT.BOUND of
 INNER))
		(I.B (ffetch
 BOTTOM.BOUND of
 INNER))
		(I.R (ffetch
 RIGHT.BOUND of
 INNER))
		(I.T (ffetch
 TOP.BOUND of
 INNER))
		RESULT)
	       [COND
		 ((NEQ O.L I.L)
		   (SETQ RESULT (BOUNDARY.CREATE
 O.L O.B I.L O.T RESULT]
	       [COND
		 ((NEQ O.R I.R)
		   (SETQ RESULT (BOUNDARY.CREATE
 I.R O.B O.R O.T RESULT]
	       [COND
		 ((NEQ O.B I.B)
		   (SETQ RESULT (BOUNDARY.CREATE
 I.L O.B I.R I.B RESULT]
	       [COND
		 ((NEQ O.T I.T)
		   (SETQ RESULT (BOUNDARY.CREATE
 I.L I.T I.R O.T RESULT]
	       (RETURN RESULT])

(BOUNDARY.MERGE

  [LAMBDA (OLD.BOUNDARIES NEW.BOUNDARIES)                    (* mgb: "23-Oct-84 18:25")


          (* * Warning: Members of NEW.BOUNDARIES may be smashed)




          (* * Since head of OLD.BOUNDARIES comes from NEW.BOUNDARIES and Y walks tail before P and both NEW.BOUNDARIES and 

	  Y are type-checked P need not be checked)



    (DECLARE
 (LOCALVARS . T))
    [for
 (X ← NEW.BOUNDARIES) while
 X by
 NEXT bind
 NEXT
       do
 (COND
	    [(type?
 BOUNDARY X)
	      (SETQ NEXT (fetch
 NEXT.BOUND of
 X))
	      (COND
		[OLD.BOUNDARIES
		  (AND (OR (type?
 BOUNDARY OLD.BOUNDARIES)
			   (\ILLEGAL.ARG OLD.BOUNDARIES))
		       (PROG ((XL (ffetch
 LEFT.BOUND of
 X))
			      (XB (ffetch
 BOTTOM.BOUND of
 X))
			      (XR (ffetch
 RIGHT.BOUND of
 X))
			      (XT (ffetch
 TOP.BOUND of
 X)))
			     (BOUNDARY.PUSH OLD.BOUNDARIES X)
			     (bind
 BUSY while
 (ffetch
 NEXT.BOUND of
 OLD.BOUNDARIES)
				do
 (SETQ BUSY NIL) 

          (* * DANGER: Acute optimisation)



				   [bind
 Y YL YB for
 (P ← OLD.BOUNDARIES) by
 Y
				      while
 (SETQ Y (ffetch
 NEXT.BOUND of
 P))
				      do
 (AND (OR (type?
 BOUNDARY Y)
						  (\ILLEGAL.ARG Y))
					      (COND
						([PROGN (SETQ YB (ffetch
 BOTTOM.BOUND of
 Y))
							(COND
							  [(AND (EQ XL (SETQ YL
								      (ffetch
 LEFT.BOUND
									 of
 Y)))
								(EQ XR (ffetch
 RIGHT.BOUND
									  of
 Y)))
							    (COND
							      [(EQ XT YB)
								(freplace
 TOP.BOUND of
 X
								   with
 (SETQ XT
									  (ffetch
 TOP.BOUND
									     of
 Y]
							      ((EQ (ffetch
 TOP.BOUND of
 Y)
								   XB)
								(freplace
 BOTTOM.BOUND of
 X
								   with
 (SETQ XB YB]
							  ((AND (EQ XB YB)
								(EQ XT (ffetch
 TOP.BOUND
									  of
 Y)))
							    (COND
							      [(EQ XR YL)
								(freplace
 RIGHT.BOUND of
 X
								   with
 (SETQ XR
									  (ffetch
 RIGHT.BOUND
									     of
 Y]
							      ((EQ (ffetch
 RIGHT.BOUND of
 Y)
								   XL)
								(freplace
 LEFT.BOUND of
 X
								   with
 (SETQ XL YL]
						  (freplace
 NEXT.BOUND of
 P
						     with
 (fetch
 NEXT.BOUND of
 Y))
						  (freplace
 NEXT.BOUND of
 Y with
 NIL)
						  (BOUNDARY.RELEASE
 Y)
						  (SETQ BUSY T)
						  (RETURN]
				repeatwhile
 BUSY]
		(T (freplace
 NEXT.BOUND of
 X with
 NIL)
		   (SETQ OLD.BOUNDARIES X]
	    (T (\ILLEGAL.ARG X]
    OLD.BOUNDARIES])

(BOUNDARY.RELEASE

  [LAMBDA (BOUNDARIES)                                       (* mgb: "24-Oct-84 15:45")

    (DECLARE
 (LOCALVARS . T))
    (for
 (B ← BOUNDARIES) by
 NEXT while
 B bind
 NEXT
       do
 (NEXT←B:NEXT.BOUND)
	  (BOUNDARY.PUSH BOUNDARY.FREELIST B])
)
(PUTPROPS BOUNDARY COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (5120 9616 (BOUNDARY.CREATE 5130 . 5640) (BOUNDARY.DIFFERENCE 5642 . 6707) (
BOUNDARY.MERGE 6709 . 9323) (BOUNDARY.RELEASE 9325 . 9614)))))
STOP