The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
c1614af
)
Added OOM check.
author
Tim Vaughan
<tgvaughan@gmail.com>
Sun, 23 Oct 2016 03:06:38 +0000
(16:06 +1300)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Sun, 23 Oct 2016 03:06:38 +0000
(16:06 +1300)
scheme.4th
patch
|
blob
|
history
diff --git
a/scheme.4th
b/scheme.4th
index
3ea9d66
..
3c4744e
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-35,15
+35,15
@@
make-type compound-proc-type
\ ------ Cons cell memory ------ {{{
\ ------ Cons cell memory ------ {{{
-1000
0 constant N
-create car-cells
N
allot
-create car-type-cells
N
allot
-create cdr-cells
N
allot
-create cdr-type-cells
N
allot
+1000
constant scheme-memsize
+create car-cells
scheme-memsize
allot
+create car-type-cells
scheme-memsize
allot
+create cdr-cells
scheme-memsize
allot
+create cdr-type-cells
scheme-memsize
allot
-create nextfrees
N
allot
+create nextfrees
scheme-memsize
allot
:noname
:noname
-
N
0 do
+
scheme-memsize
0 do
i 1+ nextfrees i + !
loop
; execute
i 1+ nextfrees i + !
loop
; execute
@@
-53,7
+53,15
@@
variable nextfree
: inc-nextfree
nextfrees nextfree @ + @
: inc-nextfree
nextfrees nextfree @ + @
- nextfree ! ;
+
+ dup scheme-memsize < if
+ nextfree !
+ else
+ bold fg red
+ ." Out of memory! Aborting."
+ reset-term abort
+ then
+;
: cons ( car-obj cdr-obj -- pair-obj )
cdr-type-cells nextfree @ + !
: cons ( car-obj cdr-obj -- pair-obj )
cdr-type-cells nextfree @ + !
@@
-173,8
+181,8
@@
false gc-enabled !
;
: gc-sweep
;
: gc-sweep
-
N
nextfree !
- 0
N
1- do
+
scheme-memsize
nextfree !
+ 0
scheme-memsize
1- do
nextfrees i + @ 0<> if
nextfree @ nextfrees i + !
i nextfree !
nextfrees i + @ 0<> if
nextfree @ nextfrees i + !
i nextfree !