diff --git a/msvc/Makefile b/msvc/Makefile index 1638b2c9f..4e85a7b53 100755 --- a/msvc/Makefile +++ b/msvc/Makefile @@ -231,7 +231,7 @@ c\cut$(EXE): $(top_srcdir)\util\cut.c $(MAKE) cut$(EXE) cd .. -$(TARGETS): $(UCDDAT) ecl_min$(EXE) compile.lsp sysfun.lsp BUILD-STAMP +$(TARGETS): $(UCDDAT) ecl_min$(EXE) compile.lsp BUILD-STAMP set ECLDIR=./ ecl_min compile BUILD-STAMP: Makefile @@ -377,9 +377,6 @@ eclgmp.lib: $(CP) gmp.h ..\ecl\gmp.h cd .. -sysfun.lsp: - $(CP) $(srcdir)\cmp\sysfun.lsp .\ - install: IF NOT EXIST "$(prefix)" $(MKDIR) "$(prefix)" IF NOT EXIST "$(bindir)" $(MKDIR) "$(bindir)" @@ -454,7 +451,7 @@ clean: clean_ecl clean_lisp clean_ecl: -for %i in (eclgc.lib eclgmp.lib lsp\config.lsp compile.lsp bare.lsp \ lsp\load.lsp clos\load.lsp cmp\load.lsp cmp\cmpdefs.lsp \ - ecl.lib ecl.dll ecl_min$(EXE) eclmin.lib help.doc sysfun.lsp \ + ecl.lib ecl.dll ecl_min$(EXE) eclmin.lib help.doc \ BUILD-STAMP $(TARGETS) *.exp *.ilk *.manifest *.pdb *.c *.obj \ ecl-config.bat ecl-static.lib *.tmp *.implib *.lib ecl.ico \ ecl-cc.bat ecl.rc ecl.res) \ diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-lspfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-lspfun.lsp new file mode 100644 index 000000000..9083de74e --- /dev/null +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-lspfun.lsp @@ -0,0 +1,203 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*- +;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab: + +;;;; +;;;; Copyright (c) 1991, Giuseppe Attardi. All rights reserved. +;;;; Copyright (c) 2003, Juan Jose Garcia Ripoll +;;;; +;;;; See the file 'LICENSE' for the copyright details. +;;;; + +;;;; +;;;; Database for Lisp functions accessible from C. +;;;; + +(in-package "COMPILER") + +;;; +;;; FUNCTIONS WHICH CAN BE CALLED FROM C +;;; +;;; The following two lists contain all functions in the core library which do +;;; not belong to the C part of the library, but which should have an exported C +;;; name that users (and compiled code) can refer to. This means, for instance, that +;;; MAKE-ARRAY will be compiled to a function called cl_make_array, etc. +;;; +;;; Note that if the created C function should take only fixed +;;; arguments, a proclamation for the function type must exist so that +;;; the compiler can produce the correct function signature! +;;; + +#+ecl-min +(defvar *in-all-symbols-functions* + ;; These functions are visible from external.h and their function + ;; objects are created in init_all_symbols from the data in + ;; symbols_list.h + `(;; arraylib.lsp + cl:make-array cl:vector cl:array-dimensions cl:array-in-bounds-p cl:array-row-major-index + cl:bit cl:sbit cl:bit-and cl:bit-ior cl:bit-xor cl:bit-eqv cl:bit-nand cl:bit-nor cl:bit-andc1 + cl:bit-andc2 cl:bit-orc1 cl:bit-orc2 cl:bit-not + cl:vector-pop cl:adjust-array + ;; assert.lsp + si:do-check-type si:ecase-error si:etypecase-error + si:wrong-type-argument si:ccase-error si:ctypecase-error + ;; config.lsp + cl:short-site-name cl:long-site-name cl:machine-type cl:machine-instance cl:machine-version + cl:software-type cl:software-version cl:lisp-implementation-type cl:lisp-implementation-version + si:lisp-implementation-vcs-id + ;; assignment.lsp + si:setf-definition + ;; conditions.lsp + si:safe-eval cl:abort cl:continue cl:muffle-warning cl:store-value cl:use-value + si:bind-simple-restarts si:bind-simple-handlers + si:assert-failure cl:compute-restarts cl:find-restart cl:invoke-restart + cl:invoke-restart-interactively cl:make-condition + ;; describe.lsp + cl:describe cl:inspect + ;; iolib.lsp + cl:read-from-string cl:write-to-string cl:prin1-to-string cl:princ-to-string + cl:y-or-n-p cl:yes-or-no-p si:string-to-object cl:dribble + ext:make-encoding ext:load-encoding + ;; listlib.lsp + cl:union cl:nunion cl:intersection cl:nintersection cl:set-difference cl:nset-difference + cl:set-exclusive-or cl:nset-exclusive-or cl:subsetp cl:rassoc-if cl:rassoc-if-not + cl:assoc-if cl:assoc-if-not cl:member-if cl:member-if-not cl:subst-if cl:subst-if-not + cl:nsubst-if cl:nsubst-if-not + ;; mislib.lsp + cl:logical-pathname-translations cl:load-logical-pathname-translations cl:decode-universal-time + cl:encode-universal-time cl:get-decoded-time + cl:ensure-directories-exist si:simple-program-error si:signal-simple-error + ;; module.lsp + cl:provide cl:require + ;; numlib.lsp + cl:isqrt cl:phase cl:signum cl:cis + cl:asin cl:acos cl:asinh cl:acosh cl:atanh cl:ffloor cl:fceiling cl:ftruncate cl:fround + cl:logtest cl:byte cl:byte-size cl:byte-position cl:ldb cl:ldb-test cl:mask-field cl:dpb + cl:deposit-field + ;; packlib.lsp + cl:find-all-symbols cl:apropos cl:apropos-list + ;; pprint.lsp + cl:pprint-fill cl:copy-pprint-dispatch cl:pprint-dispatch + cl:pprint-linear cl:pprint-newline cl:pprint-tab cl:pprint-tabular + cl:set-pprint-dispatch cl:pprint-indent + ;; predlib.lsp + cl:upgraded-array-element-type cl:upgraded-complex-part-type cl:typep cl:subtypep cl:coerce + si:do-deftype si:ratiop si:single-float-p si:short-float-p si:double-float-p + si:long-float-p + ;; process.lsp + ext:run-program + ext:terminate-process + ;; seq.lsp + cl:make-sequence cl:concatenate cl:map cl:some cl:every cl:notany cl:notevery cl:map-into cl:complement + ;; seqlib.lsp + cl:reduce cl:fill cl:replace + cl:remove cl:remove-if cl:remove-if-not cl:delete cl:delete-if cl:delete-if-not + cl:count cl:count-if cl:count-if-not cl:substitute cl:substitute-if cl:substitute-if-not + cl:nsubstitute cl:nsubstitute-if cl:nsubstitute-if-not cl:find cl:find-if cl:find-if-not + cl:position cl:position-if cl:position-if-not cl:remove-duplicates + cl:delete-duplicates cl:mismatch cl:search cl:sort cl:stable-sort cl:merge cl:constantly + si:sequence-count + ;; setf.lsp + si:do-defsetf si:do-define-setf-method + ;; trace.lsp + si:traced-old-definition + + ,@(when (member :clos *features*) + '(;; combin.lsp + cl:invalid-method-error + cl:method-combination-error + clos:compute-effective-method-function + clos:std-compute-effective-method + ;; defclass.lsp + clos::ensure-class + clos:load-defclass + ;; kernel.lsp + clos:std-compute-applicable-methods + ;; method.lsp + clos:extract-lambda-list + clos:extract-specializer-names + ;; predlib.lsp + si:subclassp si:of-class-p + ;; slotvalue.lsp + cl:slot-makunbound + ;; std-slot-value.lsp + cl:slot-boundp + cl:slot-exists-p + cl:slot-value + clos:slot-value-set + clos:standard-instance-access ;; alias clos:funcallable-standard-instance-access + clos:standard-instance-set)) + + ;; cdr-5 + ext:array-index-p + ext:negative-fixnum-p ext:non-negative-fixnum-p + ext:non-positive-fixnum-p ext:positive-fixnum-p + ext:negative-integer-p ext:non-negative-integer-p + ext:non-positive-integer-p ext:positive-integer-p + ext:negative-rational-p ext:non-negative-rational-p + ext:non-positive-rational-p ext:positive-rational-p + ext:negative-ratio-p ext:non-negative-ratio-p + ext:non-positive-ratio-p ext:positive-ratio-p + ext:negative-real-p ext:non-negative-real-p + ext:non-positive-real-p ext:positive-real-p + ext:negative-float-p ext:non-negative-float-p + ext:non-positive-float-p ext:positive-float-p + ext:negative-short-float-p ext:non-negative-short-float-p + ext:non-positive-short-float-p ext:positive-short-float-p + ext:negative-single-float-p ext:non-negative-single-float-p + ext:non-positive-single-float-p ext:positive-single-float-p + ext:negative-double-float-p ext:non-negative-double-float-p + ext:non-positive-double-float-p ext:positive-double-float-p + ext:negative-long-float-p ext:non-negative-long-float-p + ext:non-positive-long-float-p ext:positive-long-float-p)) + +(proclaim + ;; These functions are not visible in external.h and have no entry in + ;; symbols_list.h + `(si::c-export-fname + ,@(when (member :ecl-min *features*) + *in-all-symbols-functions*) + ;; defmacro.lsp + si::find-documentation si::find-declarations + si::search-keyword si::check-keyword + si::dm-too-many-arguments si::dm-too-few-arguments + si::remove-documentation + ;; defstruct.lsp + si::structure-type-error si::define-structure + ;; helpfile.lsp + si::get-documentation si::set-documentation + si::expand-set-documentation + ;; packlib.lsp + si::packages-iterator + ;; pprint.lsp + si::pprint-logical-block-helper si::pprint-pop-helper + ;; seq.lsp + si::make-seq-iterator si::seq-iterator-ref + si::seq-iterator-set si::seq-iterator-next + si::coerce-to-list si::coerce-to-vector + ,@(when (member :formatter *features*) + '(si::format-princ si::format-prin1 si::format-print-named-character + si::format-print-integer + si::format-print-cardinal si::format-print-ordinal si::format-print-old-roman + si::format-print-roman si::format-fixed si::format-exponential + si::format-general si::format-dollars + si::format-relative-tab si::format-absolute-tab + si::format-justification)) + ,@(when (member :clos *features*) + '(;; generic.lsp + clos::associate-methods-to-gfun + ;; kernel.lsp + clos::install-method + ;; std-slot-value.lsp + clos::find-slot-definition + ;; clos::generic-function-lambda-list + ;; clos::generic-function-argument-precedence-order + ;; clos::generic-function-method-combination + ;; clos::generic-function-method-class + ;; clos::generic-function-methods + ;; clos::method-generic-function + ;; clos::method-lambda-list + ;; clos::method-specializers + ;; clos::method-qualifiers + ;; clos::method-function + ;; clos::method-plist + )))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp new file mode 100644 index 000000000..001d82199 --- /dev/null +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -0,0 +1,819 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*- +;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab: + +;;;; +;;;; Copyright (c) 1991, Giuseppe Attardi. All rights reserved. +;;;; Copyright (c) 2003, Juan Jose Garcia Ripoll +;;;; +;;;; See the file 'LICENSE' for the copyright details. +;;;; + +;;;; +;;;; Database for system functions. +;;;; + +(in-package "COMPILER") + +;;; +;;; DATABASE OF INLINE EXPANSIONS +;;; +;;; (DEF-INLINE function-name kind ([arg-type]*) return-rep-type +;;; expansion-string) +;;; +;;; Here, ARG-TYPE is the list of argument types belonging to the lisp family, +;;; while RETURN-REP-TYPE is a representation type, i.e. the C type of the +;;; output expression. EXPANSION-STRING is a C/C++ expression template, like the +;;; ones used by C-INLINE. Finally, KIND can be :ALWAYS, :SAFE or :UNSAFE, +;;; depending on whether the inline expression should be applied always, in safe +;;; or in unsafe compilation mode, respectively. +;;; + +(defun inline-information (name safety) + (gethash (list name safety) *inline-information*)) + +(defun (setf inline-information) (value name safety) + (setf (gethash (list name safety) *inline-information*) value)) + +(defun %def-inline (name safety arg-types return-rep-type expansion + &key (one-liner t) (exact-return-type nil) (inline-or-warn nil) + (multiple-values t) + &aux arg-rep-types) + (setf safety + (case safety + (:unsafe :inline-unsafe) + (:safe :inline-safe) + (:always :inline-always) + (t (error "In DEF-INLINE, wrong value of SAFETY")))) + ;; Ensure we can inline this form. We only inline when the features are + ;; there (checked above) and when the C types are part of this machine + ;; (checked here). + (loop for type in (list* return-rep-type arg-types) + unless (or (eq type 'fixnum-float) + (and (consp type) (eq (car type) 'values)) + (lisp-type-p type) + (machine-c-type-p type)) + do (warn "Dropping inline form for ~A because of missing type ~A" name type) + (return-from %def-inline)) + (setf arg-rep-types + (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->rep-type x))) + arg-types)) + (when (eq return-rep-type t) + (setf return-rep-type :object)) + (when inline-or-warn + (setf (inline-information name 'should-be-inlined) t)) + (let* ((return-type (if (and (consp return-rep-type) + (eq (first return-rep-type) 'values)) + t + (rep-type->lisp-type return-rep-type))) + (inline-info + (make-inline-info :name name + :arg-rep-types arg-rep-types + :return-rep-type return-rep-type + :return-type return-type + :arg-types arg-types + :exact-return-type exact-return-type + :multiple-values multiple-values + ;; :side-effects (not (si:get-sysprop name 'no-side-effects)) + :one-liner one-liner + :expansion expansion))) + #+(or) + (loop for i in (inline-information name safety) + when (and (equalp (inline-info-arg-types i) arg-types) + (not (equalp return-type (inline-info-return-type i)))) + do (format t "~&;;; Redundand inline definition for ~A~&;;; ~<~A~>~&;;; ~<~A~>" + name i inline-info)) + (push inline-info (gethash (list name safety) *inline-information*)))) + +(defmacro def-inline (&rest args) + `(apply #'%def-inline ',args)) + +(defun make-inline-information (*machine*) + (let ((*inline-information* (make-hash-table :size 768 :test 'equal))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; ALL FUNCTION DECLARATIONS AND INLINE FORMS + ;; + (def-inline cl:aref :unsafe (t t t) t "@0;ecl_aref_unsafe(#0,ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2))") + (def-inline cl:aref :unsafe ((array t) t t) t "@0;(#0)->array.self.t[ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2)]") + (def-inline cl:aref :unsafe ((array bit) t t) :fixnum "@0;ecl_aref_bv(#0,ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2))") + (def-inline cl:aref :unsafe ((array t) fixnum fixnum) t "@0;(#0)->array.self.t[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array bit) fixnum fixnum) :fixnum "@0;ecl_aref_bv(#0,(#1)*(#0)->array.dims[1]+#2)") + (def-inline cl:aref :unsafe ((array base-char) fixnum fixnum) :unsigned-char "@0;(#0)->base_string.self[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array double-float) fixnum fixnum) :double "@0;(#0)->array.self.df[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array single-float) fixnum fixnum) :float "@0;(#0)->array.self.sf[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array long-float) fixnum fixnum) :long-double "@0;(#0)->array.self.lf[#1*(#0)->array.dims[1]+#2]") + (when (member :complex-float *features*) + (def-inline cl:aref :unsafe ((array si:complex-single-float) fixnum fixnum) :csfloat "@0;(#0)->array.self.csf[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array si:complex-double-float) fixnum fixnum) :cdfloat "@0;(#0)->array.self.cdf[#1*(#0)->array.dims[1]+#2]") + (def-inline cl:aref :unsafe ((array si:complex-long-float) fixnum fixnum) :clfloat "@0;(#0)->array.self.clf[#1*(#0)->array.dims[1]+#2]")) + + (def-inline cl:aref :unsafe ((array fixnum) fixnum fixnum) :fixnum "@0;(#0)->array.self.fix[#1*(#0)->array.dims[1]+#2]") + + (def-inline cl:aref :always (t t) t "ecl_aref1(#0,ecl_to_size(#1))") + (def-inline cl:aref :always (t fixnum) t "ecl_aref1(#0,#1)") + (def-inline cl:aref :unsafe (t t) t "ecl_aref1(#0,ecl_fixnum(#1))") + (def-inline cl:aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") + (def-inline cl:aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") + (when (member :unicode *features*) + (def-inline cl:aref :unsafe ((array character) fixnum) :wchar "(#0)->string.self[#1]")) + (def-inline cl:aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]") + (def-inline cl:aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]") + (def-inline cl:aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]") + (def-inline cl:aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]") + (when (member :complex-float *features*) + (def-inline cl:aref :unsafe ((array si:complex-single-float) fixnum) :csfloat "(#0)->array.self.csf[#1]") + (def-inline cl:aref :unsafe ((array si:complex-double-float) fixnum) :cdfloat "(#0)->array.self.cdf[#1]") + (def-inline cl:aref :unsafe ((array si:complex-long-float) fixnum) :clfloat "(#0)->array.self.clf[#1]")) + (def-inline cl:aref :unsafe ((array fixnum) fixnum) :fixnum "(#0)->array.self.fix[#1]") + + (def-inline cl:row-major-aref :always (t t) t "ecl_aref(#0,ecl_to_size(#1))") + (def-inline cl:row-major-aref :always (t fixnum) t "ecl_aref(#0,#1)") + (def-inline cl:row-major-aref :unsafe (t t) t "ecl_aref_unsafe(#0,ecl_fixnum(#1))") + (def-inline cl:row-major-aref :unsafe (t fixnum) t "ecl_aref_unsafe(#0,#1)") + (def-inline cl:row-major-aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") + (def-inline cl:row-major-aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") + (when (member :unicode *features*) + (def-inline cl:row-major-aref :unsafe ((array character) fixnum) :wchar "(#0)->string.self[#1]")) + (def-inline cl:row-major-aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:byte8) fixnum) :uint8-t "(#0)->vector.self.b8[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:integer8) fixnum) :int8-t "(#0)->vector.self.i8[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:byte16) fixnum) :uint16-t "(#0)->vector.self.b16[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:integer16) fixnum) :int16-t "(#0)->vector.self.i16[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:byte32) fixnum) :uint32-t "(#0)->vector.self.b32[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:integer32) fixnum) :int32-t "(#0)->vector.self.i32[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:byte64) fixnum) :uint64-t "(#0)->vector.self.b64[#1]") + (def-inline cl:row-major-aref :unsafe ((array ext:integer64) fixnum) :int64-t "(#0)->vector.self.i64[#1]") + (def-inline cl:row-major-aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]") + (def-inline cl:row-major-aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]") + (def-inline cl:row-major-aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]") + (when (member :complex-float *features*) + (def-inline cl:row-major-aref :unsafe ((array si:complex-single-float) fixnum) :csfloat "(#0)->array.self.csf[#1]") + (def-inline cl:row-major-aref :unsafe ((array si:complex-double-float) fixnum) :cdfloat "(#0)->array.self.cdf[#1]") + (def-inline cl:row-major-aref :unsafe ((array si:complex-long-float) fixnum) :clfloat "(#0)->array.self.clf[#1]")) + (def-inline cl:row-major-aref :unsafe ((array fixnum) fixnum) :fixnum "(#0)->array.self.fix[#1]") + + (def-inline si:row-major-aset :always (t t t) t "ecl_aset(#0,ecl_to_size(#1),#2)") + (def-inline si:row-major-aset :always (t fixnum t) t "ecl_aset(#0,#1,#2)") + (def-inline si:row-major-aset :unsafe (t t t) t "ecl_aset_unsafe(#0,ecl_fixnum(#1),#2)") + (def-inline si:row-major-aset :unsafe (t fixnum t) t "ecl_aset_unsafe(#0,#1,#2)") + (def-inline si:row-major-aset :unsafe ((array t) fixnum t) t "(#0)->vector.self.t[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array bit) fixnum t) :fixnum "ecl_aset_bv(#0,#1,ecl_fixnum(#2))") + (def-inline si:row-major-aset :unsafe ((array bit) fixnum fixnum) :fixnum "ecl_aset_bv(#0,#1,#2)") + (def-inline si:row-major-aset :unsafe ((array base-char) fixnum base-char) :unsigned-char "(#0)->base_string.self[#1]= #2") + (when (member :unicode *features*) + (def-inline si:row-major-aset :unsafe ((array character) fixnum character) :wchar "(#0)->string.self[#1]= #2")) + (def-inline si:row-major-aset :unsafe ((array ext:byte8) fixnum ext:byte8) :uint8-t "(#0)->vector.self.b8[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:integer8) fixnum ext:integer8) :int8-t "(#0)->vector.self.i8[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:byte16) fixnum ext:byte16) :uint16-t "(#0)->vector.self.b16[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:integer16) fixnum ext:integer16) :int16-t "(#0)->vector.self.i16[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:byte32) fixnum ext:byte32) :uint32-t "(#0)->vector.self.b32[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:integer32) fixnum ext:integer32) :int32-t "(#0)->vector.self.i32[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:byte64) fixnum ext:byte64) :uint64-t "(#0)->vector.self.b64[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array ext:integer64) fixnum ext:integer64) :int64-t "(#0)->vector.self.i64[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array long-float) fixnum long-float) :long-double "(#0)->array.self.lf[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array double-float) fixnum double-float) :double "(#0)->array.self.df[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array single-float) fixnum single-float) :float "(#0)->array.self.sf[#1]= #2") + (when (member :complex-float *features*) + (def-inline si:row-major-aset :unsafe ((array si:complex-single-float) fixnum si:complex-single-float) :csfloat "(#0)->array.self.csf[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array si:complex-double-float) fixnum si:complex-double-float) :cdfloat "(#0)->array.self.cdf[#1]= #2") + (def-inline si:row-major-aset :unsafe ((array si:complex-long-float) fixnum si:complex-long-float) :clfloat "(#0)->array.self.clf[#1]= #2")) + (def-inline si:row-major-aset :unsafe ((array fixnum) fixnum fixnum) :fixnum "(#0)->array.self.fix[#1]= #2") + + (def-inline si:copy-subarray :always (array ext:array-index array ext:array-index ext:array-index) array "@0;(ecl_copy_subarray(#0,#1,#2,#3,#4),#0)") + + (def-inline cl:array-rank :unsafe (array) :fixnum "@0;(((#0)->d.t == t_array)?(#0)->array.rank:1)") + (def-inline cl:array-rank :always (array) :fixnum "ecl_array_rank(#0)") + + (def-inline cl:array-dimension :always (t t) fixnum "ecl_array_dimension(#0,ecl_to_size(#1))") + (def-inline cl:array-dimension :always (t fixnum) fixnum "ecl_array_dimension(#0,#1)") + + (def-inline cl:array-total-size :unsafe (t) :fixnum "((#0)->array.dim)") + + (def-inline cl:adjustable-array-p :always (t) :bool "@0;(ECL_ARRAYP(#0)? (void)0: FEtype_error_array(#0),ECL_ADJUSTABLE_ARRAY_P(#0))") + (def-inline cl:adjustable-array-p :unsafe (array) :bool "ECL_ADJUSTABLE_ARRAY_P(#0)") + + (def-inline cl:svref :always (t t) t "ecl_aref1(#0,ecl_to_size(#1))") + (def-inline cl:svref :always (t fixnum) t "ecl_aref1(#0,#1)") + (def-inline cl:svref :unsafe (t t) t "(#0)->vector.self.t[ecl_fixnum(#1)]") + (def-inline cl:svref :unsafe (t fixnum) t "(#0)->vector.self.t[#1]") + + (def-inline si:svset :always (t t t) t "ecl_aset1(#0,ecl_to_size(#1),#2)") + (def-inline si:svset :always (t fixnum t) t "ecl_aset1(#0,#1,#2)") + (def-inline si:svset :unsafe (t t t) t "((#0)->vector.self.t[ecl_fixnum(#1)]=(#2))") + (def-inline si:svset :unsafe (t fixnum t) t "(#0)->vector.self.t[#1]= #2") + + (def-inline cl:array-has-fill-pointer-p :always (t) :bool "@0;(ECL_ARRAYP(#0)?(void)0:FEtype_error_array(#0),ECL_ARRAY_HAS_FILL_POINTER_P(#0))") + (def-inline cl:array-has-fill-pointer-p :unsafe (array) :bool "ECL_ARRAY_HAS_FILL_POINTER_P(#0)") + + (def-inline cl:fill-pointer :unsafe (t) :fixnum "((#0)->vector.fillp)") + (def-inline si:fill-pointer-set :unsafe (t fixnum) :fixnum "((#0)->vector.fillp)=(#1)") + + ;; file character.d + + (def-inline cl:standard-char-p :always (character) :bool "ecl_standard_char_p(#0)") + (def-inline cl:graphic-char-p :always (character) :bool "ecl_graphic_char_p(#0)") + (def-inline cl:alpha-char-p :always (character) :bool "ecl_alpha_char_p(#0)") + (def-inline cl:upper-case-p :always (character) :bool "ecl_upper_case_p(#0)") + (def-inline cl:lower-case-p :always (character) :bool "ecl_lower_case_p(#0)") + (def-inline cl:both-case-p :always (character) :bool "ecl_both_case_p(#0)") + (def-inline cl:alphanumericp :always (character) :bool "ecl_alphanumericp(#0)") + + (def-inline cl:char= :always (t t) :bool "ecl_char_code(#0)==ecl_char_code(#1)") + (def-inline cl:char= :always (character character) :bool "(#0)==(#1)") + + (def-inline cl:char/= :always (t t) :bool "ecl_char_code(#0)!=ecl_char_code(#1)") + (def-inline cl:char/= :always (character character) :bool "(#0)!=(#1)") + + (def-inline cl:char< :always (character character) :bool "(#0)<(#1)") + (def-inline cl:char> :always (character character) :bool "(#0)>(#1)") + (def-inline cl:char<= :always (character character) :bool "(#0)<=(#1)") + (def-inline cl:char>= :always (character character) :bool "(#0)>=(#1)") + + (def-inline cl:char-code :always (character) :fixnum "#0") + (def-inline cl:code-char :always (fixnum) :wchar "#0") + + (def-inline cl:char-upcase :always (base-char) :unsigned-char "ecl_char_upcase(#0)") + (def-inline cl:char-upcase :always (character) :wchar "ecl_char_upcase(#0)") + + (def-inline cl:char-downcase :always (base-char) :unsigned-char "ecl_char_downcase(#0)") + (def-inline cl:char-downcase :always (character) :wchar "ecl_char_downcase(#0)") + + (def-inline cl:char-int :always (character) :fixnum "#0") + + ;; file ffi.d + + (def-inline si:foreign-data-p :always (t) :bool "@0;ECL_FOREIGN_DATA_P(#0)") + + ;; file file.d + + (def-inline cl:input-stream-p :always (stream) :bool "ecl_input_stream_p(#0)") + (def-inline cl:output-stream-p :always (stream) :bool "ecl_output_stream_p(#0)") + + ;; file hash.d + + (def-inline cl:gethash :always (t t t) t "ecl_gethash_safe(#0,#1,#2)" :multiple-values nil) + (def-inline cl:gethash :always (t t) t "ecl_gethash_safe(#0,#1,ECL_NIL)" :multiple-values nil) + (def-inline cl:hash-table-count :unsafe (hash-table) ext:array-index "ecl_hash_table_count(#0)") + + ;; file list.d + + (def-inline cl:car :unsafe (cons) t "ECL_CONS_CAR(#0)") + (def-inline cl:car :unsafe (t) t "_ecl_car(#0)") + + (def-inline si:cons-car :always (t) t "_ecl_car(#0)") + (def-inline si:cons-car :unsafe (t) t "ECL_CONS_CAR(#0)") + + (def-inline cl:cdr :unsafe (cons) t "ECL_CONS_CDR(#0)") + (def-inline cl:cdr :unsafe (t) t "_ecl_cdr(#0)") + + (def-inline si:cons-cdr :always (t) t "_ecl_cdr(#0)") + (def-inline si:cons-cdr :unsafe (t) t "ECL_CONS_CDR(#0)") + + ;; BEGIN-GENERATED (gen-cons-sysfun) + + (def-inline cl:car :always (t) t "ecl_car(#0)") + (def-inline cl:car :unsafe (t) t "_ecl_car(#0)") + (def-inline cl:cdr :always (t) t "ecl_cdr(#0)") + (def-inline cl:cdr :unsafe (t) t "_ecl_cdr(#0)") + (def-inline cl:caar :always (t) t "ecl_caar(#0)") + (def-inline cl:caar :unsafe (t) t "_ecl_caar(#0)") + (def-inline cl:cdar :always (t) t "ecl_cdar(#0)") + (def-inline cl:cdar :unsafe (t) t "_ecl_cdar(#0)") + (def-inline cl:cadr :always (t) t "ecl_cadr(#0)") + (def-inline cl:cadr :unsafe (t) t "_ecl_cadr(#0)") + (def-inline cl:cddr :always (t) t "ecl_cddr(#0)") + (def-inline cl:cddr :unsafe (t) t "_ecl_cddr(#0)") + (def-inline cl:caaar :always (t) t "ecl_caaar(#0)") + (def-inline cl:caaar :unsafe (t) t "_ecl_caaar(#0)") + (def-inline cl:cdaar :always (t) t "ecl_cdaar(#0)") + (def-inline cl:cdaar :unsafe (t) t "_ecl_cdaar(#0)") + (def-inline cl:cadar :always (t) t "ecl_cadar(#0)") + (def-inline cl:cadar :unsafe (t) t "_ecl_cadar(#0)") + (def-inline cl:cddar :always (t) t "ecl_cddar(#0)") + (def-inline cl:cddar :unsafe (t) t "_ecl_cddar(#0)") + (def-inline cl:caadr :always (t) t "ecl_caadr(#0)") + (def-inline cl:caadr :unsafe (t) t "_ecl_caadr(#0)") + (def-inline cl:cdadr :always (t) t "ecl_cdadr(#0)") + (def-inline cl:cdadr :unsafe (t) t "_ecl_cdadr(#0)") + (def-inline cl:caddr :always (t) t "ecl_caddr(#0)") + (def-inline cl:caddr :unsafe (t) t "_ecl_caddr(#0)") + (def-inline cl:cdddr :always (t) t "ecl_cdddr(#0)") + (def-inline cl:cdddr :unsafe (t) t "_ecl_cdddr(#0)") + (def-inline cl:caaaar :always (t) t "ecl_caaaar(#0)") + (def-inline cl:caaaar :unsafe (t) t "_ecl_caaaar(#0)") + (def-inline cl:cdaaar :always (t) t "ecl_cdaaar(#0)") + (def-inline cl:cdaaar :unsafe (t) t "_ecl_cdaaar(#0)") + (def-inline cl:cadaar :always (t) t "ecl_cadaar(#0)") + (def-inline cl:cadaar :unsafe (t) t "_ecl_cadaar(#0)") + (def-inline cl:cddaar :always (t) t "ecl_cddaar(#0)") + (def-inline cl:cddaar :unsafe (t) t "_ecl_cddaar(#0)") + (def-inline cl:caadar :always (t) t "ecl_caadar(#0)") + (def-inline cl:caadar :unsafe (t) t "_ecl_caadar(#0)") + (def-inline cl:cdadar :always (t) t "ecl_cdadar(#0)") + (def-inline cl:cdadar :unsafe (t) t "_ecl_cdadar(#0)") + (def-inline cl:caddar :always (t) t "ecl_caddar(#0)") + (def-inline cl:caddar :unsafe (t) t "_ecl_caddar(#0)") + (def-inline cl:cdddar :always (t) t "ecl_cdddar(#0)") + (def-inline cl:cdddar :unsafe (t) t "_ecl_cdddar(#0)") + (def-inline cl:caaadr :always (t) t "ecl_caaadr(#0)") + (def-inline cl:caaadr :unsafe (t) t "_ecl_caaadr(#0)") + (def-inline cl:cdaadr :always (t) t "ecl_cdaadr(#0)") + (def-inline cl:cdaadr :unsafe (t) t "_ecl_cdaadr(#0)") + (def-inline cl:cadadr :always (t) t "ecl_cadadr(#0)") + (def-inline cl:cadadr :unsafe (t) t "_ecl_cadadr(#0)") + (def-inline cl:cddadr :always (t) t "ecl_cddadr(#0)") + (def-inline cl:cddadr :unsafe (t) t "_ecl_cddadr(#0)") + (def-inline cl:caaddr :always (t) t "ecl_caaddr(#0)") + (def-inline cl:caaddr :unsafe (t) t "_ecl_caaddr(#0)") + (def-inline cl:cdaddr :always (t) t "ecl_cdaddr(#0)") + (def-inline cl:cdaddr :unsafe (t) t "_ecl_cdaddr(#0)") + (def-inline cl:cadddr :always (t) t "ecl_cadddr(#0)") + (def-inline cl:cadddr :unsafe (t) t "_ecl_cadddr(#0)") + (def-inline cl:cddddr :always (t) t "ecl_cddddr(#0)") + (def-inline cl:cddddr :unsafe (t) t "_ecl_cddddr(#0)") + ;; END-GENERATED + + (def-inline cl:cons :always (t t) t "CONS(#0,#1)") + + (def-inline cl:endp :safe (t) :bool "ecl_endp(#0)") + (def-inline cl:endp :unsafe (t) :bool "#0==ECL_NIL") + + (def-inline cl:nth :always (t t) t "ecl_nth(ecl_to_size(#0),#1)") + (def-inline cl:nth :always (fixnum t) t "ecl_nth(#0,#1)") + (def-inline cl:nth :unsafe (t t) t "ecl_nth(ecl_fixnum(#0),#1)") + (def-inline cl:nth :unsafe (fixnum t) t "ecl_nth(#0,#1)") + + (def-inline cl:nthcdr :always (t t) t "ecl_nthcdr(ecl_to_size(#0),#1)") + (def-inline cl:nthcdr :always (fixnum t) t "ecl_nthcdr(#0,#1)") + (def-inline cl:nthcdr :unsafe (t t) t "ecl_nthcdr(ecl_fixnum(#0),#1)") + (def-inline cl:nthcdr :unsafe (fixnum t) t "ecl_nthcdr(#0,#1)") + + (def-inline cl:last :always (t) t "ecl_last(#0,1)") + + (def-inline cl:list :always nil t "ECL_NIL") + (def-inline cl:list :always (t) t "ecl_list1(#0)") + + (def-inline cl:list* :always (t) t "#0") + (def-inline cl:list* :always (t t) t "CONS(#0,#1)") + + (def-inline cl:append :always (t t) t "ecl_append(#0,#1)") + (def-inline cl:nconc :always (t t) t "ecl_nconc(#0,#1)") + (def-inline cl:butlast :always (t) t "ecl_butlast(#0,1)") + (def-inline cl:nbutlast :always (t) t "ecl_nbutlast(#0,1)") + + ;; file num_arith.d + + (def-inline cl:1+ :always (t) t "ecl_one_plus(#0)") + (def-inline cl:1+ :always (fixnum) t "ecl_make_integer((#0)+1)") + (def-inline cl:1+ :always (long-float) :long-double "(long double)(#0)+1") + (def-inline cl:1+ :always (double-float) :double "(double)(#0)+1") + (def-inline cl:1+ :always (single-float) :float "(float)(#0)+1") + (when (member :complex-float *features*) + (def-inline cl:1+ :always (si:complex-single-float) :csfloat "(_Complex float)(#0)+1") + (def-inline cl:1+ :always (si:complex-double-float) :cdfloat "(_Complex double)(#0)+1") + (def-inline cl:1+ :always (si:complex-long-float) :clfloat "(_Complex long double)(#0)+1")) + (def-inline cl:1+ :always (fixnum) :fixnum "(#0)+1" :exact-return-type t) + + (def-inline cl:1- :always (t) t "ecl_one_minus(#0)") + (def-inline cl:1- :always (fixnum) t "ecl_make_integer((#0)-1)") + (def-inline cl:1- :always (long-float) :long-double "(long double)(#0)-1") + (def-inline cl:1- :always (double-float) :double "(double)(#0)-1") + (def-inline cl:1- :always (single-float) :float "(float)(#0)-1") + (when (member :complex-float *features*) + (def-inline cl:1- :always (si:complex-single-float) :csfloat "(_Complex float)(#0)-1") + (def-inline cl:1- :always (si:complex-double-float) :cdfloat "(_Complex double)(#0)-1") + (def-inline cl:1- :always (si:complex-long-float) :clfloat "(_Complex long double)(#0)-1")) + (def-inline cl:1- :always (fixnum) :fixnum "(#0)-1" :exact-return-type t) + + ;; file num_co.d + + (def-inline cl:float :always (t single-float) :float "ecl_to_float(#0)") + (def-inline cl:float :always (t double-float) :double "ecl_to_double(#0)") + (def-inline cl:float :always (t long-float) :long-double "ecl_to_long_double(#0)") + (def-inline cl:float :always (fixnum-float) :long-double "((long double)(#0))" :exact-return-type t) + (def-inline cl:float :always (fixnum-float) :double "((double)(#0))" :exact-return-type t) + (def-inline cl:float :always (fixnum-float) :float "((float)(#0))" :exact-return-type t) + + (def-inline cl:numerator :unsafe (integer) integer "(#0)") + (def-inline cl:numerator :unsafe (ratio) integer "(#0)->ratio.num") + + (def-inline cl:denominator :unsafe (integer) integer "ecl_make_fixnum(1)") + (def-inline cl:denominator :unsafe (ratio) integer "(#0)->ratio.den") + + (def-inline cl:floor :always (t) (values &rest t) "ecl_floor1(#0)") + (def-inline cl:floor :always (t t) (values &rest t) "ecl_floor2(#0,#1)") + #+(or) ; does not work well, no multiple values + (def-inline cl:floor :always (fixnum fixnum) :fixnum "@01;(#0>=0&>0?(#0)/(#1):ecl_ifloor(#0,#1))") + + (def-inline cl:ceiling :always (t) (values &rest t) "ecl_ceiling1(#0)") + (def-inline cl:ceiling :always (t t) (values &rest t) "ecl_ceiling2(#0,#1)") + + (def-inline cl:truncate :always (t) (values &rest t) "ecl_truncate1(#0)") + (def-inline cl:truncate :always (t t) (values &rest t) "ecl_truncate2(#0,#1)") + #+(or) ; does not work well, no multiple values + (def-inline cl:truncate :always (fixnum-float) :fixnum "(cl_fixnum)(#0)") + + (def-inline cl:round :always (t) (values &rest t) "ecl_round1(#0)") + (def-inline cl:round :always (t t) (values &rest t) "ecl_round2(#0,#1)") + + (def-inline cl:mod :always (t t) t "(ecl_floor2(#0,#1),cl_env_copy->values[1])") + (def-inline cl:mod :always (fixnum fixnum) :fixnum "@01;(#0>=0&>0?(#0)%(#1):ecl_imod(#0,#1))") + + (def-inline cl:rem :always (t t) t "(ecl_truncate2(#0,#1),cl_env_copy->values[1])") + (def-inline cl:rem :always (fixnum fixnum) :fixnum "(#0)%(#1)") + + (def-inline cl:= :always (t t) :bool "ecl_number_equalp(#0,#1)") + (def-inline cl:= :always (fixnum-float fixnum-float) :bool "(#0)==(#1)") + + (def-inline cl:/= :always (t t) :bool "!ecl_number_equalp(#0,#1)") + (def-inline cl:/= :always (fixnum-float fixnum-float) :bool "(#0)!=(#1)") + + (def-inline cl:< :always (t t) :bool "ecl_lower(#0,#1)") + (def-inline cl:< :always (fixnum-float fixnum-float) :bool "(#0)<(#1)") + (def-inline cl:< :always (fixnum-float fixnum-float fixnum-float) :bool "@012;((#0)<(#1) && (#1)<(#2))") + + (def-inline cl:> :always (t t) :bool "ecl_greater(#0,#1)") + (def-inline cl:> :always (fixnum-float fixnum-float) :bool "(#0)>(#1)") + (def-inline cl:> :always (fixnum-float fixnum-float fixnum-float) :bool "@012;((#0)>(#1) && (#1)>(#2))") + + (def-inline cl:<= :always (t t) :bool "ecl_lowereq(#0,#1)") + (def-inline cl:<= :always (fixnum-float fixnum-float) :bool "(#0)<=(#1)") + (def-inline cl:<= :always (fixnum-float fixnum-float fixnum-float) :bool "@012;((#0)<=(#1) && (#1)<=(#2))") + + (def-inline cl:>= :always (t t) :bool "ecl_greatereq(#0,#1)") + (def-inline cl:>= :always (fixnum-float fixnum-float) :bool "(#0)>=(#1)") + (def-inline cl:>= :always (fixnum-float fixnum-float fixnum-float) :bool "@012;((#0)>=(#1) && (#1)>=(#2))") + + (def-inline cl:max :always (fixnum fixnum) :fixnum "@01;(#0)>=(#1)?#0:#1") + (def-inline cl:min :always (fixnum fixnum) :fixnum "@01;(#0)<=(#1)?#0:#1") + (if (member :ieee-floating-point *features*) + (progn + (def-inline cl:max :always (t t) t "@01;((ecl_float_nan_p(#1) || ecl_greatereq(#0,#1))?#0:#1)") + (def-inline cl:min :always (t t) t "@01;((ecl_float_nan_p(#1) || ecl_lowereq(#0,#1))?#0:#1)")) + (progn + (def-inline cl:max :always (t t) t "@01;(ecl_greatereq(#0,#1)?#0:#1)") + (def-inline cl:min :always (t t) t "@01;(ecl_lowereq(#0,#1)?#0:#1)"))) + + ;; file num_log.d + + (def-inline cl:logand :always nil t "ecl_make_fixnum(-1)") + (def-inline cl:logand :always nil :fixnum "-1") + (def-inline cl:logand :always (t t) t "ecl_boole(ECL_BOOLAND,(#0),(#1))") + (def-inline cl:logand :always (fixnum fixnum) :fixnum "((#0) & (#1))") + + (def-inline cl:logandc1 :always (t t) t "ecl_boole(ECL_BOOLANDC1,(#0),(#1))") + (def-inline cl:logandc1 :always (fixnum fixnum) :fixnum "(~(#0) & (#1))") + + (def-inline cl:logandc2 :always (t t) t "ecl_boole(ECL_BOOLANDC2,(#0),(#1))") + (def-inline cl:logandc2 :always (fixnum fixnum) :fixnum "((#0) & ~(#1))") + + (def-inline cl:logeqv :always nil t "ecl_make_fixnum(-1)") + (def-inline cl:logeqv :always nil :fixnum "-1") + (def-inline cl:logeqv :always (t t) t "ecl_boole(ECL_BOOLEQV,(#0),(#1))") + (def-inline cl:logeqv :always (fixnum fixnum) :fixnum "(~( (#0) ^ (#1) ))") + + (def-inline cl:logior :always nil t "ecl_make_fixnum(0)") + (def-inline cl:logior :always nil :fixnum "0") + (def-inline cl:logior :always (t t) t "ecl_boole(ECL_BOOLIOR,(#0),(#1))") + (def-inline cl:logior :always (fixnum fixnum) :fixnum "((#0) | (#1))") + + (def-inline cl:lognand :always (t t) t "ecl_boole(ECL_BOOLNAND,(#0),(#1))") + (def-inline cl:lognand :always (fixnum fixnum) :fixnum "(~( (#0) & (#1) ))") + + (def-inline cl:lognor :always (t t) t "ecl_boole(ECL_BOOLNOR,(#0),(#1))") + (def-inline cl:lognor :always (fixnum fixnum) :fixnum "(~( (#0) | (#1) ))") + + (def-inline cl:lognot :always (t) t "ecl_boole(ECL_BOOLXOR,(#0),ecl_make_fixnum(-1))") + (def-inline cl:lognot :always (fixnum) :fixnum "(~(#0))") + + (def-inline cl:logorc1 :always (t t) t "ecl_boole(ECL_BOOLORC1,(#0),(#1))") + (def-inline cl:logorc1 :always (fixnum fixnum) :fixnum "(~(#0) | (#1))") + + (def-inline cl:logorc2 :always (t t) t "ecl_boole(ECL_BOOLORC2,(#0),(#1))") + (def-inline cl:logorc2 :always (fixnum fixnum) :fixnum "((#0) | ~(#1))") + + (def-inline cl:logxor :always nil t "ecl_make_fixnum(0)") + (def-inline cl:logxor :always nil :fixnum "0") + (def-inline cl:logxor :always (t t) t "ecl_boole(ECL_BOOLXOR,(#0),(#1))") + (def-inline cl:logxor :always (fixnum fixnum) :fixnum "((#0) ^ (#1))") + + (def-inline cl:boole :always (fixnum t t) t "ecl_boole((#0),(#1),(#2))") + + (def-inline cl:logbitp :always ((integer -29 29) fixnum) :bool "(#1 >> #0) & 1") + + (def-inline cl:integer-length :always (t) :cl-index "ecl_integer_length(#0)") + + (def-inline cl:zerop :always (t) :bool "ecl_zerop(#0)") + (def-inline cl:zerop :always (fixnum-float) :bool "(#0)==0") + + (def-inline cl:plusp :always (t) :bool "ecl_plusp(#0)") + (def-inline cl:plusp :always (fixnum-float) :bool "(#0)>0") + + (def-inline cl:minusp :always (t) :bool "ecl_minusp(#0)") + (def-inline cl:minusp :always (fixnum-float) :bool "(#0)<0") + + (def-inline cl:oddp :always (t) :bool "ecl_oddp(#0)") + (def-inline cl:oddp :always (fixnum fixnum) :bool "(#0) & 1") + + (def-inline cl:evenp :always (t) :bool "ecl_evenp(#0)") + (def-inline cl:evenp :always (fixnum fixnum) :bool "~(#0) & 1") + + (def-inline cl:abs :always (t t) t "ecl_abs(#0,#1)") + (def-inline cl:exp :always (t) t "ecl_exp(#0)") + + (def-inline cl:expt :always (t t) t "ecl_expt(#0,#1)") + (def-inline cl:expt :always ((integer 2 2) (integer 0 29)) :fixnum "(1<<(#1))") + (def-inline cl:expt :always ((integer 0 0) t) :fixnum "0") + (def-inline cl:expt :always ((integer 1 1) t) :fixnum "1") + (def-inline cl:expt :always ((long-float 0.0l0 *) long-float) :long-double "powl((long double)#0,(long double)#1)") + (def-inline cl:expt :always ((double-float 0.0d0 *) double-float) :double "pow((double)#0,(double)#1)") + (def-inline cl:expt :always ((single-float 0.0f0 *) single-float) :float "powf((float)#0,(float)#1)") + (when (member :complex-float *features*) + (def-inline cl:expt :always (si:complex-single-float si:complex-single-float) :csfloat "cpowf(#0,#1)") + (def-inline cl:expt :always (si:complex-double-float si:complex-double-float) :cdfloat "cpow(#0,#1)") + (def-inline cl:expt :always (si:complex-long-float si:complex-long-float) :clfloat "cpowl(#0,#1)")) + + (def-inline cl:log :always (fixnum-float) :long-double "logl((long double)(#0))" :exact-return-type t) + (def-inline cl:log :always (fixnum-float) :double "log((double)(#0))" :exact-return-type t) + (def-inline cl:log :always (fixnum-float) :float "logf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:log :always (si:complex-single-float) :csfloat "clogf(#0)") + (def-inline cl:log :always (si:complex-double-float) :cdfloat "clog(#0)") + (def-inline cl:log :always (si:complex-long-float) :clfloat "clogl(#0)")) + + (def-inline cl:sqrt :always (number) number "ecl_sqrt(#0)") + (def-inline cl:sqrt :always ((long-float 0.0l0 *)) :long-double "sqrtl((long double)(#0))") + (def-inline cl:sqrt :always ((double-float 0.0d0 *)) :double "sqrt((double)(#0))") + (def-inline cl:sqrt :always ((single-float 0.0f0 *)) :float "sqrtf((float)(#0))") + (when (member :complex-float *features*) + (def-inline cl:sqrt :always (si:complex-single-float) :csfloat "csqrtf(#0)") + (def-inline cl:sqrt :always (si:complex-double-float) :cdfloat "csqrt(#0)") + (def-inline cl:sqrt :always (si:complex-long-float) :clfloat "csqrtl(#0)")) + + (def-inline cl:sin :always (number) number "ecl_sin(#0)") + (def-inline cl:sin :always (fixnum-float) :long-double "sinl((long double)(#0))" :exact-return-type t) + (def-inline cl:sin :always (fixnum-float) :double "sin((double)(#0))" :exact-return-type t) + (def-inline cl:sin :always (fixnum-float) :float "sinf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:sin :always (si:complex-single-float) :csfloat "csinf(#0)") + (def-inline cl:sin :always (si:complex-double-float) :cdfloat "csin(#0)") + (def-inline cl:sin :always (si:complex-long-float) :clfloat "csinl(#0)")) + + (def-inline cl:cos :always (t) number "ecl_cos(#0)") + (def-inline cl:cos :always (fixnum-float) :long-double "cosl((long double)(#0))" :exact-return-type t) + (def-inline cl:cos :always (fixnum-float) :double "cos((double)(#0))" :exact-return-type t) + (def-inline cl:cos :always (fixnum-float) :float "cosf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:cos :always (si:complex-single-float) :csfloat "ccosf(#0)") + (def-inline cl:cos :always (si:complex-double-float) :cdfloat "ccos(#0)") + (def-inline cl:cos :always (si:complex-long-float) :clfloat "ccosl(#0)")) + + (def-inline cl:tan :always (t) number "ecl_tan(#0)") + (def-inline cl:tan :always (fixnum-float) :long-double "tanl((long double)(#0))" :exact-return-type t) + (def-inline cl:tan :always (fixnum-float) :double "tan((double)(#0))" :exact-return-type t) + (def-inline cl:tan :always (fixnum-float) :float "tanf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:tan :always (si:complex-single-float) :csfloat "ctanf(#0)") + (def-inline cl:tan :always (si:complex-double-float) :cdfloat "ctan(#0)") + (def-inline cl:tan :always (si:complex-long-float) :clfloat "ctanl(#0)")) + + (def-inline cl:sinh :always (t) number "ecl_sinh(#0)") + (def-inline cl:sinh :always (fixnum-float) :long-double "sinhl((long double)(#0))" :exact-return-type t) + (def-inline cl:sinh :always (fixnum-float) :double "sinh((double)(#0))" :exact-return-type t) + (def-inline cl:sinh :always (fixnum-float) :float "sinhf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:sinh :always (si:complex-single-float) :csfloat "csinhf(#0)") + (def-inline cl:sinh :always (si:complex-double-float) :cdfloat "csinh(#0)") + (def-inline cl:sinh :always (si:complex-long-float) :clfloat "csinhl(#0)")) + + (def-inline cl:cosh :always (t) number "ecl_cosh(#0)") + (def-inline cl:cosh :always (fixnum-float) :long-double "coshl((long double)(#0))" :exact-return-type t) + (def-inline cl:cosh :always (fixnum-float) :double "cosh((double)(#0))" :exact-return-type t) + (def-inline cl:cosh :always (fixnum-float) :float "coshf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:cosh :always (si:complex-single-float) :csfloat "ccoshf(#0)") + (def-inline cl:cosh :always (si:complex-double-float) :cdfloat "ccosh(#0)") + (def-inline cl:cosh :always (si:complex-long-float) :clfloat "ccoshl(#0)")) + + (def-inline cl:tanh :always (t) number "ecl_tanh(#0)") + (def-inline cl:tanh :always (fixnum-float) :long-double "tanhl((long double)(#0))" :exact-return-type t) + (def-inline cl:tanh :always (fixnum-float) :double "tanh((double)(#0))" :exact-return-type t) + (def-inline cl:tanh :always (fixnum-float) :float "tanhf((float)(#0))" :exact-return-type t) + (when (member :complex-float *features*) + (def-inline cl:tanh :always (si:complex-single-float) :csfloat "ctanhf(#0)") + (def-inline cl:tanh :always (si:complex-double-float) :cdfloat "ctanh(#0)") + (def-inline cl:tanh :always (si:complex-long-float) :clfloat "ctanhl(#0)")) + + ;; file package.d + + ;; file pathname.d + + (def-inline cl:null :always (t) :bool "#0==ECL_NIL") + (def-inline cl:symbolp :always (t) :bool "@0;ECL_SYMBOLP(#0)") + (def-inline cl:atom :always (t) :bool "@0;ECL_ATOM(#0)") + (def-inline cl:consp :always (t) :bool "@0;ECL_CONSP(#0)") + (def-inline cl:listp :always (t) :bool "@0;ECL_LISTP(#0)") + (def-inline cl:numberp :always (t) :bool "ecl_numberp(#0)") + (def-inline cl:integerp :always (t) :bool "@0;ECL_FIXNUMP(#0)||ECL_BIGNUMP(#0)") + (def-inline cl:floatp :always (t) :bool "floatp(#0)") + (def-inline cl:characterp :always (t) :bool "ECL_CHARACTERP(#0)") + (def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_P(#0)") + (def-inline cl:stringp :always (t) :bool "@0;ECL_STRINGP(#0)") + (def-inline si:base-string-p :always (t) :bool "@0;ECL_BASE_STRING_P(#0)") + (def-inline cl:bit-vector-p :always (t) :bool "@0;ECL_BIT_VECTOR_P(#0)") + (def-inline cl:vectorp :always (t) :bool "@0;ECL_VECTORP(#0)") + (def-inline cl:arrayp :always (t) :bool "@0;ECL_ARRAYP(#0)") + + (def-inline cl:eq :always (t t) :bool "(#0)==(#1)") + (def-inline cl:eq :always (fixnum fixnum) :bool "(#0)==(#1)") + + (def-inline cl:eql :always (t t) :bool "ecl_eql(#0,#1)") + (def-inline cl:eql :always (character t) :bool "(ECL_CODE_CHAR(#0)==(#1))") + (def-inline cl:eql :always (t character) :bool "((#0)==ECL_CODE_CHAR(#1))") + (def-inline cl:eql :always (character character) :bool "(#0)==(#1)") + (def-inline cl:eql :always ((not (or complex bignum ratio float)) t) :bool "(#0)==(#1)") + (def-inline cl:eql :always (t (not (or complex bignum ratio float))) :bool "(#0)==(#1)") + (def-inline cl:eql :always (fixnum fixnum) :bool "(#0)==(#1)") + + (def-inline cl:equal :always (t t) :bool "ecl_equal(#0,#1)") + (def-inline cl:equal :always (fixnum fixnum) :bool "(#0)==(#1)") + + (def-inline cl:equalp :always (t t) :bool "ecl_equalp(#0,#1)") + (def-inline cl:equalp :always (fixnum fixnum) :bool "(#0)==(#1)") + + (def-inline cl:not :always (t) :bool "(#0)==ECL_NIL") + + ;; file print.d, read.d + + (def-inline cl:clear-output :always (stream) NULL "(ecl_clear_output(#0),ECL_NIL)") + (def-inline cl:finish-output :always (stream) NULL "(ecl_finish_output(#0),ECL_NIL)") + (def-inline cl:finish-output :always (stream) NULL "(ecl_force_output(#0),ECL_NIL)") + (def-inline cl:write-char :always (t) t "@0;(ecl_princ_char(ecl_char_code(#0),ECL_NIL),(#0))") + (def-inline cl:clear-input :always (stream) NULL "(ecl_clear_input(#0),ECL_NIL)") + (def-inline cl:copy-readtable :always (null null) t "standard_readtable") + + (def-inline cl:boundp :always (t) :bool "ecl_boundp(cl_env_copy,#0)") + (def-inline cl:boundp :unsafe ((and symbol (not null))) :bool "ECL_SYM_VAL(cl_env_copy,#0)!=OBJNULL") + + ;; file unixsys.d + + ;; file sequence.d + + (def-inline cl:elt :always (t t) t "ecl_elt(#0,ecl_to_size(#1))") + (def-inline cl:elt :always (t fixnum) t "ecl_elt(#0,#1)") + (def-inline cl:elt :unsafe (t t) t "ecl_elt(#0,ecl_fixnum(#1))") + (def-inline cl:elt :unsafe (t fixnum) t "ecl_elt(#0,#1)") + (def-inline cl:elt :unsafe (vector t) t "ecl_aref_unsafe(#0,ecl_fixnum(#1))") + (def-inline cl:elt :unsafe (vector fixnum) t "ecl_aref_unsafe(#0,#1)") + (def-inline cl:aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") + (def-inline cl:aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") + (when (member :unicode *features*) + (def-inline cl:aref :unsafe ((array character) fixnum) :wchar "(#0)->string.self[#1]")) + (def-inline cl:aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]") + (def-inline cl:aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]") + (def-inline cl:aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]") + (def-inline cl:aref :unsafe ((array fixnum) fixnum) :fixnum "(#0)->array.self.fix[#1]") + + (def-inline si:elt-set :always (t t t) t "ecl_elt_set(#0,ecl_to_size(#1),#2)") + (def-inline si:elt-set :always (t fixnum t) t "ecl_elt_set(#0,#1,#2)") + (def-inline si:elt-set :unsafe (t t t) t "ecl_elt_set(#0,ecl_fixnum(#1),#2)") + (def-inline si:elt-set :unsafe (vector t t) t "ecl_aset_unsafe(#0,ecl_to_size(#1),#2)") + (def-inline si:elt-set :unsafe (vector fixnum t) t "ecl_aset_unsafe(#0,#1,#2)") + + (def-inline cl:length :always (t) :fixnum "ecl_length(#0)") + (def-inline cl:length :unsafe (vector) :fixnum "(#0)->vector.fillp") + + (def-inline cl:copy-seq :always (t) t "ecl_copy_seq(#0)") + + ;; file character.d + + (def-inline cl:char :always (t fixnum) t "ecl_aref1(#0,#1)") + (def-inline cl:char :always (t fixnum) :wchar "ecl_char(#0,#1)") + (if (member :unicode *features*) + (def-inline cl:char :unsafe (ext:extended-string fixnum) :wchar "(#0)->string.self[#1]") + (progn + (def-inline cl:char :unsafe (t t) t "ECL_CODE_CHAR((#0)->base_string.self[ecl_fixnum(#1)])") + (def-inline cl:char :unsafe (t fixnum) :unsigned-char "(#0)->base_string.self[#1]"))) + (def-inline cl:char :unsafe (base-string fixnum) :unsigned-char "(#0)->base_string.self[#1]") + + (def-inline si:char-set :always (t t t) t "si_char_set(#0,#1,#2)") + (def-inline si:char-set :always (t fixnum t) t "ecl_aset1(#0,#1,#2)") + (def-inline si:char-set :always (t fixnum character) :wchar "ecl_char_set(#0,#1,#2)") + + (unless (member :unicode *features*) + (def-inline si:char-set :unsafe (t t t) t "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") + (def-inline si:char-set :unsafe (t fixnum character) :unsigned-char "(#0)->base_string.self[#1]= #2")) + (def-inline si:char-set :unsafe (base-string t t) t "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") + (def-inline si:char-set :unsafe (base-string fixnum base-char) :unsigned-char "(#0)->base_string.self[#1]= #2") + (def-inline si:char-set :unsafe (ext:extended-string t t) t "@2;((#0)->string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") + (def-inline si:char-set :unsafe (ext:extended-string fixnum character) :unsigned-char "(#0)->string.self[#1]= #2") + + (def-inline cl:schar :always (t t) t "ecl_elt(#0,ecl_to_size(#1))") + (def-inline cl:schar :always (t fixnum) t "ecl_elt(#0,#1)") + (def-inline cl:schar :always (t fixnum) :wchar "ecl_char(#0,#1)") + (def-inline cl:schar :unsafe (base-string t) t "ECL_CODE_CHAR((#0)->base_string.self[ecl_fixnum(#1)])") + (def-inline cl:schar :unsafe (base-string fixnum) :unsigned-char "(#0)->base_string.self[#1]") + (if (member :unicode *features*) + (def-inline cl:schar :unsafe (ext:extended-string fixnum) :wchar "(#0)->string.self[#1]") + (def-inline cl:schar :unsafe (t fixnum) :unsigned-char "(#0)->base_string.self[#1]")) + (def-inline si:schar-set :always (t t t) t "ecl_elt_set(#0,ecl_to_size(#1),#2)") + (def-inline si:schar-set :always (t fixnum t) t "ecl_elt_set(#0,#1,#2)") + (def-inline si:schar-set :always (t fixnum character) :wchar "ecl_char_set(#0,#1,#2)") + (if (member :unicode *features*) + (progn + (def-inline si:schar-set :unsafe (ext:extended-string fixnum t) :wchar "@2;((#0)->string.self[#1]= ecl_char_code(#2),(#2))") + (def-inline si:schar-set :unsafe (ext:extended-string fixnum character) :wchar "(#0)->string.self[#1]= #2")) + (progn + (def-inline si:schar-set :unsafe (t t t) t "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") + (def-inline si:schar-set :unsafe (t fixnum base-char) :unsigned-char "(#0)->base_string.self[#1]= #2"))) + (def-inline si:schar-set :unsafe (base-string t t) t "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") + (def-inline si:schar-set :unsafe (base-string fixnum base-char) :unsigned-char "(#0)->base_string.self[#1]= #2") + + (def-inline cl:string= :always (string string) :bool "ecl_string_eq(#0,#1)") + + ;; file structure.d + + (def-inline si:structure-name :always (structure-object) symbol "ECL_STRUCT_NAME(#0)") + (def-inline si:structure-ref :always (t t fixnum) t "ecl_structure_ref(#0,#1,#2)") + (def-inline si:structure-set :always (t t fixnum t) t "ecl_structure_set(#0,#1,#2,#3)") + + ;; file symbol.d + + (def-inline cl:get :always (t t t) t "ecl_get(#0,#1,#2)") + (def-inline cl:get :always (t t) t "ecl_get(#0,#1,ECL_NIL)") + + (def-inline cl:symbol-name :always (t) string "ecl_symbol_name(#0)") + + ;; Additions used by the compiler. + ;; The following functions do not exist. They are always expanded into the + ;; given C code. References to these functions are generated in the C1 phase. + + (def-inline shift>> :always (fixnum fixnum) :fixnum "((#0) >> (- (#1)))") + (def-inline shift<< :always (fixnum fixnum) :fixnum "((#0) << (#1))") + + (def-inline si:short-float-p :always (t) :bool "@0;ECL_SINGLE_FLOAT_P(#0)") + (def-inline si:single-float-p :always (t) :bool "@0;ECL_SINGLE_FLOAT_P(#0)") + (def-inline si:double-float-p :always (t) :bool "@0;ECL_DOUBLE_FLOAT_P(#0)") + (def-inline si:long-float-p :always (t) :bool "@0;ECL_LONG_FLOAT_P(#0)") + + (when (member :complex-float *features*) + (def-inline si::complex-single-float-p :always (t) :bool "@0;ECL_COMPLEX_SINGLE_FLOAT_P(#0)") + (def-inline si::complex-double-float-p :always (t) :bool "@0;ECL_COMPLEX_DOUBLE_FLOAT_P(#0)") + (def-inline si::complex-long-float-p :always (t) :bool "@0;ECL_COMPLEX_LONG_FLOAT_P(#0)")) + + (def-inline ext:fixnump :always (t) :bool "ECL_FIXNUMP(#0)") + (def-inline ext:fixnump :always (fixnum) :bool "1") + + ;; Functions only available with threads + (when (member :threads *features*) + (def-inline mp:lock-count :unsafe (mp:lock) fixnum "((#0)->lock.counter)") + (def-inline mp:compare-and-swap-car :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CAR(#0),(#1),(#2))") + (def-inline mp:atomic-incf-car :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CAR(#0),(#1))") + (def-inline mp:atomic-incf-car :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CAR(#0),(#1))") + + (def-inline mp:compare-and-swap-cdr :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CDR(#0),(#1),(#2))") + (def-inline mp:atomic-incf-cdr :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CDR(#0),(#1))") + (def-inline mp:atomic-incf-cdr :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CDR(#0),(#1))") + + (def-inline mp:compare-and-swap-symbol-value :unsafe (symbol t t) t "ecl_compare_and_swap(ecl_bds_ref(ecl_process_env(),(#0)),(#1),(#2))") + (def-inline mp:atomic-incf-symbol-value :always (t fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") + (def-inline mp:atomic-incf-symbol-value :unsafe (symbol t) t "ecl_atomic_incf(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") + (def-inline mp:atomic-incf-symbol-value :unsafe (symbol fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") + + (def-inline mp:compare-and-swap-svref :unsafe (t t t t) t "ecl_compare_and_swap((#0)->vector.self.t + ecl_fixnum(#1),(#2),(#3))") + (def-inline mp:compare-and-swap-svref :unsafe (t fixnum t t) t "ecl_compare_and_swap((#0)->vector.self.t + (#1),(#2),(#3))") + + ;; :threads are implicit + (when (member :clos *features*) + (def-inline mp:compare-and-swap-instance :always (t fixnum t t) t "ecl_compare_and_swap_instance((#0),(#1),(#2),(#3))") + (def-inline mp:compare-and-swap-instance :unsafe (standard-object fixnum t t) t "ecl_compare_and_swap((#0)->instance.slots+(#1),(#2),(#3))") + (def-inline mp:atomic-incf-instance :always (t fixnum t) t "ecl_atomic_incf_instance((#0),(#1),(#2))") + (def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum t) t "ecl_atomic_incf((#0)->instance.slots+(#1),(#2))") + (def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum fixnum) t "ecl_atomic_incf_by_fixnum((#0)->instance.slots+(#1),(#2))")) + + (def-inline mp:compare-and-swap-structure :unsafe (structure-object t fixnum t t) t "ecl_compare_and_swap(&(ECL_STRUCT_SLOT((#0),(#2))),(#3),(#4))")) + + ;; Functions only available with CLOS + (when (member :clos *features*) + (def-inline si:instance-ref :always (t fixnum) t "ecl_instance_ref((#0),(#1))") + (def-inline si:instance-ref :unsafe (standard-object fixnum) t "(#0)->instance.slots[#1]") + (def-inline si::instance-slotds :unsafe (standard-object) list "(#0)->instance.slotds") + + (def-inline si:instance-set :unsafe (t fixnum t) t "ecl_instance_set((#0),(#1),(#2))") + (def-inline si:instance-set :unsafe (standard-object fixnum t) t "(#0)->instance.slots[#1]=(#2)") + + (def-inline si:instance-class :always (standard-object) t "ECL_CLASS_OF(#0)") + (def-inline cl:class-of :unsafe (standard-object) t "ECL_CLASS_OF(#0)") + + (def-inline si:instancep :always (t) :bool "@0;ECL_INSTANCEP(#0)") + (def-inline si:unbound :always nil t "ECL_UNBOUND") + + (def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND") + + (def-inline clos:standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") + (def-inline clos:standard-instance-access :unsafe (standard-object fixnum) t "(#0)->instance.slots[#1]") + + (def-inline clos:funcallable-standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") + (def-inline clos:funcallable-standard-instance-access :unsafe (clos:funcallable-standard-object fixnum) t "(#0)->instance.slots[#1]")) + + *inline-information*)) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp b/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp index c08286b31..e35189339 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp @@ -5,18 +5,18 @@ ;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. ;;;; Copyright (c) 1990, Giuseppe Attardi. ;;;; -;;;; This program is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Library General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 2 of the License, or (at your option) any later version. +;;;; See the file 'LICENSE' for the copyright details. ;;;; -;;;; See file '../Copyright' for full details. + ;;;; -;;;; CMPC-INLINER -- Open coding functions as C expressions +;;;; Open coding functions as C expressions. ;;;; (in-package "COMPILER") +(setf (machine-inline-information *default-machine*) + (make-inline-information *default-machine*)) + (defun inlined-arg-loc (arg) (second arg)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp index 5bed4952f..9d828aa40 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp @@ -156,33 +156,29 @@ ;; either because it has been proclaimed so, or because it belongs ;; to the runtime. (multiple-value-bind (found fd minarg maxarg) - (si::mangle-name fname t) + (si:mangle-name fname t) (when found (return-from call-global-loc - (call-exported-function-loc fname args fd minarg maxarg t - return-type)))) + (call-exported-function-loc fname args fd minarg maxarg t return-type)))) (when (policy-use-direct-C-call) - (let ((fd (si:get-sysprop fname 'Lfun))) - (when fd - (multiple-value-bind (minarg maxarg found) (get-proclaimed-narg fname) + (ext:when-let ((fd (si:get-sysprop fname 'Lfun))) + (multiple-value-bind (minarg maxarg found) (get-proclaimed-narg fname) + (unless found + ;; Without knowing the number of arguments we cannot call the C + ;; function. When compiling ECL itself, we get this information + ;; through si::mangle-name from symbols_list.h for core functions + ;; defined in Lisp code. #+ecl-min + (let (ignored) + (multiple-value-setq (found ignored minarg maxarg) + (si:mangle-name fname))) (unless found - ;; Without knowing the number of arguments we cannot call - ;; the C function. When compiling ECL itself, we get this - ;; information through si::mangle-name from symbols_list.h - ;; for core functions defined in Lisp code. - (let (ignored) - (multiple-value-setq (found ignored minarg maxarg) - (si::mangle-name fname)))) - (unless found - (cmperr "Can not call the function ~A using its exported C name ~A because its function type has not been proclaimed" - fname fd)) - (return-from call-global-loc - (call-exported-function-loc - fname args fd minarg maxarg - (si::mangle-name fname) - return-type)))))) + (cmperr "Can not call the function ~A using its exported C name ~A because its function type has not been proclaimed." + fname fd))) + (return-from call-global-loc + (call-exported-function-loc fname args fd minarg maxarg + (si:mangle-name fname) return-type))))) (call-unknown-global-loc fname nil args)) diff --git a/src/cmp/cmpenv-proclaim.lsp b/src/cmp/cmpenv-proclaim.lsp index de0bcc6f4..77c60cebf 100644 --- a/src/cmp/cmpenv-proclaim.lsp +++ b/src/cmp/cmpenv-proclaim.lsp @@ -79,14 +79,14 @@ (dolist (x (cdr decl)) (cond ((symbolp x) (multiple-value-bind (found c-name) - (si::mangle-name x t) + (si:mangle-name x t) (if found - (warn "The function ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." x) + (error "The function ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." x) (si:put-sysprop x 'Lfun c-name)))) ((consp x) (destructuring-bind (c-name lisp-name) x - (if (si::mangle-name lisp-name) - (warn "The function ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." lisp-name) + (if (si:mangle-name lisp-name) + (error "The function ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." lisp-name) (si:put-sysprop lisp-name 'Lfun c-name)))) (t (error "Syntax error in proclamation ~s" decl))))) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 0d1e19050..c65412987 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -153,12 +153,6 @@ :format-control "The expansion of the compiler macro~%~T~A~%was aborted because of a serious condition~%~A" :format-arguments (list fname c)) (values nil nil)))) -(defun si::compiler-clear-compiler-properties (symbol) - (si:rem-sysprop symbol 't1) - (si:rem-sysprop symbol 't2) - (si:rem-sysprop symbol 't3) - (si:rem-sysprop symbol 'lfun)) - (defun lisp-to-c-name (obj) "Translate Lisp object prin1 representation to valid C identifier name" (and obj diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index a137936ea..e5cf4b1e6 100644 --- a/src/cmp/load.lsp.in +++ b/src/cmp/load.lsp.in @@ -48,6 +48,8 @@ "src:cmp;cmpbackend-cxx;cmpc-util.lsp" "src:cmp;cmpbackend-cxx;cmpc-mach.lsp" "src:cmp;cmpbackend-cxx;cmpc-wt.lsp" + "src:cmp;cmpbackend-cxx;cmpc-inl-sysfun.lsp" + "src:cmp;cmpbackend-cxx;cmpc-inl-lspfun.lsp" "src:cmp;cmpbackend-cxx;cmpc-inliner.lsp" "src:cmp;cmpbackend-cxx;cmpc-opt-inl.lsp" "src:cmp;cmpbackend-cxx;cmpc-opt-num.lsp" @@ -80,7 +82,6 @@ "src:cmp;cmpclos.lsp" ;unused "src:cmp;cmpstructures.lsp" ;unused "src:cmp;cmparray.lsp" - "src:cmp;sysfun.lsp" ;; Other "src:cmp;cmpos-run.lsp" "src:cmp;cmpos-features.lsp" diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp deleted file mode 100644 index 7204932c5..000000000 --- a/src/cmp/sysfun.lsp +++ /dev/null @@ -1,1123 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*- -;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab: - -;;;; -;;; CMPSYSFUN Database for system functions. -;;; -;;; Copyright (c) 2003, Juan Jose Garcia Ripoll -;;; Copyright (c) 1991, Giuseppe Attardi. All rights reserved. -;;; Copying of this file is authorized to users who have executed the true -;;; and proper "License Agreement for ECoLisp". -;;; -;;; DATABASE OF INLINE EXPANSIONS -;;; -;;; (DEF-INLINE function-name kind ([arg-type]*) return-rep-type -;;; expansion-string) -;;; -;;; Here, ARG-TYPE is the list of argument types belonging to the lisp family, -;;; while RETURN-REP-TYPE is a representation type, i.e. the C type of the -;;; output expression. EXPANSION-STRING is a C/C++ expression template, like the -;;; ones used by C-INLINE. Finally, KIND can be :ALWAYS, :SAFE or :UNSAFE, -;;; depending on whether the inline expression should be applied always, in safe -;;; or in unsafe compilation mode, respectively. -;;; - -(in-package "COMPILER") - -(eval-when (:compile-toplevel :execute) -(defparameter +inline-forms+ '( -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; ALL FUNCTION DECLARATIONS AND INLINE FORMS -;;; - -(def-inline cl:aref :unsafe (t t t) t "@0;ecl_aref_unsafe(#0,ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2))") -(def-inline cl:aref :unsafe ((array t) t t) t "@0;(#0)->array.self.t[ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2)]") -(def-inline cl:aref :unsafe ((array bit) t t) :fixnum "@0;ecl_aref_bv(#0,ecl_fixnum(#1)*(#0)->array.dims[1]+ecl_fixnum(#2))") -(def-inline cl:aref :unsafe ((array t) fixnum fixnum) t "@0;(#0)->array.self.t[#1*(#0)->array.dims[1]+#2]") -(def-inline cl:aref :unsafe ((array bit) fixnum fixnum) :fixnum "@0;ecl_aref_bv(#0,(#1)*(#0)->array.dims[1]+#2)") -(def-inline cl:aref :unsafe ((array base-char) fixnum fixnum) :unsigned-char "@0;(#0)->base_string.self[#1*(#0)->array.dims[1]+#2]") -(def-inline cl:aref :unsafe ((array double-float) fixnum fixnum) :double "@0;(#0)->array.self.df[#1*(#0)->array.dims[1]+#2]") -(def-inline cl:aref :unsafe ((array single-float) fixnum fixnum) :float "@0;(#0)->array.self.sf[#1*(#0)->array.dims[1]+#2]") -(def-inline cl:aref :unsafe ((array long-float) fixnum fixnum) :long-double "@0;(#0)->array.self.lf[#1*(#0)->array.dims[1]+#2]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-single-float) fixnum fixnum) :csfloat "@0;(#0)->array.self.csf[#1*(#0)->array.dims[1]+#2]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-double-float) fixnum fixnum) :cdfloat "@0;(#0)->array.self.cdf[#1*(#0)->array.dims[1]+#2]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-long-float) fixnum fixnum) :clfloat "@0;(#0)->array.self.clf[#1*(#0)->array.dims[1]+#2]") - -(def-inline cl:aref :unsafe ((array fixnum) fixnum fixnum) :fixnum "@0;(#0)->array.self.fix[#1*(#0)->array.dims[1]+#2]") - -(def-inline cl:aref :always (t t) t "ecl_aref1(#0,ecl_to_size(#1))") -(def-inline cl:aref :always (t fixnum) t "ecl_aref1(#0,#1)") -(def-inline cl:aref :unsafe (t t) t "ecl_aref1(#0,ecl_fixnum(#1))") -(def-inline cl:aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") -(def-inline cl:aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") -#+unicode -(def-inline cl:aref :unsafe ((array character) fixnum) :wchar "(#0)->string.self[#1]") -(def-inline cl:aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]") -(def-inline cl:aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]") -(def-inline cl:aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]") -(def-inline cl:aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-single-float) fixnum) :csfloat "(#0)->array.self.csf[#1]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-double-float) fixnum) :cdfloat "(#0)->array.self.cdf[#1]") -#+complex-float (def-inline cl:aref :unsafe ((array si:complex-long-float) fixnum) :clfloat "(#0)->array.self.clf[#1]") -(def-inline cl:aref :unsafe ((array fixnum) fixnum) :fixnum "(#0)->array.self.fix[#1]") - -(def-inline cl:row-major-aref :always (t t) t "ecl_aref(#0,ecl_to_size(#1))") -(def-inline cl:row-major-aref :always (t fixnum) t "ecl_aref(#0,#1)") -(def-inline cl:row-major-aref :unsafe (t t) t "ecl_aref_unsafe(#0,ecl_fixnum(#1))") -(def-inline cl:row-major-aref :unsafe (t fixnum) t "ecl_aref_unsafe(#0,#1)") -(def-inline cl:row-major-aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") -(def-inline cl:row-major-aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") -#+unicode -(def-inline cl:row-major-aref :unsafe ((array character) fixnum) :wchar "(#0)->string.self[#1]") -(def-inline cl:row-major-aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:byte8) fixnum) :uint8-t "(#0)->vector.self.b8[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:integer8) fixnum) :int8-t "(#0)->vector.self.i8[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:byte16) fixnum) :uint16-t "(#0)->vector.self.b16[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:integer16) fixnum) :int16-t "(#0)->vector.self.i16[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:byte32) fixnum) :uint32-t "(#0)->vector.self.b32[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:integer32) fixnum) :int32-t "(#0)->vector.self.i32[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:byte64) fixnum) :uint64-t "(#0)->vector.self.b64[#1]") -(def-inline cl:row-major-aref :unsafe ((array ext:integer64) fixnum) :int64-t "(#0)->vector.self.i64[#1]") -(def-inline cl:row-major-aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]") -(def-inline cl:row-major-aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]") -(def-inline cl:row-major-aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]") -#+complex-float (def-inline cl:row-major-aref :unsafe ((array si:complex-single-float) fixnum) :csfloat "(#0)->array.self.csf[#1]") -#+complex-float (def-inline cl:row-major-aref :unsafe ((array si:complex-double-float) fixnum) :cdfloat "(#0)->array.self.cdf[#1]") -#+complex-float (def-inline cl:row-major-aref :unsafe ((array si:complex-long-float) fixnum) :clfloat "(#0)->array.self.clf[#1]") -(def-inline cl:row-major-aref :unsafe ((array fixnum) fixnum) :fixnum "(#0)->array.self.fix[#1]") - -(def-inline si:row-major-aset :always (t t t) t "ecl_aset(#0,ecl_to_size(#1),#2)") -(def-inline si:row-major-aset :always (t fixnum t) t "ecl_aset(#0,#1,#2)") -(def-inline si:row-major-aset :unsafe (t t t) t "ecl_aset_unsafe(#0,ecl_fixnum(#1),#2)") -(def-inline si:row-major-aset :unsafe (t fixnum t) t "ecl_aset_unsafe(#0,#1,#2)") -(def-inline si:row-major-aset :unsafe ((array t) fixnum t) t "(#0)->vector.self.t[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array bit) fixnum t) :fixnum "ecl_aset_bv(#0,#1,ecl_fixnum(#2))") -(def-inline si:row-major-aset :unsafe ((array bit) fixnum fixnum) :fixnum "ecl_aset_bv(#0,#1,#2)") -(def-inline si:row-major-aset :unsafe ((array base-char) fixnum base-char) :unsigned-char "(#0)->base_string.self[#1]= #2") -#+unicode -(def-inline si:row-major-aset :unsafe ((array character) fixnum character) :wchar "(#0)->string.self[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:byte8) fixnum ext:byte8) :uint8-t "(#0)->vector.self.b8[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:integer8) fixnum ext:integer8) :int8-t "(#0)->vector.self.i8[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:byte16) fixnum ext:byte16) :uint16-t "(#0)->vector.self.b16[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:integer16) fixnum ext:integer16) :int16-t "(#0)->vector.self.i16[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:byte32) fixnum ext:byte32) :uint32-t "(#0)->vector.self.b32[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:integer32) fixnum ext:integer32) :int32-t "(#0)->vector.self.i32[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:byte64) fixnum ext:byte64) :uint64-t "(#0)->vector.self.b64[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array ext:integer64) fixnum ext:integer64) :int64-t "(#0)->vector.self.i64[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array long-float) fixnum long-float) :long-double "(#0)->array.self.lf[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array double-float) fixnum double-float) :double "(#0)->array.self.df[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array single-float) fixnum single-float) :float "(#0)->array.self.sf[#1]= #2") -#+complex-float (def-inline si:row-major-aset :unsafe ((array si:complex-single-float) fixnum si:complex-single-float) :csfloat "(#0)->array.self.csf[#1]= #2") -#+complex-float (def-inline si:row-major-aset :unsafe ((array si:complex-double-float) fixnum si:complex-double-float) :cdfloat "(#0)->array.self.cdf[#1]= #2") -#+complex-float (def-inline si:row-major-aset :unsafe ((array si:complex-long-float) fixnum si:complex-long-float) :clfloat "(#0)->array.self.clf[#1]= #2") -(def-inline si:row-major-aset :unsafe ((array fixnum) fixnum fixnum) :fixnum "(#0)->array.self.fix[#1]= #2") - -(def-inline si:copy-subarray :always (array ext:array-index array ext:array-index - ext:array-index) array - "@0;(ecl_copy_subarray(#0,#1,#2,#3,#4),#0)") - -(def-inline cl:array-rank :unsafe (array) :fixnum - "@0;(((#0)->d.t == t_array)?(#0)->array.rank:1)") -(def-inline cl:array-rank :always (array) :fixnum - "ecl_array_rank(#0)") - -(def-inline cl:array-dimension :always (t t) fixnum - "ecl_array_dimension(#0,ecl_to_size(#1))") -(def-inline cl:array-dimension :always (t fixnum) fixnum - "ecl_array_dimension(#0,#1)") - -(def-inline cl:array-total-size :unsafe (t) :fixnum "((#0)->array.dim)") - -(def-inline cl:adjustable-array-p :always (t) :bool "@0;(ECL_ARRAYP(#0)? (void)0: FEtype_error_array(#0),ECL_ADJUSTABLE_ARRAY_P(#0))") -(def-inline cl:adjustable-array-p :unsafe (array) :bool "ECL_ADJUSTABLE_ARRAY_P(#0)") - -(def-inline cl:svref :always (t t) t "ecl_aref1(#0,ecl_to_size(#1))") -(def-inline cl:svref :always (t fixnum) t "ecl_aref1(#0,#1)") -(def-inline cl:svref :unsafe (t t) t "(#0)->vector.self.t[ecl_fixnum(#1)]") -(def-inline cl:svref :unsafe (t fixnum) t "(#0)->vector.self.t[#1]") - -(def-inline si:svset :always (t t t) t "ecl_aset1(#0,ecl_to_size(#1),#2)") -(def-inline si:svset :always (t fixnum t) t "ecl_aset1(#0,#1,#2)") -(def-inline si:svset :unsafe (t t t) t "((#0)->vector.self.t[ecl_fixnum(#1)]=(#2))") -(def-inline si:svset :unsafe (t fixnum t) t "(#0)->vector.self.t[#1]= #2") - -(def-inline cl:array-has-fill-pointer-p :always (t) :bool "@0;(ECL_ARRAYP(#0)?(void)0:FEtype_error_array(#0),ECL_ARRAY_HAS_FILL_POINTER_P(#0))") -(def-inline cl:array-has-fill-pointer-p :unsafe (array) :bool "ECL_ARRAY_HAS_FILL_POINTER_P(#0)") - -(def-inline cl:fill-pointer :unsafe (t) :fixnum "((#0)->vector.fillp)") - - -(def-inline si:fill-pointer-set :unsafe (t fixnum) :fixnum - "((#0)->vector.fillp)=(#1)") - -;; file character.d - -(def-inline cl:standard-char-p :always (character) :bool "ecl_standard_char_p(#0)") - -(def-inline cl:graphic-char-p :always (character) :bool "ecl_graphic_char_p(#0)") - -(def-inline cl:alpha-char-p :always (character) :bool "ecl_alpha_char_p(#0)") - -(def-inline cl:upper-case-p :always (character) :bool "ecl_upper_case_p(#0)") - -(def-inline cl:lower-case-p :always (character) :bool "ecl_lower_case_p(#0)") - -(def-inline cl:both-case-p :always (character) :bool "ecl_both_case_p(#0)") - -(def-inline cl:alphanumericp :always (character) :bool "ecl_alphanumericp(#0)") - -(def-inline cl:char= :always (t t) :bool "ecl_char_code(#0)==ecl_char_code(#1)") -(def-inline cl:char= :always (character character) :bool "(#0)==(#1)") - -(def-inline cl:char/= :always (t t) :bool "ecl_char_code(#0)!=ecl_char_code(#1)") -(def-inline cl:char/= :always (character character) :bool "(#0)!=(#1)") - -(def-inline cl:char< :always (character character) :bool "(#0)<(#1)") - -(def-inline cl:char> :always (character character) :bool "(#0)>(#1)") - -(def-inline cl:char<= :always (character character) :bool "(#0)<=(#1)") - -(def-inline cl:char>= :always (character character) :bool "(#0)>=(#1)") - -(def-inline cl:char-code :always (character) :fixnum "#0") - -(def-inline cl:code-char :always (fixnum) :wchar "#0") - -(def-inline cl:char-upcase :always (base-char) :unsigned-char "ecl_char_upcase(#0)") -(def-inline cl:char-upcase :always (character) :wchar "ecl_char_upcase(#0)") - -(def-inline cl:char-downcase :always (base-char) :unsigned-char "ecl_char_downcase(#0)") -(def-inline cl:char-downcase :always (character) :wchar "ecl_char_downcase(#0)") - -(def-inline cl:char-int :always (character) :fixnum "#0") - -;; file ffi.d - -(def-inline si:foreign-data-p :always (t) :bool "@0;ECL_FOREIGN_DATA_P(#0)") - -;; file file.d - -(def-inline cl:input-stream-p :always (stream) :bool "ecl_input_stream_p(#0)") - -(def-inline cl:output-stream-p :always (stream) :bool "ecl_output_stream_p(#0)") - -;; file hash.d - -(def-inline cl:gethash :always (t t t) t "ecl_gethash_safe(#0,#1,#2)" :multiple-values nil) -(def-inline cl:gethash :always (t t) t "ecl_gethash_safe(#0,#1,ECL_NIL)" :multiple-values nil) -(def-inline cl:hash-table-count :unsafe (hash-table) ext:array-index "ecl_hash_table_count(#0)") - -;; file list.d - -(def-inline cl:car :unsafe (cons) t "ECL_CONS_CAR(#0)") -(def-inline cl:car :unsafe (t) t "_ecl_car(#0)") - -(def-inline si:cons-car :always (t) t "_ecl_car(#0)") -(def-inline si:cons-car :unsafe (t) t "ECL_CONS_CAR(#0)") - -(def-inline cl:cdr :unsafe (cons) t "ECL_CONS_CDR(#0)") -(def-inline cl:cdr :unsafe (t) t "_ecl_cdr(#0)") - -(def-inline si:cons-cdr :always (t) t "_ecl_cdr(#0)") -(def-inline si:cons-cdr :unsafe (t) t "ECL_CONS_CDR(#0)") - -;; BEGIN-GENERATED (gen-cons-sysfun) - -(def-inline cl:car :always (t) t "ecl_car(#0)") -(def-inline cl:car :unsafe (t) t "_ecl_car(#0)") -(def-inline cl:cdr :always (t) t "ecl_cdr(#0)") -(def-inline cl:cdr :unsafe (t) t "_ecl_cdr(#0)") -(def-inline cl:caar :always (t) t "ecl_caar(#0)") -(def-inline cl:caar :unsafe (t) t "_ecl_caar(#0)") -(def-inline cl:cdar :always (t) t "ecl_cdar(#0)") -(def-inline cl:cdar :unsafe (t) t "_ecl_cdar(#0)") -(def-inline cl:cadr :always (t) t "ecl_cadr(#0)") -(def-inline cl:cadr :unsafe (t) t "_ecl_cadr(#0)") -(def-inline cl:cddr :always (t) t "ecl_cddr(#0)") -(def-inline cl:cddr :unsafe (t) t "_ecl_cddr(#0)") -(def-inline cl:caaar :always (t) t "ecl_caaar(#0)") -(def-inline cl:caaar :unsafe (t) t "_ecl_caaar(#0)") -(def-inline cl:cdaar :always (t) t "ecl_cdaar(#0)") -(def-inline cl:cdaar :unsafe (t) t "_ecl_cdaar(#0)") -(def-inline cl:cadar :always (t) t "ecl_cadar(#0)") -(def-inline cl:cadar :unsafe (t) t "_ecl_cadar(#0)") -(def-inline cl:cddar :always (t) t "ecl_cddar(#0)") -(def-inline cl:cddar :unsafe (t) t "_ecl_cddar(#0)") -(def-inline cl:caadr :always (t) t "ecl_caadr(#0)") -(def-inline cl:caadr :unsafe (t) t "_ecl_caadr(#0)") -(def-inline cl:cdadr :always (t) t "ecl_cdadr(#0)") -(def-inline cl:cdadr :unsafe (t) t "_ecl_cdadr(#0)") -(def-inline cl:caddr :always (t) t "ecl_caddr(#0)") -(def-inline cl:caddr :unsafe (t) t "_ecl_caddr(#0)") -(def-inline cl:cdddr :always (t) t "ecl_cdddr(#0)") -(def-inline cl:cdddr :unsafe (t) t "_ecl_cdddr(#0)") -(def-inline cl:caaaar :always (t) t "ecl_caaaar(#0)") -(def-inline cl:caaaar :unsafe (t) t "_ecl_caaaar(#0)") -(def-inline cl:cdaaar :always (t) t "ecl_cdaaar(#0)") -(def-inline cl:cdaaar :unsafe (t) t "_ecl_cdaaar(#0)") -(def-inline cl:cadaar :always (t) t "ecl_cadaar(#0)") -(def-inline cl:cadaar :unsafe (t) t "_ecl_cadaar(#0)") -(def-inline cl:cddaar :always (t) t "ecl_cddaar(#0)") -(def-inline cl:cddaar :unsafe (t) t "_ecl_cddaar(#0)") -(def-inline cl:caadar :always (t) t "ecl_caadar(#0)") -(def-inline cl:caadar :unsafe (t) t "_ecl_caadar(#0)") -(def-inline cl:cdadar :always (t) t "ecl_cdadar(#0)") -(def-inline cl:cdadar :unsafe (t) t "_ecl_cdadar(#0)") -(def-inline cl:caddar :always (t) t "ecl_caddar(#0)") -(def-inline cl:caddar :unsafe (t) t "_ecl_caddar(#0)") -(def-inline cl:cdddar :always (t) t "ecl_cdddar(#0)") -(def-inline cl:cdddar :unsafe (t) t "_ecl_cdddar(#0)") -(def-inline cl:caaadr :always (t) t "ecl_caaadr(#0)") -(def-inline cl:caaadr :unsafe (t) t "_ecl_caaadr(#0)") -(def-inline cl:cdaadr :always (t) t "ecl_cdaadr(#0)") -(def-inline cl:cdaadr :unsafe (t) t "_ecl_cdaadr(#0)") -(def-inline cl:cadadr :always (t) t "ecl_cadadr(#0)") -(def-inline cl:cadadr :unsafe (t) t "_ecl_cadadr(#0)") -(def-inline cl:cddadr :always (t) t "ecl_cddadr(#0)") -(def-inline cl:cddadr :unsafe (t) t "_ecl_cddadr(#0)") -(def-inline cl:caaddr :always (t) t "ecl_caaddr(#0)") -(def-inline cl:caaddr :unsafe (t) t "_ecl_caaddr(#0)") -(def-inline cl:cdaddr :always (t) t "ecl_cdaddr(#0)") -(def-inline cl:cdaddr :unsafe (t) t "_ecl_cdaddr(#0)") -(def-inline cl:cadddr :always (t) t "ecl_cadddr(#0)") -(def-inline cl:cadddr :unsafe (t) t "_ecl_cadddr(#0)") -(def-inline cl:cddddr :always (t) t "ecl_cddddr(#0)") -(def-inline cl:cddddr :unsafe (t) t "_ecl_cddddr(#0)") -;; END-GENERATED - -(def-inline cl:cons :always (t t) t "CONS(#0,#1)") - -(def-inline cl:endp :safe (t) :bool "ecl_endp(#0)") -(def-inline cl:endp :unsafe (t) :bool "#0==ECL_NIL") - -(def-inline cl:nth :always (t t) t "ecl_nth(ecl_to_size(#0),#1)") -(def-inline cl:nth :always (fixnum t) t "ecl_nth(#0,#1)") -(def-inline cl:nth :unsafe (t t) t "ecl_nth(ecl_fixnum(#0),#1)") -(def-inline cl:nth :unsafe (fixnum t) t "ecl_nth(#0,#1)") - -(def-inline cl:nthcdr :always (t t) t "ecl_nthcdr(ecl_to_size(#0),#1)") -(def-inline cl:nthcdr :always (fixnum t) t "ecl_nthcdr(#0,#1)") -(def-inline cl:nthcdr :unsafe (t t) t "ecl_nthcdr(ecl_fixnum(#0),#1)") -(def-inline cl:nthcdr :unsafe (fixnum t) t "ecl_nthcdr(#0,#1)") - -(def-inline cl:last :always (t) t "ecl_last(#0,1)") - -(def-inline cl:list :always nil t "ECL_NIL") -(def-inline cl:list :always (t) t "ecl_list1(#0)") - -(def-inline cl:list* :always (t) t "#0") -(def-inline cl:list* :always (t t) t "CONS(#0,#1)") - -(def-inline cl:append :always (t t) t "ecl_append(#0,#1)") - -(def-inline cl:nconc :always (t t) t "ecl_nconc(#0,#1)") - -(def-inline cl:butlast :always (t) t "ecl_butlast(#0,1)") - -(def-inline cl:nbutlast :always (t) t "ecl_nbutlast(#0,1)") - -;; file num_arith.d - -(def-inline cl:1+ :always (t) t "ecl_one_plus(#0)") -(def-inline cl:1+ :always (fixnum) t "ecl_make_integer((#0)+1)") -(def-inline cl:1+ :always (long-float) :long-double "(long double)(#0)+1") -(def-inline cl:1+ :always (double-float) :double "(double)(#0)+1") -(def-inline cl:1+ :always (single-float) :float "(float)(#0)+1") -#+complex-float (def-inline cl:1+ :always (si:complex-single-float) :csfloat "(_Complex float)(#0)+1") -#+complex-float (def-inline cl:1+ :always (si:complex-double-float) :cdfloat "(_Complex double)(#0)+1") -#+complex-float (def-inline cl:1+ :always (si:complex-long-float) :clfloat "(_Complex long double)(#0)+1") -(def-inline cl:1+ :always (fixnum) :fixnum "(#0)+1" :exact-return-type t) - -(def-inline cl:1- :always (t) t "ecl_one_minus(#0)") -(def-inline cl:1- :always (fixnum) t "ecl_make_integer((#0)-1)") -(def-inline cl:1- :always (long-float) :long-double "(long double)(#0)-1") -(def-inline cl:1- :always (double-float) :double "(double)(#0)-1") -(def-inline cl:1- :always (single-float) :float "(float)(#0)-1") -#+complex-float (def-inline cl:1- :always (si:complex-single-float) :csfloat "(_Complex float)(#0)-1") -#+complex-float (def-inline cl:1- :always (si:complex-double-float) :cdfloat "(_Complex double)(#0)-1") -#+complex-float (def-inline cl:1- :always (si:complex-long-float) :clfloat "(_Complex long double)(#0)-1") -(def-inline cl:1- :always (fixnum) :fixnum "(#0)-1" :exact-return-type t) - -;; file num_co.d - -(def-inline cl:float :always (t single-float) :float "ecl_to_float(#0)") -(def-inline cl:float :always (t double-float) :double "ecl_to_double(#0)") -(def-inline cl:float :always (t long-float) :long-double "ecl_to_long_double(#0)") -(def-inline cl:float :always (fixnum-float) :long-double "((long double)(#0))" :exact-return-type t) -(def-inline cl:float :always (fixnum-float) :double "((double)(#0))" :exact-return-type t) -(def-inline cl:float :always (fixnum-float) :float "((float)(#0))" :exact-return-type t) - -(def-inline cl:numerator :unsafe (integer) integer "(#0)") -(def-inline cl:numerator :unsafe (ratio) integer "(#0)->ratio.num") - -(def-inline cl:denominator :unsafe (integer) integer "ecl_make_fixnum(1)") -(def-inline cl:denominator :unsafe (ratio) integer "(#0)->ratio.den") - -(def-inline cl:floor :always (t) (values &rest t) "ecl_floor1(#0)") -(def-inline cl:floor :always (t t) (values &rest t) "ecl_floor2(#0,#1)") -#+(or) ; does not work well, no multiple values -(def-inline cl:floor :always (fixnum fixnum) :fixnum - "@01;(#0>=0&>0?(#0)/(#1):ecl_ifloor(#0,#1))") - -(def-inline cl:ceiling :always (t) (values &rest t) "ecl_ceiling1(#0)") -(def-inline cl:ceiling :always (t t) (values &rest t) "ecl_ceiling2(#0,#1)") - -(def-inline cl:truncate :always (t) (values &rest t) "ecl_truncate1(#0)") -(def-inline cl:truncate :always (t t) (values &rest t) "ecl_truncate2(#0,#1)") -#+(or) ; does not work well, no multiple values -(def-inline cl:truncate :always (fixnum-float) :fixnum "(cl_fixnum)(#0)") - -(def-inline cl:round :always (t) (values &rest t) "ecl_round1(#0)") -(def-inline cl:round :always (t t) (values &rest t) "ecl_round2(#0,#1)") - -(def-inline cl:mod :always (t t) t "(ecl_floor2(#0,#1),cl_env_copy->values[1])") -(def-inline cl:mod :always (fixnum fixnum) :fixnum - "@01;(#0>=0&>0?(#0)%(#1):ecl_imod(#0,#1))") - -(def-inline cl:rem :always (t t) t "(ecl_truncate2(#0,#1),cl_env_copy->values[1])") -(def-inline cl:rem :always (fixnum fixnum) :fixnum "(#0)%(#1)") - -(def-inline cl:= :always (t t) :bool "ecl_number_equalp(#0,#1)") -(def-inline cl:= :always (fixnum-float fixnum-float) :bool "(#0)==(#1)") - -(def-inline cl:/= :always (t t) :bool "!ecl_number_equalp(#0,#1)") -(def-inline cl:/= :always (fixnum-float fixnum-float) :bool "(#0)!=(#1)") - -(def-inline cl:< :always (t t) :bool "ecl_lower(#0,#1)") -(def-inline cl:< :always (fixnum-float fixnum-float) :bool "(#0)<(#1)") -(def-inline cl:< :always (fixnum-float fixnum-float fixnum-float) :bool - "@012;((#0)<(#1) && (#1)<(#2))") - -(def-inline cl:> :always (t t) :bool "ecl_greater(#0,#1)") -(def-inline cl:> :always (fixnum-float fixnum-float) :bool "(#0)>(#1)") -(def-inline cl:> :always (fixnum-float fixnum-float fixnum-float) :bool - "@012;((#0)>(#1) && (#1)>(#2))") - -(def-inline cl:<= :always (t t) :bool "ecl_lowereq(#0,#1)") -(def-inline cl:<= :always (fixnum-float fixnum-float) :bool "(#0)<=(#1)") -(def-inline cl:<= :always (fixnum-float fixnum-float fixnum-float) :bool - "@012;((#0)<=(#1) && (#1)<=(#2))") - -(def-inline cl:>= :always (t t) :bool "ecl_greatereq(#0,#1)") -(def-inline cl:>= :always (fixnum-float fixnum-float) :bool "(#0)>=(#1)") -(def-inline cl:>= :always (fixnum-float fixnum-float fixnum-float) :bool - "@012;((#0)>=(#1) && (#1)>=(#2))") - -#+ieee-floating-point (def-inline cl:max :always (t t) t "@01;((ecl_float_nan_p(#1) || ecl_greatereq(#0,#1))?#0:#1)") -#-ieee-floating-point (def-inline cl:max :always (t t) t "@01;(ecl_greatereq(#0,#1)?#0:#1)") -(def-inline cl:max :always (fixnum fixnum) :fixnum "@01;(#0)>=(#1)?#0:#1") - -#+ieee-floating-point (def-inline cl:min :always (t t) t "@01;((ecl_float_nan_p(#1) || ecl_lowereq(#0,#1))?#0:#1)") -#-ieee-floating-point (def-inline cl:min :always (t t) t "@01;(ecl_lowereq(#0,#1)?#0:#1)") -(def-inline cl:min :always (fixnum fixnum) :fixnum "@01;(#0)<=(#1)?#0:#1") - -;; file num_log.d - -(def-inline cl:logand :always nil t "ecl_make_fixnum(-1)") -(def-inline cl:logand :always nil :fixnum "-1") -(def-inline cl:logand :always (t t) t "ecl_boole(ECL_BOOLAND,(#0),(#1))") -(def-inline cl:logand :always (fixnum fixnum) :fixnum "((#0) & (#1))") - -(def-inline cl:logandc1 :always (t t) t "ecl_boole(ECL_BOOLANDC1,(#0),(#1))") -(def-inline cl:logandc1 :always (fixnum fixnum) :fixnum "(~(#0) & (#1))") - -(def-inline cl:logandc2 :always (t t) t "ecl_boole(ECL_BOOLANDC2,(#0),(#1))") -(def-inline cl:logandc2 :always (fixnum fixnum) :fixnum "((#0) & ~(#1))") - -(def-inline cl:logeqv :always nil t "ecl_make_fixnum(-1)") -(def-inline cl:logeqv :always nil :fixnum "-1") -(def-inline cl:logeqv :always (t t) t "ecl_boole(ECL_BOOLEQV,(#0),(#1))") -(def-inline cl:logeqv :always (fixnum fixnum) :fixnum "(~( (#0) ^ (#1) ))") - -(def-inline cl:logior :always nil t "ecl_make_fixnum(0)") -(def-inline cl:logior :always nil :fixnum "0") -(def-inline cl:logior :always (t t) t "ecl_boole(ECL_BOOLIOR,(#0),(#1))") -(def-inline cl:logior :always (fixnum fixnum) :fixnum "((#0) | (#1))") - -(def-inline cl:lognand :always (t t) t "ecl_boole(ECL_BOOLNAND,(#0),(#1))") -(def-inline cl:lognand :always (fixnum fixnum) :fixnum "(~( (#0) & (#1) ))") - -(def-inline cl:lognor :always (t t) t "ecl_boole(ECL_BOOLNOR,(#0),(#1))") -(def-inline cl:lognor :always (fixnum fixnum) :fixnum "(~( (#0) | (#1) ))") - -(def-inline cl:lognot :always (t) t "ecl_boole(ECL_BOOLXOR,(#0),ecl_make_fixnum(-1))") -(def-inline cl:lognot :always (fixnum) :fixnum "(~(#0))") - -(def-inline cl:logorc1 :always (t t) t "ecl_boole(ECL_BOOLORC1,(#0),(#1))") -(def-inline cl:logorc1 :always (fixnum fixnum) :fixnum "(~(#0) | (#1))") - -(def-inline cl:logorc2 :always (t t) t "ecl_boole(ECL_BOOLORC2,(#0),(#1))") -(def-inline cl:logorc2 :always (fixnum fixnum) :fixnum "((#0) | ~(#1))") - -(def-inline cl:logxor :always nil t "ecl_make_fixnum(0)") -(def-inline cl:logxor :always nil :fixnum "0") -(def-inline cl:logxor :always (t t) t "ecl_boole(ECL_BOOLXOR,(#0),(#1))") -(def-inline cl:logxor :always (fixnum fixnum) :fixnum "((#0) ^ (#1))") - -(def-inline cl:boole :always (fixnum t t) t "ecl_boole((#0),(#1),(#2))") - -(def-inline cl:logbitp :always ((integer -29 29) fixnum) :bool "(#1 >> #0) & 1") - -(def-inline cl:integer-length :always (t) :cl-index "ecl_integer_length(#0)") - -(def-inline cl:zerop :always (t) :bool "ecl_zerop(#0)") -(def-inline cl:zerop :always (fixnum-float) :bool "(#0)==0") - -(def-inline cl:plusp :always (t) :bool "ecl_plusp(#0)") -(def-inline cl:plusp :always (fixnum-float) :bool "(#0)>0") - -(def-inline cl:minusp :always (t) :bool "ecl_minusp(#0)") -(def-inline cl:minusp :always (fixnum-float) :bool "(#0)<0") - -(def-inline cl:oddp :always (t) :bool "ecl_oddp(#0)") -(def-inline cl:oddp :always (fixnum fixnum) :bool "(#0) & 1") - -(def-inline cl:evenp :always (t) :bool "ecl_evenp(#0)") -(def-inline cl:evenp :always (fixnum fixnum) :bool "~(#0) & 1") - -(def-inline cl:abs :always (t t) t "ecl_abs(#0,#1)") - -(def-inline cl:exp :always (t) t "ecl_exp(#0)") - -(def-inline cl:expt :always (t t) t "ecl_expt(#0,#1)") -(def-inline cl:expt :always ((integer 2 2) (integer 0 29)) :fixnum "(1<<(#1))") -(def-inline cl:expt :always ((integer 0 0) t) :fixnum "0") -(def-inline cl:expt :always ((integer 1 1) t) :fixnum "1") -(def-inline cl:expt :always ((long-float 0.0l0 *) long-float) :long-double "powl((long double)#0,(long double)#1)") -(def-inline cl:expt :always ((double-float 0.0d0 *) double-float) :double "pow((double)#0,(double)#1)") -(def-inline cl:expt :always ((single-float 0.0f0 *) single-float) :float "powf((float)#0,(float)#1)") -#+complex-float (def-inline cl:expt :always (si:complex-single-float si:complex-single-float) :csfloat "cpowf(#0,#1)") -#+complex-float (def-inline cl:expt :always (si:complex-double-float si:complex-double-float) :cdfloat "cpow(#0,#1)") -#+complex-float (def-inline cl:expt :always (si:complex-long-float si:complex-long-float) :clfloat "cpowl(#0,#1)") - -(def-inline cl:log :always (fixnum-float) :long-double "logl((long double)(#0))" :exact-return-type t) -(def-inline cl:log :always (fixnum-float) :double "log((double)(#0))" :exact-return-type t) -(def-inline cl:log :always (fixnum-float) :float "logf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:log :always (si:complex-single-float) :csfloat "clogf(#0)") -#+complex-float (def-inline cl:log :always (si:complex-double-float) :cdfloat "clog(#0)") -#+complex-float (def-inline cl:log :always (si:complex-long-float) :clfloat "clogl(#0)") - -(def-inline cl:sqrt :always (number) number "ecl_sqrt(#0)") -(def-inline cl:sqrt :always ((long-float 0.0l0 *)) :long-double "sqrtl((long double)(#0))") -(def-inline cl:sqrt :always ((double-float 0.0d0 *)) :double "sqrt((double)(#0))") -(def-inline cl:sqrt :always ((single-float 0.0f0 *)) :float "sqrtf((float)(#0))") -#+complex-float (def-inline cl:sqrt :always (si:complex-single-float) :csfloat "csqrtf(#0)") -#+complex-float (def-inline cl:sqrt :always (si:complex-double-float) :cdfloat "csqrt(#0)") -#+complex-float (def-inline cl:sqrt :always (si:complex-long-float) :clfloat "csqrtl(#0)") - -(def-inline cl:sin :always (number) number "ecl_sin(#0)") -(def-inline cl:sin :always (fixnum-float) :long-double "sinl((long double)(#0))" :exact-return-type t) -(def-inline cl:sin :always (fixnum-float) :double "sin((double)(#0))" :exact-return-type t) -(def-inline cl:sin :always (fixnum-float) :float "sinf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:sin :always (si:complex-single-float) :csfloat "csinf(#0)") -#+complex-float (def-inline cl:sin :always (si:complex-double-float) :cdfloat "csin(#0)") -#+complex-float (def-inline cl:sin :always (si:complex-long-float) :clfloat "csinl(#0)") - -(def-inline cl:cos :always (t) number "ecl_cos(#0)") -(def-inline cl:cos :always (fixnum-float) :long-double "cosl((long double)(#0))" :exact-return-type t) -(def-inline cl:cos :always (fixnum-float) :double "cos((double)(#0))" :exact-return-type t) -(def-inline cl:cos :always (fixnum-float) :float "cosf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:cos :always (si:complex-single-float) :csfloat "ccosf(#0)") -#+complex-float (def-inline cl:cos :always (si:complex-double-float) :cdfloat "ccos(#0)") -#+complex-float (def-inline cl:cos :always (si:complex-long-float) :clfloat "ccosl(#0)") - -(def-inline cl:tan :always (t) number "ecl_tan(#0)") -(def-inline cl:tan :always (fixnum-float) :long-double "tanl((long double)(#0))" :exact-return-type t) -(def-inline cl:tan :always (fixnum-float) :double "tan((double)(#0))" :exact-return-type t) -(def-inline cl:tan :always (fixnum-float) :float "tanf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:tan :always (si:complex-single-float) :csfloat "ctanf(#0)") -#+complex-float (def-inline cl:tan :always (si:complex-double-float) :cdfloat "ctan(#0)") -#+complex-float (def-inline cl:tan :always (si:complex-long-float) :clfloat "ctanl(#0)") - -(def-inline cl:sinh :always (t) number "ecl_sinh(#0)") -(def-inline cl:sinh :always (fixnum-float) :long-double "sinhl((long double)(#0))" :exact-return-type t) -(def-inline cl:sinh :always (fixnum-float) :double "sinh((double)(#0))" :exact-return-type t) -(def-inline cl:sinh :always (fixnum-float) :float "sinhf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:sinh :always (si:complex-single-float) :csfloat "csinhf(#0)") -#+complex-float (def-inline cl:sinh :always (si:complex-double-float) :cdfloat "csinh(#0)") -#+complex-float (def-inline cl:sinh :always (si:complex-long-float) :clfloat "csinhl(#0)") - -(def-inline cl:cosh :always (t) number "ecl_cosh(#0)") -(def-inline cl:cosh :always (fixnum-float) :long-double "coshl((long double)(#0))" :exact-return-type t) -(def-inline cl:cosh :always (fixnum-float) :double "cosh((double)(#0))" :exact-return-type t) -(def-inline cl:cosh :always (fixnum-float) :float "coshf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:cosh :always (si:complex-single-float) :csfloat "ccoshf(#0)") -#+complex-float (def-inline cl:cosh :always (si:complex-double-float) :cdfloat "ccosh(#0)") -#+complex-float (def-inline cl:cosh :always (si:complex-long-float) :clfloat "ccoshl(#0)") - -(def-inline cl:tanh :always (t) number "ecl_tanh(#0)") -(def-inline cl:tanh :always (fixnum-float) :long-double "tanhl((long double)(#0))" :exact-return-type t) -(def-inline cl:tanh :always (fixnum-float) :double "tanh((double)(#0))" :exact-return-type t) -(def-inline cl:tanh :always (fixnum-float) :float "tanhf((float)(#0))" :exact-return-type t) -#+complex-float (def-inline cl:tanh :always (si:complex-single-float) :csfloat "ctanhf(#0)") -#+complex-float (def-inline cl:tanh :always (si:complex-double-float) :cdfloat "ctanh(#0)") -#+complex-float (def-inline cl:tanh :always (si:complex-long-float) :clfloat "ctanhl(#0)") - -;; file package.d - -;; file pathname.d - -(def-inline cl:null :always (t) :bool "#0==ECL_NIL") - -(def-inline cl:symbolp :always (t) :bool "@0;ECL_SYMBOLP(#0)") - -(def-inline cl:atom :always (t) :bool "@0;ECL_ATOM(#0)") - -(def-inline cl:consp :always (t) :bool "@0;ECL_CONSP(#0)") - -(def-inline cl:listp :always (t) :bool "@0;ECL_LISTP(#0)") - -(def-inline cl:numberp :always (t) :bool "ecl_numberp(#0)") - -(def-inline cl:integerp :always (t) :bool "@0;ECL_FIXNUMP(#0)||ECL_BIGNUMP(#0)") - -(def-inline cl:floatp :always (t) :bool "floatp(#0)") - -(def-inline cl:characterp :always (t) :bool "ECL_CHARACTERP(#0)") - -(def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_P(#0)") - -(def-inline cl:stringp :always (t) :bool "@0;ECL_STRINGP(#0)") - -(def-inline si:base-string-p :always (t) :bool "@0;ECL_BASE_STRING_P(#0)") - -(def-inline cl:bit-vector-p :always (t) :bool "@0;ECL_BIT_VECTOR_P(#0)") - -(def-inline cl:vectorp :always (t) :bool "@0;ECL_VECTORP(#0)") - -(def-inline cl:arrayp :always (t) :bool "@0;ECL_ARRAYP(#0)") - -(def-inline cl:eq :always (t t) :bool "(#0)==(#1)") -(def-inline cl:eq :always (fixnum fixnum) :bool "(#0)==(#1)") - -(def-inline cl:eql :always (t t) :bool "ecl_eql(#0,#1)") -(def-inline cl:eql :always (character t) :bool "(ECL_CODE_CHAR(#0)==(#1))") -(def-inline cl:eql :always (t character) :bool "((#0)==ECL_CODE_CHAR(#1))") -(def-inline cl:eql :always (character character) :bool "(#0)==(#1)") -(def-inline cl:eql :always ((not (or complex bignum ratio float)) t) :bool - "(#0)==(#1)") -(def-inline cl:eql :always (t (not (or complex bignum ratio float))) :bool - "(#0)==(#1)") -(def-inline cl:eql :always (fixnum fixnum) :bool "(#0)==(#1)") - -(def-inline cl:equal :always (t t) :bool "ecl_equal(#0,#1)") -(def-inline cl:equal :always (fixnum fixnum) :bool "(#0)==(#1)") - -(def-inline cl:equalp :always (t t) :bool "ecl_equalp(#0,#1)") -(def-inline cl:equalp :always (fixnum fixnum) :bool "(#0)==(#1)") - -(def-inline cl:not :always (t) :bool "(#0)==ECL_NIL") - -;; file print.d, read.d - -(def-inline cl:clear-output :always (stream) NULL "(ecl_clear_output(#0),ECL_NIL)") - -(def-inline cl:finish-output :always (stream) NULL "(ecl_finish_output(#0),ECL_NIL)") - -(def-inline cl:finish-output :always (stream) NULL "(ecl_force_output(#0),ECL_NIL)") - -(def-inline cl:write-char :always (t) t "@0;(ecl_princ_char(ecl_char_code(#0),ECL_NIL),(#0))") - -(def-inline cl:clear-input :always (stream) NULL "(ecl_clear_input(#0),ECL_NIL)") - -(def-inline cl:copy-readtable :always (null null) t "standard_readtable") - -(def-inline cl:boundp :always (t) :bool "ecl_boundp(cl_env_copy,#0)") -(def-inline cl:boundp :unsafe ((and symbol (not null))) :bool "ECL_SYM_VAL(cl_env_copy,#0)!=OBJNULL") - -;; file unixsys.d - -;; file sequence.d - -(def-inline cl:elt :always (t t) t "ecl_elt(#0,ecl_to_size(#1))") -(def-inline cl:elt :always (t fixnum) t "ecl_elt(#0,#1)") - -(def-inline cl:elt :unsafe (t t) t "ecl_elt(#0,ecl_fixnum(#1))") -(def-inline cl:elt :unsafe (t fixnum) t "ecl_elt(#0,#1)") -(def-inline cl:elt :unsafe (vector t) t "ecl_aref_unsafe(#0,ecl_fixnum(#1))") -(def-inline cl:elt :unsafe (vector fixnum) t "ecl_aref_unsafe(#0,#1)") -(def-inline cl:aref :unsafe ((array bit) t) :fixnum "ecl_aref_bv(#0,ecl_fixnum(#1))") -(def-inline cl:aref :unsafe ((array bit) fixnum) :fixnum "ecl_aref_bv(#0,#1)") -#+unicode -(def-inline cl:aref :unsafe ((array character) fixnum) :wchar - "(#0)->string.self[#1]") -(def-inline cl:aref :unsafe ((array base-char) fixnum) :unsigned-char - "(#0)->base_string.self[#1]") -(def-inline cl:aref :unsafe ((array double-float) fixnum) :double - "(#0)->array.self.df[#1]") -(def-inline cl:aref :unsafe ((array single-float) fixnum) :float - "(#0)->array.self.sf[#1]") -(def-inline cl:aref :unsafe ((array fixnum) fixnum) :fixnum - "(#0)->array.self.fix[#1]") - -(def-inline si:elt-set :always (t t t) t "ecl_elt_set(#0,ecl_to_size(#1),#2)") -(def-inline si:elt-set :always (t fixnum t) t "ecl_elt_set(#0,#1,#2)") - -(def-inline si:elt-set :unsafe (t t t) t "ecl_elt_set(#0,ecl_fixnum(#1),#2)") -(def-inline si:elt-set :unsafe (vector t t) t "ecl_aset_unsafe(#0,ecl_to_size(#1),#2)") -(def-inline si:elt-set :unsafe (vector fixnum t) t "ecl_aset_unsafe(#0,#1,#2)") - -(def-inline cl:length :always (t) :fixnum "ecl_length(#0)") -(def-inline cl:length :unsafe (vector) :fixnum "(#0)->vector.fillp") - -(def-inline cl:copy-seq :always (t) t "ecl_copy_seq(#0)") - -;; file character.d - -(def-inline cl:char :always (t fixnum) t "ecl_aref1(#0,#1)") -(def-inline cl:char :always (t fixnum) :wchar "ecl_char(#0,#1)") -#-unicode -(def-inline cl:char :unsafe (t t) t "ECL_CODE_CHAR((#0)->base_string.self[ecl_fixnum(#1)])") -#-unicode -(def-inline cl:char :unsafe (t fixnum) :unsigned-char "(#0)->base_string.self[#1]") -(def-inline cl:char :unsafe (base-string fixnum) :unsigned-char "(#0)->base_string.self[#1]") -#+unicode -(def-inline cl:char :unsafe (ext:extended-string fixnum) :wchar "(#0)->string.self[#1]") - -(def-inline si:char-set :always (t t t) t "si_char_set(#0,#1,#2)") -(def-inline si:char-set :always (t fixnum t) t "ecl_aset1(#0,#1,#2)") -(def-inline si:char-set :always (t fixnum character) :wchar "ecl_char_set(#0,#1,#2)") -#-unicode -(def-inline si:char-set :unsafe (t t t) t - "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") -#-unicode -(def-inline si:char-set :unsafe (t fixnum character) :unsigned-char - "(#0)->base_string.self[#1]= #2") -(def-inline si:char-set :unsafe (base-string t t) t - "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") -(def-inline si:char-set :unsafe (base-string fixnum base-char) :unsigned-char - "(#0)->base_string.self[#1]= #2") -(def-inline si:char-set :unsafe (ext:extended-string t t) t - "@2;((#0)->string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") -(def-inline si:char-set :unsafe (ext:extended-string fixnum character) :unsigned-char - "(#0)->string.self[#1]= #2") - -(def-inline cl:schar :always (t t) t "ecl_elt(#0,ecl_to_size(#1))") -(def-inline cl:schar :always (t fixnum) t "ecl_elt(#0,#1)") -(def-inline cl:schar :always (t fixnum) :wchar "ecl_char(#0,#1)") -(def-inline cl:schar :unsafe (base-string t) t "ECL_CODE_CHAR((#0)->base_string.self[ecl_fixnum(#1)])") -#-unicode -(def-inline cl:schar :unsafe (t fixnum) :unsigned-char "(#0)->base_string.self[#1]") -(def-inline cl:schar :unsafe (base-string fixnum) :unsigned-char "(#0)->base_string.self[#1]") -#+unicode -(def-inline cl:schar :unsafe (ext:extended-string fixnum) :wchar "(#0)->string.self[#1]") - -(def-inline si:schar-set :always (t t t) t "ecl_elt_set(#0,ecl_to_size(#1),#2)") -(def-inline si:schar-set :always (t fixnum t) t "ecl_elt_set(#0,#1,#2)") -(def-inline si:schar-set :always (t fixnum character) :wchar "ecl_char_set(#0,#1,#2)") -#-unicode -(def-inline si:schar-set :unsafe (t t t) t - "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") -#-unicode -(def-inline si:schar-set :unsafe (t fixnum base-char) :unsigned-char - "(#0)->base_string.self[#1]= #2") -(def-inline si:schar-set :unsafe (base-string t t) t - "@2;((#0)->base_string.self[ecl_fixnum(#1)]=ecl_char_code(#2),(#2))") -(def-inline si:schar-set :unsafe (base-string fixnum base-char) :unsigned-char - "(#0)->base_string.self[#1]= #2") -#+unicode -(def-inline si:schar-set :unsafe (ext:extended-string fixnum t) :wchar - "@2;((#0)->string.self[#1]= ecl_char_code(#2),(#2))") -#+unicode -(def-inline si:schar-set :unsafe (ext:extended-string fixnum character) :wchar - "(#0)->string.self[#1]= #2") - -(def-inline cl:string= :always (string string) :bool "ecl_string_eq(#0,#1)") - -;; file structure.d - -(def-inline si:structure-name :always (structure-object) symbol "ECL_STRUCT_NAME(#0)") - -(def-inline si:structure-ref :always (t t fixnum) t "ecl_structure_ref(#0,#1,#2)") - -(def-inline si:structure-set :always (t t fixnum t) t - "ecl_structure_set(#0,#1,#2,#3)") - -;; file symbol.d - -(def-inline cl:get :always (t t t) t "ecl_get(#0,#1,#2)") -(def-inline cl:get :always (t t) t "ecl_get(#0,#1,ECL_NIL)") - -(def-inline cl:symbol-name :always (t) string "ecl_symbol_name(#0)") - -;; Additions used by the compiler. -;; The following functions do not exist. They are always expanded into the -;; given C code. References to these functions are generated in the C1 phase. - -(def-inline shift>> :always (fixnum fixnum) :fixnum "((#0) >> (- (#1)))") - -(def-inline shift<< :always (fixnum fixnum) :fixnum "((#0) << (#1))") - -(def-inline si:short-float-p :always (t) :bool "@0;ECL_SINGLE_FLOAT_P(#0)") - -(def-inline si:single-float-p :always (t) :bool "@0;ECL_SINGLE_FLOAT_P(#0)") - -(def-inline si:double-float-p :always (t) :bool "@0;ECL_DOUBLE_FLOAT_P(#0)") - -(def-inline si:long-float-p :always (t) :bool "@0;ECL_LONG_FLOAT_P(#0)") - -#+complex-float -(def-inline si::complex-single-float-p :always (t) :bool "@0;ECL_COMPLEX_SINGLE_FLOAT_P(#0)") -#+complex-float -(def-inline si::complex-double-float-p :always (t) :bool "@0;ECL_COMPLEX_DOUBLE_FLOAT_P(#0)") -#+complex-float -(def-inline si::complex-long-float-p :always (t) :bool "@0;ECL_COMPLEX_LONG_FLOAT_P(#0)") - -(def-inline ext:fixnump :always (t) :bool "ECL_FIXNUMP(#0)") -(def-inline ext:fixnump :always (fixnum) :bool "1") - -;; Functions only available with threads -#+threads -(def-inline mp:lock-count :unsafe (mp:lock) fixnum "((#0)->lock.counter)") - -#+threads -(def-inline mp:compare-and-swap-car :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CAR(#0),(#1),(#2))") -#+threads -(def-inline mp:atomic-incf-car :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CAR(#0),(#1))") -#+threads -(def-inline mp:atomic-incf-car :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CAR(#0),(#1))") - -#+threads -(def-inline mp:compare-and-swap-cdr :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CDR(#0),(#1),(#2))") -#+threads -(def-inline mp:atomic-incf-cdr :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CDR(#0),(#1))") -#+threads -(def-inline mp:atomic-incf-cdr :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CDR(#0),(#1))") - -#+threads -(def-inline mp:compare-and-swap-symbol-value :unsafe (symbol t t) t "ecl_compare_and_swap(ecl_bds_ref(ecl_process_env(),(#0)),(#1),(#2))") -#+threads -(def-inline mp:atomic-incf-symbol-value :always (t fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") -#+threads -(def-inline mp:atomic-incf-symbol-value :unsafe (symbol t) t "ecl_atomic_incf(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") -#+threads -(def-inline mp:atomic-incf-symbol-value :unsafe (symbol fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))") - -#+threads -(def-inline mp:compare-and-swap-svref :unsafe (t t t t) t "ecl_compare_and_swap((#0)->vector.self.t + ecl_fixnum(#1),(#2),(#3))") -#+threads -(def-inline mp:compare-and-swap-svref :unsafe (t fixnum t t) t "ecl_compare_and_swap((#0)->vector.self.t + (#1),(#2),(#3))") - -#+(and threads clos) -(def-inline mp:compare-and-swap-instance :always (t fixnum t t) t "ecl_compare_and_swap_instance((#0),(#1),(#2),(#3))") -#+(and threads clos) -(def-inline mp:compare-and-swap-instance :unsafe (standard-object fixnum t t) t "ecl_compare_and_swap((#0)->instance.slots+(#1),(#2),(#3))") -#+(and threads clos) -(def-inline mp:atomic-incf-instance :always (t fixnum t) t "ecl_atomic_incf_instance((#0),(#1),(#2))") -#+(and threads clos) -(def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum t) t "ecl_atomic_incf((#0)->instance.slots+(#1),(#2))") -#+(and threads clos) -(def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum fixnum) t "ecl_atomic_incf_by_fixnum((#0)->instance.slots+(#1),(#2))") - -#+threads -(def-inline mp:compare-and-swap-structure :unsafe (structure-object t fixnum t t) t "ecl_compare_and_swap(&(ECL_STRUCT_SLOT((#0),(#2))),(#3),(#4))") - -;; Functions only available with CLOS - -#+clos -(def-inline si:instance-ref :always (t fixnum) t "ecl_instance_ref((#0),(#1))") -#+clos -(def-inline si:instance-ref :unsafe (standard-object fixnum) t - "(#0)->instance.slots[#1]") - -#+clos -(def-inline si::instance-slotds :unsafe (standard-object) list - "(#0)->instance.slotds") - -#+clos -(def-inline si:instance-set :unsafe (t fixnum t) t - "ecl_instance_set((#0),(#1),(#2))") -#+clos -(def-inline si:instance-set :unsafe (standard-object fixnum t) t - "(#0)->instance.slots[#1]=(#2)") - -#+clos -(def-inline si:instance-class :always (standard-object) t "ECL_CLASS_OF(#0)") -#+clos -(def-inline cl:class-of :unsafe (standard-object) t "ECL_CLASS_OF(#0)") - -#+clos -(def-inline si:instancep :always (t) :bool "@0;ECL_INSTANCEP(#0)") -#+clos -(def-inline si:unbound :always nil t "ECL_UNBOUND") - -#+clos -(def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND") - -#+clos -(def-inline clos:standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") -#+clos -(def-inline clos:standard-instance-access :unsafe (standard-object fixnum) t - "(#0)->instance.slots[#1]") - -#+clos -(def-inline clos:funcallable-standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") -#+clos -(def-inline clos:funcallable-standard-instance-access :unsafe (clos:funcallable-standard-object fixnum) t - "(#0)->instance.slots[#1]") - -))) ; eval-when - -(defun make-inline-information (*machine*) - (let ((*inline-information* (make-hash-table :size 512 :test 'equal))) - (loop for i in '#.(mapcar #'rest +inline-forms+) - do (apply #'def-inline i)) - *inline-information*)) - -(defun inline-information (name safety) - (gethash (list name safety) *inline-information*)) - -(defun (setf inline-information) (value name safety) - (setf (gethash (list name safety) *inline-information*) value)) - -(defun def-inline (name safety arg-types return-rep-type expansion - &key (one-liner t) (exact-return-type nil) (inline-or-warn nil) - (multiple-values t) - &aux arg-rep-types) - (setf safety - (case safety - (:unsafe :inline-unsafe) - (:safe :inline-safe) - (:always :inline-always) - (t (error "In DEF-INLINE, wrong value of SAFETY")))) - ;; Ensure we can inline this form. We only inline when the features are - ;; there (checked above) and when the C types are part of this machine - ;; (checked here). - (loop for type in (list* return-rep-type arg-types) - unless (or (eq type 'fixnum-float) - (and (consp type) (eq (car type) 'values)) - (lisp-type-p type) - (machine-c-type-p type)) - do (warn "Dropping inline form for ~A because of missing type ~A" name type) - (return-from def-inline)) - (setf arg-rep-types - (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->rep-type x))) - arg-types)) - (when (eq return-rep-type t) - (setf return-rep-type :object)) - (when inline-or-warn - (setf (inline-information name 'should-be-inlined) t)) - (let* ((return-type (if (and (consp return-rep-type) - (eq (first return-rep-type) 'values)) - t - (rep-type->lisp-type return-rep-type))) - (inline-info - (make-inline-info :name name - :arg-rep-types arg-rep-types - :return-rep-type return-rep-type - :return-type return-type - :arg-types arg-types - :exact-return-type exact-return-type - :multiple-values multiple-values - ;; :side-effects (not (si:get-sysprop name 'no-side-effects)) - :one-liner one-liner - :expansion expansion))) - #+(or) - (loop for i in (inline-information name safety) - when (and (equalp (inline-info-arg-types i) arg-types) - (not (equalp return-type (inline-info-return-type i)))) - do (format t "~&;;; Redundand inline definition for ~A~&;;; ~<~A~>~&;;; ~<~A~>" - name i inline-info)) - (push inline-info (gethash (list name safety) *inline-information*)))) - -(setf (machine-inline-information *default-machine*) - (make-inline-information *default-machine*)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; FUNCTIONS WHICH CAN BE CALLED FROM C -;;; -;;; The following two lists contain all functions in the core library which do -;;; not belong to the C part of the library, but which should have an exported C -;;; name that users (and compiled code) can refer to. This means, for instance, that -;;; MAKE-ARRAY will be compiled to a function called cl_make_array, etc. -;;; -;;; Note that if the created C function should take only fixed -;;; arguments, a proclamation for the function type must exist so that -;;; the compiler can produce the correct function signature! -;;; - -(in-package "SI") - -#+ecl-min -(defvar c::*in-all-symbols-functions* - ;; These functions are visible from external.h and their function - ;; objects are created in init_all_symbols from the data in - ;; symbols_list.h - `(;; arraylib.lsp - make-array vector array-dimensions array-in-bounds-p array-row-major-index - bit sbit bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 - bit-andc2 bit-orc1 bit-orc2 bit-not - vector-pop adjust-array - ;; assert.lsp - si::do-check-type si::ecase-error si::etypecase-error - si::wrong-type-argument si::ccase-error si::ctypecase-error - ;; config.lsp - short-site-name long-site-name machine-type machine-instance machine-version - software-type software-version lisp-implementation-type lisp-implementation-version - si::lisp-implementation-vcs-id - ;; assignment.lsp - si::setf-definition - ;; conditions.lsp - si::safe-eval abort continue muffle-warning store-value use-value - si::bind-simple-restarts si::bind-simple-handlers - si::assert-failure compute-restarts find-restart invoke-restart - invoke-restart-interactively make-condition - ;; describe.lsp - describe inspect - ;; iolib.lsp - read-from-string write-to-string prin1-to-string princ-to-string - y-or-n-p yes-or-no-p string-to-object dribble - ext:make-encoding ext:load-encoding - ;; listlib.lsp - union nunion intersection nintersection set-difference nset-difference - set-exclusive-or nset-exclusive-or subsetp rassoc-if rassoc-if-not - assoc-if assoc-if-not member-if member-if-not subst-if subst-if-not - nsubst-if nsubst-if-not - ;; mislib.lsp - logical-pathname-translations load-logical-pathname-translations decode-universal-time - encode-universal-time get-decoded-time - ensure-directories-exist si::simple-program-error si::signal-simple-error - ;; module.lsp - provide require - ;; numlib.lsp - isqrt phase signum cis - asin acos asinh acosh atanh ffloor fceiling ftruncate fround - logtest byte byte-size byte-position ldb ldb-test mask-field dpb - deposit-field - ;; packlib.lsp - find-all-symbols apropos apropos-list - ;; pprint.lsp - pprint-fill copy-pprint-dispatch pprint-dispatch - pprint-linear pprint-newline pprint-tab pprint-tabular - set-pprint-dispatch pprint-indent - ;; predlib.lsp - upgraded-array-element-type upgraded-complex-part-type typep subtypep coerce - si::do-deftype si::ratiop si::single-float-p si::short-float-p si::double-float-p - si::long-float-p - ;; process.lsp - ext:run-program - ext:terminate-process - ;; seq.lsp - make-sequence concatenate map some every notany notevery map-into complement - ;; seqlib.lsp - reduce fill replace - remove remove-if remove-if-not delete delete-if delete-if-not - count count-if count-if-not substitute substitute-if substitute-if-not - nsubstitute nsubstitute-if nsubstitute-if-not find find-if find-if-not - position position-if position-if-not remove-duplicates - delete-duplicates mismatch search sort stable-sort merge constantly - si::sequence-count - ;; setf.lsp - si::do-defsetf si::do-define-setf-method - ;; trace.lsp - si::traced-old-definition - - #+clos - ,@'(;; combin.lsp - invalid-method-error - method-combination-error - clos:compute-effective-method-function - clos:std-compute-effective-method - ;; defclass.lsp - clos::ensure-class - clos:load-defclass - ;; kernel.lsp - clos:std-compute-applicable-methods - ;; method.lsp - clos:extract-lambda-list - clos:extract-specializer-names - ;; predlib.lsp - si::subclassp si::of-class-p - ;; slotvalue.lsp - slot-makunbound - ;; std-slot-value.lsp - slot-boundp - slot-exists-p - slot-value - clos::slot-value-set - clos::standard-instance-access ;; alias clos:funcallable-standard-instance-access - clos::standard-instance-set - ) - - ;; cdr-5 - ext:array-index-p - ext:negative-fixnum-p ext:non-negative-fixnum-p - ext:non-positive-fixnum-p ext:positive-fixnum-p - ext:negative-integer-p ext:non-negative-integer-p - ext:non-positive-integer-p ext:positive-integer-p - ext:negative-rational-p ext:non-negative-rational-p - ext:non-positive-rational-p ext:positive-rational-p - ext:negative-ratio-p ext:non-negative-ratio-p - ext:non-positive-ratio-p ext:positive-ratio-p - ext:negative-real-p ext:non-negative-real-p - ext:non-positive-real-p ext:positive-real-p - ext:negative-float-p ext:non-negative-float-p - ext:non-positive-float-p ext:positive-float-p - ext:negative-short-float-p ext:non-negative-short-float-p - ext:non-positive-short-float-p ext:positive-short-float-p - ext:negative-single-float-p ext:non-negative-single-float-p - ext:non-positive-single-float-p ext:positive-single-float-p - ext:negative-double-float-p ext:non-negative-double-float-p - ext:non-positive-double-float-p ext:positive-double-float-p - ext:negative-long-float-p ext:non-negative-long-float-p - ext:non-positive-long-float-p ext:positive-long-float-p -)) - -(proclaim - ;; These functions are not visible in external.h and have no entry in - ;; symbols_list.h - `(si::c-export-fname #+ecl-min ,@c::*in-all-symbols-functions* - ;; defmacro.lsp - find-documentation find-declarations - si::search-keyword si::check-keyword - si::dm-too-many-arguments si::dm-too-few-arguments - remove-documentation - ;; defstruct.lsp - si::structure-type-error si::define-structure - ;; helpfile.lsp - si::get-documentation si::set-documentation - si::expand-set-documentation - ;; packlib.lsp - si::packages-iterator - ;; pprint.lsp - si::pprint-logical-block-helper si::pprint-pop-helper - ;; seq.lsp - si::make-seq-iterator si::seq-iterator-ref - si::seq-iterator-set si::seq-iterator-next - si::coerce-to-list si::coerce-to-vector - - #+formatter - ,@'( - format-princ format-prin1 format-print-named-character - format-print-integer - format-print-cardinal format-print-ordinal format-print-old-roman - format-print-roman format-fixed format-exponential - format-general format-dollars - format-relative-tab format-absolute-tab - format-justification - ) - - #+clos - ,@'(;; generic.lsp - clos::associate-methods-to-gfun - ;; kernel.lsp - clos::install-method - ;; std-slot-value.lsp - clos::find-slot-definition - ;; clos::generic-function-lambda-list - ;; clos::generic-function-argument-precedence-order - ;; clos::generic-function-method-combination - ;; clos::generic-function-method-class - ;; clos::generic-function-methods - ;; clos::method-generic-function - ;; clos::method-lambda-list - ;; clos::method-specializers - ;; clos::method-qualifiers - ;; clos::method-function - ;; clos::method-plist - ) - )) -