;;; -*- 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)))))) ))