Befunge-93 interpreter
Rugxulo
program so far (only started learning Rexx about two months ago,
barely coded a few useless snippets and a non-portable program to
touch Gzip files).
I've been pretty obsessed with Befunge-93 for a few months ever since
I read Pinecone_'s introduction on FASM's forum.
http://board.flatassembler.net/topic.php?t=10599&postdays=0&postorder=asc&start=0
http://en.wikipedia.org/wiki/Befunge
"Befunge is a stack-based, reflective, esoteric programming language.
It differs from conventional languages in that programs are arranged
on a two-dimensional grid." (It's like a very limited Forth, 80x25
grid, only 26 single-char ASCII commands plus the ten digits to push
numbers.)
I even maintain / hacked up / improved an x86 assembly version for DOS
(since Pinecone_'s is for Win32 only)! The included examples there are
what I tested, mostly.
http://board.flatassembler.net/topic.php?t=10810
Anyways, this Rexx code version works with three different Rexx
interpreters and almost all the examples I tried, so it should be
"good enough" for now. Of course, I can't test every Rexx interpreter
under the sun, so feel free to kick the tires a bit. ;-) I've
modified it slightly so that it hopefully won't wraparound on Google
Groups (annoying).
BTW, there are B93 interpreters for various other languages, too: C,
C99, C++, D, Ruby, Lua, Python, Perl, Intercal, Fortran, Forth,
Algol-60, TI-86, RiscOS, Inform, etc.
Greets to #esoteric on irc.freenode.net !!
P.S. The creator of Befunge-93 (and -98)'s stuff (reference
implementations, examples) is here: http://catseye.tc/projects/bef.html
==================================================
/* REXX */
/*
Befunge-93 for BRexx or Regina or r4
rugxulo _AT_ gmail _DOT_ com
public domain, nenies proprajxo
!! Christus Rex !!
KNOWN BUGS (minor, not important):
- stack doesn't wraparound at intmax (BENCHMARK.BEF)
- BRexx (16-bit only) hangs halfway through GUESSWHO.BEF
- r4 is pretty slow (not line buffered ??)
Sunday, April 25, 2010 11:56pm
*/
signal on notready
if arg()=0 then file='tony.bef' ; else file=arg(1)
options='REM ' ; options nofast_lines_bif_default
lines=lines(file) ; num=1
do lines
line.num=linein(file)
line.num=line.num || copies(' ',80-length(line.num)) ; num=num+1
end
do n=num to 25 ; line.n=copies(' ',80) ; end
ip.x=-1 ; ip.y=0 ; xdelta=1 ; ydelta=0 ; strmode=0
do forever
ip.x=ip.x+xdelta ; ip.y=ip.y+ydelta
if ip.x > 79 then ip.x=0 ; if ip.y > 24 then ip.y=0
if ip.x < 0 then ip.x=79 ; if ip.y < 0 then ip.y=24
ip.char=get(ip.x,ip.y)
/*
trace ?r
say ip.x','ip.y "'"ip.char"'" 'q='queued() 's='strmode
trace off
*/
select
when strmode=1 & ip.char \= '"' then push c2d(ip.char)
when strmode=0 & verify(ip.char, xrange('0','9'),m) then ,
push ip.char
when ip.char='v' then do ; ydelta= 1 ; xdelta= 0 ; end
when ip.char='^' then do ; ydelta=-1 ; xdelta= 0 ; end
when ip.char='<' then do ; ydelta=0 ; xdelta=-1 ; end
when ip.char='>' then do ; ydelta=0 ; xdelta= 1 ; end
when ip.char='#' then call hop
when ip.char='*' then do ; b=pop() ; a=pop() ; c=a*b ; ,
push c ; end
when ip.char='/' then do ; b=pop() ; a=pop() ; c=a%b ; ,
push c ; end
when ip.char='%' then do ; b=pop() ; a=pop() ; c=a//b ; ,
push trunc(c) ; end
when ip.char='+' then do ; b=pop() ; a=pop() ; c=a+b ; ,
push c ; end
when ip.char='-' then do ; b=pop() ; a=pop() ; c=a-b ; ,
push c ; end
when ip.char='.' then do ; ch=pop() ; call charout ,ch ; ,
call charout ,' ' ; end
when ip.char=',' then do ; ch=pop() ; call charout ,d2c(ch) ; end
when ip.char='\' then do ; a=pop() ; b=pop() ; push a ; ,
push b ; end
when ip.char=':' then do ; a=pop() ; push a ; push a ; end
when ip.char='$' then a=pop()
when ip.char='g' then do ; b=pop() ; a=pop() ; push c2d(get(a,b)),
; end
when ip.char='p' then do ; b=pop() ; a=pop() ; ch=pop() ; ,
call put ch,a,b ; end
when ip.char='`' then do ; b=pop() ; a=pop() ; if a>b then push 1 ,
; else push 0 ; end
when ip.char='!' then do ; a=pop() ; if a=0 then push 1 ; else ,
push 0 ; end
when ip.char='?' then call rand
when ip.char='_' then do ; a=pop() ; if a \= 0 then do ; xdelta=-1 ,
; ydelta=0 ; end ; else do ; xdelta=1 ; ydelta=0 ; end ; end
when ip.char='|' then do ; a=pop() ; if a \= 0 then do ; ydelta=-1 ,
; xdelta=0 ; end ; else do ; ydelta=1 ; xdelta=0 ; end ; end
when ip.char='~' then do ; a=charin('') ; push c2d(a) ; end
when ip.char='&' then push linein('')
when ip.char='@' then exit
when ip.char='"' then strmode=strmode && 1 /* xor toggles */
otherwise nop /* not reflect, Deewiant !! */
end /* select */
end /* do forever */
get: procedure expose line.
x=arg(1) + 1 ; y=arg(2) + 1
return substr(line.y,x,1)
put: procedure expose line.
ch=arg(1) ; x=arg(2) + 1 ; y=arg(3) + 1
line.y=delstr(line.y,x) || d2c(ch) || substr(line.y,x+1)
return
hop: procedure expose xdelta ydelta ip.
select
when ydelta=-1 then ip.y=ip.y-1
when ydelta= 1 then ip.y=ip.y+1
when xdelta=-1 then ip.x=ip.x-1
when xdelta= 1 then ip.x=ip.x+1
otherwise nop
end
return
rand: procedure expose xdelta ydelta
r=random(1,4)
select
when r=1 then do ; xdelta=-1 ; ydelta=0 ; end
when r=2 then do ; xdelta= 1 ; ydelta=0 ; end
when r=3 then do ; ydelta=-1 ; xdelta=0 ; end
when r=4 then do ; ydelta= 1 ; xdelta=0 ; end
otherwise nop
end
return
pop:
if queued()=0 then return 0
else do ; parse pull moo ; return moo ; end
notready: say "Where's the file?" ; exit
/* EOF */
Rugxulo
==================================================
/* REXX */
/*
Befunge-93 interpreter (for BRexx or Regina or OORexx or r4)
Tuesday, April 27, 2010 6:18pm
rugxulo _AT_ gmail _DOT_ com
public domain, nenies proprajxo
!! Christus Rex !!
BUGS: (not hugely important)
- the B93 stack doesn't wraparound at intmax (BENCHMARK.BEF)
- "bitand(num,'7fffffff'x)" perhaps ??
- BRexx (16-bit DOS only) hangs halfway through GUESSWHO.BEF
- perhaps due to pushing "depth nesting limit near 90" ??
- r4 is slow for charout (not line-buffered internally ??)
- ???
FIXED:
- v1.1 : "do ;" typo corrected, minor cleanups
- v1.2 : workaround LINES() and '\n' quirks, more cleanups
LINKS:
- http://catseye.tc/projects/bef.html
- http://board.flatassembler.net/topic.php?t=10810
- http://www.esolangs.org/wiki/Befunge
- #esoteric on irc.freenode.net
*/
signal on notready
if arg()=0 then file='tony.bef' ; else file=arg(1)
parse source . . srcfile .
num=1
if lines(srcfile) = 1 then do /* old BRexx or OORexx */
do while lines(file) \= 0
line.num=linein(file)
line.num=line.num || copies(' ',80-length(line.num))
num=num+1
end
end
else do /* new BRexx or Regina or r4 */
do lines(file)
line.num=linein(file)
line.num=line.num || copies(' ',80-length(line.num))
num=num+1
end
end
do n=num to 25 ; line.n=copies(' ',80) ; end ; num=num-1
/*
say 'number of lines in' file '=' num
do i=1 to 25 ; say line.i ; end
exit
*/
ip.x=-1 ; ip.y=0 ; xdelta=1 ; ydelta=0 ; strmode=0
do forever
ip.x=ip.x + xdelta ; ip.y=ip.y + ydelta
if ip.x > 79 then ip.x=0 ; if ip.y > 24 then ip.y=0
if ip.x < 0 then ip.x=79 ; if ip.y < 0 then ip.y=24
ip.char=get(ip.x,ip.y)
/* ********************************
trace ?r
say ip.x','ip.y "'"ip.char"'" 'q='queued() 's='strmode
trace off
******************************** */
select
when strmode=1 & ip.char \= '"' then push c2d(ip.char)
when strmode=0 & verify(ip.char, xrange('0','9'),m) then ,
push ip.char
when ip.char=' ' then nop
when ip.char='"' then strmode=strmode && 1 /* xor toggles */
when ip.char='.' then do ; ch=pop() ; call outnum ch ; end
when ip.char=',' then do ; ch=pop() ; if ch \= 10 then ,
call outchar d2c(ch) ; else say '' ; end
when ip.char='v' then call delta 0,1
when ip.char='^' then call delta 0,-1
when ip.char='<' then call delta -1,0
when ip.char='>' then call delta 1,0
when ip.char='#' then call hop
when ip.char='?' then call rand
when ip.char='_' then do ; a=pop() ; if a \= 0 then call delta -1,0
else call delta 1,0 ; end
when ip.char='|' then do ; a=pop() ; if a \= 0 then call delta 0,-1
else call delta 0,1 ; end
when ip.char='*' then do ; b=pop() ; a=pop() ; c=a*b ; push c ; end
when ip.char='/' then do ; b=pop() ; a=pop() ; c=a%b ; push c ; end
when ip.char='%' then do ; b=pop() ; a=pop() ; c=a//b ; ,
push trunc(c) ; end
when ip.char='+' then do ; b=pop() ; a=pop() ; c=a+b ; push c ; end
when ip.char='-' then do ; b=pop() ; a=pop() ; c=a-b ; push c ; end
when ip.char='`' then do ; b=pop() ; a=pop() ; if a>b then push 1
else push 0 ; end
when ip.char='!' then do ; a=pop() ; if a=0 then push 1 ; else ,
push 0 ; end
when ip.char=':' then do ; a=pop() ; push a ; push a ; end
when ip.char='\' then do ; a=pop() ; b=pop() ; push a ; push b ; end
when ip.char='$' then a=pop()
when ip.char='g' then do ; b=pop() ; a=pop() ; push c2d(get(a,b))
end
when ip.char='p' then do ; b=pop() ; a=pop() ; ch=pop()
call put ch,a,b ; end
when ip.char='~' then do ; a=charin('') ; push c2d(a) ; end
when ip.char='&' then push linein('')
when ip.char='@' then exit
otherwise nop /* not reflect, Deewiant !! */
end /* select */
end /* do forever */
get: procedure expose line.
x = arg(1)+1 ; y = arg(2)+1
return substr(line.y,x,1)
put: procedure expose line.
ch=d2c(arg(1)) ; x=arg(2)+1 ; y=arg(3)+1
line.y=overlay(ch,line.y,x,1)
return
hop: procedure expose xdelta ydelta ip.
select
when ydelta=-1 then ip.y=ip.y-1
when ydelta= 1 then ip.y=ip.y+1
when xdelta=-1 then ip.x=ip.x-1
when xdelta= 1 then ip.x=ip.x+1
otherwise nop
end
return
rand: procedure expose xdelta ydelta
r=random(1,4)
select
when r=1 then call delta -1,0
when r=2 then call delta 1,0
when r=3 then call delta 0,-1
when r=4 then call delta 0,1
otherwise nop
end
return
pop: procedure
if queued()=0 then return 0
else do ; parse pull popped ; return popped ; end
delta: procedure expose xdelta ydelta
xdelta = arg(1) ; ydelta = arg(2)
return
outnum: procedure
call charout ,arg(1) ; call charout ,' '
return
outchar: procedure
call charout ,arg(1)
return
notready: say "Where's the B93 file?" ; exit 255
/* EOF */
==================================================
Sahananda
> Back by popular demand (not!), now fixed for OORexx.
>
> ==================================================
> /* REXX */
> /*
> Befunge-93 interpreter (for BRexx or Regina or OORexx or r4)
>
> Tuesday, April 27, 2010 6:18pm
>
> rugxulo _AT_ gmail _DOT_ com
> public domain, nenies proprajxo
> !! Christus Rex !!
>
> BUGS: (not hugely important)
> - the B93 stack doesn't wraparound at intmax (BENCHMARK.BEF)
> - "bitand(num,'7fffffff'x)" perhaps ??
> - BRexx (16-bit DOS only) hangs halfway through GUESSWHO.BEF
> - perhaps due to pushing "depth nesting limit near 90" ??
> - r4 is slow for charout (not line-buffered internally ??)
> - ???
>
> FIXED:
> - v1.1 : "do ;" typo corrected, minor cleanups
> - v1.2 : workaround LINES() and '\n' quirks, more cleanups
>
> LINKS:
> -http://catseye.tc/projects/bef.html
> -http://board.flatassembler.net/topic.php?t=10810
Hi,
I don't know if you're looking for a critique of your code.
In case you are, here are a few points.
After the main body has been interpreted, interpretation will run on
until it hits the return at the end of the 'get' procedure. You can
prevent this by putting a return or exit at the end of your main body
of code.
It might be simpler and clearer, where you want to left align a line
in 80 characters to use the left function (or method) line.num =
left(line.num,80)
You can use the not operator \ to toggle a boolean strmode = \strmode
Unless I'm mistaken, your loop
do while lines(file) \= 0
...
end
Would work for all your target interpreters.
hth
Jon
Rugxulo
On Apr 28, 12:48 am, Sahananda <sahana...@googlemail.com> wrote:
> On Apr 28, 12:19 am, Rugxulo <rugx...@gmail.com> wrote:
>
> > Back by popular demand (not!), now fixed for OORexx.
>
> > ==================================================
> > /* REXX */
> > /*
> > Befunge-93 interpreter (for BRexx or Regina or OORexx or r4)
>
> > Tuesday, April 27, 2010 6:18pm
>
> Hi,
>
> I don't know if you're looking for a critique of your code.
> In case you are, here are a few points.
Any and all feedback is welcome, esp. constructive criticism since I'm
an admitted newbie at Rexx!!
> After the main body has been interpreted, interpretation will run on
> until it hits the return at the end of the 'get' procedure. You can
> prevent this by putting a return or exit at the end of your main body
> of code.
Oops, you're right, but I always assumed every Befunge script would
end with '@', which does "exit". (Not all do, but 99% will, and at
least anything I wrote does. I can't see much use for endless Befunge
scripts, though.)
> It might be simpler and clearer, where you want to left align a line
> in 80 characters to use the left function (or method) line.num =
> left(line.num,80)
Not sure, lemme check. Hmmm, it does seem to not force everything to
move to the left (which would be bad), only fills spaces at right.
Yes, that's what I wanted. Space is a nop in Befunge, and if a file
doesn't use all 80x25 chars, I wanted to make sure there wasn't any
garbage that was accidentally executed (or used by 'g'et, etc).
> You can use the not operator \ to toggle a boolean strmode = \strmode
Yes, I wasn't 100% aware of this, and I didn't bother testing. But it
works, would be even more straight-forward for '!' ("not") than what I
have. ;-)
> Unless I'm mistaken, your loop
> do while lines(file) \= 0
> ...
> end
> Would work for all your target interpreters.
It would indeed ... except that old pre-built BRexx .EXEs (2.1.0, 16-
bit DOS, and 2.0.8, 32-bit DOS) seem to loop repeatedly without
decrementing the result of lines, e.g. it stays static at "3" or
whatever. My build of 2.1.8 via DJGPP seems to have this fixed,
though.
Honestly, I'm a little confused and surprised that this would work:
if lines(srcfile) = 1 then do /* old BRexx or OORexx */
do while lines(file) \= 0
...
The whole "do ; do" part seems redundant, but it doesn't choke any of
the Rexxes I tried, so whatever. ;-) I actually wondered if
using some INTERPRET trickery might make it cleaner code there (heh)
but decided against it. ;-)
Sahananda
> ...
>
> The whole "do ; do" part seems redundant, but it doesn't choke any of
> the Rexxes I tried, so whatever. ;-) I actually wondered if
> using some INTERPRET trickery might make it cleaner code there (heh)
> but decided against it. ;-)
Well you could code it with single do's like this if you prefer:
if lines(srcfile) = 1
then do while lines(file) \= 0
line.num=linein(file)
line.num=line.num || copies(' ',80-length(line.num))
num=num+1
end
else do lines(file)
line.num=linein(file)
line.num=line.num || copies(' ',80-length(line.num))
num=num+1
end
Many folks prefer top terminate stream i/o by trapping the NotReady
condition - another possibility.
Jon
GerardS
I noticed in the original posting of the REXX code for a BEFUNGE93
interpreter that when in the case of division or modulus by zero,
the user is supposed to be prompted for a result. Also, by the same
reasoning, I think that the user should be prompted when asking for
input. I re-wrote the REXX code to support all the REXXes I know,
and also removed the dependency on the "stack". I also kept at
the optimization of the code where it got to the point of being
six times faster than the original. I also added another option
to limit the number of iterations in the case of an infinite loop,
and made the default 1,000,000. At which time, an appropriate
message is generated (as well when it stops normally).
I tried to simplify some of the code, but for some REXX programmers,
it may have obfuscated it instead. My main intent was to increase
the speed of the (REXX) Befunge interpreter.
================================================================
/*REXX*/ signal on notready
parse arg file times _ . /*obtain user specified
options. */
if times=='' then times=1000000 /*limit of 1 million
iterations.*/
if _\=='' then call error 1359,'too many arguments'
if \datatype(times,'N') then call error 1353,times "isn't numeric."
if \datatype(times,'W') then call error 1392,times "isn't a whole
number."
if times<0 then call error 1302,times "can't be
negative."
if file=='' | file==',' then file='DEFAULT.BEF' /*default input
file.*/
do n=1 while lines(file)\==0; @.n=linein(file) ; end /*read
input.*/
do n=1 for 25; @.n=left(@.n,80,' '); end /*make 80
chr*/
rand.1=-1 0
rand.2= 1 0
rand.3='0 -1'
rand.4= 0 1
div0='division by zero, enter desired result:'
x=-1; y=0; xn=1; yn=0; mode=0; q=0; !.0=; call time 'R'
do times
x=x+xn; if x>79 then x=0; if x<0 then x=79
y=y+yn; if y>24 then y=0; if y<0 then y=24
_=y+1
@=substr(@._,x+1,1) /*get next character to
examine. */
select
when mode & @\=='"' then call ! c2d(@)
when @==' ' then iterate
when @=='v' then do; yn= 1; xn= 0; end
when @=='^' then do; yn=-1; xn= 0; end
when @=='<' then do; yn= 0; xn=-1; end
when @=='>' then do; yn= 0; xn= 1; end
when @=='.' then call charout ,$()' '
when @=='*' then call ! $$()*b
when @=='+' then call ! $$()+b
when @=='-' then do; call $$; call ! b-a; end
when @=='/' then do; call $$;if a\==0 then call ! b%a;else call
u;end
when @=='%' then do; call $$;if a\==0 then call ! b//a;else call
u;end
when @==',' then call charout ,d2c($())
when @=='\' then do; call $$; call ! a; call ! b; end
when @==':' then do; call ! $(); call ! a; end
when @=='$' then q=q-1
when @=='g' then do; call $$; call ! c2d(get(b,a)); end
when @=='p' then do; call $$$; call put c,b,a; end
when @=='`' then call ! $()<$()
when @=='!' then call ! $()==0
when @=='?' then do; r=random(1,4); parse var rand.r xn yn;end
when @=='_' then do; yn=0; if $()\==0 then xn=-1;else xn=1; end
when @=='|' then do; xn=0; if $()\==0 then yn=-1;else yn=1; end
when @=='~' then call ! c2d(charin(''))
when @=='#' then do; y=y+yn; x=x+xn; end
when @=='&' then call u 'enter number:'
when \mode & @>=0 & @<=9 then call ! @
when @=='"' then mode=mode&&1
when @=='@' then leave
otherwise nop
end /*select*/
end /*forever*/
if @=='@' then _='finished'
else _='exhausted' times
say;say;say _ 'and took' format(time('E'),,2) "seconds.";say
exit
!:parse arg qq;q=q+1;!.q=qq;return
$$$:a=!.q;q=q-1;b=!.q;q=q-1;c=!.q;q=q-1;if q<0 then q=0;return a
$$:a=!.q;q=q-1;b=!.q;q=q-1;if q<0 then q=0;return a
$:a=!.q;q=q-1;if q<0 then q=0;return a
error:say;say "***error!***" arg(2);say;exit arg(1)
get:parse arg gx,gy;gy=gy+1;return substr(@.gy,gx+1,1)
notready:call error 1328,"File doesn't exist:" file
put:parse arg c,a,b;b=b+1;@.b=delstr(@.b,a+1)d2c(c)substr(@.b,a
+2);return
u:_=;if arg(1,'o') then _=div0;say _;call ! linein('');return
=============================================================================
_____________________________________________________________Gerard S.
LesK
by the ANSI Standard. OORexx will complain about it's use.
--
Les (Change Arabic to Roman to email me)
Rugxulo
On Apr 28, 2:23 pm, GerardS <gerar...@rrt.net> wrote:
>
> I noticed in the original posting of the REXX code for a BEFUNGE93
> interpreter that when in the case of division or modulus by zero,
> the user is supposed to be prompted for a result.
That's indeed what the spec says, but most don't bother (it's rare).
So I wasn't too concerned with it, honestly.
> Also, by the same reasoning, I think that the user
> should be prompted when asking for input.
Makes sense, don't want the user to think it froze! ;-)
> I re-wrote the REXX code to support all the REXXes I know,
What REXXes did you test? Out of the box, it "mostly" works with
Regina but none of my others. (Very easy to fix, though.)
> and also removed the dependency on the "stack". I also kept at
> the optimization of the code where it got to the point of being
> six times faster than the original.
Yeah, yours is much faster! (Seems that fastest to slowest, for me,
are BRexx32, OORexx, Regina, r4.)
> I also added another option
> to limit the number of iterations in the case of an infinite loop,
> and made the default 1,000,000. At which time, an appropriate
> message is generated (as well when it stops normally).
Very good job!
> I tried to simplify some of the code, but for some REXX programmers,
> it may have obfuscated it instead.
<sarcasm> Obfuscated and Befunge rarely go together. </sarcasm>
> My main intent was to increase
> the speed of the (REXX) Befunge interpreter.
>
> ================================================================
> (snip)
> ================================================================
Okay, so here's various compatibility fixes:
# fix.sed
s/0=;/0=0;/
s/_=;/_='';/
s/\([^']\)@/\1A/g
/'$'/!y/$/S/
# (EOF)
With that, it works with latest BRexx and r4. But it still could use
some minor tweaking:
parse source . . srcfile . ; n=1
if lines(srcfile)==1 then do n=1 while lines(file)\==0
A.n=linein(file);end;else do lines(file);A.n=linein(file)
n=n+1;end /*read input*/
...
when A==',' then do;me=S();if me=10 then say
else call charout ,d2c(me);end
Now it should work on old pre-built BRexx (with line() bug) and
display correctly even on CR+LF systems.
P.S. Actually, there's another rare bug (dunno where exactly)
somewhere in BRexx that is only uncovered with your version. For
reference, here's the test case below (funnysig.bef), hopefully shows
up aligned correctly in various newsreaders!!
v >$v v <
>31#v #-?+>2+>:"##"-\g:"$"-#v_@
> > > ^ >,88+:1g1+\1p^
"In Soviet Russia, Befunge obfuscate *YOU*!" -- Yakov Smirnoff$
"Yeah, but does it run BefOS?" -- Slashdot$
"80x25 should be enough for anybody" -- Chris Pressey, 1993$
"All your Befunge are belong to us" -- Zero Wing (video game)$