shithub: sl

Info  •  Files  •  Log  •  Branches

exit: replace with exits, add sysfatal, make (exit …) use a string

--- a/boot/sl.boot

+++ b/boot/sl.boot

@@ -13,7 +13,7 @@

               #fn("z0700}2:" #(aset!)) NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL #fn("n3012082>1|:" #(#fn("n1A061:" #())))

               NIL NIL NIL NIL NIL NIL NIL NIL #fn("z0700}2:" #(aref)) NIL NIL NIL)

             *properties* #table(*funvars* #table(identity ((x))  bound? ((symbol))  io-eof? ((io))  < ((a . rest))  cadr ((cell))  sym (term)  nan? ((v))  for ((min

-  max fn))  fixnum? ((v))  exit ((status))  > ((a . rest))  + (rest)  div0 ((a b))  __finish ((status))  lz-unpack ((data

+  max fn))  fixnum? ((v))  exit (((status NIL)))  > ((a . rest))  + (rest)  div0 ((a b))  __finish ((status))  lz-unpack ((data

   :to destination)

   (data :size decompressed-bytes))  defstruct ((name doc options… (slot-1 DEFAULT) slot-2 (slot-3

   :read-only))

@@ -28,10 +28,9 @@

                                                                               help-print-header)))  rand-u32 (NIL)  = ((a . rest))  rand-u64 (NIL)  not ((v))  set-cdr! ((cell

   new-second))  /= ((a . rest))  fn? ((v))  help-print-header ((term sigs))  lz-pack ((data (level

   0)))  *prompt* (NIL)  getprop ((symbol key (def NIL)))  vm-stats (NIL)  * (rest)  putprop ((symbol

-  key val))  io->str ((io)))  *doc* #table(identity "Return `x`."  bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise."  io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise."  < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one)."  cadr "Shorthand for `(car (cdr cell))`, that is, \"first element of the\nsecond element\".\n\nExamples:\n\n    (cadr '(1 2 3)) → 2\n    (cadr '(1))     → NIL\n    (cadr NIL)      → NIL"  sym "Convert terms to a symbol.\n\nThis is equivalent to `(sym (str terms…))`."  nan? "Return `T` if `v` is a floating point representation of NaN, either\nnegative or positive, `NIL` otherwise."  for "Call the function `fn` with a single integer argument, starting from\n`min` and ending with `max`.\n\nExamples:\n\n    (for 0 2 (λ (i) (print (- 2 i)))) → 210"  fixnum? "Return `T` if `v` is of a fixnum type, `NIL` otherwise."  exit "Terminate the process with the specified status. Does not return."  > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  + "Return sum of the arguments or `0` with none."  div0 "Return the quotient of two numbers.  For non-integers this is\nequivalent to `(div0 (floor a) (floor b))`.  The result is always an\ninteger.\n\nExamples:\n\n    (div0 7 2)     → 3\n    (div0 10 -2)   → -5\n    (div0 6.9 1.9) → 6"  __finish "A function called right before exit by the VM."  lz-unpack "Return decompressed data previously compressed using lz-pack.\n\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values.  If the name as the first element isn't\nrequired, `:named NIL` should be used.  A list can be used instead\nof a vector by adding `:type list` option.\n\nAn example of a default constructor signature, based on structure\ndefinition:\n\n    (defstruct blah a b c) →\n      (make-blah (:a NIL) (:b NIL) (:c NIL))\n\nIt can be customized in several ways. For example:\n\n    ; disable the constructor altogether\n    (defstruct blah :constructor NIL a b c)\n    ; only change its name\n    (defstruct blah :constructor blargh a b c)\n    ; rename AND avoid using keywords\n    (defstruct blah :constructor (blah a b c) a b c)\n\nThe option `:conc-name` specifies the slot accessor prefix, which\ndefaults to `name-`.\n\nDefault predicate name (`name?`) can be changed:\n\n    ; use \"blargh?\" instead of \"blah?\"\n    (defstruct blah :predicate blargh? a b c)"  compare "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is\ngreater than `x`.\n\nExamples:\n\n    (compare 'a 'b)       → -1\n    (compare 1 1)         → 0\n    (compare \"b\" \"a\") → 1"  buffer "Return an in-memory buffer for I/O, of `io` type.\n\nA buffer can be used for both reading and writing at the same\ntime."  num? "Return `T` if `v` is of a numerical type, `NIL` otherwise.\n\nNumerical types include floating point, fixnum, bignum, etc.\nNote: ironically, a NaN value is considered a number by this function\nsince it's only testing the _type_ of the value."  add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a\nsingle argument, which is (usually) `0` on success and any other\nnumber on error."  rand-float "Return a random float on [0.0, 1.0] interval."  builtin? "Return `T` if `v` is a built-in function, `NIL` otherwise."  set-car! "Modify a cons cell (a list) in-place by putting `new-first` as its\nfirst element (head of the list).  Return the modified cons\ncell (list).\n\nExamples:\n\n    (def q '(1 2 3 4 5))\n    (set-car! q 0) → (0 6 7)\n    q              → (0 6 7)"  cons? "Return `T` if `v` is a c

\ No newline at end of file

-            *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref))  doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void

-  sym-set-doc quote))  with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings

-                                                                         *io-in* #fn(copy-list)))  unless #fn("z1200q211Pe4:" #(if

+  key val))  io->str ((io)))  *doc* #table(identity "Return `x`."  bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise."  io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise."  < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one)."  cadr "Shorthand for `(car (cdr cell))`, that is, \"first element of the\nsecond element\".\n\nExamples:\n\n    (cadr '(1 2 3)) → 2\n    (cadr '(1))     → NIL\n    (cadr NIL)      → NIL"  sym "Convert terms to a symbol.\n\nThis is equivalent to `(sym (str terms…))`."  nan? "Return `T` if `v` is a floating point representation of NaN, either\nnegative or positive, `NIL` otherwise."  for "Call the function `fn` with a single integer argument, starting from\n`min` and ending with `max`.\n\nExamples:\n\n    (for 0 2 (λ (i) (print (- 2 i)))) → 210"  fixnum? "Return `T` if `v` is of a fixnum type, `NIL` otherwise."  exit "Terminate the process with the specified status.  Does not return.\nThe status is expected to be a string in case of an error.\n\nExamples:\n\n    (exit)\n    (exit \"error\")"  > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  + "Return sum of the arguments or `0` with none."  div0 "Return the quotient of two numbers.  For non-integers this is\nequivalent to `(div0 (floor a) (floor b))`.  The result is always an\ninteger.\n\nExamples:\n\n    (div0 7 2)     → 3\n    (div0 10 -2)   → -5\n    (div0 6.9 1.9) → 6"  __finish "A function called right before exit by the VM."  lz-unpack "Return decompressed data previously compressed using lz-pack.\n\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values.  If the name as the first element isn't\nrequired, `:named NIL` should be used.  A list can be used instead\nof a vector by adding `:type list` option.\n\nAn example of a default constructor signature, based on structure\ndefinition:\n\n    (defstruct blah a b c) →\n      (make-blah (:a NIL) (:b NIL) (:c NIL))\n\nIt can be customized in several ways. For example:\n\n    ; disable the constructor altogether\n    (defstruct blah :constructor NIL a b c)\n    ; only change its name\n    (defstruct blah :constructor blargh a b c)\n    ; rename AND avoid using keywords\n    (defstruct blah :constructor (blah a b c) a b c)\n\nThe option `:conc-name` specifies the slot accessor prefix, which\ndefaults to `name-`.\n\nDefault predicate name (`name?`) can be changed:\n\n    ; use \"blargh?\" instead of \"blah?\"\n    (defstruct blah :predicate blargh? a b c)"  compare "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is\ngreater than `x`.\n\nExamples:\n\n    (compare 'a 'b)       → -1\n    (compare 1 1)         → 0\n    (compare \"b\" \"a\") → 1"  buffer "Return an in-memory buffer for I/O, of `io` type.\n\nA buffer can be used for both reading and writing at the same\ntime."  num? "Return `T` if `v` is of a numerical type, `NIL` otherwise.\n\nNumerical types include floating point, fixnum, bignum, etc.\nNote: ironically, a NaN value is considered a number by this function\nsince it's only testing the _type_ of the value."  add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) `NIL` on success and a string describing\nan error otherwise."  rand-float "Return a random float on [0.0, 1.0] interval."  builtin? "Return `T` if `v` is a built-in function, `NIL` otherwise."  set-car! "Modify a cons cell (a list) in-place by putting `new-first` as its\nfirst element (head of the list).  Return the modified cons\ncell (list).\n\nExamples:\

\ No newline at end of file

+            *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref))  doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863D0202187e212188e2e4:202187e21e3:" #(sym-set-doc

+  quote))  with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings *io-in* #fn(copy-list)))  unless #fn("z1200q211Pe4:" #(if

    (aref a 0 2)   → 4"  *properties* "All properties of symbols recorded with `putprop` are recorded in this table."  vec "Return a vector constructed of the arguments.\n\nExamples:\n\n    (vec)              → #() ; empty vector\n    (vec 1 2.5 \"a\" 'b) → #(1 2.5 \"a\" b)"  >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)."  sym? "Return `T` if `v` is a symbol, `NIL` otherwise."  void? "Return `T` if `x` is `#<void>`, `NIL` otherwise."  zero? "Return `T` if `x` is zero."  length= "Perform a bounded length test.\n\nUse this instead of `(= (length lst) n)`, since it avoids unnecessary\nwork and always terminates."  positive? "Return `T` if `x` is greater than zero."  doc-for "Define documentation for a top level term.\n\nIf `term` is a function signature and `doc` is not specified, just\nthe signature will be included in the documentation, without\nreplacing any previously defined."  aset! "Modify the sequence element specified by the subscripts and return the\nnew value.  The sequence can be an array, vector, a list.\nMulti-dimensional sequences of variating types are also supported.\n\nExamples:\n\n    (def a '((1 #(2 (3)) 4)))\n    (aset! a 1 'x)     → index 1 out of bounds\n    (aset! a 0 0 'x)   → x\n    a                  → ((x #(2 (3)) 4))\n    (aset! a 0 1 9)    → 9\n    a                  → ((x #(9 (3)) 4))"  car "Return the first element of a cons cell (head of a list) or `NIL` if\nnot available.\n\nExamples:\n\n    (car NIL)      → NIL\n    (car '(1 2 3)) → 1\n    (car '(1 . 2)) → 1"  *builtins* "VM instructions as closures."  str "Convert terms to a concatenated string.\n\nThis is equivalent to `(princ terms…)`, except the string is\nreturned, rather than printed."  cons "Return a cons cell containing two arguments.\n\nExamples:\n\n    (cons 1 2)                     → (1 . 2)\n    (cons 1 '(2))                  → (1 2)\n    (cons 1 (cons 2 (cons 3 NIL))) → (1 2 3)"  - "Return the result of subtraction.  With only one argument a\nnegation is performed.\n\nExamples:\n\n    (- 1.5) → -1.5\n    (- 3 2) → 1"  remprop "Remove a property value associated with a symbol."  <= "Return `T` if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)."  rand "Return a random non-negative fixnum on its maximum range."  void "Return the constant `#<void>` while ignoring any arguments.\n\n`#<void>` is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though `T` or `NIL` could\nbe returned instead, in case of `#<void>` alone, REPL will not print\nit."  negative? "Return `T` if `x` is negative."  Instructions "VM instructions mapped to their encoded byte representation."  file "Open a file for I/O.\n\nAn `io` object is returned.  Without any modes specified the file\nis opened in read-only mode."  rand-double "Return a random double on interval [0.0, 1.0]."  1- "Equivalent to `(- n 1)`."  atom? "Return `T` if `v` is a _not_ a cons cell, `NIL` otherwise.  This is\nthe opposite of `cons?`.\n\nThe term \"atom\" comes from the idea of being indivisible."  cdr "Return the second element of a cons cell (tail of a list) or `NIL` if\nnot available.\n\nExamples:\n\n    (cdr NIL)      → NIL\n    (cdr '(1 2 3)) → (2 3)\n    (cdr '(1 . 2)) → 2"  T "A boolean \"true\".\n\nExamples:\n\n    (not T)         → NIL\n    (if T 'yes 'no) → yes"  vec? "Return `T` if `v` is a vector, `NIL` otherwise."  / "Return the division of the arguments.  With only one argument the\nresult of `1/x` is returned.  If the result is integer-valued, it is\nreturned as an integer.\n\nExamples:\n\n    (/ 2)       → 0.5\n    (/ 7 2 2)   → 1.75\n    (/ 10 -2)   → -5 ; a fixnum\n    (/ 6.9 1.9) → 3.6315…"  apply "Return the result of applying a function to a list of arguments.\n\nThe last argument must always be a list which gets spliced as\narguments to the function.\n\nExamples:\n\n    (apply + 1 2 '(3 4 5))   → 15\n    (apply vec '(1 2 3))     → #(3

\ No newline at end of file

             *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref))  doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void

   sym-set-doc quote))  with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings

@@ -85,9 +84,10 @@

 2076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)

   car cadr #fn("n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list)

   #fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!))))  let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)

-"z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)

-  λ #fn(map) #fn("n10B3500<:0:" #()) #fn(copy-list)

-  #fn("n10B3500T:7060:" #(void)) letrec))  bcode:code #fn("n1200Ee3:" #(aref))  make-label #fn("n120e1:" #(gensym))  bcode:cenv #fn("n1200r3e3:" #(aref))  > #fn("z12021e12273151510e163:" #(#fn(nconc)

+ym))) #fn(nconc) let list #fn(copy-list)

+  #fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!))))  let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)

+  λ #fn(map) #fn("n10B3500<:0:" #()) #fn(copy-list)

+  #fn("n10B3500T:7060:" #(void)) letrec))  bcode:code #fn("n1200Ee3:" #(aref))  make-label #fn("n120e1:" #(gensym))  bcode:cenv #fn("n1200r3e3:" #(aref))  > #fn("z12021e12273151510e163:" #(#fn(nconc)

 200r3e3:" #(aref))  > #fn("z12021e12273151510e163:" #(#fn(nconc)

   < #fn(copy-list) reverse!))  when #fn("z1200211Pqe4:" #(if begin))  quasiquote #fn("n1700E62:" #(bq-process))  help #fn("O100010002000W1000J7071?14720235272024q5386;J504873Y0251260e22687e2e327862886e229e1e42:e1e4:782;05240R3@00ZJ;0782<51@30q47960:" #(#(:print-header

   0) help-print-header getprop *doc* *funvars* begin quote when princ newline void "no help for "

--- a/src/builtins.c

+++ b/src/builtins.c

@@ -139,7 +139,7 @@

 {

 	if(nargs > 1)

 		argcount(nargs, 1);

-	sl_exit(nargs > 0 ? tofixnum(args[0]) : 0);

+	sl_exit((nargs > 0 && args[0] != sl_nil) ? tostr(args[0]) : nil);

 }

 BUILTIN("sym", sym)

--- a/src/docs_extra.lsp

+++ b/src/docs_extra.lsp

@@ -9,8 +9,8 @@

                    term))

          (callvars (and call (cdr term))))

     (if call

-        `(void (sym-set-doc ',sym ,doc ',callvars))

-        `(void (sym-set-doc ',sym ,doc)))))

+        `(sym-set-doc ',sym ,doc ',callvars)

+        `(sym-set-doc ',sym ,doc))))

 (doc-for (vm-stats)

   "Print various VM-related information, such as the number of GC

@@ -48,8 +48,14 @@

 (doc-for (rand-float)

   "Return a random float on [0.0, 1.0] interval.")

-(doc-for (exit status)

-  "Terminate the process with the specified status. Does not return.")

+(doc-for (exit (status NIL))

+  "Terminate the process with the specified status.  Does not return.

+   The status is expected to be a string in case of an error.

+

+   Examples:

+

+       (exit)

+       (exit \"error\")")

 (doc-for (file path (:read NIL)

                     (:write NIL)

--- a/src/dos/platform.h

+++ b/src/dos/platform.h

@@ -34,6 +34,14 @@

 typedef jmp_buf sl_jmp_buf;

 #define sl_setjmp(e) setjmp((e))

 #define sl_longjmp(e, v) longjmp((e), (v))

+#define exits(status) do{ \

+	const char *s = (status); \

+	exit(s == nil ? 0 : 1); \

+}while(0)

+#define sysfatal(...) do{ \

+	fprintf(stderr, __VA_ARGS__); \

+	exit(1); \

+}while(0)

 #define PATHSEP '\\'

 #define PATHSEPSTRING "\\"

--- a/src/macos/platform.h

+++ b/src/macos/platform.h

@@ -37,6 +37,14 @@

 typedef jmp_buf sl_jmp_buf;

 #define sl_setjmp(e) setjmp((e))

 #define sl_longjmp(e, v) longjmp((e), (v))

+#define exits(status) do{ \

+	const char *s = (status); \

+	exit(s == nil ? 0 : 1); \

+}while(0)

+#define sysfatal(...) do{ \

+	fprintf(stderr, __VA_ARGS__); \

+	exit(1); \

+}while(0)

 #define PATHSEP '/'

 #define PATHSEPSTRING "/"

--- a/src/plan9/platform.h

+++ b/src/plan9/platform.h

@@ -52,7 +52,6 @@

 #define unsetenv(name) putenv(name, "")

 #define setenv(name, val, overwrite) putenv(name, val)

-#define exit(x) exits((x) ? "error" : nil)

 #define isinf(x) isInf(x, 0)

 #define isnan(x) isNaN(x)

--- a/src/posix/platform.h

+++ b/src/posix/platform.h

@@ -64,6 +64,14 @@

 typedef sigjmp_buf sl_jmp_buf;

 #define sl_setjmp(e) sigsetjmp((e), 0)

 #define sl_longjmp(e, v) siglongjmp((e), (v))

+#define exits(status) do{ \

+	const char *s = (status); \

+	exit(s == nil ? 0 : 1); \

+}while(0)

+#define sysfatal(...) do{ \

+	fprintf(stderr, __VA_ARGS__); \

+	exit(1); \

+}while(0)

 #define nil NULL

 #define USED(x) ((void)(x))

--- a/src/sl.c

+++ b/src/sl.c

@@ -67,14 +67,18 @@

 }

 _Noreturn void

-sl_exit(int status)

+sl_exit(const char *status)

 {

 	if(!slg.exiting){

 		slg.exiting = true;

-		sl_applyn(1, sym_value(mk_sym("__finish", false)), fixnum(status));

+		sl_applyn(

+			1,

+			sym_value(mk_sym("__finish", false)),

+			status == nil ? sl_nil : cvalue_static_cstr(status)

+		);

 		sl_gc(false);

 	}

-	exit(status);

+	exits(status);

 }

 #define sl_TRY \

@@ -550,8 +554,7 @@

 			if(slg.tospace == nil){

 				// FIXME(sigrid): lost it entirely. give up?

 				// alternatively, wait and try indefinitely?

-				ios_printf(ios_stderr, "lost tospace\n");

-				exit(1);

+				sysfatal("lost tospace");

 			}

 			sl_raise(sl_erroom);

 		}

--- a/src/sl.h

+++ b/src/sl.h

@@ -178,7 +178,7 @@

 int sl_init(usize heapsize, usize stacksize);

 int sl_load_system_image(sl_v ios);

-_Noreturn void sl_exit(int status);

+_Noreturn void sl_exit(const char *status);

 /* collector */

 sl_v sl_relocate(sl_v v) sl_hotfn;

--- a/src/slmain.c

+++ b/src/slmain.c

@@ -57,8 +57,7 @@

 	case 0:

 		break;

 	default:

-		ios_printf(ios_stderr, "invalid size suffix '%c'\n", su);

-		exit(1);

+		sysfatal("invalid size suffix '%c'", su);

 	}

 }

@@ -66,7 +65,7 @@

 usage(void)

 {

 	ios_printf(ios_stderr, "%s: [-i] [-H heapsize] [-S stacksize] ...\n", argv0);

-	exit(1);

+	exits("usage");

 }

 _Noreturn void

@@ -99,10 +98,8 @@

 		break;

 	}ARGEND

-	if(sl_init(heapsize, stacksize) != 0){

-		ios_puts(ios_stderr, "init failed\n");

-		exit(1);

-	}

+	if(sl_init(heapsize, stacksize) != 0)

+		sysfatal("init failed");

 	u8int *unpacked = nil;

 	if(boot[0] == 0){

@@ -113,10 +110,8 @@

 			boot[4]<<24;

 		unpacked = MEM_ALLOC(unpackedsz);

 		unsigned long n = blz_depack_safe(boot+5, bootsz-5, unpacked, unpackedsz);

-		if(n == BLZ_ERROR){

-			ios_puts(ios_stderr, "failed to unpack boot image\n");

-			sl_exit(1);

-		}

+		if(n == BLZ_ERROR)

+			sysfatal("failed to unpack boot image");

 		boot = unpacked;

 		bootsz = n;

 	}

@@ -123,7 +118,7 @@

 	static sl_ios s;

 	ios_static_buffer(&s, boot, bootsz);

-	int r = 1;

+	const char *status = nil;

 	sl_v args = argv_list(argc, argv);

 	sl_gc_handle(&args);

 	sl_TRY_EXTERN{

@@ -134,7 +129,6 @@

 			ios_free(&s);

 			sl_free_gc_handles(1);

 			sl_applyn(2, sym_value(mk_sym("__start", false)), args, interactive);

-			r = 0;

 		}

 	}

 	sl_CATCH_EXTERN_NO_RESTORE{

@@ -141,7 +135,8 @@

 		ios_puts(ios_stderr, "fatal error:\n");

 		sl_print(ios_stderr, sl.lasterror);

 		ios_putc(ios_stderr, '\n');

+		status = "error";

 		break;

 	}

-	sl_exit(r);

+	sl_exit(status);

 }

--- a/src/system.lsp

+++ b/src/system.lsp

@@ -1384,7 +1384,7 @@

 (def (__script fname)

   (trycatch (load fname)

             (λ (e) (top-level-exception-handler e)

-                   (exit 1))))

+                   (exit (str e)))))

 (def (__rcscript)

   (let* ((homevar (case *os-name*

@@ -1410,14 +1410,14 @@

   (when *interactive*

     (__rcscript)

     (repl))

-  (exit 0))

+  (exit))

 (def (add-exit-hook fun)

   "Puts an one-argument function on top of the list of exit hooks.

-   On shutdown each exit hook is called with the exit status as a

-   single argument, which is (usually) `0` on success and any other

-   number on error."

+   On shutdown each exit hook is called with the exit status as a single

+   argument, which is (usually) `NIL` on success and a string describing

+   an error otherwise."

   (set! *exit-hooks* (cons fun *exit-hooks*))

   (void))

--- a/test/exit0.lsp

+++ b/test/exit0.lsp

@@ -1,1 +1,1 @@

-(exit 0)

+(exit)

--- a/test/exit1.lsp

+++ b/test/exit1.lsp

@@ -1,1 +1,1 @@

-(exit 1)

+(exit "error")

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -642,7 +642,7 @@

 (assert (eq? (sym 'blah) 'blah))

 (assert (eq? (sym "hi" "there" 'symbol 123) 'hitheresymbol123))

-(assert-fail (exit 1 2))

+(assert-fail (exit "error" 2))

 (assert (int-valued? 1.0))

 (assert (int-valued? -1.0))

--- a/tools/lzpack.c

+++ b/tools/lzpack.c

@@ -49,5 +49,5 @@

 		abort();

 	free(w);

 	free(out);

-	exit(0);

+	exits(nil);

 }