;;; -*- Mode: Common-Lisp; Package: SI; Base: 8.; Patch-File: T -*-

;;; Reason: Fix to maphash to return NIL instead of the hash table. [ref CLtL p.285, SPR 10271]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 03/13/90 08:44:30 by BERGER,
;;; while running on Pasteur from band LOD2
;;; With SYSTEM 6.30, VIRTUAL-MEMORY 6.3, EH 6.6, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.4, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.2, DISK-LABEL 6.0, BASIC-FILE 6.8, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.1,
;;;  COMPILER 6.14, TV 6.24, DATALINK 6.0, CHAOSNET 6.5, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.5, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.13,
;;;  DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.5, MAIL-READER 6.7, TELNET 6.1, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.7, TI-CLOS 6.40, CLEH 6.5, IP 3.58,
;;;  Experimental CLX 6.8, CLUE 6.67, X11M 6.20, Experimental BUG 11.18,  microcode 648,
;;;  Band Name: rel6.0 1/23

#!C
; From file HASH.LISP#> KERNEL; sys:
#8R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; HASH.#"


(defun maphash (function hash-table &rest extra-args)
  "Apply FUNCTION to each item in HASH-TABLE; ignore values.
FUNCTION's arguments are the key followed by the values associated with it,
 followed by the EXTRA-ARGS."
  (CHECK-ARG hash-table hash-table-p "a hash table")
  (with-lock ((hash-table-lock hash-table) :whostate "Hash Table Lock")
    ;; 3-24-87, -ab.  Put re-hash inside the WITH-LOCK.
    (when (rehash-for-gc hash-table)	      
      ;; Some %POINTER's may have changed, try rehashing
      (funcall (hash-table-rehash-function hash-table) hash-table ()))
    (setq hash-table (follow-structure hash-table))
    (let* ((blen (hash-table-block-length hash-table))
	   (block-offset (if (hash-table-hash-function hash-table) 1 0))
	   (argcount (- (+ blen (Length extra-args)) block-offset)))
      (%assure-PDL-room argcount)
      (inhibit-gc-flips
      (do(
	  (i 0 (+ i blen))
	  (n (array-total-size hash-table)))
	 ((>= i n))
	(unless (without-interrupts (= (%p-data-type (aloc hash-table i)) dtp-null))
	  (without-interrupts (%spread (%make-pointer-offset dtp-list (aloc hash-table i) block-offset)))
	  (%spread extra-args)
	  (%call function argcount))
	))))
    nil)
))