Commit 4c8ae0d8 authored by rtoy's avatar rtoy
Browse files

Remove debugging stuff.

code/c-call.lisp:
o Remove debugging print
o Don't need make-array-unsigned-byte-8.  It was never really needed.
o Update deport-gen not to use make-array-unsigned-byte-8.
o Remove %primitive prints.

code/filesys.lisp:
o Remove %primitive prints.

code/lispinit.lisp:
o Remove %primitive prints.

code/pathname.lisp:
o Remove %primitive prints.
parent 54fc69ff
Loading
Loading
Loading
Loading
+11 −38
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/c-call.lisp,v 1.17.12.3 2008/05/19 15:16:36 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/c-call.lisp,v 1.17.12.4 2008/05/19 16:55:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -60,7 +60,6 @@

(def-alien-type-method (c-string :naturalize-gen) (type alien)
  (declare (ignore type))
  (format t "c-string naturalize-gen~%")
  `(if (zerop (sap-int ,alien))
       nil
       (%naturalize-c-string ,alien)))
@@ -73,14 +72,6 @@
     ((alien (* char)) (alien-sap ,value))
     (simple-base-string (vector-sap ,value))))

;; FIXME: Hack because make-array was not making an (unsigned-byte 8)
;; array for some reason.  So have c-string deport-gen call this to
;; make the appropriate object.
(defun make-array-unsigned-byte-8 (n)
  (declare (fixnum n)
	   (optimize (speed 3) (safety 0)))
  (make-array n :element-type '(unsigned-byte 8)))

#+unicode
(def-alien-type-method (c-string :deport-gen) (type value)
  (declare (ignore type))
@@ -95,18 +86,10 @@
	;; 8-bit array and copy our characters (the low 8-bits of each
	;; character!) to the 8-bit array.
	(let* ((,len (length ,value))
	       (,s #+(and) (make-array (1+ ,len) :element-type '(unsigned-byte 8))
		   #-(and) (make-array-unsigned-byte-8 ,len)))
	  #+nil
	  (progn
	    (lisp::%primitive lisp::print "deport string")
	    (lisp::%primitive lisp::print ,value)
	    (lisp::%primitive lisp::print ,s))
	       (,s (make-array (1+ ,len) :element-type '(unsigned-byte 8))))
	  (dotimes (,k ,len)
	    (setf (aref ,s ,k) (logand #xff (char-code (aref ,value ,k)))))
	  (setf (aref ,s ,len) 0)
	  #+nil
	  (lisp::%primitive lisp::print ,s)
	  (vector-sap ,s))))))

#-unicode
@@ -131,22 +114,12 @@
#+unicode
(defun %naturalize-c-string (sap)
  (declare (type system-area-pointer sap))
  (locally
      ()
  (let ((length (loop
		   for offset of-type fixnum upfrom 0
		   until (zerop (sap-ref-8 sap offset))
		   finally (return offset))))
      #+nil
      (progn
	(lisp::%primitive lisp::print "%naturalize-c-string")
	(lisp::%primitive lisp::print length))
    
    (let ((result (make-string length)))
      (dotimes (k length)
	  (setf (aref result k)
		(code-char (sap-ref-8 sap k))))
	#+t
	(progn
	  (lisp::%primitive lisp::print "%naturalize-c-string to")
	  (lisp::%primitive lisp::Print result))
	result))))
	(setf (aref result k) (code-char (sap-ref-8 sap k))))
      result)))
+1 −13
Original line number Diff line number Diff line
@@ -6,7 +6,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.104.4.1 2008/05/14 16:12:04 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.104.4.2 2008/05/19 16:55:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -302,10 +302,6 @@
(defun parse-unix-namestring (namestr start end)
  (declare (type simple-base-string namestr)
	   (type index start end))
  #+nil
  (progn
    (lisp::%primitive lisp::print "parse-unix-namestring")
    (lisp::%primitive lisp::print namestr))
  (multiple-value-bind
      (absolute pieces)
      (split-at-slashes namestr start end)
@@ -317,10 +313,6 @@
		       (search-list new-start)
		     (maybe-extract-search-list namestr
						(car first) (cdr first))
		   #+nil
		   (progn
		     (lisp::%primitive lisp::print "maybe search-list:")
		     (lisp::%primitive lisp::print search-list))
		   (when search-list
		     ;; Lose if this search-list is already defined as
		     ;; a logical host.  Since the syntax for
@@ -362,10 +354,6 @@
                   (find-if #'(lambda (x)
				(or (char= x #\Null) (char= x #\/)))
			    name))
	  #+nil
	  (progn
	    (lisp::%primitive lisp::print "Parse error null/slash")
	    (lisp::%primitive lisp::print name))
	  (error 'parse-error))
	;; Now we have everything we want.  So return it.
	(values nil ; no host for unix namestrings.
+2 −2
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.78.4.1 2008/05/14 16:12:04 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.78.4.2 2008/05/19 16:55:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -351,7 +351,7 @@

  (let ((funs (nreverse *lisp-initialization-functions*)))
    (%primitive print "Calling top-level forms.")
    (%primitive print (length funs))
    #+nil (%primitive print (length funs))
    (dolist (fun funs)
      #+nil (%primitive print fun)
      (typecase fun
+1 −9
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.86.2.1 2008/05/14 16:12:04 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.86.2.2 2008/05/19 16:55:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -962,10 +962,6 @@ a host-structure or string."
	   (type pathname defaults)
	   (type index start)
	   (type (or index null) end))
  #+nil
  (progn
    (lisp::%primitive lisp::print "%parse-namestring namestr")
    (lisp::%primitive lisp::print namestr))
  (if junk-allowed
      (handler-case
	  (%parse-namestring namestr host defaults start end nil)
@@ -1024,10 +1020,6 @@ a host-structure or string."
	   (type path-designator defaults)
	   (type index start)
	   (type (or index null) end))
  #+nil
  (progn
    (lisp::%primitive lisp::print "parse-namestring thing")
    (lisp::%primitive lisp::print thing))
  ;; Generally, redundant specification of information in software,
  ;; whether in code or in comments, is bad. However, the ANSI spec
  ;; for this is messy enough that it's hard to hold in short-term