crc/retroforth
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

down to 10 words w/o recorded stack comments

Browse source 
FossilOrigin-Name: 9a36cf9d0e7ddd0131df3867aa4285f0c26ccde64ef7c193729932647d8829a3
This commit is contained in:
crc 2024-09-09 18:07:02 +00:00
parent 1611c8898b
commit 3962c08662
13 changed files with 1335 additions and 1309 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
interface/clock.retro
View file

@ -4,7 +4,7 @@ The `clock:` namespace contains words for interacting with the
system clock.
~~~
:clock:operation
:clock:operation (:n-)
DEVICE:CLOCK io:scan-for
dup n:negative? [ drop 'Error:_clock_device_not_found s:put nl ] if;
io:invoke ;

42
interface/devices.retro
View file

@ -1,25 +1,25 @@
~~~
#0 'DEVICE:OUTPUT const
#1 'DEVICE:KEYBOARD const
#2 'DEVICE:FLOATS const
#4 'DEVICE:FILES const
#3 'DEVICE:BLOCKS const
#5 'DEVICE:CLOCK const
#6 'DEVICE:RESERVED6 const
#7 'DEVICE:SOCKET const
#8 'DEVICE:UNIX const
#9 'DEVICE:SCRIPTING const
#10 'DEVICE:RNG const
#11 'DEVICE:RESERVED11 const
#12 'DEVICE:RESERVED12 const
#13 'DEVICE:RESERVED13 const
#14 'DEVICE:IOCTL const
#15 'DEVICE:MALLOC const
#1000 'DEVICE:IMAGE const
#1234 'DEVICE:ERROR const
#8000 'DEVICE:MULTICORE const
#8100 'DEVICE:FFI const
#8101 'DEVICE:UNSIGNED const
#0 'DEVICE:OUTPUT const (:-n)
#1 'DEVICE:KEYBOARD const (:-n)
#2 'DEVICE:FLOATS const (:-n)
#4 'DEVICE:FILES const (:-n)
#3 'DEVICE:BLOCKS const (:-n)
#5 'DEVICE:CLOCK const (:-n)
#6 'DEVICE:RESERVED6 const (:-n)
#7 'DEVICE:SOCKET const (:-n)
#8 'DEVICE:UNIX const (:-n)
#9 'DEVICE:SCRIPTING const (:-n)
#10 'DEVICE:RNG const (:-n)
#11 'DEVICE:RESERVED11 const (:-n)
#12 'DEVICE:RESERVED12 const (:-n)
#13 'DEVICE:RESERVED13 const (:-n)
#14 'DEVICE:IOCTL const (:-n)
#15 'DEVICE:MALLOC const (:-n)
#1000 'DEVICE:IMAGE const (:-n)
#1234 'DEVICE:ERROR const (:-n)
#8000 'DEVICE:MULTICORE const (:-n)
#8100 'DEVICE:FFI const (:-n)
#8101 'DEVICE:UNSIGNED const (:-n)
'interface/devices.retro s:dedup

10
interface/floatingpoint.retro
View file

@ -122,11 +122,11 @@ the standard integer range as the smallest value is used
for NaN.
~~~
n:MAX n:dec 'e:MAX const
n:MAX n:dec n:negate 'e:MIN const
n:MIN 'e:NAN const
n:MAX 'e:INF const
n:MAX n:negate 'e:-INF const
n:MAX n:dec 'e:MAX const (:-n)
n:MAX n:dec n:negate 'e:MIN const (:-n)
n:MIN 'e:NAN const (:-n)
n:MAX 'e:INF const (:-n)
n:MAX n:negate 'e:-INF const (:-n)
~~~
~~~

2
interface/ioctl.retro
View file

@ -1,5 +1,5 @@
~~~
:ioctl:operation
:ioctl:operation (:n-)
DEVICE:IOCTL io:scan-for
dup n:negative? [ drop 'Error:_ioctl_device_not_found s:put nl ] if;
io:invoke ;

16
interface/library.retro
View file

@ -1,24 +1,24 @@
~~~
:HOME here #4096 + ;
'%s/.config/retroforth/library/%s.retro 'library:.CONFIG s:const
'./library/%s.retro 'library:CWD s:const
'%s/.config/retroforth/library/%s.retro 'library:.CONFIG s:const (:-s)
'./library/%s.retro 'library:CWD s:const (:-s)
:library:cwd library:CWD s:format ;
:library:cwd (:s-s) library:CWD s:format ;
:library:.config
:library:.config (:-s)
'HOME HOME unix:getenv
HOME library:.CONFIG s:format ;
:library:filename (s-s)
:library:filename (:s-s)
dup library:cwd
dup file:exists? [ nip ] if; drop
dup file:exists? &nip if; drop
library:.config dup file:exists? [ ] if; drop s:empty ;
:library:contains? (s-f)
:library:contains? (:s-f)
&library:cwd &library:.config bi &file:exists? bi@ or ;
:library:load
:library:load (:s-)
dup library:contains? [ library:filename include ]
[ 'ERROR:_Library_`%s`_was_not_found s:format s:put nl ] choose ;

10
interface/retro-unix.retro
View file

@ -4,7 +4,7 @@ In this file I am implementing the interactive listener that
RETRO will run when started with `-i`, `-i,c`, or `-i,fs`.
~~~
:image:save (s-) #1000 io:scan-for io:invoke ;
:image:save (:s-) #1000 io:scan-for io:invoke ;
~~~
Now that I can read characters, it's time to support reading
@ -22,7 +22,7 @@ not `TRUE` it will add the character to the buffer.
(c-) :gather edit? &drop &add choose ;
(q-qc) :cycle repeat c:get dup-pair swap call not 0; drop gather again ;
---reveal---
:parse-until (q-s)
:parse-until (:q-s)
[ s:empty buffer:set cycle drop-pair buffer:start ] buffer:preserve ;
}}
~~~
@ -31,12 +31,12 @@ Using this, a simple `s:get` can be implemented very easily as
a quote which looks for an end of line character.
~~~
:s:get (-s) [ [ ASCII:CR eq? ]
:s:get (:-s) [ [ ASCII:CR eq? ]
[ ASCII:LF eq? ] bi or ] parse-until ;
~~~
~~~
:clear '\^[2J\^[0;0H s:format s:put ;
:clear (:-) '\^[2J\^[0;0H s:format s:put ;
~~~
Hide the support words.
@ -50,7 +50,7 @@ RRE's C part will access a couple parts of this, based on the
startup flags passed.
~~~
:// script:ignore-to-eol &Ignoring v:on ; immediate
:// (:-) script:ignore-to-eol &Ignoring v:on ; immediate
~~~
## d:source

2
interface/sockets.retro
View file

@ -6,7 +6,7 @@ wrapper over the standard Unix socket functions. This means
that it is fairly low level.
~~~
:socket:operation
:socket:operation (:n-)
DEVICE:SOCKET io:scan-for dup n:negative?
[ drop 'Error:_socket_device_not_found s:put nl
'See_https://retroforth.org/support/2022.1/SOCKETS.md

7
interface/stack-comments.retro
View file

@ -28,6 +28,13 @@ comment format this introduces to add them inline.
Add the stack comments for existing words:
~~~
'ss- 'd:set-source d:set-stack-comment
'n-s 'n:to-string/reversed d:set-stack-comment
's-s 's:truncate d:set-stack-comment
's-sf 's:oversize? d:set-stack-comment
'- 'err:notfound d:set-stack-comment
'a-a 'd:stack d:set-stack-comment
'D:_-c__A:_-__F:_- '$ d:set-stack-comment
'D:_-s__A:_-__F:_- '' d:set-stack-comment
'D:_-__A:_-__F:_- '( d:set-stack-comment

2
interface/unix.retro
View file

@ -4,7 +4,7 @@ The `unix:` namespace contains words for interacting with the
host operating system on Unix style systems.
~~~
:io:unix-syscall
:io:unix-syscall (:n-)
DEVICE:UNIX io:scan-for
dup n:negative? [ drop 'Error:_UNIX_device_not_found s:put nl ] if;
io:invoke ;

6
package/dict-words-listing.forth
View file

@ -3,7 +3,7 @@
The basic word listing is provided by `d:words`.
~~~
:d:words (-) [ d:name s:put sp ] d:for-each ;
:d:words (:-) [ d:name s:put sp ] d:for-each ;
~~~
This isn't very useful though: a raw list of names is difficult
@ -16,7 +16,7 @@ in a specific namespace, e.g., by doing `'s: d:words-with`, or
words that likely display something: `':put d:words-with`.
~~~
:d:words-with (s-)
:d:words-with (:s-)
here s:copy
[ d:name dup here
(put-match s:contains/string? [ s:put sp ] [ drop ] choose )
@ -32,7 +32,7 @@ deal with this, `d:words-beginning-with` is provided.
:display-if-left (s-)
dup here s:begins-with? [ s:put sp ] [ drop ] choose ;
---reveal---
:d:words-beginning-with (s-)
:d:words-beginning-with (:s-)
here s:copy [ d:name display-if-left ] d:for-each ;
}}
~~~

14
package/extensions/double.retro
View file

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

16
package/extensions/malloc.retro
View file

@ -12,16 +12,16 @@
---reveal---
:mem:alloc (n--a) ALLOC mem:invoke ;
:mem:store (an--) STORE mem:invoke ;
:mem:fetch (a--n) FETCH mem:invoke ;
:mem:free (a--) FREE mem:invoke ;
:mem:resize (an--) RESIZE mem:invoke ;
:mem:alloc (:n--a) ALLOC mem:invoke ;
:mem:store (:an--) STORE mem:invoke ;
:mem:fetch (:a--n) FETCH mem:invoke ;
:mem:free (:a--) FREE mem:invoke ;
:mem:resize (:an--) RESIZE mem:invoke ;
}}
:mem:cell+ (nn-n) #8 * + ;
:mem:fetch-double (n-nn)
:mem:cell+ (:nn-n) #8 * + ;
:mem:fetch-double (:n-nn)
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 ;
~~~

2515
vm/nga-c/image.c
View file

File diff suppressed because it is too large Load diff