From 9e21704825800f0e624aba0a3507603c6dd8e0e3 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Tue, 20 Oct 2020 22:21:20 -0500
Subject: [PATCH] add large-object allocation (over 4 MB) with mmap

---
 jumpforth.S |  4 ++--
 startup.4th | 24 ++++++++++++++++++++++--
 2 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/jumpforth.S b/jumpforth.S
index 048900f..e6a073f 100644
--- a/jumpforth.S
+++ b/jumpforth.S
@@ -257,7 +257,7 @@ defconst SYS_BRK,__NR_brk
 /* defconst SYS_SWAPON,__NR_swapon */
 /* defconst SYS_REBOOT,__NR_reboot */
 /* defconst SYS_READDIR,__NR_readdir */
-/* defconst SYS_MUNMAP,__NR_munmap */
+defconst SYS_MUNMAP,__NR_munmap
 /* defconst SYS_GETPRIORITY,__NR_getpriority */
 /* defconst SYS_SETPRIORITY,__NR_setpriority */
 /* defconst SYS_IOPERM,__NR_ioperm */
@@ -321,7 +321,7 @@ defconst SYS_BRK,__NR_brk
 /* defconst SYS_CAPSET,__NR_capset */
 /* defconst SYS_SIGALTSTACK,__NR_sigaltstack */
 /* defconst SYS_VFORK,__NR_vfork */
-/* defconst SYS_MMAP2,__NR_mmap2 */
+defconst SYS_MMAP2,__NR_mmap2
 /* defconst SYS_TRUNCATE64,__NR_truncate64 */
 /* defconst SYS_FTRUNCATE64,__NR_ftruncate64 */
 /* defconst SYS_STAT64,__NR_stat64 */
diff --git a/startup.4th b/startup.4th
index 066252f..3d1b7e8 100644
--- a/startup.4th
+++ b/startup.4th
@@ -710,13 +710,33 @@ VARIABLE TOTAL
 : ALIGN-TO ( u -- )
    HERE SWAP ALIGNED-TO HERE - ALLOT ;
 
+0 CONSTANT NULL
+: KB 10 LSHIFT ;
+: MB 20 LSHIFT ;
+
 : ALLOCATE ( size -- a-addr )
-   CELL+ DUP BUDDY-MAX-BYTES CELL- U> "unsupported size" ?FAIL
+   CELL+ DUP BUDDY-MAX-BYTES U> IF
+MARK A
+      BEGIN
+         NULL OVER PROT_READ PROT_WRITE OR
+         MAP_PRIVATE MAP_ANONYMOUS OR -1 0 SYS_MMAP2 SYSCALL6
+         DUP -4095 U>=
+      WHILE
+         NEGATE ERRNO_EINTR <> IF EXCP-HEAP-OVERFLOW THROW THEN
+      REPEAT
+      TUCK ! CELL+ EXIT
+   THEN
+MARK B
    NATURALLY-ALIGNED DUP BUDDY-MIN-BYTES U< IF DROP BUDDY-MIN-BYTES THEN
    BUDDY-ORDER-FROM-BYTES DUP BUDDY-ALLOCATE SWAP OVER ! CELL+ ;
 
 : FREE ( a-addr -- )
-   CELL- DUP @ SWAP BUDDY-FREE ;
+   CELL- DUP @
+   DUP BUDDY-ORDERS U< IF SWAP BUDDY-FREE EXIT THEN
+   BEGIN
+      2DUP SYS_MUNMAP SYSCALL2 ?DUP 0= IF 2DROP EXIT THEN
+      NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL
+   AGAIN ;
 
 \ Read the next word and return the first character
 : CHAR ( "<spaces>name" -- c )