diff --git a/src/CHANGELOG b/src/CHANGELOG index 6b4d9e6a3..deea48682 100755 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -12,6 +12,9 @@ ECL 13.7.1 such as in (declare (:double a)) and then the variable is enforced to be unboxed to such type. +- New form EXT:C-PROGN used to interleave C statements with lisp code, where + the lisp code may refer to any number of variables. + ;;; Local Variables: *** ;;; mode:text *** ;;; fill-column:79 *** diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 190577c2a..47851b5d7 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -2265,6 +2265,7 @@ cl_symbols[] = { {FFI_ "ALLOCATE-FOREIGN-OBJECT", FFI_ORDINARY, NULL, -1, OBJNULL}, {FFI_ "ALLOCATE-FOREIGN-STRING", FFI_ORDINARY, NULL, -1, OBJNULL}, {FFI_ "C-INLINE", FFI_ORDINARY, NULL, -1, OBJNULL}, +{FFI_ "C-PROGN", FFI_ORDINARY, NULL, -1, OBJNULL}, {FFI_ "CALLBACK", FFI_ORDINARY, NULL, -1, OBJNULL}, {FFI_ "CHAR*", FFI_ORDINARY, NULL, -1, OBJNULL}, {FFI_ "CHAR-ARRAY-TO-POINTER", FFI_ORDINARY, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 2ed3a2b6f..5d99c948b 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -2265,6 +2265,7 @@ cl_symbols[] = { {FFI_ "ALLOCATE-FOREIGN-OBJECT",NULL}, {FFI_ "ALLOCATE-FOREIGN-STRING",NULL}, {FFI_ "C-INLINE",NULL}, +{FFI_ "C-PROGN",NULL}, {FFI_ "CALLBACK",NULL}, {FFI_ "CHAR*",NULL}, {FFI_ "CHAR-ARRAY-TO-POINTER",NULL}, diff --git a/src/cmp/cmpffi.lsp b/src/cmp/cmpffi.lsp index 9de0e5f5e..073821a09 100755 --- a/src/cmp/cmpffi.lsp +++ b/src/cmp/cmpffi.lsp @@ -370,6 +370,27 @@ (add-to-set-nodes var form))) form))) +(defun c1c-progn (arguments) + (let* ((variables (mapcar #'c1fref (pop arguments))) + (statements (loop for form in arguments + collect (if (stringp form) + form + (c1expr form)))) + (form (make-c1form* 'FFI:C-PROGN :type NIL + :side-effects t + :args variables statements))) + (add-to-set-nodes-of-var-list variables form) + form)) + +(defun c2c-progn (c1form statements) + (loop with *destination* = 'TRASH + for form in statements + if (stringp form) + do (wt-nl form) + else + do (c2expr* form)) + (unwind-exit nil)) + (defun produce-inline-loc (inlined-arguments arg-types output-rep-type c-expression side-effects one-liner) (let* (args-to-be-saved diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index 21c0ab228..dcc8e685b 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -37,6 +37,7 @@ c-expression-string side-effects-p one-liner-p) + (C-PROGN body) (LOCALS local-fun-list body labels-p :pure) (IF fmla-c1form true-c1form false-c1form :pure) (FMLA-NOT fmla-c1form :pure) @@ -94,6 +95,7 @@ (ext:with-backend . c1with-backend) ; c1special (ffi:clines . c1clines) ; c1special (ffi:c-inline . c1c-inline) ; c1special + (ffi:c-progn . c1c-progn) ; c1special (flet . c1flet) ; c1special (labels . c1labels) ; c1special (locally . c1locally) ; c1special @@ -212,6 +214,7 @@ (throw . c2throw) ; c2 (progn . c2progn) ; c2 (ffi:c-inline . c2c-inline) ; c2 + (ffi:c-progn . c2c-progn) ; c2 (locals . c2locals) ; c2 (call-local . c2call-local) ; c2 @@ -286,6 +289,7 @@ (values . p1values) (location . p1trivial) ;; Some of these can be improved (ffi:c-inline . p1trivial) + (ffi:c-progn . p1trivial) (function . p1trivial) (funcall . p1trivial) (load-time-value . p1trivial) diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp index 9c34e278d..9c7834af5 100644 --- a/src/lsp/ffi.lsp +++ b/src/lsp/ffi.lsp @@ -668,7 +668,9 @@ (eval-when (:load-toplevel :execute) (defmacro c-inline (args arg-types ret-type &body others) `(error "The special form c-inline cannot be used in the interpreter: ~A" - (list (list ,@args) ',arg-types ',ret-type ,@others)))) + (list (list ,@args) ',arg-types ',ret-type ,@others))) + (defmacro c-progn (&rest body) + '(error "The special form c-progn cannot be used in the interpreter."))) (defmacro definline (fun arg-types type code) "Syntax: (definline symbol (&rest arg-types) result-type &body body) " "