~ chicken-r7rs (master) /scheme.process-context.scm

 1(module scheme.process-context (command-line
 2				emergency-exit
 3				exit
 4				get-environment-variable
 5				get-environment-variables)
 6  (import scheme
 7          chicken.process-context
 8          chicken.type
 9	  (rename chicken.base (exit chicken-exit)))
10
11;;;
12;;; 6.14. System interface.
13;;;
14
15(: command-line (-> (list-of string)))
16(: exit (#!optional * -> noreturn))
17(: emergency-exit (#!optional * -> noreturn))
18
19(define (command-line)
20  ;; Don't cache these; they may be parameterized at any time!
21  (cons (program-name) (command-line-arguments)))
22
23(define (->exit-status obj)
24  (cond ((integer? obj) obj)
25        ((eq? obj #f) 1)
26        (else 0)))
27
28(define exit
29  (case-lambda
30    (()
31     (exit 0))
32    ((obj)
33     ;; ##sys#dynamic-unwind is hidden, have to unwind manually.
34     ; (##sys#dynamic-unwind '() (length ##sys#dynamic-winds))
35     (let unwind ()
36       (unless (null? ##sys#dynamic-winds)
37         (let ((after (cdar ##sys#dynamic-winds)))
38           (set! ##sys#dynamic-winds (cdr ##sys#dynamic-winds))
39           (after)
40           (unwind))))
41     ;; The built-in exit runs cleanup handlers for us.
42     (chicken-exit (->exit-status obj)))))
43
44)