move malloc & double to package/extensions

FossilOrigin-Name: 072c6e6b0eb0f21ce985d84fc8c5f032172e3116ec765c61d85fb60aa3ff74d4
This commit is contained in:
crc 2023-10-23 18:23:23 +00:00
parent 3eec5480ab
commit f7310bb6cc
11 changed files with 796 additions and 749 deletions

View file

@ -54,8 +54,6 @@ DEVICES += interface/unsigned.retro
DEVICES += interface/future.retro DEVICES += interface/future.retro
DEVICES += interface/block.retro DEVICES += interface/block.retro
DEVICES += interface/deprecated.retro DEVICES += interface/deprecated.retro
DEVICES += interface/double.retro
DEVICES += interface/malloc.retro
DEVICES += interface/error.retro DEVICES += interface/error.retro
DEVICES += interface/final.retro DEVICES += interface/final.retro

View file

@ -23,5 +23,7 @@
- quieter output when building - quieter output when building
- remove old Python build + packaging code - remove old Python build + packaging code
- small optimizations in fll: vocabulary - small optimizations in fll: vocabulary
- move from interface/ to package/extensions/:
double.retro malloc.retro
================================================================ ================================================================

View file

@ -8,6 +8,7 @@ String deduplication for RetroForth.
'init s:keep fll:create 's:dedup.data var-n 'init s:keep fll:create 's:dedup.data var-n
{{ {{
'Temp d:create #1024 allot
't1 var 't1 var
't2 var 't2 var
---reveal--- ---reveal---
@ -21,8 +22,20 @@ String deduplication for RetroForth.
@s:dedup.data [ dup @t1 s:eq? [ !t2 ] &drop choose ] @s:dedup.data [ dup @t1 s:eq? [ !t2 ] &drop choose ]
fll:for-each @t2 ; fll:for-each @t2 ;
:s:dedup (s-s) :s:dedup (s-s)
&Temp s:copy &Temp
dup s:dedup.defined? &s:dedup.find &s:dedup.register dup s:dedup.defined? &s:dedup.find &s:dedup.register
choose ; choose ;
:s:unique? (s-f) s:dedup.defined? ; :s:unique? (s-f) s:dedup.defined? ;
}} }}
~~~ ~~~
~~~
'interface/dedup.retro s:dedup
dup 's:unique? d:lookup d:source store
dup 's:dedup d:lookup d:source store
dup 's:dedup.find d:lookup d:source store
dup 's:dedup.defined? d:lookup d:source store
dup 's:dedup.register d:lookup d:source store
dup 's:dedup.data d:lookup d:source store
drop
~~~

View file

@ -1,27 +0,0 @@
~~~
:double:var (nns-)
d:create swap , , ;
:double:fetch (a-nn)
fetch-next swap fetch ;
:double:store (nna-)
&swap dip store-next store ;
:double:const (nns-)
double:var &double:fetch does ;
:double:swap (nnmm-mmnn)
rot push rot pop ;
:double:dip (mnq-mn) rot rot push push call pop pop ;
:double:sip (mnq-mn) &dup-pair dip double:dip ;
'interface/double.retro 'double:var d:set-source
'interface/double.retro 'double:fetch d:set-source
'interface/double.retro 'double:store d:set-source
'interface/double.retro 'double:const d:set-source
'interface/double.retro 'double:swap d:set-source
'interface/double.retro 'double:sip d:set-source
'interface/double.retro 'double:dip d:set-source
~~~

View file

@ -174,7 +174,7 @@ once for each line in a file. This makes some things trivial. E.g., a simple
## d:source ## d:source
~~~ ~~~
'interface/filesystem.retro 'interface/filesystem.retro s:dedup
dup 'file:spew d:set-source dup 'file:spew d:set-source
dup 'file:slurp d:set-source dup 'file:slurp d:set-source
dup 'file:for-each-line d:set-source dup 'file:for-each-line d:set-source

View file

@ -210,7 +210,7 @@ Deal with special cases.
## Populate d:source ## Populate d:source
~~~ ~~~
'interface/floatingpoint.retro 'interface/floatingpoint.retro s:dedup
dup 'e:put d:set-source dup 'e:put d:set-source
dup 'f:dump-astack d:set-source dup 'f:dump-astack d:set-source
dup 'f:dump-stack d:set-source dup 'f:dump-stack d:set-source

View file

@ -137,7 +137,7 @@ seconds.
## d:source ## d:source
~~~ ~~~
'interface/unix.retro 'interface/unix.retro s:dedup
dup 'unix:slurp-pipe d:set-source dup 'unix:slurp-pipe d:set-source
dup 'unix:for-each-file d:set-source dup 'unix:for-each-file d:set-source
dup 'unix:count-files-in-cwd d:set-source dup 'unix:count-files-in-cwd d:set-source

View file

@ -0,0 +1,19 @@
~~~
:double:var (nns-)
d:create swap , , ;
:double:fetch (a-nn)
fetch-next swap fetch ;
:double:store (nna-)
&swap dip store-next store ;
:double:const (nns-)
double:var &double:fetch does ;
:double:swap (nnmm-mmnn)
rot push rot pop ;
:double:dip (mnq-mn) rot rot push push call pop pop ;
:double:sip (mnq-mn) &dup-pair dip double:dip ;
~~~

View file

@ -1,7 +1,6 @@
# Malloc # Malloc
~~~ ~~~
{{ {{
:mem:invoke #15 io:scan-for io:invoke ; :mem:invoke #15 io:scan-for io:invoke ;
@ -25,14 +24,4 @@
dup #1 mem:cell+ fetch push mem:fetch pop ; dup #1 mem:cell+ fetch push mem:fetch pop ;
:mem:store-double (ann-nn) :mem:store-double (ann-nn)
push push dup-pair #1 mem:cell+ pop mem:store pop mem:store ; push push dup-pair #1 mem:cell+ pop mem:store pop mem:store ;
'interface/malloc.retro 'mem:alloc d:set-source
'interface/malloc.retro 'mem:store d:set-source
'interface/malloc.retro 'mem:fetch d:set-source
'interface/malloc.retro 'mem:free d:set-source
'interface/malloc.retro 'mem:size d:set-source
'interface/malloc.retro 'mem:resize d:set-source
'interface/malloc.retro 'mem:cell+ d:set-source
'interface/malloc.retro 'mem:fetch-double d:set-source
'interface/malloc.retro 'mem:store-double d:set-source
~~~ ~~~

View file

@ -1,3 +1,5 @@
~~~ ~~~
'extensions/README.retro include 'extensions/README.retro include
'extensions/double.retro include
'extensions/malloc.retro include
~~~ ~~~

File diff suppressed because it is too large Load diff