mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-25 05:51:55 -08:00
61 lines
2.2 KiB
Common Lisp
61 lines
2.2 KiB
Common Lisp
;;;;
|
|
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya
|
|
;;;; Copyright (c) 1990, Giuseppe Attardi
|
|
;;;; Copyright (c) 2010, Juan Jose Garcia-Ripoll
|
|
;;;; Copyright (c) 2021, Daniel Kochmański
|
|
;;;;
|
|
;;;; 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.
|
|
;;;;
|
|
|
|
(in-package #:compiler)
|
|
|
|
;;;; Following special forms are provided:
|
|
;;;;
|
|
;;;; (WITH-STACK {form}*)
|
|
;;;; Executes given forms, restoring the lisp stack on output.
|
|
;;;; (STACK-PUSH form)
|
|
;;;; (STACK-PUSH-VALUES form)
|
|
;;;; (STACK-POP nvalues)
|
|
|
|
(defun c1with-stack (forms)
|
|
(let* ((var (pop forms))
|
|
(body (c1expr `(let ((,var (innermost-stack-frame))) ,@forms))))
|
|
(make-c1form* 'WITH-STACK
|
|
:type (c1form-type body)
|
|
:args body)))
|
|
|
|
(defun c1innermost-stack-frame (args)
|
|
(declare (ignore args))
|
|
`(ffi:c-inline () () :object "_ecl_inner_frame"
|
|
:one-liner t :side-effects nil))
|
|
|
|
(defun c1stack-push (args)
|
|
`(progn
|
|
(ffi:c-inline ,args (t t) :void "ecl_stack_frame_push(#0,#1)"
|
|
:one-liner t :side-effects t)
|
|
1))
|
|
|
|
(defun c1stack-push-values (args)
|
|
(let ((frame-var (pop args))
|
|
(form (pop args)))
|
|
(make-c1form* 'STACK-PUSH-VALUES :type '(VALUES)
|
|
:args
|
|
(c1expr form)
|
|
(c1expr `(ffi:c-inline (,frame-var) (t)
|
|
:void "ecl_stack_frame_push_values(#0)"
|
|
:one-liner t :side-effects t)))))
|
|
|
|
(defun c1stack-pop (args)
|
|
`(ffi:c-inline ,args (t) (values &rest t)
|
|
"cl_env_copy->values[0]=ecl_stack_frame_pop_values(#0);"
|
|
:one-liner nil :side-effects t))
|
|
|
|
(defun c1apply-from-stack-frame (args)
|
|
`(ffi:c-inline ,args (t t) (values &rest t)
|
|
"cl_env_copy->values[0]=ecl_apply_from_stack_frame(#0,#1);"
|
|
:one-liner nil :side-effects t))
|