From 9cb802b1f9c8d24a9fc81c26fca481abdf87fe6f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 23 Jul 1990 14:07:04 +0000 Subject: [PATCH] Changed to use new lexical environment stuff. Fixed ALIEN-BIND to work, given its sequential binding semantics. Fixed the ALIEN-SAP transform to be a transform for ALIEN-SAP instead of having two transforms for ALIEN-ADDRESS. --- compiler/aliencomp.lisp | 81 +++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 40 deletions(-) diff --git a/compiler/aliencomp.lisp b/compiler/aliencomp.lisp index c059d0b61..db4fecc7f 100644 --- a/compiler/aliencomp.lisp +++ b/compiler/aliencomp.lisp @@ -68,7 +68,7 @@ (defun analyze-alien-expression (result-type exp) (if (atom exp) (if (and (symbolp exp) - (or (ct-a-val-p (cdr (assoc exp *venv*))) + (or (ct-a-val-p (lexenv-find exp variables)) (info variable alien-value exp))) (grovel-alien-var result-type exp) (grovel-random-alien result-type exp)) @@ -169,11 +169,12 @@ ;;; Grovel-Alien-Var -- Internal ;;; -;;; Look the var up in *venv*, and then check if it is a global -;;; alien-variable. If it ain't there or is the the wrong type then flame out. +;;; Look the var up in the LEXENV-VARIABLES, and then check if it is a +;;; global alien-variable. If it ain't there or is the the wrong type then +;;; flame out. ;;; (defun grovel-alien-var (type var) - (let* ((local-def (cdr (assoc var *venv*))) + (let* ((local-def (lexenv-find var variables)) (res (cond ((ct-a-val-p local-def) local-def) ((or (not local-def) (and (global-var-p local-def) @@ -209,7 +210,7 @@ (do* ((args (cdr exp) (cdr args)) (dums ()) - (*venv* *venv*) + (*lexical-environment* *lexical-environment*) (num 0 (1+ num)) (types (lisp::alien-info-arg-types info)) (atype (cdr (assoc num types)) (cdr (assoc num types))) @@ -241,7 +242,8 @@ (setq binds (nconc binds b) stuff (nconc stuff s)) (unless val (return nil)) (let ((var (gensym))) - (push (cons var val) *venv*) + (setq *lexical-environment* + (make-lexenv :variables (list (cons var val)))) (push var dums)))) (t (let ((var (gensym))) @@ -338,49 +340,49 @@ ;;; Alien-Bind IR1 convert -- Internal ;;; (def-ir1-translator alien-bind ((binds &body body &whole source) start cont) - (let ((*venv* *venv*)) - (collect ((lets nil nconc) - (stuff nil nconc)) - (dolist (bind binds) + (if binds + (let ((bind (first binds))) (unless (<= 2 (length bind) 4) (compiler-error "Malformed Alien-Bind specifier:~% ~S" bind)) (let ((var (first bind)) (val (second bind)) (typ (third bind)) (aligned (fourth bind))) - - (multiple-value-bind (l s res) + + (multiple-value-bind (init-lets stuff res) (analyze-alien-expression typ val) (unless (ct-a-val-type res) (compiler-error "Must specify type, since it is not apparent ~ - from the value:~% ~S" bind)) - (lets l) - (stuff s) + from the value:~% ~S" + bind)) (let* ((offset (ct-a-val-offset res)) (sap (ct-a-val-sap res)) (size (ct-a-val-size res)) (n-size (gensym)) (n-sap (gensym)) - (n-offset (gensym))) - (lets `((,n-sap ,(if aligned - `(%aligned-sap ,sap ,offset ',source) - sap)) - (,n-size ,size) - (,n-offset ,(if aligned 0 offset)))) - - (push (cons var - (make-ct-a-val :type (ct-a-val-type res) + (n-offset (gensym)) + (a-val (make-ct-a-val :type (ct-a-val-type res) :offset (if aligned 0 n-offset) :size n-size :sap n-sap :alien (ct-a-val-alien res))) - *venv*))))) - - (ir1-convert start cont - `(let* ,(reverse (lets)) - ,(ignore-unreferenced-vars (lets)) - ,@(nreverse (stuff)) - ,@body))))) + (lets `(,@(reverse init-lets) + (,n-sap ,(if aligned + `(%aligned-sap ,sap ,offset ',source) + sap)) + (,n-size ,size) + (,n-offset ,(if aligned 0 offset))))) + (ir1-convert + start cont + `(let* ,lets + ,(ignore-unreferenced-vars lets) + (compiler-let ((*lexical-environment* + (make-lexenv :variables + ',(acons var a-val nil)))) + ,@(reverse stuff) + (alien-bind ,(rest binds) + ,@body)))))))) + (ir1-convert-progn-body start cont body))) ;;; With-Stack-Alien-Transform -- Internal @@ -394,13 +396,13 @@ (let* ((n-current (lisp::stack-info-current info)) (n-sap (gensym)) (n-alien (gensym)) - (*venv* (acons var - (make-ct-a-val :type (lisp::stack-info-type info) - :size (lisp::stack-info-size info) - :sap n-sap - :offset 0 - :alien n-alien) - *venv*))) + (a-val (make-ct-a-val :type (lisp::stack-info-type info) + :size (lisp::stack-info-size info) + :sap n-sap + :offset 0 + :alien n-alien)) + (*lexical-environment* + (make-lexenv :variables (list (cons var a-val))))) (ir1-convert start cont `(let* ((,n-alien (or (car ,n-current) (,(lisp::stack-info-grow info)))) @@ -430,8 +432,7 @@ ;;; Alien-SAP soruce transform -- Internal ;;; -;;; -(def-source-transform alien-address (alien &whole source) +(def-source-transform alien-sap (alien &whole source) (multiple-value-bind (binds stuff res) (analyze-alien-expression nil alien) `(let* ,(reverse binds) -- GitLab