From 5ced0fdfbbfff78e7fce9446628c15e552cab8a9 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 21 Jan 1997 00:30:28 +0000
Subject: [PATCH] source kit 1.03.7

---
 assembly/x86/alloc.lisp      |   70 ++
 assembly/x86/arith.lisp      |  318 ++++++
 assembly/x86/array.lisp      |  146 +++
 assembly/x86/assem-rtns.lisp |  290 ++++++
 assembly/x86/bit-bash.lisp   |    1 +
 assembly/x86/kludges.lisp    |   66 ++
 assembly/x86/support.lisp    |   62 ++
 lisp/Config.FreeBSD          |   19 +
 lisp/Config.linux            |   20 +
 lisp/FreeBSD-os.c            |  259 +++++
 lisp/FreeBSD-os.h            |   41 +
 lisp/GNUmakefile             |   14 +-
 lisp/Linux-os.c              |  274 +++++
 lisp/Linux-os.h              |   76 ++
 lisp/WARNING.files           |    9 +
 lisp/alloc.c                 |   16 +-
 lisp/cgc.c                   | 1902 ++++++++++++++++++++++++++++++++++
 lisp/cgc.h                   |    7 +
 lisp/coreparse.c             |   14 +-
 lisp/dynbind.c               |    4 +-
 lisp/globals.c               |   10 +-
 lisp/globals.h               |   20 +-
 lisp/interr.c                |    6 +-
 lisp/interrupt.c             |   86 +-
 lisp/linux-stubs.S           |  171 +++
 lisp/lisp.c                  |   27 +-
 lisp/lisp.h                  |   10 +-
 lisp/monitor.c               |   43 +-
 lisp/os.h                    |   10 +-
 lisp/parse.c                 |   12 +-
 lisp/print.c                 |   30 +-
 lisp/purify.c                |  258 ++++-
 lisp/save.c                  |   27 +-
 lisp/undefineds.h            |   25 +-
 lisp/validate.c              |    6 +-
 lisp/x86-arch.c              |  329 ++++++
 lisp/x86-assem.S             |  438 ++++++++
 lisp/x86-lispregs.h          |   45 +
 lisp/x86-validate.h          |   29 +
 39 files changed, 5064 insertions(+), 126 deletions(-)
 create mode 100644 assembly/x86/alloc.lisp
 create mode 100644 assembly/x86/arith.lisp
 create mode 100644 assembly/x86/array.lisp
 create mode 100644 assembly/x86/assem-rtns.lisp
 create mode 100644 assembly/x86/bit-bash.lisp
 create mode 100644 assembly/x86/kludges.lisp
 create mode 100644 assembly/x86/support.lisp
 create mode 100644 lisp/Config.FreeBSD
 create mode 100644 lisp/Config.linux
 create mode 100644 lisp/FreeBSD-os.c
 create mode 100644 lisp/FreeBSD-os.h
 create mode 100644 lisp/Linux-os.c
 create mode 100644 lisp/Linux-os.h
 create mode 100644 lisp/WARNING.files
 create mode 100644 lisp/cgc.c
 create mode 100644 lisp/cgc.h
 create mode 100644 lisp/linux-stubs.S
 create mode 100644 lisp/x86-arch.c
 create mode 100644 lisp/x86-assem.S
 create mode 100644 lisp/x86-lispregs.h
 create mode 100644 lisp/x86-validate.h

diff --git a/assembly/x86/alloc.lisp b/assembly/x86/alloc.lisp
new file mode 100644
index 000000000..e94733450
--- /dev/null
+++ b/assembly/x86/alloc.lisp
@@ -0,0 +1,70 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/alloc.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;; Stuff to handle allocating simple objects.
+;;;
+;;; Written by William Lott.
+;;;
+;;; Debugged by Paul F. Werkowski -- Spring 1995.
+;;;
+(in-package :x86)
+
+
+;;;; From from signed/unsigned
+
+#+assembler ; we don't want a vop for this one.
+(define-assembly-routine
+    (move-from-signed)
+    ((:temp eax dword-reg eax-offset)
+     (:temp ebx dword-reg ebx-offset)
+     (:temp ecx dword-reg ecx-offset))
+  (inst mov ebx eax)
+  (inst shl ebx 1)
+  (inst jmp :o bignum)
+  (inst shl ebx 1)
+  (inst jmp :o bignum)
+  (inst ret)
+  BIGNUM
+
+  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
+    (storew eax ebx bignum-digits-offset other-pointer-type))
+
+  (inst ret))
+
+#+assembler ; we don't want a vop for this one either.
+(define-assembly-routine
+  (move-from-unsigned)
+  ((:temp eax dword-reg eax-offset)
+   (:temp ebx dword-reg ebx-offset)
+   (:temp ecx dword-reg ecx-offset))
+
+  (inst test eax #xe0000000)
+  (inst jmp :nz bignum)
+  ;; Fixnum
+  (inst mov ebx eax)
+  (inst shl ebx 2)
+  (inst ret)
+
+  BIGNUM
+  (inst jmp :ns one-word-bignum)
+  (inst mov ebx eax)
+
+  ;; Two word bignum
+  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 2))
+    (storew eax ebx bignum-digits-offset other-pointer-type))
+  (inst ret)
+  
+  ONE-WORD-BIGNUM
+  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
+    (storew eax ebx bignum-digits-offset other-pointer-type))
+  (inst ret))
diff --git a/assembly/x86/arith.lisp b/assembly/x86/arith.lisp
new file mode 100644
index 000000000..38e2657cb
--- /dev/null
+++ b/assembly/x86/arith.lisp
@@ -0,0 +1,318 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;; Stuff to handle simple cases for generic arithmetic.
+;;;
+;;; Written by William Lott.
+;;; Debugged by Paul Werkowski -- Spring/Summer 1995.
+;;;
+(in-package :x86)
+
+(eval-when (compile eval)
+
+
+;;;; Addition, Subtraction, and Multiplication
+
+(defmacro define-generic-arith-routine ((fun cost) &body body)
+  `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
+			     (:cost ,cost)
+			     (:return-style :full-call)
+			     (:translate ,fun)
+			     (:policy :safe)
+			     (:save-p t))
+			    ((:arg x (descriptor-reg any-reg) edx-offset)
+			     (:arg y (descriptor-reg any-reg)
+			      ;; this seems wrong esi-offset
+			      edi-offset)
+
+			     (:res res (descriptor-reg any-reg) edx-offset)
+
+			     (:temp eax dword-reg eax-offset)
+			     (:temp ebx dword-reg ebx-offset)
+			     (:temp ecx dword-reg ecx-offset))
+    ;; for now, pass this off
+    ;; (inst jmp DO-STATIC-FUN)
+    ;; ebx ; ignorable
+    (inst test x 3)			; fixnum?
+    (inst jmp :nz DO-STATIC-FUN)	; no - do generic
+    (inst test y 3)			; fixnum?
+    (inst jmp :z DO-BODY)		; yes - doit here
+
+    DO-STATIC-FUN
+    (inst pop eax)
+    (inst push ebp-tn)
+    (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+    (inst sub esp-tn (fixnum 3))	; pw -- was 2
+    (inst push eax)			; callers return addr
+    (inst mov ecx (fixnum 2))		; arg count
+
+    (inst mov ebx
+     (make-ea :dword
+      :disp (+ nil-value (static-function-offset
+			  ',(symbolicate "TWO-ARG-" fun)))))
+    
+    (inst jmp ebx)
+    
+    DO-BODY
+    ,@body))
+
+); eval-when
+
+
+(define-generic-arith-routine (+ 10)
+  (move res x)
+  (inst add res y)
+  (inst jmp :no OKAY)
+  (inst rcr res 1)			; carry has correct sign
+  (inst sar res 1)			; remove type bits
+
+  (move ecx res)
+
+  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
+    (storew ecx res bignum-digits-offset other-pointer-type))
+
+  
+  OKAY)
+
+
+(define-generic-arith-routine (- 10)
+    ;;; I can't figure out the flags on subtract. Overflow never gets
+    ;;; set and carry always does. (- 0 most-negative-fixnum) can't be
+    ;;; easily detected so just let the upper level stuff do it.
+  (inst jmp DO-STATIC-FUN)
+  
+  (move res x)
+  (inst sub res y)
+  (inst jmp :no OKAY)
+  (inst rcr res 1)
+  (inst sar res 1)			; remove type bits
+  
+  (move ecx res)
+  
+  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
+    (storew ecx res bignum-digits-offset other-pointer-type))
+  OKAY)
+
+(define-generic-arith-routine (* 30)
+  (move eax x)				; must use eax for 64-bit result
+  (inst sar eax 2)			; remove *4 fixnum bias
+  (inst imul y)				; result in edx:eax
+  (inst jmp :no okay)			; still fixnum
+
+  ;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
+  ;;     pfw says that loses big -- edx is target for arg x and result res
+  ;;     note that 'edx' is not defined -- using x
+  (inst shrd eax x 2)			; high bits from edx
+  (inst sar x 2)			; now shift edx too
+
+  (move ecx x)				; save high bits from cdq
+  (inst cdq)				; edx:eax <- sign-extend of eax
+  (inst cmp x ecx)
+  (inst jmp :e SINGLE-WORD-BIGNUM)
+
+  (with-fixed-allocation (res ebx bignum-type (+ bignum-digits-offset 2))
+    (storew eax res bignum-digits-offset other-pointer-type)
+    (storew ecx res (1+ bignum-digits-offset) other-pointer-type))
+  (inst jmp DONE)
+
+  SINGLE-WORD-BIGNUM
+  
+  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
+    (storew eax res bignum-digits-offset other-pointer-type))
+  (inst jmp DONE)
+
+  OKAY
+  (move res eax)
+  DONE)
+
+(define-assembly-routine (generic-negate
+			  (:cost 10)
+			  (:return-style :full-call)
+			  (:policy :safe)
+			  (:translate %negate)
+			  (:save-p t))
+			 ((:arg x (descriptor-reg any-reg) edx-offset)
+			  (:res res (descriptor-reg any-reg) edx-offset)
+
+			  (:temp eax dword-reg eax-offset)
+			  (:temp ecx dword-reg ecx-offset))
+  (inst test x 3)
+  (inst jmp :z FIXNUM)
+
+  (inst pop eax)
+  (inst push ebp-tn)
+  (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+  (inst sub esp-tn (fixnum 3))		; pw -- was 2
+  (inst push eax)
+  (inst mov ecx (fixnum 1))		; arg count
+
+  (inst mov eax (make-ea
+		 :dword
+		 :disp (+ nil-value (static-function-offset '%negate))))
+  (inst jmp eax)
+  
+  FIXNUM
+  (move res x)
+  (inst neg res)			; (- most-negative-fixnum) is BIGNUM
+  (inst jmp :no OKAY)
+  (inst shr res 2)			; sign bit is data - remove type bits
+  (move ecx res)
+
+  (with-fixed-allocation (res eax bignum-type (1+ bignum-digits-offset))
+    (storew ecx res bignum-digits-offset other-pointer-type))
+
+  
+  OKAY)
+
+
+
+;;;; Comparison routines.
+
+(eval-when (compile eval)
+
+(defmacro define-cond-assem-rtn (name translate static-fn test)
+  `(define-assembly-routine (,name
+			     (:cost 10)
+			     (:return-style :full-call)
+			     (:policy :safe)
+			     (:translate ,translate)
+			     (:save-p t))
+			    ((:arg x (descriptor-reg any-reg) edx-offset)
+			     (:arg y (descriptor-reg any-reg)
+			      #+nil esi-offset
+			      edi-offset)
+			     
+			     (:res res descriptor-reg edx-offset)
+
+			     (:temp eax dword-reg eax-offset)
+			     (:temp ecx dword-reg ecx-offset)
+			     )
+    (inst test x 3)
+    (inst jmp :nz DO-STATIC-FN)
+    (inst test y 3)
+    (inst jmp :z DO-COMPARE)
+    
+    DO-STATIC-FN
+    (inst pop eax)
+    (inst push ebp-tn)
+    (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+    (inst sub esp-tn (fixnum 3))	; pw -- was 2
+    (inst push eax)
+    (inst mov ecx (fixnum 2))
+    (inst mov eax (make-ea
+		   :dword
+		   :disp (+ nil-value (static-function-offset ',static-fn))))
+    (inst jmp eax)
+    
+     DO-COMPARE
+     (inst cmp x y)
+     (inst jmp ,test TRUE)
+     (inst mov res nil-value)
+     (inst pop eax)
+     (inst add eax 2)
+     (inst jmp eax)
+
+     TRUE
+     (inst mov res t-value)))
+
+); eval-when
+
+(define-cond-assem-rtn generic-< < two-arg-< :l)
+(define-cond-assem-rtn generic-> > two-arg-> :g)
+
+#+pfw-obsolete????
+(define-assembly-routine (generic-eql
+			  (:cost 10)
+			  (:return-style :full-call)
+			  (:policy :safe)
+			  (:translate eql)
+			  (:save-p t))
+			 ((:arg x (descriptor-reg any-reg) edx-offset)
+			  (:arg y (descriptor-reg any-reg) esi-offset)
+			  
+			  (:res res descriptor-reg edx-offset)
+			  
+			  (:temp eax dword-reg eax-offset)	; zzz added by jrd
+			  (:temp ecx dword-reg ecx-offset)	; zzz added by jrd
+			  )
+  (inst cmp x y)
+  (inst jmp :e RETURN-T)
+  (inst test x 3)
+  (inst jmp :z RETURN-NIL)
+  (inst test y 3)
+  (inst jmp :nz DO-STATIC-FN)
+
+  RETURN-NIL
+  (inst mov res nil-value)
+  (inst pop eax)
+  (inst add eax 2)
+  (inst jmp eax)
+
+  DO-STATIC-FN
+  (inst pop eax)
+  (inst push ebp-tn)
+  (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+  (inst sub esp-tn (fixnum 3))		; pw -- was 2
+  (inst push eax)
+  (inst mov ecx (fixnum 2))
+  (inst mov eax (make-ea :dword
+			 :disp (+ nil-value
+				  (static-function-offset 'two-arg-eql))))
+  (inst jmp eax)
+  
+  RETURN-T
+  (inst mov res t-value))
+
+(define-assembly-routine (generic-=
+			  (:cost 10)
+			  (:return-style :full-call)
+			  (:policy :safe)
+			  (:translate =)
+			  (:save-p t))
+			 ((:arg x (descriptor-reg any-reg) edx-offset)
+			  (:arg y (descriptor-reg any-reg)
+				#+nil esi-offset
+				edi-offset)
+			  
+			  (:res res descriptor-reg edx-offset)
+			  
+			  (:temp eax dword-reg eax-offset)
+			  (:temp ecx dword-reg ecx-offset)
+			  )
+  (inst test x 3)			; descriptor?
+  (inst jmp :nz DO-STATIC-FN)		; yes do it here
+  (inst test y 3)			; descriptor?
+  (inst jmp :nz DO-STATIC-FN)
+  (inst cmp x y)
+  (inst jmp :e RETURN-T)		; ok
+
+  (inst mov res nil-value)
+  (inst pop eax)
+  (inst add eax 2)
+  (inst jmp eax)
+
+  DO-STATIC-FN
+  (inst pop eax)
+  (inst push ebp-tn)
+  (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
+  (inst sub esp-tn (fixnum 3))		; pw -- was 2
+  (inst push eax)
+  (inst mov ecx (fixnum 2))
+  (inst mov eax (make-ea
+		 :dword
+		 :disp (+ nil-value (static-function-offset 'two-arg-=))))
+  (inst jmp eax)
+  
+  RETURN-T
+  (load-symbol res t))
+
diff --git a/assembly/x86/array.lisp b/assembly/x86/array.lisp
new file mode 100644
index 000000000..121fab90f
--- /dev/null
+++ b/assembly/x86/array.lisp
@@ -0,0 +1,146 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;; This file contains various array operations that are too expensive
+;;; (in space) to do inline.
+;;;
+;;; Written by William Lott.
+;;;
+;;; Debugged by Paul F. Werkowski -- Spring 1995.
+;;;
+(in-package :x86)
+
+
+;;;; Allocation
+
+(define-assembly-routine (allocate-vector
+			  (:policy :fast-safe)
+			  (:translate allocate-vector)
+			  (:arg-types positive-fixnum
+				      positive-fixnum
+				      positive-fixnum))
+			 ((:arg type unsigned-reg eax-offset)
+			  (:arg length any-reg ebx-offset)
+			  (:arg words any-reg ecx-offset)
+			  (:res result descriptor-reg edx-offset)
+
+			  (:temp alloc dword-reg edi-offset))
+  #-cgc
+  (with-allocation (alloc)
+    (inst lea result (make-ea :byte :base alloc :disp other-pointer-type))
+    (inst add alloc
+	  (+ (1- (ash 1 lowtag-bits)) (* vector-data-offset word-bytes)))
+    (inst add alloc words)
+    (inst and alloc (lognot vm:lowtag-mask)))
+  #+cgc
+  (progn
+    (inst mov alloc (+ (1- (ash 1 lowtag-bits))
+		       (* vector-data-offset word-bytes)))
+    (inst add alloc words)
+    (inst and alloc (lognot vm:lowtag-mask))
+    (with-cgc-allocation(alloc alloc)
+      (inst lea result (make-ea :byte :base alloc :disp other-pointer-type))))
+  (storew type result 0 other-pointer-type)
+  (storew length result vector-length-slot other-pointer-type)
+  (inst ret))
+
+
+
+;;;; Hash primitives
+
+(define-assembly-routine (sxhash-simple-string
+			  (:translate %sxhash-simple-string)
+			  (:policy :fast-safe)
+			  (:result-types positive-fixnum))
+			 ((:arg string descriptor-reg ebx-offset)
+			  (:res result any-reg edx-offset)
+
+			  (:temp length any-reg edi-offset)
+			  (:temp esi dword-reg esi-offset)
+			  (:temp ecx dword-reg ecx-offset)
+			  (:temp eax dword-reg eax-offset))
+  (declare (ignore result esi ecx eax))
+  (loadw length string vector-length-slot other-pointer-type)
+  ;; zzzzz this appears to be busted
+  ;; (inst jmp nil (make-fixup 'sxhash-simple-substring :assembly-routine))
+  ;; just fall through???
+  )
+
+(define-assembly-routine (sxhash-simple-substring
+			  (:translate %sxhash-simple-substring)
+			  (:policy :fast-safe)
+			  (:arg-types * positive-fixnum)
+			  (:result-types positive-fixnum))
+			 ((:arg string descriptor-reg ebx-offset)
+			  (:arg length any-reg edi-offset)
+			  (:res result any-reg edx-offset)
+
+			  (:temp esi dword-reg esi-offset)
+			  (:temp ecx dword-reg ecx-offset)
+			  (:temp eax dword-reg eax-offset))
+  ;; Compute a pointer to where we are going to be extracting the bits.
+  (inst lea esi
+	(make-ea :byte :base string
+		 :disp (- (* vector-data-offset word-bytes)
+			  other-pointer-type)))
+  ;; Initialize the result.
+  (inst mov result 0)
+  ;; Get the count.  If it's zero, blow out.
+  (inst mov ecx length)
+  (inst jecxz done)
+  ;; Convert it into count of the number of full words.  If zero, then skip
+  ;; to the part that handles the tail.
+  (inst shr ecx 4)
+  (inst jecxz do-extra)
+  ;; Clear the direction flag, so we advance through memory.
+  (inst cld)
+
+  LOOP
+  ;; Merge each successive word with the result.
+  ;; ZZZZZ undef inst???
+  (inst lods eax)			; load 32-bits into eax and (+4 esi)
+
+  (inst rol result 5)
+  (inst xor result eax)
+  (inst loop loop)
+
+  DO-EXTRA
+  ;; Now we have to take care of any bytes that don't make up a full word.
+  ;; First, check to see how many of them there are.  If zero, blow out of
+  ;; here.  Otherwise, multiply by 8.
+  (inst mov ecx length)
+  (inst and ecx (fixnum 3))
+  (inst jecxz done)
+  (inst shl ecx 1)
+
+  ;; Grab the last word.
+  ;; ZZZZZ undef isnt?
+  (inst lods eax)
+
+  ;; Convert the count into a mask.  The count is multiplied by 8, so we just
+  ;; shift -1 left, which shifts count*8 zeros into the low order end.  We
+  ;; then invert that, ending up with a mask of count*8 ones.
+  (inst mov esi -1)
+  (inst shl esi :cl)
+  (inst not esi)
+  ;; Use the mask to strip off the bits we arn't interested in, and merge
+  ;; the remaining bits with the result.
+  (inst and eax esi)
+  (inst rol result 5)
+  (inst xor result eax)
+
+  DONE
+
+  ;; Force result to be a positive fixnum.
+  (inst and result #x7ffffffc)
+  (inst ret))
diff --git a/assembly/x86/assem-rtns.lisp b/assembly/x86/assem-rtns.lisp
new file mode 100644
index 000000000..648422106
--- /dev/null
+++ b/assembly/x86/assem-rtns.lisp
@@ -0,0 +1,290 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;; 
+;;; This file contains the machine specific support routines needed by
+;;; the file assembler.
+;;;
+;;; Written by William Lott
+;;;
+;;; Debugged by Paul F. Werkowski -- Spring/Summer 1995.
+;;;
+(in-package :x86)
+
+
+;;;; Return-multiple
+
+;;; For return-multiple, we have to move the results from the end of the
+;;; frame for the function that is returning to the end of the frame for
+;;; the function being returned to.
+
+#+assembler ;; we don't want a vop for this one.
+(define-assembly-routine
+    (return-multiple (:return-style :none))
+    (;; These four are really arguments.
+     (:temp eax dword-reg eax-offset)
+     (:temp ebx dword-reg ebx-offset)
+     (:temp ecx dword-reg ecx-offset)
+     (:temp esi dword-reg esi-offset)
+
+     ;; These we need as temporaries.
+     (:temp edx dword-reg edx-offset)
+     (:temp edi dword-reg edi-offset))
+     
+  ;; Pick off the cases where everything fits in register args.
+  (inst jecxz zero-values)
+  (inst cmp ecx (fixnum 1))
+  (inst jmp :e one-value)
+  (inst cmp ecx (fixnum 2))
+  (inst jmp :e two-values)
+  (inst cmp ecx (fixnum 3))
+  (inst jmp :e three-values)
+
+  ;; Save the count, because the loop is going to destroy it.
+  (inst mov edx ecx)
+
+  ;; Blit the values down the stack.  Note: there might be overlap, so we have
+  ;; to be careful not to clobber values before we've read them.  Because the
+  ;; stack builds down, we are coping to a larger address.  Therefore, we need
+  ;; to iterate from larger addresses to smaller addresses.
+  ;; pfw-this says copy ecx words from esi to edi counting down.
+  (inst shr ecx 2)			; fixnum to raw word count
+  (inst std)				; count down
+  (inst sub esi 4)			; ?
+  (inst lea edi (make-ea :dword :base ebx :disp (- word-bytes)))
+  (inst rep)
+  (inst movs :dword)
+
+  ;; Restore the count.
+  (inst mov ecx edx)
+
+  ;; Set the stack top to the last result.
+  (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))
+
+  ;; Load the register args.
+  (loadw edx ebx -1)
+  (loadw edi ebx -2)
+  (loadw esi ebx -3)
+
+  ;; And back we go.
+  (inst jmp eax)
+
+  ;; Handle the register arg cases.
+  ZERO-VALUES
+  (move esp-tn ebx)
+  (inst mov edx nil-value)
+  (inst mov edi edx)
+  (inst mov esi edx)
+  (inst jmp eax)
+
+  ONE-VALUE ; Note: we can get this, because the return-multiple vop
+	    ; doesn't check for this case when size > speed.
+  (loadw edx esi -1)
+  (inst mov esp-tn ebx)
+  (inst add eax 2)
+  (inst jmp eax)
+
+  TWO-VALUES
+  (loadw edx esi -1)
+  (loadw edi esi -2)
+  (inst mov esi nil-value)
+  (inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 word-bytes)))
+  (inst jmp eax)
+
+  THREE-VALUES
+  (loadw edx esi -1)
+  (loadw edi esi -2)
+  (loadw esi esi -3)
+  (inst lea esp-tn (make-ea :dword :base ebx :disp (* -3 word-bytes)))
+  (inst jmp eax))
+
+
+
+;;;; tail-call-variable.
+
+;;; For tail-call-variable, we have to copy the arguments from the end of our
+;;; stack frame (were args are produced) to the start of our stack frame
+;;; (were args are expected).
+;;;
+;;; We take the function to call in EAX and a pointer to the arguments in
+;;; ESI.  EBP says the same over the jump, and the old frame pointer is
+;;; still saved in the first stack slot.  The return-pc is saved in
+;;; the second stack slot, so we have to push it to make it look like
+;;; we actually called.  We also have to compute ECX from the difference
+;;; between ESI and the stack top.
+;;; 
+#+assembler ;; no vop for this one either.
+(define-assembly-routine
+    (tail-call-variable
+     (:return-style :none))
+
+    ((:temp eax dword-reg eax-offset)
+     (:temp ebx dword-reg ebx-offset)
+     (:temp ecx dword-reg ecx-offset)
+     (:temp edx dword-reg edx-offset)
+     (:temp edi dword-reg edi-offset)
+     (:temp esi dword-reg esi-offset))
+
+  ;; Calculate NARGS (as a fixnum)
+  (move ecx esi)
+  (inst sub ecx esp-tn)
+
+  ;; Check for all the args fitting the the registers.
+  (inst cmp ecx (fixnum 3))
+  (inst jmp :le REGISTER-ARGS)
+
+  ;; Save the OLD-FP and RETURN-PC because the blit it going to trash
+  ;; those stack locations.  Save the ECX, because the loop is going
+  ;; to trash it.
+  (pushw ebp-tn -1)
+  (loadw ebx ebp-tn -2)
+  (inst push ecx)
+
+  ;; Do the blit.  Because we are coping from smaller addresses to larger
+  ;; addresses, we have to start at the largest pair and work our way down.
+  (inst shr ecx 2)			; fixnum to raw words
+  (inst std)				; count down
+  (inst lea edi (make-ea :dword :base ebp-tn :disp (- word-bytes)))
+  (inst sub esi (fixnum 1))
+  (inst rep)
+  (inst movs :dword)
+
+  ;; Load the register arguments carefully.
+  (loadw edx ebp-tn -1)
+
+  ;; Restore OLD-FP and ECX.
+  (inst pop ecx)
+  (popw ebp-tn -1)			; overwrites a0
+
+  ;; Blow off the stack above the arguments.
+  (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))
+
+  ;; remaining register args
+  (loadw edi ebp-tn -2)
+  (loadw esi ebp-tn -3)
+
+  ;; Push the (saved) return-pc so it looks like we just called.
+  (inst push ebx)
+
+  ;; And jump into the function.
+    (inst jmp 
+	  (make-ea :byte :base eax
+		   :disp (- (* closure-function-slot word-bytes)
+			    function-pointer-type)))
+
+  ;; All the arguments fit in registers, so load them.
+  REGISTER-ARGS
+  (loadw edx esi -1)
+  (loadw edi esi -2)
+  (loadw esi esi -3)
+
+  ;; Clear most of the stack.
+  (inst lea esp-tn
+	(make-ea :dword :base ebp-tn :disp (* -3 word-bytes)))
+
+  ;; Push the return-pc so it looks like we just called.
+  (pushw ebp-tn -2)
+
+  ;; And away we go.
+;  (inst jmp-indirect
+;	(make-ea :byte :base eax :disp (- (* closure-function-slot word-bytes)
+;					  function-pointer-type)))
+  ;; -- jrd
+  (inst jmp
+	(make-ea :byte :base eax :disp (- (* closure-function-slot word-bytes)
+					  function-pointer-type)))
+  )
+
+
+
+(define-assembly-routine (throw
+			  (:return-style :none))
+			 ((:arg target (descriptor-reg any-reg) edx-offset)
+			  (:arg start any-reg ebx-offset)
+			  (:arg count any-reg ecx-offset)
+			  (:temp catch any-reg eax-offset))
+  
+  (declare (ignore start count))
+
+  (load-symbol-value catch lisp::*current-catch-block*)
+  
+  LOOP
+  
+  (let ((error (generate-error-code nil unseen-throw-tag-error target)))
+    (inst or catch catch)		; check for NULL pointer
+    (inst jmp :z error))
+  
+  (inst cmp target (make-ea-for-object-slot catch catch-block-tag-slot 0))
+  (inst jmp :e exit)
+  
+  (loadw catch catch catch-block-previous-catch-slot)
+  (inst jmp loop)
+  
+  EXIT
+
+  
+  ;; hear eax points to catch block containing symbol pointed to by edx
+  ;; (inst jmp-near (make-fixup 'unwind :assembly-routine)) -- jrd
+  ;;
+  ;; fall into unwind
+  )
+
+;;;; Non-local exit noise.
+
+(define-assembly-routine (unwind
+			  (:return-style :none)
+			  (:translate %continue-unwind)
+			  (:policy :fast-safe))
+			 ((:arg block (any-reg descriptor-reg) eax-offset)
+			  (:arg start (any-reg descriptor-reg) ebx-offset)
+			  (:arg count (any-reg descriptor-reg) ecx-offset)
+			  (:temp uwp dword-reg esi-offset))
+  (declare (ignore count))
+
+  (let ((error (generate-error-code nil invalid-unwind-error)))
+    (inst or block block)		; check for NULL pointer
+    (inst jmp :z error))
+  
+  (load-symbol-value uwp lisp::*current-unwind-protect-block*)
+
+  (inst;; does *cuwpb* match value stored in argument cuwp slot?
+   cmp uwp (make-ea-for-object-slot block unwind-block-current-uwp-slot 0))
+  ;; If a match, return to context in arg block.
+  (inst jmp :e do-exit)
+
+  ;; Not a match - return to *current-unwind-protect-block* context.
+  ;; Important! Must save (and return) the arg 'block' for later use!!
+  (move edx-tn block)
+  (move block uwp)
+  ;; Set next unwind protect context.
+  (loadw uwp uwp unwind-block-current-uwp-slot)
+  (store-symbol-value uwp lisp::*current-unwind-protect-block*)
+  
+  DO-EXIT
+  
+  (loadw ebp-tn block unwind-block-current-cont-slot)
+  
+  ;; apparently a carefully held secret is that uwp-entry expects
+  ;; some things in known locations so that they can be saved on
+  ;; the stack! Jeesh!
+ 
+  ;;(move edx-tn block)			; gets shoved into 'block'
+  ;;(move ecx-tn count)			; a noop
+
+  ;; This seems needed to properly save the 'start' value so that the
+  ;; correct thing gets passed into the various nlx entry points although
+  ;; I think the compiler really ought to do it.
+
+  (storew start ebp-tn (- (1+ old-fp-save-offset)))
+
+  (inst jmp (make-ea :byte :base block
+		     :disp (* unwind-block-entry-pc-slot word-bytes))))
diff --git a/assembly/x86/bit-bash.lisp b/assembly/x86/bit-bash.lisp
new file mode 100644
index 000000000..6417cbcf0
--- /dev/null
+++ b/assembly/x86/bit-bash.lisp
@@ -0,0 +1 @@
+;; Just a dummy file to keep loadbackend happy.
diff --git a/assembly/x86/kludges.lisp b/assembly/x86/kludges.lisp
new file mode 100644
index 000000000..ecd4c3487
--- /dev/null
+++ b/assembly/x86/kludges.lisp
@@ -0,0 +1,66 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/Attic/kludges.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;; Kludges to make up for the fact that we don't have an assembler.  
+;;; replace this file with real native assembly source later.
+;;;
+;;; by jrd
+;;;
+
+(in-package :x86)
+
+
+#+assembler
+;;;
+;;; a kludge to tranpoline through when we're calling into lisp.
+;;; this cf the sparc one
+;;;
+;;; int call_into_lisp_kludge(control_stack_pointer, function, args, nargs);
+;;;
+(define-assembly-routine (call-into-lisp-kludge)
+			 ((:temp eax dword-reg eax-offset)
+			  (:temp ebx dword-reg ebx-offset)
+			  (:temp ecx dword-reg ecx-offset)
+			  (:temp edx dword-reg edx-offset)
+			  (:temp esi dword-reg esi-offset)
+			  (:temp edi dword-reg edi-offset)
+			  (:temp esp dword-reg esp-offset)
+			  (:temp ebp dword-reg ebp-offset))
+  ;; get the lisp stack pointer into ebx, so we can push things on it
+  (inst mov ebp (make-ea :dword :base esp :disp 4))
+
+  ;; make room on the lisp stack
+  (inst sub ebp 8)
+
+  ;; pull the args off the stack
+;  (inst mov eax (make-ea :dword :base esp :disp 16))	;nargs.  zzz is this right?
+;  (inst mov (make-ea :dword :base ebp :disp 4) eax)
+;  (inst mov eax (make-ea :dword :base esp :disp 12))	; args
+;  (inst mov (make-ea :dword :base ebp  :disp 0) eax)
+
+  ;; get the function 
+  (inst mov eax (make-ea :dword :base esp :disp 8))
+  (inst add eax 23)				; function-code-offset
+  (inst mov edi eax)				; move it to reg-code
+
+  ;; clear the descriptor regs
+  (inst mov eax 0)
+  (inst mov ebx 0)
+  (inst mov ecx 0)
+  (inst mov edx 0)
+
+  ;; zzz what else?
+
+  ;; jump there
+  (inst call edi))
+
diff --git a/assembly/x86/support.lisp b/assembly/x86/support.lisp
new file mode 100644
index 000000000..1a9dfa81f
--- /dev/null
+++ b/assembly/x86/support.lisp
@@ -0,0 +1,62 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/support.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
+;;;
+;;; **********************************************************************
+;;; 
+;;; This file contains the machine specific support routines needed by
+;;; the file assembler.
+;;;
+;;; Written by William Lott.
+;;;
+(in-package :x86)
+
+(def-vm-support-routine generate-call-sequence (name style vop)
+  (ecase style
+    (:raw
+     (values
+      `((inst call (make-fixup ',name :assembly-routine)))
+      nil))
+    (:full-call
+     (values
+      #-x86-lra
+      `((note-this-location ,vop :call-site)
+	(inst call (make-fixup ',name :assembly-routine))
+	(note-this-location ,vop :single-value-return)
+	(move esp-tn ebx-tn))
+      #+x86-lra
+      `((note-this-location ,vop :call-site)
+	(inst push (make-fixup nil :code-object return))
+	(inst jmp (make-fixup ',name :assembly-routine))
+	(align lowtag-bits #x90)
+	(inst lra-header-word)
+	(inst nop)
+	(inst nop)
+	(inst nop)
+	RETURN
+	(note-this-location ,vop :single-value-return)
+	(move esp-tn ebx-tn))
+      '((:save-p :compute-only))))
+    (:none
+     (values 
+      `((inst jmp (make-fixup ',name :assembly-routine)))
+      nil))))
+
+(def-vm-support-routine generate-return-sequence (style)
+  (ecase style
+    (:raw
+     `(inst ret))
+    (:full-call
+     `(
+       (inst pop eax-tn)
+
+       (inst add eax-tn 2)
+       (inst jmp eax-tn)))
+    (:none)))
diff --git a/lisp/Config.FreeBSD b/lisp/Config.FreeBSD
new file mode 100644
index 000000000..ff9faf4eb
--- /dev/null
+++ b/lisp/Config.FreeBSD
@@ -0,0 +1,19 @@
+PATH1=../../../p86/lisp
+PATH2=../../../17f/lisp
+vpath %.h $(PATH1):$(PATH2)
+vpath %.c $(PATH1):$(PATH2)
+vpath %.S $(PATH1)
+CPPFLAGS = -I. -I$(PATH1) -I$(PATH2) -I- -I/usr/X11R6/include
+CC = gcc # -Wall -Wstrict-prototypes -Wmissing-prototypes
+LD = ld
+CPP = cpp
+CFLAGS =   -m486 -g -DWANT_CGC -O2
+ASFLAGS = -g 
+NM = nm -gp
+UNDEFSYMPATTERN=-Xlinker -u -Xlinker &
+ASSEM_SRC = x86-assem.S
+ARCH_SRC = x86-arch.c
+OS_SRC = FreeBSD-os.c os-common.c
+OS_LINK_FLAGS=-static
+OS_LIBS= -lgnumalloc
+GC_SRC= cgc.c
diff --git a/lisp/Config.linux b/lisp/Config.linux
new file mode 100644
index 000000000..2dee6f5bc
--- /dev/null
+++ b/lisp/Config.linux
@@ -0,0 +1,20 @@
+PATH1=../../p86/lisp
+PATH2=../../17f/lisp
+vpath %.h $(PATH1):$(PATH2)
+vpath %.c $(PATH1):$(PATH2)
+vpath %.S $(PATH1)
+CPPFLAGS = -I. -I$(PATH1) -I$(PATH2) -I- -I/usr/X11R6/include
+CC = gcc  -Wstrict-prototypes -O2 -fno-strength-reduce # -Wall
+LD = ld
+CPP = cpp
+CFLAGS =   -m486 -g -DWANT_CGC -O2
+ASFLAGS = -g 
+NM = nm -p
+UNDEFSYMPATTERN=-Xlinker -u -Xlinker &
+ASSEM_SRC = x86-assem.S  linux-stubs.S
+ARCH_SRC = x86-arch.c
+OS_SRC = Linux-os.c os-common.c
+OS_LINK_FLAGS=
+#-static
+OS_LIBS= -lieee -lm  -ldl
+GC_SRC= cgc.c
diff --git a/lisp/FreeBSD-os.c b/lisp/FreeBSD-os.c
new file mode 100644
index 000000000..d87618a67
--- /dev/null
+++ b/lisp/FreeBSD-os.c
@@ -0,0 +1,259 @@
+/*
+ * FreeBSD-os.c. Maybe could be just BSD-os.c
+ * From osf1-os.c,v 1.1 94/03/27 15:30:51 hallgren Exp $
+ *
+ * OS-dependent routines.  This file (along with os.h) exports an
+ * OS-independent interface to the operating system VM facilities.
+ * Suprisingly, this interface looks a lot like the Mach interface
+ * (but simpler in some places).  For some operating systems, a subset
+ * of these functions will have to be emulated.
+ *
+ * This is the OSF1 version.  By Sean Hallgren.
+ * Much hacked by Paul Werkowski
+ *
+ */
+
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/param.h>
+#include <signal.h>
+#include <sys/user.h>
+#include <sys/ptrace.h>
+#include <sys/wait.h>
+#include <sys/param.h>
+#include <sys/file.h>
+#include <sys/proc.h>
+#include <errno.h>
+#include "./signal.h"
+#include "os.h"
+#include "arch.h"
+#include "globals.h"
+#include "interrupt.h"
+#include "lispregs.h"
+#include "internals.h"
+
+#include "x86-validate.h"
+vm_size_t os_vm_page_size;
+#define DPRINTF(t,a) {if(t)fprintf a;}
+
+#define HAVE_SIGVEC		/* defined  - now obsolete */
+#define HAVE_SIGACTION		/* replacement for SIGVEC          */
+/* SIGSTKSZ == 40Kb */
+#define SIG_STACK_SIZE (SIGSTKSZ/sizeof(double))
+/* make sure the stack is 8 byte aligned */
+#if defined USE_SIG_STACK
+static double estack_buf[SIG_STACK_SIZE];
+#endif
+
+void
+os_init()
+{
+
+#if defined USE_SIG_STACK
+  static struct sigaltstack estack;
+  estack.ss_base = (char*)estack_buf; /* this should be ss_sp */
+  estack.ss_size = SIGSTKSZ;
+  estack.ss_flags = 0;
+  if (sigaltstack(&estack, 0) < 0)
+    perror("sigaltstack");
+#endif
+  os_vm_page_size=OS_VM_DEFAULT_PAGESIZE;
+}
+
+int
+sc_reg(struct sigcontext *c, int offset)
+{
+  switch(offset)
+    {
+    case  0: return c->sc_eax;
+    case  2: return c->sc_ecx;
+    case  4: return c->sc_edx;
+    case  6: return c->sc_ebx;
+    case  8: return c->sc_esp;
+    case 10: return c->sc_ebp;
+    case 12: return c->sc_esi;
+    case 14: return c->sc_edi;
+    }
+  return 0;
+}
+void
+os_save_context()
+{
+  /* Called from interrupt handlers so C stuff knows things set in Lisp
+   */
+}
+void
+os_set_context()
+{
+}
+
+os_vm_address_t
+os_validate(os_vm_address_t addr, os_vm_size_t len)
+{
+  int flags = MAP_PRIVATE|MAP_ANONYMOUS;
+
+  if(addr) flags|=MAP_FIXED;
+  else flags|=MAP_VARIABLE;
+
+  DPRINTF(0,(stderr,"os_validate %x %d => ",addr,len));
+  if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,-1,0)) == (os_vm_address_t) -1)
+    {
+      perror("mmap");
+      return NULL;
+    }
+  DPRINTF(0,(stderr,"%x\n",addr));
+
+  return addr;
+}
+
+void
+os_invalidate(os_vm_address_t addr, os_vm_size_t len)
+{
+  DPRINTF(0,(stderr,"os_invalidate %x %d\n",addr,len));
+  if(munmap(addr,len) == -1)
+    perror("munmap");
+}
+
+os_vm_address_t
+os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
+{
+  if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FILE|MAP_FIXED,fd,
+		(off_t) offset)) == (os_vm_address_t) -1)
+    perror("mmap");
+  
+  return addr;
+}
+
+void
+os_flush_icache(os_vm_address_t address, os_vm_size_t length)
+{
+}
+
+void
+os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
+{
+  if(mprotect(address, length, prot) == -1)
+    perror("mprotect");
+}
+
+static boolean
+in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
+{
+  char* beg = (char*)sbeg;
+  char* end = (char*)sbeg + slen;
+  char* adr = (char*)a;
+  return (adr >= beg && adr < end);
+}
+boolean
+valid_addr(os_vm_address_t addr)
+{
+  int ret;
+  os_vm_address_t newaddr;
+  newaddr=os_trunc_to_page(addr);
+
+  if(   in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE)
+     || in_range_p(addr, STATIC_SPACE_START   , STATIC_SPACE_SIZE   )
+     || in_range_p(addr, DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE  )
+     || in_range_p(addr, DYNAMIC_1_SPACE_START, DYNAMIC_SPACE_SIZE  )
+     || in_range_p(addr, CONTROL_STACK_START  , CONTROL_STACK_SIZE  )
+     || in_range_p(addr, BINDING_STACK_START  , BINDING_STACK_SIZE  ))
+    return TRUE;
+  return FALSE;
+}
+
+
+static void
+sigbus_handler(int signal, int code, struct sigcontext *context)
+{
+  DPRINTF(0,(stderr,"sigbus:\n"));
+#if defined NOTYET
+  if(!interrupt_maybe_gc(signal, code, context))
+#endif
+    interrupt_handle_now(signal, code, context);
+}
+static void
+sigsegv_handler(int signal, int code, struct sigcontext *context)
+{
+  DPRINTF(0,(stderr,"os_sigsegv\n"));
+#if defined NOTYET
+  if(!interrupt_maybe_gc(signal, code, context))
+#endif
+    interrupt_handle_now(signal, code, context);
+}
+
+void 
+os_install_interrupt_handlers(void)
+{
+  interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler);
+  interrupt_install_low_level_handler(SIGBUS,sigbus_handler);
+}
+
+
+/* All this is needed to get the floating-point status register
+ * that was stuffed in process context on a SIGFPE. We need it
+ * to determine what kind of condition occured. This code also
+ * sets up the possibility of defining some local structs to
+ * make up for lack of sigcontext registers and have a low level
+ * SIGFPE handler dummy something up.
+ */
+#ifdef not_now_maybe_not_ever
+struct user u;
+unsigned int
+BSD_get_fp_modes()
+{
+  /* All this is highly dependent on FreeBSD internals. Watch Out! */
+  /* offset to where NPX state is saved in a process */
+  unsigned int fpoff = (char*)&u.u_pcb.pcb_savefpu - (char*)&u;
+  unsigned int fplen = sizeof u.u_pcb.pcb_savefpu / sizeof(int);
+  /* offset to the last exception status word */
+  unsigned int swoff = (char*)&u.u_pcb.pcb_savefpu.sv_ex_sw - (char*)&u;
+  pid_t pid;
+  /* fork to capture NPX state in another process */
+  pid =  fork();
+  if(pid)
+    {
+      u_long ex_sw, ex_cw;
+      int status;
+      printf("p: wait1\n"); fflush(stdout);
+      wait4(pid, &status, WUNTRACED, NULL);
+      printf("P: wait over\n"); fflush(stdout);
+      ex_sw = ptrace(PT_READ_U, pid, (caddr_t)swoff, 0);
+      if(ex_sw == -1)
+	perror("ptrace");
+      {
+	/* Might as well get the rest  of the saved state. */
+	int i, *ip = (int*)&u.u_pcb.pcb_savefpu;
+	unsigned int*uaddr = (unsigned int*)fpoff;
+	for(i=0; i<fplen; i++, uaddr++)
+	  *ip++ = ptrace(PT_READ_U, pid, (caddr_t)uaddr, 0);
+	ex_cw = u.u_pcb.pcb_savefpu.sv_env.en_cw & 0xffff;
+      }
+      printf("sw %x cw %x\n",ex_sw,ex_cw); fflush(stdout);
+      printf("p: Kill\n"); fflush(stdout);
+      ptrace(PT_CONTINUE, pid, NULL, 0);
+      printf("p: wait2\n"); fflush(stdout);
+      wait4(pid, &status, 0, NULL);
+      printf("p: wait over\n"); fflush(stdout);
+      ex_sw &= 0xffff;
+      ex_cw &= 0xffff;
+      ex_cw ^= 0x3f;
+      return (ex_sw << 16) | ex_cw ;
+    }
+  else
+    {
+      /* As child, notify OS to allow ptrace calls */
+      int status = ptrace(PT_TRACE_ME, getpid(), NULL, 0);
+      if(status == -1)
+	perror("kid");
+      printf("c:\n"); fflush(stdout);
+      /* Go idle so parent can poke at process contents. */
+      raise(SIGSTOP);
+      printf("c: stopped?\n");
+      while(0)
+	{ sigsuspend(0); printf("c:\n"); fflush(stdout); }
+      exit(1);
+    }
+}
+#endif
+
diff --git a/lisp/FreeBSD-os.h b/lisp/FreeBSD-os.h
new file mode 100644
index 000000000..c626049a1
--- /dev/null
+++ b/lisp/FreeBSD-os.h
@@ -0,0 +1,41 @@
+/*
+
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.h,v 1.1 1997/01/21 00:28:13 ram Exp $
+
+ This code was written as part of the CMU Common Lisp project at
+ Carnegie Mellon University, and has been placed in the public domain.
+
+*/
+
+#include <sys/types.h>
+#include <sys/mman.h>
+#include <sys/signal.h>
+
+#define MAP_ANONYMOUS MAP_ANON
+#define MAP_VARIABLE 0
+#define PRINTNOISE
+#undef  PRINTNOISE
+/* #define DEBUG_SCAVENGE_VERBOSE */
+typedef caddr_t os_vm_address_t;
+typedef vm_size_t os_vm_size_t;
+typedef off_t os_vm_offset_t;
+typedef int os_vm_prot_t;
+
+#define OS_VM_PROT_READ PROT_READ
+#define OS_VM_PROT_WRITE PROT_WRITE
+#define OS_VM_PROT_EXECUTE PROT_EXEC
+
+#define OS_VM_DEFAULT_PAGESIZE	4096
+
+int
+sc_reg(struct sigcontext*,int);
+void
+os_save_context();
+#define SAVE_CONTEXT os_save_context
+
+#define USE_SIG_STACK
+/*
+ * On second thought, a separate stack would probably
+ * confuse the hell out of the Lisp debugger!
+ */
+#undef  USE_SIG_STACK
diff --git a/lisp/GNUmakefile b/lisp/GNUmakefile
index 210b11748..642f6d05d 100644
--- a/lisp/GNUmakefile
+++ b/lisp/GNUmakefile
@@ -1,18 +1,22 @@
-# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.11 1995/02/17 00:51:01 wlott Exp $
+# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.12 1997/01/21 00:28:13 ram Exp $
 
 all: lisp.nm
 
 CC = gcc
+
 DEPEND_FLAGS =
 
 include Config
 
+ifndef GC_SRC
+GC_SRC = gc.c
+endif
+
 SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \
-	vars.c parse.c interrupt.c search.c validate.c gc.c globals.c \
+	vars.c parse.c interrupt.c search.c validate.c globals.c \
 	dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \
 	socket.c runprog.c time.c undefineds.c \
-	${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC}
-
+	${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
 
 OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(patsubst %.s,%.o,$(SRCS))))
 
@@ -21,7 +25,7 @@ OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(patsubst %.s,%.o,$(SRCS))))
 
 lisp.nm: lisp
 	echo 'Map file for lisp version ' `cat version` > ,lisp.nm
-	$(NM) lisp >> ,lisp.nm
+	$(NM) lisp | grep -v " F \| U " >> ,lisp.nm
 	mv ,lisp.nm lisp.nm
 
 lisp: version.c ${OBJS} version
diff --git a/lisp/Linux-os.c b/lisp/Linux-os.c
new file mode 100644
index 000000000..21b958906
--- /dev/null
+++ b/lisp/Linux-os.c
@@ -0,0 +1,274 @@
+/*
+ * Linux-os.c. 
+ * Form FreeBSD-os.c
+ * From osf1-os.c,v 1.1 94/03/27 15:30:51 hallgren Exp $
+ *
+ * OS-dependent routines.  This file (along with os.h) exports an
+ * OS-independent interface to the operating system VM facilities.
+ * Suprisingly, this interface looks a lot like the Mach interface
+ * (but simpler in some places).  For some operating systems, a subset
+ * of these functions will have to be emulated.
+ *
+ * This is the OSF1 version.  By Sean Hallgren.
+ * Much hacked by Paul Werkowski
+ * Morfed from the FreeBSD file by Peter Van Eynde (July 1996)
+ *
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.1 1997/01/21 00:28:13 ram Exp $
+ *
+ */
+
+#include <stdio.h>
+#include <sys/param.h>
+#include <sys/file.h>
+#include <errno.h>
+#include "./signal.h"
+#include "os.h"
+#include "arch.h"
+#include "globals.h"
+#include "interrupt.h"
+#include "lispregs.h"
+#include "internals.h"
+#include <sys/socket.h>
+#include <sys/utsname.h>
+
+#include <sys/types.h>
+#include <signal.h>
+/* #include <sys/sysinfo.h> */
+#include <sys/time.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#include "x86-validate.h"
+size_t os_vm_page_size;
+
+#define DPRINTF(t,a) {if(t)fprintf a;}
+
+#undef HAVE_SIGVEC		/* defined  - now obsolete */
+#undef HAVE_SIGACTION		/* replacement for SIGVEC          */
+/* SIGSTKSZ == 40Kb */
+#define SIG_STACK_SIZE (SIGSTKSZ/sizeof(double))
+/* make sure the stack is 8 byte aligned */
+#if defined USE_SIG_STACK
+static double estack_buf[SIG_STACK_SIZE];
+#endif
+
+
+void
+os_init(void)
+{
+  struct utsname name;
+
+  uname(&name);
+
+/* we need this for mmap */
+
+  if ((name.release[0]) < '2')
+   {
+    printf("Linux version must be later then 2.0.0!\n");
+    exit(2);
+  }
+
+#if defined USE_SIG_STACK
+  static struct sigaltstack estack;
+  estack.ss_base = (char*)estack_buf; /* this should be ss_sp */
+  estack.ss_size = SIGSTKSZ;
+  estack.ss_flags = 0;
+  if (sigaltstack(&estack, 0) < 0)
+    perror("sigaltstack");
+#endif
+#if 0
+  os_vm_page_size=OS_VM_DEFAULT_PAGESIZE;
+#else
+  os_vm_page_size=getpagesize();
+#endif
+__setfpucw(0x1372|4|8|16|32); /*no interrupts */
+}
+
+int
+sc_reg(struct sigcontext_struct *c, int offset)
+{
+  switch(offset)
+    {
+    case  0: return c->eax;
+    case  2: return c->ecx;
+    case  4: return c->edx;
+    case  6: return c->ebx;
+    case  8: return c->esp;
+    case 10: return c->ebp;
+    case 12: return c->esi;
+    case 14: return c->edi;
+    }
+  return 0;
+}
+
+void
+os_save_context(void)
+{
+  /* Called from interrupt handlers so C stuff knows things set in Lisp
+   */
+}
+
+void
+os_set_context(void)
+{
+}
+
+int do_mmap(os_vm_address_t *addr, os_vm_size_t len,
+	     int flags)
+{
+  /* we _must_ have the memory where we want it...*/
+  os_vm_address_t old_addr=*addr;
+
+  *addr=mmap(*addr,len,OS_VM_PROT_ALL,flags,-1,0);
+  if (((old_addr != NULL) && (*addr != old_addr)) || 
+	(*addr == (os_vm_address_t) -1)) 
+    {
+      fprintf(stderr, "Error in allocating memory, do you have more then 16MB of memory+swap?\n");
+      perror("mmap");
+      return 1;
+    }
+ return 0;
+}
+
+os_vm_address_t
+os_validate(os_vm_address_t addr, os_vm_size_t len)
+{
+  int flags = MAP_PRIVATE|MAP_ANONYMOUS;
+  int oa=addr,olen=len;
+
+  if(addr) flags|=MAP_FIXED;
+  else flags|=MAP_VARIABLE;
+
+  DPRINTF(0,(stderr,"os_validate %x %d => ",addr,len));
+  if (addr)
+    {
+      do {
+	if (len <= 0x1000000 )
+	  {
+	    if (do_mmap(&addr,len,flags))
+	      return NULL;
+	    len=0;
+	  }
+	else
+	  {
+	    len = len-0x1000000;
+	    if (do_mmap(&addr,0x1000000,flags))
+		return NULL;
+	    addr+=0x1000000;
+	  }
+      }
+      while (len>0);
+    }
+  else
+    {
+      if(do_mmap(&addr,len,flags))
+	  return NULL;
+      return addr;
+    }
+  DPRINTF(0,(stderr,"%x\n",addr));
+  return oa;
+}
+
+void
+os_invalidate(os_vm_address_t addr, os_vm_size_t len)
+{
+  DPRINTF(0,(stderr,"os_invalidate %x %d\n",addr,len));
+  if(munmap(addr,len) == -1)
+    perror("munmap");
+}
+
+os_vm_address_t
+os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
+{
+  if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FILE|MAP_FIXED,fd,
+		(off_t) offset)) == (os_vm_address_t) -1)
+    perror("mmap");
+  
+  return addr;
+}
+
+void
+os_flush_icache(os_vm_address_t address, os_vm_size_t length)
+{
+}
+
+void
+os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
+{
+  if(mprotect(address, length, prot) == -1)
+    perror("mprotect");
+}
+
+static boolean
+in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
+{
+  char* beg = (char*)sbeg;
+  char* end = (char*)sbeg + slen;
+  char* adr = (char*)a;
+  return (adr >= beg && adr < end);
+}
+boolean
+valid_addr(os_vm_address_t addr)
+{
+  int ret;
+  os_vm_address_t newaddr;
+  newaddr=os_trunc_to_page(addr);
+
+  if(   in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE)
+     || in_range_p(addr, STATIC_SPACE_START   , STATIC_SPACE_SIZE   )
+     || in_range_p(addr, DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE  )
+     || in_range_p(addr, DYNAMIC_1_SPACE_START, DYNAMIC_SPACE_SIZE  )
+     || in_range_p(addr, CONTROL_STACK_START  , CONTROL_STACK_SIZE  )
+     || in_range_p(addr, BINDING_STACK_START  , BINDING_STACK_SIZE  ))
+    return TRUE;
+  return FALSE;
+}
+
+
+static void
+sigbus_handler(HANDLER_ARGS)
+{
+  GET_CONTEXT
+
+  DPRINTF(1,(stderr,"sigbus:\n")); /* there is no sigbus in linux??? */
+#if defined NOTYET
+  if(!interrupt_maybe_gc(signal, code, context))
+#endif
+    interrupt_handle_now(signal,contextstruct);
+}
+static void
+sigsegv_handler(HANDLER_ARGS)
+{
+  GET_CONTEXT
+
+  DPRINTF(0,(stderr,"os_sigsegv\n"));
+#if defined NOTYET
+  if(!interrupt_maybe_gc(signal, code, context))
+#endif
+    interrupt_handle_now(signal,contextstruct);
+}
+
+void 
+os_install_interrupt_handlers(void)
+{
+  interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler);
+  interrupt_install_low_level_handler(SIGBUS,sigbus_handler);
+}
+
+#if 0
+/* functions that disapear ! */
+#define Force_Fct(fct) int * Force_ ## fct (void) {return &fct;}
+
+Force_Fct(select)
+Force_Fct(stat)
+Force_Fct(lstat)
+Force_Fct(fstat)
+Force_Fct(socket)
+Force_Fct(connect)
+Force_Fct(listen)
+Force_Fct(recv)
+Force_Fct(accept)
+Force_Fct(bind)
+#endif
+
+
diff --git a/lisp/Linux-os.h b/lisp/Linux-os.h
new file mode 100644
index 000000000..6a6ad9ebd
--- /dev/null
+++ b/lisp/Linux-os.h
@@ -0,0 +1,76 @@
+/*
+
+ This code was written as part of the CMU Common Lisp project at
+ Carnegie Mellon University, and has been placed in the public domain.
+
+ Morfed from the FreeBSD file by Peter Van Eynde (July 1996)
+*/
+
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/mman.h>
+#include <sys/signal.h>
+#include <asm/sigcontext.h>
+#include <string.h> 
+#include <dlfcn.h>
+#include <sys/time.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <sys/syscall.h>
+#include <asm/unistd.h>
+#include <errno.h>
+#define MAP_VARIABLE 0
+#define PRINTNOISE
+/* #define DEBUG_SCAVENGE_VERBOSE */
+
+typedef caddr_t os_vm_address_t; /* like hpux */
+typedef size_t os_vm_size_t;     /* like hpux */
+typedef off_t os_vm_offset_t;    /* like hpux */
+typedef int os_vm_prot_t;        /* like hpux */
+
+#define OS_VM_PROT_READ PROT_READ    /* like hpux */
+#define OS_VM_PROT_WRITE PROT_WRITE  /* like hpux */
+#define OS_VM_PROT_EXECUTE PROT_EXEC /* like hpux */
+     
+#define OS_VM_DEFAULT_PAGESIZE	4096 /* like hpux */ 
+
+int sc_reg(struct sigcontext_struct *,int);
+void os_save_context(void);
+
+#define SAVE_CONTEXT os_save_context
+
+typedef struct sigcontext_struct sigcontext;
+
+#define POSIX_SIGS
+
+#define HANDLER_ARGS int signal, struct sigcontext_struct contextstruct
+#define GET_CONTEXT int code=0; struct sigcontext_struct *context=&contextstruct;
+
+#define sigvec          sigaction
+#define sv_mask         sa_mask
+#define sv_flags        sa_flags
+#define sv_handler      sa_handler
+#define sv_onstack      sa_mask /* ouch, this one really hurts */
+#define uc_sigmask 	oldmask
+#define sc_pc		eip
+#define sc_mask		oldmask 
+#define sc_sp		esp
+#define sigcontext	sigcontext_struct 
+#define sa_sigaction	sa_handler
+#define SA_SIGINFO	0
+
+#define sc_eax eax
+#define sc_ecx ecx
+#define sc_edx edx
+#define sc_ebx ebx
+#define sc_esp esp
+#define sc_ebp ebp
+#define sc_esi esi
+#define sc_edi edi
+
+/*
+ * On second thought, a separate stack would probably
+ * confuse the hell out of the Lisp debugger!
+ */
+#undef  USE_SIG_STACK
+
diff --git a/lisp/WARNING.files b/lisp/WARNING.files
new file mode 100644
index 000000000..dae228f53
--- /dev/null
+++ b/lisp/WARNING.files
@@ -0,0 +1,9 @@
+Three critical files are created in the build directory and
+may not be present in this source directory after Genesis.
+Look for correct versions of
+
+	internals.h
+	version
+	lisp.nm
+
+before making distributions.
diff --git a/lisp/alloc.c b/lisp/alloc.c
index 3973b38db..e896a447f 100644
--- a/lisp/alloc.c
+++ b/lisp/alloc.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.c,v 1.2 1994/03/27 15:19:55 hallgren Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.c,v 1.3 1997/01/21 00:28:13 ram Exp $ */
 
 #include "lisp.h"
 #include "internals.h"
@@ -22,12 +22,14 @@
     clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
 #endif
 
-
+#define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask
 
 /****************************************************************
 Allocation Routines.
 ****************************************************************/
-
+#if defined WANT_CGC
+extern lispobj *alloc(int bytes);
+#else
 static lispobj *alloc(int bytes)
 {
     lispobj *result;
@@ -45,12 +47,13 @@ static lispobj *alloc(int bytes)
 
     return result;
 }
+#endif
 
 static lispobj *alloc_unboxed(int type, int words)
 {
     lispobj *result;
 
-    result = alloc((1 + words) * sizeof(lispobj));
+    result = alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj)));
 
     *result = (lispobj) (words << type_Bits) | type;
 
@@ -61,7 +64,8 @@ static lispobj alloc_vector(int type, int length, int size)
 {
     struct vector *result;
 
-    result = (struct vector *)alloc((2 + (length*size + 31) / 32) * sizeof(lispobj));
+    result = (struct vector *)
+      alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj)));
 
     result->header = type;
     result->length = make_fixnum(length);
@@ -71,7 +75,7 @@ static lispobj alloc_vector(int type, int length, int size)
 
 lispobj alloc_cons(lispobj car, lispobj cdr)
 {
-    struct cons *ptr = (struct cons *)alloc(sizeof(struct cons));
+    struct cons *ptr = (struct cons *)alloc(ALIGNED_SIZE(sizeof(struct cons)));
 
     ptr->car = car;
     ptr->cdr = cdr;
diff --git a/lisp/cgc.c b/lisp/cgc.c
new file mode 100644
index 000000000..cf9105f7f
--- /dev/null
+++ b/lisp/cgc.c
@@ -0,0 +1,1902 @@
+/* cgc.c -*- Mode: C; comment-column: 40; -*-
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.1 1997/01/21 00:28:13 ram Exp $
+ *
+ * Conservative Garbage Collector for CMUCL x86.
+ *
+ * Copyright (c) Paul F Werkowski, 1996.
+ *
+ * There is absolutely NO WARRANTY associated with this code! Use
+ * at your own risk! If you can't handle the fact that this may 
+ * not work the way you want then just DELETE THIS FILE NOW!
+ *
+ * This code is based on software written by William Lott, and
+ * Public Domain codes from Carnegie Mellon University.
+ *
+ * Received from William 27 Jul 95.
+ *
+ * Debug, FreeBSD hooks, and integration by Paul Werkowski
+ *
+ */
+#include <stdio.h>
+#include <assert.h>
+#include <signal.h>
+#include "os.h"				/* for SetSymbolValue */
+#include "x86-validate.h"		/* for memory layout  */
+#include "x86-lispregs.h"
+#include "lisp.h"			/* for object defs */
+#include "interrupt.h"			/* interrupt_handlers */
+#include "internals.h"
+#include "cgc.h"
+
+#if !defined MIN
+#define MIN(a,b)(((a)<(b))?(a):(b))
+#define MAX(a,b)(((a)>(b))?(a):(b))
+#endif
+
+#include <unistd.h>
+#include <stdlib.h>
+#if defined unix
+#include <sys/param.h>
+#endif
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+
+#define dprintf(t,exp) if(t){printf exp ; fflush(stdout);}
+
+/* Object representation details. The allocator/collector knows
+ * almost nothing about lisp internals and is fairly general.
+*/
+
+#define ALIGN_BITS 3
+#define ALIGN_BYTES (1<<ALIGN_BITS)
+#define ALIGNEDP(addr) ((((int)addr)&(ALIGN_BYTES-1)) == 0)
+
+/* Type of an object. */
+typedef struct object
+{
+  long header;
+  struct object*data[1];
+} *obj_t;
+
+/* Just leave unused space */
+#define NOTE_EMPTY(ptr,bytes) {}
+
+
+/* Collector datastructures */
+
+#define BLOCK_BITS 16
+#define BLOCK_BYTES (1<<BLOCK_BITS)
+#define BLOCK_NUMBER(ptr) (((long)(ptr))>>BLOCK_BITS)
+#define BLOCK_ADDRESS(num) ((void *)((num)<<BLOCK_BITS))
+
+#define CHUNK_BITS 9
+#define CHUNK_BYTES (1<<CHUNK_BITS)
+#define CHUNK_NUMBER(ptr) (((long)(ptr))>>CHUNK_BITS)
+#define CHUNK_ADDRESS(num) ((void *)((num)<<CHUNK_BITS))
+
+#define BLOCK_CHUNKS (1<<(BLOCK_BITS-CHUNK_BITS))
+
+
+#define ROUNDDOWN(val,x) ((val)&~((x)-1))
+#define ROUNDUP(val,x) ROUNDDOWN((val)+(x)-1,x)
+
+#define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
+			__FILE__, __LINE__)
+
+#if 0
+#define gc_assert(ex) {if (!(ex)) gc_abort();}
+#else
+#define gc_assert(ex)
+#endif
+
+char*alloc(int);
+
+
+struct cluster {
+    /* Link to the next cluster. */
+    struct cluster *next;
+
+    /* The number of blocks in this cluster. */
+    int num_blocks;
+
+    /* Pointer to the first region. */
+    struct region *first_region;
+
+    /* Table index by the chunk number of some pointer minus the chunk */
+    /* number for the first region giving the number of chunks past */
+    /* the chunk holding the region header that spans that pointer. */
+    /* Actually, it might not be enough.  So after backing up that far, */
+    /* try again. */
+    unsigned char region_offset[1];
+};
+
+/* The first word of this is arranged to look like a fixnum
+ * so as not to confuse 'room'.
+ */
+struct region {
+  unsigned
+  res1 :2, num_chunks :16, contains_small_objects :1, clean :1, hole :7;
+  struct region **prev;
+  struct region *next;
+  struct space *space;
+};
+
+#define REGION_OVERHEAD ROUNDUP(sizeof(struct region), ALIGN_BYTES)
+
+
+struct space {
+    struct region *regions;
+    struct region **regions_tail;
+    char *alloc_ptr;
+    char *alloc_end;
+};
+
+/* Chain of all the clusters. */
+struct cluster *clusters = NULL;
+static int num_clusters = 0;		/* for debugging */
+int cgc_debug = 0;			/* maybe set from Lisp */
+/* Table indexed by block number giving the cluster that block is part of. */
+static struct cluster **block_table = NULL;
+
+/* The allocated memory block_table is offset from. */
+static struct cluster **block_table_base = NULL;
+
+/* The maximum bounds on the heap. */
+static void *heap_base = NULL;
+static void *heap_end = NULL;
+
+/* The two dynamic spaces. */
+static struct space space_0 = { NULL };
+static struct space space_1 = { NULL };
+/* Pointers it whichever dynamic space is currently newspace and oldspace */
+static struct space *newspace = NULL;
+static struct space *oldspace = NULL;
+/* Free lists of regions. */
+static struct region *small_region_free_list = NULL;
+static struct region *large_region_free_list = NULL;
+static void move_to_newspace(struct region *region);
+
+#if defined TESTING
+static void print_region(struct region*r)
+{
+  dprintf(1,("[region %x %d <%x %x> %x]\n",
+		     r,r->num_chunks,r->prev,r->next,r->space));
+}
+static void print_regions(struct region*r, char*str)
+{
+  printf("Regions %s:\n",str);
+  for(; r != NULL; r = r->next)
+    print_region(r);
+}
+
+static void print_space(struct space*s)
+{
+  struct region*r = s->regions;
+  dprintf(1,("[space %x %s %s <%x - %x>]\n",
+	     s,
+	     (s == &space_0)? "S0" : "S1",
+	     (s == newspace)? "NewSpace" : "OldSpace",
+	     s->alloc_ptr, s->alloc_end));
+  print_regions(r,"");
+
+}
+void print_spaces()
+{
+  print_space(&space_0);
+  print_space(&space_1);
+  print_regions(large_region_free_list,"LRFL");
+  print_regions(small_region_free_list,"SRFL");
+}
+void print_cluster(struct cluster*cluster)
+{
+  printf("[cluster %x >%x %d]\n",cluster,cluster->next,cluster->num_blocks);
+  print_regions(cluster->first_region,"cluster");
+}
+void print_clusters()
+{
+  struct cluster*cluster;
+  for(cluster=clusters; cluster != NULL; cluster = cluster->next)
+    print_cluster(cluster);
+}
+#endif /* TESTING */
+  
+
+/* Allocation/deallocation routines */
+
+static void init_region(struct region *region, int nchunks)
+{
+    int region_block = BLOCK_NUMBER(region);
+    struct cluster *cluster = block_table[region_block];
+    int offset = CHUNK_NUMBER(region) - CHUNK_NUMBER(cluster->first_region);
+    int i;
+    dprintf(0,("init region %x %d\n",region,nchunks));
+    *(long*)region = 0;			/* clear fields */
+    region->num_chunks = nchunks;
+    if (nchunks > UCHAR_MAX) {
+	for (i = 0; i < UCHAR_MAX; i++)
+	    cluster->region_offset[offset + i] = i;
+	for (; i < nchunks; i++)
+	    cluster->region_offset[offset + i] = UCHAR_MAX;
+    }
+    else {
+	for (i = 0; i < nchunks; i++)
+	    cluster->region_offset[offset + i] = i;
+    }
+}
+
+static struct region *maybe_alloc_large_region(int nchunks)
+{
+    struct region *region, **prev;
+
+    prev = &large_region_free_list;
+    while ((region = *prev) != NULL) {
+	if (region->num_chunks >= nchunks) {
+	    if (region->num_chunks == nchunks)
+		*prev = region->next;
+	    else {
+		struct region *new
+		    = (struct region *)((char *)region + nchunks*CHUNK_BYTES);
+		init_region(new, region->num_chunks - nchunks);
+		new->next = region->next;
+		new->prev = NULL;
+		new->space = NULL;
+		*prev = new;
+		region->num_chunks = nchunks;
+	    }
+	    region->next = NULL;
+	    region->prev = NULL;
+	    region->space = NULL;
+	    return region;
+	}
+	prev = &region->next;
+    }
+    return NULL;
+}
+
+
+/* from os_zero */
+static void cgc_zero(addr, length)
+os_vm_address_t addr;
+os_vm_size_t length;
+{
+  os_vm_address_t block_start = os_round_up_to_page(addr);
+  os_vm_address_t end = addr + length;
+  os_vm_size_t block_size;
+  
+  
+  if(block_start > addr)
+    bzero((char *)addr, MIN(block_start - addr, length));
+
+  if(block_start < end)
+    {
+      length -= block_start - addr;
+      
+      block_size =os_trunc_size_to_page(length);
+      
+      if(block_size < length)
+	bzero((char *)block_start + block_size,length - block_size);
+  
+      if (block_size != 0)
+	{
+	  /* Now deallocate and allocate the block so that it */
+	  /* faults in  zero-filled. */
+	  
+	  os_invalidate(block_start,block_size);
+	  addr=os_validate(block_start,block_size);
+	  
+	  if(addr == NULL || addr != block_start)
+	    fprintf(stderr,"cgc_zero: block moved, 0x%08x ==> 0x%08x!\n",
+		    block_start,addr);
+	}
+    }
+}
+
+static void compact_cluster(struct cluster *cluster)
+{
+  int show = 0;
+  struct region *region = cluster->first_region;
+  struct region *end =
+    (struct region *)((char *)region + cluster->num_blocks * BLOCK_BYTES);
+  int grown = 0;
+  struct region *large_additions = NULL;
+  struct region **large_prev = &large_additions;
+  struct region *small_additions = NULL;
+  struct region **small_prev = &small_additions;
+  
+  dprintf(show,("compact cluster %x\n",cluster));
+  while (region < end) {
+    struct region *next =
+      (struct region *) ((char *)region + region->num_chunks*CHUNK_BYTES);
+    if (region->space != newspace) {	/* was == NULL */
+      if (next < end && next->space != newspace) { /* was == NULL */
+	gc_assert(region->space == NULL);
+	gc_assert(next->space == NULL);
+	gc_assert(region->num_chunks > 0);
+	gc_assert(next->num_chunks > 0);
+	region->num_chunks += next->num_chunks;
+	grown = 1;
+      }
+      else {
+	if (grown) {
+	  init_region(region, region->num_chunks);
+	  region->space = NULL;
+	  grown = 0;
+	}
+	{
+	  int ovh = REGION_OVERHEAD;
+	  cgc_zero((os_vm_address_t)((char*)region + ovh),
+		  (os_vm_size_t)(region->num_chunks*CHUNK_BYTES) - ovh);
+	}
+
+	if(region->num_chunks == 1) {
+	  *small_prev = region;
+	  small_prev = &region->next;
+	}
+	else {
+	  *large_prev = region;
+	  large_prev = &region->next;
+	}
+	region = next;
+      }
+    }
+    else
+      region = next;
+  }
+  
+  *large_prev = large_region_free_list;
+  large_region_free_list = large_additions;
+  *small_prev = small_region_free_list;
+  small_region_free_list = small_additions;
+}
+
+static void compact_free_regions()
+{
+  struct cluster*cluster;
+    large_region_free_list = NULL;
+    small_region_free_list = NULL;
+
+    for (cluster = clusters; cluster != NULL; cluster = cluster->next)
+	compact_cluster(cluster);
+}
+
+/* WL code arranged to allocate new space via the sbrk() mechanism.
+ * However, I am going to start by allocating from the standard dynamic
+ * space. The idea is to use the normal allocation scheme for initial
+ * system build and switch to the cgc allocator when starting up a
+ * saved image when dynamic space is hopefully clean.
+ */
+static struct region*new_region(int nblocks)
+{
+  /* take from existing dynamic space */
+  char*new = (char*)SymbolValue(ALLOCATION_POINTER);
+  struct region*region = (struct region*)(ROUNDUP((long)new,BLOCK_BYTES));
+  int bn = BLOCK_NUMBER(region);
+  new += (nblocks * BLOCK_BYTES + ((char*)region - new));
+  SetSymbolValue(ALLOCATION_POINTER,(lispobj)new);
+    return region;
+}
+
+static void new_cluster(int min_blocks)
+{
+    int nblocks = min_blocks < 4 ? 4 : min_blocks;
+    int nchunks = nblocks << (BLOCK_BITS-CHUNK_BITS);
+    int i;
+    struct cluster *cluster = malloc(sizeof(struct cluster) + nchunks-1);
+    struct region*region = new_region(nblocks);
+
+    int bn = BLOCK_NUMBER(region);
+    dprintf(cgc_debug,("new cluster %x region@%x\n",cluster,region));
+    for (i = 0; i < nblocks; i++)
+      block_table[bn+i] = cluster;
+
+    num_clusters++;
+    cluster->next = clusters;
+    clusters = cluster;
+    cluster->num_blocks = nblocks;
+    cluster->first_region = region;
+
+    init_region(region, nchunks);
+
+    region->next = large_region_free_list;
+    large_region_free_list = region;
+    region->prev = NULL;
+    region->space = NULL;
+}
+
+unsigned long cgc_bytes_allocated = 0;	/* Seen by (dynamic-usage) */
+static unsigned long auto_gc_trigger = 0;
+static int maybe_gc_called = 0;
+
+static struct region *alloc_large_region(int nchunks)
+{
+  struct region *region;
+  {
+    region = maybe_alloc_large_region(nchunks);
+
+    if (region == NULL)
+      {
+	new_cluster((nchunks + BLOCK_CHUNKS - 1) >> (BLOCK_BITS-CHUNK_BITS));
+	region = maybe_alloc_large_region(nchunks);
+	gc_assert(region != NULL);
+      }
+  }
+  gc_assert(region->space == NULL);
+  return region;
+}
+
+static struct region *alloc_small_region()
+{
+    struct region *region = small_region_free_list;
+
+    if (region == NULL)
+	region = alloc_large_region(1);
+    else
+	small_region_free_list = region->next;
+    region->next = NULL;
+    region->prev = NULL;
+    region->space = NULL;
+    move_to_newspace(region);
+    return region;
+}
+
+static int chunks_freed = 0;
+
+static void free_region(struct region *region)
+{
+  gc_assert(region->space && region->space == oldspace);
+  gc_assert(region->num_chunks > 0);
+
+  region->space = NULL;			/* for compact_cluster? */
+  region->prev = NULL;			/* housekeeping I hope */
+  chunks_freed += region->num_chunks;
+
+  if (region->num_chunks == 1)
+    {
+      region->next = small_region_free_list;
+      small_region_free_list = region;
+    }
+  else
+    {
+      region->next = large_region_free_list;
+      large_region_free_list = region;
+    }
+}
+
+static void *alloc_large(int nbytes)
+{
+    int nchunks = (nbytes+REGION_OVERHEAD+CHUNK_BYTES-1) >> CHUNK_BITS;
+    struct region *region = alloc_large_region(nchunks);
+    region->contains_small_objects = 0;
+    region->next = NULL;
+    region->prev = NULL;
+    region->space = NULL;
+    cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES;
+    move_to_newspace(region);
+    return (char *)region + REGION_OVERHEAD;
+}
+
+void *cgc_alloc(int nbytes)
+{
+  void*res;
+  dprintf(0,("alloc %d\n", nbytes));
+
+  if (nbytes > (CHUNK_BYTES - REGION_OVERHEAD))
+    res = alloc_large(nbytes);
+  else
+    {
+      struct space *space = newspace;
+      if ((space->alloc_ptr + nbytes) > space->alloc_end)
+	{
+	  struct region *region;
+	  if(space->alloc_ptr != NULL)
+	    {
+	      int hole = space->alloc_end - space->alloc_ptr;
+	      if(hole >= ALIGN_BYTES)
+		/* This wastes the space, eg suppose one cons
+		 * has been allocated then a request for
+		 * a maximum sized small obj comes in. I'd like
+		 * to remember that there is still a lot of
+		 * room left in this region. Maybe I could actually
+		 * use the small_region_free_list in some way.
+		 */
+		NOTE_EMPTY(space->alloc_ptr, hole);
+	    }
+	  region = alloc_small_region();
+	  region->contains_small_objects = 1;
+	  space->alloc_ptr = (char *)region + REGION_OVERHEAD;
+	  space->alloc_end = (char *)region + CHUNK_BYTES;
+	  cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES;
+	}
+      
+      res = space->alloc_ptr;
+      space->alloc_ptr += ROUNDUP(nbytes, ALIGN_BYTES);
+    }
+  return res;
+}
+
+
+static void move_to_newspace(struct region *region)
+{
+  /* (maybe) unlink region from oldspace and add to tail of 
+   * newspace regions. Don't attempt to move a region that
+   * is already in newspace.
+   */
+    struct space *space = newspace;
+    if(region->space == oldspace)
+      {
+	/* Remove region from list. The prev slot holds
+	 * the address of the 'next' slot of the previous
+	 * list entry, not a pointer to that region (why?)
+	 */
+	*region->prev = region->next;
+	if(region->next)
+	  region->next->prev = region->prev;
+	if(region->space->regions_tail == &region->next)
+	  region->space->regions_tail = region->prev;
+      }
+    /* Append to newspace unless it has already been promoted. */
+    if(region->space != newspace)
+      {
+	region->prev = space->regions_tail;
+	region->next = NULL;
+	*space->regions_tail = region;
+	space->regions_tail = &region->next;
+	region->space = space;
+      }
+}
+
+static struct region *find_region(void *ptr)
+{
+    struct cluster *cluster;
+    int cluster_chunk_num;
+    int chunk_num;
+    unsigned char delta;
+
+    ptr = (void*)((int) ptr & ~0x3);
+    if (ptr < heap_base || ptr >= heap_end)
+	return NULL;
+
+    cluster = block_table[BLOCK_NUMBER(ptr)];
+    if (cluster == NULL)
+	return NULL;
+
+    if (ptr < (void*)cluster->first_region)
+	return NULL;
+
+    cluster_chunk_num = CHUNK_NUMBER(cluster->first_region);
+    chunk_num = CHUNK_NUMBER(ptr);
+
+    while (delta = cluster->region_offset[chunk_num - cluster_chunk_num])
+	chunk_num -= delta;
+
+    return CHUNK_ADDRESS(chunk_num);
+}
+
+/* Interface to std collector */
+static inline boolean
+from_space_p(lispobj obj)
+{
+  struct region*region=find_region((void*)obj);
+  return (region != NULL && region->space == oldspace);
+}
+static inline boolean
+new_space_p(lispobj obj)
+{
+  struct region*region=find_region((void*)obj);
+  return (region != NULL && region->space == newspace);
+}
+static inline boolean
+static_space_p(lispobj obj)
+{
+  return (STATIC_SPACE_START < obj
+	  && obj < SymbolValue(STATIC_SPACE_FREE_POINTER));
+}
+
+/* Predicate that returns true if an object is a pointer. */
+#undef  POINTERP
+#define POINTERP(obj) Pointerp((obj)->header)
+
+/* Predicate that returns true if an object has been forwarded. */
+#define FORWARDED(obj) ((obj_t)(obj)->header == (obj_t)0x1)
+
+/* Returns the forwarding pointer for the given object. */
+#define FORWARDING_PTR(obj) ((lispobj)(obj)->data[0])
+
+/* Marks obj as forwarded to new */
+#define DEPOSIT_FORWARDING_PTR(obj,new) \
+ ((obj_t)(obj)->header = 0x1, (obj_t)(obj)->data[0] = (obj_t)new)
+
+/* Returns an obj_t for the object starting at addr */
+#define OBJECT_AT(addr) ((obj_t)(addr))
+
+/* Returns the size (in bytes) of obj. */
+#define OBJECT_SIZE(obj) (sizeOfObject((obj_t)obj)<<2)
+
+/* Scavenges an object. */
+#define SCAVENGE_OBJECT(obj) scavengex((lispobj*)obj)
+
+#if 0
+/* Makes a region of memory look like some kind of object. */
+#define NOTE_EMPTY(ptr,bytes) \
+    (((obj_t)ptr)->header = (((bytes+ALIGN_BYTES-1)>>ALIGN_BITS)<<8) | 1)
+#endif
+
+static unsigned long bytes_copied = 0;
+#   define  HAVE_FASTCOPY
+#if defined HAVE_FASTCOPY
+#define COPYDUAL(a,b,c) fastcopy16(a,b,c)
+void fastcopy16(void*,void*,size_t);
+#else
+#define COPYDUAL(a,b,c) memmove(a,b,c)
+#endif
+static inline lispobj
+copy(lispobj taggedobj)
+{
+  obj_t source = (obj_t)PTR(taggedobj);
+  int nbytes = OBJECT_SIZE(source);
+  gc_assert(Pointerp(taggedobj));
+  gc_assert(!(nbytes & (ALIGN_BYTES-1)));
+  {
+    int lowtag = LowtagOf(taggedobj);
+    obj_t newobj = cgc_alloc(nbytes);
+    COPYDUAL(newobj, source, nbytes);
+    bytes_copied += nbytes;
+    return ((lispobj)newobj | lowtag);
+  }
+}
+
+
+#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
+#define NWORDS(x,y) (CEILING((x),(y)) / (y))
+
+#define WEAK_POINTER_NWORDS \
+	CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
+static struct weak_pointer *weak_pointers;
+
+
+/* Scavenging:
+ * CMU CL objects can be classified as BOXED, UNBOXED or other.
+ * Boxed objects have a header containing length and type followed
+ * by LENGTH tagged object descriptors which may be pointers.
+ * UNBOXED objects have a header but the data is other than
+ * tagged descriptors, such as floats, bignums, saps or code.
+ * Others (code) contain a mix of boxed and unboxed and some
+ * (cons) are like BOXED but without header. The scavenger needs
+ * to consider these different kinds of objects. I will use a
+ * table indexed by type to detect the simple cases of boxed
+ * or unboxed.
+ */
+#define IMMED_OR_LOSE(thing) gc_assert(sct[TypeOf(thing)].sc_kind == SC_IMMED)
+static void scavenge_pointer(lispobj*);
+static int noise = 0;
+
+typedef struct { unsigned sc_kind : 3, ve_l2bits : 5;} OSC_t;
+
+OSC_t make_OSC(int kind, int log2bits)
+{
+  OSC_t thing;
+  thing.sc_kind = kind;
+  thing.ve_l2bits = log2bits;
+  return thing;
+}
+#define SETSCT(indx,kind,logbits) sct[indx] = make_OSC(kind,logbits)
+#define SC_ISBOXED 1
+#define SC_UNBOXED 2
+#define SC_IMMED   3
+#define SC_POINTER 4
+#define SC_VECTOR  5
+#define SC_STRING  6
+#define SC_OTHER   7
+#define SC_LOSER   0
+static OSC_t sct[256];
+
+int sizeOfObject(obj_t obj)
+{
+  int obj_type = TypeOf(obj->header);
+  OSC_t class = sct[obj_type];
+  struct vector*vector;
+  int length = 1;
+  int nwords = 1;
+  switch (class.sc_kind)
+    {
+    case SC_POINTER:
+    case SC_IMMED:
+      return 1;
+    case SC_ISBOXED:
+    case SC_UNBOXED:
+      gc_assert(HeaderValue(obj->header) > 0);
+      nwords = length = HeaderValue(obj->header) + 1;
+      break;
+    case SC_STRING:
+    case SC_VECTOR:
+      {
+	int log2bits = class.ve_l2bits;
+	int bits_per_el = 1 << log2bits;
+	int extra = 0;
+	int els_per_word = 1 << (5 - log2bits);
+	if(log2bits > 5)
+	  {
+	    els_per_word = 1;
+	    extra = log2bits - 5;
+	  }
+	length = ((struct vector*)obj)->length;
+	length = fixnum_value(length);	/* Zero Length IS valid */
+	length +=  (class.sc_kind == SC_STRING);
+	length <<= extra;
+	nwords = NWORDS(length, els_per_word);
+	nwords += 2;			/* header + length */
+      }
+      break;
+    case SC_OTHER:
+      switch(obj_type)
+	{
+	case type_CodeHeader:
+	  {
+	    struct code *code;
+	    int nheader_words, ncode_words;
+	    code = (struct code *)obj;
+	    ncode_words = fixnum_value(code->code_size);
+	    nheader_words = HeaderValue(code->header);
+	    nwords = ncode_words + nheader_words;
+	  } break;
+	default:
+	  fprintf(stderr,"GC losage: no size for other type %d\n",obj_type);
+	  gc_abort();
+	}
+      break;
+    default:
+      fprintf(stderr,"GC losage: no size for other type %d\n",obj_type);
+      gc_abort();
+    }
+  return CEILING(nwords,2);
+}
+
+static void init_osc()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    SETSCT(i ,SC_LOSER, 0);
+  for (i = 0; i < 32; i++)
+    {
+      SETSCT(type_EvenFixnum|(i<<3)	,SC_IMMED,0);
+      SETSCT(type_FunctionPointer|(i<<3),SC_POINTER,0);
+      /* OtherImmediate0 */
+      SETSCT(type_ListPointer|(i<<3)	,SC_POINTER,0);
+      SETSCT(type_OddFixnum|(i<<3) 	,SC_IMMED,0);
+      SETSCT(type_InstancePointer|(i<<3),SC_POINTER,0);
+      /* OtherImmediate1 */
+      SETSCT(type_OtherPointer|(i<<3) 	,SC_POINTER,0);
+    }
+  SETSCT(type_Bignum			,SC_UNBOXED,0);
+  SETSCT(type_Ratio			,SC_ISBOXED,0);
+  SETSCT(type_SingleFloat		,SC_UNBOXED,0);
+  SETSCT(type_DoubleFloat		,SC_UNBOXED,0);
+  SETSCT(type_Complex			,SC_ISBOXED,0);
+  SETSCT(type_SimpleArray		,SC_ISBOXED,0);
+  SETSCT(type_SimpleString		,SC_STRING,3);
+  SETSCT(type_SimpleBitVector		,SC_VECTOR,0);
+  SETSCT(type_SimpleVector		,SC_VECTOR,5);
+  SETSCT(type_SimpleArrayUnsignedByte2	,SC_VECTOR,1);
+  SETSCT(type_SimpleArrayUnsignedByte4	,SC_VECTOR,2);
+  SETSCT(type_SimpleArrayUnsignedByte8	,SC_VECTOR,3);
+  SETSCT(type_SimpleArrayUnsignedByte16	,SC_VECTOR,4);
+  SETSCT(type_SimpleArrayUnsignedByte32	,SC_VECTOR,5);
+  SETSCT(type_SimpleArraySingleFloat	,SC_VECTOR,5);
+  SETSCT(type_SimpleArrayDoubleFloat	,SC_VECTOR,6);
+  SETSCT(type_ComplexString		,SC_ISBOXED,0);
+  SETSCT(type_ComplexBitVector		,SC_ISBOXED,0);
+  SETSCT(type_ComplexVector		,SC_ISBOXED,0);
+  SETSCT(type_ComplexArray		,SC_ISBOXED,0);
+  SETSCT(type_CodeHeader		,SC_OTHER,0);
+  SETSCT(type_FunctionHeader		,SC_OTHER,0);
+  SETSCT(type_ClosureFunctionHeader	,SC_OTHER,0);
+  SETSCT(type_ReturnPcHeader		,SC_OTHER,0);
+  SETSCT(type_ClosureHeader		,SC_ISBOXED,0);
+  SETSCT(type_FuncallableInstanceHeader	,SC_ISBOXED,0);
+  SETSCT(type_ByteCodeFunction		,SC_ISBOXED,0);
+  SETSCT(type_ByteCodeClosure		,SC_ISBOXED,0);
+  SETSCT(type_DylanFunctionHeader	,SC_ISBOXED,0);
+
+  SETSCT(type_ValueCellHeader		,SC_ISBOXED,0);
+  SETSCT(type_SymbolHeader		,SC_ISBOXED,0);
+  SETSCT(type_BaseChar			,SC_IMMED,0);
+  SETSCT(type_Sap			,SC_UNBOXED,0);
+  SETSCT(type_UnboundMarker		,SC_IMMED,0);
+  SETSCT(type_WeakPointer		,SC_UNBOXED,0);
+  SETSCT(type_InstanceHeader		,SC_ISBOXED,0);
+  SETSCT(type_Fdefn			,SC_ISBOXED,0);
+}
+
+static lispobj* scavenge(lispobj*,int);
+static lispobj*scavenge_object(lispobj*);
+static lispobj*scavengex(lispobj*);
+
+static inline scavenge_1word_obj(lispobj*addr)
+{
+  if(Pointerp(*addr))
+    {
+      if(*addr != NIL && *addr != T)
+	scavenge_pointer(addr);
+    }
+  else
+    IMMED_OR_LOSE(*addr);
+}
+static int debug_code = 0;
+static int
+scav_code_header(lispobj*where)
+{
+  lispobj object = *where;
+  struct code *code;
+  int i,nheader_words, ncode_words, nwords;
+  lispobj fheaderl;
+  struct function *fheaderp;
+  dprintf(0,("code: %x %x\n",where,object));
+  code = (struct code *) where;
+  ncode_words = fixnum_value(code->code_size);
+  nheader_words = HeaderValue(object);
+  nwords = ncode_words + nheader_words;
+  nwords = CEILING(nwords, 2);
+  /* Scavenge the boxed section of the code data block */
+  /* NOTE: seeing a problem where the trace_table_offset slot
+   * is a bogus list pointer instead of a fixnum such that 
+   * junk gets moved to newspace which causes problems later.
+   * Purify doesn't look at that slot (a bug?). Need
+   * to figure out how it happens. Ans: from loading top-level
+   * forms that init byte-compiled functions like "defun fcn".
+   * Fix the loader to not do this and save some space!
+   */
+  for(i=1; i < nheader_words; i++)
+    scavenge_1word_obj(where + i);
+
+  /* Scavenge the boxed section of each function object in the 
+   * code data block.
+   */
+  fheaderl = code->entry_points;
+  while (fheaderl != NIL) {
+    fheaderp = (struct function *) PTR(fheaderl);
+    gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
+    scavenge_1word_obj(&fheaderp->name);
+    scavenge_1word_obj(&fheaderp->arglist);
+    scavenge_1word_obj(&fheaderp->type);
+    fheaderl = fheaderp->next;
+  }
+  return nwords;
+}
+
+#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
+#ifdef i386
+static void scavenge_fcn_header(struct function*object)
+{
+  struct function*fheader = object;
+  unsigned long offset = HeaderValue(fheader->header) * 4;
+  /* Ok, we don't transport code here, but we do need to
+   * scavenge the constants and functions (of which this is one).
+   * This should be done as part of scavenging a live code object
+   * and we could now be trying to do CPR on a corpse!
+   */
+  struct code*code = (struct code *) ((unsigned long) fheader - offset);
+  gc_assert(TypeOf(fheader->header) == type_FunctionHeader);
+  scav_code_header((lispobj*)code);
+}
+
+static int docode=0;			/* maybe not needed */
+static int
+scav_closure_header(struct closure*closure)
+{
+  /* Could also be a funcallable_instance. The x86 port has the
+   * raw code address in the function slot, not a lisp object.
+   * However, the function object is a known distance from the code.
+   */
+  lispobj fun, fheader1;
+  int i,words;
+  gc_assert(ALIGNEDP(closure));
+  words = HeaderValue(closure->header);
+  fun = closure->function - RAW_ADDR_OFFSET;
+  /* This needs to be done to get at live code. I now have no
+   * way to know if this has already been scavenged so I assume
+   * that it hasn't. Code that has been seen by purify is
+   * supposed RO and doesn't (shouldn't) need to be looked at
+   * so this maybe really redundant.
+   *
+   * I have seen one case where FI was incomplete with function
+   * and lexenv slots == 0! Is this a bug?
+   *
+   * Update, it appears this is not needed. I will disable execution
+   * by default but leave the code here in case something breaks.
+   */
+  if(docode && static_space_p(closure->function))
+    scavenge_fcn_header((struct function*)PTR(fun));
+  else					/* "normal" */
+    scavenge_1word_obj(&fun);
+
+  /* Now the boxed part of the closure header. */
+  for(i = 0; i < words - 1; i++)
+    scavenge_1word_obj(&closure->info[i]);
+
+  return CEILING(words + 1, 2);
+}
+static int fnoise=0;			/* experimental */
+static int
+scav_fdefn(lispobj*where)
+{
+  /* I don't know if this is really needs to be special cased here.
+   * raw_address  should look like a fixnum and function is in static
+   * space -- unless it is pointing to something in C like closure_tramp
+   * or maybe undefined_tramp.
+   * Actually function is in dynamic space if it is a byte-function!
+   * Hmm, have seen case of function slot containing 1. Bug?
+   */
+  struct fdefn * fdefn = (struct fdefn*)where;
+  int words = HeaderValue(fdefn->header);
+  int fix_func = ((char*)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr);
+  scavenge_pointer(&fdefn->name);
+  if(fnoise && LowtagOf(fdefn->function) == type_FunctionPointer)
+    {
+      obj_t fcnobj = (obj_t)PTR(fdefn->function);
+      switch(TypeOf(fcnobj->header))
+	{
+	  /* Can only be in static space and may need to scavenge code object.
+	   * Won't be noticed by scavenge_pointer().
+	   */
+	case type_FunctionHeader:
+	  scavenge_fcn_header((struct function*)fcnobj);
+	  break;
+	  /* If in static space it was moved there by purify and we are
+	   * doing normal scavenge. Handle normally.
+	   */
+	case type_FuncallableInstanceHeader:
+	case type_ClosureHeader:
+	  scavenge_pointer(&fdefn->function);
+	  break;
+	default:
+	  dprintf(1,("Ignoring bogus value %x for fdefn function.\n", 
+		     *fcnobj));
+	}
+    }
+  else
+    /* NIL for undefined function? */
+    scavenge_pointer(&fdefn->function);
+
+  if (fix_func)
+    { /* This shouldn't be needed yet. */
+      fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
+    }
+  return sizeof(struct fdefn) / sizeof(lispobj);
+}
+
+#endif
+
+/* List scavenger taken from gc.c and adapted */
+
+static FILE*log=NULL;
+static int scav_ro = 0;			/* for testing  */
+static int debug=0;
+static void*trapaddr=0;
+void check_trap(void*addr)
+{
+  fprintf(stderr,"Trapped @ %x\n",addr);
+}
+
+static lispobj
+trans_list(lispobj object)
+{
+  lispobj new_list_pointer;
+  struct cons *cons, *new_cons;
+  int n=0;
+  lispobj  cdr;
+
+  cons = (struct cons *) PTR(object);
+  
+  /* copy 'object' */
+  new_cons = (struct cons *) cgc_alloc(sizeof(struct cons));
+  new_cons->car = cons->car;
+  new_cons->cdr = cons->cdr; /* updated later */
+  new_list_pointer = (lispobj)new_cons | LowtagOf(object);
+  bytes_copied += sizeof(struct cons);
+#if 0
+  if(scav_ro>1)check_trap(object);
+  if(log)fprintf(log,"( %d cons @ #x%x -> #x%x car #x%x)\n",
+	  n++, cons,new_cons,new_cons->car);
+#endif
+  /* Grab the cdr before it is clobbered */
+  cdr = cons->cdr;
+  /* Set forwarding pointer (clobbers start of list). */
+  DEPOSIT_FORWARDING_PTR((obj_t)cons,new_list_pointer);
+
+  /* Try to linearize the list in the cdr direction to help reduce paging. */  
+  while (1)
+    {
+      lispobj  new_cdr;
+      struct cons *cdr_cons, *new_cdr_cons;
+      
+      if (LowtagOf(cdr) != type_ListPointer 
+	  || !from_space_p(cdr)
+	  || FORWARDED((obj_t)PTR(cdr)) )
+	break;
+    
+      cdr_cons = (struct cons *) PTR(cdr);
+      
+      /* copy 'cdr' */
+      new_cdr_cons = (struct cons*) cgc_alloc(sizeof(struct cons));
+      new_cdr_cons->car = cdr_cons->car;
+      new_cdr_cons->cdr = cdr_cons->cdr;
+      new_cdr = (lispobj)new_cdr_cons | LowtagOf(cdr);
+      bytes_copied += sizeof(struct cons);
+#if 0
+      if(scav_ro>1)check_trap(object);
+      if(log)fprintf(log,"( %d cons @ #x%x -> #x%x car #x%x)\n",
+		   n++,cdr_cons,new_cdr_cons,cdr_cons->car);
+#endif
+      /* Grab the cdr before it is clobbered */
+      cdr = cdr_cons->cdr;
+      /* Set forwarding pointer */
+      DEPOSIT_FORWARDING_PTR((obj_t)cdr_cons,new_cdr);
+
+      /* Update the cdr of the last cons copied into new
+       * space to keep the newspace scavenge from having to do it.
+       */
+      new_cons->cdr = new_cdr;
+      
+      new_cons = new_cdr_cons;
+  }
+  
+  return new_list_pointer;
+}
+
+/* Weak Pointers */
+static int weak_noise=0;
+static int do_weak=1;
+static int
+scav_weak_pointer(lispobj*where)
+{
+  struct weak_pointer*wp = weak_pointers;
+  /* Push the weak pointer onto the list of weak pointers.
+   * Do I have to watch for duplicates? Originally this was
+   * part of trans_weak_pointer but that didn't work in the
+   * case where the WP was in a promoted region.
+   */
+
+  while(wp != NULL)
+    {
+      if(wp == (struct weak_pointer*)where)
+	break;
+      wp = wp->next;
+    }
+  if(wp == NULL)
+    {
+      wp = (struct weak_pointer*)where;
+      wp->next = weak_pointers;
+      weak_pointers = wp;
+      if(!do_weak)scavenge_1word_obj(&wp->value);
+    }
+
+  /* Do not let GC scavenge the value slot of the weak pointer
+   * (that is why it is a weak pointer).
+   */
+
+  return WEAK_POINTER_NWORDS;
+}
+void scan_weak_pointers(void)
+{
+  struct weak_pointer *wp;
+  for (wp = weak_pointers; wp != NULL; wp = wp->next)
+    {
+      lispobj value = wp->value;
+      obj_t obj = (obj_t)PTR(value);
+      lispobj first, *first_pointer;
+      
+      dprintf(weak_noise,("Weak pointer at 0x%08x\n", (unsigned long) wp));
+      dprintf(weak_noise,("Value: 0x%08x\n", (unsigned long) value));
+
+      if (Pointerp(value) && from_space_p(value))
+	{
+	  /* Now, we need to check if the object has been forwarded.
+	   * If it has been, the weak pointer is still good and needs
+	   * to be updated. Otherwise, the weak pointer needs to be nil'ed out.
+	   */
+	  
+	  if(FORWARDED(obj))
+	     wp->value = FORWARDING_PTR(obj);
+	  else
+	    { /* break it */
+	      dprintf(weak_noise,("Broken.\n"));
+	      wp->value = NIL;
+	      wp->broken = T;
+	    }
+	}
+    }
+}
+
+static int
+scavenge_random_object(lispobj*addr)
+{
+  lispobj header = *addr;
+  int count = 1;
+  dprintf(noise > 1,("soi: %x @ %x\n",header,addr));
+#if 0
+  if(trapaddr==addr)
+    check_trap(addr);
+#endif
+  gc_assert(ALIGNEDP(addr));
+
+  switch (TypeOf(header))
+    {
+    case type_SimpleVector:
+      {
+	struct vector*v = (struct vector*)addr;
+	int i, n = fixnum_value(v->length);
+	if (HeaderValue(v->header) == subtype_VectorValidHashing)
+	  v->header = (subtype_VectorMustRehash<<type_Bits)|type_SimpleVector;
+	/* Look at each of the vector elements which can be any lisp object. */
+	for(i=0; i<n; i++)
+	  scavenge_1word_obj(&v->data[i]);
+	count = CEILING(n+2, 2);
+      }
+      break;
+    case type_CodeHeader:
+      count = scav_code_header(addr);
+      break;
+      /* We should never hit any of these, 'cause they occur buried in
+       * the middle of code objects (and handled by the code just above).
+       */
+    case type_ClosureFunctionHeader:
+    case type_ReturnPcHeader:
+      gc_abort();
+
+      /* Except while looking at an fdefn and wanting to ensure
+       * code object is looked at.
+       */
+    case type_FunctionHeader:
+      scavenge_fcn_header((struct function *)addr);
+      break;
+#if defined i386
+    case type_ClosureHeader:
+    case type_FuncallableInstanceHeader:
+    case type_ByteCodeFunction:
+    case type_ByteCodeClosure:
+    case type_DylanFunctionHeader:
+      count = scav_closure_header((struct closure *)addr);
+      break;
+#endif
+    case type_WeakPointer:
+      count = scav_weak_pointer(addr);
+      break;
+    case type_Fdefn:
+      /* We have to handle fdefn objects specially, so we can fix
+       * up the raw function address.
+       */
+      count = scav_fdefn(addr);
+      break;
+    default:
+      {
+	OSC_t class = sct[TypeOf(header)];
+	switch(class.sc_kind)
+	  {
+	  case SC_IMMED:
+	    count = 1;
+	    break;
+	  case SC_ISBOXED:
+	    {
+	      int i, words = 1+ HeaderValue(header);
+	      for(i=1; i<words; i++)
+		scavenge_1word_obj(addr+i);
+	      count = CEILING(words, 2);
+	    }
+	    break;
+	  case SC_UNBOXED:
+	  case SC_STRING:
+	  case SC_VECTOR:		/* simple vector handled above */
+	    count = sizeOfObject((obj_t)addr);
+	    break;
+	  default:
+	    gc_abort();
+	  }
+      }
+    }
+  return count;
+}
+
+static void logcopy(lispobj*addr, lispobj tagged, int hdr, lispobj to)
+{
+  if(log)
+    {
+      int kind = TypeOf(hdr);
+      int words = sizeOfObject((obj_t)PTR(tagged));
+      fprintf(log,"(copy #x%x @ #x%x (#x%x %d) to #x%x)\n",
+	      tagged,addr,kind,words,to);
+    }
+}
+static void
+maybe_transport(lispobj*addr, lispobj tagged, struct region*region)
+{
+  obj_t obj = (obj_t)PTR(tagged);
+  gc_assert(ALIGNEDP(obj));
+  gc_assert(Pointerp(tagged));
+  gc_assert((void*)region != (void*)obj);
+#if 0
+  if((void*)obj == (void*)trapaddr)
+    check_trap(obj);
+#endif
+  if (region->contains_small_objects)
+    {
+      lispobj new = copy(tagged);
+#if 0
+      if(scav_ro > 1)			/* debugging in RO space */
+	check_trap(obj);
+#endif
+#if defined GOOSE_CHASE
+      if(TypeOf(obj->header)==type_Fdefn)
+	{
+	  struct fdefn*fdefn=(struct fdefn*)PTR(new);
+	  if(fdefn->function < STATIC_SPACE_START)
+	    check_trap(obj);
+	}
+#endif
+      dprintf(0,("copy %x @ %x (%x) to %x\n",
+		 tagged,addr,TypeOf(obj->header),new));
+      logcopy(addr,tagged,obj->header,new);
+      DEPOSIT_FORWARDING_PTR(obj , new);
+      *addr = new;
+    }
+  else
+    { 
+      move_to_newspace(region);
+      dprintf(0,("move %x\n",region)); 
+    }
+}
+
+void
+scavenge_pointer(lispobj*addr)
+{
+  lispobj taggedobj = *addr;		/* descriptor */
+  obj_t obj = (obj_t)PTR(taggedobj);	/* pointer to object */
+  gc_assert(Pointerp(taggedobj));
+#if 0
+  if(addr == trapaddr) check_trap(addr);
+  if(obj  == trapaddr) check_trap(obj);
+#endif
+  /* optimize out common static pointers */
+  if(taggedobj != NIL && taggedobj != T)
+    {
+      struct region*region = find_region(obj);
+      /* Only interested in pointers into oldspace */
+      if(region && region->space == oldspace)
+	{
+	  if(FORWARDED(obj))
+	    *addr = FORWARDING_PTR(obj);
+	  else
+	    switch (LowtagOf(taggedobj))
+	      {
+	      case type_ListPointer:
+		dprintf(noise>1,("ListPointer @ %x...\n",addr));
+		*addr = trans_list(taggedobj);
+		dprintf(noise>1,("... -> %x\n",addr));
+		break;
+	      case type_FunctionPointer:
+		switch(TypeOf(obj->header))
+		  {
+		  case type_ClosureHeader:
+		  case type_FuncallableInstanceHeader:
+		  case type_ByteCodeFunction:
+		  case type_ByteCodeClosure:
+		  case type_DylanFunctionHeader:
+		    maybe_transport(addr, taggedobj, region);
+		    break;
+		  default:
+		    gc_abort();
+		  }
+		break;
+	      case type_InstancePointer:
+	      case type_OtherPointer:
+		maybe_transport(addr, taggedobj, region);
+		break;
+	      default:
+		/* It was a pointer, but not one of them? */
+		gc_abort();
+	      }
+	}
+    }
+}
+
+
+static lispobj*scavenge(lispobj*addr, int ptrs)
+{
+  /* addr points to an aligned 32-bit word in some space. */
+  struct region *region;
+  lispobj*end = addr + ptrs;
+  lispobj obj;
+  while (addr < end)
+    {
+      int count = 1;
+      obj = *addr;			/* the lisp object */
+#if 0
+      if(trapaddr == addr)
+	check_trap(addr);		/* gdb breakpoint */
+#endif
+      if (Pointerp(obj))		/* lowtag odd      */
+	scavenge_pointer(addr);
+      else if(obj & 0x3)		/* some other immediate */
+	/*
+	 * Some random header. Process some type dependent number
+	 * of words. May still be inside object after call and the
+	 * next cell can be any lisp object. We can either recurse
+	 * by calling scavenge here or let the caller do it.
+	 */
+	count = scavenge_random_object(addr);
+      else
+	IMMED_OR_LOSE(obj);
+	  
+      addr += count;
+    }
+  return addr;
+}
+
+static void
+scavenge_cons(lispobj*where)
+{
+  /* Scavenge a two-word space */
+  scavenge_1word_obj(where + 0);	/* car */
+  scavenge_1word_obj(where + 1);	/* cdr */
+}
+static lispobj*scavenge_object(lispobj*start)
+{
+  int length = sizeOfObject((obj_t)start);
+  int words = scavenge_random_object(start);
+  gc_assert(length == words);
+  return start+length;
+}
+static lispobj*
+scavengex(lispobj*obj)
+{
+  /* Thing at this location is one of:
+   * a - basic object with header.
+   * b - cons object (no header).
+   * so that the starting and ending addresses are aligned.
+   */
+  gc_assert(ALIGNEDP(obj));
+  {
+    lispobj first_word = *obj;
+    OSC_t sc = sct[TypeOf(first_word)];
+    if(Pointerp(first_word) || sc.sc_kind == SC_IMMED)
+      {	/* Must be a cons object or unused space */
+	scavenge_cons((lispobj*)obj);
+	return obj + 2;
+      }
+    else
+      { /* Must be a complex object with header */
+	lispobj*next = scavenge_object(obj);
+	return next;
+      }
+  }
+}
+
+static void
+scavenge_space( lispobj*where, int words, char*name )
+{
+  int allocated = cgc_bytes_allocated;
+  lispobj*end = where + words;
+  lispobj*last;
+  bytes_copied = 0;
+  if(name)
+    dprintf(noise,("  %s",name));
+  while (where < end)
+    {
+      last = where;
+      where = scavengex(last);
+    }
+  gc_assert(where == end);
+  if(name)
+    dprintf(noise,(" %ld bytes moved, %ld bytes allocated.\n",
+		   bytes_copied, cgc_bytes_allocated - allocated));
+}
+
+static int boxed_registers[] = BOXED_REGISTERS;
+static void
+preserve_interrupt_context(struct sigcontext *context)
+{
+  int i;
+  /* Check each boxed register for a valid pointer and promote
+   * its region when found.
+   */
+  for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++)
+    {
+      int index = boxed_registers[i];
+      lispobj foo = SC_REG(context,index);
+      struct region*region = find_region((void*)foo);
+      if(region && region->space == oldspace)
+	move_to_newspace(region);
+    }
+}
+static void preserve_interrupt_contexts(void)
+{
+  int i, index;
+  struct sigcontext *context;
+
+  index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
+  dprintf(noise,("Number of active contexts: %d\n", index));
+
+  for (i = 0; i < index; i++)
+    {
+      context = lisp_interrupt_contexts[i];
+      preserve_interrupt_context(context); 
+    }
+}
+
+
+static void flip_spaces()
+{
+    struct space *temp = oldspace;
+    oldspace = newspace;
+    newspace = temp;
+}
+
+/* There should be no lisp objects on the C stack so will limit search
+ * to just the assigned lisp stack area.
+ */
+#if defined i386
+#define BOS (CONTROL_STACK_START+CONTROL_STACK_SIZE) /* x86-validate.h */
+/* Traverse stack in same direction as it was loaded to try and
+ * preserve original ordering of pages. Good for the VM system I hope.
+ */ 
+#define ACROSS_STACK(var) var=(void**)BOS-1; var > (void**)&var; var--
+#endif
+
+static void preserve_stack()
+{
+  void **addr;			/* auto var is current TOS */
+  for (ACROSS_STACK(addr))
+    {
+      void *ptr = *addr;
+      if (ptr > heap_base && ptr < heap_end)
+	{
+	  struct region *region = find_region(ptr);
+	  if (region != NULL && region->space == oldspace)
+	    {
+	      dprintf(0,("move %x\n",ptr));
+	      move_to_newspace(region);
+	    }
+	}
+    }
+}
+static void zero_stack()
+{
+  /* This is a bit tricky because we don't want to zap any
+   * stack frames between here and the call to mmap. For now,
+   * lets just be slow and careful.
+   */
+  long*p,*q;
+  os_vm_address_t base = (os_vm_address_t)CONTROL_STACK_START;
+  os_vm_size_t size = (char*)&base - (char*)base;
+#if 0
+  cgc_zero(base,size);
+#else
+  p = (long*)base;
+  q = (long*)&size;
+  while(p < q)
+    *p++ = 0;
+#endif
+  
+}
+
+#if defined STATIC_BLUE_BAG
+static int fast_static=1;
+static void scavenge_static()
+{
+  /* Static space consists of alternating layers of
+   * code objects that refer to read-only space (from purify),
+   * static non-code objects that need looking at, and
+   * newly loaded code objects that refer to dynamic space.
+   * The number of these areas depends on how many times purify
+   * ran while loading the system image. I will extend purify
+   * to maintain a list of collectable areas and use that list
+   * here to avoid scanning read-only code sections.
+   */
+  lispobj*ss0 = (lispobj*)PTR(NIL);
+  lispobj*ssa = (lispobj*)(PTR(STATIC_BLUE_BAG));
+  lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER);
+  lispobj bag = SymbolValue(STATIC_BLUE_BAG);
+  lispobj*end = NULL;
+  ssa += sizeOfObject(OBJECT_AT(ssa));	/* Genesis modifies plist entry */
+  if(fast_static)
+    {
+      scavenge_space(ss0, ssa-ss0, "Static0");
+      if(bag != NIL && LowtagOf(bag) == type_ListPointer)
+	{
+	  char sbuf[128];
+	  struct cons*cons = (struct cons*)PTR(bag);
+	  while(LowtagOf(cons->car) == type_ListPointer)
+	    {
+	      struct cons*pair = (struct cons*)PTR(cons->car);
+	      lispobj*ss1 = (lispobj*)pair->car;
+	      lispobj*ss2 = (lispobj*)pair->cdr;
+	      if(end == NULL)
+		end = ss2;
+	      sprintf(sbuf,"Static %x %d",ss1, ss2-ss1);
+	      scavenge_space(ss1, ss2-ss1, sbuf);
+	      if(cons->cdr != NIL && LowtagOf(cons->cdr) == type_ListPointer)
+		cons = (struct cons*)PTR(cons->cdr);
+	      else break;
+	    }
+	}
+      if(end != NULL)
+	scavenge_space(end, ssz-end, "Static");
+    }
+  else (scavenge_space(ss0, ssz-ss0, "Static-All"));
+}
+#endif
+
+static void scavenge_roots()
+{
+  /* So what should go here?
+   * When cgc starts up after purify/save all live objects
+   * are in read-only or static space, and anything in RO
+   * can point only to RO or STATIC and can't be changed.
+   * Anything in STATIC is subject to change (but not move).
+   * . not read-only-space	(probably most of the roots here)
+   * . static-space		(all compiled code at least)
+   * . binding-stack
+   * . weak-pointers
+   ?   do I allow GC from interrupt?)
+   * . interrupt-context	(regs same as stack)
+   ****
+   * Well, it turns out that RO space ain't exactly that as
+   * somehow apparently cached 'compact-info-environment' stuff
+   * modifies at least 2 locations in RO space. There is a note
+   * in globaldb.lisp that alludes to this and provides a post GC
+   * hook to blow the cache. Not a problem if gc is called from
+   * the lisp wrapper. UPDATE: Found purify bug which forced
+   * boxed vectors into RO. This may be what led to above.
+   *
+   */
+  lispobj*rs0 = (lispobj*)READ_ONLY_SPACE_START;
+  lispobj*rsz = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
+  lispobj*ss0 = (lispobj*)STATIC_SPACE_START;
+  lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER);
+  lispobj*bs0 = (lispobj*)BINDING_STACK_START;
+  lispobj*bsz = (lispobj*)SymbolValue(BINDING_STACK_POINTER);
+
+  if(scav_ro)
+    {
+      scav_ro++;
+      scavenge_space(rs0, rsz-rs0, "RO");
+      scav_ro--;
+    }
+  scavenge_static();
+  scavenge_space(bs0, bsz-bs0, "Binding Stack");
+
+  dprintf(noise,("Interrupt handlers (%u bytes) ...\n",
+		 sizeof(interrupt_handlers)));
+
+  scavenge((lispobj *) interrupt_handlers,
+	   sizeof(interrupt_handlers) / sizeof(lispobj));
+
+}
+
+static void scavenge_newspace()
+{
+  /* Scavenge is going to start at the beginning of newspace which
+   * is presumed to have some "root" object pointers lying about due
+   * to promoting regions that may be aimed at by stack resident pointers,
+   * copied small objects from scavenge_roots(), or promoted large_object
+   * regions. Scavenge() will flush out more copied objects/promoted
+   * regions that will get added to the end of newspace and eventually
+   * scanned by this code -- until all referenced things (and maybe some
+   * extra dead stuff) have been examined. At the end of this loop anything
+   * in oldspace is trash.
+   */
+    struct region *current;
+    current = newspace->regions;
+
+    while (current != NULL)
+      {
+	if (current->contains_small_objects)
+	  {
+	    void *obj = (char *)current + REGION_OVERHEAD;
+	    void *end = (char *)current + current->num_chunks*CHUNK_BYTES;
+	    while (obj < end)
+	      obj = SCAVENGE_OBJECT(OBJECT_AT(obj));
+	    gc_assert(obj == end);
+	  }
+	else
+	  SCAVENGE_OBJECT(OBJECT_AT(((char *)current + REGION_OVERHEAD)));
+	current = current->next;
+      }
+}
+
+static void free_oldspace()
+{
+    struct region *region, *next;
+    chunks_freed = 0;
+    for (region = oldspace->regions; region != NULL; region = next)
+      {
+	gc_assert(region->space != newspace);
+	next = region->next;
+	free_region(region);
+      }
+    oldspace->alloc_ptr = NULL;
+    oldspace->alloc_end = NULL;
+    oldspace->regions = NULL;
+    oldspace->regions_tail = &oldspace->regions;
+}
+
+static void verify_space(lispobj*start, size_t words)
+{
+  while(words > 0)
+    {
+      size_t count = 1;
+      lispobj thing = *(lispobj*)start;
+      if(Pointerp(thing))
+	{
+	  struct region*region = find_region((void*)thing);
+	  if(region && region->space == NULL)
+	    fprintf(stderr,"Ptr %x @ %x sees Junk\n",thing,start);
+	}
+      else
+	if(thing & 0x3)
+	  {
+	    obj_t obj = (obj_t)start;
+	    switch(TypeOf(obj->header))
+	      {
+	      case type_CodeHeader:
+		{
+		  lispobj object = *start;
+		  struct code *code;
+		  int nheader_words, ncode_words, nwords;
+		  lispobj fheaderl;
+		  struct function *fheaderp;
+		  
+		  code = (struct code *) start;
+		  ncode_words = fixnum_value(code->code_size);
+		  nheader_words = HeaderValue(object);
+		  nwords = ncode_words + nheader_words;
+		  nwords = CEILING(nwords, 2);
+		  /* Scavenge the boxed section of the code data block */
+		  verify_space(start + 1, nheader_words - 1);
+		  
+		  /* Scavenge the boxed section of each function object in the
+		   * code data block.
+		   */
+		  fheaderl = code->entry_points;
+		  while (fheaderl != NIL) {
+		    fheaderp = (struct function *) PTR(fheaderl);
+		    gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
+		    verify_space(&fheaderp->name, 1);
+		    verify_space(&fheaderp->arglist, 1);
+		    verify_space(&fheaderp->type, 1);
+		    fheaderl = fheaderp->next;
+		  }
+		  count = nwords;
+		  break;
+		}
+	      default:
+		{
+		  OSC_t class = sct[TypeOf(obj->header)];
+		  switch(class.sc_kind)
+		    {
+		    case SC_ISBOXED:
+		    case SC_IMMED:
+		      count = 1;
+		      break;
+		    case SC_UNBOXED:
+		    case SC_STRING:
+		    case SC_VECTOR:
+		      count = sizeOfObject((obj_t)start);
+		      break;
+		    default:
+		      gc_abort();
+		    }
+		  break;
+		}
+	      }
+	  }
+      start += count;
+      words -= count;
+    }
+}
+
+/* For debug/test only. */
+static void 
+verify_gc()
+{
+  lispobj*rs0 = (lispobj*)READ_ONLY_SPACE_START;
+  lispobj*rsz = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
+  lispobj*ss0 = (lispobj*)STATIC_SPACE_START;
+  lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER);
+  lispobj*bs0 = (lispobj*)BINDING_STACK_START;
+  lispobj*bsz = (lispobj*)SymbolValue(BINDING_STACK_POINTER);
+  lispobj*cs0 = (lispobj*)&rs0;
+  lispobj*csz = (lispobj*)BOS;
+  /* can't check stack easily because there may be non-valid 
+   * objects there (thats why we're doing this cgc stuff. In
+   * particular there are raw return addresses which can be very
+   * descriptorish looking!!!
+
+  verify_space(cs0, csz-cs0);
+  */
+  verify_space(rs0, rsz-rs0);
+  verify_space(ss0, ssz-ss0);
+  verify_space(bs0, bsz-bs0);
+}
+
+static int dolog=0;			/* log copy ops to file */
+static int dover=0;			/* hunt pointers to oldspace */
+void cgc_collect_garbage()
+{
+  unsigned long allocated =  cgc_bytes_allocated;
+
+  dprintf(noise,("GC\n"));
+  if(dolog && !log)
+    log=fopen("LOG.tmp","w");
+
+  /* Initialize the weak pointer list. */
+  weak_pointers = NULL;
+
+  dprintf(noise,("[Flip Spaces]\n"));
+  flip_spaces();
+  preserve_interrupt_contexts();
+  dprintf(noise,("[Preserve Stack]\n"));
+  preserve_stack();
+  dprintf(noise,("[Scavenge Roots]\n"));
+  scavenge_roots();
+  dprintf(noise,("[Scavenge New]\n"));
+  scavenge_newspace();
+  scan_weak_pointers();
+  dprintf(noise,("[Free Oldspace]\n"));
+  free_oldspace();
+  if(dover) {
+    dprintf(noise,("[Checking]\n"));
+    verify_gc();}
+  dprintf(noise,("[Compacting]\n"));
+  compact_free_regions();
+  /* The stack will be zeroed by scrub-control-stack in sub-gc which
+     is more effecient. */
+  /* zero_stack(); */
+  if(log)
+    fclose(log);
+  log=NULL;
+  dprintf(noise,("  %ld bytes copied.\n",(cgc_bytes_allocated - allocated)));
+  dprintf(noise,("  %ld bytes (%ld pages) reclaimed.\n",
+	     chunks_freed*CHUNK_BYTES, chunks_freed));
+  cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES;
+  maybe_gc_called = 0;
+}
+void cgc_free_heap()
+{
+  /* Like above but just zap everything 'cause purify has
+   * cleaned house!
+   */
+  unsigned long allocated =  cgc_bytes_allocated;
+  flip_spaces();
+  free_oldspace();
+  compact_free_regions();
+#if 0 /* purify is currently running on the C stack so don't do this */
+  zero_stack();
+#endif
+  cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES;
+}
+
+
+void
+cgc_init_collector()
+{
+    int max_blocks;
+    heap_base = (void*)DYNAMIC_0_SPACE_START;
+
+    /* I could actually use both spaces here but just 1 for now */
+    heap_end = (char*)heap_base + DYNAMIC_SPACE_SIZE;
+
+    max_blocks = BLOCK_NUMBER(heap_end) - BLOCK_NUMBER(heap_base);
+    if((block_table_base = malloc(sizeof(struct cluster *) * max_blocks))
+       != NULL)
+      {
+	memset(block_table_base, 0, sizeof(struct cluster *) * max_blocks);
+	block_table = (block_table_base - BLOCK_NUMBER(heap_base));
+
+	space_0.regions_tail = &space_0.regions;
+	space_1.regions_tail = &space_1.regions;
+
+	newspace = &space_0;
+	oldspace = &space_1;
+      }
+    else perror("malloc cgc block table");
+    init_osc();				/* Object Storage Class table */
+}
+
+
+void do_pending_interrupt(void);
+
+int use_cgc_p = 0;
+char*alloc(int nbytes)
+{
+  /* Alloc is only called from lisp code to allocate a number of
+     words, the cgc GC uses cgc_alloc directly as the checks of the
+     heap size and is not needed and interrupts are allways disabled
+     during a GC. */
+
+  /* Assumes nbytes includes alignment. Python arranges for that
+   * but the C startup code needed some help.
+   */
+#if 0
+  int bytes = (nbytes + (ALIGN_BYTES-1)) & ~(ALIGN_BYTES-1);
+  if(bytes != nbytes)
+    fprintf(stderr,"Fixing unaligned allocation length %d.\n",nbytes);
+  nbytes = bytes;
+#endif
+  if(!use_cgc_p)
+    {
+      char*current = (char*)SymbolValue(ALLOCATION_POINTER);
+      char*nxtfree = current + nbytes;
+      SetSymbolValue(ALLOCATION_POINTER, (lispobj)nxtfree);
+      return current;
+    }
+  else
+    {
+      /* Lacking an interrupt driven scheme to notice when a GC might
+       * be wise, we add some more overhead to the allocator here
+       * before any needed state is acquired. Only need to do it once
+       * though because lisp will remember *need to collect garbage*
+       * and get to it when it can.  */
+      if( auto_gc_trigger		/* Only when enabled */
+	  && cgc_bytes_allocated > auto_gc_trigger
+	  && !maybe_gc_called++)		/* Only once         */
+	funcall0(SymbolFunction(MAYBE_GC));
+      
+      if (SymbolValue(INTERRUPTS_ENABLED) == NIL)
+	/* Interrupts are disable so no special care is needed */
+	return cgc_alloc(nbytes);
+      else
+	{
+	  void *result;
+	  /* Interrupts are enabled so set *interrupt-enabled* to nil
+	     before calling cgc_alloc to prevent cgc_alloc from being
+	     re-entered. */
+	  SetSymbolValue(INTERRUPTS_ENABLED, NIL);
+	  
+	  result = cgc_alloc(nbytes);
+	  
+	  /* Restore *interrupts-enabled* */
+	  SetSymbolValue(INTERRUPTS_ENABLED, T);
+	  
+	  /* Check if an interrupt occured */
+	  if (SymbolValue(INTERRUPT_PENDING) == T)
+	    /* Handle any interrupts that occured during cgc_alloc */
+	    do_pending_interrupt();
+
+	  return result;
+	}
+    }
+}
+
+/* Interface to history. */
+void set_auto_gc_trigger(unsigned long dynamic_usage)
+{
+  auto_gc_trigger += dynamic_usage;
+}
+void clear_auto_gc_trigger(void)
+{
+  auto_gc_trigger = 0;
+}
+void gc_init(void)
+{
+    cgc_init_collector();
+}
+void collect_garbage()
+{
+  /* SUB-GC wraps without-interrupt around call, but this
+   * is going to absolutely block SIGINT.
+   */
+  /* #define REALLY_SAFE */
+#if defined REALLY_SAFE
+  sigset_t newmask,oldmask;
+  sigemptyset(&newmask);
+  sigaddset(&newmask, SIGINT);
+  sigprocmask(SIG_BLOCK, &newmask, &oldmask);
+#endif
+  cgc_collect_garbage();
+#if defined REALLY_SAFE
+  sigprocmask(SIG_SETMASK, &oldmask, NULL);
+#endif
+
+}
diff --git a/lisp/cgc.h b/lisp/cgc.h
new file mode 100644
index 000000000..18dc9e5ba
--- /dev/null
+++ b/lisp/cgc.h
@@ -0,0 +1,7 @@
+/* cgc.h -*- Mode: C; comment-column: 40; -*-
+ *
+ * Conservative GC for CMUCL X86
+ *
+ */
+void*cgc_alloc(int);
+void cgc_free_heap(void);
diff --git a/lisp/coreparse.c b/lisp/coreparse.c
index 8d0c88796..59c9ad1c3 100644
--- a/lisp/coreparse.c
+++ b/lisp/coreparse.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.4 1994/07/05 16:06:45 hallgren Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.5 1997/01/21 00:28:13 ram Exp $ */
 #include <stdio.h>
 #include <sys/types.h>
 #include <sys/file.h>
@@ -35,12 +35,12 @@ static void process_directory(int fd, long *ptr, int count)
 	if (len != 0) {
 	    os_vm_address_t real_addr;
 #ifdef PRINTNOISE
-	    printf("Mapping %d bytes at 0x%x.\n", len, addr);
+	    printf("Mapping %ld bytes at 0x%lx.\n", len, addr);
 #endif
 	    real_addr=os_map(fd, offset, addr, len);
 	    if(real_addr!=addr)
 	    fprintf(stderr,
-	"process_directory: file mapped in wrong place! (0x%08x != 0x%08x)\n",
+	"process_directory: file mapped in wrong place! (0x%08x != 0x%08lx)\n",
 		real_addr,
 		addr);
 	}
@@ -55,7 +55,7 @@ static void process_directory(int fd, long *ptr, int count)
 		 && addr != (os_vm_address_t)dynamic_1_space)
 		printf("Strange ... dynamic space lossage.\n");
 		current_dynamic_space = (lispobj *)addr;
-#ifdef ibmrt
+#if defined(ibmrt) || defined(i386)
 	    SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
 #else
 	    current_dynamic_space_free_pointer = free_pointer;
@@ -68,7 +68,7 @@ static void process_directory(int fd, long *ptr, int count)
 	    /* Don't care about read only space */
 	    break;
 	  default:
-	    printf("Strange space ID: %d; ignored.\n", id);
+	    printf("Strange space ID: %ld; ignored.\n", id);
 	    break;
 	}
 	entry++;
@@ -105,7 +105,7 @@ lispobj load_core_file(char *file)
     val = *ptr++;
 
     if (val != CORE_MAGIC) {
-	fprintf(stderr, "Invalid magic number: 0x%x should have been 0x%x.\n",
+	fprintf(stderr, "Invalid magic number: 0x%lx should have been 0x%x.\n",
 	val, CORE_MAGIC); 
 	exit(1);
     }
@@ -147,7 +147,7 @@ lispobj load_core_file(char *file)
 	    break;
 
 	  default:
-	    printf("Unknown core file entry: %d; skipping.\n", val);
+	    printf("Unknown core file entry: %ld; skipping.\n", val);
 	    break;
 	}
 
diff --git a/lisp/dynbind.c b/lisp/dynbind.c
index 839c1bd7b..e2dbcbac3 100644
--- a/lisp/dynbind.c
+++ b/lisp/dynbind.c
@@ -1,5 +1,5 @@
 /*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.c,v 1.1 1992/07/28 20:14:22 wlott Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.c,v 1.2 1997/01/21 00:28:13 ram Exp $
  * 
  * Support for dynamic binding from C.
  */
@@ -9,7 +9,7 @@
 #include "globals.h"
 #include "dynbind.h"
 
-#ifdef ibmrt
+#if defined(ibmrt) || defined(i386)
 #define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER))
 #define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value))
 #else
diff --git a/lisp/globals.c b/lisp/globals.c
index a8d9595d5..bc03c1880 100644
--- a/lisp/globals.c
+++ b/lisp/globals.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.c,v 1.1 1992/07/28 20:14:29 wlott Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.c,v 1.2 1997/01/21 00:28:13 ram Exp $ */
 
 /* Variables everybody needs to look at or frob on. */
 
@@ -21,6 +21,9 @@ lispobj *static_space;
 lispobj *dynamic_0_space;
 lispobj *dynamic_1_space;
 lispobj *control_stack;
+#ifdef i386
+lispobj *control_stack_end;
+#endif
 lispobj *binding_stack;
 
 lispobj *current_dynamic_space;
@@ -45,7 +48,12 @@ void globals_init(void)
     foreign_function_call_active = 1;
 
     /* Initialize the current lisp state. */
+#ifndef i386
     current_control_stack_pointer = control_stack;
+#else
+    current_control_stack_pointer = control_stack_end;
+#endif
+
     current_control_frame_pointer = (lispobj *)0;
 #ifndef BINDING_STACK_POINTER
     current_binding_stack_pointer = binding_stack;
diff --git a/lisp/globals.h b/lisp/globals.h
index c6265ac9d..207e368dc 100644
--- a/lisp/globals.h
+++ b/lisp/globals.h
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.3 1994/10/24 20:03:32 ram Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.4 1997/01/21 00:28:13 ram Exp $ */
 
 #if !defined(_INCLUDE_GLOBALS_H_)
 #define _INCLUDED_GLOBALS_H_
@@ -11,7 +11,7 @@ extern int foreign_function_call_active;
 
 extern lispobj *current_control_stack_pointer;
 extern lispobj *current_control_frame_pointer;
-#ifndef ibmrt
+#if !defined(ibmrt) && !defined(i386)
 extern lispobj *current_binding_stack_pointer;
 #endif
 
@@ -21,9 +21,11 @@ extern lispobj *dynamic_0_space;
 extern lispobj *dynamic_1_space;
 extern lispobj *control_stack;
 extern lispobj *binding_stack;
-
+#ifdef i386
+extern lispobj *control_stack_end;
+#endif
 extern lispobj *current_dynamic_space;
-#ifndef ibmrt
+#if !defined(ibmrt) && !defined(i386)
 extern lispobj *current_dynamic_space_free_pointer;
 extern lispobj *current_auto_gc_trigger;
 #endif
@@ -48,11 +50,19 @@ extern void globals_init(void);
 #define EXTERN(name,bytes) .globl _/**/name
 #endif
 
+#ifdef i386
+#ifdef __linux__
+#define EXTERN(name,bytes) .globl _/**/name
+#else
+#define EXTERN(name,bytes) .global _ ## name
+#endif
+#endif
+
 EXTERN(foreign_function_call_active, 4)
 
 EXTERN(current_control_stack_pointer, 4)
 EXTERN(current_control_frame_pointer, 4)
-#ifndef ibmrt
+#if !defined(ibmrt) && !defined(i386)
 EXTERN(current_binding_stack_pointer, 4)
 EXTERN(current_dynamic_space_free_pointer, 4)
 #endif
diff --git a/lisp/interr.c b/lisp/interr.c
index 0b6117a18..5e892139e 100644
--- a/lisp/interr.c
+++ b/lisp/interr.c
@@ -1,5 +1,5 @@
 /*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.c,v 1.2 1994/10/24 20:04:27 ram Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.c,v 1.3 1997/01/21 00:28:13 ram Exp $
  *
  * Stuff to handle internal errors.
  *
@@ -113,10 +113,10 @@ void internal_error(struct sigcontext *context)
 	    printf("\t0x%08x\n", SC_REG(context, offset));
 	    break;
 	  case sc_SignedReg:
-	    printf("\t%ld\n", SC_REG(context, offset));
+	    printf("\t%d\n", SC_REG(context, offset));
 	    break;
 	  case sc_UnsignedReg:
-	    printf("\t%lu\n", SC_REG(context, offset));
+	    printf("\t%u\n", SC_REG(context, offset));
 	    break;
 #ifdef sc_SingleFloatReg
 	  case sc_SingleFloatReg:
diff --git a/lisp/interrupt.c b/lisp/interrupt.c
index 661e88eaf..d89f90d36 100644
--- a/lisp/interrupt.c
+++ b/lisp/interrupt.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.5 1994/10/24 20:05:30 ram Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.6 1997/01/21 00:28:13 ram Exp $ */
 
 /* Interrupt handing magic. */
 
@@ -26,6 +26,7 @@
 #include "interr.h"
 
 boolean internal_errors_enabled = 0;
+boolean my_error_stuff_ok = 1;
 
 struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS];
 
@@ -56,10 +57,10 @@ static boolean maybe_gc_pending = FALSE;
 * Utility routines used by various signal handlers.              *
 \****************************************************************/
 
-void fake_foreign_function_call(struct sigcontext *context)
+void 
+fake_foreign_function_call(struct sigcontext *context)
 {
     int context_index;
-    lispobj oldcont;
     
     /* Get current LISP state from context */
 #ifdef reg_ALLOC
@@ -130,7 +131,8 @@ void fake_foreign_function_call(struct sigcontext *context)
     foreign_function_call_active = 1;
 }
 
-void undo_fake_foreign_function_call(struct sigcontext *context)
+void 
+undo_fake_foreign_function_call(struct sigcontext *context)
 {
     /* Block all blockable signals */
 #ifdef POSIX_SIGS
@@ -156,16 +158,21 @@ void undo_fake_foreign_function_call(struct sigcontext *context)
 #endif
 }
 
-void interrupt_internal_error(HANDLER_ARGS,
+void 
+interrupt_internal_error(HANDLER_ARGS,
 			      boolean continuable)
 {
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
 #ifdef POSIX_SIGS
     sigprocmask(SIG_SETMASK,&context->uc_sigmask, 0);
 #else
     sigsetmask(context->sc_mask);
 #endif
     fake_foreign_function_call(context);
-    if (internal_errors_enabled)
+    if (internal_errors_enabled && my_error_stuff_ok)
 	funcall2(SymbolFunction(INTERNAL_ERROR), alloc_sap(context),
 		 continuable ? T : NIL);
     else
@@ -175,7 +182,8 @@ void interrupt_internal_error(HANDLER_ARGS,
 	arch_skip_instruction(context);
 }
 
-void interrupt_handle_pending(struct sigcontext *context)
+void 
+interrupt_handle_pending(struct sigcontext *context)
 {
     boolean were_in_lisp = !foreign_function_call_active;
 
@@ -199,8 +207,12 @@ void interrupt_handle_pending(struct sigcontext *context)
 	signal = pending_signal;
 	code = pending_code;
 	pending_signal = 0;
-	/* pending_code = 0; /**/
+	/* pending_code = 0; */
+#ifdef __linux__
+        interrupt_handle_now(signal,*context);
+#else
 	interrupt_handle_now(signal, PASSCODE(code), context);
+#endif
     }
 #ifdef POSIX_SIGS
     context->uc_sigmask = pending_mask;
@@ -217,10 +229,19 @@ void interrupt_handle_pending(struct sigcontext *context)
 *    the two main signal handlers.                               *
 \****************************************************************/
 
-void interrupt_handle_now(HANDLER_ARGS)
+void 
+interrupt_handle_now(HANDLER_ARGS)
 {
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
     int were_in_lisp;
     union interrupt_handler handler;
+
+#ifdef __linux__
+    __setfpucw(contextstruct.fpstate->cw);
+#endif
     
     handler = interrupt_handlers[signal];
 
@@ -254,14 +275,23 @@ void interrupt_handle_now(HANDLER_ARGS)
 	         alloc_sap(context));
 #endif
     else
+#ifdef __linux__
+        (*handler.c)(signal, contextstruct);
+#else
         (*handler.c)(signal, code, context);
+#endif
     
     if (were_in_lisp)
         undo_fake_foreign_function_call(context);
 }
 
-static void maybe_now_maybe_later(HANDLER_ARGS)
+static void 
+maybe_now_maybe_later(HANDLER_ARGS)
 {
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
     SAVE_CONTEXT(); /**/
 
     if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
@@ -288,7 +318,11 @@ static void maybe_now_maybe_later(HANDLER_ARGS)
 #endif
 	arch_set_pseudo_atomic_interrupted(context);
     } else
+#ifdef __linux__
+        interrupt_handle_now(signal,contextstruct);
+#else
         interrupt_handle_now(signal, code, context);
+#endif
 }
 
 /****************************************************************\
@@ -312,6 +346,10 @@ static boolean gc_trigger_hit(HANDLER_ARGS)
 
 boolean interrupt_maybe_gc(HANDLER_ARGS)
 {
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
     if (!foreign_function_call_active
 #ifndef INTERNAL_GC_TRIGGER
 		  && gc_trigger_hit(signal, code, context)
@@ -362,16 +400,36 @@ void interrupt_install_low_level_handler
     sa.sa_flags = SA_RESTART | SA_SIGINFO;
 
     sigaction(signal, &sa, NULL);
+#else
+#if defined __FreeBSD__ && 0	/* hack in progress */
+/* sort of like POSIX -- maybe fixed in new release */
+#define FILLBLOCKSET(s) (sigaddset(s,SIGHUP), sigaddset(s,SIGINT), \
+		   sigaddset(s,SIGQUIT), sigaddset(s,SIGPIPE), \
+		   sigaddset(s,SIGALRM), sigaddset(s,SIGURG), \
+		   sigaddset(s,SIGTSTP), sigaddset(s,SIGCHLD), \
+		   sigaddset(s,SIGIO), sigaddset(s,SIGXCPU), \
+                   sigaddset(s,SIGXFSZ), sigaddset(s,SIGVTALRM), \
+		   sigaddset(s,SIGPROF), sigaddset(s,SIGWINCH), \
+		   sigaddset(s,SIGUSR1), sigaddset(s,SIGUSR2))
+
+    struct sigaction sa;
+    sa.sa_handler = handler;
+    sigemptyset(&sa.sa_mask);
+    FILLBLOCKSET(&sa.sa_mask);
+    sa.sa_flags = SA_RESTART | SA_SIGINFO;
+    sa.sa_flags |= SA_ONSTACK;
 #else
     struct sigvec sv;
 
     sv.sv_handler=handler;
     sv.sv_mask=BLOCKABLE;
     sv.sv_flags=0;
-
+#if defined USE_SIG_STACK
+    sv.sv_flags |= SV_ONSTACK;	/* use separate stack */
+#endif
     sigvec(signal,&sv,NULL);
 #endif
-
+#endif    
     interrupt_low_level_handlers[signal]=(handler==SIG_DFL ? 0 : handler);
 }
 
@@ -430,7 +488,9 @@ unsigned long install_handler(int signal,
 
 	sv.sv_mask = BLOCKABLE;
 	sv.sv_flags = 0;
-
+#if defined USE_SIG_STACK
+	sv.sv_flags = SV_ONSTACK;
+#endif
 	sigvec(signal, &sv, NULL);
     }
 
diff --git a/lisp/linux-stubs.S b/lisp/linux-stubs.S
new file mode 100644
index 000000000..3af204f0e
--- /dev/null
+++ b/lisp/linux-stubs.S
@@ -0,0 +1,171 @@
+/*	linux-stubs.S
+
+	$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/linux-stubs.S,v 1.1 1997/01/21 00:28:13 ram Exp $
+
+	These are needed because the locations of the
+	libraries are filled in by ld.so at runtime.
+*/
+
+	.file	"linux-stubs.S"
+	.version	"01.01"
+gcc2_compiled.:
+.text
+#define doe(fct) \
+	.align 16 ;\
+.globl PVE_stub_ ## fct ;\
+	.type	 PVE_stub_ ## fct,@function ;\
+PVE_stub_ ## fct: ;\
+	jmp fct ;\
+.L ## fct ## e1: ;\
+	.size	 PVE_stub_ ## fct,.L ## fct ## e1-PVE_stub_ ## fct  ;
+
+ doe(malloc)
+ doe(free)
+ doe(isatty)
+ doe(accept)
+ doe(access)
+ doe(acct)
+ doe(adjtime)
+ doe(bind)
+ doe(brk)
+ doe(chdir)
+ doe(chmod)
+ doe(chown)
+ doe(chroot)
+ doe(close)
+ doe(connect)
+ doe(creat)
+ doe(dup)
+ doe(dup2)
+ doe(execve)
+ doe(exit)
+ doe(fchmod)
+ doe(fchown)
+ doe(fcntl)
+ doe(flock)
+ doe(fork)
+ doe(fstat)
+ doe(fsync)
+ doe(ftruncate)
+ doe(getdtablesize)
+ doe(getegid)
+ doe(geteuid)
+ doe(getgid)
+ doe(getgroups)
+ doe(gethostid)
+ doe(gethostname)
+ doe(getitimer)
+ doe(getpagesize)
+ doe(getpeername)
+ doe(getpgrp)
+ doe(getpid)
+ doe(getppid)
+ doe(getpriority)
+ doe(getrlimit)
+ doe(getrusage)
+ doe(getsockname)
+ doe(getsockopt)
+ doe(gettimeofday)
+ doe(getuid)
+ doe(ioctl)
+ doe(kill)
+ doe(killpg)
+ doe(link)
+ doe(listen)
+ doe(lseek)
+ doe(lstat)
+ doe(mkdir)
+ doe(mknod)
+ doe(mount)
+ doe(open)
+ doe(pipe)
+ doe(ptrace)
+ doe(read)
+ doe(readlink)
+ doe(readv)
+ doe(reboot)
+ doe(recv)
+ doe(recvfrom)
+ doe(recvmsg)
+ doe(rename)
+ doe(rmdir)
+ doe(sbrk)
+ doe(select)
+ doe(send)
+ doe(sendmsg)
+ doe(sendto)
+ doe(setgroups)
+ doe(sethostid)
+ doe(sethostname)
+ doe(setitimer)
+ doe(setpgrp)
+ doe(setpriority)
+ doe(setregid)
+ doe(setreuid)
+ doe(setrlimit)
+ doe(setsockopt)
+ doe(settimeofday)
+ doe(shutdown)
+ doe(sigblock)
+ doe(sigpause)
+ doe(sigreturn)
+ doe(sigsetmask)
+ doe(socket)
+ doe(socketpair)
+ doe(stat)
+ doe(swapon)
+ doe(symlink)
+ doe(sync)
+ doe(syscall)
+ doe(closedir)
+ doe(opendir)
+ doe(readdir)
+ doe(tcgetattr)
+ doe(tcsetattr)
+ doe(truncate)
+ doe(umask)
+ doe(umount)
+ doe(unlink)
+ doe(utimes)
+ doe(vfork)
+ doe(vhangup)
+ doe(wait)
+ doe(wait3)
+ doe(write)
+ doe(writev)
+ doe(cos)
+ doe(sin)
+ doe(tan)
+ doe(acos)
+ doe(asin)
+ doe(atan)
+ doe(atan2)
+ doe(sinh)
+ doe(cosh)
+ doe(tanh)
+ doe(asinh)
+ doe(acosh)
+ doe(atanh)
+ doe(exp)
+ doe(expm1)
+ doe(log)
+ doe(log10)
+ doe(log1p)
+ doe(pow)
+ doe(cbrt)
+ doe(sqrt)
+ doe(hypot)
+ doe(gethostbyname)
+ doe(gethostbyaddr)
+ doe(setpgid)
+ doe(getpgid)
+ doe(timezone)
+ doe(altzone)
+ doe(daylight)
+ doe(tzname)
+ doe(dlopen)
+ doe(dlsym)
+ doe(dlclose)
+ doe(dlerror)
+ doe(getwd)
+ doe(ttyname)
diff --git a/lisp/lisp.c b/lisp/lisp.c
index fff95e20f..a910102dc 100644
--- a/lisp/lisp.c
+++ b/lisp/lisp.c
@@ -1,7 +1,7 @@
 /*
  * main() entry point for a stand alone lisp image.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.10 1994/11/01 19:35:49 ram Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.11 1997/01/21 00:28:13 ram Exp $
  *
  */
 
@@ -39,9 +39,13 @@
 
 static void sigint_handler(HANDLER_ARGS)
 {
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
     SAVE_CONTEXT();
 
-    printf("\nSIGINT hit at 0x%08X\n", SC_PC(context));
+    printf("\nSIGINT hit at 0x%08lX\n", SC_PC(context));
     ldb_monitor();
 }
 
@@ -87,7 +91,7 @@ void main(int argc, char *argv[], char *envp[])
 #ifdef MACH
     mach_init();
 #endif
-#ifdef SVR4
+#if defined(SVR4) || defined(__linux__)
     tzset();
 #endif
 
@@ -145,11 +149,15 @@ void main(int argc, char *argv[], char *envp[])
 	}
 	if (core == NULL) {
 	    /* Note: the /usr/misc/.cmucl/lib/ default path is also wired
-	    /* into the lisp code in .../code/save.lisp. */
+	       into the lisp code in .../code/save.lisp. */
 #ifdef MACH
 	    strcpy(buf, "/usr/misc/.cmucl/lib/");
+#else
+#ifdef __linux__
+	    strcpy(buf, "/usr/lib/cmucl/");
 #else
 	    strcpy(buf, "/usr/local/lib/cmucl/lib/");
+#endif
 #endif
 	    strcat(buf, default_core);
 	    core = buf;
@@ -163,10 +171,19 @@ void main(int argc, char *argv[], char *envp[])
 
     initial_function = load_core_file(core);
 
+#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
+    {
+      extern int use_cgc_p;
+      lispobj x = SymbolValue(X86_CGC_ACTIVE_P);
+      if(x != type_UnboundMarker && x != NIL)
+	use_cgc_p = 1;		/* enable allocator */
+    }
+#endif
+
 #ifdef BINDING_STACK_POINTER
     SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
 #endif
-#ifdef INTERNAL_GC_TRIGGER
+#if defined INTERNAL_GC_TRIGGER && !defined i386
     SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1));
 #endif
 
diff --git a/lisp/lisp.h b/lisp/lisp.h
index a30b9b8c7..ecd37773f 100644
--- a/lisp/lisp.h
+++ b/lisp/lisp.h
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.h,v 1.2 1994/03/27 15:27:35 hallgren Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.h,v 1.3 1997/01/21 00:28:13 ram Exp $ */
 
 #ifndef _LISP_H_
 #define _LISP_H_
@@ -18,8 +18,14 @@
 #define SYMBOL(obj) ((struct symbol *)((obj)-type_OtherPointer))
 #define FDEFN(obj) ((struct fdefn *)((obj)-type_OtherPointer))
 
-#ifndef alpha
+#if !defined alpha
 typedef unsigned long lispobj;
+
+#if defined(__FreeBSD__) || defined(__linux__)
+typedef unsigned int u32;
+typedef signed int s32;
+#endif
+
 #else
 typedef unsigned int u32;
 typedef signed int s32;
diff --git a/lisp/monitor.c b/lisp/monitor.c
index 767a34217..ba7de0f10 100644
--- a/lisp/monitor.c
+++ b/lisp/monitor.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.5 1994/10/24 20:06:50 ram Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.6 1997/01/21 00:28:13 ram Exp $ */
 
 #include <stdio.h>
 #include <sys/types.h>
@@ -102,7 +102,7 @@ static void dump_cmd(char **ptr)
 
     while (count-- > 0) {
 #ifndef alpha
-        printf("0x%08X: ", (unsigned long) addr);
+        printf("0x%08lX: ", (unsigned long) addr);
 #else
         printf("0x%08X: ", (u32) addr);
 #endif
@@ -115,7 +115,7 @@ static void dump_cmd(char **ptr)
             unsigned short *sptr = (unsigned short *)addr;
             unsigned char *cptr = (unsigned char *)addr;
 
-            printf("0x%08x   0x%04x 0x%04x   0x%02x 0x%02x 0x%02x 0x%02x    %c%c%c%c\n", lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), visable(cptr[3]));
+            printf("0x%08lx   0x%04x 0x%04x   0x%02x 0x%02x 0x%02x 0x%02x    %c%c%c%c\n", lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), visable(cptr[3]));
         }
         else
             printf("invalid address\n");
@@ -135,23 +135,26 @@ static void print_cmd(char **ptr)
 
 static void regs_cmd(char **ptr)
 {
-    printf("CSP\t=\t0x%08X\n", (unsigned long)current_control_stack_pointer);
-    printf("FP\t=\t0x%08X\n", (unsigned long)current_control_frame_pointer);
-#ifndef ibmrt
+    printf("CSP\t=\t0x%08lX\n", (unsigned long)current_control_stack_pointer);
+    printf("FP\t=\t0x%08lX\n", (unsigned long)current_control_frame_pointer);
+#if !defined(ibmrt) && !defined(i386)
     printf("BSP\t=\t0x%08X\n", (unsigned long)current_binding_stack_pointer);
 #endif
+#ifdef i386
+    printf("BSP\t=\t0x%08X\n", SymbolValue(BINDING_STACK_POINTER));
+#endif
 
-    printf("DYNAMIC\t=\t0x%08X\n", (unsigned long)current_dynamic_space);
-#ifdef ibmrt
-    printf("ALLOC\t=\t0x08X\n", SymbolValue(ALLOCATION_POINTER));
-    printf("TRIGGER\t=\t0x08X\n", SymbolValue(INTERNAL_GC_TRIGGER));
+    printf("DYNAMIC\t=\t0x%08lX\n", (unsigned long)current_dynamic_space);
+#if defined(ibmrt) || defined(i386)
+    printf("ALLOC\t=\t0x%08lX\n", SymbolValue(ALLOCATION_POINTER));
+    printf("TRIGGER\t=\t0x%08lX\n", SymbolValue(INTERNAL_GC_TRIGGER));
 #else
     printf("ALLOC\t=\t0x%08X\n",
 	   (unsigned long)current_dynamic_space_free_pointer);
     printf("TRIGGER\t=\t0x%08X\n", (unsigned long)current_auto_gc_trigger);
 #endif
-    printf("STATIC\t=\t0x%08X\n", SymbolValue(STATIC_SPACE_FREE_POINTER));
-    printf("RDONLY\t=\t0x%08X\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+    printf("STATIC\t=\t0x%08lX\n", SymbolValue(STATIC_SPACE_FREE_POINTER));
+    printf("RDONLY\t=\t0x%08lX\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
 
 #ifdef MIPS
     printf("FLAGS\t=\t0x%08x\n", current_flags_register);
@@ -198,10 +201,10 @@ static void search_cmd(char **ptr)
     start = end = addr;
     lastcount = count;
 
-    printf("searching for 0x%x at 0x%08X\n", val, (unsigned long)end);
+    printf("searching for 0x%x at 0x%08lX\n", val, (unsigned long)end);
 
     while (search_for_type(val, &end, &count)) {
-        printf("found 0x%x at 0x%08X:\n", val, (unsigned long)end);
+        printf("found 0x%x at 0x%08lX:\n", val, (unsigned long)end);
         obj = *end;
         addr = end;
         end += 2;
@@ -232,26 +235,26 @@ static void call_cmd(char **ptr)
 		    goto fdefn;
 		}
 	    }
-	    printf("symbol 0x%08x is undefined.\n", thing);
+	    printf("symbol 0x%08lx is undefined.\n", thing);
 	    return;
 
 	  case type_Fdefn:
 	  fdefn:
 	    function = FDEFN(thing)->function;
 	    if (function == NIL) {
-		printf("fdefn 0x%08x is undefined.\n", thing);
+		printf("fdefn 0x%08lx is undefined.\n", thing);
 		return;
 	    }
 	    break;
 	  default:
 	    printf(
-	      "0x%08x is not a function pointer, symbol, or fdefn object.\n",
+	      "0x%08lx is not a function pointer, symbol, or fdefn object.\n",
 		   thing);
 	    return;
 	}
     }
     else if (LowtagOf(thing) != type_FunctionPointer) {
-        printf("0x%08x is not a function pointer, symbol, or fdefn object.\n",
+        printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n",
 	       thing);
         return;
     }
@@ -335,7 +338,7 @@ static void print_context(struct sigcontext *context)
 		printf("%s:\t", lisp_register_names[i]);
 		brief_print((lispobj) SC_REG(context, i));
 	}
-	printf("PC:\t\t  0x%08x\n", SC_PC(context));
+	printf("PC:\t\t  0x%08lx\n", SC_PC(context));
 }
 
 static void print_context_cmd(char **ptr)
@@ -392,7 +395,7 @@ static void catchers_cmd(char **ptr)
         printf("There are no active catchers!\n");
     else {
         while (catch != NULL) {
-            printf("0x%08X:\n\tuwp: 0x%08X\n\tfp: 0x%08X\n\tcode: 0x%08x\n\tentry: 0x%08x\n\ttag: ", (unsigned long)catch, (unsigned long)(catch->current_uwp), (unsigned long)(catch->current_cont), catch->current_code, catch->entry_pc);
+            printf("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%08lx\n\tentry: 0x%08lx\n\ttag: ", (unsigned long)catch, (unsigned long)(catch->current_uwp), (unsigned long)(catch->current_cont), catch->current_code, catch->entry_pc);
             brief_print((lispobj)catch->tag);
             catch = catch->previous_catch;
         }
diff --git a/lisp/os.h b/lisp/os.h
index 8df4af639..84c120f12 100644
--- a/lisp/os.h
+++ b/lisp/os.h
@@ -1,5 +1,5 @@
 /*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.5 1994/10/25 00:11:29 ram Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.6 1997/01/21 00:28:13 ram Exp $
  *
  * Common interface for os-dependent functions.
  *
@@ -25,6 +25,14 @@
 #else
 #ifdef irix
 #include "irix-os.h"
+#else
+#ifdef __FreeBSD__
+#include "FreeBSD-os.h"
+#else
+#ifdef __linux__
+#include "Linux-os.h"
+#endif
+#endif
 #endif
 #endif
 #endif
diff --git a/lisp/parse.c b/lisp/parse.c
index 67762a13a..f33449a6c 100644
--- a/lisp/parse.c
+++ b/lisp/parse.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.c,v 1.2 1994/10/25 00:09:21 ram Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.c,v 1.3 1997/01/21 00:28:13 ram Exp $ */
 #include <stdio.h>
 #include <ctype.h>
 #include <signal.h>
@@ -15,7 +15,7 @@
 #include "arch.h"
 #include "search.h"
 
-#if !defined(MACH) && !defined(SVR4)
+#if !defined(MACH) && !defined(SVR4) && !defined(__linux__)
 
 static int strcasecmp(s1,s2)
 char *s1,*s2;
@@ -234,8 +234,8 @@ char **ptr;
         result &= ~3;
     }
 
-    if (!valid_addr(result)) {
-        printf("Invalid address: 0x%x\n", result);
+    if (!valid_addr((os_vm_address_t)result)) {
+        printf("Invalid address: 0x%lx\n", result);
         throw_to_monitor();
     }
 
@@ -258,7 +258,7 @@ static boolean lookup_symbol(char *name, lispobj *result)
 
     /* Search dynamic space */
     headerptr = current_dynamic_space;
-#ifndef ibmrt
+#if !defined(ibmrt) && !defined(i386)
     count = current_dynamic_space_free_pointer - current_dynamic_space;
 #else
     count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - current_dynamic_space;
@@ -336,7 +336,7 @@ char **ptr;
     } else if (token[0] == '@') {
         if (string_to_long(token+1, &pointer)) {
             pointer &= ~3;
-            if (valid_addr(pointer))
+            if (valid_addr((os_vm_address_t)pointer))
                 result = *(lispobj *)pointer;
             else {
                 printf("Invalid address: ``%s''\n", token+1);
diff --git a/lisp/print.c b/lisp/print.c
index 5cb9211da..b9c858e5b 100644
--- a/lisp/print.c
+++ b/lisp/print.c
@@ -1,4 +1,4 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.3 1994/03/27 15:18:07 hallgren Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.4 1997/01/21 00:28:13 ram Exp $ */
 #include <stdio.h>
 
 #include "print.h"
@@ -125,7 +125,7 @@ static void newline(char *label)
 static void brief_fixnum(lispobj obj)
 {
 #ifndef alpha
-    printf("%d", ((long)obj)>>2);
+    printf("%ld", ((long)obj)>>2);
 #else
     printf("%d", ((s32)obj)>>2);
 #endif
@@ -134,7 +134,7 @@ static void brief_fixnum(lispobj obj)
 static void print_fixnum(lispobj obj)
 {
 #ifndef alpha
-    printf(": %d", ((long)obj)>>2);
+    printf(": %ld", ((long)obj)>>2);
 #else
     printf(": %d", ((s32)obj)>>2);
 #endif
@@ -214,7 +214,7 @@ static void print_otherimm(lispobj obj)
             break;
 
         default:
-            printf(": data=%d", (obj>>8)&0xffffff);
+            printf(": data=%ld", (obj>>8)&0xffffff);
             break;
     }
 }
@@ -224,7 +224,7 @@ static void brief_list(lispobj obj)
     int space = FALSE;
     int length = 0;
 
-    if (!valid_addr(obj))
+    if (!valid_addr((os_vm_address_t)obj))
 	    printf("(invalid address)");
     else if (obj == NIL)
         printf("NIL");
@@ -256,7 +256,7 @@ static void brief_list(lispobj obj)
 
 static void print_list(lispobj obj)
 {
-    if (!valid_addr(obj))
+    if (!valid_addr((os_vm_address_t)obj))
 	    printf("(invalid address)");
     else if (obj == NIL)
         printf(" (NIL)");
@@ -270,7 +270,7 @@ static void print_list(lispobj obj)
 
 static void brief_struct(lispobj obj)
 {
-    printf("#<ptr to 0x%08x instance>",
+    printf("#<ptr to 0x%08lx instance>",
            ((struct instance *)PTR(obj))->slots[0]);
 }
 
@@ -296,7 +296,7 @@ static void brief_otherptr(lispobj obj)
 
     ptr = (lispobj *) PTR(obj);
 
-    if (!valid_addr(obj)) {
+    if (!valid_addr((os_vm_address_t)obj)) {
 	    printf("(invalid address)");
 	    return;
     }
@@ -353,7 +353,7 @@ static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
 
 static void print_otherptr(lispobj obj)
 {
-    if (!valid_addr(obj))
+    if (!valid_addr((os_vm_address_t)obj))
 	    printf("(invalid address)");
     else {
 #ifndef alpha
@@ -392,7 +392,7 @@ static void print_otherptr(lispobj obj)
                 NEWLINE;
                 printf("0x");
                 while (count-- > 0)
-                    printf("%08x", *--ptr);
+                    printf("%08lx", *--ptr);
                 break;
 
             case type_Ratio:
@@ -409,12 +409,12 @@ static void print_otherptr(lispobj obj)
 
             case type_SingleFloat:
                 NEWLINE;
-                printf("%f", ((struct single_float *)PTR(obj))->value);
+                printf("%g", ((struct single_float *)PTR(obj))->value);
                 break;
 
             case type_DoubleFloat:
                 NEWLINE;
-                printf("%f", ((struct double_float *)PTR(obj))->value);
+                printf("%g", ((struct double_float *)PTR(obj))->value);
                 break;
 
             case type_SimpleString:
@@ -429,7 +429,7 @@ static void print_otherptr(lispobj obj)
             case type_SimpleVector:
             case type_InstanceHeader:
                 NEWLINE;
-                printf("length = %d", length);
+                printf("length = %ld", length);
                 ptr++;
                 index = 0;
                 while (length-- > 0) {
@@ -473,7 +473,7 @@ static void print_otherptr(lispobj obj)
             case type_Sap:
                 NEWLINE;
 #ifndef alpha
-                printf("0x%08x", *ptr);
+                printf("0x%08lx", *ptr);
 #else
                 printf("0x%016lx", *(long*)(ptr+1));
 #endif
@@ -535,7 +535,7 @@ static void print_obj(char *prefix, lispobj obj)
         }
         else
             newline(NULL);
-        printf("%s0x%08x: ", prefix, obj);
+        printf("%s0x%08lx: ", prefix, obj);
         if (cur_depth < brief_depth) {
             fputs(lowtag_Names[type], stdout);
             (*verbose_fns[type])(obj);
diff --git a/lisp/purify.c b/lisp/purify.c
index 70f629c89..687686a70 100644
--- a/lisp/purify.c
+++ b/lisp/purify.c
@@ -1,7 +1,11 @@
 /* Purify. */
 
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.6 1993/03/29 03:39:58 wlott Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.7 1997/01/21 00:28:13 ram Exp $ */
 
+/* This file has been hacked a bunch by Werkowski as part of
+ * the x86 port. Stack direction changes as well as more conservative
+ * decisions about pointers. It probably doesn't work yet.
+ */
 #include <stdio.h>
 #include <sys/types.h>
 #include <stdlib.h>
@@ -15,10 +19,16 @@
 #include "purify.h"
 #include "interr.h"
 
+#undef PRINTNOISE
+
+#if defined(ibmrt) || defined(i386)
+static lispobj *current_dynamic_space_free_pointer;
+#endif
+
 #define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
 			__FILE__, __LINE__)
 
-#if 0
+#if 1
 #define gc_assert(ex) do { \
 	if (!(ex)) gc_abort(); \
 } while (0)
@@ -26,7 +36,7 @@
 #define gc_assert(ex)
 #endif
 
-
+
 /* These hold the original end of the read_only and static spaces so we can */
 /* tell what are forwarding pointers. */
 
@@ -55,8 +65,9 @@ static int later_count = 0;
 #else
 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
 #endif
-
-static boolean forwarding_pointer_p(lispobj obj)
+
+static boolean 
+forwarding_pointer_p(lispobj obj)
 {
     lispobj *ptr;
 
@@ -66,12 +77,92 @@ static boolean forwarding_pointer_p(lispobj obj)
             (read_only_end <= ptr && ptr <= read_only_free));
 }
 
-static boolean dynamic_pointer_p(lispobj ptr)
+static boolean 
+dynamic_pointer_p(lispobj ptr)
 {
-    return ptr >= (lispobj)dynamic_0_space;
+#ifndef i386
+    return (ptr >= (lispobj)dynamic_0_space);
+#else
+    /* Be more conservative, and remember, this is a maybe */
+    return (ptr >= (lispobj)current_dynamic_space
+	    &&
+	    ptr < (lispobj)current_dynamic_space_free_pointer);
+#endif
 }
-
-static void pscav_later(lispobj *where, int count)
+
+static int
+maybe_can_move_p(lispobj thing)
+{
+  lispobj *thingp,header;
+  if (dynamic_pointer_p(thing)) { /* in dynamic space */
+    thingp = (lispobj*)PTR(thing);
+    header = *thingp;
+    if(Pointerp(header) && forwarding_pointer_p(header))
+      return -1;		/* must change it */
+    if(LowtagOf(thing) == type_ListPointer)
+      return type_ListPointer;	/* can we check this somehow */
+    else if (thing & 3) {	/* not fixnum */
+      int kind = TypeOf(header);
+      /* printf(" %x %x",header,kind); */
+      switch (kind) {		/* something with a header */
+      case type_Bignum:
+      case type_SingleFloat:
+      case type_DoubleFloat:
+      case type_Sap:
+      case type_SimpleVector:
+      case type_SimpleString:
+      case type_SimpleBitVector:
+      case type_SimpleArrayUnsignedByte2:
+      case type_SimpleArrayUnsignedByte4:
+      case type_SimpleArrayUnsignedByte8:
+      case type_SimpleArrayUnsignedByte16:
+      case type_SimpleArrayUnsignedByte32:
+      case type_SimpleArraySingleFloat:
+      case type_SimpleArrayDoubleFloat:
+      case type_CodeHeader:
+      case type_FunctionHeader:
+      case type_ClosureFunctionHeader:
+      case type_ReturnPcHeader:
+      case type_ClosureHeader:
+      case type_FuncallableInstanceHeader:
+      case type_InstanceHeader:
+      case type_ValueCellHeader:
+      case type_ByteCodeFunction:
+      case type_ByteCodeClosure:
+      case type_DylanFunctionHeader:
+      case type_WeakPointer:
+      case type_Fdefn:
+	return kind;
+	break;
+      default:
+	return 0;
+      }}}
+  return 0;
+}
+
+static int pverbose=0;
+#define PVERBOSE pverbose
+static void
+carefully_pscav_stack(lispobj*lowaddr, lispobj*base)
+{
+  lispobj*sp = lowaddr;
+  while(sp < base)
+    { int k;
+      lispobj thing = *sp;
+      if((unsigned)thing & 0x3)	/* may be pointer */
+	{
+	  /* need to check for valid float/double? */
+	  k = maybe_can_move_p(thing);
+	  if(PVERBOSE)printf("%8x %8x %d\n",sp, thing, k);
+	  if(k)
+	    pscav(sp, 1, FALSE);
+	}
+      sp++;
+    }
+}
+
+static void 
+pscav_later(lispobj *where, int count)
 {
     struct later *new;
 
@@ -234,6 +325,13 @@ static lispobj ptrans_code(lispobj thing)
     code = (struct code *)PTR(thing);
     nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
 
+    /* Moving machine code around does not work on the x86 port, but
+       byte compiled function code blocks can be moved.  Perhaps for
+       all byte compiled code blocks the entry_points slot is nil.
+       Check and print a warning. */
+    if ( (code->entry_points) != NIL )
+      fprintf(stderr,"** ptrans_code(%x)\n",thing);
+
     new = (struct code *)read_only_free;
     read_only_free += CEILING(nwords, 2);
 
@@ -257,6 +355,13 @@ static lispobj ptrans_code(lispobj thing)
     /* Arrange to scavenge the debug info later. */
     pscav_later(&new->debug_info, 1);
 
+    if(new->trace_table_offset & 0x3)
+#if 0
+      pscav(&new->trace_table_offset, 1, FALSE);
+#else
+      new->trace_table_offset = NIL; /* limit lifetime */
+#endif
+
     /* Scavenge the constants. */
     pscav(new->constants, HeaderValue(new->header)-5, TRUE);
 
@@ -289,6 +394,10 @@ static lispobj ptrans_func(lispobj thing, lispobj header)
     if (TypeOf(header) == type_FunctionHeader ||
         TypeOf(header) == type_ClosureFunctionHeader) {
 
+      /* Moving code around is not good on the x86 port; print a
+	 warning. */
+      fprintf(stderr,"ptrans_function(%x, %x)\n",thing,header);
+
 	/* We can only end up here if the code object has not been */
         /* scavenged, because if it had been scavenged, forwarding pointers */
         /* would have been left behind for all the entry points. */
@@ -318,10 +427,10 @@ static lispobj ptrans_func(lispobj thing, lispobj header)
 	else {
 	    /* Closures can always go in read-only space, 'caues */
 	    /* they never change. */
+
 	    new = read_only_free;
 	    read_only_free += CEILING(nwords, 2);
 	}
-
         /* Copy it. */
         bcopy(old, new, nwords * sizeof(lispobj));
 
@@ -479,16 +588,49 @@ static int pscav_fdefn(struct fdefn *fdefn)
 }
 
 #ifdef i386
-static int pscav_closure_header(closure)
-     struct closure *closure;
+/* now putting code objects in static space */
+static int
+pscav_code(struct code*code)
 {
-    lispobj fun = closure->function - RAW_ADDR_OFFSET;
-    int nwords = HeaderValue(closure->header);
+    int nwords;
+    lispobj func;
+    nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
+
 
-    pscav(&fun, 1, TRUE);
-    pscav(closure->info, nwords-1, TRUE);
-    return nwords+1;
+    /* pw--The trace_table_offset slot can contain a list pointer. This
+     * occurs when the code object is a top level form that initializes
+     * a byte-compiled function. The fact that purify was ignoring this
+     * slot may be a bug unrelated to the x86 port, except that TLF's
+     * normally become unreachable after the loader calls them and 
+     * won't be seen by purify at all!!
+     */
+    if(code->trace_table_offset & 0x3)
+#if 0
+      pscav(&code->trace_table_offset, 1, FALSE);
+#else
+      code->trace_table_offset = NIL; /* limit lifetime */
+#endif
+
+    /* Arrange to scavenge the debug info later. */
+    pscav_later(&code->debug_info, 1);
+
+    /* Scavenge the constants. */
+    pscav(code->constants, HeaderValue(code->header)-5, TRUE);
+
+    /* Scavenge all the functions. */
+    pscav(&code->entry_points, 1, TRUE);
+    for (func = code->entry_points;
+         func != NIL;
+         func = ((struct function *)PTR(func))->next) {
+        gc_assert(LowtagOf(func) == type_FunctionPointer);
+        gc_assert(!dynamic_pointer_p(func));
+        pscav(&((struct function *)PTR(func))->self, 2, TRUE);
+        pscav_later(&((struct function *)PTR(func))->name, 3);
+    }
+
+    return CEILING(nwords,2);
 }
+
 #endif
 
 static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
@@ -601,23 +743,38 @@ static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
                 break;
 
               case type_CodeHeader:
+#ifndef i386
                 gc_abort(); /* No code headers in static space */
+#else
+		count = pscav_code((struct code*)addr);
+#endif
                 break;
 
               case type_FunctionHeader:
               case type_ClosureFunctionHeader:
               case type_ReturnPcHeader:
-                /* We should never hit any of these, 'cause they occure */
+                /* We should never hit any of these, 'cause they occur */
                 /* buried in the middle of code objects. */
+
                 gc_abort();
 
+		
+		break;
+
 #ifdef i386
 	      case type_ClosureHeader:
 	      case type_FuncallableInstanceHeader:
 	      case type_ByteCodeFunction:
 	      case type_ByteCodeClosure:
 	      case type_DylanFunctionHeader:
-		count = pscav_closure_header((struct closure *)addr);
+ 		/* The function self pointer needs special care on the
+		   x86 because it is the real entry point. */
+ 		{
+ 		  lispobj fun = ((struct closure *)addr)->function
+ 		    - RAW_ADDR_OFFSET;
+ 		  pscav(&fun, 1, constant);
+ 		}
+ 		count = 2;
 		break;
 #endif
 
@@ -668,6 +825,11 @@ int purify(lispobj static_roots, lispobj read_only_roots)
         return 0;
     }
 
+#if defined(ibmrt) || defined(i386)
+    current_dynamic_space_free_pointer = 
+      (lispobj*)SymbolValue(ALLOCATION_POINTER);
+#endif
+
     read_only_end = read_only_free =
         (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
     static_end = static_free =
@@ -692,13 +854,18 @@ int purify(lispobj static_roots, lispobj read_only_roots)
     printf(" stack");
     fflush(stdout);
 #endif
+#ifndef i386
     pscav(control_stack, current_control_stack_pointer - control_stack, FALSE);
+#else
+    gc_assert(control_stack_end > ((&read_only_roots)+1));
+    carefully_pscav_stack(((&read_only_roots)+1), control_stack_end);
+#endif
 
 #ifdef PRINTNOISE
     printf(" bindings");
     fflush(stdout);
 #endif
-#ifndef ibmrt
+#if !defined(ibmrt) && !defined(i386)
     pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE);
 #else
     pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE);
@@ -739,22 +906,65 @@ int purify(lispobj static_roots, lispobj read_only_roots)
     printf(" cleanup");
     fflush(stdout);
 #endif
+
+/* well, something seems messed up in FreeBSD VM, hacking to resolve it.
+ * Nope -- problem was 'auto-gc-trigger' mprotecting pages in background.
+ */
+#if defined X86_CGC_ACTIVE_P
+    if(SymbolValue(X86_CGC_ACTIVE_P) != T)
+      os_zero((os_vm_address_t) current_dynamic_space,
+	      (os_vm_size_t) DYNAMIC_SPACE_SIZE);
+#else
     os_zero((os_vm_address_t) current_dynamic_space,
             (os_vm_size_t) DYNAMIC_SPACE_SIZE);
-
+#endif
     /* Zero stack. */
+#ifndef i386
     os_zero((os_vm_address_t) current_control_stack_pointer,
             (os_vm_size_t) (CONTROL_STACK_SIZE -
                             ((current_control_stack_pointer - control_stack) *
                              sizeof(lispobj))));
+#else
+    /* os_zero won't work cause it things the junk is above the 
+     * start address where here it is below. I don't see why we want
+     * to zero stuff anyhow.
+     */
+#endif
 
-#ifndef ibmrt
+#if defined STATIC_BLUE_BAG
+    {
+      lispobj bag = SymbolValue(STATIC_BLUE_BAG);
+      struct cons*cons = (struct cons*)static_free;
+      struct cons*pair = cons + 1;
+      static_free += 2*WORDS_PER_CONS;
+      if(bag == type_UnboundMarker)
+	bag = NIL;
+      cons->cdr = bag;
+      cons->car = (lispobj)pair | type_ListPointer;
+      pair->car = (lispobj)static_end;
+      pair->cdr = (lispobj)static_free;
+      bag = (lispobj)cons | type_ListPointer;
+      SetSymbolValue(STATIC_BLUE_BAG, bag);
+    }
+#endif
+
+    /* It helps to update the heap free pointers so that free_heap can
+       verify after it's done. */
+    SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
+    SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
+    
+#if !defined(ibmrt) && !defined(i386)
     current_dynamic_space_free_pointer = current_dynamic_space;
+#endif
+
+#if defined X86_CGC_ACTIVE_P
+    if(SymbolValue(X86_CGC_ACTIVE_P) != T)
+      SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space);
+    else
+      cgc_free_heap();
 #else
     SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space);
 #endif
-    SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
-    SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
 
 #ifdef PRINTNOISE
     printf(" Done.]\n");
diff --git a/lisp/save.c b/lisp/save.c
index c9630c12b..d40261ad1 100644
--- a/lisp/save.c
+++ b/lisp/save.c
@@ -1,6 +1,6 @@
 /*
 
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.4 1994/10/27 17:13:54 ram Exp $
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.5 1997/01/21 00:28:13 ram Exp $
 
  This code was written as part of the CMU Common Lisp project at
  Carnegie Mellon University, and has been placed in the public domain.
@@ -75,7 +75,26 @@ static void output_space(FILE *file, int id, lispobj *addr, lispobj *end)
 boolean save(char *filename, lispobj init_function)
 {
     FILE *file;
-
+#if defined WANT_CGC
+    volatile lispobj*func_ptr = &init_function;
+    char sbuf[128];
+    strcpy(sbuf,filename);
+    filename=sbuf;
+    /* Get rid of remnant stuff. This is a MUST so that
+     * the memory manager can get started correctly when
+     * we restart after this save. Purify is going to
+     * maybe move the args so we need to consider them volatile,
+     * especially if the gcc optimizer is working!!
+     */
+    purify(NIL,NIL);
+
+    init_function = *func_ptr;
+    /* Set dynamic space pointer to base value so we don't write out
+     * MBs of just cleared heap.
+     */
+    if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
+      SetSymbolValue(ALLOCATION_POINTER,DYNAMIC_0_SPACE_START);
+#endif
     /* Open the file: */
     unlink(filename);
     file = fopen(filename, "w");
@@ -90,7 +109,9 @@ boolean save(char *filename, lispobj init_function)
     SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
     SetSymbolValue(EVAL_STACK_TOP, 0);
     printf("done]\n");
-
+#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
+    SetSymbolValue(X86_CGC_ACTIVE_P, T);
+#endif
     printf("[Saving current lisp image into %s:\n", filename);
 
     putw(CORE_MAGIC, file);
diff --git a/lisp/undefineds.h b/lisp/undefineds.h
index 9c5ec9acb..c98a25794 100644
--- a/lisp/undefineds.h
+++ b/lisp/undefineds.h
@@ -1,5 +1,5 @@
 /* Routines that must be linked into the core for lisp to work. */
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.8 1994/10/30 21:43:03 ram Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.9 1997/01/21 00:28:13 ram Exp $ */
 
 /* Pick up all the syscalls. */
 accept,
@@ -75,7 +75,9 @@ mknod,
 mount,
 open,
 pipe,
+#ifndef __linux__
 profil,
+#endif
 ptrace,
 #ifdef mach
 quota,
@@ -123,14 +125,16 @@ shutdown,
 sigblock,
 #endif
 sigpause,
-#if !defined(ibmrt) && !defined(hpux) && !defined(SVR4)
+#if !defined(ibmrt) && !defined(hpux) && !defined(SVR4) && !defined(i386)
 sigreturn,
 #endif
-#ifndef SVR4
+#if !defined SVR4 && !defined __FreeBSD__
 sigsetmask,
+#ifndef __linux__
 sigstack,
 sigvec,
 #endif
+#endif
 socket,
 socketpair,
 stat,
@@ -140,7 +144,7 @@ swapon,
 symlink,
 sync,
 syscall,
-#if defined(hpux) || defined(SVR4)
+#if defined(__linux__) || defined(hpux) || defined(SVR4)
 closedir,
 opendir,
 readdir,
@@ -149,7 +153,8 @@ tcsetattr,
 #endif
 truncate,
 umask,
-#if !defined(SUNOS) && !defined(parisc) && !defined(SOLARIS)
+#if !defined(SUNOS) && !defined(parisc) && !defined(SOLARIS) \
+  && !defined(__FreeBSD__)
 umount,
 #endif
 unlink,
@@ -159,7 +164,7 @@ utimes,
 #ifndef irix
 vfork,
 #endif
-#ifndef osf1
+#if !defined osf1 && !defined __FreeBSD__
 vhangup,
 #endif
 wait,
@@ -170,8 +175,10 @@ write,
 writev,
 
 /* Math routines. */
+#ifndef i386
 cos,
 sin,
+#endif
 tan,
 acos,
 asin,
@@ -198,7 +205,9 @@ pow,
 #ifndef hpux
 cbrt,
 #endif
+#ifndef i386
 sqrt,
+#endif
 hypot,
 
 /* Network support. */
@@ -206,18 +215,20 @@ gethostbyname,
 gethostbyaddr,
 
 /* Other random things. */
-#ifdef SVR4
+#if defined(SVR4) || defined(__linux__)
 setpgid,
 getpgid,
 timezone,
 altzone,
 daylight,
 tzname,
+#ifndef __linux__
 dlopen,
 dlsym,
 dlclose,
 dlerror,
 #endif
+#endif
 #ifndef SOLARIS
 getwd,
 #endif
diff --git a/lisp/validate.c b/lisp/validate.c
index e931de6a2..f113fcd06 100644
--- a/lisp/validate.c
+++ b/lisp/validate.c
@@ -1,5 +1,5 @@
 /*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.4 1993/04/28 01:58:43 wlott Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.5 1997/01/21 00:28:13 ram Exp $
  *
  * Memory Validation
  */
@@ -69,6 +69,10 @@ void validate(void)
 
 	/* Control Stack */
 	control_stack = (lispobj *) CONTROL_STACK_START;
+#ifdef i386
+	control_stack_end = (lispobj *) (CONTROL_STACK_START
+					 + CONTROL_STACK_SIZE);
+#endif
 	ensure_space(control_stack, CONTROL_STACK_SIZE);
 
 	/* Binding Stack */
diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c
new file mode 100644
index 000000000..33191950f
--- /dev/null
+++ b/lisp/x86-arch.c
@@ -0,0 +1,329 @@
+/* x86-arch.c -*- Mode: C; comment-column: 40 -*-
+ *
+ * $header: $ 
+ *
+ */
+
+#include <stdio.h>
+
+#include "lisp.h"
+#include "globals.h"
+#include "validate.h"
+#include "os.h"
+#include "internals.h"
+#include "arch.h"
+#include "lispregs.h"
+#include "signal.h"
+#include "alloc.h"
+#include "interrupt.h"
+#include "interr.h"
+#include "breakpoint.h"
+
+#define DPRINTF(test,e){if(test) fprintf e ;}
+
+#define BREAKPOINT_INST 0xcc	/* INT3 */
+
+char *
+arch_init(void)
+{
+  return "lisp.core";
+}
+
+os_vm_address_t 
+arch_get_bad_addr(HANDLER_ARGS)
+{
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
+  unsigned int badinst;
+
+  if((context->sc_pc & 3) != 0) return NULL;
+
+  if( (context->sc_pc < READ_ONLY_SPACE_START ||
+       context->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && 
+      ((lispobj *)context->sc_pc < current_dynamic_space ||
+       (lispobj *)context->sc_pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))
+    return NULL;
+
+  badinst = *(unsigned int *)context->sc_pc;
+#ifdef fixme
+  if((badinst>>27)!=0x16) return NULL;
+  return (os_vm_address_t)(context->sc_regs[(badinst>>16)&0x1f]+(badinst&0xffff));
+#else
+  return NULL;
+#endif
+}
+
+void arch_skip_instruction(context)
+struct sigcontext *context;
+{
+  /* Assuming we get here via an INT3 xxx instruction, the PC now
+   * points to the interrupt code (lisp value) so we just move past
+   * it. Skip the code, then if the code if an error-trap or
+   * Cerror-trap then skip the data bytes that follow. */
+  int vlen,code;
+
+  DPRINTF(0,(stderr,"[arch_skip_inst at %x>]\n", context->sc_pc));
+
+  /* Get and skip the lisp error code. */
+  code = *(char*)context->sc_pc++;
+  switch (code)
+    {
+    case trap_Error:
+    case trap_Cerror:
+      /* Lisp error arg vector length */
+      vlen = *(char*)context->sc_pc++;
+      /* Skip lisp error arg data bytes */
+      while(vlen-- > 0) 
+	(char*)context->sc_pc++;
+      /* Align 2 */
+      /* (char*)context->sc_pc += 0x3;
+      context->sc_pc &= ~0x03; */
+      break;
+
+    case trap_Breakpoint:		/* Not tested */
+    case trap_FunctionEndBreakpoint:	/* not tested */
+      break;
+
+    case trap_PendingInterrupt:
+    case trap_Halt:
+      /* Only needed to skip the Code. */
+      break;
+
+    default:
+      DPRINTF(1,(stderr,"[arch_skip_inst invalid code %d\n]\n",code));
+      break;
+    }
+
+  DPRINTF(0,(stderr,"[arch_skip_inst resuming at %x>]\n", context->sc_pc));
+}
+
+unsigned char *
+arch_internal_error_arguments(struct sigcontext *context)
+{
+  return (unsigned char *)(context->sc_pc+1);
+}
+
+boolean 
+arch_pseudo_atomic_atomic(struct sigcontext *context)
+{
+#ifdef fixme
+  return (context->sc_regs[reg_ALLOC] & 1);
+#else
+  return 0;
+#endif
+}
+
+#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
+
+void 
+arch_set_pseudo_atomic_interrupted(struct sigcontext *context)
+{
+#ifdef fixme
+  context->sc_regs[reg_ALLOC] |= 2;
+#endif
+}
+
+/* This stuff seems to get called for TRACE and debug activity */
+unsigned long 
+arch_install_breakpoint(void *pc)
+{
+  char*ptr = (char*)pc;
+  unsigned long result = *(unsigned long*)ptr;
+  *ptr++ = BREAKPOINT_INST;		/* x86 INT3       */
+  *ptr++ = trap_Breakpoint;		/* Lisp trap code */
+  *ptr++ = 1;				/* vector length  */
+  *ptr++ = 0;				/* junk data      */
+  
+  os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long));
+
+  return result;
+}
+
+void 
+arch_remove_breakpoint(void *pc, unsigned long orig_inst)
+{
+  unsigned int *ptr=(unsigned int*)pc;
+  *ptr = orig_inst;
+  os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long));
+}
+
+static unsigned int *skipped_break_addr, displaced_after_inst,
+     after_breakpoint;
+static int orig_sigmask;
+
+unsigned int
+emulate_branch(struct sigcontext *context,unsigned long orig_inst)
+{
+  /* This has to be invented for the X86. Maybe figure out how
+   * to use the trace trap. Shouldn't be hard. Gdb does it.
+   */
+  int next_pc = context->sc_pc;
+  return next_pc;
+}
+
+#ifdef __linux__
+_syscall1(int,sigreturn,struct sigcontext *,context)
+#endif
+
+
+void 
+arch_do_displaced_inst(struct sigcontext *context,
+				   unsigned long orig_inst)
+{
+  /* Ditto the above for X86.
+   */
+  unsigned int *pc = (unsigned int*)context->sc_pc;
+  unsigned int *next_pc;
+  unsigned int next_inst;
+  DPRINTF(0,(stderr,"[arch_do_displaced_inst %x %x NOT YET!]\n",
+	     context,orig_inst));
+  sigreturn(context);
+}
+
+#define AfterBreakpoint 100	/* pfw - what is this?? */
+
+void 
+sigtrap_handler(HANDLER_ARGS)
+{
+#ifdef __linux__
+  GET_CONTEXT
+#endif
+
+  /* Don't disallow recursive breakpoint traps.  Otherwise, we can't */
+  /* use debugger breakpoints anywhere in here. */
+  /*fprintf(stderr,"x86sigtrap: %8x %x\n", context->sc_pc, *(char*)(context->sc_pc-1));
+   */
+  DPRINTF(0,(stderr,"sigtrap(%d %d %x)\n",signal,code,context));
+  sigsetmask(context->sc_mask);
+  SAVE_CONTEXT();
+  /* this is just for info in case monitor wants to print an approx */
+  current_control_stack_pointer = (unsigned long*)context->sc_sp;
+ /* On entry %eip points just after the INT3 byte and aims at the
+  * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a
+  * number of bytes will follow, the first is the length of the byte
+  * arguments to follow.  */
+  if( *(unsigned char*)(context->sc_pc-1) == BREAKPOINT_INST)
+    {
+      if(after_breakpoint) code = AfterBreakpoint; /* ?? */
+      else code = (int)*(char*)context->sc_pc;
+    } 
+  switch (code)
+    {
+    case trap_PendingInterrupt:
+      DPRINTF(0,(stderr,"<trap Pending Interrupt.>\n"));
+      arch_skip_instruction(context);
+      interrupt_handle_pending(context);
+      break;
+      
+    case trap_Halt:
+      fake_foreign_function_call(context);
+      lose("%%primitive halt called; the party is over.\n");
+      undo_fake_foreign_function_call(context);
+      arch_skip_instruction(context);
+      break;
+      
+    case trap_Error:
+    case trap_Cerror:
+      DPRINTF(0,(stderr,"<trap Error %d>\n",code));
+#ifdef __linux__
+      interrupt_internal_error(signal,contextstruct, code==trap_Cerror);
+#else
+      interrupt_internal_error(signal, code, context, code==trap_Cerror);
+#endif
+      break;
+      
+    case trap_Breakpoint:		/* Not tested */
+      (char*)context->sc_pc -= 1;
+      handle_breakpoint(signal, code, context);
+      break;
+      
+    case trap_FunctionEndBreakpoint:	/* not tested */
+      (char*)context->sc_pc -= 1;
+      context->sc_pc = (int)handle_function_end_breakpoint(signal, code, context);
+      break;
+      
+    case AfterBreakpoint:		/* not tested */
+      DPRINTF(1,(stderr,"[C--AfterBreakpoint NOT TESTED]\n"));
+      (char*)context->sc_pc -= 1;
+      *skipped_break_addr = BREAKPOINT_INST;
+      os_flush_icache((os_vm_address_t)skipped_break_addr,
+		      sizeof(unsigned long));
+      skipped_break_addr = NULL;
+      *(unsigned int *)context->sc_pc = displaced_after_inst;
+      os_flush_icache((os_vm_address_t)context->sc_pc, sizeof(unsigned long));
+      context->sc_mask = orig_sigmask;
+      after_breakpoint=NULL;
+      break;
+      
+    default:
+      DPRINTF(0,(stderr,"[C--trap default %d %d %x]\n",signal,code,context));
+#ifdef __linux__
+      interrupt_handle_now(signal,contextstruct);
+#else
+      interrupt_handle_now(signal, code, context);
+#endif
+      break;
+    }
+}
+
+#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
+
+extern void first_handler();
+void 
+arch_install_interrupt_handlers()
+{
+    interrupt_install_low_level_handler(SIGILL ,sigtrap_handler);
+    interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
+}
+
+
+extern lispobj
+call_into_lisp(lispobj fun, lispobj *args, int nargs);
+
+/* These next four functions are an interface to the 
+ * Lisp call-in facility. Since this is C we can know
+ * nothing about the calling environment. The control
+ * stack might be the C stack if called from the monitor
+ * or the Lisp stack if called as a result of an interrupt
+ * or maybe even a separate stack. The args are most likely
+ * on that stack but could be in registers depending on
+ * what the compiler likes. So I try to package up the
+ * args into a portable vector and let the assembly language
+ * call-in function figure it out.
+ */
+lispobj 
+funcall0(lispobj function)
+{
+    lispobj *args = NULL;
+
+    return call_into_lisp(function, args, 0);
+}
+
+lispobj
+funcall1(lispobj function, lispobj arg0)
+{
+    lispobj args[1];
+    args[0] = arg0;
+    return call_into_lisp(function, args, 1);
+}
+
+lispobj
+funcall2(lispobj function, lispobj arg0, lispobj arg1)
+{
+    lispobj args[2];
+    args[0] = arg0;
+    args[1] = arg1;
+    return call_into_lisp(function, args, 2);
+}
+
+lispobj
+funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
+{
+    lispobj args[3];
+    args[0] = arg0;
+    args[1] = arg1;
+    args[2] = arg2;
+    return call_into_lisp(function, args, 3);
+}
diff --git a/lisp/x86-assem.S b/lisp/x86-assem.S
new file mode 100644
index 000000000..8ebad823f
--- /dev/null
+++ b/lisp/x86-assem.S
@@ -0,0 +1,438 @@
+### x86-assem.S -*- Mode: Asm; -*-
+/**
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.1 1997/01/21 00:28:13 ram Exp $
+ *
+ * Author:	Paul F. Werkowski <pw@snoopy.mv.com>
+ *
+ * This code was written to support the port of CMU Common Lisp
+ * to the Intel X86 ISA and the FreeBSD operating system. The
+ * author has placed this code in the public domain September 1996.
+ *
+ */
+
+
+#include "x86-validate.h"
+	
+#define LANGUAGE_ASSEMBLY
+#include "internals.h"
+
+/* Minimize conditionalization for different OS naming schemes */
+#if defined __linux__
+#define GNAME(var) var
+#else
+#define GNAME(var) _##var
+#endif
+
+/* Get the right type of alignment.  Linux as wants alignment in bytes? */
+/* not but .align 3 doesn't work ! in kernel it says: align 4 =16 bytes*/
+/* error is:
+tmp/cca01184.s: Assembler messages:
+/tmp/cca01184.s:553: Error: Alignment not a power of 2
+/tmp/cca01184.s:616: Error: Rest of line ignored. First ignored character is `,'.
+*/
+
+#ifdef	__linux__	
+#define align_4byte   2
+#define       align_8byte     4       
+#define       align_16byte    4      
+#else
+#define	align_4byte	2
+#define	align_8byte	3
+#define	align_16byte	4	
+#endif			
+	.text
+	.global	GNAME(sigtrap_handler)
+	.global	GNAME(foreign_function_call_active)
+	.global	GNAME(purify)
+	.global GNAME(collect_garbage)
+	.global	GNAME(current_control_stack_pointer)
+	.global GNAME(call_into_c)
+	.type	GNAME(call_into_c),@function
+	.data
+
+Cstack:	.long	0
+Purify:	.long	GNAME(purify)
+
+	.text
+
+
+/*
+ * The C function will preserve ebx, esi, edi, and ebp across its
+ * function call - ebx is used to save the return lisp address.
+ *
+ * Return values are in eax and maybe edx for quads, or st(0) for
+ * floats.
+ *
+ * It should work for lisp calls c calls lisp calls c ..
+ */
+	.text
+	.align	align_16byte,0x90
+	.global GNAME(call_into_c)
+	.type	GNAME(call_into_c),@function
+GNAME(call_into_c):
+	movl	$1,GNAME(foreign_function_call_active)
+
+/* Save the return lisp address in ebx */	
+	popl	%ebx
+
+/* Setup the NPX for C */
+	pushl	%ecx		# Make a little temp room.
+	fnstcw  (%esp)		# save exception masks
+	fninit
+	fldcw	(%esp)		# restore exception masks
+	popl	%ecx		# Restore the stack.
+
+	call	*%eax		# normal callout using Lisp stack
+
+	movl	%eax,%ecx	# remember integer return value
+
+/* Check for a return FP value */
+	fxam
+	fnstsw	%eax
+	andl	$0x4500,%eax
+	cmpl	$0x4100,%eax
+	jne	Lfp_rtn_value
+
+/* The return value is in eax, or eax,edx? */
+/* Setup the NPX stack for lisp */
+	fldz			# insure no regs are empty
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+
+/* Restore the return value */
+	movl	%ecx,%eax	# maybe return value
+
+	movl	$0,GNAME(foreign_function_call_active)
+/* Return */	
+	jmp	*%ebx
+
+Lfp_rtn_value:
+/* The return result is in st(0) */
+/* Setup the NPX stack for lisp, placing the result in st(0) */
+	fldz			# insure no regs are empty
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fxch	%st(7)		# move the result back to st(0)
+
+/* Don't need to restore eax as the result is in st(0) */
+
+	movl	$0,GNAME(foreign_function_call_active)
+/* Return */	
+	jmp	*%ebx
+
+	.size	GNAME(call_into_c), . - GNAME(call_into_c)
+
+	.align	align_16byte,0x90
+	.type prep_mind_warp,@function
+/* Purify wants to mess with the control stack and I can't really
+ * do that if I am also running on that stack. So I will transfer
+ * to the stack that was left at initial call_into_lisp time.
+ */
+prep_mind_warp:
+	movl	%esp,GNAME(current_control_stack_pointer)
+	movl	%esp,%ecx	# temp
+	xchgl	%esp,Cstack	# now on C stack
+	pushl	8(%ecx)		# arg 2
+	pushl	4(%ecx)		# arg 1
+	call	*%eax		# purify
+	addl	$8,%esp		# pop 2 args
+	xchgl	%esp,Cstack	# back to lisp stack
+
+/* Purify does not return a fp value, so don't need to check,
+ * just setup the lisp stack for Lisp */
+	fldz			# insure no regs are not empty
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+
+	movl	$0,GNAME(foreign_function_call_active)
+/* Return */	
+	jmp	%ebx
+	.size	prep_mind_warp, . - prep_mind_warp
+
+
+
+	.type	GNAME(do_purify),@function
+	.global	GNAME(do_purify)
+/* This is called from save to purge dynamic memory.
+ * 
+ * dtc: We are now on the lisp stack, but got here via a call_into_c so we
+ * are in foreign_function land. Since a lisp image is being saved and
+ * lisp will not be returned to it's not important to preserve
+ * state which is not significant to saving an image.
+ *
+ * Need to see where any dynamic objects end up.
+ * This seems like an incredible hack. Maybe I can fix purify.
+ */
+GNAME(do_purify):
+	movl	%esp,GNAME(current_control_stack_pointer)
+
+	movl	%esp,%ecx	# temp
+	xchgl	%esp,Cstack	# now on C stack
+
+	pushl	%ebp		# save old frame pointer
+	movl	%esp,%ebp	# establish new frame
+
+	pushl	8(%ecx)		# arg 2
+	pushl	4(%ecx)		# arg 1
+	call	GNAME(purify)	# purify
+	addl	$8,%esp		# pop 2 args
+	
+	popl	%ebp
+
+	xchgl	%esp,Cstack	# back to lisp stack
+	
+	ret
+	.size	GNAME(do_purify), . - GNAME(do_purify)
+
+
+	.global GNAME(call_into_lisp)
+	.type  GNAME(call_into_lisp),@function
+fpmask:	.word	0x33f		# 64-bit precision | all execptions masked
+		
+/* The C conventions require that ebx, esi, edi, and ebp be preserved
+	across function calls. */
+	
+	.align	align_16byte,0x90
+GNAME(call_into_lisp):
+	pushl	%ebp		# save old frame pointer
+	movl	%esp,%ebp	# establish new frame
+
+/* Save the NPX state */	
+	subl	$108,%esp	# Make room for the NPX state.
+	fnsave	(%esp)		# Resets NPX
+	fldcw	(%esp)		# Recover modes
+	fldz			# insure no regs are not empty
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	fldz
+	
+/* Save C regs: ebx esi edi */
+	pushl	%ebx
+	pushl	%esi
+	pushl	%edi
+	
+/* clear descriptor regs */
+	xorl	%eax,%eax	# lexenv
+	movl	%eax,%ebx	# available
+	movl	%eax,%ecx	# arg count
+	movl	%eax,%edx	# first arg
+	movl	%eax,%edi	# second arg
+	movl	%eax,%esi	# third arg
+
+/* establish nil (?) */
+
+/* start pseudo-atomic (?) */
+
+/* no longer in function call */
+	movl	%eax, GNAME(foreign_function_call_active)
+
+	movl	%esp,%ebx	# remember current stack
+/* load lisp state */
+	/* dyn space free */
+	/* binding stack  */
+	/* control stack (esp) */
+	movl	$CONTROL_STACK_START,%ecx
+	movl	%ecx,%edx
+	addl	$CONTROL_STACK_SIZE,%edx
+	cmpl	%ecx,%esp	# low - sp
+	jbe	LispStackSet	# jump when sp "below or equal" low
+	cmpl	%edx,%esp	# hgh - sp
+	jbe	LispStackOk
+LispStackSet:			# probably called from Monitor
+	movl	%esp,Cstack	# save C stack for use by GC/Purify
+	movl	%edx,%esp	# now at bottom of Lisp stack
+LispStackOk:
+	pushl	%ebx		# save entry stack on (maybe) new stack
+	/* control frame (ebp) */
+	/* end pseudo-atomic */
+
+	/* establish lisp args */
+	movl	 8(%ebp),%eax	# lexenv?
+	movl	12(%ebp),%ebx	# address of arg vec
+	movl	16(%ebp),%ecx	# num args
+	shll	$2,%ecx		# make into fixnum
+	cmpl	$0,%ecx
+	je	Ldone
+	movl	(%ebx),%edx	# arg0
+	cmpl	$4,%ecx
+	je	Ldone
+	movl	4(%ebx),%edi	# arg1
+	cmpl	$8,%ecx
+	je	Ldone
+	movl	8(%ebx),%esi	# arg2
+Ldone:	
+	/* registers eax, ecx, edx,edi,esi now live */
+	
+
+	/* alloc new frame */
+	mov	%esp,%ebx	# current sp marks start of new frame
+	push	%ebp		# fp in save location S0
+	mov	%ebx,%ebp	# switch to new frame
+
+	/* lra in the save location */
+	pushl	$Llra
+
+	/* push the lra for backward compatibility */
+	pushl	$Llra
+
+	/* indirect the closure */
+	jmp	*CLOSURE_FUNCTION_OFFSET(%eax)
+	
+	.align	align_8byte
+        .long   type_ReturnPcHeader
+	nop
+	nop
+	nop
+Llra:
+	/* Multi-value return - blow off any extra values */
+	mov	%ebx, %esp
+
+	/* Single value return */	
+	popl	%esp		# c-sp
+
+/* restore C regs: ebx esi edi */
+	popl	%edi
+	popl	%esi
+	popl	%ebx
+
+/* Restore the NPX state */
+	frstor  (%esp)
+	addl	$108, %esp
+	
+	popl	%ebp		# c-sp
+	movl	%edx,%eax	# c-val
+	ret
+	.size	GNAME(call_into_lisp), . - GNAME(call_into_lisp)
+
+
+/* Fdefn objects for undefined functions have a 'raw' slot
+   pointing here. The RISC systems seem to have this set up
+   as an actual function object instead.
+ */
+	.text
+	.align	align_4byte,0x90
+	.global GNAME(undefined_tramp)
+	.type	GNAME(undefined_tramp),@function
+GNAME(undefined_tramp):
+	int3
+	.byte	trap_Cerror
+        .byte   2
+        .byte   23
+        .byte   14
+	ret
+	.size	GNAME(undefined_tramp), .-GNAME(undefined_tramp)
+
+/* This apparently gets called to hack on something in closures
+   that can't get done by the compiler.
+*/
+	.align align_4byte,0x90
+	.global GNAME(closure_tramp)
+	.type	GNAME(closure_tramp),@function
+GNAME(closure_tramp):
+	movl	FDEFN_FUNCTION_OFFSET(%eax),%eax
+	jmp	CLOSURE_FUNCTION_OFFSET(%eax)
+
+	.size	GNAME(closure_tramp), .-GNAME(closure_tramp)
+
+	.align align_4byte
+	.global GNAME(function_end_breakpoint_trap)
+	.global GNAME(function_end_breakpoint_end)
+	.global	GNAME(function_end_breakpoint_guts)
+
+GNAME(function_end_breakpoint_trap):
+	ret
+	.align align_4byte
+GNAME(function_end_breakpoint_guts):
+	ret
+	.align align_4byte
+GNAME(function_end_breakpoint_end):
+	ret
+
+	.global	GNAME(test_point)
+	.align	align_4byte
+GNAME(test_point):
+	ret
+
+
+	.global	GNAME(do_pending_interrupt)
+	.type	GNAME(do_pending_interrupt),@function
+	.align align_4byte,0x90
+GNAME(do_pending_interrupt):
+	int3
+	.byte 	trap_PendingInterrupt
+	ret
+	.size	GNAME(do_pending_interrupt),.-GNAME(do_pending_interrupt)
+
+/* A copy function optimized for the Pentium and works ok on
+ * 486 as well. This assumes (does not check) that the input
+ * byte count is a multiple of 8-bytes (one lisp object).
+ * This code takes advantage of pairing in the Pentium as well
+ * as the 128-bit cache line.
+ */
+	.global	GNAME(fastcopy16)
+	.type	GNAME(fastcopy16),@function
+	.align align_4byte,0x90
+GNAME(fastcopy16):
+	pushl	%ebp
+	movl	%esp,%ebp
+	movl	8(%ebp), %edx	# dst
+	movl	12(%ebp),%eax	# src
+	movl	16(%ebp),%ecx	# bytes
+	pushl	%ebx
+	pushl	%esi
+	pushl	%edi
+	movl	%edx,%edi
+	movl	%eax,%esi
+	sarl	$3,%ecx		# number 8-byte units
+	testl	$1,%ecx		# odd?
+	jz	Lquad
+	movl	(%esi),%eax
+	movl	4(%esi),%ebx
+	movl	%eax,(%edi)
+	movl	%ebx,4(%edi)
+	leal	8(%esi),%esi
+	leal	8(%edi),%edi
+Lquad:	sarl	$1,%ecx		# count 16-byte units
+	jz	Lend
+	movl	%ecx,%ebp	# use ebp for loop counter
+	.align	align_16byte,0x90
+Ltop:
+	movl	  (%edi),%eax	#prefetch! MAJOR Pentium win.
+	movl	  (%esi),%eax
+	movl	 4(%esi),%ebx
+	movl	 8(%esi),%ecx
+	movl	12(%esi),%edx
+	movl	%eax,  (%edi)
+	movl	%ebx, 4(%edi)
+	movl	%ecx, 8(%edi)
+	movl	%edx,12(%edi)
+	leal	16(%esi),%esi
+	leal	16(%edi),%edi
+	decl	%ebp
+	jnz	Ltop		# non-prefixed jump saves cycles
+Lend:
+	popl	%edi
+	popl	%esi
+	popl	%ebx
+	popl	%ebp
+	ret
+	.size	GNAME(fastcopy16),.-GNAME(fastcopy16)
+	.end
diff --git a/lisp/x86-lispregs.h b/lisp/x86-lispregs.h
new file mode 100644
index 000000000..e81b38520
--- /dev/null
+++ b/lisp/x86-lispregs.h
@@ -0,0 +1,45 @@
+/* 86-lispregs.h -*- Mode: C; -*-
+ *
+ */
+
+/* These register names and offsets correspond to definitions
+ * in compiler/x86/vm.lisp. They map into accessors in the
+ * os dependent <machine/signal.h> structure via the sc_reg
+ * os dependent function.
+ */
+
+#define NREGS	(8)
+
+#ifdef LANGUAGE_ASSEMBLY
+#define REG(num) $ ## num
+#else
+#define REG(num) num
+#endif
+
+#define reg_EAX REG( 0)
+#define reg_ECX REG( 2)
+#define reg_EDX REG( 4)
+#define reg_EBX REG( 6)
+#define reg_ESP REG( 8)
+#define reg_EBP REG(10)
+#define reg_ESI REG(12)
+#define reg_EDI REG(14)
+
+#define reg_SP reg_ESP
+#define reg_FP reg_EBP
+
+#define REGNAMES "EAX", "ECX", "EDX", "EBX", "ESP", "EBP", "ESI", "EDI"
+
+/* These registers can contain lisp object pointers */
+#define BOXED_REGISTERS {\
+  reg_EAX, reg_ECX, reg_EDX, reg_EBX, reg_ESI, reg_EDI \
+  }
+
+/* N is offset in storage class (SC) as defined in vm.lisp.
+ * Ordering in sigcontext is probably os dependent so let
+ * xxx-os.c handle it.
+ */
+
+#define SC_REG(sc, n) sc_reg(sc,n)
+#define SC_PC(sc) ((sc)->sc_pc)
+
diff --git a/lisp/x86-validate.h b/lisp/x86-validate.h
new file mode 100644
index 000000000..e71dea8de
--- /dev/null
+++ b/lisp/x86-validate.h
@@ -0,0 +1,29 @@
+/*
+
+ This code was written as part of the CMU Common Lisp project at
+ Carnegie Mellon University, and has been placed in the public domain.
+
+*/
+
+
+#define READ_ONLY_SPACE_START   (0x01000000)
+#define READ_ONLY_SPACE_SIZE    (0x04000000) /* 64MB!! */
+
+#define STATIC_SPACE_START	(0x05000000)
+#define STATIC_SPACE_SIZE	(0x02fff000) /* 64MB - 1 page */
+
+#define DYNAMIC_0_SPACE_START	(0x09000000)
+#define DYNAMIC_1_SPACE_START	(0x0d000000)
+#define DYNAMIC_SPACE_SIZE	(0x04000000)
+
+/* Note that i386 has the stack growing from high
+ * to low addresses. The code for the RISC systems
+ * seem to go the other way. May have to make
+ * a lot of changes in the GC and supporting code
+ * to account for stack direction.
+ */
+#define CONTROL_STACK_START	(0x50000000)
+#define CONTROL_STACK_SIZE	(0x00100000)
+
+#define BINDING_STACK_START	(0x60000000)
+#define BINDING_STACK_SIZE	(0x00100000)
-- 
GitLab