;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.239
;;; Reason:
;;;  (hash-table-p (make-hash-table)) -> NIL
;;;  Make system type HASH-TABLE an alias for BASIC-HASH-TABLE.
;;;  Recompile (hash-table-p) because it uses optimized (typep).
;;;  Recompile (commonp) because it uses defsubst (hash-table-p).
;;; Written 22-Apr-88 15:59:54 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 1
;;; with Experimental System 123.238, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.1, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS; TYPES.LISP#105 at 22-Apr-88 16:14:21
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; TYPES  "

(setf (get 'hash-table 'type-alias-for) 'basic-hash-table)

))

; From file DJ: L.SYS2; LMMAC.LISP#462 at 22-Apr-88 16:16:54
#10R SYSTEM-INTERNALS#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "

(DEFSUBST HASH-TABLE-P (OBJECT)
  "T if OBJECT is a hash table."
  (TYPEP OBJECT 'HASH-TABLE))

))

; From file DJ: L.SYS; TYPES.LISP#106 at 22-Apr-88 16:17:03
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; TYPES  "

(defun commonp (object)
  "T if OBJECT is a kind of object which Common Lisp defines.
This is everything except locatives, stack groups, selects,
closures, entities, compiled and microcode functions,
and flavor instances (except for a few flavors which implement Common Lisp types)."
  (typecase object
    (instance
     (or (pathnamep object) (streamp object) (hash-table-p object)))
    (compiled-function
     (streamp object))
    (t
     (not (memq (%data-type object)
		'(#.dtp-locative #.dtp-stack-group #.dtp-select-method
		  #.dtp-closure #.dtp-entity #.dtp-u-entry))))))

))
