Changeset 15238 for release


Ignore:
Timestamp:
Mar 9, 2012, 7:06:23 PM (7 years ago)
Author:
rme
Message:

Merge trunk changes.

Location:
release/1.8/source
Files:
22 edited

Legend:

Unmodified
Added
Removed
  • release/1.8/source

  • release/1.8/source/cocoa-ide/cocoa-editor.lisp

    r14737 r15238  
    35103510  (execute-in-gui #'(lambda ()
    35113511                      (assume-cocoa-thread)
    3512                       (let ((view (find-or-make-hemlock-view pathname)))
    3513                         (hi::handle-hemlock-event view thunk)))))
     3512                      (handler-case
     3513                          (let ((view (find-or-make-hemlock-view pathname)))
     3514                            (hi::handle-hemlock-event view thunk))
     3515                        (error (c)
     3516                          (alert-window :title "Error in Hemlock command processing"
     3517                                        :message (or (ignore-errors (princ-to-string c))
     3518                                                     "#<error printing error message>")
     3519                                        :default-button "Ok"))))))
    35143520
    35153521(defun hemlock-ext:open-sequence-dialog (&key title sequence action (printer #'prin1))
  • release/1.8/source/compiler/X86/x862.lisp

    r15174 r15238  
    10621062
    10631063
    1064 (defun x862-bind-lambda (seg lcells req opt rest keys auxen optsupvloc passed-in-regs lexpr &optional inherited
     1064(defun x862-bind-lambda (seg lcells req opt rest keys auxen optsupvloc passed-in-regs lexpr inherited tail-label
    10651065                             &aux (vloc 0) (numopt (list-length (%car opt)))
    10661066                             (nkeys (list-length (%cadr keys)))
     
    11051105            (x862-copy-register seg reg *x862-arg-z*)
    11061106            (x862-set-var-ea seg rest reg))
    1107             (let* ((loc *x862-vstack*))
    1108               (x862-vpush-register seg *x862-arg-z* :reserved)
    1109               (x862-note-top-cell rest)
    1110               (x862-bind-var seg rest loc *x862-top-vstack-lcell*))))
     1107          (let* ((loc *x862-vstack*))
     1108            (x862-vpush-register seg *x862-arg-z* :reserved)
     1109            (x862-note-top-cell rest)
     1110            (x862-bind-var seg rest loc *x862-top-vstack-lcell*))))
    11111111      (let* ((rvloc (+ vloc (* 2 *x862-target-node-size* nkeys))))
    11121112        (if (setq reg (nx2-assign-register-var rest))
    11131113          (x862-init-regvar seg rest reg (x862-vloc-ea rvloc))
    11141114          (x862-bind-var seg rest rvloc (pop lcells))))))
    1115     (when keys
    1116       (apply #'x862-init-keys seg vloc lcells keys))
     1115  (when keys
     1116    (apply #'x862-init-keys seg vloc lcells keys))
     1117  (when tail-label
     1118    (with-x86-local-vinsn-macros (seg)
     1119      (@+ tail-label)))
    11171120  (x862-seq-bind seg (%car auxen) (%cadr auxen)))
    11181121
     
    67236726          (setq *x862-entry-vstack* *x862-vstack*)
    67246727          (setq reserved-lcells (x862-collect-lcells :reserved))
    6725           (x862-bind-lambda seg reserved-lcells req opt rest keys auxen optsupvloc arg-regs lexprp inherited-vars)
    6726           (when *x862-tail-label*
    6727             (@+ *x862-tail-label*))
     6728          (x862-bind-lambda seg reserved-lcells req opt rest keys auxen optsupvloc arg-regs lexprp inherited-vars *x862-tail-label*)
    67286729          (when next-method-var-scope-info
    67296730            (push next-method-var-scope-info *x862-recorded-symbols*)))
  • release/1.8/source/level-0/X86/X8632/x8632-misc.lisp

    r15156 r15238  
    713713
    714714(defx8632lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
     715  (cmpb ($ x8632::subtag-double-float-vector) (@ x8632::misc-subtag-offset (% vect)))
     716  (je @dfloat)
     717  (cmpb ($ x8632::subtag-double-float) (@ x8632::misc-subtag-offset (% vect)))
     718  (je @dfloat)
    715719  (lea (@ x8632::misc-data-offset (% vect)) (% imm0))
     720  (jmp @common)
     721  @dfloat
     722  (lea (@ x8632::misc-dfloat-offset (% vect)) (% imm0))
     723  @common
    716724  (movl (% imm0) (@ x8632::macptr.address (% ptr)))
    717725  (single-value-return))
  • release/1.8/source/level-0/l0-io.lisp

    r13067 r15238  
    162162                                            (ash (the fixnum (logxor 3rd-unit #x80)) 6))
    163163                                          (the fixnum (logxor 4th-unit #x80)))))))))))))))))
    164         (setf (schar string i) (or char #\Replacement_Character))))))
     164        (setf (schar string i) (or char (note-vector-decoding-problem pointer index :utf-8)))))))
    165165
    166166(defun utf-8-length-of-memory-encoding (pointer noctets start)
  • release/1.8/source/level-1/l1-boot-2.lisp

    r15169 r15238  
    176176        (setq *standard-input* (make-synonym-stream '*terminal-io*)
    177177              *standard-output* (make-synonym-stream '*terminal-io*))))
    178     (setq *error-output* (if *batch-flag*
     178    (setq *error-output* (if (or *batch-flag*
     179                                 (not (same-fd-p (stream-device *stderr* :output)
     180                                                 (stream-device *stdout* :output))))
    179181                           (make-synonym-stream '*stderr*)
    180182                           (make-synonym-stream '*terminal-io*)))
  • release/1.8/source/level-1/l1-error-system.lisp

    r15018 r15238  
    5151  ((kill :initarg :kill :initform nil :reader process-reset-kill)))
    5252
     53(define-condition encoding-problem (condition)
     54  ((character :initarg :character :reader encoding-problem-character)
     55   (destination :initarg :destination :reader encoding-problem-destination)
     56   (encoding-name :initarg :encoding-name :reader encoding-problem-encoding-name))
     57  (:report
     58   (lambda (c s)
     59     (with-slots (character destination encoding-name) c
     60       (format s "Character ~c can't be written to ~a in encoding ~a."
     61               character destination encoding-name)))))
     62
     63
     64
     65(define-condition decoding-problem (condition)
     66  ((source :initarg :source :reader decoding-problem-source)
     67   (position :initarg :position :reader decoding-problem-position)
     68   (encoding-name :initarg :encoding-name :reader decoding-problem-encoding-name))
     69  (:report (lambda (c stream)
     70             (with-slots (source position encoding-name) c
     71               (format stream "Contents of ~a" source)
     72               (when position
     73                 (format stream ", near ~a ~d," (if (typep source 'stream) "position" "index") position))
     74               (format stream " don't represent a valid character in ~s." encoding-name)))))
     75
     76
     77             
    5378
    5479(define-condition print-not-readable (error)
  • release/1.8/source/level-1/l1-init.lisp

    r14362 r15238  
    313313
    314314
    315 (defvar *terminal-character-encoding-name* nil
     315(defvar *terminal-character-encoding-name* :utf-8
    316316  "NIL (implying :ISO-8859-1), or a keyword which names a defined
    317317character encoding to be used for *TERMINAL-IO* and other predefined
  • release/1.8/source/level-1/l1-sysio.lisp

    r15165 r15238  
    8585(defvar *default-external-format* :unix)
    8686
    87 (defvar *default-file-character-encoding* nil)
     87(defvar *default-file-character-encoding* :utf-8)
    8888
    8989(defmethod default-character-encoding ((domain (eql :file)))
     
    932932                   (file-string-length stream #\Return))
    933933                0))
    934            (if (eql (file-position stream) 0)
    935              0
    936              (length (character-encoding-bom-encoding encoding)))))))))
     934           (if (and (eql (file-position stream) 0)
     935                    (character-encoding-use-byte-order-mark encoding))
     936             (length (character-encoding-bom-encoding encoding))
     937             0)))))))
    937938 
  • release/1.8/source/level-1/l1-unicode.lisp

    r14364 r15238  
    154154    (format stream "~a" (character-encoding-name ce))))
    155155
     156(defun note-stream-decoding-problem (stream)
     157  (let* ((source (if (typep stream 'ioblock)
     158                   (ioblock-stream stream)
     159                   stream))
     160         (position (stream-position source))
     161         (encoding-name
     162          (character-encoding-name
     163           (external-format-character-encoding (stream-external-format source)))))
     164    (signal (make-condition 'decoding-problem
     165                            :source source
     166                            :position position
     167                            :encoding-name encoding-name))
     168    #\Replacement_Character))
     169
     170(defun note-vector-decoding-problem (vector index encoding)
     171  (signal (make-condition 'decoding-problem
     172                          :source vector
     173                          :position index
     174                          :encoding-name (let* ((enc (if (typep encoding 'character-encoding)
     175                                                       encoding
     176                                                       (lookup-character-encoding encoding))))
     177                                           (if enc (character-encoding-name enc) encoding))))
     178  #\Replacement_Character)
     179
     180(defun note-encoding-problem (char destination encoding code)
     181  (signal (make-condition 'encoding-problem
     182                          :character char
     183                          :destination (if (typep destination 'ioblock)
     184                                         (ioblock-stream destination)
     185                                         destination)
     186                          :encoding-name (let* ((enc (if (typep encoding 'character-encoding)
     187                                                       encoding
     188                                                       (lookup-character-encoding encoding))))
     189                                           (if enc (character-encoding-name enc) encoding))))
     190  code)
     191                         
    156192;;; N.B.  (ccl:nfunction <name> (lambda (...) ...)) is just  like
    157193;;;       (cl:function (lambda (...) ...)), except that the resulting
     
    205241       (declare (type (mod #x110000) code))
    206242       (if (>= code 256)
    207          (setq code (char-code #\Sub)))
     243         (setq code (note-encoding-problem char stream :iso-8859-1 (char-code #\Sub))))
    208244       (funcall write-function stream code)
    209245       1)))
     
    227263         (declare (type (mod #x110000) code))
    228264         (if (>= code 256)
    229            (setq code (char-code #\Sub)))
     265           (setq code (note-encoding-problem char vector :iso-8859-1 (char-code #\Sub))))
    230266         (progn
    231267           (setf (aref vector idx) code)
     
    247283     (do* ((i start (1+ i)))
    248284          ((>= i end) idx)
    249        (let* ((code (char-code (schar string i))))
     285       (let* ((char (schar string i))
     286              (code (char-code char)))
    250287         (declare (type (mod #x110000) code))
    251288         (if (>= code 256)
    252            (setq code (char-code #\Sub)))
     289           (setq code (note-encoding-problem char pointer :iso-8859-1 (char-code #\Sub))))
    253290         (setf (%get-unsigned-byte pointer idx) code)
    254291         (incf idx)))))
     
    270307  :decode-literal-code-unit-limit 256
    271308  :encode-literal-char-code-limit 256
     309
    272310  )
    273311
     
    284322       (declare (type (mod #x110000) code))
    285323       (when (>= code 128)
    286          (setq code (char-code #\Sub)))
     324         (setq code (note-encoding-problem char stream :us-ascii (char-code #\Sub))))
    287325       (funcall write-function stream code)
    288326       1)))
     
    291329   ascii-stream-decode
    292330   (lambda (1st-unit next-unit-function stream)
    293      (declare (ignore next-unit-function stream)
     331     (declare (ignore next-unit-function)
    294332              (type (unsigned-byte 8) 1st-unit))
    295333     (if (< 1st-unit 128)
    296334       (code-char 1st-unit)
    297        #\Replacement_Character)))
     335       (note-stream-decoding-problem stream))))
    298336  :vector-encode-function
    299337  (nfunction
     
    308346         (declare (type (mod #x110000) code))
    309347         (if (>= code 128)
    310            (setq code (char-code #\Sub)))
     348           (setq code (note-encoding-problem char vector :us-ascii (char-code #\Sub))))
    311349         (setf (aref vector idx) code)
    312350         (incf idx)))))
     
    321359       (let* ((code (aref vector index)))
    322360         (declare (type (unsigned-byte 8) code))
    323          (when (>= code 128)
    324            (setq code (char-code #\Sub)))
    325          (setf (schar string i) (code-char code))))))
     361         (setf (schar string i) (if (< code 128)
     362                                  (code-char code)
     363                                  (note-vector-decoding-problem vector index :us-ascii)))))))
    326364  :memory-encode-function
    327365  (nfunction
     
    330368     (do* ((i start (1+ i)))
    331369          ((>= i end) idx)
    332        (let* ((code (char-code (schar string i))))
     370       (let* ((char (schar string i))
     371              (code (char-code char)))
    333372         (declare (type (mod #x110000) code))
    334373         (if (>= code 128)
    335            (setq code (char-code #\Sub)))
     374           (setq code (note-encoding-problem char pointer :us-ascii (char-code #\Sub))))
    336375         (setf (%get-unsigned-byte pointer idx) code)
    337376         (incf idx)))))
     
    346385         (declare (type (unsigned-byte 8) code))
    347386         (if (>= code 128)
    348            (setf (schar string i) #\sub)
     387           (setf (schar string i) (note-vector-decoding-problem pointer index :us-ascii))
    349388           (setf (schar string i) (code-char code)))))))
    350389  :octets-in-string-function
     
    448487                     
    449488       (declare (type (mod #x110000) code))
    450        (funcall write-function stream (or c2 (char-code #\Sub)))
     489       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-2 (char-code #\Sub))))
    451490       1)))
    452491  :stream-decode-function
     
    467506     (do* ((i start (1+ i)))
    468507          ((>= i end) idx)
    469        (let* ((code (char-code (schar string i)))
     508       (let* ((char (schar string i))
     509              (code (char-code char))
    470510              (c2 (cond ((< code #xa0) code)
    471511                          ((< code #x180)
     
    476516                                  (the fixnum (- code #x2c0)))))))
    477517         (declare (type (mod #x110000) code))
    478          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     518         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-2 (char-code #\Sub))))
    479519         (incf idx)))))
    480520  :vector-decode-function
     
    498538     (do* ((i start (1+ i)))
    499539          ((>= i end) idx)
    500        (let* ((code (char-code (schar string i)))
     540       (let* ((char (schar string i))
     541              (code (char-code char))
    501542              (c2 (cond ((< code #xa0) code)
    502543                        ((< code #x180)
     
    507548                                (the fixnum (- code #x2c0)))))))
    508549       (declare (type (mod #x110000) code))
    509        (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     550       (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-2 (char-code #\Sub))))
    510551       (1+ idx)))))
    511552  :memory-decode-function
     
    619660                              (the fixnum (- code #x2d8)))))))
    620661       (declare (type (mod #x110000) code))
    621        (funcall write-function stream (or c2 (char-code #\Sub)))
     662       (funcall write-function stream (or c2
     663                                          (note-encoding-problem
     664                                           char stream :iso-8859-3 (char-code #\Sub))))
    622665       1)))
    623666  :stream-decode-function
     
    652695               (the fixnum (- code #x2d8)))))))
    653696         (declare (type (mod #x110000) code))
    654          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     697         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-3 (char-code #\Sub))))
    655698         (incf idx)))))
    656699  :vector-decode-function
     
    674717     (do* ((i start (1+ i)))
    675718          ((>= i end) idx)
    676        (let* ((code (char-code (schar string i)))
     719       (let* ((char (schar string i))
     720              (code (char-code char))
    677721              (c2 (cond ((< code #xa0) code)
    678722                        ((< code #x100)
     
    686730                                (the fixnum (- code #x2d8)))))))
    687731         (declare (type (mod #x110000) code))
    688          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     732         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-3 (char-code #\Sub))))
    689733         (incf idx)))))
    690734  :memory-decode-function
     
    798842                     
    799843       (declare (type (mod #x110000) code))
    800        (funcall write-function stream (or c2 (char-code #\Sub)))
     844       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-4 (char-code #\Sub))))
    801845       1)))
    802846  :stream-decode-function
     
    827871                                (the fixnum (- code #x2c0)))))))
    828872         (declare (type (mod #x110000) code))
    829          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     873         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-4 (char-code #\Sub))))
    830874         (incf idx)))))
    831875  :vector-decode-function
     
    849893     (do* ((i start (1+ i)))
    850894          ((>= i end) idx)
    851        (let* ((code (char-code (schar string i)))
     895       (let* ((char (schar string i))
     896              (code (char-code char))
    852897              (c2 (cond ((< code #xa0) code)
    853898                        ((< code #x180)
     
    858903                                (the fixnum (- code #x2c0)))))))
    859904         (declare (type (mod #x110000) code))
    860          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     905         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-4 (char-code #\Sub))))
    861906         (incf idx)))))
    862907  :memory-decode-function
     
    950995                     
    951996       (declare (type (mod #x110000) code))
    952        (funcall write-function stream (or c2 (char-code #\Sub)))
     997       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-5 (char-code #\Sub))))
    953998       1)))
    954999  :stream-decode-function
     
    9791024                                (the fixnum (- code #x400)))))))
    9801025         (declare (type (mod #x110000) code))
    981          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1026         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-5 (char-code #\Sub))))
    9821027         (incf idx)))))
    9831028  :vector-decode-function
     
    10011046     (do* ((i start (1+ i)))
    10021047          ((>= i end) idx)
    1003        (let* ((code (char-code (schar string i)))
     1048       (let* ((char (schar string i))
     1049              (code (char-code char))
    10041050              (c2 (cond ((< code #xa0) code)
    10051051                        ((< code #xb0)
     
    10101056                                (the fixnum (- code #x400)))))))
    10111057         (declare (type (mod #x110000) code))
    1012          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1058         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-5 (char-code #\Sub))))
    10131059         (incf idx)))))
    10141060  :memory-decode-function
     
    10991145                     
    11001146       (declare (type (mod #x110000) code))
    1101        (funcall write-function stream (or c2 (char-code #\Sub)))
     1147       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-6 (char-code #\Sub))))
    11021148       1)))
    11031149  :stream-decode-function
     
    11281174                                (the fixnum (- code #x608)))))))
    11291175         (declare (type (mod #x110000) code))
    1130          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1176         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-6 (char-code #\Sub))))
    11311177         (incf idx)))))
    11321178  :vector-decode-function
     
    11501196     (do* ((i start (1+ i)))
    11511197          ((>= i end) idx)
    1152        (let* ((code (char-code (schar string i)))
     1198       (let* ((char (schar string i))
     1199              (code (char-code char))
    11531200              (c2 (cond ((< code #xa0) code)
    11541201                        ((< code #xb0)
     
    11591206                                (the fixnum (- code #x608)))))))
    11601207         (declare (type (mod #x110000) code))
    1161          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1208         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-6 (char-code #\Sub))))
    11621209         (incf idx)))))
    11631210  :memory-decode-function
     
    12671314             
    12681315       (declare (type (mod #x110000) code))
    1269        (funcall write-function stream (or c2 (char-code #\Sub)))
     1316       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-7 (char-code #\Sub))))
    12701317       1)))
    12711318  :stream-decode-function
     
    13021349                              (the fixnum (- code #x20ac)))))))
    13031350         (declare (type (mod #x110000) code))
    1304          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1351         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-7 (char-code #\Sub))))
    13051352         (incf idx)))))
    13061353  :vector-decode-function
     
    13241371     (do* ((i start (1+ i)))
    13251372          ((>= i end) idx)
    1326        (let* ((code (char-code (schar string i)))
     1373       (let* ((char (schar string i))
     1374              (code (char-code char))
    13271375              (c2 (cond ((< code #xa0) code)
    13281376                      ((< code #xc0)
     
    13391387                              (the fixnum (- code #x20ac)))))))
    13401388         (declare (type (mod #x110000) code))
    1341          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1389         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-7 (char-code #\Sub))))
    13421390         (incf idx)))))
    13431391  :memory-decode-function
     
    14391487             
    14401488       (declare (type (mod #x110000) code))
    1441        (funcall write-function stream (or c2 (char-code #\Sub)))
     1489       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-8 (char-code #\Sub))))
    14421490       1)))
    14431491  :stream-decode-function
     
    14711519                              (the fixnum (- code #x2008)))))))
    14721520         (declare (type (mod #x110000) code))
    1473          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1521         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-8 (char-code #\Sub))))
    14741522         (incf idx)))))
    14751523  :vector-decode-function
     
    14931541     (do* ((i start (1+ i)))
    14941542          ((>= i end) idx)
    1495        (let* ((code (char-code (schar string i)))
     1543       (let* ((char (schar string i))
     1544              (code (char-code char))
    14961545              (c2 (cond ((< code #xa0) code)
    14971546                      ((< code #xf8)
     
    15051554                              (the fixnum (- code #x2008)))))))
    15061555         (declare (type (mod #x110000) code))
    1507          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1556         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-8 (char-code #\Sub))))
    15081557         (incf idx)))))
    15091558  :memory-decode-function
     
    15881637             
    15891638       (declare (type (mod #x110000) code))
    1590        (funcall write-function stream (or c2 (char-code #\Sub)))
     1639       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-9 (char-code #\Sub))))
    15911640       1)))
    15921641  :stream-decode-function
     
    16171666                              (the fixnum (- code #x118)))))))
    16181667         (declare (type (mod #x110000) code))
    1619          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1668         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-9 (char-code #\Sub))))
    16201669         (incf idx)))))
    16211670  :vector-decode-function
     
    16391688     (do* ((i start (1+ i)))
    16401689          ((>= i end) idx)
    1641        (let* ((code (char-code (schar string i)))
     1690       (let* ((char (schar string i))
     1691              (code (char-code char))
    16421692              (c2 (cond ((< code #xd0) code)
    16431693                      ((< code #x100)
     
    16481698                              (the fixnum (- code #x118)))))))
    16491699         (declare (type (mod #x110000) code))
    1650          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1700         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-9 (char-code #\Sub))))
    16511701         (incf idx)))))
    16521702  :memory-decode-function
     
    17441794                              (the fixnum (- code #xa0)))))))
    17451795       (declare (type (mod #x110000) code))
    1746        (funcall write-function stream (or c2 (char-code #\Sub)))
     1796       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-10 (char-code #\Sub))))
    17471797       1)))
    17481798  :stream-decode-function
     
    17701820                              (the fixnum (- code #xa0)))))))
    17711821         (declare (type (mod #x110000) code))
    1772          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1822         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-10 (char-code #\Sub))))
    17731823         (incf idx)))))
    17741824  :vector-decode-function
     
    17921842     (do* ((i start (1+ i)))
    17931843          ((>= i end) idx)
    1794        (let* ((code (char-code (schar string i)))
     1844       (let* ((char (schar string i))
     1845              (code (char-code char))
    17951846              (c2 (cond ((< code #xa0) code)
    17961847                      ((< code #x180)
     
    17981849                              (the fixnum (- code #xa0)))))))
    17991850         (declare (type (mod #x110000) code))
    1800          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1851         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-10 (char-code #\Sub))))
    18011852         (incf idx)))))
    18021853  :memory-decode-function
     
    18391890                       (+ code #x0d60)))))
    18401891       (declare (type (mod #x110000) code))
    1841        (funcall write-function stream (or c2 (char-code #\Sub)))
     1892       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-11 (char-code #\Sub))))
    18421893       1)))
    18431894  :stream-decode-function
     
    18451896   iso-8859-11-stream-decode
    18461897   (lambda (1st-unit next-unit-function stream)
    1847      (declare (ignore next-unit-function stream)
     1898     (declare (ignore next-unit-function)
    18481899              (type (unsigned-byte 8) 1st-unit))
    18491900     (if (< 1st-unit #xa1)
     
    18541905                          (<= 1st-unit #xe3e))))
    18551906         (code-char (- 1st-unit #xd60))
    1856          #\Replacement_Character))))
     1907         (note-stream-decoding-problem stream)))))
    18571908  :vector-encode-function
    18581909  (nfunction
     
    18701921                       (+ code #x0d60)))))
    18711922         (declare (type (mod #x110000) code))
    1872          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     1923         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-11 (char-code #\Sub))))
    18731924         (incf idx)))))
    18741925  :vector-decode-function
     
    18901941                                    (<= 1st-unit #xe3e))))
    18911942                   (code-char (- 1st-unit #xd60))
    1892                    #\Replacement_Character)))))))
     1943                   (note-vector-decoding-problem vector index :iso-8859-11))))))))
    18931944  :memory-encode-function
    18941945  (nfunction
     
    18971948     (do* ((i start (1+ i)))
    18981949          ((>= i end) idx)
    1899        (let* ((code (char-code (schar string i)))
     1950       (let* ((char (schar string i))
     1951              (code (char-code char))
    19001952              (c2 (cond ((< code #xa1) code)
    19011953                      ((and (<= code #xfb)
     
    19031955                       (+ code #x0d60)))))
    19041956         (declare (type (mod #x110000) code))
    1905          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     1957         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-11 (char-code #\Sub))))
    19061958         (incf idx)))))
    19071959  :memory-decode-function
     
    19221974                                    (<= 1st-unit #xe3e))))
    19231975                   (code-char (- 1st-unit #xd60))
    1924                    #\Replacement_Character)))))))
     1976                   (note-vector-decoding-problem pointer index :iso-8859-11))))))))
    19251977  :octets-in-string-function
    19261978  #'8-bit-fixed-width-octets-in-string
     
    20162068                              (the fixnum (- code #x2018)))))))
    20172069       (declare (type (mod #x110000) code))
    2018        (funcall write-function stream (or c2 (char-code #\Sub)))
     2070       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-13 (char-code #\Sub))))
    20192071       1)))
    20202072  :stream-decode-function
     
    20462098                              (the fixnum (- code #x2018)))))))
    20472099         (declare (type (mod #x110000) code))
    2048          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2100         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-13 (char-code #\Sub))))
    20492101         (incf idx)))))
    20502102  :vector-decode-function
     
    20682120     (do* ((i start (1+ i)))
    20692121          ((>= i end) idx)
    2070        (let* ((code (char-code (schar string i)))
     2122       (let* ((char (schar string i))
     2123              (code (char-code char))
    20712124              (c2 (cond ((< code #xa0) code)
    20722125                      ((< code #x180)
     
    20782131                              (the fixnum (- code #x2018)))))))
    20792132         (declare (type (mod #x110000) code))
    2080          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2133         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-13 (char-code #\Sub))))
    20812134         (incf idx)))))
    20822135  :memory-decode-function
     
    22092262                              (the fixnum (- code #x1ef0)))))))
    22102263       (declare (type (mod #x110000) code))
    2211        (funcall write-function stream (or c2 (char-code #\Sub)))
     2264       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-14 (char-code #\Sub))))
    22122265       1)))
    22132266  :stream-decode-function
     
    22472300                              (the fixnum (- code #x1ef0)))))))
    22482301         (declare (type (mod #x110000) code))
    2249          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2302         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-14 (char-code #\Sub))))
    22502303         (incf idx)))))
    22512304  :vector-decode-function
     
    22692322     (do* ((i start (1+ i)))
    22702323          ((>= i end) idx)
    2271        (let* ((code (char-code (schar string i)))
     2324       (let* ((char (schar string i))
     2325              (code (char-code char))
    22722326              (c2 (cond ((< code #xa0) code)
    22732327                      ((< code #x100)
     
    22872341                              (the fixnum (- code #x1ef0)))))))
    22882342         (declare (type (mod #x110000) code))
    2289          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2343         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-14 (char-code #\Sub))))
    22902344         (incf idx)))))
    22912345  :memory-decode-function
     
    23852439                      ((= code #x20ac) #xa4))))
    23862440       (declare (type (mod #x110000) code))
    2387        (funcall write-function stream (or c2 (char-code #\Sub)))
     2441       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-15 (char-code #\Sub))))
    23882442       1)))
    23892443  :stream-decode-function
     
    24152469                      ((= code #x20ac) #xa4))))
    24162470         (declare (type (mod #x110000) code))
    2417          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2471         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-15 (char-code #\Sub))))
    24182472         (incf idx)))))
    24192473  :vector-decode-function
     
    24372491     (do* ((i start (1+ i)))
    24382492          ((>= i end) idx)
    2439        (let* ((code (char-code (schar string i)))
     2493       (let* ((char (schar string i))
     2494              (code (char-code char))
    24402495              (c2 (cond ((< code #xa0) code)
    24412496                      ((< code #x100)
     
    24472502                      ((= code #x20ac) #xa4))))
    24482503         (declare (type (mod #x110000) code))
    2449          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2504         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-15 (char-code #\Sub))))
    24502505         (incf idx)))))
    24512506  :memory-decode-function
     
    25602615                      ((= code #x20ac) #xa4))))
    25612616       (declare (type (mod #x110000) code))
    2562        (funcall write-function stream (or c2 (char-code #\Sub)))
     2617       (funcall write-function stream (or c2 (note-encoding-problem char stream :iso-8859-16 (char-code #\Sub))))
    25632618       1)))
    25642619  :stream-decode-function
     
    25932648                      ((= code #x20ac) #xa4))))
    25942649         (declare (type (mod #x110000) code))
    2595          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2650         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :iso-8859-16 (char-code #\Sub))))
    25962651         (incf idx)))))
    25972652  :vector-decode-function
     
    26152670     (do* ((i start (1+ i)))
    26162671          ((>= i end) idx)
    2617        (let* ((code (char-code (schar string i)))
     2672       (let* ((char (schar string i))
     2673              (code (char-code char))
    26182674              (c2 (cond ((< code #xa0) code)
    26192675                      ((< code #x180)
     
    26282684                      ((= code #x20ac) #xa4))))
    26292685         (declare (type (mod #x110000) code))
    2630          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2686         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :iso-8859-16 (char-code #\Sub))))
    26312687         (incf idx)))))
    26322688  :memory-decode-function
     
    27992855                      ((= code #xf8ff) #xf0))))
    28002856       (declare (type (mod #x110000) code))
    2801        (funcall write-function stream (or c2 (char-code #\Sub)))
     2857       (funcall write-function stream (or c2 (note-encoding-problem char stream :macintosh (char-code #\Sub))))
    28022858       1)))
    28032859  :stream-decode-function
     
    28462902                      ((= code #xf8ff) #xf0))))
    28472903         (declare (type (mod #x110000) code))
    2848          (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2904         (setf (aref vector idx) (or c2 (note-encoding-problem char vector :macintosh (char-code #\Sub))))
    28492905         (incf idx)))))
    28502906  :vector-decode-function
     
    28682924     (do* ((i start (1+ i)))
    28692925          ((>= i end) idx)
    2870        (let* ((code (char-code (schar string i)))
    2871             (c2 (cond ((< code #x80) code)
     2926       (let* ((char (schar string i))
     2927              (code (char-code char))
     2928              (c2 (cond ((< code #x80) code)
    28722929                      ((and (>= code #xa0) (< code #x100)
    28732930                       (svref *unicode-a0-100-to-macintosh*
     
    28952952                      ((= code #xf8ff) #xf0))))
    28962953         (declare (type (mod #x110000) code))
    2897          (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2954         (setf (%get-unsigned-byte pointer idx) (or c2 (note-encoding-problem char pointer :macintosh (char-code #\Sub))))
    28982955         (incf idx)))))
    28992956  :memory-decode-function
     
    29843041                       (the fixnum (ash (the fixnum (logand #x1f 1st-unit)) 6))
    29853042                       (the fixnum (logxor s1 #x80))))
    2986                      #\Replacement_Character)
     3043                     (note-stream-decoding-problem stream))
    29873044                   (let* ((s2 (funcall next-unit-function stream)))
    29883045                     (if (eq s2 :eof)
     
    30053062                                                            6))
    30063063                                                     (the fixnum (logand s2 #x3f)))))))
    3007                                  #\Replacement_Character)
    3008                              #\Replacement_Character)
     3064                                 (note-stream-decoding-problem stream))
     3065                             (note-stream-decoding-problem stream))
    30093066                           (if (< 1st-unit #xf8)
    30103067                             (let* ((s3 (funcall next-unit-function stream)))
     
    30313088                                            (ash (the fixnum (logxor s2 #x80)) 6))
    30323089                                          (the fixnum (logxor s3 #x80))))))
    3033                                      #\Replacement_Character))))
    3034                              #\Replacement_Character)))))))))
    3035            #\Replacement_Character))))
     3090
     3091
     3092                                     (note-stream-decoding-problem stream)))))
     3093                             (note-stream-decoding-problem stream))))))))))
     3094           (note-stream-decoding-problem stream)))))
    30363095    :vector-encode-function
    30373096    (nfunction
     
    31343193                                              (ash (the fixnum (logxor 3rd-unit #x80)) 6))
    31353194                                            (the fixnum (logxor 4th-unit #x80))))))))))))))))
    3136                (setf (schar string i) (or char #\Replacement_Character)))))))
     3195               (setf (schar string i) (or char (note-vector-decoding-problem vector index :utf-8))))))))
    31373196    :memory-encode-function
    31383197    #'utf-8-memory-encode
     
    32253284                     (< 2nd-unit #xe000))
    32263285              (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)
    3227               #\Replacement_Character))))
    3228       #\Replacement_Character)))
     3286              (note-stream-decoding-problem stream)))))
     3287      (note-stream-decoding-problem stream))))
    32293288
    32303289
     
    33593418                                  (< 2nd-unit #xe000))
    33603419                           (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3361              (setf (schar string i) (or char #\Replacement_Character)))))))
     3420             (setf (schar string i) (or char (note-vector-decoding-problem vector index #+big-endian-target :utf-16be #-big-endian-target :utf-16le))))))))
    33623421    :memory-encode-function
    33633422    (nfunction
     
    34033462                                    (< 2nd-unit #xe000))
    34043463                             (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3405             (setf (schar string i) (or char #\Replacement_Character)))))))
     3464            (setf (schar string i) (or char (note-vector-decoding-problem pointer index #+big-endian-target :utf-16be #-big-endian-target :utf-16le))))))))
    34063465    :octets-in-string-function
    34073466    #'utf-16-octets-in-string
     
    35243583                                (< 2nd-unit #xe000))
    35253584                         (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3526            (setf (schar string i) (or char #\Replacement_Character)))))))
     3585           (setf (schar string i) (or char (note-vector-decoding-problem vector index #+big-endian-target :utf-16le #-big-endian-target :utf-16be))))))))
    35273586  :memory-encode-function
    35283587  (nfunction
     
    35683627                                (< 2nd-unit #xe000))
    35693628                         (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3570            (setf (schar string i) (or char #\Replacement_Character)))))))
     3629           (setf (schar string i) (or char (note-vector-decoding-problem pointer index #+big-endian-target :utf-16le #-big-endian-target :utf-16be))))))))
    35713630  :octets-in-string-function
    35723631  #'utf-16-octets-in-string
     
    37093768                                  (< 2nd-unit #xe000))
    37103769                           (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3711              (setf (schar string i) (or char #\Replacement_Character))))))))
     3770             (setf (schar string i) (or char (note-vector-decoding-problem vector index :utf-16)))))))))
    37123771  :memory-encode-function
    37133772  (nfunction
     
    37693828                                  (< 2nd-unit #xe000))
    37703829                           (utf-16-combine-surrogate-pairs 1st-unit 2nd-unit)))))))
    3771              (setf (schar string i) (or char #\Replacement_Character))))))))
     3830             (setf (schar string i) (or char (note-vector-decoding-problem pointer index :utf-16)))))))))
    37723831  :octets-in-string-function
    37733832  (nfunction
     
    38603919    (declare (type (mod #x110000) code))
    38613920    (if (>= code #x10000)
    3862       (setq code (char-code #\Replacement_Character)))
     3921      (setq code (note-encoding-problem char stream :ucs-2 (char-code #\Replacement_Character))))
    38633922    (funcall write-function stream code)
    38643923    1))
     
    38663925(defun ucs-2-stream-decode (1st-unit next-unit-function stream)
    38673926  (declare (type (unsigned-byte 16) 1st-unit)
    3868            (ignore next-unit-function stream))
     3927           (ignore next-unit-function))
    38693928  ;; CODE-CHAR returns NIL on either half of a surrogate pair.
    38703929  (or (code-char 1st-unit)
    3871       #\Replacement_Character))
     3930      (note-stream-decoding-problem stream)))
    38723931
    38733932
     
    39223981         (declare (type (mod #x110000) code))
    39233982         (when (>= code #x10000)
    3924            (setq code (char-code #\Replacement_Character)))
     3983           (setq code (note-encoding-problem char vector #+big-endian-target :ucs-2be #-big-endian-target :ucs-2le (char-code #\Replacement_Character))))
    39253984         (setf (%native-u8-ref-u16 vector idx) code)
    39263985         (incf idx 2)))))
     
    39383997       (setf (schar string i)
    39393998             (or (code-char (%native-u8-ref-u16 vector index))
    3940                  #\Replacement_Character)))))
     3999                 (note-vector-decoding-problem vector index  #+big-endian-target :ucs-2be #-big-endian-target :ucs-2le))))))
    39414000  :memory-encode-function
    39424001  (nfunction
     
    39464005     (do* ((i start (1+ i)))
    39474006          ((>= i end) idx)
    3948        (let* ((code (char-code (schar string i))))
     4007       (let* ((char (schar string i))
     4008              (code (char-code char)))
    39494009         (declare (type (mod #x110000) code))
    39504010         (setf (%get-unsigned-word pointer idx)
    39514011                      (if (>= code #x10000)
    3952                         (char-code #\Replacement_Character)
     4012                        (note-encoding-problem char pointer #+big-endian-target :ucs-2be #-big-endian-target :ucs-2le (char-code #\Replacement_Character))
    39534013                        code))
    39544014         (incf idx 2)))))
     
    39644024       (let* ((1st-unit (%get-unsigned-word pointer index)))
    39654025         (declare (type (unsigned-byte 16) 1st-unit))
    3966          (setf (schar string i) (or (char-code 1st-unit) #\Replacement_Character))))))
     4026         (setf (schar string i) (or (char-code 1st-unit) (note-vector-decoding-problem pointer index  #+big-endian-target :ucs-2be #-big-endian-target :ucs-2le)))))))
    39674027  :octets-in-string-function
    39684028  #'ucs-2-octets-in-string
     
    40114071         (declare (type (mod #x110000) code))
    40124072         (when (>= code #x10000)
    4013            (setq code (char-code #\Replacement_Character)))
     4073           (setq code (note-encoding-problem char vector #+big-endian-target :ucs-2le #-big-endian-target :ucs-2be (char-code #\Replacement_Character))))
    40144074         (setf (%reversed-u8-ref-u16 vector idx) code)
    40154075         (incf idx 2)))))
     
    40274087       (setf (schar string i)
    40284088             (or (code-char (%reversed-u8-ref-u16 vector index))
    4029                  #\Replacement_Character)))))
     4089                 (note-vector-decoding-problem vector index #+big-endian-target :ucs-2le #-big-endian-target :ucs-2be))))))
    40304090  :memory-encode-function
    40314091  (nfunction
     
    40354095     (do* ((i start (1+ i)))
    40364096          ((>= i end) idx)
    4037        (let* ((code (char-code (schar string i))))
     4097       (let* ((char (schar string i))
     4098              (code (char-code char)))
    40384099         (declare (type (mod #x110000) code))
    40394100         (setf (%get-unsigned-word pointer idx)
    40404101               (if (>= code #x10000)
    4041                  (%swap-u16 (char-code #\Replacement_Character))
     4102                 (%swap-u16 (note-encoding-problem char pointer #+big-endian-target :ucs-2le #-big-endian-target :ucs-2be (char-code #\Replacement_Character)))
    40424103                 (%swap-u16 code)))
    40434104         (incf idx 2)))))
     
    40534114       (let* ((1st-unit (%swap-u16 (%get-unsigned-word pointer index))))
    40544115         (declare (type (unsigned-byte 16) 1st-unit))
    4055          (setf (schar string i) (or (code-char 1st-unit) #\Replacement_Character))))))
     4116         (setf (schar string i) (or (code-char 1st-unit) (note-vector-decoding-problem pointer index #+big-endian-target :ucs-2le #-big-endian-target :ucs-2be)))))))
    40564117  :octets-in-string-function
    40574118  #'ucs-2-octets-in-string
     
    40944155         (declare (type (mod #x110000) code))
    40954156         (when (>= code #x10000)
    4096            (setq code (char-code #\Replacement_Character)))
     4157           (setq code (note-encoding-problem char vector :ucs-2 (char-code #\Replacement_Character))))
    40974158         (setf (%native-u8-ref-u16 vector idx) code)
    40984159         (incf idx 2)))))
     
    41214182                            (%native-u8-ref-u16 vector index))))
    41224183             (declare (type (unsigned-byte 16) 1st-unit))
    4123              (setf (schar string i) (or (code-char 1st-unit) #\Replacement_Character)))))))
     4184             (setf (schar string i) (or (code-char 1st-unit)
     4185                                        (note-vector-decoding-problem vector index :ucs-2))))))))
    41244186  :memory-encode-function
    41254187  (nfunction
     
    41314193     (do* ((i start (1+ i)))
    41324194          ((>= i end) idx)
    4133        (let* ((code (char-code (schar string i))))
     4195       (let* ((char (schar string i))
     4196              (code (char-code char)))
    41344197         (declare (type (mod #x110000) code))
    41354198         (setf (%get-unsigned-word pointer idx)
    41364199                      (if (>= code #x10000)
    4137                         (char-code #\Replacement_Character)
     4200                        (note-encoding-problem char pointer :ucs-2 (char-code #\Replacement_Character))
    41384201                        code))
    41394202         (incf idx 2)))))
     
    41614224         (declare (type (unsigned-byte 16) 1st-unit))
    41624225         (if swap (setq 1st-unit (%swap-u16 1st-unit)))
    4163          (setf (schar string i) (or (code-char 1st-unit) #\Replacement_Character)))))))
     4226         (setf (schar string i) (or (code-char 1st-unit)
     4227                                    (note-vector-decoding-problem pointer index :ucs-2))))))))
    41644228  :octets-in-string-function
    41654229  (nfunction
     
    43424406               (or (if (< code char-code-limit)
    43434407                      (code-char code))
    4344                    #\Replacement_Character))))))
     4408                   (note-vector-decoding-problem vector index #+big-endian-target :utf-32be #-big-endian-target :utf-32le)))))))
    43454409  :memory-encode-function
    43464410  (nfunction
     
    43674431         (setf (schar string i) (or (if (< 1st-unit char-code-limit)
    43684432                                      (code-char 1st-unit))
    4369                                     #\Replacement_Character))))))
     4433                                    (note-vector-decoding-problem
     4434                                     pointer index #+big-endian-target :utf-32be #-big-endian-target :utf-32le)))))))
    43704435  :octets-in-string-function
    43714436  #'ucs-4-octets-in-string
     
    44404505               (or (if (< code char-code-limit)
    44414506                     (code-char code))
    4442                    #\Replacement_Character))))))
     4507                   (note-vector-decoding-problem vector index #+big-endian-target :utf-32le #-big-endian-target :utf-32be)))))))
    44434508  :memory-encode-function
    44444509  (nfunction
     
    44654530         (setf (schar string i) (or (if (< 1st-unit char-code-limit)
    44664531                                      (code-char 1st-unit))
    4467                                     #\Replacement_Character))))))
     4532                                    (note-vector-decoding-problem pointer index #+big-endian-target :utf-32le #-big-endian-target :utf-32be)))))))
    44684533
    44694534  :octets-in-string-function
     
    45484613             (setf (schar string i) (or (if (< 1st-unit char-code-limit)
    45494614                                          (code-char 1st-unit))
    4550                                         #\Replacement_Character)))))))
     4615                                        (note-vector-decoding-problem
     4616                                         vector index :utf-32))))))))
    45514617  :memory-encode-function
    45524618  (nfunction
     
    45874653         (setf (schar string i) (or (if (< 1st-unit char-code-limit)
    45884654                                      (code-char 1st-unit))
    4589                                     #\Replacement_Character)))))))
     4655                                    (note-vector-decoding-problem
     4656                                     pointer index :utf-32))))))))
    45904657  :octets-in-string-function
    45914658  (nfunction
  • release/1.8/source/level-1/linux-files.lisp

    r15146 r15238  
    21852185;;(assert (= (logcount *host-page-size*) 1))
    21862186
     2187
     2188(defun same-fd-p (a b)
     2189  (or (eql a b)
     2190      #-windows-target
     2191      (let* ((a-stat (multiple-value-list (%fstat a)))
     2192             (b-stat (multiple-value-list (%fstat b))))
     2193        (declare (dynamic-extent a-stat b-stat))
     2194        (and (car a-stat) (car b-stat)
     2195             (eql (nth 9 a-stat)
     2196                  (nth 9 b-stat))
     2197             (eql (nth 4 a-stat)
     2198                  (nth 4 b-stat))))
     2199      #+windows-target
     2200      (%stack-block ((a-info (record-length #>BY_HANDLE_FILE_INFORMATION))
     2201                     (b-info (record-length #>BY_HANDLE_FILE_INFORMATION)))
     2202        (unless (or (eql 0 (#_GetFileInformationByHandle (%int-to-ptr a) a-info))
     2203                    (eql 0 (#_GetFileInformationByHandle (%int-to-ptr b) b-info)))
     2204          (and (eql (pref a-info #>BY_HANDLE_FILE_INFORMATION.dwVolumeSerialNumber)
     2205                    (pref b-info #>BY_HANDLE_FILE_INFORMATION.dwVolumeSerialNumber))
     2206               (eql (pref a-info #>BY_HANDLE_FILE_INFORMATION.nFileIndexHigh)
     2207                    (pref b-info #>BY_HANDLE_FILE_INFORMATION.nFileIndexHigh))
     2208               (eql (pref a-info #>BY_HANDLE_FILE_INFORMATION.nFileIndexLow)
     2209                    (pref b-info #>BY_HANDLE_FILE_INFORMATION.nFileIndexLow)))))))
     2210
     2211 
    21872212(defun get-universal-time ()
    21882213  "Return a single integer for the current time of
  • release/1.8/source/lib/ccl-export-syms.lisp

    r15146 r15238  
    343343     event-dispatch
    344344     *ticks-per-second*
     345     encoding-problem
     346     decoding-problem
     347     with-encoding-problems-as-errors
     348     with-decoding-problems-as-errors
    345349
    346350     *application*
  • release/1.8/source/lib/macros.lisp

    r15155 r15238  
    406406             (continue cond &rest args) expansion
    407407             (setq condform `(condition-arg ,cond (list ,@args) 'simple-error)
    408                    signalform `(cerror ,continue ,cname))))
     408                   signalform `(cerror ,continue ,cname ,@args))))
    409409          ((signal error warn)
    410410           (destructuring-bind
     
    17691769            (setf (%get-unsigned-word ,sym ,noctets) 0)
    17701770            ,@body))))))
     1771
     1772(defmacro with-encoding-problems-as-errors (&body body)
     1773  `(handler-bind ((encoding-problem #'error))
     1774    ,@body))
     1775
     1776(defmacro with-decoding-problems-as-errors (&body body)
     1777  `(handler-bind ((decoding-problem #'error))
     1778    ,@body))
    17711779
    17721780(defmacro with-pointers (speclist &body body)
  • release/1.8/source/lisp-kernel/androidarm/Makefile

    r15211 r15238  
    1515
    1616LIBBASE = 0x04001000
    17 NDK = /usr/local/android-ndk-r7
     17NDK = /usr/local/android-ndk-r7b
    1818UNAME_S = $(shell uname -s)
    1919ifeq ($(UNAME_S),Linux)
  • release/1.8/source/lisp-kernel/androidarm/android_native_app_glue.c

    r15205 r15238  
    192192}
    193193
    194 static void process_cmd(struct android_app* app, struct android_poll_source* source) {
    195     int8_t cmd = android_app_read_cmd(app);
    196     android_app_pre_exec_cmd(app, cmd);
    197     if (app->onAppCmd != NULL) app->onAppCmd(app, cmd);
    198     android_app_post_exec_cmd(app, cmd);
    199 }
    200 
    201 static void* android_app_entry(void* param) {
    202     struct android_app* android_app = (struct android_app*)param;
    203 
    204     android_app->config = AConfiguration_new();
    205     AConfiguration_fromAssetManager(android_app->config, android_app->activity->assetManager);
    206 
    207     print_cur_config(android_app);
    208 
    209     android_app->cmdPollSource.id = LOOPER_ID_MAIN;
    210     android_app->cmdPollSource.app = android_app;
    211     android_app->cmdPollSource.process = process_cmd;
    212     android_app->inputPollSource.id = LOOPER_ID_INPUT;
    213     android_app->inputPollSource.app = android_app;
    214     android_app->inputPollSource.process = process_input;
    215 
    216     ALooper* looper = ALooper_prepare(ALOOPER_PREPARE_ALLOW_NON_CALLBACKS);
    217     ALooper_addFd(looper, android_app->msgread, LOOPER_ID_MAIN, ALOOPER_EVENT_INPUT, NULL,
    218             &android_app->cmdPollSource);
    219     android_app->looper = looper;
    220 
    221     pthread_mutex_lock(&android_app->mutex);
    222     android_app->running = 1;
    223     pthread_cond_broadcast(&android_app->cond);
    224     pthread_mutex_unlock(&android_app->mutex);
    225 
    226     android_main(android_app);
    227 
    228     android_app_destroy(android_app);
    229     return NULL;
     194static void process_cmd(struct android_app* app, struct android_poll_source* source)
     195{
     196  int8_t cmd = android_app_read_cmd(app);
     197  android_app_pre_exec_cmd(app, cmd);
     198  if (app->onAppCmd != NULL) app->onAppCmd(app, cmd);
     199  android_app_post_exec_cmd(app, cmd);
     200}
     201
     202static void*
     203android_app_entry(void* param)
     204{
     205  struct android_app* android_app = (struct android_app*)param;
     206
     207  android_app->config = AConfiguration_new();
     208  AConfiguration_fromAssetManager(android_app->config, android_app->activity->assetManager);
     209
     210  print_cur_config(android_app);
     211
     212  android_app->cmdPollSource.id = LOOPER_ID_MAIN;
     213  android_app->cmdPollSource.app = android_app;
     214  android_app->cmdPollSource.process = process_cmd;
     215  android_app->inputPollSource.id = LOOPER_ID_INPUT;
     216  android_app->inputPollSource.app = android_app;
     217  android_app->inputPollSource.process = process_input;
     218
     219  ALooper* looper = ALooper_prepare(ALOOPER_PREPARE_ALLOW_NON_CALLBACKS);
     220  ALooper_addFd(looper, android_app->msgread, LOOPER_ID_MAIN, ALOOPER_EVENT_INPUT, NULL,
     221                &android_app->cmdPollSource);
     222  android_app->looper = looper;
     223
     224  pthread_mutex_lock(&android_app->mutex);
     225  android_app->running = 1;
     226  pthread_cond_broadcast(&android_app->cond);
     227  pthread_mutex_unlock(&android_app->mutex);
     228
     229  android_main(android_app);
     230
     231  android_app_destroy(android_app);
     232  return NULL;
    230233}
    231234
     
    234237// --------------------------------------------------------------------
    235238
    236 static struct android_app* android_app_create(ANativeActivity* activity,
    237         void* savedState, size_t savedStateSize) {
    238     struct android_app* android_app = (struct android_app*)malloc(sizeof(struct android_app));
    239     memset(android_app, 0, sizeof(struct android_app));
    240     android_app->activity = activity;
    241 
    242     pthread_mutex_init(&android_app->mutex, NULL);
    243     pthread_cond_init(&android_app->cond, NULL);
    244 
    245     if (savedState != NULL) {
    246         android_app->savedState = malloc(savedStateSize);
    247         android_app->savedStateSize = savedStateSize;
    248         memcpy(android_app->savedState, savedState, savedStateSize);
    249     }
    250 
    251     int msgpipe[2];
    252     if (pipe(msgpipe)) {
    253         LOGI("could not create pipe: %s", strerror(errno));
    254     }
    255     android_app->msgread = msgpipe[0];
    256     android_app->msgwrite = msgpipe[1];
    257 
    258     pthread_attr_t attr;
    259     pthread_attr_init(&attr);
    260     pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
    261     pthread_create(&android_app->thread, &attr, android_app_entry, android_app);
    262 
    263     // Wait for thread to start.
    264     pthread_mutex_lock(&android_app->mutex);
    265     while (!android_app->running) {
    266         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    267     }
    268     pthread_mutex_unlock(&android_app->mutex);
    269 
    270     return android_app;
    271 }
    272 
    273 static void android_app_write_cmd(struct android_app* android_app, int8_t cmd) {
    274     if (write(android_app->msgwrite, &cmd, sizeof(cmd)) != sizeof(cmd)) {
    275         LOGI("Failure writing android_app cmd: %s\n", strerror(errno));
    276     }
    277 }
    278 
    279 static void android_app_set_input(struct android_app* android_app, AInputQueue* inputQueue) {
    280     pthread_mutex_lock(&android_app->mutex);
    281     android_app->pendingInputQueue = inputQueue;
    282     android_app_write_cmd(android_app, APP_CMD_INPUT_CHANGED);
    283     while (android_app->inputQueue != android_app->pendingInputQueue) {
    284         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    285     }
    286     pthread_mutex_unlock(&android_app->mutex);
    287 }
    288 
    289 static void android_app_set_window(struct android_app* android_app, ANativeWindow* window) {
    290     pthread_mutex_lock(&android_app->mutex);
    291     if (android_app->pendingWindow != NULL) {
    292         android_app_write_cmd(android_app, APP_CMD_TERM_WINDOW);
    293     }
    294     android_app->pendingWindow = window;
    295     if (window != NULL) {
    296         android_app_write_cmd(android_app, APP_CMD_INIT_WINDOW);
    297     }
    298     while (android_app->window != android_app->pendingWindow) {
    299         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    300     }
    301     pthread_mutex_unlock(&android_app->mutex);
    302 }
    303 
    304 static void android_app_set_activity_state(struct android_app* android_app, int8_t cmd) {
    305     pthread_mutex_lock(&android_app->mutex);
    306     android_app_write_cmd(android_app, cmd);
    307     while (android_app->activityState != cmd) {
    308         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    309     }
    310     pthread_mutex_unlock(&android_app->mutex);
    311 }
    312 
    313 static void android_app_free(struct android_app* android_app) {
    314     pthread_mutex_lock(&android_app->mutex);
    315     android_app_write_cmd(android_app, APP_CMD_DESTROY);
    316     while (!android_app->destroyed) {
    317         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    318     }
    319     pthread_mutex_unlock(&android_app->mutex);
    320 
    321     close(android_app->msgread);
    322     close(android_app->msgwrite);
    323     pthread_cond_destroy(&android_app->cond);
    324     pthread_mutex_destroy(&android_app->mutex);
    325     free(android_app);
    326 }
    327 
    328 static void onDestroy(ANativeActivity* activity) {
    329     LOGI("Destroy: %p\n", activity);
    330     android_app_free((struct android_app*)activity->instance);
    331 }
    332 
    333 static void onStart(ANativeActivity* activity) {
    334     LOGI("Start: %p\n", activity);
    335     android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_START);
    336 }
    337 
    338 static void onResume(ANativeActivity* activity) {
    339     LOGI("Resume: %p\n", activity);
    340     android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_RESUME);
    341 }
    342 
    343 static void* onSaveInstanceState(ANativeActivity* activity, size_t* outLen) {
    344     struct android_app* android_app = (struct android_app*)activity->instance;
    345     void* savedState = NULL;
    346 
    347     LOGI("SaveInstanceState: %p\n", activity);
    348     pthread_mutex_lock(&android_app->mutex);
    349     android_app->stateSaved = 0;
    350     android_app_write_cmd(android_app, APP_CMD_SAVE_STATE);
    351     while (!android_app->stateSaved) {
    352         pthread_cond_wait(&android_app->cond, &android_app->mutex);
    353     }
    354 
    355     if (android_app->savedState != NULL) {
    356         savedState = android_app->savedState;
    357         *outLen = android_app->savedStateSize;
    358         android_app->savedState = NULL;
    359         android_app->savedStateSize = 0;
    360     }
    361 
    362     pthread_mutex_unlock(&android_app->mutex);
    363 
    364     return savedState;
    365 }
    366 
    367 static void onPause(ANativeActivity* activity) {
     239static struct android_app*
     240android_app_create(ANativeActivity* activity,
     241        void* savedState, size_t savedStateSize)
     242{
     243  struct android_app* android_app = (struct android_app*)malloc(sizeof(struct android_app));
     244  memset(android_app, 0, sizeof(struct android_app));
     245  android_app->activity = activity;
     246
     247  pthread_mutex_init(&android_app->mutex, NULL);
     248  pthread_cond_init(&android_app->cond, NULL);
     249
     250  if (savedState != NULL) {
     251    android_app->savedState = malloc(savedStateSize);
     252    android_app->savedStateSize = savedStateSize;
     253    memcpy(android_app->savedState, savedState, savedStateSize);
     254  }
     255
     256  int msgpipe[2];
     257  if (pipe(msgpipe)) {
     258    LOGI("could not create pipe: %s", strerror(errno));
     259  }
     260  android_app->msgread = msgpipe[0];
     261  android_app->msgwrite = msgpipe[1];
     262
     263  pthread_attr_t attr;
     264  pthread_attr_init(&attr);
     265  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
     266  pthread_create(&android_app->thread, &attr, android_app_entry, android_app);
     267
     268  // Wait for thread to start.
     269  pthread_mutex_lock(&android_app->mutex);
     270  while (!android_app->running) {
     271    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     272  }
     273  pthread_mutex_unlock(&android_app->mutex);
     274
     275  return android_app;
     276}
     277
     278static void
     279android_app_write_cmd(struct android_app* android_app, int8_t cmd)
     280{
     281  if (write(android_app->msgwrite, &cmd, sizeof(cmd)) != sizeof(cmd)) {
     282    LOGI("Failure writing android_app cmd: %s\n", strerror(errno));
     283  }
     284}
     285
     286static void
     287android_app_set_input(struct android_app* android_app, AInputQueue* inputQueue)
     288{
     289  pthread_mutex_lock(&android_app->mutex);
     290  android_app->pendingInputQueue = inputQueue;
     291  android_app_write_cmd(android_app, APP_CMD_INPUT_CHANGED);
     292  while (android_app->inputQueue != android_app->pendingInputQueue) {
     293    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     294  }
     295  pthread_mutex_unlock(&android_app->mutex);
     296}
     297
     298static void
     299android_app_set_window(struct android_app* android_app, ANativeWindow* window)
     300{
     301  pthread_mutex_lock(&android_app->mutex);
     302  if (android_app->pendingWindow != NULL) {
     303    android_app_write_cmd(android_app, APP_CMD_TERM_WINDOW);
     304  }
     305  android_app->pendingWindow = window;
     306  if (window != NULL) {
     307    android_app_write_cmd(android_app, APP_CMD_INIT_WINDOW);
     308  }
     309  while (android_app->window != android_app->pendingWindow) {
     310    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     311  }
     312  pthread_mutex_unlock(&android_app->mutex);
     313}
     314
     315static void
     316android_app_set_activity_state(struct android_app* android_app, int8_t cmd)
     317{
     318  pthread_mutex_lock(&android_app->mutex);
     319  android_app_write_cmd(android_app, cmd);
     320  while (android_app->activityState != cmd) {
     321    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     322  }
     323  pthread_mutex_unlock(&android_app->mutex);
     324}
     325
     326static void
     327android_app_free(struct android_app* android_app)
     328{
     329  pthread_mutex_lock(&android_app->mutex);
     330  android_app_write_cmd(android_app, APP_CMD_DESTROY);
     331  while (!android_app->destroyed) {
     332    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     333  }
     334  pthread_mutex_unlock(&android_app->mutex);
     335
     336  close(android_app->msgread);
     337  close(android_app->msgwrite);
     338  pthread_cond_destroy(&android_app->cond);
     339  pthread_mutex_destroy(&android_app->mutex);
     340  free(android_app);
     341}
     342
     343static void
     344onDestroy(ANativeActivity* activity)
     345{
     346  LOGI("Destroy: %p\n", activity);
     347  android_app_free((struct android_app*)activity->instance);
     348}
     349
     350static void
     351onStart(ANativeActivity* activity)
     352{
     353  LOGI("Start: %p\n", activity);
     354  android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_START);
     355}
     356
     357static void
     358onResume(ANativeActivity* activity)
     359{
     360  LOGI("Resume: %p\n", activity);
     361  android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_RESUME);
     362}
     363
     364static void*
     365onSaveInstanceState(ANativeActivity* activity, size_t* outLen)
     366{
     367  struct android_app* android_app = (struct android_app*)activity->instance;
     368  void* savedState = NULL;
     369
     370  LOGI("SaveInstanceState: %p\n", activity);
     371  pthread_mutex_lock(&android_app->mutex);
     372  android_app->stateSaved = 0;
     373  android_app_write_cmd(android_app, APP_CMD_SAVE_STATE);
     374  while (!android_app->stateSaved) {
     375    pthread_cond_wait(&android_app->cond, &android_app->mutex);
     376  }
     377
     378  if (android_app->savedState != NULL) {
     379    savedState = android_app->savedState;
     380    *outLen = android_app->savedStateSize;
     381    android_app->savedState = NULL;
     382    android_app->savedStateSize = 0;
     383  }
     384
     385  pthread_mutex_unlock(&android_app->mutex);
     386
     387  return savedState;
     388}
     389
     390static void
     391onPause(ANativeActivity* activity) {
    368392    LOGI("Pause: %p\n", activity);
    369393    android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_PAUSE);
    370394}
    371395
    372 static void onStop(ANativeActivity* activity) {
     396static void
     397onStop(ANativeActivity* activity) {
    373398    LOGI("Stop: %p\n", activity);
    374399    android_app_set_activity_state((struct android_app*)activity->instance, APP_CMD_STOP);
    375400}
    376401
    377 static void onConfigurationChanged(ANativeActivity* activity) {
     402static void
     403onConfigurationChanged(ANativeActivity* activity) {
    378404    struct android_app* android_app = (struct android_app*)activity->instance;
    379405    LOGI("ConfigurationChanged: %p\n", activity);
     
    381407}
    382408
    383 static void onLowMemory(ANativeActivity* activity) {
    384     struct android_app* android_app = (struct android_app*)activity->instance;
    385     LOGI("LowMemory: %p\n", activity);
    386     android_app_write_cmd(android_app, APP_CMD_LOW_MEMORY);
    387 }
    388 
    389 static void onWindowFocusChanged(ANativeActivity* activity, int focused) {
    390     LOGI("WindowFocusChanged: %p -- %d\n", activity, focused);
    391     android_app_write_cmd((struct android_app*)activity->instance,
    392             focused ? APP_CMD_GAINED_FOCUS : APP_CMD_LOST_FOCUS);
    393 }
    394 
    395 static void onNativeWindowCreated(ANativeActivity* activity, ANativeWindow* window) {
    396     LOGI("NativeWindowCreated: %p -- %p\n", activity, window);
    397     android_app_set_window((struct android_app*)activity->instance, window);
    398 }
    399 
    400 static void onNativeWindowDestroyed(ANativeActivity* activity, ANativeWindow* window) {
    401     LOGI("NativeWindowDestroyed: %p -- %p\n", activity, window);
    402     android_app_set_window((struct android_app*)activity->instance, NULL);
    403 }
    404 
    405 static void onInputQueueCreated(ANativeActivity* activity, AInputQueue* queue) {
    406     LOGI("InputQueueCreated: %p -- %p\n", activity, queue);
    407     android_app_set_input((struct android_app*)activity->instance, queue);
    408 }
    409 
    410 static void onInputQueueDestroyed(ANativeActivity* activity, AInputQueue* queue) {
    411     LOGI("InputQueueDestroyed: %p -- %p\n", activity, queue);
    412     android_app_set_input((struct android_app*)activity->instance, NULL);
    413 }
    414 
    415 void ANativeActivity_onCreate(ANativeActivity* activity,
    416         void* savedState, size_t savedStateSize) {
    417     LOGI("Creating: %p\n", activity);
    418     activity->callbacks->onDestroy = onDestroy;
    419     activity->callbacks->onStart = onStart;
    420     activity->callbacks->onResume = onResume;
    421     activity->callbacks->onSaveInstanceState = onSaveInstanceState;
    422     activity->callbacks->onPause = onPause;
    423     activity->callbacks->onStop = onStop;
    424     activity->callbacks->onConfigurationChanged = onConfigurationChanged;
    425     activity->callbacks->onLowMemory = onLowMemory;
    426     activity->callbacks->onWindowFocusChanged = onWindowFocusChanged;
    427     activity->callbacks->onNativeWindowCreated = onNativeWindowCreated;
    428     activity->callbacks->onNativeWindowDestroyed = onNativeWindowDestroyed;
    429     activity->callbacks->onInputQueueCreated = onInputQueueCreated;
    430     activity->callbacks->onInputQueueDestroyed = onInputQueueDestroyed;
    431 
    432     activity->instance = android_app_create(activity, savedState, savedStateSize);
    433 }
     409static void
     410onLowMemory(ANativeActivity* activity)
     411{
     412  struct android_app* android_app = (struct android_app*)activity->instance;
     413  LOGI("LowMemory: %p\n", activity);
     414  android_app_write_cmd(android_app, APP_CMD_LOW_MEMORY);
     415}
     416
     417static void
     418onWindowFocusChanged(ANativeActivity* activity, int focused)
     419{
     420  LOGI("WindowFocusChanged: %p -- %d\n", activity, focused);
     421  android_app_write_cmd((struct android_app*)activity->instance,
     422                        focused ? APP_CMD_GAINED_FOCUS : APP_CMD_LOST_FOCUS);
     423}
     424
     425static void
     426onNativeWindowCreated(ANativeActivity* activity, ANativeWindow* window)
     427{
     428  LOGI("NativeWindowCreated: %p -- %p\n", activity, window);
     429  android_app_set_window((struct android_app*)activity->instance, window);
     430}
     431
     432static void
     433onNativeWindowDestroyed(ANativeActivity* activity, ANativeWindow* window)
     434{
     435  LOGI("NativeWindowDestroyed: %p -- %p\n", activity, window);
     436  android_app_set_window((struct android_app*)activity->instance, NULL);
     437}
     438
     439static void
     440onInputQueueCreated(ANativeActivity* activity, AInputQueue* queue)
     441{
     442  LOGI("InputQueueCreated: %p -- %p\n", activity, queue);
     443  android_app_set_input((struct android_app*)activity->instance, queue);
     444}
     445
     446static void
     447onInputQueueDestroyed(ANativeActivity* activity, AInputQueue* queue)
     448{
     449  LOGI("InputQueueDestroyed: %p -- %p\n", activity, queue);
     450  android_app_set_input((struct android_app*)activity->instance, NULL);
     451}
     452
     453void
     454ANativeActivity_onCreate(ANativeActivity* activity,
     455        void* savedState, size_t savedStateSize)
     456{
     457  extern Boolean init_ccl_for_android(ANativeActivity *);
     458
     459  if (!init_ccl_for_android(activity)) {
     460    _exit(1);
     461  }
     462 
     463  LOGI("Creating: %p\n", activity);
     464  activity->callbacks->onDestroy = onDestroy;
     465  activity->callbacks->onStart = onStart;
     466  activity->callbacks->onResume = onResume;
     467  activity->callbacks->onSaveInstanceState = onSaveInstanceState;
     468  activity->callbacks->onPause = onPause;
     469  activity->callbacks->onStop = onStop;
     470  activity->callbacks->onConfigurationChanged = onConfigurationChanged;
     471  activity->callbacks->onLowMemory = onLowMemory;
     472  activity->callbacks->onWindowFocusChanged = onWindowFocusChanged;
     473  activity->callbacks->onNativeWindowCreated = onNativeWindowCreated;
     474  activity->callbacks->onNativeWindowDestroyed = onNativeWindowDestroyed;
     475  activity->callbacks->onInputQueueCreated = onInputQueueCreated;
     476  activity->callbacks->onInputQueueDestroyed = onInputQueueDestroyed;
     477
     478  activity->instance = android_app_create(activity, savedState, savedStateSize);
     479}
  • release/1.8/source/lisp-kernel/arm-asmutils.s

    r15137 r15238  
    196196_endfn               
    197197
     198/* zero N (r1) dnodes, starting at the dnode-aligned address in r0 */
     199_exportfn(C(zero_dnodes))
     200        __(cmp r1,#0)
     201        __(adr r2,2f)
     202        __(fldd d0,[r2,#0])
     203        __(b 1f)
     2040:      __(subs r1,r1,#1)
     205        __(fstd d0,[r0])
     206        __(add r0,r0,#dnode_size)       
     2071:      __(bne 0b)
     208        __(bx lr)
     209        .align 3
     2102:      .long 0
     211        .long 0       
     212_endfn                       
    198213                               
    199214        _endfile
  • release/1.8/source/lisp-kernel/arm-spentry.s

    r15217 r15238  
    43714371local_label(loop):
    43724372        __(ref_nrs_value(arg_z,toplcatch))
    4373         __(bl _SPmkcatch1v)     /* preserves nfn, at the moment */
     4373        __(bl _SPmkcatch1v)
    43744374        __(b local_label(test)) /* cleanup address, not really a branch */
    43754375        __(ldr nfn,[vsp,#0])
     
    44744474        __(ldr allocptr,[rcontext,#tcr.save_allocptr])
    44754475        __(ref_nrs_function(nfn,restore_lisp_pointers))
    4476         __(extract_fulltag(imm0,nfn))
     4476        __(extract_subtag(imm0,nfn))
    44774477        __(cmp imm0,#subtag_function)
    44784478        __(bne local_label(fail))
     
    44804480        __(bl _SPmkcatch1v)
    44814481        __(b local_label(fail)) /* cleanup address */
     4482        __(ref_nrs_function(nfn,restore_lisp_pointers))
    44824483        __(set_nargs(0))
    44834484        __(bl _SPfuncall)
  • release/1.8/source/lisp-kernel/gc-common.c

    r15202 r15238  
    13531353}
    13541354
     1355extern void zero_dnodes(void *,natural);
     1356
    13551357void
    13561358gc(TCR *tcr, signed_natural param)
     
    17051707      last_zeroed_addr = a->high;
    17061708    }
    1707     zero_memory_range(a->active, last_zeroed_addr);
     1709    zero_dnodes(a->active, area_dnode(last_zeroed_addr,a->active));
    17081710
    17091711    /*
  • release/1.8/source/lisp-kernel/pmcl-kernel.c

    r15217 r15238  
    21502150xGetSharedLibrary(char *path, int mode)
    21512151{
     2152#ifdef ANDROID
     2153  /* Hopefully temporary bug workaround */
     2154  return NULL;
     2155#else
    21522156  return dlopen(path, mode);
     2157#endif
    21532158}
    21542159#endif
     
    26022607JavaVM *android_vm = NULL;
    26032608
    2604 jint
    2605 JNI_OnLoad(JavaVM *vm, void *unused)
     2609void
     2610wait_for_debugger()
     2611{
     2612  volatile Boolean ready = false;
     2613
     2614  __android_log_print(ANDROID_LOG_INFO,"nativeCCL","waiting for debugger");
     2615  do {
     2616    sleep(1);
     2617  } while(!ready);
     2618
     2619 
     2620
     2621Boolean
     2622init_ccl_for_android(ANativeActivity *activity)
    26062623{
    26072624  extern int page_size;
     
    26142631    ;
    26152632  TCR *tcr;
    2616   BytePtr stack_base, current_sp = (BytePtr) current_stack_pointer();
    2617  
    2618 #if 1
    2619   sleep(100);
    2620 #endif
    2621   android_vm = vm;
    2622 
     2633  BytePtr stack_base, current_sp;
     2634  char **argv;
     2635
     2636  wait_for_debugger();
     2637  android_vm = activity->vm;
     2638
     2639  current_sp = (BytePtr) current_stack_pointer();
    26232640  page_size = getpagesize();
    26242641 
    26252642  if (!check_arm_cpu()) {
    26262643    __android_log_print(ANDROID_LOG_FATAL,"nativeCCL","CPU doesn't support required features");
    2627       return -1;
     2644    return false;
    26282645  }
    26292646  main_thread_pid = getpid();
     
    26682685
    26692686  exception_init();
    2670 
     2687  argv = (char**)(malloc (sizeof (char *)));
     2688  argv[0] = NULL;
    26712689  lisp_global(IMAGE_NAME) = ptr_to_lispobj(ensure_real_path(image_name));
    26722690  lisp_global(KERNEL_PATH) = ptr_to_lispobj(real_executable_name);
    2673   lisp_global(ARGV) = (LispObj)NULL;
     2691  lisp_global(ARGV) = ptr_to_lispobj(argv);
    26742692  lisp_global(KERNEL_IMPORTS) = (LispObj)import_ptrs_base;
    26752693
     
    27072725
    27082726  if (init_lisp(TCR_TO_TSD(tcr)) == 0) {
    2709     return JNI_VERSION_1_6;
    2710   }
    2711   return -1;
     2727    return true;
     2728  }
     2729  return false;
    27122730}
    27132731
     
    27242742android_main(struct android_app* state)
    27252743{
    2726   TCR *tcr = new_tcr(DEFAULT_INITIAL_STACK_SIZE, MIN_TSTACK_SIZE);
     2744  TCR *tcr;
    27272745  JNIEnv *env;
    27282746
     2747  tcr = new_tcr(DEFAULT_INITIAL_STACK_SIZE, MIN_TSTACK_SIZE);
    27292748  thread_init_tcr(tcr, current_stack_pointer,DEFAULT_INITIAL_STACK_SIZE);
    27302749  (*android_vm)->AttachCurrentThread(android_vm, &env, NULL);
  • release/1.8/source/lisp-kernel/ppc-asmutils.s

    r15137 r15238  
    428428_endfn
    429429
    430 
     430/* zero N (r4) dnodes, starting at the dnode-aligned address in r3 */
     431_exportfn(C(zero_dnodes))
     432        __(cmpri(r4,0))
     433        __(li r5,0)
     434        __(li r6,0)
     435        __(b 1f)
     4360:      __(subi r4,r4,1)
     437        __(str(r5,0(r3)))
     438        __(cmpri(r4,0))
     439        __(str(r6,node_size(r3)))
     440        __(la r3,dnode_size(r3))
     4411:      __(bne 0b)
     442        __(blr)
     443_endfn               
    431444        _endfile
  • release/1.8/source/lisp-kernel/x86-asmutils32.s

    r15137 r15238  
    280280_endfn                                       
    281281        __endif
     282
     283/* zero arg1 dnodes,starting at the dnode-aligned address in arg0 */
     284_exportfn(C(zero_dnodes)) 
     285        __(xorl %eax,%eax)
     286        __(mov 4(%esp),%edx)
     287        __(mov 8(%esp),%ecx)
     288        __(testl %ecx,%ecx)
     289        __(jmp 1f)
     2900:      __(mov %eax,0(%edx))
     291        __(mov %eax,4(%edx))
     292        __(lea dnode_size(%edx),%edx)
     293        __(subl $1,%ecx)
     2941:      __(jne 0b)
     295        __(repret)
     296_endfn       
    282297        _endfile
    283298
  • release/1.8/source/lisp-kernel/x86-asmutils64.s

    r15137 r15238  
    276276_endfn                                       
    277277        __endif
     278
     279/* zero N (%carg1) dnodes, starting at the dnode-aligned address in %carg0 */
     280_exportfn(C(zero_dnodes))
     281        __(pxor %xmm0,%xmm0)
     282        __(cmpq $0,%carg1)
     283        __(jmp 1f)
     2840:      __(movdqa %xmm0,(%carg0))
     285        __(lea 16(%carg0),%carg0)
     286        __(subq $1,%carg1)
     2871:      __(jne 0b)
     288        __(repret)
     289_endfn       
    278290        _endfile
Note: See TracChangeset for help on using the changeset viewer.