mirror of
https://git.sr.ht/~crc_/retroforth
synced 2024-11-16 19:48:56 +01:00
move malloc & double to package/extensions
FossilOrigin-Name: 072c6e6b0eb0f21ce985d84fc8c5f032172e3116ec765c61d85fb60aa3ff74d4
This commit is contained in:
parent
3eec5480ab
commit
f7310bb6cc
11 changed files with 796 additions and 749 deletions
|
@ -54,8 +54,6 @@ DEVICES += interface/unsigned.retro
|
|||
DEVICES += interface/future.retro
|
||||
DEVICES += interface/block.retro
|
||||
DEVICES += interface/deprecated.retro
|
||||
DEVICES += interface/double.retro
|
||||
DEVICES += interface/malloc.retro
|
||||
DEVICES += interface/error.retro
|
||||
DEVICES += interface/final.retro
|
||||
|
||||
|
|
|
@ -23,5 +23,7 @@
|
|||
- quieter output when building
|
||||
- remove old Python build + packaging code
|
||||
- small optimizations in fll: vocabulary
|
||||
- move from interface/ to package/extensions/:
|
||||
double.retro malloc.retro
|
||||
|
||||
================================================================
|
||||
|
|
|
@ -8,6 +8,7 @@ String deduplication for RetroForth.
|
|||
'init s:keep fll:create 's:dedup.data var-n
|
||||
|
||||
{{
|
||||
'Temp d:create #1024 allot
|
||||
't1 var
|
||||
't2 var
|
||||
---reveal---
|
||||
|
@ -21,8 +22,20 @@ String deduplication for RetroForth.
|
|||
@s:dedup.data [ dup @t1 s:eq? [ !t2 ] &drop choose ]
|
||||
fll:for-each @t2 ;
|
||||
:s:dedup (s-s)
|
||||
&Temp s:copy &Temp
|
||||
dup s:dedup.defined? &s:dedup.find &s:dedup.register
|
||||
choose ;
|
||||
: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
|
||||
~~~
|
||||
|
|
|
@ -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
|
||||
~~~
|
|
@ -174,7 +174,7 @@ once for each line in a file. This makes some things trivial. E.g., a simple
|
|||
## d:source
|
||||
|
||||
~~~
|
||||
'interface/filesystem.retro
|
||||
'interface/filesystem.retro s:dedup
|
||||
dup 'file:spew d:set-source
|
||||
dup 'file:slurp d:set-source
|
||||
dup 'file:for-each-line d:set-source
|
||||
|
|
|
@ -210,7 +210,7 @@ Deal with special cases.
|
|||
## Populate d:source
|
||||
|
||||
~~~
|
||||
'interface/floatingpoint.retro
|
||||
'interface/floatingpoint.retro s:dedup
|
||||
dup 'e:put d:set-source
|
||||
dup 'f:dump-astack d:set-source
|
||||
dup 'f:dump-stack d:set-source
|
||||
|
|
|
@ -137,7 +137,7 @@ seconds.
|
|||
## d:source
|
||||
|
||||
~~~
|
||||
'interface/unix.retro
|
||||
'interface/unix.retro s:dedup
|
||||
dup 'unix:slurp-pipe d:set-source
|
||||
dup 'unix:for-each-file d:set-source
|
||||
dup 'unix:count-files-in-cwd d:set-source
|
||||
|
|
19
package/extensions/double.retro
Normal file
19
package/extensions/double.retro
Normal 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 ;
|
||||
~~~
|
|
@ -1,7 +1,6 @@
|
|||
# Malloc
|
||||
|
||||
~~~
|
||||
|
||||
{{
|
||||
:mem:invoke #15 io:scan-for io:invoke ;
|
||||
|
||||
|
@ -25,14 +24,4 @@
|
|||
dup #1 mem:cell+ fetch push mem:fetch pop ;
|
||||
:mem:store-double (ann-nn)
|
||||
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
|
||||
~~~
|
|
@ -1,3 +1,5 @@
|
|||
~~~
|
||||
'extensions/README.retro include
|
||||
'extensions/double.retro include
|
||||
'extensions/malloc.retro include
|
||||
~~~
|
||||
|
|
1463
vm/nga-c/image.c
1463
vm/nga-c/image.c
File diff suppressed because it is too large
Load diff
Loading…
Reference in a new issue