Changeset 9257


Ignore:
Timestamp:
05/25/05 12:26:48 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r9256 r9257  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.467 2005-05-25 01:37:38 piso Exp $
     4;;; $Id: jvm.lisp,v 1.468 2005-05-25 12:26:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    267267  (unboxed-fixnum-variable obj))
    268268
     269(declaim (ftype (function () t) allocate-register))
    269270(defun allocate-register ()
    270271  (let* ((register *register*)
     
    945946                  (pool-name-and-type method-name type-name))))
    946947
    947 (declaim (ftype (function (string) fixnum) pool-field))
     948(declaim (ftype (function (string) fixnum) pool-string))
    948949(defun pool-string (string)
    949950  (declare (optimize speed))
    950951  (pool-get (list 8 (pool-name string))))
    951952
    952 (declaim (ftype (function (fixnum) fixnum) pool-field))
     953(declaim (ftype (function (fixnum) fixnum) pool-int))
    953954(defun pool-int (n)
    954955  (declare (optimize speed))
    955956  (pool-get (list 3 n)))
    956957
    957 (declaim (ftype (function (fixnum) cons) pool-field))
     958(declaim (ftype (function (fixnum) cons) u2))
    958959(defun u2 (n)
    959960  (declare (optimize speed))
     
    10301031  (emit 'getstatic +lisp-class+ "T" +lisp-symbol+))
    10311032
     1033(declaim (ftype (function * t) emit-push-constant-int))
    10321034(defun emit-push-constant-int (n)
    10331035  (if (<= -32768 n 32767)
     
    10611063  (car (get-descriptor-info arg-types return-type)))
    10621064
     1065(declaim (ftype (function * t) emit-invokestatic))
    10631066(defun emit-invokestatic (class-name method-name arg-types return-type)
    10641067  (let* ((info (get-descriptor-info arg-types return-type))
     
    10681071    (setf (instruction-stack instruction) stack-effect)))
    10691072
     1073(declaim (ftype (function * t) emit-invokevirtual))
    10701074(defun emit-invokevirtual (class-name method-name arg-types return-type)
    10711075  (let* ((info (get-descriptor-info arg-types return-type))
     
    10751079    (setf (instruction-stack instruction) (1- stack-effect))))
    10761080
     1081(declaim (ftype (function * t) emit-invokespecial-init))
    10771082(defun emit-invokespecial-init (class-name arg-types)
    10781083  (let* ((info (get-descriptor-info arg-types nil))
     
    12361241  (single-valued-p-init))
    12371242
     1243(declaim (ftype (function t t) single-valued-p))
    12381244(defun single-valued-p (form)
    12391245  (cond ((block-node-p form)
     
    12681274               nil)))))
    12691275
     1276(declaim (ftype (function * t) emit-clear-values))
    12701277(defun emit-clear-values ()
    12711278;;   (break "EMIT-CLEAR-VALUES called~%")
     
    12731280  (emit 'clear-values))
    12741281
     1282(declaim (ftype (function * t) maybe-emit-clear-values))
    12751283(defun maybe-emit-clear-values (form)
    12761284  (declare (optimize speed))
     
    12801288    (emit 'clear-values)))
    12811289
     1290(declaim (ftype (function () t) emit-unbox-fixnum))
    12821291(defun emit-unbox-fixnum ()
    12831292  (declare (optimize speed))
     
    12891298         (emit 'getfield +lisp-fixnum-class+ "value" "I"))))
    12901299
     1300(declaim (ftype (function () t) emit-box-long))
    12911301(defun emit-box-long ()
    12921302  (declare (optimize speed))
    12931303  (emit-invokestatic +lisp-class+ "number" (list "J") +lisp-object+))
    12941304
     1305(declaim (ftype (function (t &optional t) t) emit-move-from-stack))
     1306(defun emit-move-from-stack (target &optional representation)
     1307  (declare (optimize speed))
     1308  (cond ((null target)
     1309         (emit 'pop))
     1310        ((eq target :stack))
     1311        ((fixnump target)
     1312         (emit
     1313          (case representation
     1314            ((:unboxed-fixnum :java-boolean)
     1315             'istore)
     1316            (t
     1317             'astore))
     1318          target))
     1319        (t
     1320         (aver nil))))
     1321
    12951322;; Expects value on stack.
     1323(declaim (ftype (function () t) emit-invoke-method))
    12961324(defun emit-invoke-method (method-name target representation)
    12971325  (emit-invokevirtual +lisp-object-class+ method-name nil +lisp-object+)
     
    16571685      max-stack)))
    16581686
    1659 (declaim (ftype (function (t &optional t) emit-move-from-stack)))
    1660 (defun emit-move-from-stack (target &optional representation)
    1661   (declare (optimize speed))
    1662   (cond ((null target)
    1663          (emit 'pop))
    1664         ((eq target :stack))
    1665         ((fixnump target)
    1666          (emit
    1667           (case representation
    1668             ((:unboxed-fixnum :java-boolean)
    1669              'istore)
    1670             (t
    1671              'astore))
    1672           target))
    1673         (t
    1674          (aver nil))))
    1675 
    16761687(defun resolve-variables ()
    16771688  (let ((code (nreverse *code*)))
     
    27222733      (unboxed-fixnum-variable arg)))
    27232734
     2735(declaim (ftype (function t t) emit-push-int))
    27242736(defun emit-push-int (arg)
    27252737  (if (fixnump arg)
     
    27302742            (aver nil)))))
    27312743
     2744(declaim (ftype (function t t) emit-push-long))
    27322745(defun emit-push-long (arg)
    27332746  (cond ((eql arg 0)
     
    66496662  t)
    66506663
     6664(declaim (ftype (function * t) install-p2-handler))
    66516665(defun install-p2-handler (symbol &optional handler)
    66526666  (declare (type symbol symbol))
  • trunk/j/src/org/armedbear/lisp/known-functions.lisp

    r9247 r9257  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: known-functions.lisp,v 1.9 2005-05-24 19:15:25 piso Exp $
     4;;; $Id: known-functions.lisp,v 1.10 2005-05-25 12:25:57 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2020(in-package #:system)
    2121
    22 (declaim (ftype (function * symbol) gensym))
     22(declaim (ftype (function * symbol) copy-symbol gensym))
     23(declaim (ftype (function * symbol) fdefinition-block-name))
    2324
    2425(declaim (ftype (function (t t) t) gethash-2op-1ret))
     
    3031
    3132(declaim (ftype (function * cons) backq-cons))
     33
     34(declaim (ftype (function * string) write-string))
    3235
    3336(declaim
     
    4750        char-equal
    4851        string<=
     52        simple-typep
     53        %make-structure
     54        %structure-ref
     55        %structure-set
     56        caadr
     57        %set-cddr
     58        neq
     59        set
     60        every
     61        some
     62        %svset
     63        vectorp
     64        pathnamep
     65        hash-table-p
     66        characterp
     67        %failed-aver
    4968        ))
    5069
Note: See TracChangeset for help on using the changeset viewer.