[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Re: funny symbol packages
|
From: |
Camm Maguire |
|
Subject: |
[Gcl-devel] Re: funny symbol packages |
|
Date: |
22 Nov 2006 13:29:13 -0500 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings, and thanks as always for the report!
The issue here is the 'nil package' hack, which I've been told is
"OK". When packages are deleted, their names are set to nil, and
symbols therein are logically treated as uninterned. Problem is, gc
does not mark the hpack of a symbol (presumably for speed since a mark
pass is separately made over the list of all packages), so nil named
packages, which are excised from this list, are not marked at all,
making the uninterned symols therein unprintable if the hpack is
freed.
>(make-package 'foo)
>(setq a 'foo::b)
>(delete-pacakge 'foo)
>(symbol-package a)
This should be fixed now. This also addresses the issue you so
helpfully found with pcl::*fgens*.
The question remains where these packages came from in the first
place, as the code appears to simply create these symbols with gensym,
which sets hpack to nil. I have yet to find where they are interned
in some package, though I have a strong suspicion. GCL has
traditionally been unable to compile functions with gensyms in the
source, as it could not print them into a temporary file and then read
them. We've fixed this by interning into a temporary package and
deleting same on compile completion, which appears to work quite well.
Unfortunately, I cannot run your very nice utility anymore, as I have
a bind stack overflow :-(.
Take care,
Robert Boyer <address@hidden> writes:
> > How do you map over the accessible symbols?
>
> Caution: I don't really know what I'm doing besides having fun. The
> following transcript show how. The file map-all.lisp follows.
>
> > If you have a little torture tester written already, we could include
> > this in ansi-tests (or elsewhere).
>
> Something like this is a good idea if done well, but my puny effort is
> far from what a Lisp professional would want. For example, I am still
> too ignorant to figure out how to look at all the 'slots' in an object,
> given the object. 'slot-value' will give one the value of the slot if
> you have the object and the slot name, but I don't know how to ask for
> all the slot names of a given object (or class or struct or whatever the
> right ANSI words are here).
>
> Bob
>
> -------------------------------------------------------------------------------
> % 4
> GCL (GNU Common Lisp) 2.7.0 ANSI Nov 20 2006 17:20:56
> ...
> >(compile-file "map-all.lisp")
> ...
> >(load *)
> ...
> >(do-all)
>
> Setting up.
> Scanning symbols.
> Symbol G385, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G386, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G388, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G389, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G390, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G394, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G395, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G391, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G393, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G405, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G409, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G410, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G406, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G408, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G418, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G419, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G420, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G424, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G425, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G421, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G423, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G454, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G458, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G459, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G455, has a bad package. See *bad-symbols*. Ignoring.
> Symbol G457, has a bad package. See *bad-symbols*. Ignoring.
>
> -------------------------------------------------------------------------------
> ; The file map-all.lisp:
>
>
> (in-package :cl-user)
>
> ; Invoke (do-all) to do all these tests. An explanatory error should
> ; arise if any test fails.
>
> ; how can one in general map over all structures? with-slots?
>
> (declaim (optimize (safety 3)))
>
> (declaim (ftype (function nil (values null)) setup-all find-duplicates
> obvious))
> (declaim (ftype (function (t) (values null)) map-all scan))
> (declaim (ftype (function (t) (values t)) arg-types number-of-args dangerous))
> (declaim (ftype (function (t) (values boolean)) arg-types rude))
>
> ; #+GCL (setq si::*notify-gbc* t)
>
> #+GCL (setq system:*print-nans* t)
>
> (setq *print-level* 3)
>
> (setq *print-length* 3)
>
> (si::use-fast-links nil)
>
> (defparameter *all-packages* (list-all-packages))
>
> (defvar *x-call-stack* nil)
>
> (defvar *bad-symbols* nil)
>
> (defvar *all-object-hash-table* nil)
>
> (defparameter *all-object-hash-table-equal* nil)
>
> (defun scan (x)
> (let ((h (gethash x *all-object-hash-table*)))
> (cond ((assoc x *bad-symbols* :test 'eq) nil)
> ((null h)
> (let ((*x-call-stack* (cons x *x-call-stack*)))
> (setf (gethash x *all-object-hash-table*) t)
> (cond ((symbolp x)
> (let ((p (symbol-package x)))
> (cond ((null p) nil)
> ((member p *all-packages*))
> (t (push (list x *x-call-stack*) *bad-symbols*)
> (format t "~%Symbol ~a, has a bad ~
> package. See *bad-symbols*. ~
> Ignoring."
> (symbol-name x))
> (remhash x *all-object-hash-table*))))
> (scan (symbol-name x))
> (scan (symbol-plist x))
> (scan (symbol-package x))
> (cond ((boundp x) (scan (symbol-value x))))
> (cond ((fboundp x) (scan (symbol-function x)))))
> ((consp x)
> (scan (car x))
> (scan (cdr x)))
> ((arrayp x)
> (loop for i fixnum below (array-total-size x) do
> (scan (row-major-aref x i))))
> ((pathnamep x)
> (scan (namestring x)))
> ((readtablep x)
> (loop for i fixnum below char-code-limit do
> (scan (get-macro-character
> (code-char i)
> x))
> (loop for j fixnum below char-code-limit do
> (ignore-errors (scan
> (get-dispatch-macro-character
> (code-char i)
> (code-char j)
> x))))))
> ((complexp x)
> (scan (realpart x))
> (scan (imagpart x)))
> ((hash-table-p x)
> (maphash (function (lambda (k v) (scan k) (scan v)))
> x)))))))
> nil)
>
> (defvar *current-object*)
>
> (defun check-objects ()
> (maphash (lambda (x v)
> (declare (ignore v))
> (setq *current-object* x)
> (cond ((consp x) nil)
> (t (let ((*print-pretty* nil)
> (*print-circle* t))
> (prin1-to-string x)))))
> *all-object-hash-table*))
>
> (defun setup-all ()
> (cond ((null *all-object-hash-table*)
> (setq *all-object-hash-table* (make-hash-table :test 'eq))
> (format t "~%Setting up.")
> ;; Symbols
> (format t "~%Scanning symbols.")
> (with-package-iterator
> (next-symbol (list-all-packages) :internal :external)
> (loop (multiple-value-bind (more? symbol) (next-symbol)
> (if more? (scan symbol) (return)))))
> (format t "~%Scanning characters.")
> ;; Characters
> (loop for i fixnum below char-code-limit do (scan (code-char i)))
>
> (format t "~%Scanning packages.")
> ;; Packages
> (scan (list-all-packages))
>
> (format t "~%Scanning Classes.")
> ;; Classes
> (pcl::map-all-classes #'scan)
>
> (format t "~%Scanning Generic Functions")
> ;; Generic functions
> (pcl::map-all-generic-functions #'scan)
>
> (format t "~%Altogether ~a objects found."
> (hash-table-count *all-object-hash-table*))
>
> ;; Checking
> (format t "~%Checking printability of objects. On failure, ~
> check *current-object*.")
> (format t "~%(setup-all), including printability checking,
> finished.")))
> nil)
>
> (defun map-all (fn)
> ; Tries to find every object and apply fn to it.
> (setup-all)
> ; Finally.
> (maphash (function (lambda (k v)
> (declare (ignore v))
> (funcall fn k)))
> *all-object-hash-table*)
> nil)
>
> (defun subtest (object)
> (cond ((subtypep (type-of object) (class-of object)) nil)
> (t (error "~a failed subtest." object))))
>
> (defun typetest (object)
> (cond ((typep object (type-of object)) nil)
> (t (error "~a failed typetest." object))))
>
> (defun equaltest (x)
> (cond ((equal x x) nil)
> (t (error "~a failed equaltest." x))))
>
> (defun ltetest (x)
> (cond ((rationalp x)
> (cond ((<= x x) nil)
> (t (error "~a failed ltetest." x))))))
>
> (defun duhtest (x)
> (let ((a (first '(atom consp)))
> (c (second '(atom consp))))
> (cond ((or (funcall a x) (funcall c x)) nil)
> (t (error "~a failed duhtest" x)))))
>
> (defparameter *assoc-fns*
> '(* lognand + gcd lognor lcm logand logxor max logeqv min logior))
>
> (defun assoc-test (x)
> (cond ((not (integerp x)) nil)
> (t (loop for fn in *assoc-fns*
> when (not (equal (funcall fn (funcall fn x x) x)
> (funcall fn x (funcall fn x x))))
> do (error "Assoc problem on ~a and ~a." x fn)))))
>
> (defparameter duplicates nil)
>
> (defun find-duplicates ()
> (setq *all-object-hash-table-equal* (make-hash-table :test 'equal))
> (map-all #'(lambda (x)
> (let ((h (gethash x *all-object-hash-table-equal*)))
> (cond ((eq h t) (setq h nil)))
> (setf (gethash x *all-object-hash-table-equal*)
> (cons x h)))))
> (setq duplicates nil)
> (maphash #'(lambda (k v)
> (cond ((cdr v)
> (cond ((member k duplicates :test #'eq) nil)
> (t (setq duplicates (cons v duplicates)))))))
> *all-object-hash-table-equal*))
>
> (defparameter *tests*
> (list 'subtest 'typetest 'equaltest 'duhtest 'assoc-test))
>
> (defun do-all ()
> (setup-all)
> (loop for fn in *tests*
> do (format t "~%Trying test ~a." fn)
> (time (map-all fn)))
> (find-duplicates)
> (setq duplicates
> (sort duplicates
> #'(lambda (x y) (>= (length x) (length y)))))
> ;; (format t "~%Printing duplicates to foo-duplicates.lisp.")
> ;; (with-open-file (s "foo-duplicates.lisp" :direction :output)
> ;; (let ((*print-level* nil)
> ;; (*print-length* nil)
> ;; (*print-pretty* nil)
> ;; (*print-circle* t))
> ;; (print duplicates s)))
> (list 'length-duplicates (length duplicates)))
>
> (defun find-all-special-operators ()
> (let ((*ans* nil))
> (declare (special *ans*))
> (map-all (lambda (x)
> (cond ((and (symbolp x) (fboundp x)
> (consp (symbol-function x))
> (equal 'special (car (symbol-function x))))
> (push x *ans*)))))
> (setq *ans*
> (sort *ans*
> (function (lambda (x y)
> (string-lessp (symbol-name x) (symbol-name
> y))))))))
>
> (defun find-all-macros ()
> (let ((*ans* nil))
> (declare (special *ans*))
> (map-all (lambda (x)
> (cond ((and (symbolp x) (fboundp x)
> (consp (symbol-function x))
> (equal 'macro (car (symbol-function x))))
> (push x *ans*)))))
> (setq *ans*
> (sort *ans*
> (function (lambda (x y)
> (string-lessp (symbol-name x) (symbol-name
> y))))))))
>
> (defun find-all-compiler-macros ()
> (let ((*ans* nil))
> (declare (special *ans*))
> (map-all (lambda (x)
> (cond ((and (symbolp x) (fboundp x)
> (compiler-macro-function x))
> (push x *ans*))))
> (setq *ans* (sort *ans*
> (lambda (x y)
> (string-lessp (symbol-name x) (symbol-name
> y))))))))
>
> (defun dangerous (x)
> (or (not (symbolp x))
> (and (fboundp x)
> (let ((name (symbol-name x)))
> (loop for x in '("OPEN" "DELETE" "COMPILE" "UNBOUND"
> "PROP" "CLEAR"
> "BREAK" "INVOKE-DEBUGGER" "ED"
> "YES-OR-NO-P" "Y-OR-N-P"
> "DEF" "SET" "RPLAC"
> "LOOP" "CALL" "MAP"
> "APPLY" "FUNCALL" "SYSTEM" "DO"
> "SLEEP" "SAVE")
> thereis (search x name))))))
>
> (defparameter *terrible-forms*
> '((adjust-array 1 2)
> (WRITE-STRING 0 0)
> (SPECIFIC-CORRECTABLE-ERROR 3) ; not ANSI
> (symbol-macrolet (a))
> (untrace 1 2 3)
> (with-accessors '(a) b c 1 2 3 "KEYWORDS")
> (TYPECASE '(1 2 3) 4)
> (WITH-SIMPLE-RESTART 1 2 3 4 5)
> (PPRINT-LOGICAL-BLOCK 134790128 135401728)
> (restart-bind 1 2 3 4 5)
> (ignore-errors (values-list (loop for i from 1 to 100 collect I))) ;
> doesn't ignore the error
> (handler-case 0 1 2 3 4 5 6)
> (byte-position 1 )
> (byte-size 1 )
> (deposit-field 1 2 3 )
> (dpb 1 2 3 )
> (proclaim (list (function car)))
> (handler-bind 1 2 3 4 5)
> (ldb 1 2 )
> (ldb-test 1 2 )
> (mask-field 1 2 )
> (coerce (quote (b . 17))(quote (c . 17)))
> (subtypep (quote (b . 17))(quote (c . 17))(quote (d . 17)))
> (read-from-string 1 2 )
> (svref 1 2 )))
>
> (defparameter *known-bad* (loop for x in *terrible-forms* collect (car x)))
>
> (defvar *form*) ; special so we can inspect it.
>
> (defparameter safe-symbols
> (let ((ans nil))
> (do-external-symbols
> (fn :common-lisp ans)
> (cond ((and (fboundp fn) (not (dangerous fn)) (not (member fn
> *known-bad*)))
> (push fn ans))))))
>
> (defparameter *limit* (- (min multiple-values-limit call-arguments-limit) 2))
>
> (defvar *fboundp-ansi-cl-symbols*) ; defined later in this file
> (defvar safe-symbols) ; defined later in this file
>
> (defvar *all-array*)
>
> (defun try-non-dangerous ()
> (declare (optimize (safety 3)))
> (let (* ** *** all len *all-array* args
> (*print-circle* t)
> (*print-pretty* nil)
> (system:*print-nans* t)
> (*standard-input* (open "/dev/null")))
> (time (setup-all))
> (setq safe-symbols (loop for fn in *fboundp-ansi-cl-symbols*
> when (and (not (dangerous fn))
> (not (member fn *known-bad*)))
> collect fn))
> (maphash (lambda (k v) (declare (ignore v)) (push k all))
> *all-object-hash-table*)
> (setq len (length all))
> (setq *all-array* (make-array len))
> (loop for i below len as x in all do (setf (aref *all-array* i) x))
> (with-open-file (o "silly-experiment.text"
> :direction :output
> :if-exists :rename-and-delete)
> (let ((*print-level* nil)
> (*print-pretty* nil)
> (*print-length* nil)
> (*print-circle* t))
> (loop ; forever
> (loop
> for fn in safe-symbols do
> (prin1 fn t)
> (princ "," t)
> (force-output t)
> (file-position o 0)
> (setq args (loop for i in (arg-types fn)
> append
> (cond ((or (eq i t)
> (and (consp i) (member (car i)
> '(integer))))
> (list (let ((arg (aref *all-array* (random
> len))))
> (cond ((or (symbolp arg) (consp
> arg))
> (list 'quote arg))
> (t arg)))))
> ((eq i '*)
> (loop for j below (random *limit*)
> collect
> (let ((arg (aref *all-array* (random
> len))))
> (cond ((or (symbolp arg) (consp
> arg))
> (list 'quote arg))
> (t arg)))))
> (t (print (list 'unknown-type i))
> nil))))
> (setq *form* (list 'ignore-errors (cons fn args)))
> (print *form* o)
> (force-output o)
> (eval *form*)))))))
>
> (defparameter ansi-cl-symbols
> '(&ALLOW-OTHER-KEYS &AUX &BODY &ENVIRONMENT &KEY &OPTIONAL &REST &WHOLE * **
> *** *BREAK-ON-SIGNALS* *COMPILE-FILE-PATHNAME* *COMPILE-FILE-TRUENAME*
> *COMPILE-PRINT* *COMPILE-VERBOSE* *DEBUG-IO* *DEBUGGER-HOOK*
> *DEFAULT-PATHNAME-DEFAULTS* *ERROR-OUTPUT* *FEATURES* *GENSYM-COUNTER*
> *LOAD-PATHNAME* *LOAD-PRINT* *LOAD-TRUENAME* *LOAD-VERBOSE*
> *MACROEXPAND-HOOK* *MODULES* *PACKAGE* *PRINT-ARRAY* *PRINT-BASE*
> *PRINT-CASE* *PRINT-CIRCLE* *PRINT-ESCAPE* *PRINT-GENSYM* *PRINT-LENGTH*
> *PRINT-LEVEL* *PRINT-LINES* *PRINT-MISER-WIDTH* *PRINT-PPRINT-DISPATCH*
> *PRINT-PRETTY* *PRINT-RADIX* *PRINT-READABLY* *PRINT-RIGHT-MARGIN*
> *QUERY-IO*
> *RANDOM-STATE* *READ-BASE* *READ-DEFAULT-FLOAT-FORMAT* *READ-EVAL*
> *READ-SUPPRESS* *READTABLE* *STANDARD-INPUT* *STANDARD-OUTPUT*
> *TERMINAL-IO*
> *TRACE-OUTPUT* + ++ +++ - / // /// /= 1+ 1- < <= = > >= ABORT ABS ACONS
> ACOS
> ACOSH ADD-METHOD ADJOIN ADJUST-ARRAY ADJUSTABLE-ARRAY-P ALLOCATE-INSTANCE
> ALPHA-CHAR-P ALPHANUMERICP AND APPEND APPLY APROPOS APROPOS-LIST AREF
> ARITHMETIC-ERROR ARITHMETIC-ERROR-OPERANDS ARITHMETIC-ERROR-OPERATION
> ARRAY
> ARRAY-DIMENSION ARRAY-DIMENSION-LIMIT ARRAY-DIMENSIONS ARRAY-DISPLACEMENT
> ARRAY-ELEMENT-TYPE ARRAY-HAS-FILL-POINTER-P ARRAY-IN-BOUNDS-P ARRAY-RANK
> ARRAY-RANK-LIMIT ARRAY-ROW-MAJOR-INDEX ARRAY-TOTAL-SIZE
> ARRAY-TOTAL-SIZE-LIMIT ARRAYP ASH ASIN ASINH ASSERT ASSOC ASSOC-IF
> ASSOC-IF-NOT ATAN ATANH ATOM BASE-CHAR BASE-STRING BIGNUM BIT BIT-AND
> BIT-ANDC1 BIT-ANDC2 BIT-EQV BIT-IOR BIT-NAND BIT-NOR BIT-NOT BIT-ORC1
> BIT-ORC2 BIT-VECTOR BIT-VECTOR-P BIT-XOR BLOCK BOOLE BOOLE-1 BOOLE-2
> BOOLE-AND BOOLE-ANDC1 BOOLE-ANDC2 BOOLE-C1 BOOLE-C2 BOOLE-CLR BOOLE-EQV
> BOOLE-IOR BOOLE-NAND BOOLE-NOR BOOLE-ORC1 BOOLE-ORC2 BOOLE-SET BOOLE-XOR
> BOOLEAN BOTH-CASE-P BOUNDP BREAK BROADCAST-STREAM BROADCAST-STREAM-STREAMS
> BUILT-IN-CLASS BUTLAST BYTE BYTE-POSITION BYTE-SIZE CAAAAR CAAADR CAAAR
> CAADAR CAADDR CAADR CAAR CADAAR CADADR CADAR CADDAR CADDDR CADDR CADR
> CALL-ARGUMENTS-LIMIT CALL-METHOD CALL-NEXT-METHOD CAR CASE CATCH CCASE
> CDAAAR
> CDAADR CDAAR CDADAR CDADDR CDADR CDAR CDDAAR CDDADR CDDAR CDDDAR CDDDDR
> CDDDR
> CDDR CDR CEILING CELL-ERROR CELL-ERROR-NAME CERROR CHANGE-CLASS CHAR
> CHAR-CODE CHAR-CODE-LIMIT CHAR-DOWNCASE CHAR-EQUAL CHAR-GREATERP CHAR-INT
> CHAR-LESSP CHAR-NAME CHAR-NOT-EQUAL CHAR-NOT-GREATERP CHAR-NOT-LESSP
> CHAR-UPCASE CHAR/= CHAR< CHAR<= CHAR= CHAR> CHAR>= CHARACTER CHARACTERP
> CHECK-TYPE CIS CLASS CLASS-NAME CLASS-OF CLEAR-INPUT CLEAR-OUTPUT CLOSE
> CLRHASH CODE-CHAR COERCE COMPILATION-SPEED COMPILE COMPILE-FILE
> COMPILE-FILE-PATHNAME COMPILED-FUNCTION COMPILED-FUNCTION-P COMPILER-MACRO
> COMPILER-MACRO-FUNCTION COMPLEMENT COMPLEX COMPLEXP
> COMPUTE-APPLICABLE-METHODS COMPUTE-RESTARTS CONCATENATE
> CONCATENATED-STREAM
> CONCATENATED-STREAM-STREAMS COND CONDITION CONJUGATE CONS CONSP CONSTANTLY
> CONSTANTP CONTINUE CONTROL-ERROR COPY-ALIST COPY-LIST COPY-PPRINT-DISPATCH
> COPY-READTABLE COPY-SEQ COPY-STRUCTURE COPY-SYMBOL COPY-TREE COS COSH
> COUNT
> COUNT-IF COUNT-IF-NOT CTYPECASE DEBUG DECF DECLAIM DECLARATION DECLARE
> DECODE-FLOAT DECODE-UNIVERSAL-TIME DEFCLASS DEFCONSTANT DEFGENERIC
> DEFINE-COMPILER-MACRO DEFINE-CONDITION DEFINE-METHOD-COMBINATION
> DEFINE-MODIFY-MACRO DEFINE-SETF-EXPANDER DEFINE-SYMBOL-MACRO DEFMACRO
> DEFMETHOD DEFPACKAGE DEFPARAMETER DEFSETF DEFSTRUCT DEFTYPE DEFUN DEFVAR
> DELETE DELETE-DUPLICATES DELETE-FILE DELETE-IF DELETE-IF-NOT
> DELETE-PACKAGE
> DENOMINATOR DEPOSIT-FIELD DESCRIBE DESCRIBE-OBJECT DESTRUCTURING-BIND
> DIGIT-CHAR DIGIT-CHAR-P DIRECTORY DIRECTORY-NAMESTRING DISASSEMBLE
> DIVISION-BY-ZERO DO DO* DO-ALL-SYMBOLS DO-EXTERNAL-SYMBOLS DO-SYMBOLS
> DOCUMENTATION DOLIST DOTIMES DOUBLE-FLOAT DOUBLE-FLOAT-EPSILON
> DOUBLE-FLOAT-NEGATIVE-EPSILON DPB DRIBBLE DYNAMIC-EXTENT ECASE ECHO-STREAM
> ECHO-STREAM-INPUT-STREAM ECHO-STREAM-OUTPUT-STREAM ED EIGHTH ELT
> ENCODE-UNIVERSAL-TIME END-OF-FILE ENDP ENOUGH-NAMESTRING
> ENSURE-DIRECTORIES-EXIST ENSURE-GENERIC-FUNCTION EQ EQL EQUAL EQUALP ERROR
> ETYPECASE EVAL EVAL-WHEN EVENP EVERY EXP EXPORT EXPT EXTENDED-CHAR FBOUNDP
> FCEILING FDEFINITION FFLOOR FIFTH FILE-AUTHOR FILE-ERROR
> FILE-ERROR-PATHNAME
> FILE-LENGTH FILE-NAMESTRING FILE-POSITION FILE-STREAM FILE-STRING-LENGTH
> FILE-WRITE-DATE FILL FILL-POINTER FIND FIND-ALL-SYMBOLS FIND-CLASS FIND-IF
> FIND-IF-NOT FIND-METHOD FIND-PACKAGE FIND-RESTART FIND-SYMBOL
> FINISH-OUTPUT
> FIRST FIXNUM FLET FLOAT FLOAT-DIGITS FLOAT-PRECISION FLOAT-RADIX
> FLOAT-SIGN
> FLOATING-POINT-INEXACT FLOATING-POINT-INVALID-OPERATION
> FLOATING-POINT-OVERFLOW FLOATING-POINT-UNDERFLOW FLOATP FLOOR FMAKUNBOUND
> FORCE-OUTPUT FORMAT FORMATTER FOURTH FRESH-LINE FROUND FTRUNCATE FTYPE
> FUNCALL FUNCTION FUNCTION-KEYWORDS FUNCTION-LAMBDA-EXPRESSION FUNCTIONP
> GCD
> GENERIC-FUNCTION GENSYM GENTEMP GET GET-DECODED-TIME
> GET-DISPATCH-MACRO-CHARACTER GET-INTERNAL-REAL-TIME GET-INTERNAL-RUN-TIME
> GET-MACRO-CHARACTER GET-OUTPUT-STREAM-STRING GET-PROPERTIES
> GET-SETF-EXPANSION GET-UNIVERSAL-TIME GETF GETHASH GO GRAPHIC-CHAR-P
> HANDLER-BIND HANDLER-CASE HASH-TABLE HASH-TABLE-COUNT HASH-TABLE-P
> HASH-TABLE-REHASH-SIZE HASH-TABLE-REHASH-THRESHOLD HASH-TABLE-SIZE
> HASH-TABLE-TEST HOST-NAMESTRING IDENTITY IF IGNORABLE IGNORE IGNORE-ERRORS
> IMAGPART IMPORT IN-PACKAGE INCF INITIALIZE-INSTANCE INLINE INPUT-STREAM-P
> INSPECT INTEGER INTEGER-DECODE-FLOAT INTEGER-LENGTH INTEGERP
> INTERACTIVE-STREAM-P INTERN INTERNAL-TIME-UNITS-PER-SECOND INTERSECTION
> INVALID-METHOD-ERROR INVOKE-DEBUGGER INVOKE-RESTART
> INVOKE-RESTART-INTERACTIVELY ISQRT KEYWORD KEYWORDP LABELS LAMBDA
> LAMBDA-LIST-KEYWORDS LAMBDA-PARAMETERS-LIMIT LAST LCM LDB LDB-TEST LDIFF
> LEAST-NEGATIVE-DOUBLE-FLOAT LEAST-NEGATIVE-LONG-FLOAT
> LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT
> LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT
> LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT
> LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT
> LEAST-NEGATIVE-SHORT-FLOAT LEAST-NEGATIVE-SINGLE-FLOAT
> LEAST-POSITIVE-DOUBLE-FLOAT LEAST-POSITIVE-LONG-FLOAT
> LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT
> LEAST-POSITIVE-NORMALIZED-LONG-FLOAT
> LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT
> LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT
> LEAST-POSITIVE-SHORT-FLOAT LEAST-POSITIVE-SINGLE-FLOAT LENGTH LET LET*
> LISP-IMPLEMENTATION-TYPE LISP-IMPLEMENTATION-VERSION LIST LIST*
> LIST-ALL-PACKAGES LIST-LENGTH LISTEN LISTP LOAD
> LOAD-LOGICAL-PATHNAME-TRANSLATIONS LOAD-TIME-VALUE LOCALLY LOG LOGAND
> LOGANDC1 LOGANDC2 LOGBITP LOGCOUNT LOGEQV LOGICAL-PATHNAME
> LOGICAL-PATHNAME-TRANSLATIONS LOGIOR LOGNAND LOGNOR LOGNOT LOGORC1 LOGORC2
> LOGTEST LOGXOR LONG-FLOAT LONG-FLOAT-EPSILON LONG-FLOAT-NEGATIVE-EPSILON
> LONG-SITE-NAME LOOP LOOP-FINISH LOWER-CASE-P MACHINE-INSTANCE MACHINE-TYPE
> MACHINE-VERSION MACRO-FUNCTION MACROEXPAND MACROEXPAND-1 MACROLET
> MAKE-ARRAY
> MAKE-BROADCAST-STREAM MAKE-CONCATENATED-STREAM MAKE-CONDITION
> MAKE-DISPATCH-MACRO-CHARACTER MAKE-ECHO-STREAM MAKE-HASH-TABLE
> MAKE-INSTANCE
> MAKE-INSTANCES-OBSOLETE MAKE-LIST MAKE-LOAD-FORM
> MAKE-LOAD-FORM-SAVING-SLOTS
> MAKE-METHOD MAKE-PACKAGE MAKE-PATHNAME MAKE-RANDOM-STATE MAKE-SEQUENCE
> MAKE-STRING MAKE-STRING-INPUT-STREAM MAKE-STRING-OUTPUT-STREAM MAKE-SYMBOL
> MAKE-SYNONYM-STREAM MAKE-TWO-WAY-STREAM MAKUNBOUND MAP MAP-INTO MAPC
> MAPCAN
> MAPCAR MAPCON MAPHASH MAPL MAPLIST MASK-FIELD MAX MEMBER MEMBER-IF
> MEMBER-IF-NOT MERGE MERGE-PATHNAMES METHOD METHOD-COMBINATION
> METHOD-COMBINATION-ERROR METHOD-QUALIFIERS MIN MINUSP MISMATCH MOD
> MOST-NEGATIVE-DOUBLE-FLOAT MOST-NEGATIVE-FIXNUM MOST-NEGATIVE-LONG-FLOAT
> MOST-NEGATIVE-SHORT-FLOAT MOST-NEGATIVE-SINGLE-FLOAT
> MOST-POSITIVE-DOUBLE-FLOAT MOST-POSITIVE-FIXNUM MOST-POSITIVE-LONG-FLOAT
> MOST-POSITIVE-SHORT-FLOAT MOST-POSITIVE-SINGLE-FLOAT MUFFLE-WARNING
> MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL MULTIPLE-VALUE-LIST
> MULTIPLE-VALUE-PROG1 MULTIPLE-VALUE-SETQ MULTIPLE-VALUES-LIMIT NAME-CHAR
> NAMESTRING NBUTLAST NCONC NEXT-METHOD-P NIL NINTERSECTION NINTH
> NO-APPLICABLE-METHOD NO-NEXT-METHOD NOT NOTANY NOTEVERY NOTINLINE NRECONC
> NREVERSE NSET-DIFFERENCE NSET-EXCLUSIVE-OR NSTRING-CAPITALIZE
> NSTRING-DOWNCASE NSTRING-UPCASE NSUBLIS NSUBST NSUBST-IF NSUBST-IF-NOT
> NSUBSTITUTE NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT NTH NTH-VALUE NTHCDR NULL
> NUMBER NUMBERP NUMERATOR NUNION ODDP OPEN OPEN-STREAM-P OPTIMIZE OR
> OTHERWISE
> OUTPUT-STREAM-P PACKAGE PACKAGE-ERROR PACKAGE-ERROR-PACKAGE PACKAGE-NAME
> PACKAGE-NICKNAMES PACKAGE-SHADOWING-SYMBOLS PACKAGE-USE-LIST
> PACKAGE-USED-BY-LIST PACKAGEP PAIRLIS PARSE-ERROR PARSE-INTEGER
> PARSE-NAMESTRING PATHNAME PATHNAME-DEVICE PATHNAME-DIRECTORY PATHNAME-HOST
> PATHNAME-MATCH-P PATHNAME-NAME PATHNAME-TYPE PATHNAME-VERSION PATHNAMEP
> PEEK-CHAR PHASE PI PLUSP POP POSITION POSITION-IF POSITION-IF-NOT PPRINT
> PPRINT-DISPATCH PPRINT-EXIT-IF-LIST-EXHAUSTED PPRINT-FILL PPRINT-INDENT
> PPRINT-LINEAR PPRINT-LOGICAL-BLOCK PPRINT-NEWLINE PPRINT-POP PPRINT-TAB
> PPRINT-TABULAR PRIN1 PRIN1-TO-STRING PRINC PRINC-TO-STRING PRINT
> PRINT-NOT-READABLE PRINT-NOT-READABLE-OBJECT PRINT-OBJECT
> PRINT-UNREADABLE-OBJECT PROBE-FILE PROCLAIM PROG PROG* PROG1 PROG2 PROGN
> PROGRAM-ERROR PROGV PROVIDE PSETF PSETQ PUSH PUSHNEW QUOTE RANDOM
> RANDOM-STATE RANDOM-STATE-P RASSOC RASSOC-IF RASSOC-IF-NOT RATIO RATIONAL
> RATIONALIZE RATIONALP READ READ-BYTE READ-CHAR READ-CHAR-NO-HANG
> READ-DELIMITED-LIST READ-FROM-STRING READ-LINE READ-PRESERVING-WHITESPACE
> READ-SEQUENCE READER-ERROR READTABLE READTABLE-CASE READTABLEP REAL REALP
> REALPART REDUCE REINITIALIZE-INSTANCE REM REMF REMHASH REMOVE
> REMOVE-DUPLICATES REMOVE-IF REMOVE-IF-NOT REMOVE-METHOD REMPROP
> RENAME-FILE
> RENAME-PACKAGE REPLACE REQUIRE REST RESTART RESTART-BIND RESTART-CASE
> RESTART-NAME RETURN RETURN-FROM REVAPPEND REVERSE ROOM ROTATEF ROUND
> ROW-MAJOR-AREF RPLACA RPLACD SAFETY SATISFIES SBIT SCALE-FLOAT SCHAR
> SEARCH
> SECOND SEQUENCE SERIOUS-CONDITION SET SET-DIFFERENCE
> SET-DISPATCH-MACRO-CHARACTER SET-EXCLUSIVE-OR SET-MACRO-CHARACTER
> SET-PPRINT-DISPATCH SET-SYNTAX-FROM-CHAR SETF SETQ SEVENTH SHADOW
> SHADOWING-IMPORT SHARED-INITIALIZE SHIFTF SHORT-FLOAT SHORT-FLOAT-EPSILON
> SHORT-FLOAT-NEGATIVE-EPSILON SHORT-SITE-NAME SIGNAL SIGNED-BYTE SIGNUM
> SIMPLE-ARRAY SIMPLE-BASE-STRING SIMPLE-BIT-VECTOR SIMPLE-BIT-VECTOR-P
> SIMPLE-CONDITION SIMPLE-CONDITION-FORMAT-ARGUMENTS
> SIMPLE-CONDITION-FORMAT-CONTROL SIMPLE-ERROR SIMPLE-STRING SIMPLE-STRING-P
> SIMPLE-TYPE-ERROR SIMPLE-VECTOR SIMPLE-VECTOR-P SIMPLE-WARNING SIN
> SINGLE-FLOAT SINGLE-FLOAT-EPSILON SINGLE-FLOAT-NEGATIVE-EPSILON SINH SIXTH
> SLEEP SLOT-BOUNDP SLOT-EXISTS-P SLOT-MAKUNBOUND SLOT-MISSING SLOT-UNBOUND
> SLOT-VALUE SOFTWARE-TYPE SOFTWARE-VERSION SOME SORT SPACE SPECIAL
> SPECIAL-OPERATOR-P SPEED SQRT STABLE-SORT STANDARD STANDARD-CHAR
> STANDARD-CHAR-P STANDARD-CLASS STANDARD-GENERIC-FUNCTION STANDARD-METHOD
> STANDARD-OBJECT STEP STORAGE-CONDITION STORE-VALUE STREAM
> STREAM-ELEMENT-TYPE
> STREAM-ERROR STREAM-ERROR-STREAM STREAM-EXTERNAL-FORMAT STREAMP STRING
> STRING-CAPITALIZE STRING-DOWNCASE STRING-EQUAL STRING-GREATERP
> STRING-LEFT-TRIM STRING-LESSP STRING-NOT-EQUAL STRING-NOT-GREATERP
> STRING-NOT-LESSP STRING-RIGHT-TRIM STRING-STREAM STRING-TRIM STRING-UPCASE
> STRING/= STRING< STRING<= STRING= STRING> STRING>= STRINGP STRUCTURE
> STRUCTURE-CLASS STRUCTURE-OBJECT STYLE-WARNING SUBLIS SUBSEQ SUBSETP SUBST
> SUBST-IF SUBST-IF-NOT SUBSTITUTE SUBSTITUTE-IF SUBSTITUTE-IF-NOT SUBTYPEP
> SVREF SXHASH SYMBOL SYMBOL-FUNCTION SYMBOL-MACROLET SYMBOL-NAME
> SYMBOL-PACKAGE SYMBOL-PLIST SYMBOL-VALUE SYMBOLP SYNONYM-STREAM
> SYNONYM-STREAM-SYMBOL T TAGBODY TAILP TAN TANH TENTH TERPRI THE THIRD
> THROW
> TIME TRACE TRANSLATE-LOGICAL-PATHNAME TRANSLATE-PATHNAME TREE-EQUAL
> TRUENAME
> TRUNCATE TWO-WAY-STREAM TWO-WAY-STREAM-INPUT-STREAM
> TWO-WAY-STREAM-OUTPUT-STREAM TYPE TYPE-ERROR TYPE-ERROR-DATUM
> TYPE-ERROR-EXPECTED-TYPE TYPE-OF TYPECASE TYPEP UNBOUND-SLOT
> UNBOUND-SLOT-INSTANCE UNBOUND-VARIABLE UNDEFINED-FUNCTION UNEXPORT
> UNINTERN
> UNION UNLESS UNREAD-CHAR UNSIGNED-BYTE UNTRACE UNUSE-PACKAGE
> UNWIND-PROTECT
> UPDATE-INSTANCE-FOR-DIFFERENT-CLASS UPDATE-INSTANCE-FOR-REDEFINED-CLASS
> UPGRADED-ARRAY-ELEMENT-TYPE UPGRADED-COMPLEX-PART-TYPE UPPER-CASE-P
> USE-PACKAGE USE-VALUE USER-HOMEDIR-PATHNAME VALUES VALUES-LIST VARIABLE
> VECTOR VECTOR-POP VECTOR-PUSH VECTOR-PUSH-EXTEND VECTORP WARN WARNING WHEN
> WILD-PATHNAME-P WITH-ACCESSORS WITH-COMPILATION-UNIT
> WITH-CONDITION-RESTARTS
> WITH-HASH-TABLE-ITERATOR WITH-INPUT-FROM-STRING WITH-OPEN-FILE
> WITH-OPEN-STREAM WITH-OUTPUT-TO-STRING WITH-PACKAGE-ITERATOR
> WITH-SIMPLE-RESTART WITH-SLOTS WITH-STANDARD-IO-SYNTAX WRITE WRITE-BYTE
> WRITE-CHAR WRITE-LINE WRITE-SEQUENCE WRITE-STRING WRITE-TO-STRING Y-OR-N-P
> YES-OR-NO-P ZEROP))
>
> (defparameter *fboundp-ansi-cl-symbols* (loop for x in ansi-cl-symbols when
> (fboundp x) collect x))
>
> (setq safe-symbols (loop for fn in *fboundp-ansi-cl-symbols*
> when (and (not (dangerous fn))
> (not (member fn *known-bad*)))
> collect fn))
> (defun obvious ()
> (loop for x in safe-symbols when (rude x) collect (print x t)))
>
> (defun arg-types (x)
> (or (get x 'system:proclaimed-arg-types)
> (get x 'compiler::arg-types)
> (make-list (random *limit*) ':initial-element t)))
>
> (defun number-of-args (x)
> (cond ((get x 'system:proclaimed-arg-types)
> (length (get x 'system:proclaimed-arg-types)))
> ((get x 'compiler::arg-types)
> (length (get x 'compiler::arg-types)))
> (t (random *limit*))))
>
> (defun rude (x)
> (let (*form* errno)
> (setq errno
> (si::system
> (format nil
> "4 -eval '(progn (ignore-errors (~a ~a)) (ignore-errors
> (~a ~a)))' < /dev/null >& foo"
> x
> (setq *form*
> (apply 'concatenate
> (cons 'string
> (loop for i from 1 to (number-of-args x)
> collect (format nil
> "(quote (~a .
> 17))"
> (character (+ 65
> i)))))))
> x *form*)))
> (let ((str (si::file-to-string "foo")))
> (cond ((or (not (equal errno 0))
> (search "Segmentation" str)
> (search "Control stack" str))
> (format t "(~a ~a)" x *form*)
> t)
> (t nil)))))
>
>
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Gcl-devel] Re: funny symbol packages,
Camm Maguire <=