From 222ab1bfa456b3b20a7f927be659de86bf20c67e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 27 Jun 2023 15:09:59 +0200 Subject: [PATCH] cmp: don't pass "raw" boolean values in the second pass T and NIL are expected to be wrapped in an intermediate structure representing the value. This improves the separation between the host and the target language. --- src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp | 9 +++++---- src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp | 2 ++ src/cmp/cmpbackend-cxx/cmppass2-data.lsp | 2 ++ src/cmp/cmpbackend-cxx/cmppass2-eval.lsp | 8 ++++---- src/cmp/cmpbackend-cxx/cmppass2-exit.lsp | 6 ++++-- src/cmp/cmpbackend-cxx/cmppass2-fun.lsp | 13 ++++++++----- src/cmp/cmpbackend-cxx/cmppass2-loc.lsp | 9 --------- src/cmp/cmpbackend-cxx/cmppass2-var.lsp | 2 +- src/cmp/cmplocs.lsp | 10 ++-------- src/cmp/cmppass1-eval.lsp | 14 ++++++++++++-- src/cmp/cmptables.lsp | 5 +---- 11 files changed, 41 insertions(+), 39 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp index a1d18f5ff..d5620b9a5 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp @@ -138,10 +138,11 @@ (define-c-inliner float (return-type arg &optional float) (let ((arg-c-type (lisp-type->rep-type (inlined-arg-type arg))) - (flt-c-type (lisp-type->rep-type (inlined-arg-type float)))) - (when (member flt-c-type '(:float :double :long-double)) - (if (eq arg-c-type flt-c-type) - (inlined-arg-loc arg) + (flt-c-type (and float (lisp-type->rep-type (inlined-arg-type float))))) + (if (member arg-c-type '(:float :double :long-double)) + (when (or (null float) (eq arg-c-type flt-c-type)) + (inlined-arg-loc arg)) + (when (member flt-c-type '(:float :double :long-double)) (produce-inline-loc (list arg) (list :object) (list flt-c-type) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp index 4f4d57858..6832be43e 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp @@ -13,6 +13,8 @@ (in-package "COMPILER") (define-c-inliner cl:princ (return-type expression &optional stream) + (unless stream + (setf stream (emit-inline-form *c1nil* nil))) (multiple-value-bind (foundp value) (loc-immediate-value-p (inlined-arg-loc expression)) (cond diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp index 745c54fe9..1ae8939bc 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp @@ -241,6 +241,8 @@ (defun wt-vv-value (vv value) (etypecase value + ((eql CL:T) (wt "ECL_T")) + ((eql CL:NIL) (wt "ECL_NIL")) (fixnum (wt-fixnum value vv)) (character (wt-character value vv)) (float (wt-number value vv)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp index 775248d02..b46cd206f 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp @@ -91,7 +91,7 @@ (case rep-type (:bool '((:bool) (:object) "(#0)?ECL_NIL:ECL_T" nil t)) (:object '((:object) (:object) "Null(#0)?ECL_T:ECL_NIL" nil t)) - (otherwise (return-from negate-argument nil))))))) + (otherwise (return-from negate-argument *vv-nil*))))))) (defun c2fmla-not (c1form arg) (declare (ignore c1form)) @@ -129,7 +129,7 @@ (let ((*destination* `(JUMP-FALSE ,false-label))) (mapc #'c2expr* butlast)) (c2expr last)) - (unwind-exit nil)))) + (unwind-exit *vv-nil*)))) (defun c2fmla-or (c1form butlast last) (declare (ignore c1form)) @@ -141,7 +141,7 @@ (let ((*destination* `(JUMP-TRUE ,true-label))) (mapc #'c2expr* butlast)) (c2expr last)) - (unwind-exit t)) + (unwind-exit *vv-t*)) (t (with-exit-label (common-exit) (with-exit-label (normal-exit) @@ -240,7 +240,7 @@ (wt-nl "cl_env_copy->nvalues = 0;") (unwind-exit 'VALUES)) (t - (unwind-exit 'NIL)))) + (unwind-exit *vv-nil*)))) ;; For a single form, we must simply ensure that we only take a single ;; value of those that the function may output. ((endp (rest forms)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp index 5217d377b..8ef8d7d18 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp @@ -67,10 +67,12 @@ (case (car *destination*) (JUMP-TRUE (set-jump-true loc (second *destination*)) - (when (eq loc t) (return-from unwind-exit))) + (when (eq loc *vv-t*) + (return-from unwind-exit))) (JUMP-FALSE (set-jump-false loc (second *destination*)) - (when (eq loc nil) (return-from unwind-exit))))) + (when (eq loc *vv-nil*) + (return-from unwind-exit))))) (dolist (ue *unwind-exit* (baboon-improper-*exit*)) ;; perform all unwind-exit's which precede *exit* (cond diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp index da97389ad..79520b916 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp @@ -44,7 +44,7 @@ (wt "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";"))) ;; bind closed locations because of possible circularities (loop for var in closed-vars - do (bind nil var))) + do (bind *vv-nil* var))) ;; create the functions: (mapc #'new-local funs) ;; - then assign to it @@ -204,7 +204,8 @@ (wt-nl "if (i >= narg) {") (let ((*opened-c-braces* (1+ *opened-c-braces*))) (bind-init (second opt) (first opt)) - (when (third opt) (bind nil (third opt)))) + (when (third opt) + (bind *vv-nil* (third opt)))) (wt-nl "} else {") (let ((*opened-c-braces* (1+ *opened-c-braces*)) (*unwind-exit* *unwind-exit*)) @@ -212,7 +213,8 @@ (bind va-arg-loc (first opt)) (if (car type-check) (c2expr* (car type-check))) - (when (third opt) (bind t (third opt)))) + (when (third opt) + (bind *vv-t* (third opt)))) (wt-nl "}")) (wt-nl-close-brace))) @@ -230,7 +232,8 @@ ;; declaration on some variables. (if rest (wt ",(cl_object*)&" rest-loc) (wt ",NULL")) (wt (if allow-other-keys ",TRUE);" ",FALSE);")))) - (when rest (bind rest-loc rest))) + (when rest + (bind rest-loc rest))) (when varargs (wt-nl (if simple-varargs "va_end(args);" "ecl_va_end(args);"))) @@ -252,7 +255,7 @@ (init (third kwd)) (flag (fourth kwd))) (cond ((and (eq (c1form-name init) 'LOCATION) - (null (c1form-arg 0 init))) + (eq (c1form-arg 0 init) *vv-nil*)) ;; no initform ;; ECL_NIL has been set in keyvars if keyword parameter is not supplied. (setf (second KEYVARS[i]) i) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp index 10d62a77e..b26ace199 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp @@ -175,15 +175,6 @@ (wt "ecl_fdefinition(" vv ")"))) ;; #'(SETF symbol) (if safe - #+(or) - (let ((set-loc (assoc name *setf-definitions*))) - (unless set-loc - (let* ((setf-vv (data-empty-loc)) - (name-vv (add-symbol name)) - (setf-form-vv (add-object fun-name))) - (setf set-loc (list name setf-vv name-vv setf-form-vv)) - (push set-loc *setf-definitions*))) - (wt "ECL_SETF_DEFINITION(" (second set-loc) "," (fourth set-loc) ")")) (let ((set-loc (assoc name *setf-definitions*))) (unless set-loc (let* ((setf-vv (data-empty-loc)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index af4a3afe1..a727d4ec9 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -196,7 +196,7 @@ (let ((*destination* var)) (c2expr* form)))) (dolist (save saves) (set-var (cdr save) (car save))) (wt-nl-close-many-braces braces) - (unwind-exit nil)) + (unwind-exit *vv-nil*)) ;;; bind must be called for each variable in a lambda or let, once the value ;;; to be bound has been placed in loc. diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp index 7c31fefdd..b6add3844 100644 --- a/src/cmp/cmplocs.lsp +++ b/src/cmp/cmplocs.lsp @@ -162,9 +162,7 @@ (defun loc-in-c1form-movable-p (loc) "A location that is in a C1FORM and can be moved" - (cond ((member loc '(t nil)) - t) - ((numberp loc) + (cond ((numberp loc) t) ((stringp loc) t) @@ -191,11 +189,7 @@ (eq (sixth loc) 'cl:VALUES))))) (defun loc-immediate-value-p (loc) - (cond ((eq loc t) - (values t t)) - ((eq loc nil) - (values t nil)) - ((numberp loc) + (cond ((numberp loc) (values t loc)) ((vv-p loc) (let ((value (vv-value loc))) diff --git a/src/cmp/cmppass1-eval.lsp b/src/cmp/cmppass1-eval.lsp index f81b3a05e..0060a4d7b 100644 --- a/src/cmp/cmppass1-eval.lsp +++ b/src/cmp/cmppass1-eval.lsp @@ -55,9 +55,19 @@ (when (c1form-p form) (return form))))) -(defvar *c1nil* (make-c1form* 'LOCATION :type (object-type nil) :args nil)) +(defvar *vv-nil* + (make-vv :value CL:NIL)) + +(defvar *vv-t* + (make-vv :value CL:T)) + +(defvar *c1nil* + (make-c1form* 'LOCATION :type (object-type nil) :args *vv-nil*)) + +(defvar *c1t* + (make-c1form* 'LOCATION :type (object-type t) :args *vv-t*)) + (defun c1nil () *c1nil*) -(defvar *c1t* (make-c1form* 'LOCATION :type (object-type t) :args t)) (defun c1t () *c1t*) (defun c1with-backend (forms) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index 43610a4b3..72218191d 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -189,14 +189,11 @@ (si:structure-ref . wt-structure-ref) - (cl:nil . "ECL_NIL") - (cl:t . "ECL_T") (cl:return . "value0") (cl:values . "cl_env_copy->values[0]") (va-arg . "va_arg(args,cl_object)") (cl-va-arg . "ecl_va_arg(args)") - (value0 . "value0") - )) + (value0 . "value0"))) (defconstant +c2-dispatch-alist+ '((cl:block . c2block)