mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 05:12:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

New file cmploc.lsp for dealing with locations.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-12-29 16:51:05 +01:00
parent 8355766f0c
commit 97b6077f84
3 changed files with 97 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/new-cmp/cmpc-ffi.lsp
View file

@ -100,31 +100,6 @@
((C-INLINE) (not (fifth loc))) ; side effects?
(otherwise t))))
(defun loc-type (loc)
(cond ((eq loc NIL) 'NULL)
((var-p loc) (var-type loc))
((si::fixnump loc) 'fixnum)
((atom loc) 'T)
(t
(case (first loc)
(FIXNUM-VALUE 'FIXNUM)
(CHARACTER-VALUE (type-of (code-char (second loc))))
(DOUBLE-FLOAT-VALUE 'DOUBLE-FLOAT)
(SINGLE-FLOAT-VALUE 'SINGLE-FLOAT)
(LONG-FLOAT-VALUE 'LONG-FLOAT)
(C-INLINE (let ((type (first (second loc))))
(cond ((and (consp type) (eq (first type) 'VALUES)) T)
((lisp-type-p type) type)
(t (rep-type->lisp-type type)))))
(BIND (var-type (second loc)))
(LCL (or (third loc) T))
(MAKE-CCLOSURE 'FUNCTION)
((VV VV-TEMP)
(if (cddr loc)
(object-type (third loc))
T))
(otherwise T)))))
(defun loc-representation-type (loc)
(cond ((member loc '(NIL T)) :object)
((var-p loc) (var-rep-type loc))

93
src/new-cmp/cmploc.lsp Normal file
View file

@ -0,0 +1,93 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll.
;;;;
;;;; 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 file '../Copyright' for full details.
;;;;
;;;; CMPLOC -- Backend-independent functions for dealing with locations
;;;;
(in-package "C-BACKEND")
;;; Valid locations are:
;;; NIL
;;; T
;;; fixnum
;;; VALUE0
;;; VALUES
;;; VALUES+VALUE0
;;; var-object
;;; ( VALUE i ) VALUES(i)
;;; ( VV vv-index )
;;; ( VV-temp vv-index )
;;; ( LCL lcl [representation-type]) local variable, type unboxed
;;; ( TEMP temp ) local variable, type object
;;; ( CALL c-fun-name args fname ) locs are locations containing the arguments
;;; ( CALL-NORMAL fun locs) similar as CALL, but number of arguments is fixed
;;; ( CALL-INDIRECT fun narg args) similar as CALL, but unknown function
;;; ( C-INLINE output-type fun/string locs side-effects output-var )
;;; ( COERCE-LOC representation-type location)
;;; ( CAR lcl )
;;; ( CDR lcl )
;;; ( CADR lcl )
;;; ( FDEFINITION vv-index )
;;; ( MAKE-CCLOSURE cfun )
;;; ( FIXNUM-VALUE fixnum-value )
;;; ( CHARACTER-VALUE character-code )
;;; ( LONG-FLOAT-VALUE long-float-value vv )
;;; ( DOUBLE-FLOAT-VALUE double-float-value vv )
;;; ( SINGLE-FLOAT-VALUE single-float-value vv )
;;; ( STACK-POINTER index ) retrieve a value from the stack
;;; ( SYS:STRUCTURE-REF loc slot-name-vv slot-index )
;;; ( KEYVARS n )
;;; ( THE type loc )
;;; VA-ARG
;;; CL-VA-ARG
;;; Valid *DESTINATION* locations are:
;;;
;;; VALUE0
;;; RETURN Object returned from current function.
;;; TRASH Value may be thrown away.
;;; VALUES Values vector.
;;; var-object
;;; ( LCL lcl )
;;; ( LEX lex-address )
;;; ( BIND var alternative ) Alternative is optional
;;; ( JUMP-TRUE label )
;;; ( JUMP-FALSE label )
;;; ( JUMP-ZERO label )
;;; ( JUMP-NONZERO label )
(in-package "C-DATA")
(defun loc-type (loc)
(cond ((eq loc NIL) 'NULL)
((var-p loc) (var-type loc))
((si::fixnump loc) 'fixnum)
((atom loc) 'T)
(t
(case (first loc)
(FIXNUM-VALUE 'FIXNUM)
(CHARACTER-VALUE (type-of (code-char (second loc))))
(DOUBLE-FLOAT-VALUE 'DOUBLE-FLOAT)
(SINGLE-FLOAT-VALUE 'SINGLE-FLOAT)
(LONG-FLOAT-VALUE 'LONG-FLOAT)
(C-INLINE (let ((type (first (second loc))))
(cond ((and (consp type) (eq (first type) 'VALUES)) T)
((lisp-type-p type) type)
(t (rep-type->lisp-type type)))))
(BIND (var-type (second loc)))
(LCL (or (third loc) T))
(MAKE-CCLOSURE 'FUNCTION)
((VV VV-TEMP)
(if (cddr loc)
(object-type (third loc))
T))
(otherwise T)))))

6
src/new-cmp/load.lsp.in
View file

@ -5,11 +5,13 @@
"src:new-cmp;cmptypes.lsp"
"src:new-cmp;cmpglobals.lsp"
"build:new-cmp;cmpdefs.lsp"
"src:new-cmp;cmpform.lsp"
"src:new-cmp;cmptables.lsp"
"src:new-cmp;cmpmac.lsp"
"src:new-cmp;cmpform.lsp"
"src:new-cmp;cmploc.lsp"
"src:new-cmp;cmpdata.lsp"
"src:new-cmp;cmputil.lsp"
"src:new-cmp;cmptype.lsp"
"src:new-cmp;cmptables.lsp"
"src:new-cmp;cmptranslate.lsp"
"src:new-cmp;cmpblock.lsp"
"src:new-cmp;cmpcall.lsp"