Discussion:
Befunge93 in Pascal
(too old to reply)
Rugxulo
2010-01-13 06:12:00 UTC
Permalink
Well, I'm new here, and I don't really know Pascal at all, but since
I've barely squeaked out something (and it's better than the spam, at
least), I'll post it here. Yes, I know, it's not really useful yet.
Feel free to improve / explain / suggest!

http://en.wikipedia.org/wiki/Befunge
http://board.flatassembler.net/topic.php?t=10810

=======================================
{$define DEBUG}

{$standard-pascal} (* well, striving to be ... *)

(*********************************************
buggy, VERY incomplete, depends on ASCII
I don't grok Pascal yet!!

"echo 98*.@ >example" -> 72 (or ',' -> 'H')

rugxulo _AT_ gmail _DOT_ com
*********************************************)

program Befunge(input,output,example);

label 9999; (* "sed -e '/9999/s//adios/' *.pas | less" *)

const
bsize = 2000; (* 80*25 for B93 *)
maxstack = 1000; (* reasonable??? *)

type
line = array [1..80] of char;
string = packed array [1..20] of char;

var
i: integer;
bspace: array [1..bsize] of char;
bstack: array [1..maxstack] of integer;
example: text;

procedure debugmsg(chr: string);
begin
{$ifdef DEBUG}
writeln; writeln(chr);
{$endif}
end;

begin
debugmsg('*** Begin ***');

reset(example);

for i := 1 to bsize do
begin
if not eof(example) then
begin
bspace[i] := example^;
get(example);
end;
end;

for i := 1 to 5 do
begin

if bspace[i] in ['0'..'9'] then
bstack[i] := ord(bspace[i])-ord('0')
else
begin
case bspace[i] of
'+': bstack[5] := bstack[i-2] + bstack[i-1];
'-': bstack[5] := bstack[i-2] - bstack[i-1];
'*': bstack[5] := bstack[i-2] * bstack[i-1];
'/': bstack[5] := bstack[i-2] div bstack[i-1];
'%': bstack[5] := bstack[i-2] mod bstack[i-1];
'.': write(bstack[5]:1);
',': write(chr(bstack[5]));
'@': goto 9999; (* empty statement also accepted *)
end;
end;
end;

9999:
debugmsg('*** End ***');

end.
Rugxulo
2010-01-24 14:13:33 UTC
Permalink
Hi,
Post by Rugxulo
Well, I'm new here, and I don't really know Pascal at all, but since
I've barely squeaked out something (and it's better than the spam, at
least), I'll post it here. Yes, I know, it's not really useful yet.
Feel free to improve / explain / suggest!
http://en.wikipedia.org/wiki/Befunge
http://board.flatassembler.net/topic.php?t=10810
Still far from finished or perfect but works better now.

==================================
[ Vista/DJGPP 344 ] - Sun 01/24/2010 >redir -t gpc -s -O -Wall -Wextra
--standard-pascal --pedantic befunge.pas -o befunge.exe
befunge.pas:6: warning: compiler directives are a UCSD Pascal
extension
befunge.pas:32: warning: 'inc2' defined but not used
Elapsed time: 1.050 seconds

[ Vista/DJGPP 344 ] - Sun 01/24/2010 >befunge
45 1 4 14 4 81
HHH
[ Vista/DJGPP 344 ] - Sun 01/24/2010 >befi example
45 1 4 14 4 81
HHH
[ Vista/DJGPP 344 ] - Sun 01/24/2010 >bef -q example.
45 1 4 14 4 81
HHH
[ Vista/DJGPP 344 ] - Sun 01/24/2010 >type example
==================================

{ GPC 20070904, GCC 3.4.4, DJGPP }
{ rugxulo _AT_ gmail _DOT_ com }
{ http://rugxulo.googlepages.com }
{ nenies proprajho, public domain }

{$standard-pascal}
{$transparent-file-names}
{ or at run-time: "--gpc-rts=--file-name=example:example" }

program Befunge93(input,output,example);

const xmax = 80; ymax = 25; stackmax = 1000;
type spcoords = record x: integer; y: integer; end;
var bspace: array [1..xmax,1..ymax] of char;
bstack: array [1..stackmax] of integer;
example: text;
space: spcoords;
i,j,index: integer;

{
procedure showline(l: integer);
var k: integer;
begin
for k := 1 to xmax do
if (k <> 1) and (bspace[k,l] <> chr(0)) then
if bspace[k,l] <> '=' then write(bspace[k,l]) else writeln;
end;
}

procedure inc(var x: integer); begin x := x + 1; end;
procedure dec(var x: integer); begin x := x - 1; end;
procedure inc2(var x: integer); begin x := x + 2; end;
procedure dec2(var x: integer); begin x := x - 2; end;

begin {Befunge93}

for i := 1 to xmax do for j := 1 to ymax do bspace[i,j] := ' ';

reset(example);

{*****************************************************************}
for j := 1 to ymax do
for i := 1 to xmax do
if not eof(example) then
if not eoln(example) then
begin
bspace[i,j] := example^;
get(example);
end
else get(example);
{*****************************************************************}

{for i := 1 to ymax do showline(i);}

space.x := 1; space.y := 1; index := 1;

for i := 1 to xmax do
begin
space.x := i;

if bspace[space.x,space.y] in ['0'..'9'] then
begin
bstack[index] := ord(bspace[space.x,space.y]);
bstack[index] := bstack[index] - ord('0');
inc(index);
end
else
case bspace[space.x,space.y] of
'+':
begin
dec2(index);
bstack[index] := bstack[index] + bstack[index+1];
inc(index);
end;
'-':
begin
dec2(index);
bstack[index] := bstack[index] - bstack[index+1];
inc(index);
end;
'*':
begin
dec2(index);
bstack[index] := bstack[index] * bstack[index+1];
inc(index);
end;
'/':
begin
dec2(index);
bstack[index] := bstack[index] div bstack[index+1];
inc(index);
end;
'%':
begin
dec2(index);
bstack[index] := bstack[index] mod bstack[index+1];
inc(index);
end;
':':
begin
bstack[index] := bstack[index-1];
inc(index);
end;
'.':
begin
dec(index);
write(bstack[index]:1,' ');
end;
',':
begin
dec(index);
if bstack[index] = 9+1 then writeln else
write(chr(bstack[index]));
end;
'>': space.x := succ(space.x);
'<': space.x := pred(space.x);
' ': inc(space.x);
'@': ; {halt;}
end;
end;

end. {Befunge93}
==================================

Loading...