;;; -*- Mode: Scheme -*-

;;;; C Stub Generator for Scheme
;;;; Unix System Calls -- Code Generation

;;; Copyright (c) 2009, Taylor R. Campbell
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;;   notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above copyright
;;;   notice, this list of conditions and the following disclaimer in
;;;   the documentation and/or other materials provided with the
;;;   distribution.
;;;
;;; * Neither the names of the authors nor the names of contributors
;;;   may be used to endorse or promote products derived from this
;;;   software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(define (c-expression/unix-syscall-failure syscall error-code retry-command)
  (lambda (locative)
    locative                            ;ignore
    (c-command/unix-syscall-failure syscall error-code retry-command)))

(define (c-command/unix-syscall-failure syscall error-code retry-command)
  syscall                               ;ignore
  (c-format:call-statement "SCHEME_SYSCALL_FAILURE"
                           (list syscall error-code retry-command)))

(define (c-command/unix-void-syscall commands syscall arguments)
  (unix-syscall commands syscall arguments
    (lambda (expression)
      (c-format:statement
       (cpp-format:call "SCHEME_VOID_SYSCALL" (list syscall expression))))))

(define (c-expression/unix-void-syscall commands syscall arguments)
  (c-expression/sequence
   (c-command/unix-void-syscall commands syscall arguments)
   (c-expression/unspecific)))

(define (c-command/unix-uint-syscall commands type location syscall arguments)
  (unix-uint-syscall commands type location syscall arguments
    (lambda (location)
      location                          ;ignore
      (format:empty))))

(define (c-expression/unix-uint-syscall commands type syscall arguments)
  (lambda (locative)
    (unix-uint-syscall commands type #f syscall arguments
      (lambda (location)
        ((c-expression/integral type location) locative)))))

(define (unix-uint-syscall commands type location syscall arguments
                           continuation)
  ((lambda (body)
     (if location
         (body location)
         (c-format:call-with-temporary-name "syscall_result"
           (lambda (location)
             (c-format:block (c-format:declare type location)
                             (body location))))))
   (lambda (location)
     (format:sequence
      (unix-syscall commands syscall arguments
        (lambda (expression)
          (c-format:statement
           (cpp-format:call "SCHEME_UINT_SYSCALL"
                            (list syscall location expression)))))
      (continuation location)))))

(define (unix-syscall commands syscall arguments generator)
  (format:sequence
   (format:list (map format:indented-line commands))
   (generator
    (c-format:call syscall
                   (map (lambda (argument)
                          (if (symbol? argument)
                              (mangle-name argument)
                              (c-format:parenthesis argument)))
                        arguments)))))