Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Befunge-93 interpreter

47 views
Skip to first unread message

Rugxulo

unread,
May 28, 2010, 1:41:41 AM5/28/10
to
{$standard-pascal}
{$transparent-file-names}
{$case-value-checking}

{ ====================================================================

Wednesday, May 26, 2010

Befunge-93 in standard-ish Pascal -- public domain, nenies proprajxo

(GPC 20070904 via DJGPP + GCC 3.4.4)

rugxulo _AT_ gmail _DOT_ com

!! Christus Rex !!

BUGS:
= most of the examples that I tested work fine (except NEGMOD.BEF)
= random via '?' is still not implemented (how???) :-/

LINKS:
= http://catseye.tc/projects/bef.html
= http://www.esolangs.org/wiki/Befunge
= http://board.flatassembler.net/topic.php?t=10810
= #esoteric on irc.freenode.net

HISTORY:
= v1.0 : initial (pre)release

==================================================================== }


program Befunge93(input,output,example);
label 9999;
const xmax = 80; ymax = 25; stackmax=1000;
type int = integer; {longint}
var
example: text;
x, y, i, j, k, l, m, numlines, a, b, c, sp, xdelta, ydelta: int;
stack: packed array [1..stackmax] of int;
bspace: packed array [1..xmax, 1..ymax] of char;
ch, chartemp: char;
strmode: boolean;

procedure incr(var k: int); begin k := succ(k) end;
procedure decr(var l: int); begin l := pred(l) end;

procedure push(m: int); begin stack[sp] := m;
if sp > 1 then decr(sp); end;
procedure pop(var m: int); begin
if sp < stackmax then begin incr(sp); m := stack[sp]; end
else m := 0; end;

{procedure unimplemented(r: array of char);
begin writeln(r,': *** not implemented yet ***'); end;}

begin {Befunge93}

for i := 1 to stackmax do stack[i] := 0;

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

{assign(example,'example');}
reset(example);
while not eof(example) do
begin
incr(i);
if eoln(example) then
begin
read(example,chartemp); i := 0; incr(numlines); incr(j);
end
else read(example,bspace[i,j]);
end;

{for j := 1 to ymax do for i := 1 to xmax do
if i < xmax then write(bspace[i,j]) else writeln;}

x := -1; y := 0; xdelta := 1; ydelta := 0; strmode := false;


while true do begin {main loop}

x := x + xdelta; y := y + ydelta;
if x > 79 then x := 0; if y > 24 then y := 0;
if x < 0 then x := 79; if y < 0 then y := 24;

ch := bspace[x+1,y+1];


{ *************************************************** }
{if paramstr(1) = '-d' then begin
write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');
for i := 1 to 5 do if sp+i < stackmax then write(' ',stack[sp+i]);
if strmode then writeln(' """"') else writeln; end;}
{ *************************************************** }


{for i := sp downto 1 do stack[i] := 0;}

if strmode then if ch <> '"' then push(ord(ch));

if ch = '"' then strmode := not strmode;

{writeln(' ch = ''',ch,'''');}

if not strmode then
if ch in ['0'..'9'] then push(ord(ch)-ord('0')) else
if ch in ['+','-','*','/','%','!','`','^','v','<','>','|','_','?','#',
',','.','~','&','$',':','\','g','p','"','@',' '] then

case ch of

' ': a := 0; {nop}
'"': a := 0; {already taken care of strmode}

{'0'..'9': push(ord(ch)-ord('0'));}

'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;

'v': begin xdelta := 0; ydelta := 1; end;
'^': begin xdelta := 0; ydelta := -1; end;
'<': begin xdelta := -1; ydelta := 0; end;
'>': begin xdelta := 1; ydelta := 0; end;
'#': begin {writeln('xd=',xdelta:1,'yd=',ydelta:1);}
case ydelta of -1: decr(y); 1: incr(y); 0: a := 0; end;
case xdelta of -1: decr(x); 1: incr(x); 0: a := 0; end; end;
'_': begin pop(a); ydelta := 0; if a <> 0 then xdelta := -1
else xdelta := 1; end;
'|': begin pop(a); xdelta := 0; if a <> 0 then ydelta := -1
else ydelta := 1; end;

'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);

'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;

'~': begin read(input,chartemp); push(ord(chartemp)); end;
'&': begin read(input,a); push(a); end;

'g': begin pop(b); pop(a); c := ord(bspace[a+1,b+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); bspace[a+1,b+1] := chr(c); end;

'?': a := 0; {unimplemented('rand');}

'@': goto 9999; {exit;}

{otherwise write('ch = ',ch);}

end {case ch}
else a := 0; {write('*** unknown ch = ''',ch,''' ***');}

end; {while true do}

9999: a := 0;
end. {Befunge93}

Rugxulo

unread,
May 31, 2010, 6:04:50 PM5/31/10
to
Hi,

On May 28, 12:41 am, Rugxulo <rugx...@gmail.com> wrote:
>
> Befunge-93 in standard-ish Pascal

Okay, here's a sed script for some non-standard Pascals (DOS). But the
examples (e.g. from BEFI package at FASM link above) have to be in CR
+LF format, so you'll have to convert them first.

#n

# ---------------------------------------------------------
# fpc -XXs -Os bef93.pas
# upx --best --lzma --all-filters bef93.exe 45,568 => 21,868 bytes
# ---------------------------------------------------------
# TP55, same for TMTPC 3.90, doesn't support Win9x LFNs
# tpc bef93.pas
# upx --best --8086 bef93.exe 5,280 => 3,603 bytes
# ---------------------------------------------------------
# tmtpc -$logo- -stub:tmt32.exe bef93.pas
# tmtpack bef93.exe 25,102 => 16,762 bytes
# ---------------------------------------------------------

/{\$/d
/program Befunge93/s/unge//
s/integer; {\(longint\)}/\1;/
/assign/{
s/{//
s/}//
s/'example'/paramstr(1)/
}
# ignore both CR and LF from .BEF file
s/\(example\)\(,chartemp\)/\1\2\2/
w bef93.pas

Rugxulo

unread,
May 31, 2010, 6:22:48 PM5/31/10
to
Hi again,

On May 31, 5:04 pm, Rugxulo <rugx...@gmail.com> wrote:
>
> > Befunge-93 in standard-ish Pascal
>

I really should benchmark more (esp. on my 586), but here's what I've
got so far (Pentium 4 Celeron, 2.40 Ghz, WinXP SP3 machine) from a few
days ago:


v bench2.bef
>91+:*-:0`#@ #._v
^ <


GPC 20070904, DJGPP, GCC 3.4.4
gpc -s -O2 -mtune=i686 -fomit-frame-pointer --no-range-checking
runtime bef93 bench2.bef : 18.74 seconds elapsed

FPC 2.4.0, DOS/GO32v2
fpc -XXs -O2 -Oppentium4
runtime bef93 bench2.bef : 21.15 seconds elapsed

IP Pascal (demo)
pc /s (after removing "k,l,m: int")
runtime bef93 bench2.bef : 03:28.90 elapsed

ACK on DOS-Minix 2.0.4 (i386) under FreeDOS
mv bef93.pas bef93.p ; pc bef93.p -o bef93
time bef93 bench2.bef : 1:02.00 real 1:01.26 user 0.00 sys

Rugxulo

unread,
Jun 2, 2010, 5:36:49 AM6/2/10
to
Hi,

On May 31, 5:04 pm, Rugxulo <rugx...@gmail.com> wrote:
>
> > Befunge-93 in standard-ish Pascal
>

> # ignore both CR and LF from .BEF file
> s/\(example\)\(,chartemp\)/\1\2\2/
> w bef93.pas

A better solution (that seems to work in my tests) is apparently this
(but corrections welcome!):

if eoln(example) then
begin readln(example);


i := 0; incr(numlines); incr(j);
end

ANSI/ISO just reads in a single blank space for EOL whereas Borland-
ish ones apparently read the actual chars (#13 and #10 for DOS).

Rugxulo

unread,
Jun 6, 2010, 7:43:03 PM6/6/10
to
Hi, back by popular demand (not)! ;-)

On May 28, 12:41 am, Rugxulo <rugx...@gmail.com> wrote:
>

> Befunge-93 in standard-ish Pascal -- public domain, nenies proprajxo
>

> HISTORY:
>   = v1.0 : initial (pre)release

This one below should be better. I cleaned it up, and it should
compile out-of-the-box on most compilers. The obvious difference is
that ISO 7185 has no randomize/random, plus the way it handles cmdline
is implementation defined. Nevertheless, everything should still
(mostly) "just work" there too.

------------------------------------------------
{language=turbo}{ansic=1}{headername="p2c.h"}
{randomizename=srand(time(0));//}{randintname=rand()%6;//}

{"gpc -s -O --standard-pascal --transparent-file-names"}
{then at runtime: "--gpc-rts -n example:guesswho.bef"}

{sed -n -e "/program/s/,example//" -e "/reset(/d" -e "/ple: text/d" \
-e "s/example/input/" -e "w b-p5.pas"}

{ *) (*$M Thank you for using ISO 7185*) (* }

{ ====================================================================

Sunday, June 6, 2010 6:14pm

Befunge-93 in standard Pascal -- public domain, nenies proprajxo

preferred: GPC 20070904 (DJGPP + GCC 3.4.4)
also fixed to work: FPC, TP55, TMT, P2C, VP, IP, P5 (see sed above)
need testing again: IRIE, ALICE, ACK
test later: Vector, Javascal, Prospero

rugxulo _AT_ gmail _DOT_ com

!! Christus Rex !!

BUGS:
= TP, TMT, probably others only understand CR+LF .BEF files !!
- be sure to convert unless you want it to hang :-/
= TMT fails EDGETEST.BEF (but others don't ??)
- in fairness, even BEFI and "official" BEF do too!
- but FBBI and CCBI handle it correctly, so ...
= requires ASCII charset
- would a xlat table fix this? (I don't have EBCDIC to test!)
= B93 always expects signed 32-bit stack
- use "longint" if necessary and available (but not on GPC !)
= NEGMOD.BEF success seems to depend on the compiler
- ISO error? nobody complains, but yeah, it's unreliable
= random via '?' is still not fully implemented (how???) :-/
- probably no ISO 7185 method w/o making user seed manually
- pipe time into stdin and act on that?? (separate version?)
- use implementation defined (e.g. ptr data uninitialized)??
- note that it is just ignored, it doesn't fail !!
- hence it should still work (except for broken scripts
(SALUTON4.BEF, oops) that assume it will eventually find its
way out, which is never guaranteed!)

HISTORY:
= v1.0 : initial (pre)release

= v1.1 : minor cleanups (but still using "goto")
= v1.2 : mixed comment compatibility tricks, still needs cleanups
= v1.3 : more cleanups, put some stuff into procedures for clarity

==================================================================== }

program bef93(input,output,example);


label 9999;
const xmax = 80; ymax = 25; stackmax=1000;
type

{ *) longint = integer; (* } {ignored by non-ISO (TP-ish) compilers}
int = longint;
var
{ *) paramcount: int; (* }
example: text;
x, y, i, j, a, b, c, sp, xdelta, ydelta: int;


stack: packed array [1..stackmax] of int;
bspace: packed array [1..xmax, 1..ymax] of char;
ch, chartemp: char;
strmode: boolean;

procedure nop; begin {a := 0} end;
procedure clearstack; var i: int; begin for i := 1 to stackmax do
stack[i] := 0 end;
procedure clearbspace; var i,j: int; begin for j := 1 to ymax do
for i := 1 to xmax do bspace[i,j] := ' ' end;
procedure incr(var k: int); begin k := k+1 end;
procedure decr(var l: int); begin l := l-1 end;


procedure push(m: int); begin stack[sp] := m;
if sp > 1 then decr(sp); end;
procedure pop(var m: int); begin
if sp < stackmax then begin incr(sp);
m := stack[sp]; end else m := 0; end;

procedure delta(xd, yd: int); begin
xdelta := xd; ydelta := yd; end;
{ *) procedure randomize; begin end; (* }
{ *) function random(r: int):int; begin r := r; random := 0; end; (* }
{ *) procedure assign(var e:text; i:int);begin reset(e);i:=i end; (* }
{ *) function paramstr(n:int):int; begin n:=n; paramstr:=1; end; (* }
{ *) procedure halt; begin goto 9999 end; (* }
{procedure debug; var i: int; begin


write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');

for i := 1 to 4 do if sp+i < stackmax then write(' ',


stack[sp+i]);
if strmode then writeln(' """"') else writeln; end;}

{procedure showbspace; var i,j: int; begin
for j := 1 to ymax do for i := 1 to xmax+1 do
if i < xmax+1 then write(bspace[i,j]) else writeln;
halt end;}

begin {bef93}

randomize; clearstack; clearbspace; i := 0; j := 1; sp := stackmax;

{ *) paramcount := 1; (* }
if paramcount = 0 then halt else assign(example,paramstr(1));

reset(example);
while not eof(example) do begin incr(i);
if eoln(example) then begin

readln(example); i := 0; incr(j); end


else read(example,bspace[i,j]);
end;

{ make sure we read the file in correctly}
{ this wraps and looks wrong on 80x25, redirect to file}
{ can't skimp, I need to show it all !!!}
{showbspace;}

x := -1; y := 0; delta(1,0); strmode := false;

while true do begin {main loop}

{wrap if necessary}


x := x + xdelta; y := y + ydelta;

if x > xmax-1 then x := 0; if y > ymax-1 then y := 0;
if x < 0 then x := xmax-1; if y < 0 then y := ymax-1;

ch := bspace[x+1,y+1];

{debug;}

{ this is slow yet shouldn't be needed}


{for i := sp downto 1 do stack[i] := 0;}

if strmode then if ch <> '"' then push(ord(ch));

if ch = '"' then strmode := not strmode;

if not strmode then


if ch in ['0'..'9'] then push(ord(ch)-ord('0')) else
if ch in ['+','-','*','/','%','!','`','^','v','<','>','|','_','?','#',
',','.','~','&','$',':','\','g','p','"','@',' '] then

case ch of

' ': nop;
'"': nop;

'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;

'^': delta(0,-1);
'v': delta(0,1);
'<': delta(-1,0);
'>': delta(1,0);
'#': begin case ydelta of -1: decr(y); 1: incr(y); 0: nop; end;
case xdelta of -1: decr(x); 1: incr(x); 0: nop; end; end;
'_': begin pop(a); if a <> 0 then delta(-1,0) else delta(1,0); end;
'|': begin pop(a); if a <> 0 then delta(0,-1) else delta(0,1); end;

'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);

'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;

'~': begin read(input,chartemp); push(ord(chartemp)); end;
'&': begin read(input,a); push(a); end;

'g': begin pop(b); pop(a); c := ord(bspace[a+1,b+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); bspace[a+1,b+1] := chr(c); end;

'?': begin a := random(4)+1; case a of 0: nop; 1: delta(0,-1);
2: delta(0,1); 3: delta(-1,0); 4: delta(1,0); end end;
'@': halt;
{otherwise write(' ch = ''',ch,'''');}

end {case ch}
else nop; {write('*** unknown ch = ''',ch,''' ***');}
end; {while true do}

9999:
end. {bef93}

Rugxulo

unread,
Jun 28, 2010, 1:59:09 PM6/28/10
to
Hi, back again, figured some minor improvements were worth reposting.
(Besides, not much traffic here otherwise.)


On Jun 6, 6:43 pm, Rugxulo <rugx...@gmail.com> wrote:
>
> Hi, back by popular demand (not)!    ;-)

-------------------

{language=turbo}{ansic=1}{headername="p2c.h"}
{randomizename=srand(time(0));//}{randintname=rand()%6;//}

{"gpc -s -O --classic-pascal --transparent-file-names"}


{then at runtime: "--gpc-rts -n example:guesswho.bef"}

{sed -n -e "s/t,example)/t)/" -e "s/example: txt;//" \
-e "s/example/input/g" -e "s/reset([^)][^)]*);*//" \
-e "/^.sed/,/bef93\.pas/d" -e "w b-p5.pas" bef93.pas}

{ *) (*$M Thank you for using ISO 7185*) (* }

{ ====================================================================

Monday, June 28, 2010 12:20pm

Befunge-93 in standard Pascal -- public domain, nenies proprajxo

preferred: GPC 20070904 (DJGPP + GCC 3.4.4)

also fixed to work: FPC, TMT390, TP55, VP21, IP, ACK, IRIE, P2C
needs minor fixes: P5, ALICE, Vector, Canterbury, PTOC, PTC
test later: Prospero

rugxulo _AT_ gmail _DOT_ com

!! Christus Rex !!

BUGS:
= IP's 2005 demo limits to 200 lines (even comments!)
- just strip these useless lines and then it'll work


= TP, TMT, probably others only understand CR+LF .BEF files !!

- use the loadfixedbeffile routine (or else it hangs on *nix LF)


= TMT fails EDGETEST.BEF (but others don't ??)
- in fairness, even BEFI and "official" BEF do too!

- but "official" FBBI and CCBI handle it correctly, so ...


= requires ASCII charset
- would a xlat table fix this? (I don't have EBCDIC to test!)
= B93 always expects signed 32-bit stack
- use "longint" if necessary and available (but not on GPC !)

- "gp --uses=system -D__BP_TYPE_SIZES__" if not --classic


= NEGMOD.BEF success seems to depend on the compiler
- ISO error? nobody complains, but yeah, it's unreliable
= random via '?' is still not fully implemented (how???) :-/
- probably no ISO 7185 method w/o making user seed manually
- pipe time into stdin and act on that?? (separate version?)
- use implementation defined (e.g. ptr data uninitialized)??
- note that it is just ignored, it doesn't fail !!
- hence it should still work (except for broken scripts
(SALUTON4.BEF, oops) that assume it will eventually find its
way out, which is never guaranteed!)

= p2c 1.21a2 (1993) dislikes $ifdef directives (sigsegv)
- 1.20.1 accepts it fine, however
- BTW, don't forget to set P2C_HOME if needed
= TP55 dislikes incompatible compiler directives (error)
- others are smarter and ignore 'em
= ptoc only outputs C++ for "-turbo" due to varstrings
- still possible to use C but needs reset(example,'example')
or manually adjusting C src to use argv[1], etc.
- note that it does read mixed comments, unlike most
= ptc is tough to compile, esp. too hard for me in its
Pascal version, but it (mostly) works too after tweaks
- in particular, assumes "int rewind"; try the fseek patches
= newp2ada 2008 doesn't work yet, but I'm considering it
- at minimum, it needs "stubedit p2ada.exe minstack=8m" first

HISTORY:
= v1.0 : initial (pre)release
= v1.1 : minor cleanups (but still using "goto")
= v1.2 : mixed comment compatibility tricks, still needs cleanups
= v1.3 : more cleanups, put some stuff into procedures for clarity

= v1.4 : (very rough, pseudo-) LFN support for TP55 (default off)
= v1.5 : more tweaks, esp. re: *nix LFs for TP55 and TMT390
= v1.6 : fixed P5 sed hack, more compatibility notes
= v1.7 : removed "goto" (except in "halt" emulation)

==================================================================== }

program bef93(input,output,example);
{uses LFNhack;} (* TP 5.5 *)
{uses WinCRT;} (* VP 2.1, works in Win 3.1/Win32s if not UPX'd! *)
{ *) label 9999; (* }


const xmax = 80; ymax = 25; stackmax=1000;
type
{ *) longint = integer; (* } {ignored by non-ISO (TP-ish) compilers}
int = longint;

txt = text; {file of char;} {latter only for TP or TMT}


var
{ *) paramcount: int; (* }

example: txt; strmode: boolean; ch, chartemp: char;


x, y, i, j, a, b, c, sp, xdelta, ydelta: int;
stack: packed array [1..stackmax] of int;
bspace: packed array [1..xmax, 1..ymax] of char;

{ *) procedure inc(var k: int); begin k := k+1 end; (* }
{ *) procedure dec(var l: int); begin l := l-1 end; (* }


{ *) procedure randomize; begin end; (* }

{ *) function random(r: int):int; begin r:=r+1;random := -1;end; (* }
{ *) procedure assign(var e:txt; i:int);begin reset(e);i:=i end; (* }
{ *) procedure close(var e:txt);begin reset(e) end; (* }


{ *) function paramstr(n:int):int; begin n:=n; paramstr:=1; end; (* }
{ *) procedure halt; begin goto 9999 end; (* }

procedure nop; begin {a := 0} end;


procedure clearstack; var i: int; begin for i := 1 to stackmax do
stack[i] := 0 end;
procedure clearbspace; var i,j: int; begin for j := 1 to ymax do
for i := 1 to xmax do bspace[i,j] := ' ' end;

procedure push(m: int); begin stack[sp] := m;

if sp > 1 then dec(sp); end;


procedure pop(var m: int); begin

if sp < stackmax then begin inc(sp);


m := stack[sp]; end else m := 0; end;
procedure delta(xd, yd: int); begin
xdelta := xd; ydelta := yd; end;

procedure loadbeffile; begin while not eof(example) do begin inc(i);


if eoln(example) then begin readln(example); i := 0;

inc(j); end else read(example,bspace[i,j]); end; end;

{


procedure debug; var i: int; begin
write(' x,y = ',x:2,',',y:2); if ch <> '"' then
write(' ch = "',ch,'"') else write(' ch = ''',ch,'''');

for i := 1 to 4 do if sp+i < stackmax then write(' ',stack[sp+i]);


if strmode then writeln(' """"') else writeln; end;
procedure showbspace; var i,j: int; begin
for j := 1 to ymax do for i := 1 to xmax+1 do
if i < xmax+1 then write(bspace[i,j]) else writeln; halt end;

procedure clearusedstack; begin for i := sp downto 1 do
stack[i] := 0 end;
procedure loadfixedbeffile; begin
while not eof(example) do begin inc(i); read(example,ch);
if (ord(ch)=13) or (ord(ch)=10) then begin i := 0; if ord(ch)=10
then inc(j) end else bspace[i,j] := ch end end;
}

begin {bef93}

randomize; clearstack; clearbspace;

i := 0; j := 1; sp := stackmax;

{ *) paramcount := 1; (* }
if paramcount = 0 then halt else assign(example,paramstr(1));

reset(example); loadbeffile; close(example);

(* make sure we read the whole file in correctly


this wraps and looks wrong on 80x25, redirect to file

can't skimp, I need to show it all !!! *)
{showbspace;}

x := -1; y := 0; delta(1,0); strmode := false;

repeat {main loop}

(* wrap if necessary *)


x := x + xdelta; y := y + ydelta;
if x > xmax-1 then x := 0; if y > ymax-1 then y := 0;
if x < 0 then x := xmax-1; if y < 0 then y := ymax-1;

ch := bspace[x+1,y+1];

{debug;}

(* this is slow yet shouldn't be needed *)
{clearusedstack;}

if strmode then if ch <> '"' then push(ord(ch));

if ch = '"' then strmode := not strmode;

if not strmode then
if ch in ['0'..'9'] then push(ord(ch)-ord('0')) else
if ch in ['+','-','*','/','%','!','`','^','v','<','>','|','_','?','#',
',','.','~','&','$',':','\','g','p','"','@',' '] then

case ch of

' ': nop;
'"': nop;

'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;

'^': delta(0,-1);
'v': delta(0,1);
'<': delta(-1,0);
'>': delta(1,0);

'#': begin case ydelta of -1: dec(y); 1: inc(y); 0: nop; end;
case xdelta of -1: dec(x); 1: inc(x); 0: nop; end; end;


'_': begin pop(a); if a <> 0 then delta(-1,0) else delta(1,0); end;
'|': begin pop(a); if a <> 0 then delta(0,-1) else delta(0,1); end;

'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);

'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;

'~': begin read(chartemp); push(ord(chartemp)); end;
'&': begin read(a); push(a); end;

'g': begin pop(b); pop(a); c := ord(bspace[a+1,b+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); bspace[a+1,b+1] := chr(c); end;

'?': begin a := random(4)+1; case a of 0: nop; 1: delta(0,-1);
2: delta(0,1); 3: delta(-1,0); 4: delta(1,0); end end;

'@': nop; {halt;}


{otherwise write(' ch = ''',ch,'''');}

end {case ch}
else nop; {write('*** unknown ch = ''',ch,''' ***');}

until (not strmode) and (ch = '@');

{ *) 9999: (* }
end. {bef93}

Rugxulo

unread,
Jul 6, 2010, 12:44:24 PM7/6/10
to
Oops, made a silly mistake.

On Jun 28, 12:59 pm, Rugxulo <rugx...@gmail.com> wrote:
>
>         -e "s/example/input/g" -e "s/reset([^)][^)]*);*//" \

"*)" accidentally ends the "{sed" comment (in ISO 7185 mode only),
which is not what you want. Workaround is putting '[' and ']' around
the ')' after the '*' :

-e "s/reset([^)][^)]*[)];*//" \

It's so trivial that I almost didn't think it was worth mentioning,
but better safe than sorry. ;-)

Rugxulo

unread,
Aug 19, 2010, 5:51:21 PM8/19/10
to
Hi again,
In the interest of exploring Extended Pascal (ISO 10206), I've
ported my wimpy B93 interpreter to it.

However, I'm a bit confused about something. In "classic" standard
(7185) Pascal, I can blank-pad a packed array of char by saying this
(right?): blah[1] := ' ';

Extended Pascal doesn't do that. And when I changed it to use real
(extended) strings, it seems that even after manually blank-padding
the string array that it's resetting the length of the string to what
was read from file. At least, I'm pretty sure that's why I get "value
out of range" error. So I had to manually disable that (sadly) in lieu
of a better solution for now. Suggestions welcome (but traffic here is
very low, oh well)!

P.S. I don't have access to any Extended Pascal compiler besides
latest GPC (2007), so I can't test there. Prospero's didn't "seem" to
install correctly here on XP, and it didn't let me re-install, so
that's a bust. If anybody has it installed and compiles it correctly,
I'd be interested in a copy of the .EXE (just for comparison).


> On Jun 28, 12:59 pm, Rugxulo <rugx...@gmail.com> wrote:
>

> Befunge-93 in standard Pascal -- public domain, nenies proprajxo

{$extended-pascal}
{$transparent-file-names} {or "--gpc-rts -n example:guesswho2.bef"}
{$no-range-checking} {why needed?}

{ ====================================================================

Thursday, August 19, 2010 4:20pm

Befunge-93 in Extended Pascal -- public domain, nenies proprajho

preferred: GPC 20070904 (DJGPP + GCC 3.4.4)

untested: Visible/Dr. Pascal's EP compiler (DOS/commercial) ??,
Visible/pc-pix interpreter (DOS/commercial, "some EP" ??)
DEC/Compaq/HP Pascal (VAX or Alpha/VMS, commercial)
test later: Prospero compiler (Win32/freeware now) -- !! BROKEN !!

rugxulo _AT_ gmail _DOT_ com

!! Christus Rex !!

BUGS:
= TODO: use bindable files (see Pascal Standards FAQ)
= argh, EPASCAL.EXE installs wrong and whines, so I dunno ...

HISTORY:
= v2.0-rc4 : simple conversion from 7185 to 10206

==================================================================== }

program bef93ext(input,output,example);
const xmax=sqr(9)-1; ymax=5 pow 2; stackmax=16#400;
type { *) longint = integer; (* } int = longint;
str = string(xmax) value (* 40+40 = 80 chars for Befunge-93 *)
' '+
' ';
var
example: text; ch, chartemp: char; a, b, c: int;


stack: packed array [1..stackmax] of int;

line: array [1..ymax] of str;
x: int value -1; y, ydelta: int value 0;
sp: int value stackmax; xdelta: int value 1;
strmode: boolean value false;

ts: timestamp; timeit: boolean value true;

{ *) procedure inc(var k: int); begin k := k+1 end; (* }
{ *) procedure dec(var l: int); begin l := l-1 end; (* }

procedure nop; begin {a := 0} end;

procedure delta(xd, yd: int); begin xdelta := xd; ydelta := yd end;
procedure push(m: int);
begin stack[sp] := m; if sp > 1 then dec(sp) end;
procedure pop(var m: int);
begin if sp < stackmax then begin inc(sp); m := stack[sp]; end
else m := 0 end;

procedure clear_stack; var s: int;
begin for s := 1 to stackmax do stack[s] := 0 end;
procedure read_b93_file(var eg: text); var i: int;
begin reset(eg); for i := 1 to ymax do if not eof(eg) then
readln(eg,line[i]); end;
procedure say_time(msg: string);
begin if timeit then begin writeln;
gettimestamp(ts); writeln('== ',msg+'ed at ',time(ts),' ==');
end; end;
{
procedure clear_bspace; var bx, by: int; begin
for by := 1 to ymax do for bx := 1 to xmax do
line[by,bx] := ' ' end;
procedure clear_used_stack; var s: int;
begin for s := sp downto 1 do stack[s] := 0 end;
procedure b93_debug; var d: int; begin


write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');

for d := 1 to 5 do if sp+d < stackmax then
write(' ',stack[sp+d]:1);


if strmode then writeln(' """"') else writeln end;

procedure show_bspace; var yx, xx: int; begin
for yx := 1 to ymax do for xx := 1 to xmax+1 do
if xx < xmax+1 then write(line[yx,xx]) else writeln; halt end;
}

begin {bef93ext}

clear_stack; {clear_bspace;} read_b93_file(example);
{show_bspace;}

say_time('Start');

while true do begin {main loop}

x := x + xdelta; y := y + ydelta;

(* wrap if necessary *)
if x > xmax-1 then x := 0; if y > ymax-1 then y := 0;
if x < 0 then x := xmax-1; if y < 0 then y := ymax-1;

ch := line[y+1,x+1];

{b93_debug;}
{clear_used_stack;} (* this is slow and hopefully unnecessary! *)

if strmode then if ch <> '"' then push(ord(ch));
if ch = '"' then strmode := not strmode;

if not strmode then
case ch of


'0'..'9': push(ord(ch)-ord('0'));

'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;

'v': delta(0,1);
'^': delta(0,-1);


'<': delta(-1,0);
'>': delta(1,0);
'#': begin case ydelta of -1: dec(y); 1: inc(y); 0: nop; end;
case xdelta of -1: dec(x); 1: inc(x); 0: nop; end; end;
'_': begin pop(a); if a <> 0 then delta(-1,0) else delta(1,0); end;
'|': begin pop(a); if a <> 0 then delta(0,-1) else delta(0,1); end;
'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);
'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;
'~': begin read(chartemp); push(ord(chartemp)); end;
'&': begin read(a); push(a); end;

'g': begin pop(b); pop(a); c := ord(line[b+1,a+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); line[b+1,a+1] := chr(c); end;
'?': begin gettimestamp(ts); a := (ts.second mod 4) + 1;
case a of 1: delta(0,-1); 2: delta(0,1);


3: delta(-1,0); 4: delta(1,0); end; end;

'@': begin say_time('Finish'); writeln; halt; end;
otherwise nop;
end; {case ch}

end; {while true do}
end. {bef93ext}

Rugxulo

unread,
Sep 8, 2010, 3:43:12 AM9/8/10
to
Hi,

On Aug 19, 4:51 pm, Rugxulo <rugx...@gmail.com> wrote:
> it seems that even after manually blank-padding
> the string array that it's resetting the length of the string to what
> was read from file. At least, I'm pretty sure that's why I get "value
> out of range" error. So I had to manually disable that (sadly) in lieu
> of a better solution for now.

I just did this for now, so range checking can stay. It seems clean
enough, I guess, and I'm not worried about efficiency (esp. since the
file's read in only once, and well before interpreting/running
anything). SetLength() is a GPC extension, so I didn't want to use
that if I didn't have to.

(partial snip below):

var line: array [1..ymax] of str; blank: str;

procedure read_b93_file(var eg: text); var i, len: int;


begin reset(eg); for i := 1 to ymax do if not eof(eg) then
readln(eg,line[i]); end;

begin readln(eg,line[i]); {writeln(length(line[i]));}
len := length(line[i]); if len=0 then len := 1;
line[i] := line[i] + blank[len..xmax]; {writeln(length(line[i]));}
end; {halt;} end;

Rugxulo

unread,
Sep 8, 2010, 3:53:01 AM9/8/10
to
Hi,

On Sep 8, 2:43 am, Rugxulo <rugx...@gmail.com> wrote:
>
> procedure read_b93_file(var eg: text); var i, len: int;
>   begin reset(eg); for i := 1 to ymax do if not eof(eg) then

>   readln(eg,line[i]); end;

Delete this spurious line.

>   begin readln(eg,line[i]); {writeln(length(line[i]));}
>   len := length(line[i]); if len=0 then len := 1;
>   line[i] := line[i] + blank[len..xmax]; {writeln(length(line[i]));}
>   end; {halt;} end;

That's what I get for diff-ing the srcs and trying to paste from there.

John Reagan

unread,
Sep 13, 2010, 2:47:22 PM9/13/10
to

"Rugxulo" <rug...@gmail.com> wrote in message
news:e6be4f6e-a406-44f2...@z10g2000yqb.googlegroups.com...

Hi again,
In the interest of exploring Extended Pascal (ISO 10206), I've
ported my wimpy B93 interpreter to it.

However, I'm a bit confused about something. In "classic" standard
(7185) Pascal, I can blank-pad a packed array of char by saying this
(right?): blah[1] := ' ';


Uh, no classic Pascal doesn't do blank-padding. The lengths have to match.

I compiled your code with the Pascal compiler on OpenVMS. It isn't fully
Extended Pascal, but has all the features that your code needed. Well,
except for 'pow', but after I changed it to '**', everything compiled fine.

John


Rugxulo

unread,
Sep 13, 2010, 6:11:37 PM9/13/10
to
Hi,

On Sep 13, 1:47 pm, "John Reagan" <johnrrea...@earthlink.net> wrote:
> "Rugxulo" <rugx...@gmail.com> wrote in message
>
> news:e6be4f6e-a406-44f2...@z10g2000yqb.googlegroups.com...
>


>    However, I'm a bit confused about something. In "classic" standard
> (7185) Pascal, I can blank-pad a packed array of char by saying this
> (right?):    blah[1] := ' ';
>
> Uh, no classic Pascal doesn't do blank-padding.  The lengths have to match.

Hmmm, I don't know what I was thinking of then. Lemme see ....

---------------------
{$classic-pascal}
program tony(output);
var str: packed array [1..10] of char;
begin
str := 'Hi!';
write('''',str,''''); { 'Hi! ' }
end.
---------------------

That's GPC 20070904 (GCC 3.4.6, Kevan Hashemi's build?) on Lucid Puppy
Linux 5.0.1 (kernel 2.6.33.2). Seems to output the same even in
{$extended-pascal} mode.

> I compiled your code with the Pascal compiler on OpenVMS.  It isn't fully
> Extended Pascal, but has all the features that your code needed.  Well,
> except for 'pow', but after I changed it to '**', everything compiled fine.

First of all, long time no see! I know who you are, barely, but I
haven't seen you around here in a while. So big thanks for compiling,
yeah, I was curious if it would compile and work there. Did at least
most of my examples work? (Befunge-93 assumes 32-bit ints, sadly, but
Befunge-98 corrected that to native size, but that's a more complex
language anyways.)

http://sites.google.com/site/rugxulo/befi_2q.zip?attredirects=0

(Google might not allow direct downloads anymore, e.g. wget, so you
might have to use a web browser nowadays, doh!)

POW isn't needed, I just put it there just to prove it works (test the
language a bit, even if useless). And surely the random '?' operator
could be improved, but I'm unsure of a better standard way.

Anyways, here's the "official" (original) Befunge dude, and he
collected a bunch of examples years ago. No pressure, obviously, I'm
just curious if at least most of them work okay:

http://catseye.tc/projects/bef.html

Chris Burrows

unread,
Sep 13, 2010, 7:01:52 PM9/13/10
to
> "Rugxulo" <rug...@gmail.com> wrote in message
> news:5fbb1dab-1272-495b...@a19g2000vbi.googlegroups.com...

On Sep 13, 1:47 pm, "John Reagan" <johnrrea...@earthlink.net> wrote:
>>
>> Uh, no classic Pascal doesn't do blank-padding. The lengths have to
>> match.

> str := 'Hi!';
> write('''',str,''''); { 'Hi! ' }
...
...


> That's GPC 20070904 (GCC 3.4.6, Kevan Hashemi's build?) on Lucid Puppy
> Linux 5.0.1 (kernel 2.6.33.2).

John's correct of course. Must be a problem with that compiler (or that
version?).

Regards,
Chris Burrows
CFB Software

Astrobe: ARM Oberon-07 Development System
http://www.astrobe.com


Rugxulo

unread,
Sep 15, 2010, 3:46:20 AM9/15/10
to
Hi,

On Sep 13, 6:01 pm, "Chris Burrows" <cfbsoftw...@hotmail.com> wrote:
> > "Rugxulo" <rugx...@gmail.com> wrote in message
> >news:5fbb1dab-1272-495b...@a19g2000vbi.googlegroups.com...
>


> John's correct of course. Must be a problem with that compiler (or that
> version?).

Right right right, forgot that "he was there" back in the day! ;-)
Anyways, here's a new version, just fairly minor cleanups, seems to
still work. Too bad I can only test GPC, but I guess it's better than
nothing.

P.S. Sorry for the weird formatting. Mostly I just want it to work,
then I want it crammed out of my way. I also tried to limit to 70 for
line length so newsgroup wraparound doesn't destroy it. (Some of the
comments actually could be removed, obviously, for ultra clarity, but
that's debatable. I honestly prefer to keep everything together in one
file for convenience here, including compatibility issues.)

--------------------------


{$extended-pascal}
{$transparent-file-names} {or "--gpc-rts -n example:guesswho2.bef"}

{ ====================================================================

Wednesday, September 15, 2010 2:34am

Befunge-93 in Extended Pascal -- public domain, nenies proprajho

preferred: GPC 20070904 (DJGPP + GCC 3.4.4)

almost: DEC/Compaq/HP Pascal (VAX or Alpha/VMS, commercial)
--> (previously) John Reagan says s/pow/**/ then okay


untested: Visible/Dr. Pascal's EP compiler (DOS/commercial) ??

Visible/pc-pix interpreter (DOS/commercial, "some EP" ??)

test later: Prospero compiler (Win32/freeware now) -- !! BROKEN !!

rugxulo _AT_ gmail _DOT_ com

!! Christus Rex !!

BUGS:
= TODO: use bindable files (see Pascal Standards FAQ)
= argh, EPASCAL.EXE installs wrong and whines, so I dunno ...

HISTORY:
= v2.0-rc7 : conversion from 7185 to 10206 with cleanups

==================================================================== }

program bef93ext(input,output,example);
const xmax=sqr(9)-1; ymax=5 pow 2; stackmax=16#400;
type { *) longint = integer; (* } int = longint;

where = (up,down,left,right);


str = string(xmax) value (* 40+40 = 80 chars for Befunge-93 *)
' '+
' ';
var
example: text; ch, chartemp: char; a, b, c: int;
stack: packed array [1..stackmax] of int;

line: array [1..ymax] of str; blank: str;


x: int value -1; y, ydelta: int value 0;
sp: int value stackmax; xdelta: int value 1;
strmode: boolean value false;

ts: timestamp; timeit: boolean value true;

{ *) procedure inc(var k: int); begin k := k+1 end; (* }
{ *) procedure dec(var l: int); begin l := l-1 end; (* }
procedure nop; begin {a := 0} end;

procedure next_instruction;
begin x := x + xdelta; y := y + ydelta end;


procedure push(m: int);
begin stack[sp] := m; if sp > 1 then dec(sp) end;
procedure pop(var m: int);
begin if sp < stackmax then begin inc(sp); m := stack[sp] end
else m := 0 end;

procedure push2(var o,p: int); begin push(o); push(p) end;
procedure pop2(var q,r: int); begin pop(q); pop(r) end;


procedure clear_stack; var s: int;
begin for s := 1 to stackmax do stack[s] := 0 end;

procedure read_b93_file(var eg: text); var i, len: int;


begin reset(eg); for i := 1 to ymax do if not eof(eg) then

begin readln(eg,line[i]); len := length(line[i]);


if len=0 then len := 1; line[i] := line[i] + blank[len..xmax];

end end;
procedure travel(w: where);


procedure delta(xd, yd: int); begin xdelta := xd; ydelta := yd end;

begin case w of up: delta(0,-1); down: delta(0,1);
left: delta(-1,0); right: delta(1,0) end end;


procedure say_time(msg: string);
begin if timeit then begin writeln;
gettimestamp(ts); writeln('== ',msg+'ed at ',time(ts),' ==');
end end;

{
procedure clear_bspace; var bx, by: int;
begin for by := 1 to ymax do for bx := 1 to xmax do
line[by,bx] := ' ' end;
procedure clear_used_stack; var s: int;
begin for s := sp downto 1 do stack[s] := 0 end;
procedure b93_debug; var d: int;
begin write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');
for d := 1 to 5 do if sp+d < stackmax then
write(' ',stack[sp+d]:1);
if strmode then writeln(' """"') else writeln end;
procedure show_bspace; var yx, xx: int;
begin for yx := 1 to ymax do for xx := 1 to xmax+1 do
if xx < xmax+1 then write(line[yx,xx]) else writeln; halt end;
}

begin {bef93ext}

clear_stack; {clear_bspace;} read_b93_file(example);
{show_bspace;}

say_time('Start');

while true do begin {main loop}

next_instruction;

(* wrap if necessary *)

{if x > xmax-1 then x := 0; if y > ymax-1 then y := 0;}
{if x < 0 then x := xmax-1; if y < 0 then y := ymax-1;}

x := x mod xmax; y := y mod ymax; (* beware negatives! *)

ch := line[y+1,x+1];

{b93_debug;}
{clear_used_stack;} (* slow and hopefully unnecessary! *)

if strmode then if ch <> '"' then push(ord(ch));
if ch = '"' then strmode := not strmode;

if not strmode then
case ch of
'0'..'9': push(ord(ch)-ord('0'));
'.': begin pop(a); write(a:1,' ') end;
',': begin pop(a); if a=10 then writeln else write(chr(a)) end;

'^': travel(up);
'v': travel(down);
'<': travel(left);
'>': travel(right);
'#': next_instruction;
'_': begin pop(a); if a <> 0 then travel(left)
else travel(right) end;
'|': begin pop(a); if a <> 0 then travel(up)
else travel(down) end;
'`': begin pop2(b,a); push(ord(a > b)) end;
'!': begin pop(a); if a = ord(false) then push(ord(not false))
else push(ord(not true)) end;
'\': begin pop2(a,b); push2(a,b) end;
':': begin pop(a); push2(a,a) end;
'$': pop(a);
'+': begin pop2(b,a); push(a + b) end;
'-': begin pop2(b,a); push(a - b) end;
'*': begin pop2(b,a); push(a * b) end;
'/': begin pop2(b,a); push(a div b) end;
'%': begin pop2(b,a); push(a mod b) end;


'~': begin read(chartemp); push(ord(chartemp)) end;
'&': begin read(a); push(a) end;

'g': begin pop2(b,a); c := ord(line[b+1,a+1]); push(c) end;
'p': begin pop2(b,a); pop(c); line[b+1,a+1] := chr(c) end;


'?': begin gettimestamp(ts); a := (ts.second mod 4) + 1;

case a of 1: travel(up); 2: travel(down);
3: travel(left); 4: travel(right) end end;

John Reagan

unread,
Sep 15, 2010, 12:17:55 PM9/15/10
to

"Rugxulo" <rug...@gmail.com> wrote in message
news:4fd67a1a-c8af-44e9...@j19g2000vbh.googlegroups.com...
Hi,

On Sep 13, 6:01 pm, "Chris Burrows" <cfbsoftw...@hotmail.com> wrote:
> > "Rugxulo" <rugx...@gmail.com> wrote in message
> >news:5fbb1dab-1272-495b...@a19g2000vbi.googlegroups.com...
>
> John's correct of course. Must be a problem with that compiler (or that
> version?).

> Right right right, forgot that "he was there" back in the day! ;-)

Ouch! :) That makes me feel old. I'm only 50 and still doing compilers
(sadly not Pascal at the moment)

John


Rugxulo

unread,
Sep 15, 2010, 3:24:16 PM9/15/10
to
Hi,

On Sep 15, 11:17 am, "John Reagan" <johnrrea...@earthlink.net> wrote:
> "Rugxulo" <rugx...@gmail.com> wrote in message
>
> news:4fd67a1a-c8af-44e9...@j19g2000vbh.googlegroups.com...
> Hi,
>
> On Sep 13, 6:01 pm, "Chris Burrows" <cfbsoftw...@hotmail.com> wrote:
>
> > > "Rugxulo" <rugx...@gmail.com> wrote in message
> > >news:5fbb1dab-1272-495b...@a19g2000vbi.googlegroups.com...
>
> > John's correct of course. Must be a problem with that compiler (or that
> > version?).
> > Right right right, forgot that "he was there" back in the day!  ;-)
>
> Ouch! :)  That makes me feel old.  I'm only 50 and still doing compilers
> (sadly not Pascal at the moment)

Oops, I was hoping you wouldn't take that the wrong way! I just meant
that your reputation precedes you. ;-) And actually I knew you were
still pretty young, must've read it somewhere (old interview on Pascal
Central?), even if you have been at it a long time.

EDIT: Here it is, guess I should read it again. ;-)

http://www.pascal-central.com/interview1.html

Chris Burrows

unread,
Sep 15, 2010, 10:40:10 PM9/15/10
to
"John Reagan" <johnr...@earthlink.net> wrote in message
news:pbednbMqgpQmbA3R...@earthlink.com...

>
> Ouch! :) That makes me feel old. I'm only 50 and still doing compilers
> (sadly not Pascal at the moment)
>

Old? No way! You're only half way there yet!

Did you work on the Pascal for the HP 64000 Logic Development Systems that
we used back in 1983? I remember giving the developer(s) some "feedback" at
the time ;-) They were really nice machines to work on at the time. I just
looked up the issue of the HP Journal which was dedicated to the system
(March 1983) and it mentions a Joel Tesler as being responsible for the C
front-end but doesn't say anything about the Pascal developer.

I'm lucky enough to have been able to work on Niklaus Wirth's Oberon-07
compiler for the last couple of years :-) If you follow his example you've
got at least another 20 years in you yet!

Cheers,
Chris

Chris Burrows
CFB Software
http://www.cfbsoftware.com


John Reagan

unread,
Sep 15, 2010, 11:39:50 PM9/15/10
to

"Chris Burrows" <cfbso...@hotmail.com> wrote in message
news:4c9183b9$0$11120$c3e...@news.astraweb.com...

> "John Reagan" <johnr...@earthlink.net> wrote in message
> news:pbednbMqgpQmbA3R...@earthlink.com...
>>
>> Ouch! :) That makes me feel old. I'm only 50 and still doing compilers
>> (sadly not Pascal at the moment)
>>
>
> Old? No way! You're only half way there yet!
>
> Did you work on the Pascal for the HP 64000 Logic Development Systems that
> we used back in 1983?

I started with Digital Equipment in 1983 and immediately started on VAX
Pascal. Digital was bought by Compaq. Compaq was bought by
Hewlett-Packard. So, no, I didn't work on the HP systems in 1983. I worked
on VAXen at the time.

John


Rugxulo

unread,
Sep 25, 2010, 2:22:51 AM9/25/10
to
Hi, just some random comments from me,

On Sep 15, 2:46 am, Rugxulo <rugx...@gmail.com> wrote:
>
> (* wrap if necessary *)
>
> {if x > xmax-1 then x := 0; if y > ymax-1 then y := 0;}
> {if x < 0 then x := xmax-1; if y < 0 then y := ymax-1;}
>
> x := x mod xmax; y := y mod ymax; (* beware negatives! *)

I'm not even sure I understand if this is correct or not. But it seems
to work. (I really need to automate checking against my goofy test
suite. Oh well. Anyways, at least for three examples, b93_debug
produced the same output either way.)

However, I do (reasonably) wonder if some compiler or architecture
would mishandle this due to confusion over negatives (a la Wirth's
PIM3 vs. PIM4 ??). I guess I should consider rewriting this part. The
way it is, I end up starting at x = -1 (technically invalid) just so I
can consistently ++ it in the loop. I left the "old" way (without MOD)
commented just in case. In other words, if you know something I don't
(highly likely), please tell me.

>  '`': begin pop2(b,a); push(ord(a > b)) end;

This seems weird to me, but anyways, I'm using it, assuming no popular
compilers choke on it.

N.B. There really aren't that many ISO 10206 compilers, and Prospero
seems mostly defunct now (since Plunnecke retired??). Esp. what I grab
from their site (freeware?) doesn't work, says expired, and I don't
recall them ever mailing me any "key". It's not that I don't trust
GPC, it's just safer to experiment with more than one compiler. It's
too easy to incorrectly "assume" everything is portable without proof.

>  '!': begin pop(a); if a = ord(false) then push(ord(not false))
>       else push(ord(not true)) end;

Similar for here, kinda weird, except hopefully it's clearer this way
(??) than just using 1 and 0.

August Karlstrom

unread,
Oct 4, 2010, 1:47:09 PM10/4/10
to
On 2010-09-15 09:46, Rugxulo wrote:
[...]

> procedure read_b93_file(var eg: text); var i, len: int;
> begin reset(eg); for i := 1 to ymax do if not eof(eg) then
> begin readln(eg,line[i]); len := length(line[i]);
> if len=0 then len := 1; line[i] := line[i] + blank[len..xmax];
> end end;
> procedure travel(w: where);
> procedure delta(xd, yd: int); begin xdelta := xd; ydelta := yd end;
> begin case w of up: delta(0,-1); down: delta(0,1);
> left: delta(-1,0); right: delta(1,0) end end;
> procedure say_time(msg: string);
> begin if timeit then begin writeln;
> gettimestamp(ts); writeln('== ',msg+'ed at ',time(ts),' ==');
> end end;

What's the deal with the non-standard and hard to read code layout?


/August

--
The competent programmer is fully aware of the limited size of his own
skull. He therefore approaches his task with full humility, and avoids
clever tricks like the plague. --Edsger Dijkstra

Rugxulo

unread,
Oct 5, 2010, 12:00:13 AM10/5/10
to
Hi,

On Oct 4, 12:47 pm, August Karlstrom <fusionf...@gmail.com> wrote:
>
> What's the deal with the non-standard and hard to read code layout?

Use FPC's ptop.exe if you really care. It's not obfuscated (though I
have a version). ;-)

August Karlstrom

unread,
Oct 5, 2010, 8:15:04 AM10/5/10
to

I don't care but it gives an impression of illiteracy and carelessness.

0 new messages