Ignore:
Timestamp:
Oct 14, 2008, 6:30:00 PM (13 years ago)
Author:
gz
Message:

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r11069 r11089  
    481481      (unless (afunc-lfun a)
    482482        (x862-compile a
    483                       (if lambda-form (afunc-lambdaform a)) 
     483                      (if lambda-form (afunc-lambdaform a))
    484484                      *x862-record-symbols*))) ; always compile inner guys
    485485    (let* ((*x862-cur-afunc* afunc)
     
    695695                        (:x8664
    696696                         (x86-lap-directive frag-list :quad 0)))))
    697                  
     697
    698698                   (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))
    699699                     (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
     
    711711                                                           *x862-register-restore-count*))))
    712712
    713                        
    714713                     (when (or (afunc-lfun-info afunc)
    715714                               lambda-form
     
    771770                           #+x86-target
    772771                           (if (eq *host-backend* *target-backend*)
    773                              (create-x86-function       fname frag-list *x862-constant-alist* bits debug-info)
     772                             (create-x86-function fname frag-list *x862-constant-alist* bits debug-info)
    774773                             (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info))
    775774                           #-x86-target
     
    883882          (lap-label (if label (vinsn-label-info label))))
    884883     (if lap-label
    885          (x86-lap-label-address lap-label)
    886          (compiler-bug "Missing or bad ~s label~@[: ~s~]"
    887                        (if start-p 'start 'end)
    888                        sym)))
     884       (x86-lap-label-address lap-label)
     885       (compiler-bug "Missing or bad ~s label~@[: ~s~]"
     886                     (if start-p 'start 'end)
     887                     sym)))
    889888   (target-arch-case
    890889    (:x8632 x8632::fulltag-misc)        ;xxx?
     
    892891
    893892(defun x862-digest-symbols ()
    894   (if *x862-recorded-symbols*
     893  (when *x862-recorded-symbols*
    895894    (let* ((symlist *x862-recorded-symbols*)
    896895           (len (length symlist))
     
    17891788                        (<- fp-val)
    17901789                        (ensuring-node-target (target vreg)
    1791                           (! single->node target fp-val)))))
     1790                          (target-arch-case
     1791                           (:x8632 (x862-single->heap seg target fp-val))
     1792                           (:x8664 (! single->node target fp-val)))))))
    17921793                   (t
    17931794                    (with-additional-imm-reg ()
     
    18081809             (with-imm-target () idx-reg
    18091810               (if index-known-fixnum
    1810                 (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    1811                 (! scale-32bit-misc-index idx-reg unscaled-idx))
     1811                (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     1812                (! scale-32bit-misc-index idx-reg unscaled-idx))
    18121813               (cond ((eq type-keyword :single-float-vector)
    18131814                      (with-fp-target () (fp-val :single-float)
     
    18191820                          (<- fp-val)
    18201821                          (ensuring-node-target (target vreg)
    1821                             (! single->node target fp-val)))))
     1822                            (target-arch-case
     1823                             (:x8632 (x862-single->heap seg target fp-val))
     1824                             (:x8664 (! single->node target fp-val)))))))
    18221825                     (t
    18231826                      (with-imm-target () temp
     
    18711874                     (! misc-ref-u16 temp src idx-reg))))
    18721875               (! box-fixnum target temp))))
    1873           ;; Down to the dregs.
    1874           (is-64-bit
     1876          ;; Down to the dregs.
     1877          (is-64-bit
    18751878           (case type-keyword
    18761879             (:double-float-vector
     
    19151918                    (ensuring-node-target (target vreg)
    19161919                      (x862-box-u64 seg target u64-reg)))))))
    1917           (t
    1918            (unless is-1-bit
    1919              (nx-error "~& unsupported vector type: ~s"
    1920                        type-keyword))
    1921            (ensuring-node-target (target vreg)
    1922              (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    1923                (! misc-ref-c-bit-fixnum target src index-known-fixnum)
     1920          (t
     1921           (unless is-1-bit
     1922             (nx-error "~& unsupported vector type: ~s"
     1923                       type-keyword))
     1924           (ensuring-node-target (target vreg)
     1925             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     1926               (! misc-ref-c-bit-fixnum target src index-known-fixnum)
    19241927               (with-imm-target () bitnum
    19251928                 (if index-known-fixnum
    19261929                   (x862-lri seg bitnum index-known-fixnum)
    19271930                   (! scale-1bit-misc-index bitnum unscaled-idx))
    1928                 (! nref-bit-vector-fixnum target bitnum src))))))))
     1931                (! nref-bit-vector-fixnum target bitnum src))))))))
    19291932    (^)))
    19301933
     
    22492252    (if is-node
    22502253      (cond ((eq form *nx-nil*)
    2251              (arch::target-nil-value arch))
     2254             (target-nil-value))
    22522255            ((eq form *nx-t*)
    2253              (+ (arch::target-nil-value arch) (arch::target-t-offset arch)))
     2256             (+ (target-nil-value) (arch::target-t-offset arch)))
    22542257            (t
    22552258             (let* ((fixval (acode-fixnum-form-p form)))
     
    24432446                            (x862-lri seg reg constval)
    24442447                            (if *x862-reckless*
    2445                               (target-arch-case
     2448                              (target-arch-case
    24462449                               (:x8632 (! unbox-u32 reg result-reg))
    24472450                               (:x8664 (! %unbox-u32 reg result-reg)))
     
    24862489                       (! trap-unless-bit reg )))
    24872490                   reg)))))))
     2491
    24882492
    24892493;;; xxx
     
    26122616      (when (and vreg val-reg) (<- val-reg))
    26132617      (^))))
    2614          
     2618
     2619
    26152620(defun x862-code-coverage-entry (seg note)
    26162621 (let* ((afunc *x862-cur-afunc*))
     
    26832688                                                value result-reg)))))
    26842689        (when safe
    2685           (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
    2686                 (value (if (eql (hard-regspec-class result-reg)
    2687                                 hard-reg-class-gpr)
    2688                           (hard-regspec-value result-reg)))
     2690          (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     2691                (value (if (eql (hard-regspec-class result-reg)
     2692                                hard-reg-class-gpr)
     2693                          (hard-regspec-value result-reg)))
    26892694                 (result-is-imm nil))
    2690             (when (and value (logbitp value *available-backend-imm-temps*))
    2691               (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))
     2695            (when (and value (logbitp value *available-backend-imm-temps*))
     2696              (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))
    26922697              (setq result-is-imm t))
    26932698            (if (typep safe 'fixnum)
     
    26962701                  (! trap-unless-typecode= src safe))
    26972702                (! trap-unless-typecode= src safe)))
    2698             (unless index-known-fixnum
    2699               (! trap-unless-fixnum unscaled-idx))
     2703            (unless index-known-fixnum
     2704              (! trap-unless-fixnum unscaled-idx))
    27002705            (if result-is-imm
    27012706              (with-additional-imm-reg (unscaled-idx src)
     
    28962901            (! save-node-register-to-spill-area *x862-temp0*)))
    28972902          (if (eq spread-p 0)
    2898             (! spread-lexpr)
     2903            (! spread-lexpr)
    28992904            (! spread-list))
    29002905          (target-arch-case
     
    30733078                       (t3r (if inherited-vars (var-to-reg (pop inherited-vars) t3))))
    30743079                  (setq cell (set-some-cells dest cell t0r t1r t2r t3r)))))))
    3075           (x862-lri seg *x862-arg-y* (ash (logior (ash -1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*))
     3080          (x862-lri seg *x862-arg-y* (ash (logior (ash -1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*))
    30763081          (! misc-set-c-node *x862-arg-y* dest cell))
    30773082        (! finalize-closure dest)
     
    31623167               (yform (%cadr revregargs))
    31633168               (xform (%caddr revregargs)))
    3164           (if (eq 3 nregs)
     3169          (if (eq 3 nregs)
    31653170            (progn
    31663171              (target-arch-case (:x8632 (compiler-bug "3 reg args on x8632?")))
     
    31683173                                             yform ($ *x862-arg-y*)
    31693174                                             zform ($ *x862-arg-z*)))
    3170             (if (eq 2 nregs)
    3171               (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
    3172               (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*))))))
     3175            (if (eq 2 nregs)
     3176              (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
     3177              (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*))))))
    31733178      n)))
    31743179
     
    57765781             (type (svref operand-types i))
    57775782             (insert-keyword (svref x86::*x86-operand-insert-function-keywords*
    5778                                     insert-function)))
     5783                                    insert-function)))
    57795784        #+debug
    57805785        (format t "~& insert-function = ~s, operand = ~s"
     
    59735978                        (mapcar #'parse-operand-form `(:rcontext ,(cadr valform) nil nil nil))
    59745979                        (mapcar #'parse-operand-form `(nil ,(cadr valform) :rcontext nil nil))))
    5975                      ((atom (cdr valform)) (svref vp (car valform)))
     5980                     ((and (atom (cdr valform))
     5981                           (typep (car valform) 'fixnum))
     5982                      (svref vp (car valform)))
    59765983                     ((eq (car valform) :@)
    59775984                      (mapcar #'parse-operand-form (cdr valform)))
     
    59825989                               (tail parsed-ops))
    59835990                          (declare (dynamic-extent parsed-ops)
    5984                                    (cons parsed-ops tail))
     5991                                   (list parsed-ops tail))
    59855992                          (dolist (op op-vals
    59865993                                   (if for-pred
     
    63426349             (:x8664
    63436350              (x862-seq-bind-var seg method-var x8664::next-method-context)))
    6344             (when *x862-recorded-symbols*
     6351            (when *x862-recorded-symbols*
    63456352              (setq next-method-var-scope-info (pop *x862-recorded-symbols*))))
    63466353
     
    68446851                                                (:x8632 x8632::temp0)
    68456852                                                (:x8664 x8664::arg_x))
    6846                                        idx *x862-arg-y*
     6853                                       idx *x862-arg-y*
    68476854                                       char *x862-arg-z*)
    68486855    (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
     
    70937100(defx862 x862-uvset uvset (seg vreg xfer vector index value)
    70947101  (x862-three-targeted-reg-forms seg
    7095                                 vector (target-arch-case
     7102                                vector (target-arch-case
    70967103                                         (:x8632 ($ x8632::temp0))
    70977104                                         (:x8664 ($ x8664::arg_x)))
    7098                                 index ($ *x862-arg-y*)
    7099                                 value ($ *x862-arg-z*))
     7105                                index ($ *x862-arg-y*)
     7106                                value ($ *x862-arg-z*))
    71007107  (! misc-set)
    71017108  (<- ($ *x862-arg-z*))
     
    71097116
    71107117(defx862 x862-%err-disp %err-disp (seg vreg xfer arglist)
    7111   (x862-set-nargs seg (x862-arglist seg arglist))
    7112   (! ksignalerr)
     7118  (let* ((*x862-vstack* *x862-vstack*))
     7119    (x862-set-nargs seg (x862-arglist seg arglist))
     7120    (! ksignalerr))
    71137121  (x862-nil seg vreg xfer))
    71147122
     
    82188226            (x862-one-targeted-reg-form seg ptr src-reg)
    82198227          (if (node-reg-p vreg)
    8220             (! mem-ref-c-bit-fixnum vreg src-reg offval)
    8221             (with-imm-target ()           ;OK if src-reg & dest overlap
    8222                 (dest :u8)
    8223               (! mem-ref-c-bit dest src-reg offval)
    8224               (<- dest))))
     8228            (! mem-ref-c-bit-fixnum vreg src-reg offval)
     8229            (with-imm-target ()         ;OK if src-reg & dest overlap
     8230                (dest :u8)
     8231              (! mem-ref-c-bit dest src-reg offval)
     8232              (<- dest))))
    82258233        (with-imm-target () (src-reg :address)
    82268234          (x862-two-targeted-reg-forms seg ptr src-reg offset ($ *x862-arg-z*))
     
    88788886      (progn
    88798887        (x862-three-targeted-reg-forms seg
    8880                                        subtag (target-arch-case
     8888                                       subtag (target-arch-case
    88818889                                               (:x8632 ($ x8632::temp0))
    88828890                                               (:x8664 ($ x8664::arg_x)))
    8883                                        uvector ($ *x862-arg-y*)
    8884                                        index ($ *x862-arg-z*))
     8891                                       uvector ($ *x862-arg-y*)
     8892                                       index ($ *x862-arg-z*))
    88858893        (! subtag-misc-ref)
    88868894        (when vreg (<- ($ *x862-arg-z*)))
     
    88968904      (x862-vset seg vreg xfer type-keyword uvector index newval (unless *x862-reckless* (nx-lookup-target-uvector-subtag type-keyword)))
    88978905      (progn
    8898         (target-arch-case
     8906        (target-arch-case
    88998907         (:x8632
    89008908          (x862-four-targeted-reg-forms seg subtag ($ x8632::temp1) uvector ($ x8632::temp0) index ($ x8632::arg_y) newval ($ x8632::arg_z)))
     
    94379445                                     (t :u32))))))))
    94389446    (^)))
     9447
    94399448
    94409449(defx862 x862-syscall syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports)
     
    1000010009        (! symbol-ref target symreg (target-arch-case
    1000110010                                     (:x8632 x8632::symbol.vcell-cell)
    10002                                      (:x8664 x8664::symbol.vcell-cell))))))
     10011                                     (:x8664 x8664::symbol.vcell-cell))))))
    1000310012  (^))
    1000410013
     
    1001210021             (make-acode (%nx1-operator fixnum)
    1001310022                         (target-arch-case
    10014                           (:x8632 x8632::symbol.vcell-cell)
     10023                          (:x8632 x8632::symbol.vcell-cell)
    1001510024                          (:x8664 x8664::symbol.vcell-cell)))
    1001610025             val
Note: See TracChangeset for help on using the changeset viewer.