diff --git a/README.md b/README.md index bdae42428..41895333e 100644 --- a/README.md +++ b/README.md @@ -16,6 +16,7 @@ Supported platforms (bytecode interpreter may work for others): * NetBSD: x86, x86_64, ARMv6, AArch64, PowerPC32 * Solaris: x86, x86_64 * GNU/Hurd: x86, x86_64 + * Haiku: x86_64 * Android: ARMv7, AArch64 * iOS: AArch64 * WebAssembly via Emscripten (bytecode interpreter only) diff --git a/c/expeditor.c b/c/expeditor.c index af8428f2a..4c015106f 100644 --- a/c/expeditor.c +++ b/c/expeditor.c @@ -762,7 +762,7 @@ static void s_ee_set_color(int color_id, IBOOL background) { # include # include #endif -#if !defined(__GLIBC__) && !defined(__COSMOPOLITAN__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE) +#if !defined(__GLIBC__) && !defined(__COSMOPOLITAN__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__HAIKU__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE) # include #endif diff --git a/c/version.h b/c/version.h index 9141e99f8..08a3b5878 100644 --- a/c/version.h +++ b/c/version.h @@ -141,6 +141,36 @@ typedef int tputsputcchar; #endif #endif +#if defined(__HAIKU__) +#define NOBLOCK O_NONBLOCK +#define LOAD_SHARED_OBJECT +#define USE_MMAP +#define MMAP_HEAP +#define IEEE_DOUBLE +#define LDEXP +#define ARCHYPERBOLIC +#define GETPAGESIZE() getpagesize() +typedef char *memcpy_t; +#define MAKE_NAN(x) { x = 0.0; x = x / x; } +#define GETWD(x) getcwd((x),PATH_MAX) +typedef int tputsputcchar; +#define LOCKF +#define DIRMARKERP(c) ((c) == '/') +#ifndef DISABLE_X11 +#define LIBX11 "libX11.so" +#endif +#define SECATIME(sb) (sb).st_atime +#define SECCTIME(sb) (sb).st_ctime +#define SECMTIME(sb) (sb).st_mtime +#define NSECATIME(sb) 0 +#define NSECCTIME(sb) 0 +#define NSECMTIME(sb) 0 +#define ICONV_INBUF_TYPE char ** +#define USE_OSSP_UUID +#endif + + + #if defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__DragonFly__) #define NOBLOCK O_NONBLOCK #define LOAD_SHARED_OBJECT diff --git a/configure b/configure index be1fe106e..be2f94389 100755 --- a/configure +++ b/configure @@ -143,6 +143,11 @@ case "${CONFIG_UNAME}" in installprefix=/usr installmansuffix=share/man ;; + Haiku) + unixsuffix=hk + installprefix=/system + installmansuffix=documentation/man + ;; QNX) if uname -m | egrep 'x86' > /dev/null 2>&1 ; then m32=i3qnx @@ -777,7 +782,7 @@ fi # Infer flags needed for threads: case "${flagsm}" in - t*le|t*gnu|t*fb|t*ob|t*nb) + t*le|t*gnu|t*fb|t*ob|t*nb|t*hk) threadFlags="-D_REENTRANT -pthread" threadLibs="-lpthread" ;; @@ -887,7 +892,7 @@ fi # Add automatic linking flags, unless suppressed by --disable-auto-flags if [ "$addflags" = "yes" ] ; then case "${flagsm}" in - *le|*gnu) + *le|*gnu|*hk) LDFLAGS="${LDFLAGS} -rdynamic" ;; *fb|*nb) @@ -904,7 +909,7 @@ if [ "$addflags" = "yes" ] ; then *le|*gnu) LIBS="${LIBS} -lm -ldl ${ncursesLib} -lrt" ;; - *fb|*ob) + *fb|*ob|*hk) LIBS="${LIBS} ${iconvLib} -lm ${ncursesLib}" ;; *nb) @@ -997,7 +1002,7 @@ exeSuffix= # compile flags for c/Mf-unix and mats/Mf-unix case "${flagsmuni}" in - *le|*gnu) + *le|*gnu|*hk) mdcflags="-fPIC -shared" ;; *fb|*ob) @@ -1031,7 +1036,7 @@ case "${flagsmuni}" in i3le) mdldflags="-melf_i386" ;; - *le|*gnu) + *le|*gnu|*hk) ;; i3nb) mdldflags="-m elf_i386" diff --git a/csug/foreign.stex b/csug/foreign.stex index 31e6780dc..c05bb1a58 100644 --- a/csug/foreign.stex +++ b/csug/foreign.stex @@ -2968,6 +2968,11 @@ On Windows: (load-shared-object "msvcrt.dll") \endschemedisplay +On Haiku: +\schemedisplay +(load-shared-object "libroot.so") +\endschemedisplay + Once the C library has been loaded, \scheme{getenv} should be available as a foreign entry. @@ -3009,7 +3014,7 @@ The files must be compiled and linked into a shared object before they can be loaded. How this is done depends upon the host system. \noindent -On Linux, FreeBSD, OpenBSD, and OpenSolaris systems: +On Linux, FreeBSD, Haiku, OpenBSD, and OpenSolaris systems: \schemedisplay (system "cc -fPIC -shared -o evenodd.so even.c odd.c") diff --git a/makefiles/install.zuo b/makefiles/install.zuo index ada123303..d0a89a09f 100644 --- a/makefiles/install.zuo +++ b/makefiles/install.zuo @@ -179,8 +179,12 @@ (shell/wait* "rm" "-f" f)) (define (rm-rf d) (shell/wait* "rm" "-rf" d)) + (define haiku? (glob-match? "*hk" m)) (define (ln-f from to) - (shell/wait* "ln" "-f" from to)) + (if haiku? + ;; no hard links on BeFS + (shell/wait* "ln" "-s" from to) + (shell/wait* "ln" "-f" from to))) (define (ln-s from to) (shell/wait* "ln" "-s" from to)) diff --git a/mats/bytevector.ms b/mats/bytevector.ms index 13b10b155..cdc2a82b5 100644 --- a/mats/bytevector.ms +++ b/mats/bytevector.ms @@ -36,7 +36,7 @@ i3osx ti3osx a6le ta6le a6nb ta6nb a6osx ta6osx a6ios ta6ios a6fb ta6fb a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx arm32le tarm32le arm64le tarm64le arm64osx tarm64osx arm64ios tarm64ios rv64le trv64le - la64le tla64le) + la64le tla64le a6hk ta6hk) 'little] [(ppc32le tppc32le ppc32osx tppc32osx) 'big] [(pb tpb) (native-endianness)] diff --git a/mats/foreign.ms b/mats/foreign.ms index ea6f9f7d1..8d5792f3a 100644 --- a/mats/foreign.ms +++ b/mats/foreign.ms @@ -209,6 +209,14 @@ (error? (load-shared-object 3)) ) ] + [(a6hk ta6hk) + (mat load-shared-object + (file-exists? foreign1.so) + (begin (load-shared-object foreign1.so) #t) + (begin (load-shared-object "libroot.so") #t) + (error? (load-shared-object 3)) + ) + ] [(i3fb ti3fb a6fb ta6fb) (mat load-shared-object (file-exists? foreign1.so) @@ -3372,6 +3380,8 @@ '(load-shared-object "libc.so")] [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le la64le tla64le) '(load-shared-object "libc.so.6")] + [(a6hk ta6hk) + '(load-shared-object "libroot.so")] [(i3fb ti3fb a6fb ta6fb) '(load-shared-object "libc.so.7")] [(i3nt ti3nt a6nt ta6nt arm64nt tarm64nt) diff --git a/mats/mat.ss b/mats/mat.ss index 759bb8daa..26477fea9 100644 --- a/mats/mat.ss +++ b/mats/mat.ss @@ -121,24 +121,39 @@ [else c]))) (define (condition-message c) (define prefix? - (lambda (x y) + (lambda (x y y-start) (let ([n (string-length x)]) - (and (fx<= n (string-length y)) + (and (fx<= n (- (string-length y) y-start)) (let prefix? ([i 0]) (or (fx= i n) - (and (char=? (string-ref x i) (string-ref y i)) + (and (char=? (string-ref x i) (string-ref y (+ i y-start))) (prefix? (fx+ i 1))))))))) (define prune-prefix (lambda (x y) - (and (prefix? x y) + (and (prefix? x y 0) (substring y (string-length x) (string-length y))))) - (let ([s (call-with-string-output-port - (lambda (p) (display-condition c p)))]) - (or (prune-prefix "Exception: " s) - (prune-prefix "Exception in " s) - (prune-prefix "Warning: " s) - (prune-prefix "Warning in " s) - s))) + (define rewrite-message + (lambda (s from to) + (let rewrite ([i 0]) + (cond + [(= i (string-length s)) + s] + [(prefix? from s i) + (string-append (substring s 0 i) + to + (substring s (+ i (string-length from)) (string-length s)))] + [else (rewrite (add1 i))])))) + (let* ([s (call-with-string-output-port + (lambda (p) (display-condition c p)))] + [s (or (prune-prefix "Exception: " s) + (prune-prefix "Exception in " s) + (prune-prefix "Warning: " s) + (prune-prefix "Warning in " s) + s)] + [s (rewrite-message s + "file or directory already exists" + "file exists")]) + s)) (define (condition-type c) (case (fxior (if (warning? c) 1 0) (if (error? c) 2 0) (if (violation? c) 4 0)) [(1) 'warning] @@ -518,6 +533,11 @@ (lambda () #t) (lambda () #f))) +(define haiku? + (if (memq (machine-type) '(a6hk ta6hk)) + (lambda () #t) + (lambda () #f))) + (define embedded? (lambda () #f)) diff --git a/mats/primvars.ms b/mats/primvars.ms index bbf6cd3bc..e816840d2 100644 --- a/mats/primvars.ms +++ b/mats/primvars.ms @@ -18,7 +18,7 @@ (define (mat-id? x) (memq x '(equivalent-expansion? mat-run mat mat/cf - mat-file mat-output enable-cp0 windows? embedded? pb? + mat-file mat-output enable-cp0 windows? embedded? pb? haiku? *scheme* *mats-dir* *fuzz* ~= fl~= cfl~= == nan pi +pi +pi/2 +pi/4 -pi -pi/2 -pi/4 +e -e separate-eval-tools separate-compile separate-eval run-script patch-exec-path $record->vector diff --git a/mats/unix.ms b/mats/unix.ms index b59c8c6dc..57a43bc44 100644 --- a/mats/unix.ms +++ b/mats/unix.ms @@ -13,7 +13,7 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(if (or (windows?) (equal? (getenv "USER") "root") (embedded?)) +(if (or (windows?) (haiku?) (equal? (getenv "USER") "root") (embedded?)) (mat unix-file-io (error? (errorf 'open-output-file "failed for testfile.ss: file exists")) (error? (errorf 'open-output-file "failed for testfile.ss: file exists")) @@ -177,7 +177,7 @@ ) ) -(if (or (windows?) (equal? (getenv "USER") "root") (embedded?)) +(if (or (windows?) (haiku?) (equal? (getenv "USER") "root") (embedded?)) (mat file-operations (error? (errorf 'delete-directory "failed for ~a: ~a" "testlink1" "not a directory")) (error? (errorf 'delete-directory "failed for ~a: ~a" "testlink2" "not a directory")) diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 0d0d63d87..03bbbbd20 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -89,6 +89,10 @@ procedure) is given in parentheses. \item x86, nonthreaded (i3s2) and threaded (ti3s2) \item x86\_64, nonthreaded (a6s2) and threaded (ta6s2) \end{itemizeC} +\item Haiku + \begin{itemizeC} + \item x86\_64, nonthreaded (a6hk) and threaded (ta6hk) + \end{itemizeC} \item Other platforms \begin{itemizeC} \item bytecode interpretation (pb, tpb, pb32l, tpb32l, pb32b, tpb32b, pb64l, tpb64l, pb64b, tpb64b) diff --git a/s/cmacros.ss b/s/cmacros.ss index b89465f6a..40b7738d0 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -419,6 +419,7 @@ rv64ob trv64ob rv64nb trv64nb la64le tla64le + a6hk ta6hk ) (include "machine.def")