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

;;; Reason: Fixed RANDOM, It was not handling BIGNUM properly. [10882]

;;;                           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 12/22/89 12:46:43 by BERGER,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.27, VIRTUAL-MEMORY 6.3, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.2, DISK-LABEL 6.0, BASIC-FILE 6.7, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.14, TV 6.21, 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.11,
;;;  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.4, MAIL-READER 6.6, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.7, TI-CLOS 6.26, CLEH 6.5, IP 3.57,
;;;  Experimental CLX 6.7, CLUE 6.40, X11M 6.19, Experimental BUG 11.17,  microcode 475,
;;;  Band Name: REL 6.0 + SLE 11/28

#!C
; From file NUMBERS.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; NUMBERS.#"


(DEFUN random (&optional high array &aux ptr1 ptr2 size ans vector)
  "Returns a randomly chosen number.
With no argument, value is chosen randomly from all fixnums.
If HIGH is an integer, the value is a nonnegative integer and less than HIGH.
If HIGH is a float, the value is a nonnegative number of the same type, and less than HIGH.
ARRAY can be an array used for data by the random number generator (and updated);
 you can create one with RANDOM-CREATE-ARRAY or MAKE-RANDOM-STATE."
  ;; 01/20/88 CLM - For floating point numbers, use FLOAT to prevent type conversion
  ;;                from rational to floating point.
  ;; 01/27/88 CLM - A slight variation on the above fix, provided by HSch.  Slightly
  ;;                faster and a little less consing.
  (WHEN high
    (CHECK-TYPE high (AND real (satisfies plusp)) "a positive real number"))
  (COND ((NULL array)
	 (OR (AND (VARIABLE-BOUNDP *random-state*) *random-state*)
	     (SETQ *random-state* (random-create-array 71. 35. 69.)))
	 (SETQ array *random-state*)))		;Initialization as opt arg loses on BOUNDP.
  (WITHOUT-INTERRUPTS
   (SETQ ptr1 (random-pointer-1 array)
	 ptr2 (random-pointer-2 array)
	 vector (random-vector array)
	 size (LENGTH vector))
   (OR (< (SETQ ptr1 (1+ ptr1)) size) (SETQ ptr1 0))
   (OR (< (SETQ ptr2 (1+ ptr2)) size) (SETQ ptr2 0))
   (SETF (random-pointer-1 array) ptr1)
   (SETF (random-pointer-2 array) ptr2)
   (SETQ ans (%MAKE-POINTER-OFFSET dtp-fix (AREF vector ptr1) (AREF vector ptr2)))
   (SETF (AREF vector ptr2) ans))
  (COND ((FLOATP high)
	 (* (%LOGDPB 0 %%q-boxed-sign-bit ans)         ; Multiply by a ratio 0  x < 1
	    (/ high
	       (- (%LOGDPB 1 %%q-boxed-sign-bit 0))))) ; and coerce to proper float
	((NULL high) ans)
	(t
	 (DO ((bits 14. (+ bits %%q-pointer))		; Generate as many fixnums as needed
	      (number (%LOGDPB 0 %%q-boxed-sign-bit ans) ; Remove sign bit from ANS
		      (+ (%LOGDPB 0 %%q-boxed-sign-bit (RANDOM))
			 (ASH number  ; DAB 12-22-89 was ans, needs to be number
			      (1- %%q-pointer)))))	;   and put as many fixnums together
	     ((> bits (HAULONG high))			;   as needed to generate a long enough bignum
	      (MOD number high))))))
))