ref: cd1803dc65daac66b7895d716238e53b6c507af4
parent: 27361e559d2f21cf0ce729b7f58bb60b1fcb96a1
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Jan 16 21:00:51 EST 2025
add a DOS port, via djgpp cross-compiler
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,4 @@
builtin_fns.h
*.core
plan9/flisp.boot.s
+cross/*-toolchain
--- a/3rd/fn.h
+++ b/3rd/fn.h
@@ -125,6 +125,7 @@
}
// sanity checks!
+/*
static_assert(Tix_base_bitmap + Tix_width_bitmap == 64,
"index fields must fill a 64 bit word");
@@ -136,7 +137,7 @@
static_assert(Tunmask(shift,0xFEDCBAULL) == 5,
"extracting the shift works");
-
+*/
// ..key[o%5==0].. ..key[o%5==1].. ..key[o%5==2].. ..key[o%5==3].. ..key[o%5==4]..
// | | | | | |
// 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
--- a/README.md
+++ b/README.md
@@ -11,7 +11,7 @@
Tested on: 9front/arm64, OpenBSD/386, NetBSD/sparc64, Alpine/amd64, Android/arm64.
-Also runs on: MacOS 4.x-9.x.
+Also runs on: MacOS 4.x-9.x, DOS.
Some of the changes from the original include:
@@ -47,7 +47,7 @@
### MacOS 4.x-9.x (m68k or PowerPC)
-Install and build [Retro68](https://git.sr.ht/~ft/retro68). This fork grabs the
+Clone and build [Retro68](https://git.sr.ht/~ft/retro68). This fork grabs the
necessary patches for more things to work as expected:
git clone https://git.sr.ht/~ft/retro68
@@ -70,6 +70,16 @@
NOTE: this isn't a full-fledged port and is going to stay low priority unless somebody
wants to spend time polishing it.
+
+### DOS
+
+Build DJGPP cross-compiler, then:
+
+ ln -s djgpp-toolchain-prefix cross/djgpp-toolchain
+ meson setup build . -Dbuildtype=minsize --cross-file cross/djgpp.txt
+ ninja -C build
+
+Result is `build/flisp.exe`.
## Characteristics
--- /dev/null
+++ b/cross/djgpp.txt
@@ -1,0 +1,21 @@
+[constants]
+toolchain = '@DIRNAME@/djgpp-toolchain/'
+path = toolchain + 'bin/'
+prefix = path + 'i586-pc-msdosdjgpp-'
+
+[built-in options]
+c_args = ['-D__dos__']
+cpp_args = c_args
+
+[binaries]
+c = prefix + 'gcc'
+cpp = prefix + 'g++'
+as = prefix + 'as'
+ar = prefix + 'ar'
+strip = prefix + 'strip'
+
+[host_machine]
+system = 'dos'
+cpu_family = 'x86'
+cpu = 'i586'
+endian = 'little'
--- /dev/null
+++ b/dos/platform.h
@@ -1,0 +1,43 @@
+#pragma once
+
+#define _XOPEN_SOURCE 700
+#include <assert.h>
+#include <ctype.h>
+#include <machine/endian.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <float.h>
+#include <inttypes.h>
+#include <limits.h>
+#include <locale.h>
+#include <math.h>
+#include <setjmp.h>
+#include <stdbool.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stddef.h>
+#include <stdint.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <wctype.h>
+#include <wchar.h>
+
+#define __os_name__ "dos"
+
+#define nil NULL
+#define USED(x) ((void)(x))
+#define nelem(x) (int)(sizeof(x)/sizeof((x)[0]))
+
+#define PATHSEP '\\'
+#define PATHSEPSTRING "\\"
+#define PATHLISTSEP ':'
+#define PATHLISTSEPSTRING ":"
+#define ISPATHSEP(c) ((c) == '\\')
+
+#include "cc.h"
+#include "mem.h"
--- a/flisp.boot
+++ b/flisp.boot
@@ -15,7 +15,8 @@
#fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #()))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 #fn("5000n10\x8e:" #())0)
- *properties* #table(*funvars* #table(>= ((a . rest)) void? ((x)) length= ((lst n)) help ((term)) lz-unpack ((data
+ *os-version* "6.12.9-0-edge" *properties*
+ #table(*funvars* #table(>= ((a . rest)) void? ((x)) length= ((lst n)) help ((term)) lz-unpack ((data
:to destination)
(data :size decompressed-bytes)) = ((a . rest)) <= ((a . rest)) car ((lst)) /= ((a . rest)) void (rest) *prompt* (#f) nan? ((x)) lz-pack ((data
(level 0))) cons? ((value)) vm-stats (nil) * ((number…)) cdr ((lst)) > ((a . rest)) + ((number…))) *doc* #table(+ "Return sum of the numbers or 0 with no arguments." >= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." lz-unpack "Return decompressed data previously compressed using lz-pack.\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." = "Return #t if the arguments are equal." <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." *builtins* "VM instructions as closures." car "Returns the first element of a list or nil if not available." /= "Return #t if not all arguments are equal. Shorthand for (not (= …))." void "Return the constant #<void> while ignoring any arguments.\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." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." nan? "Return #t if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." cons? "Returns #t if the value is a cons cell." * "Return product of the numbers or 1 with no arguments." > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Returns the tail of a list or nil if not available." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
@@ -56,10 +57,10 @@
> #fn(";000z1\x8d\x8a6862086>1_486<^10162:" #(#fn("7000n21V;IE041<0L2;3;04A<1<1=62:" #())) >) >= #fn(";000z1\x8d\x8a6862086>1_486<^10162:" #(#fn("7000n21V;IL0401<L2;I5040\x8e340O:A<1<1=62:" #())) >=)Instructions #table(call.l 81 trycatch 75 largc 79 loadg.l 68 aref2 23 box 90 cadr 36 argc 62 setg 71 load0 21 nan? 94 vector? 45 fixnum? 41 loadc0 17 loada0 0 div0 59 keyargs 89 call 5 loada.l 69 brt.l 50 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 loadvoid 93 loada1 1 shift 46 boolean? 39 atom? 24 cdr 13 brne.l 83 / 58 loadf 31 equal? 52 apply 54 dup 11 loadt 20 jmp.l 48 null? 38 not 35 = 60 set-cdr! 30 eq? 33 * 57 load1 27 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 95 + 55 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 cons? 18 brf.l 49 aref 92 symbol? 34 aset! 64 car 12 cons 32 tcall.l 82 - 56 brn.l 86 optargs 87 closure 14 pop 4 eqv? 51 list 53 seta 15 seta.l 73 brnn 26 loadnil 65 loadg 7 loada 8 tcall 6)
- __init_globals #fn("7000n07021l237022@402384w4^1425w6427w8479w:47;w<47=w>:" #(*os-name*+ __init_globals #fn("7000n07021d37022@402384w4^147025d;350426;I50427w8429w:47;w<47=w>47?w@:" #(*os-name* "macos" #fn("6000n0702161:" #(princ "\e[0m\e[1m#;> \e[0m"))- #fn("6000n0702161:" #(princ "#;> ")) *prompt* "/" *directory-separator* "\n" *linefeed* *stdout*- *output-stream* *stdin* *input-stream* *stderr* *error-stream*) __init_globals)
+ #fn("6000n0702161:" #(princ "#;> ")) *prompt* "dos" "\\" "/" *directory-separator* "\n"+ *linefeed* *stdout* *output-stream* *stdin* *input-stream* *stderr* *error-stream*) __init_globals)
__rcscript #fn("=000n0708421c360O@T08422c37023@G08424c3=07526514O@4027^184;390428845185;3=0429857:2;53863B02<86513907=8661:O:" #(*os-name*"unknown" "plan9" "home" "macos" princ "\e]0;femtolisp v0.999\a" "HOME" #fn(os-getenv)
#fn(string) *directory-separator* ".flisprc" #fn(path-exists?) load) __rcscript)
binary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/flisp.h
+++ b/flisp.h
@@ -5,6 +5,9 @@
#include "mp.h"
#include "utf.h"
#endif
+#ifdef __dos__
+int wcwidth(Rune c);
+#endif
#include "utf8.h"
#include "ios.h"
#include "tbl.h"
--- a/ios.c
+++ b/ios.c
@@ -22,7 +22,7 @@
return nil;
}
-#if !defined(__plan9__) && !defined(__macos__)
+#if !defined(__plan9__) && !defined(__macos__) && !defined(__dos__)
static int
_enonfatal(int err)
{@@ -39,7 +39,7 @@
ssize_t r;
while(1){-#if !defined(__plan9__) && !defined(__macos__)
+#if !defined(__plan9__) && !defined(__macos__) && !defined(__dos__)
errno = 0;
#endif
r = read(fd, buf, n);
@@ -47,7 +47,7 @@
*nread = (size_t)r;
break;
}
-#if defined(__plan9__) || defined(__macos__)
+#if defined(__plan9__) || defined(__macos__) || defined(__dos__)
return r;
#else
if(!_enonfatal(errno)){@@ -84,7 +84,7 @@
ssize_t r;
while(1){-#if !defined(__plan9__) && !defined(__macos__)
+#if !defined(__plan9__) && !defined(__macos__) && !defined(__dos__)
errno = 0;
#endif
r = write(fd, buf, n);
@@ -92,7 +92,7 @@
*nwritten = (size_t)r;
break;
}
-#if defined(__plan9__) || defined(__macos__)
+#if defined(__plan9__) || defined(__macos__) || defined(__dos__)
return r;
#else
if(!_enonfatal(errno)){--- a/meson.build
+++ b/meson.build
@@ -4,7 +4,6 @@
version: '0.999',
meson_version: '>=1.1.0',
default_options: [
- 'c_std=c2x',
'warning_level=3',
'buildtype=debugoptimized',
'b_ndebug=if-release'
@@ -64,8 +63,6 @@
)
endif
-platform = 'posix'
-
src_common = [
'nan.c',
]
@@ -109,7 +106,17 @@
cpp.find_library('RetroConsole', required: true), cpp.find_library('retrocrt', required: true),]
+elif host_machine.system() == 'dos'
+ flisp_exe_name = 'flisp.exe'
+ platform = 'dos'
+ add_project_arguments(
+ '-DINITIAL_HEAP_SIZE=2*1024*1024',
+ '-DALLOC_LIMIT_TRIGGER=256*1024*1024',
+ language: 'c',
+ )
+ extras = []
else
+ platform = 'posix'
flisp_exe_name = 'flisp'
add_project_arguments(
'-DINITIAL_HEAP_SIZE=8*1024*1024',
@@ -157,6 +164,10 @@
'types.c',
'utf8.c',
]
+
+if host_machine.system() == 'dos'
+ src_flisp += ['3rd/wcwidth.c']
+endif
math = cc.find_library('m', required: false)--- /dev/null
+++ b/sys_dos.c
@@ -1,0 +1,52 @@
+#include "flisp.h"
+#include "timefuncs.h"
+
+double
+sec_realtime(void)
+{+ return 0.0;
+}
+
+uint64_t
+nanosec_monotonic(void)
+{+ return 0;
+}
+
+void
+timestring(double s, char *buf, int sz)
+{+ time_t tme = (time_t)s;
+ struct tm tm;
+
+ localtime_r(&tme, &tm);
+ strftime(buf, sz, "%c", &tm);
+}
+
+double
+parsetime(const char *s)
+{+ return -1;
+}
+
+void
+sleep_ms(int ms)
+{+ if(ms != 0){+ struct timeval timeout;
+ timeout.tv_sec = ms/1000;
+ timeout.tv_usec = (ms % 1000) * 1000;
+ select(0, nil, nil, nil, &timeout);
+ }
+}
+
+static const uint8_t boot[] = {+#include "flisp.boot.h"
+};
+
+int
+main(int argc, char **argv)
+{+ setlocale(LC_NUMERIC, "C");
+ flmain(boot, sizeof(boot), argc, argv);
+}
--- a/system.lsp
+++ b/system.lsp
@@ -1114,13 +1114,13 @@
; initialize globals that need to be set at load time
(define (__init_globals)
- (let ((defprompt (if (= *os-name* "macos")
+ (let ((defprompt (if (equal? *os-name* "macos")
(λ () (princ "\x1b[0m\x1b[1m#;> \x1b[0m"))
(λ () (princ "#;> ")))))
(set! *prompt*
"Function called by REPL to signal the user input is required.
Default function prints \"#;> \"." defprompt))
- (set! *directory-separator* "/")
+ (set! *directory-separator* (or (and (equal? *os-name* "dos") "\\") "/"))
(set! *linefeed* "\n")
(set! *output-stream* *stdout*)
(set! *input-stream* *stdin*)