(FILECREATED "20-Jul-86 15:26:18" {ERIS}<TAMARIN>UCODE>CIFGEN.;17 6663   

      changes to:  (FNS ChipWire ChipSymCall ChipHdrFile)

      previous date: "16-Jun-86 21:58:11" {ERIS}<TAMARIN>UCODE>CIFGEN.;10)


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

(PRETTYCOMPRINT CIFGENCOMS)

(RPAQQ CIFGENCOMS ((FNS ChipHdr ChipHdrFile ChipString ChipSymCall ChipTrailer ChipWire CifSymbol 
			  CifWire GetFile TryMake WriteWord)
		     (INITVARS xWIN)))
(DEFINEQ

(ChipHdr
  [LAMBDA (file)                                             (* agb: "16-Jun-86 20:26")
    (SETQ chipStream (GETSTREAM (OUTPUT (OUTFILE file))
				    (QUOTE OUTPUT)))
    (SETQ chipObjects 0)
    (WriteWord 42985)
    (WriteWord 4)
    (WriteWord 1)
    (WriteWord 1)
    (WriteWord 854)
    (WriteWord 18753)
    (WriteWord 8)
    (WriteWord 8)
    (WriteWord 0)
    (WriteWord 1)
    (ChipWire 3 4 0 0 4 0)
    (SETQ chipObjects 0)
    (SETQ chipObCntLoc (GETFILEPTR chipStream))
    (WriteWord 0])

(ChipHdrFile
  [LAMBDA (file lst)                                         (* agb: "16-Jul-86 20:35")
    (if file
	then (SETQ ChipMapLst (ParseChipFile lst))
	       (SETQ chipStream (GETSTREAM (OUTPUT (OUTFILE file))
					       (QUOTE OUTPUT)))
	       (SETQ chipObjects 0)
	       (for i in lst do (WriteWord i))
	       (SETQ chipObjects 0)
	       (SETQ chipObCntLoc (PLUS -2 (GETFILEPTR chipStream)))
      else (SETQ chipStream NIL])

(ChipString
  [LAMBDA (string)                                           (* agb: "27-May-86 22:38")
    (PROG (len)
	    (SETQ len (NCHARS string))
	    [WriteWord (LOGOR (LLSH len 8)
				  (CHCON1 (SUBSTRING string 1 1]
	    [for i from 2 to (DIFFERENCE len 1) by 2
	       do (WriteWord (LOGOR (LLSH (CHCON1 (SUBSTRING string i i))
						  8)
					  (CHCON1 (SUBSTRING string (ADD1 i)
								 (ADD1 i]
	    (if (EVENP len)
		then (WriteWord (LLSH (CHCON1 (SUBSTRING string len len))
					    8])

(ChipSymCall
  [LAMBDA (name x y orient)                                  (* agb: "17-Jul-86 14:13")
    (PROG (nbr cell)
	    (if (NUMBERP name)
		then (SETQ nbr name)
	      else [SETQ cell (ASSOC name (OR ChipMapLst (QUOTE ((ZCELL 6)
									    (DCELL 5)
									    (OCELL 4)
									    (GCELL 3)
									    (VIA 2)
									    (PCELL 1]
		     (SETQ nbr (CADR cell)))
	    (if (NOT orient)
		then (SETQ orient 0))
	    (if chipStream
		then (WriteWord (PLUS (if (EQ orient 1)
						then (MINUS (OR (CADDDR cell)
								      0))
					      elseif (EQ orient 2)
						then (MINUS (OR (CADDR cell)
								      0))
					      else 0)
					    (TIMES x 2)))
		       (WriteWord (PLUS (if (EQ orient 2)
						then (MINUS (OR (CADDDR cell)
								      0))
					      elseif (EQ orient 3)
						then (MINUS (OR (CADDR cell)
								      0))
					      else 0)
					    (TIMES y 2)))
		       (WriteWord (TIMES 4 orient))
		       (WriteWord 1)
		       (WriteWord nbr)
		       (WriteWord 0)
		       (SETQ chipObjects (ADD1 chipObjects])

(ChipTrailer
  [LAMBDA NIL                                                (* agb: "26-May-86 10:16")
    (if chipStream
	then (SETFILEPTR chipStream chipObCntLoc)
	       (WriteWord chipObjects)
	       (SETFILEPTR chipStream -1)
	       (CLOSEF chipStream])

(ChipWire
  [LAMBDA (type width x1 y1 x2 y2 name)                      (* agb: "17-Jul-86 19:39")
    (if chipStream
	then (if (IGREATERP x1 x2)
		   then (SETQ t1 x1)
			  (SETQ x1 x2)
			  (SETQ x2 t1))
	       (if (IGREATERP y1 y2)
		   then (SETQ t1 y1)
			  (SETQ y1 y2)
			  (SETQ y2 t1))
	       (SETQ x1 (TIMES 2 x1))
	       (SETQ x2 (TIMES 2 x2))
	       (SETQ y1 (TIMES 2 y1))
	       (SETQ y2 (TIMES 2 y2))
	       (WriteWord x1)
	       (WriteWord y1)
	       (if (EQ x1 x2)
		   then (WriteWord 0)
			  (WriteWord 4)
			  (WriteWord (TIMES width 2))
			  (WriteWord (DIFFERENCE y2 y1))
		 elseif (EQ y1 y2)
		   then (WriteWord 4)
			  (WriteWord 4)
			  (WriteWord (TIMES width 2))
			  (WriteWord (DIFFERENCE x2 x1))
		 else (HELP))
	       (WriteWord type)
	       (if name
		   then (WriteWord 1)
			  (WriteWord 1)
			  (ChipString (U-CASE name))
		 else (WriteWord 0))
	       (SETQ chipObjects (ADD1 chipObjects)))
    (CifWire type x1 y1 x2 y2])

(CifSymbol
  [LAMBDA (nbr x y)                                          (* edited: " 2-Dec-85 21:00")
    NIL])

(CifWire
  [LAMBDA (type x1 y1 x2 y2)                                 (* agb: "26-May-86 10:15")
    (if xWIN
	then (DRAWLINE (QUOTIENT x1 2)
			   y1
			   (QUOTIENT x2 2)
			   y2 NIL NIL xWIN))                 (* PRINTOUT cifFile "L N" type ";"
							     T)

          (* IF (EQ y1 y2) THEN (PRINTOUT cifFile "B " (TIMES 2 (ABS (DIFFERENCE x2 x1))), "8", (PLUS x1 x2), 
	  (TIMES y1 2) ";" T) ELSEIF (EQ x1 x2) THEN (PRINTOUT cifFile "B ", "8", (TIMES 2 (ABS (DIFFERENCE y2 y1))), 
	  (TIMES x1 2), (PLUS y1 y2) ";" T) ELSE (HELP))


    ])

(GetFile
  [LAMBDA (fl)                                               (* agb: "25-May-86 23:01")
    (PROG (val file)
	    (SETQ file (INPUT (INFILE fl)))
	    [SETQ val (until (EOFP file) collect (LOGOR (LLSH (BIN file)
									  8)
								  (BIN file]
	    (CLOSEF file)
	    (RETURN val])

(TryMake
  [LAMBDA (muxSpec file)                                     (* agb: "27-May-86 22:58")
    (ChipHdr file)
    (ChipWire 3 6 0 0 100 0 "TESTNAME")
    (ChipWire 3 3 20 0 20 60 "FOO")
    (ChipTrailer])

(WriteWord
  [LAMBDA (wrd)                                              (* edited: " 3-Dec-85 14:53")
    (BOUT chipStream (LOGAND 255 (LRSH wrd 8)))
    (BOUT chipStream (LOGAND 255 wrd])
)

(RPAQ? xWIN NIL)
(PUTPROPS CIFGEN COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (481 6564 (ChipHdr 491 . 1094) (ChipHdrFile 1096 . 1624) (ChipString 1626 . 2252) (
ChipSymCall 2254 . 3540) (ChipTrailer 3542 . 3832) (ChipWire 3834 . 5033) (CifSymbol 5035 . 5154) (
CifWire 5156 . 5749) (GetFile 5751 . 6108) (TryMake 6110 . 6344) (WriteWord 6346 . 6562)))))
STOP