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. system clock.
~~~ ~~~
:clock:operation :clock:operation (:n-)
DEVICE:CLOCK io:scan-for DEVICE:CLOCK io:scan-for
dup n:negative? [ drop 'Error:_clock_device_not_found s:put nl ] if; dup n:negative? [ drop 'Error:_clock_device_not_found s:put nl ] if;
io:invoke ; io:invoke ;

42
interface/devices.retro
View file

@ -1,25 +1,25 @@
~~~ ~~~
#0 'DEVICE:OUTPUT const #0 'DEVICE:OUTPUT const (:-n)
#1 'DEVICE:KEYBOARD const #1 'DEVICE:KEYBOARD const (:-n)
#2 'DEVICE:FLOATS const #2 'DEVICE:FLOATS const (:-n)
#4 'DEVICE:FILES const #4 'DEVICE:FILES const (:-n)
#3 'DEVICE:BLOCKS const #3 'DEVICE:BLOCKS const (:-n)
#5 'DEVICE:CLOCK const #5 'DEVICE:CLOCK const (:-n)
#6 'DEVICE:RESERVED6 const #6 'DEVICE:RESERVED6 const (:-n)
#7 'DEVICE:SOCKET const #7 'DEVICE:SOCKET const (:-n)
#8 'DEVICE:UNIX const #8 'DEVICE:UNIX const (:-n)
#9 'DEVICE:SCRIPTING const #9 'DEVICE:SCRIPTING const (:-n)
#10 'DEVICE:RNG const #10 'DEVICE:RNG const (:-n)
#11 'DEVICE:RESERVED11 const #11 'DEVICE:RESERVED11 const (:-n)
#12 'DEVICE:RESERVED12 const #12 'DEVICE:RESERVED12 const (:-n)
#13 'DEVICE:RESERVED13 const #13 'DEVICE:RESERVED13 const (:-n)
#14 'DEVICE:IOCTL const #14 'DEVICE:IOCTL const (:-n)
#15 'DEVICE:MALLOC const #15 'DEVICE:MALLOC const (:-n)
#1000 'DEVICE:IMAGE const #1000 'DEVICE:IMAGE const (:-n)
#1234 'DEVICE:ERROR const #1234 'DEVICE:ERROR const (:-n)
#8000 'DEVICE:MULTICORE const #8000 'DEVICE:MULTICORE const (:-n)
#8100 'DEVICE:FFI const #8100 'DEVICE:FFI const (:-n)
#8101 'DEVICE:UNSIGNED const #8101 'DEVICE:UNSIGNED const (:-n)
'interface/devices.retro s:dedup '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. for NaN.
~~~ ~~~
n:MAX n:dec 'e:MAX const n:MAX n:dec 'e:MAX const (:-n)
n:MAX n:dec n:negate 'e:MIN const n:MAX n:dec n:negate 'e:MIN const (:-n)
n:MIN 'e:NAN const n:MIN 'e:NAN const (:-n)
n:MAX 'e:INF const n:MAX 'e:INF const (:-n)
n:MAX n:negate 'e:-INF const 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 DEVICE:IOCTL io:scan-for
dup n:negative? [ drop 'Error:_ioctl_device_not_found s:put nl ] if; dup n:negative? [ drop 'Error:_ioctl_device_not_found s:put nl ] if;
io:invoke ; io:invoke ;

16
interface/library.retro
View file

@ -1,24 +1,24 @@
~~~ ~~~
:HOME here #4096 + ; :HOME here #4096 + ;
'%s/.config/retroforth/library/%s.retro 'library:.CONFIG s:const '%s/.config/retroforth/library/%s.retro 'library:.CONFIG s:const (:-s)
'./library/%s.retro 'library:CWD s:const './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 HOME unix:getenv
HOME library:.CONFIG s:format ; HOME library:.CONFIG s:format ;
:library:filename (s-s) :library:filename (:s-s)
dup library:cwd 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:.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:cwd &library:.config bi &file:exists? bi@ or ;
:library:load :library:load (:s-)
dup library:contains? [ library:filename include ] dup library:contains? [ library:filename include ]
[ 'ERROR:_Library_`%s`_was_not_found s:format s:put nl ] choose ; [ '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`. 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 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 ; (c-) :gather edit? &drop &add choose ;
(q-qc) :cycle repeat c:get dup-pair swap call not 0; drop gather again ; (q-qc) :cycle repeat c:get dup-pair swap call not 0; drop gather again ;
---reveal--- ---reveal---
:parse-until (q-s) :parse-until (:q-s)
[ s:empty buffer:set cycle drop-pair buffer:start ] buffer:preserve ; [ 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. 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 ; [ 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. 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. startup flags passed.
~~~ ~~~
:// script:ignore-to-eol &Ignoring v:on ; immediate :// (:-) script:ignore-to-eol &Ignoring v:on ; immediate
~~~ ~~~
## d:source ## 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. that it is fairly low level.
~~~ ~~~
:socket:operation :socket:operation (:n-)
DEVICE:SOCKET io:scan-for dup n:negative? DEVICE:SOCKET io:scan-for dup n:negative?
[ drop 'Error:_socket_device_not_found s:put nl [ drop 'Error:_socket_device_not_found s:put nl
'See_https://retroforth.org/support/2022.1/SOCKETS.md '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: 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:_-c__A:_-__F:_- '$ d:set-stack-comment
'D:_-s__A:_-__F:_- '' d:set-stack-comment 'D:_-s__A:_-__F:_- '' d:set-stack-comment
'D:_-__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. host operating system on Unix style systems.
~~~ ~~~
:io:unix-syscall :io:unix-syscall (:n-)
DEVICE:UNIX io:scan-for DEVICE:UNIX io:scan-for
dup n:negative? [ drop 'Error:_UNIX_device_not_found s:put nl ] if; dup n:negative? [ drop 'Error:_UNIX_device_not_found s:put nl ] if;
io:invoke ; io:invoke ;

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

@ -3,7 +3,7 @@
The basic word listing is provided by `d:words`. 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 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`. words that likely display something: `':put d:words-with`.
~~~ ~~~
:d:words-with (s-) :d:words-with (:s-)
here s:copy here s:copy
[ d:name dup here [ d:name dup here
(put-match s:contains/string? [ s:put sp ] [ drop ] choose ) (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-) :display-if-left (s-)
dup here s:begins-with? [ s:put sp ] [ drop ] choose ; dup here s:begins-with? [ s:put sp ] [ drop ] choose ;
---reveal--- ---reveal---
:d:words-beginning-with (s-) :d:words-beginning-with (:s-)
here s:copy [ d:name display-if-left ] d:for-each ; 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 , , ; d:create swap , , ;
:double:fetch (a-nn) :double:fetch (:a-nn)
fetch-next swap fetch ; fetch-next swap fetch ;
:double:store (nna-) :double:store (:nna-)
&swap dip store-next store ; &swap dip store-next store ;
:double:const (nns-) :double:const (:nns-)
double:var &double:fetch does ; double:var &double:fetch does ;
:double:swap (nnmm-mmnn) :double:swap (:nnmm-mmnn)
rot push rot pop ; rot push rot pop ;
:double:dip (mnq-mn) rot rot push push call pop pop ; :double:dip (:mnq-mn) rot rot push push call pop pop ;
:double:sip (mnq-mn) &dup-pair dip double:dip ; :double:sip (:mnq-mn) &dup-pair dip double:dip ;
~~~ ~~~

16
package/extensions/malloc.retro
View file

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

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

File diff suppressed because it is too large Load diff