checkin some missing files
FossilOrigin-Name: 0b75c4f5deef7823d4302a5480af24b164a4014456e11a176528365ee9397bb9
This commit is contained in:
crc
parent
ad65087d6b
commit
79be618035
5 changed files with 403 additions and 1 deletions
16
doc/book/64-bit
Normal file
16
doc/book/64-bit
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
Building a 64-bit RETRO system:
|
||||
|
||||
- change CELL to int64_t in these files:
|
||||
|
||||
source/interfaces/retro-unix.c
|
||||
tools/muri.c
|
||||
tools/embedimage.c
|
||||
tools/extend.c
|
||||
|
||||
- update the `n:MIN` and `n:MAX` in source/retro.forth to:
|
||||
|
||||
:n:MAX (-n) #9223372036854775806 ;
|
||||
:n:MIN (-n) #-9223372036854775807 ;
|
||||
|
||||
Rebuild and enjoy your new 64-bit RETRO system.
|
||||
|
||||
120
doc/book/Building-Alternates
Normal file
120
doc/book/Building-Alternates
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
# Building Alternative Systems
|
||||
|
||||
In addition to the C implementation, there are a few other
|
||||
interfaces that can be built.
|
||||
|
||||
## Requirements
|
||||
|
||||
- c compiler (tested: clang, tcc, gcc)
|
||||
- make
|
||||
- standard unix shell
|
||||
|
||||
## retro-repl
|
||||
|
||||
A basic interactive system can be built by using:
|
||||
|
||||
make bin/retro-repl
|
||||
|
||||
This requires a copy of `ngaImage` to be in the current
|
||||
directory.
|
||||
|
||||
## Barebones
|
||||
|
||||
This is a minimal version of the `retro-repl`. It keeps the C
|
||||
portion as short as possible, making it a useful starting point
|
||||
for new interfaces.
|
||||
|
||||
To build:
|
||||
|
||||
make bin/retro-barebones
|
||||
|
||||
## retro-compiler
|
||||
|
||||
This is a turnkey compiler. It can compile a new executable
|
||||
bundling a Retro VM and image.
|
||||
|
||||
Requirements:
|
||||
|
||||
- BSD or Linux
|
||||
- objcopy in $PATH
|
||||
|
||||
To build:
|
||||
|
||||
make bin/retro-compiler
|
||||
|
||||
Example use:
|
||||
|
||||
1. Given a source file like "Hello.forth":
|
||||
|
||||
~~~
|
||||
:hello 'hello_world! s:put nl ;
|
||||
~~~
|
||||
|
||||
2. Use:
|
||||
|
||||
./bin/retro-compiler Hello.forth hello
|
||||
|
||||
The first argument is the source file, the second is the
|
||||
word to run on startup.
|
||||
|
||||
3. Run the generated `a.out`
|
||||
|
||||
Limits:
|
||||
|
||||
This only supports the core words ('all' interface) and the
|
||||
file i/o words. Support for other I/O extensions will be
|
||||
added in the future.
|
||||
|
||||
## RETRO12.html
|
||||
|
||||
There is a JavaScript and HTML based interface. To
|
||||
build this:
|
||||
|
||||
make bin/RETRO12.html
|
||||
|
||||
It is tested on Chrome and Safari. The interface is
|
||||
based on the UI used on the iOS and macOS versions,
|
||||
presenting a dual-pane model with an editor to the
|
||||
left, an output area to the right, and a listener
|
||||
at the bottom.
|
||||
|
||||
## Pascal
|
||||
|
||||
There is a Pascal version of `retro-repl`.
|
||||
|
||||
Dependencies:
|
||||
|
||||
- freepascal
|
||||
|
||||
Building:
|
||||
|
||||
cd interfaces/pascal
|
||||
fpc listener.lpr
|
||||
|
||||
This will require a copy of the `ngaImage` in the
|
||||
current directory.
|
||||
|
||||
## Python: retro.py
|
||||
|
||||
This is an implementation of `retro-repl` in Python. As
|
||||
with `retro-repl` it requires the `ngaImage` in the current
|
||||
directory when starting.
|
||||
|
||||
## C#: retro.cs
|
||||
|
||||
This is an implementation of `retro-repl` in C#. As with
|
||||
`retro-repl` it requires the `ngaImage` in the current
|
||||
directory when starting.
|
||||
|
||||
Building:
|
||||
|
||||
csc retro.cs
|
||||
|
||||
You'll need to make sure your path has the CSC.EXE in it,
|
||||
or provide a full path to it. Something like this should
|
||||
reveal the path to use:
|
||||
|
||||
dir /s %WINDIR%\CSC.EXE
|
||||
|
||||
I've only tested building this using Microsoft's .NET tools.
|
||||
It should also build and run under Mono.
|
||||
145
example/7080.retro
Executable file
145
example/7080.retro
Executable file
|
|
@ -0,0 +1,145 @@
|
|||
#!/usr/bin/env retro
|
||||
|
||||
# 7080: Gopher via HTTP
|
||||
|
||||
There are a number of Gopher via HTTP Proxies now. But none of
|
||||
them are written in Forth, and I have a rather strong desire to
|
||||
use tools I've written and understand fully, so I decided to
|
||||
write my own.
|
||||
|
||||
7080 is my Gopher via HTTP Proxy. It's not done yet, but is
|
||||
functional enough to be useful to me.
|
||||
|
||||
To use:
|
||||
|
||||
- replace all instances of HTTP-DOMAIN with the server URL.
|
||||
(e.g., http://server.tld:port)
|
||||
- setup inetd to run this
|
||||
- visit http://server.tld:port/gopher-url
|
||||
|
||||
e.g., for floodgap:
|
||||
|
||||
http://server.tld:port/gopher.floodgap.com/1/
|
||||
|
||||
|
||||
~~~
|
||||
{ 'Server 'Port 'Selector 'Response 'Size } [ var ] a:for-each
|
||||
|
||||
'Requested d:create #1025 allot
|
||||
'Host d:create #1025 allot
|
||||
'Buffer d:create #500000 allot
|
||||
~~~
|
||||
|
||||
A minimal HTTP/1.0 session will look like:
|
||||
|
||||
C: GET / HTTP/1.0
|
||||
S: HTTP/1.0 200 OK
|
||||
S: Content-Type: text/html
|
||||
S: ... body ...
|
||||
<disconnect>
|
||||
|
||||
There are a lot more things the client and server can send,
|
||||
but this is all I need to care about for this proxy.
|
||||
|
||||
~~~
|
||||
{{
|
||||
'Done var
|
||||
|
||||
:eot? (c-f)
|
||||
{ ASCII:CR ASCII:LF ASCII:SPACE } a:contains? ;
|
||||
|
||||
:s:get (a-)
|
||||
buffer:set [ c:get [ buffer:add ] [ eot? ] bi ] until
|
||||
buffer:get drop ;
|
||||
---reveal---
|
||||
:read (-)
|
||||
[ here s:get
|
||||
here s:to-upper 'GET s:eq? [ &Requested s:get &Done v:inc ] if
|
||||
@Done #1 eq? ] until ;
|
||||
}}
|
||||
~~~
|
||||
|
||||
The fetch is currently done with a pipe to curl. This is
|
||||
reliable, but I'll probably redo this using raw sockets later
|
||||
so I can remove the need for something other than RETRO.
|
||||
|
||||
~~~
|
||||
:net:fetch (san-n)
|
||||
[ [ buffer:set
|
||||
'curl_-s_%s s:format file:R unix:popen ] dip
|
||||
[ dup file:read 0; buffer:add ] times unix:pclose
|
||||
buffer:start s:length ] buffer:preserve ;
|
||||
|
||||
:request (-)
|
||||
&Requested 'http:// s:begins-with? [ &Requested #7 + ] [ &Requested n:inc ] choose
|
||||
'gopher:// s:prepend
|
||||
&Buffer FREE net:fetch &Buffer !Response !Size ;
|
||||
~~~
|
||||
|
||||
~~~
|
||||
:parse-url (s-)
|
||||
$: s:split s:keep !Server
|
||||
$/ s:split n:inc s:to-number !Port
|
||||
s:keep !Selector ;
|
||||
|
||||
|
||||
'Line var
|
||||
|
||||
:put
|
||||
$< [ '< s:put ] case
|
||||
$> [ '> s:put ] case
|
||||
$& [ '& s:put ] case
|
||||
c:put ;
|
||||
|
||||
:s:putm [ put ] s:for-each ;
|
||||
|
||||
:type
|
||||
fetch-next ;
|
||||
|
||||
:port @Line #3 a:fetch ;
|
||||
:server @Line #2 a:fetch ;
|
||||
:selector @Line #1 a:fetch ;
|
||||
:description @Line #0 a:fetch ;
|
||||
|
||||
:indicate
|
||||
$0 [ 'TXT_ s:put selector port server '<a_href="HTTP-DOMAIN/%s:%s/0%s">%s</a> s:format s:put ] case
|
||||
$1 [ 'DIR_ s:put selector port server '<a_href="HTTP-DOMAIN/%s:%s/1%s">%s</a> s:format s:put ] case
|
||||
$2 [ 'CSO_ s:put s:put ] case
|
||||
$3 [ 'ERR_ s:put s:put ] case
|
||||
$4 [ 'BHX_ s:put s:put ] case
|
||||
$5 [ 'DOS_ s:put s:put ] case
|
||||
$6 [ 'UUE_ s:put s:put ] case
|
||||
$7 [ 'FND_ s:put s:put ] case
|
||||
$8 [ 'TEL_ s:put s:put ] case
|
||||
$9 [ 'BIN_ s:put s:put ] case
|
||||
$h [ 'HTM_ s:put selector #4 + '<a_href="%s">%s</a> s:format s:put ] case
|
||||
$I [ 'IMG_ s:put s:put ] case
|
||||
$g [ 'GIF_ s:put s:put ] case
|
||||
$i [ '____ s:put s:put ] case
|
||||
drop 'UNK_ s:put description s:put drop ;
|
||||
|
||||
:tt '<tt_style='white-space:_pre'> s:put call '</tt><br> s:put nl ;
|
||||
:line
|
||||
dup ASCII:HT s:contains-char?
|
||||
[ ASCII:HT s:tokenize !Line @Line a:length #3 gteq? [ [ @Line #0 a:fetch type indicate ] tt ]
|
||||
[ @Line [ '<tt> s:put s:put '</tt> s:put ] a:for-each nl ] choose ] if;
|
||||
[ s:putm ] tt ;
|
||||
|
||||
:css
|
||||
'<style> s:put nl
|
||||
'*_{_background:_black;_color:_silver;_} s:put nl
|
||||
'a_{_color:_orange;_} s:put nl
|
||||
'</style> s:put nl ;
|
||||
|
||||
:process
|
||||
&Buffer ASCII:HT s:contains-char? [ &Buffer ASCII:CR s:tokenize [ s:trim line ] a:for-each ] if;
|
||||
'<xmp> s:put &Buffer s:put '</xmp> s:put ;
|
||||
|
||||
:eol ASCII:CR c:put ASCII:LF c:put ;
|
||||
:headers 'HTTP/1.1_200_OK s:put eol 'Content-Type:_text/html s:put eol eol ;
|
||||
:7080 read request headers css process ;
|
||||
|
||||
7080
|
||||
~~~
|
||||
|
||||
&Requested '/home/crc/retro/proxy.log file:spew
|
||||
121
example/morse.retro
Normal file
121
example/morse.retro
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
Adjust this for your system.
|
||||
|
||||
~~~
|
||||
:MS (n-) #2000 * [ ] times ;
|
||||
~~~
|
||||
|
||||
Ported from http://thecutecuttlefish.org/tmp/morse.fth
|
||||
|
||||
~~~
|
||||
'SPEAKER var
|
||||
|
||||
:START-SOUND (--)
|
||||
'./dev_dsp file:W file:open !SPEAKER ;
|
||||
|
||||
:STOP-SOUND (--)
|
||||
@SPEAKER file:close ;
|
||||
|
||||
:BEEP (cycles--)
|
||||
START-SOUND
|
||||
[ '----**** [ @SPEAKER file:write ] s:for-each ] times
|
||||
STOP-SOUND
|
||||
;
|
||||
|
||||
|
||||
:- #45 c:put #500 BEEP #50 MS ; (Long
|
||||
:. #46 c:put #100 BEEP #10 MS ; (Short
|
||||
|
||||
:P #50 MS ; (Pause
|
||||
:LP #500 MS sp ; (Long_Pause
|
||||
|
||||
:A? dup $A eq? [ . - P ] if ;
|
||||
:B? dup $B eq? [ - . . . P ] if ;
|
||||
:C? dup $C eq? [ - . - . P ] if ;
|
||||
:D? dup $D eq? [ - . . P ] if ;
|
||||
:E? dup $E eq? [ . P ] if ;
|
||||
:F? dup $F eq? [ . . - . P ] if ;
|
||||
:G? dup $G eq? [ - - . P ] if ;
|
||||
:H? dup $H eq? [ . . . . P ] if ;
|
||||
:I? dup $I eq? [ . . P ] if ;
|
||||
:J? dup $J eq? [ . - - - P ] if ;
|
||||
:K? dup $K eq? [ - . - P ] if ;
|
||||
:L? dup $L eq? [ . - . . P ] if ;
|
||||
:M? dup $M eq? [ - - P ] if ;
|
||||
:N? dup $N eq? [ - . P ] if ;
|
||||
:O? dup $O eq? [ - - - P ] if ;
|
||||
:P? dup $P eq? [ . - - . P ] if ;
|
||||
:Q? dup $Q eq? [ - - . - P ] if ;
|
||||
:R? dup $R eq? [ . - . P ] if ;
|
||||
:S? dup $S eq? [ . . . P ] if ;
|
||||
:T? dup $T eq? [ - P ] if ;
|
||||
:U? dup $U eq? [ . . - P ] if ;
|
||||
:V? dup $V eq? [ . . . - P ] if ;
|
||||
:W? dup $W eq? [ . - - P ] if ;
|
||||
:X? dup $X eq? [ - . . - P ] if ;
|
||||
:Y? dup $Y eq? [ - . - - P ] if ;
|
||||
:Z? dup $Z eq? [ - - . . P ] if ;
|
||||
|
||||
:SP? dup #32 eq? [ LP ] if ;
|
||||
|
||||
:1? dup $1 eq? [ . - - - - P ] if ;
|
||||
:2? dup $2 eq? [ . . - - - P ] if ;
|
||||
:3? dup $3 eq? [ . . . - - P ] if ;
|
||||
:4? dup $4 eq? [ . . . . - P ] if ;
|
||||
:5? dup $5 eq? [ . . . . . P ] if ;
|
||||
:6? dup $6 eq? [ - . . . . P ] if ;
|
||||
:7? dup $7 eq? [ - - . . . P ] if ;
|
||||
:8? dup $8 eq? [ - - - . . P ] if ;
|
||||
:9? dup $9 eq? [ - - - - . P ] if ;
|
||||
:0? dup $0 eq? [ - - - - - P ] if ;
|
||||
|
||||
|
||||
:MORSE (s--)
|
||||
nl
|
||||
[
|
||||
A?
|
||||
B?
|
||||
C?
|
||||
D?
|
||||
E?
|
||||
F?
|
||||
G?
|
||||
H?
|
||||
I?
|
||||
J?
|
||||
K?
|
||||
L?
|
||||
M?
|
||||
N?
|
||||
O?
|
||||
P?
|
||||
Q?
|
||||
R?
|
||||
S?
|
||||
T?
|
||||
U?
|
||||
V?
|
||||
W?
|
||||
X?
|
||||
Y?
|
||||
Z?
|
||||
|
||||
SP?
|
||||
|
||||
1?
|
||||
2?
|
||||
3?
|
||||
4?
|
||||
5?
|
||||
6?
|
||||
7?
|
||||
8?
|
||||
9?
|
||||
0? drop ] s:for-each
|
||||
;
|
||||
~~~
|
||||
|
||||
A simple test case:
|
||||
|
||||
```
|
||||
'SOS_OR_NOT MORSE
|
||||
```
|
||||
|
|
@ -11,7 +11,7 @@
|
|||
body {
|
||||
background: #657B83;
|
||||
color: #FDF6E3;
|
||||
font-size: 16pt;
|
||||
font-size: 14pt;
|
||||
font-family: monospace;
|
||||
height: 100%;
|
||||
margin: 0;
|
||||
|
|
|
|||
Loading…
Reference in a new issue