X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=92d8ee4633784c0684c274513743bf38c9a1d300;hb=020de3c04699323437f0c746fe986506b716ab97;hp=41145889555ba7e41b9518b99aca2817cdc79282;hpb=2963d6858d147b23c33f38e051e61264b479c9fc;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 4114588..92d8ee4 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -69,16 +69,28 @@
 	     (char-code char))
 	newvalue))
 
-;;; FIXME: could be SB!XC:DEFMACRO inside EVAL-WHEN (COMPILE EVAL)
-(defmacro get-cmt-entry (char rt)
-  `(the function
-	(elt (the simple-vector (character-macro-table ,rt))
-	     (char-code ,char))))
-
-(defun set-cmt-entry (char newvalue &optional (rt *readtable*))
-  (setf (elt (the simple-vector (character-macro-table rt))
-	     (char-code char))
-	(coerce newvalue 'function)))
+;;; the value actually stored in the character macro table. As per
+;;; ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, this can
+;;; be either a function or NIL.
+(eval-when (:compile-toplevel :execute)
+  (sb!xc:defmacro get-raw-cmt-entry (char readtable)
+    `(svref (character-macro-table ,readtable)
+	    (char-code ,char))))
+
+;;; the value represented by whatever is stored in the character macro
+;;; table. As per ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER,
+;;; a function value represents itself, and a NIL value represents the
+;;; default behavior.
+(defun get-coerced-cmt-entry (char readtable)
+  (the function 
+    (or (get-raw-cmt-entry char readtable)
+	#'read-token)))
+
+(defun set-cmt-entry (char new-value-designator &optional (rt *readtable*))
+  (setf (svref (character-macro-table rt)
+	       (char-code char))
+	(and new-value-designator
+	     (%coerce-callable-to-fun new-value-designator))))
 
 (defun undefined-macro-char (stream char)
   (unless *read-suppress*
@@ -178,7 +190,7 @@
   FROM-TABLE defaults to the standard Lisp readtable when NIL."
   (let ((really-from-readtable (or from-readtable *standard-readtable*)))
     ;; Copy FROM-CHAR entries to TO-CHAR entries, but make sure that if
-    ;; from char is a constituent you don't copy non-movable secondary
+    ;; FROM-CHAR is a constituent you don't copy non-movable secondary
     ;; attributes (constituent types), and that said attributes magically
     ;; appear if you transform a non-constituent to a constituent.
     (let ((att (get-cat-entry from-char really-from-readtable)))
@@ -186,42 +198,51 @@
 	  (setq att (get-secondary-attribute to-char)))
       (set-cat-entry to-char att to-readtable)
       (set-cmt-entry to-char
-		     (get-cmt-entry from-char really-from-readtable)
+		     (get-raw-cmt-entry from-char really-from-readtable)
 		     to-readtable)))
   t)
 
 (defun set-macro-character (char function &optional
-				 (non-terminatingp nil) (rt *readtable*))
+				 (non-terminatingp nil)
+				 (readtable *readtable*))
   #!+sb-doc
-  "Causes CHAR to be a macro character which invokes FUNCTION when
-   seen by the reader. The NON-TERMINATINGP flag can be used to
-   make the macro character non-terminating. The optional readtable
-   argument defaults to the current readtable. SET-MACRO-CHARACTER
-   returns T."
-  (let ((rt (or rt *standard-readtable*)))
-    (if non-terminatingp
-        (set-cat-entry char (get-secondary-attribute char) rt)
-        (set-cat-entry char +char-attr-terminating-macro+ rt))
-    (set-cmt-entry char function rt)
-    T))
-
-(defun get-macro-character (char &optional (rt *readtable*))
+  "Causes CHAR to be a macro character which invokes FUNCTION when seen
+   by the reader. The NON-TERMINATINGP flag can be used to make the macro
+   character non-terminating, i.e. embeddable in a symbol name."
+  (let ((designated-readtable (or readtable *standard-readtable*)))
+    (set-cat-entry char
+		   (if non-terminatingp
+		       (get-secondary-attribute char)
+		       +char-attr-terminating-macro+)
+		   designated-readtable)
+    (set-cmt-entry char function designated-readtable)
+    t)) ; (ANSI-specified return value)
+
+(defun get-macro-character (char &optional (readtable *readtable*))
   #!+sb-doc
   "Return the function associated with the specified CHAR which is a macro
-  character. The optional readtable argument defaults to the current
-  readtable."
-  (let ((rt (or rt *standard-readtable*)))
-    ;; Check macro syntax, return associated function if it's there.
-    ;; Returns a value for all constituents.
-    (cond ((constituentp char)
-	   (values (get-cmt-entry char rt) t))
-	  ((terminating-macrop char)
-	   (values (get-cmt-entry char rt) nil))
-	  (t nil))))
+  character, or NIL if there is no such function. As a second value, return
+  T if CHAR is a macro character which is non-terminating, i.e. which can
+  be embedded in a symbol name."
+  (let* ((designated-readtable (or readtable *standard-readtable*))
+	 ;; the first return value: a FUNCTION if CHAR is a macro
+	 ;; character, or NIL otherwise
+	 (fun-value (get-raw-cmt-entry char designated-readtable)))
+    (values fun-value
+	    ;; NON-TERMINATING-P return value:
+	    (if fun-value
+		(or (constituentp char)
+		    (not (terminating-macrop char)))
+		;; ANSI's definition of GET-MACRO-CHARACTER says this
+		;; value is NIL when CHAR is not a macro character.
+		;; I.e. this value means not just "non-terminating
+		;; character?" but "non-terminating macro character?".
+		nil))))
 
 ;;;; definitions to support internal programming conventions
 
-(defmacro eofp (char) `(eq ,char *eof-object*))
+(defmacro eofp (char)
+  `(eq ,char *eof-object*))
 
 (defun flush-whitespace (stream)
   ;; This flushes whitespace chars, returning the last char it read (a
@@ -235,9 +256,9 @@
 		   +char-attr-whitespace+)
 	       (done-with-fast-read-char)
 	       char)))
-	;; fundamental-stream
+	;; CLOS stream
 	(do ((attribute-table (character-attribute-table *readtable*))
-	     (char (stream-read-char stream) (stream-read-char stream)))
+	     (char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof)
 		 (/= (the fixnum (aref attribute-table (char-code char)))
 		     +char-attr-whitespace+))
@@ -249,27 +270,31 @@
 
 (defun !cold-init-standard-readtable ()
   (setq *standard-readtable* (make-readtable))
-  ;; All characters default to "constituent" in MAKE-READTABLE.
-  ;; *** un-constituent-ize some of these ***
+  ;; All characters get boring defaults in MAKE-READTABLE. Now we
+  ;; override the boring defaults on characters which need more
+  ;; interesting behavior.
   (let ((*readtable* *standard-readtable*))
-    (set-cat-entry (code-char tab-char-code) +char-attr-whitespace+)
-    (set-cat-entry #\linefeed +char-attr-whitespace+)
-    (set-cat-entry #\space +char-attr-whitespace+)
-    (set-cat-entry (code-char form-feed-char-code) +char-attr-whitespace+)
-    (set-cat-entry (code-char return-char-code) +char-attr-whitespace+)
+
+    (flet ((whitespaceify (char)
+	     (set-cat-entry char +char-attr-whitespace+)))
+      (whitespaceify (code-char tab-char-code))
+      (whitespaceify #\linefeed)
+      (whitespaceify #\space)
+      (whitespaceify (code-char form-feed-char-code))
+      (whitespaceify (code-char return-char-code)))
+
     (set-cat-entry #\\ +char-attr-escape+)
     (set-cmt-entry #\\ #'read-token)
-    (set-cat-entry (code-char rubout-char-code) +char-attr-whitespace+)
-    (set-cmt-entry #\: #'read-token)
-    (set-cmt-entry #\| #'read-token)
-    ;; macro definitions
+
+    ;; Easy macro-character definitions are in this source file.
     (set-macro-character #\" #'read-string)
-    ;; * # macro
     (set-macro-character #\' #'read-quote)
     (set-macro-character #\( #'read-list)
     (set-macro-character #\) #'read-right-paren)
     (set-macro-character #\; #'read-comment)
-    ;; * backquote
+    ;; (The hairier macro-character definitions, for #\# and #\`, are
+    ;; defined elsewhere, in their own source files.)
+
     ;; all constituents
     (do ((ichar 0 (1+ ichar))
 	 (char))
@@ -277,7 +302,7 @@
       (setq char (code-char ichar))
       (when (constituentp char *standard-readtable*)
 	    (set-cat-entry char (get-secondary-attribute char))
-	    (set-cmt-entry char #'read-token)))))
+	    (set-cmt-entry char nil)))))
 
 ;;;; implementation of the read buffer
 
@@ -291,7 +316,7 @@
 (defvar *ouch-ptr*)
 
 (declaim (type index *read-buffer-length* *inch-ptr* *ouch-ptr*))
-(declaim (simple-string *read-buffer*))
+(declaim (type (simple-array character (*)) *read-buffer*))
 
 (defmacro reset-read-buffer ()
   ;; Turn *READ-BUFFER* into an empty read buffer.
@@ -387,7 +412,7 @@
 	(cond ((eofp char) (return eof-value))
 	      ((whitespacep char))
 	      (t
-	       (let* ((macrofun (get-cmt-entry char *readtable*))
+	       (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
 		      (result (multiple-value-list
 			       (funcall macrofun stream char))))
 		 ;; Repeat if macro returned nothing.
@@ -401,7 +426,9 @@
 ;;; past them. We assume CHAR is not whitespace.
 (defun read-maybe-nothing (stream char)
   (let ((retval (multiple-value-list
-		 (funcall (get-cmt-entry char *readtable*) stream char))))
+		 (funcall (get-coerced-cmt-entry char *readtable*)
+			  stream
+			  char))))
     (if retval (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
@@ -456,8 +483,8 @@
 		     (fast-read-char nil nil)))
 	      ((or (not char) (char= char #\newline))
 	       (done-with-fast-read-char))))
-	;; FUNDAMENTAL-STREAM
-	(do ((char (stream-read-char stream) (stream-read-char stream)))
+	;; CLOS stream
+	(do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof) (char= char #\newline))))))
   ;; Don't return anything.
   (values))
@@ -520,13 +547,13 @@
 	       (done-with-fast-read-char))
 	    (if (escapep char) (setq char (fast-read-char t)))
 	    (ouch-read-buffer char)))
-	;; FUNDAMENTAL-STREAM
-	(do ((char (stream-read-char stream) (stream-read-char stream)))
+	;; CLOS stream
+	(do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof) (char= char closech))
 	     (if (eq char :eof)
 		 (error 'end-of-file :stream stream)))
 	  (when (escapep char)
-	    (setq char (stream-read-char stream))
+	    (setq char (read-char stream nil :eof))
 	    (if (eq char :eof)
 		(error 'end-of-file :stream stream)))
 	  (ouch-read-buffer char))))
@@ -709,7 +736,8 @@
 	(colons 0)
 	(possibly-rational t)
 	(possibly-float t)
-	(escapes ()))
+	(escapes ())
+	(seen-multiple-escapes nil))
     (reset-read-buffer)
     (prog ((char firstchar))
       (case (char-class3 char attribute-table)
@@ -773,13 +801,13 @@
      RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
-      (unless char (return (make-float)))
+      (unless char (return (make-float stream)))
       (case (char-class char attribute-table)
 	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
 	(#.+char-attr-constituent-expt+ (go EXPONENT))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
-	 (return (make-float)))
+	 (return (make-float stream)))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
@@ -832,12 +860,12 @@
      EXPTDIGIT ; got to EXPONENT, saw "[sign] {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
-      (unless char (return (make-float)))
+      (unless char (return (make-float stream)))
       (case (char-class char attribute-table)
 	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
-	 (return (make-float)))
+	 (return (make-float stream)))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
@@ -856,12 +884,12 @@
      RATIODIGIT ; saw "[sign] {digit}+ slash {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
-      (unless char (return (make-ratio)))
+      (unless char (return (make-ratio stream)))
       (case (char-class2 char attribute-table)
 	(#.+char-attr-constituent-digit+ (go RATIODIGIT))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
-	 (return (make-ratio)))
+	 (return (make-ratio stream)))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
@@ -899,15 +927,15 @@
 		 (#.+char-attr-package-delimiter+ (done-with-fast-read-char)
 						  (go COLON))
 		 (t (go SYMBOL-LOOP)))))
-	    ;; fundamental-stream
+	    ;; CLOS stream
 	    (prog ()
 	     SYMBOL-LOOP
 	     (ouch-read-buffer char)
-	     (setq char (stream-read-char stream))
+	     (setq char (read-char stream nil :eof))
 	     (when (eq char :eof) (go RETURN-SYMBOL))
 	     (case (char-class char attribute-table)
 	       (#.+char-attr-escape+ (go ESCAPE))
-	       (#.+char-attr-delimiter+ (stream-unread-char stream char)
+	       (#.+char-attr-delimiter+ (unread-char char stream)
 			    (go RETURN-SYMBOL))
 	       (#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	       (#.+char-attr-package-delimiter+ (go COLON))
@@ -929,6 +957,7 @@
 	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
       MULT-ESCAPE
+      (setq seen-multiple-escapes t)
       (do ((char (read-char stream t) (read-char stream t)))
 	  ((multiple-escape-p char))
 	(if (escapep char) (setq char (read-char stream t)))
@@ -956,7 +985,9 @@
 		;; a FIND-PACKAGE* function analogous to INTERN*
 		;; and friends?
 		(read-buffer-to-string)
-		*keyword-package*))
+		(if seen-multiple-escapes
+		    (read-buffer-to-string)
+		    *keyword-package*)))
       (reset-read-buffer)
       (setq escapes ())
       (setq char (read-char stream nil nil))
@@ -1120,7 +1151,7 @@
 				 (the index (* num base))))))))
        (setq number (+ num (* number base-power)))))))
 
-(defun make-float ()
+(defun make-float (stream)
   ;; Assume that the contents of *read-buffer* are a legal float, with nothing
   ;; else after it.
   (read-unwind-read-buffer)
@@ -1154,7 +1185,8 @@
     (cond ((eofp char)
 	   ;; If not, we've read the whole number.
 	   (let ((num (make-float-aux number divisor
-				      *read-default-float-format*)))
+				      *read-default-float-format*
+				      stream)))
 	     (return-from make-float (if negative-fraction (- num) num))))
 	  ((exponent-letterp char)
 	   (setq float-char char)
@@ -1172,7 +1204,7 @@
 		((not dig)
 		 (setq exponent (if negative-exponent (- exponent) exponent)))
 	     (setq exponent (+ (* exponent 10) dig)))
-	   ;; Generate and return the float, depending on float-char:
+	   ;; Generate and return the float, depending on FLOAT-CHAR:
 	   (let* ((float-format (case (char-upcase float-char)
 				  (#\E *read-default-float-format*)
 				  (#\S 'short-float)
@@ -1180,35 +1212,31 @@
 				  (#\D 'double-float)
 				  (#\L 'long-float)))
 		  num)
-	     ;; toy@rtp.ericsson.se: We need to watch out if the
+	     ;; Raymond Toy writes: We need to watch out if the
 	     ;; exponent is too small or too large. We add enough to
 	     ;; EXPONENT to make it within range and scale NUMBER
 	     ;; appropriately. This should avoid any unnecessary
 	     ;; underflow or overflow problems.
 	     (multiple-value-bind (min-expo max-expo)
-		 ;; FIXME: These #. forms are broken w.r.t.
-		 ;; cross-compilation portability. Maybe expressions
-		 ;; like
-		 ;;   (LOG SB!XC:MOST-POSITIVE-SHORT-FLOAT 10s0)
-		 ;; could be used instead? Or perhaps some sort of
-		 ;; load-time-form magic?
+		 ;; FIXME: These forms are broken w.r.t.
+		 ;; cross-compilation portability, as the
+		 ;; cross-compiler will call the host's LOG function
+		 ;; while attempting to constant-fold. Maybe some sort
+		 ;; of load-time-form magic could be used instead?
 		 (case float-format
-		   (short-float
-		    (values
-		     #.(log least-positive-normalized-short-float 10s0)
-		     #.(log most-positive-short-float 10s0)))
-		   (single-float
+		   ((short-float single-float)
 		    (values
-		     #.(log least-positive-normalized-single-float 10f0)
-		     #.(log most-positive-single-float 10f0)))
-		   (double-float
+		     (log sb!xc:least-positive-normalized-single-float 10f0)
+		     (log sb!xc:most-positive-single-float 10f0)))
+		   ((double-float #!-long-float long-float)
 		    (values
-		     #.(log least-positive-normalized-double-float 10d0)
-		     #.(log most-positive-double-float 10d0)))
+		     (log sb!xc:least-positive-normalized-double-float 10d0)
+		     (log sb!xc:most-positive-double-float 10d0)))
+		   #!+long-float
 		   (long-float
 		    (values
-		     #.(log least-positive-normalized-long-float 10L0)
-		     #.(log most-positive-long-float 10L0))))
+		     (log sb!xc:least-positive-normalized-long-float 10l0)
+		     (log sb!xc:most-positive-long-float 10l0))))
 	       (let ((correction (cond ((<= exponent min-expo)
 					(ceiling (- min-expo exponent)))
 				       ((>= exponent max-expo)
@@ -1217,7 +1245,7 @@
 					0))))
 		 (incf exponent correction)
 		 (setf number (/ number (expt 10 correction)))
-		 (setq num (make-float-aux number divisor float-format))
+		 (setq num (make-float-aux number divisor float-format stream))
 		 (setq num (* num (expt 10 exponent)))
 		 (return-from make-float (if negative-fraction
 					     (- num)
@@ -1225,10 +1253,15 @@
 	  ;; should never happen
 	  (t (bug "bad fallthrough in floating point reader")))))
 
-(defun make-float-aux (number divisor float-format)
-  (coerce (/ number divisor) float-format))
+(defun make-float-aux (number divisor float-format stream)
+  (handler-case
+      (coerce (/ number divisor) float-format)
+    (type-error (c)
+      (error 'reader-impossible-number-error
+	     :error c :stream stream
+	     :format-control "failed to build float"))))
 
-(defun make-ratio ()
+(defun make-ratio (stream)
   ;; Assume *READ-BUFFER* contains a legal ratio. Build the number from
   ;; the string.
   ;;
@@ -1252,7 +1285,12 @@
 	  (dig ()))
 	 ((or (eofp ch) (not (setq dig (digit-char-p ch *read-base*)))))
 	 (setq denominator (+ (* denominator *read-base*) dig)))
-    (let ((num (/ numerator denominator)))
+    (let ((num (handler-case
+		   (/ numerator denominator)
+		 (arithmetic-error (c)
+		   (error 'reader-impossible-number-error
+			  :error c :stream stream
+			  :format-control "failed to build ratio")))))
       (if negative-number (- num) num))))
 
 ;;;; cruft for dispatch macros
@@ -1363,9 +1401,10 @@
    and the lisp object built by the reader is returned. Macro chars
    will take effect."
   (declare (string string))
+  
   (with-array-data ((string string)
 		    (start start)
-		    (end (or end (length string))))
+		    (end (%check-vector-sequence-bounds string start end)))
     (unless *read-from-string-spares*
       (push (internal-make-string-input-stream "" 0 0)
 	    *read-from-string-spares*))
@@ -1388,51 +1427,55 @@
   (default to the beginning and end of the string)  It skips over
   whitespace characters and then tries to parse an integer. The
   radix parameter must be between 2 and 36."
-  (with-array-data ((string string)
-		    (start start)
-		    (end (or end (length string))))
-    (let ((index (do ((i start (1+ i)))
-		     ((= i end)
-		      (if junk-allowed
-			  (return-from parse-integer (values nil end))
-			  (error "no non-whitespace characters in number")))
-		   (declare (fixnum i))
-		   (unless (whitespacep (char string i)) (return i))))
-	  (minusp nil)
-	  (found-digit nil)
-	  (result 0))
-      (declare (fixnum index))
-      (let ((char (char string index)))
-	(cond ((char= char #\-)
-	       (setq minusp t)
-	       (incf index))
-	      ((char= char #\+)
-	       (incf index))))
-      (loop
-	(when (= index end) (return nil))
-	(let* ((char (char string index))
-	       (weight (digit-char-p char radix)))
-	  (cond (weight
-		 (setq result (+ weight (* result radix))
-		       found-digit t))
-		(junk-allowed (return nil))
-		((whitespacep char)
-		 (do ((jndex (1+ index) (1+ jndex)))
-		     ((= jndex end))
-		   (declare (fixnum jndex))
-		   (unless (whitespacep (char string jndex))
-		     (error "junk in string ~S" string)))
-		 (return nil))
-		(t
-		 (error "junk in string ~S" string))))
-	(incf index))
-      (values
-       (if found-digit
-	   (if minusp (- result) result)
-	   (if junk-allowed
-	       nil
-	       (error "no digits in string ~S" string)))
-       index))))
+  (macrolet ((parse-error (format-control)
+	       `(error 'simple-parse-error
+		       :format-control ,format-control
+		       :format-arguments (list string))))
+    (with-array-data ((string string :offset-var offset)
+		      (start start)
+		      (end (%check-vector-sequence-bounds string start end)))
+      (let ((index (do ((i start (1+ i)))
+		       ((= i end)
+			(if junk-allowed
+			    (return-from parse-integer (values nil end))
+			    (parse-error "no non-whitespace characters in string ~S.")))
+		     (declare (fixnum i))
+		     (unless (whitespacep (char string i)) (return i))))
+	    (minusp nil)
+	    (found-digit nil)
+	    (result 0))
+	(declare (fixnum index))
+	(let ((char (char string index)))
+	  (cond ((char= char #\-)
+		 (setq minusp t)
+		 (incf index))
+		((char= char #\+)
+		 (incf index))))
+	(loop
+	 (when (= index end) (return nil))
+	 (let* ((char (char string index))
+		(weight (digit-char-p char radix)))
+	   (cond (weight
+		  (setq result (+ weight (* result radix))
+			found-digit t))
+		 (junk-allowed (return nil))
+		 ((whitespacep char)
+                  (loop
+                   (incf index)
+                   (when (= index end) (return))
+                   (unless (whitespacep (char string index))
+		      (parse-error "junk in string ~S")))
+		  (return nil))
+		 (t
+		  (parse-error "junk in string ~S"))))
+	 (incf index))
+	(values
+	 (if found-digit
+	     (if minusp (- result) result)
+	     (if junk-allowed
+		 nil
+		 (parse-error "no digits in string ~S")))
+	 (- index offset))))))
 
 ;;;; reader initialization code