Interpret Befunge-93

11

4

The program will be provided as the first argument, stdin should be used for all read requests by the program and stdout for all write requests. It can be assumed that the program is less than 80 characters wide and less than 25 lines high.

  • ~ should push -1 if there is nothing to read.
  • Any pop off the bottom of the list should simply return 0, including for any calculations.
  • For p and g, x and y are 0 based indices.
  • Input should be fully buffered, i.e. & and ~ block the program until EOF is encountered on stdin then any remaining input is kept to serve future requests.

The following commands must be available:

0-9
    Push this number on the stack
+
    Addition: Pop a then b, push a+b
-
    Subtraction: Pop a then b, push b-a
*
    Multiplication: Pop a then b, push a*b
/
    Integer division: Pop a then b, push b/a, rounded down. If a is 0, result is undefined
%
    Modulo: Pop a then b, push the remainder of the integer division of b/a. If a is 0, result is undefined
!
    Logical NOT: Pop a value. If the value is 0, push 1; otherwise, push 0.
`
    Greater than: Pop a then b, push 1 if b>a, otherwise 0.
>
    Start moving right
<
    Start moving left
^
    Start moving up
v
    Start moving down
?
    Start moving in a random cardinal direction
_
    Pop a value; move right if value=0, left otherwise
|
    Pop a value; move down if value=0, up otherwise
"
    Start string mode: push each character's ASCII value all the way up to the next "
:
    Duplicate value on top of the stack
\
    Swap two values on top of the stack
$
    Pop value from the stack
.
    Pop value and output as an integer
,
    Pop value and output as ASCII character
#
    Trampoline: Skip next cell
p
    A "put" call (a way to store a value for later use). Pop y then x then v, change the character at the position (x,y) in the program to the character with ASCII value v
g
    A "get" call (a way to retrieve data in storage). Pop y then x, push ASCII value of the character at that position in the program
&
    Input an integer (may be multiple characters and may be negative) and push it
~
    Input a single character from stdin and push its ASCII value
@
    End program

This is a code golf, shortest answer wins. If there is a tie then the first answer wins.

You may use any language feature not specifically designed for Befunge to implement this, if you want to try and translate Befunge to native code and eval it good luck.

For test cases look at my recent answers. The reference interpreter I have been using is http://www.quirkster.com/js/befunge.html.

One quick test case of some features from "egnufeB">:#,_@

1-0g:"Z"-#v_$91+"sparw tup/teG">:#,_$               v                          Z
          >:" "-#v_$91+"ecaps snruter teg BOO">:#,_$v
v                >0" snruter teg BOO">:#,_$.91+,    >
>8:+:*11p11g#v_91+"tib 8 dengis"01-11p11g!#v_"nu">" era slleC">:#,_v
vv           >91+"tib 8>"                  >     ^                 >91+"krow " #
 >        >"spmuj egdE">:#,_   91+"krow "04-3%1+#v_        >"sredniamer evitag"v
>"ton od "^                                      >"ton od "^
"eN">:#,_  91+"skrow edomgnirts ni @">:#,_@                                    >

Nemo157

Posted 2011-02-07T01:12:58.507

Reputation: 1 891

What kind of input does an "ask what user wants" on division by zero take? Full integer parsing? 0 to 9 digit? ASCII value? – J B – 2011-02-07T21:14:43.093

@J B: I'll remove that requirement. That's what Wikipedia says it should do but none of the interpreters I've seen do that. I'll just make it undefined. – Nemo157 – 2011-02-07T21:39:10.837

Answers

5

Perl, 515 525 532

Ok, so this might not be the most readable code I've ever written, but it does run all the examples in the reference implementation page properly, and use -1 as a ~-didn't-have-a-reply value. (the programs in the page exercise the empty stack behavior extensively)

As usual, Perl 5.10 or later. In this instance, -M5.010 is your best bet. Newlines for presentation on CG.SE, you should remove them before trying. (in this "edit 1.5" ragged-right version, it might actually work out of the box)

@p=map[/./g],<>;$h=1;$_="for(;;){for(D_=P[Y][X]){
when('\"BS=!S}when(!!S){IordW0'||/\\d/){ID_W+BIO+
OW-BEO;IO-MW*BIO*OW/BEO;Iint(O/M)W%BEO;IO% MW!BI!
OW`BEO;I(M<O)W?BD_=qw(< > ^ v)[rand 4]R_BD_=O?'<'
:'>'R|BD_=O?'^':'v'R>BH=1;V=0W<BH=-1;V=0W^BH=0;V
=-1WvBH=0;V=1W:BI0+S[-1]W\\\\BIO,OWDBOW.BsayOW,B
print chrOW#BFWpBEO;N=O;P[M][N]=chrOWgBEO;IordP[
M][O]W&BIE<>W~BIord<>||-1WABexit}}F}";s/B/'){/g;
s/I/pushAs,/g;s/E/M=/g;s/F/X=(X+H)%A{P[0]};Y=(Y+
V)%Ap/g;s/O/(popAs)/g;s/R/;redoW/g;s/W/}when('/g
;y/DA/$@/;s/[A-Z]/\$\l$&/g;eval

Improvements welcome :-D

Edit 1: fix integer division (+2), reorganize (-9)

Edit 2 1.5: read char by char (+4); halt on division by zero (-10)

Still missing char by char input, I'm not clear yet how it parses numbers and I'm too tired to be able to do it now.

Not motivated enough to make the cell size unsigned 8-bit as suggested by the compatibility test, and not sure how negative remainders are expected in an unsigned environment.

J B

Posted 2011-02-07T01:12:58.507

Reputation: 9 638

Wow, you're not kidding about the readability. How do you get it working with input? I just tried echo "-2 + 6 / 2 * 8 - 1 / 2 - 18" | perl -M5.010 pe calc.be, where pe contains this program and calc.be contains this answer of mine, and it just output the input string.

– Nemo157 – 2011-02-07T18:59:54.280

My first bet would be a different interpretation of the spec than the reference implementation: ~ reads by ascii value indeed, but line by line. I'll look into it. – J B – 2011-02-07T19:27:45.540

Yes, that would be it. Just tried using "-2\n+\n6\n/\n2\n*\n8\n-\n1\n/\n2\n-\n18\n\n" as the input and it worked. Although it gave -10.5 instead of -11, probably not rounding after /. – Nemo157 – 2011-02-07T19:39:13.523

+1 now since the spec's ambiguous. I'll try and find out what other cli interpreters do, all the javascript ones seem to just use a one-line textbox. – Nemo157 – 2011-02-07T20:19:11.527

The integer division behavior is an unacceptable bug that will likely cost me 2 char. I'm split on the line-by-line. Is my interpretation of the spec valid? (oh, didn't see you'd answered in the meantime) – J B – 2011-02-07T20:26:08.143

So far all I've seen do fully buffered input, they pause at & and ~ until an EOF is entered then keep the rest of the input for future requests. I'll change the spec now, I've also found a quick test of a few features that I'll add as well. – Nemo157 – 2011-02-07T20:47:41.233

2

Delphi, 970 842

Since I did the Fish golf first, I just copied that and changed the interpretation to use Befunge-93 specs (which are simpler than Fish) so I mainly had to strip things away.

In the next revision I won 64 characters by implementing the movement code using 2 instead of 4 variables. Oh, and I inverted the stack, removing the need for a length variable. Another nice win is the '?' (random direction) instruction - I just change it into one of the four directions and let them handle it.

const X=80;var f:TextFile;c,s:String;i,p,d,A:Int16;procedure U(v:Int8);begin s:=Chr(v)+s;end;function O:Int8;begin if s=''then Exit(0);O:=Ord(s[1]);Delete(s,1,1)end;procedure E;begin i:=(p div X)+(d div X);p:=i*X+(p+d)mod X;i:=Ord(c[1+p])end;begin Assign(f,ParamStr(1));Reset(f);for A:=1to 26do begin ReadLn(f,s);c:=c+s+StringOfChar(' ',X-Length(s))end;d:=1;p:=-d;repeat E;A:=i;case i-32of1,63,92:A:=Ord(O=0);2:repeat E;U(i)until i=A;5,15,26,60:A:=O;31:i:=Ord('<>^v'[1+Random(4)]);71,80:A:=X*O+O+1;6:Read(A);94:Read(PChar(@A)^)end;if i=58then U(A);case i-32of 16..25:U(i-48);11:U(O+O);13:U(-O+O);10:U(O*O);15:U(O div A);5:U(O mod A);64:U(Ord(O<O));28,30:d:=i-61;62:d:=-X;86:d:=X;63:d:=2*A-1;92:d:=2*A*X-X;2,4:O;60:s:=Chr(O)+Chr(A)+s;14:Write(O,' ');12:Write(Chr(O));3:E;80:c[A]:=Chr(O);71:U(Ord(c[A]));32:Exit;1,6,26,94:U(A)end;until 0=1;end.

Here the indented and commented code :

{debug}uses Windows;{}
const
  X=80;
var
  // f is the source file
  f:TextFile;
  // c is the entire codebox (a 2-dimensional program)
  c,
  // s is the stack (kept as a string)
  s:String;
  // i is the current instruction read from the program
  i,
  // p is the position in the program
  p,
  // d is the delta for each step
  d,
  // A is a temporary variable (only uppercase var, to coincide with comments)
  A
  :Int16;

procedure U(v:Int8); // PUSH
begin
  // Push value onto the stack:
  s:=Chr(v)+s;
end;

function O:Int8; // POP
begin
  // Pop value from the stack :
  if s=''then Exit(0);
  O:=Ord(s[1]);
  Delete(s,1,1)
end;

procedure E; // STEP
begin
//{debug}Sleep(3);{}
  // Note : x-step needs to stay on same line, y-step needs to stay on same column
  i:=(p div X)+(d div X);
//  i:=i mod 25;// Enable this to wrap y-edge too
  p:=i*X+(p+d)mod X;
  i:=Ord(c[1+p])
end;

begin
  // Open file given at the command-line, and read & expand it's lines into our program buffer :
  Assign(f,ParamStr(1));
  Reset(f);
  for A:=1to 26do
  begin
    ReadLn(f,s);
    c:=c+s+StringOfChar(' ',X-Length(s))
    {debug};SetLength(c,A*X)
  end;
  // s:=''; Since we read 1 line too many above, s should always be empty now
  d:=1;
  p:=-d;
  repeat
    // Take a step (which gives a new 'i'nstruction) and make a copy of the stack :
    E;

    // Prevent begin+end pairs by handling instructions in 3 consecutive case blocks; This is applied to
    // all situations where this saves 1 or more characters, justifying the cost for another case-block.

    // Shorten '"' (>2) string-collecting, by remembering the quote character in A :
    A:=i;

    // Shorten a few cases by preparing variables so they can be shared with eachother and the 3rd case-block below :
    case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
      // Shorten '!' (>1), '_' (>63) and '|' (>92), by remembering Ord(O=0) in A :
      1,63,92:A:=Ord(O=0);
      // Shorten '"' string-collecting, by pushing the entire string here (the opening quote was remembered in A) :
      2:repeat E;U(i)until i=A; // Note :  We stop at the closing character, so the next block will still handle 'i'!
      // These instructions all need to Pop A, so write it just once here :
      5,15,26,60:A:=O;
      // Shorten '?' (>31): Choose a random direction instruction and let the 3rd case-block handle it :
      31:i:=Ord('<>^v'[1+Random(4)]);
      // Shorten 'g' (>71) and 'p' (>80): Calculate A so that the 3rd case-block doesn't need a begin+end pair :
      71,80:A:=X*O+O+1; // Note : This assumes Delphi evaluates leftmost call to O first!
      // Shorten '&' by reading a number from the input into A :
      6:Read(A);
      // Shorten '!' Prevent begin+end for input retrieval, by reading the input into A here :
      94:Read(PChar(@A)^) // Note : This case is last, because it ends on ')', which avoids a closing ';'
    end;

    // Shorten ':' (>58-32=26): Share implementation with '&' (>6) and '~' (>94) by pushing first copy of A (read above) here
    if i=58then U(A);

    // This 3rd case-block contains the final code for all statements :
    case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
      //'0'..'9': Push this number on the stack
      16..25:U(i-48);
      //'+': Addition: Pop A then B, push A+B
      11:U(O+O); // Note : A and B are inverted, but order is irrelevant here
      //'-': Subtraction: Pop A then B, push B-A
      13:U(-O+O); // Note : Delphi evaluates left-to-right, so we need to reverse the operation
      //'*': Multiplication: Pop a then b, push a*b
      10:U(O*O); // Note : A and B are inverted, but order is irrelevant here
      //'/': Integer division: Pop A then B, push B/A, rounded down. If A is 0, result is undefined
      15:U(O div A); // if A=0then U(0)else U(O mod A);
      //'%': Modulo: Pop A then B, push the remainder of the integer division of B/A. If a is 0, result is undefined
       5:U(O mod A); // if A=0then U(0)else U(O mod A);
      //'`': Greater than: Pop A then B, push 1 if B>A, otherwise 0.
      64:U(Ord(O<O)); // Note : Delphi evaluates left-to-right, so we need to reverse the test
      //'<': Start moving left
      //'>': Start moving right
      28,30:d:=i-61;
      //'^': Start moving up
      62:d:=-X;
      //'v': Start moving down
      86:d:=X;
      //'_': Pop a value; move right if value=0, left otherwise
      63:d:=2*A-1; // Note : A is already determined as Ord(O=0) in 1st case block
      //'|': Pop a value; move down if value=0, up otherwise
      92:d:=2*A*X-X; // Note : A is already determined as Ord(O=0) in 1st case block
      //'"': Start string mode: push each character's ASCII value all the way up to the next "
      //'$': Pop value from the stack
      2,4:O;
      //'\': Swap two values on top of the stack
      60:s:=Chr(O)+Chr(A)+s; // Note : A was Popped in 1st case block
      //'.': Pop value and output as an integer
      14:Write(O,' ');
      //',': Pop value and output as ASCII character
      12:Write(Chr(O));
      //'#': Trampoline: Skip next cell
      3:E;
      //'p': A "put" call (a way to store a value for later use). Pop y then x then v, change the character at the position (x,y) in the program to the character with ASCII value v
      80:c[A]:=Chr(O); // Note : A was Popped in 1st and 2nd case block, calculating y*width+x
      //'g': A "get" call (a way to retrieve data in storage). Pop y then x, push ASCII value of the character at that position in the program
      71:U(Ord(c[A])); // Note : A was Popped in 1st and 2nd case block, calculating y*width+x
      //'@': Rotates the top 3 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,4,2,3)
      32:Exit;
      //'!': Logical NOT: Pop a value. If the value is 0, push 1; otherwise, push 0.
      //'&':  Input a number from stdin and push its value
      //':': Duplicate value on top of the stack
      //'~':  Input a single character from stdin and push its ASCII value
      1,      // Note for '!' : A is already determined as Ord(O=0) in 1st case block
      6,
      26,     // Note for ':' : First A was already pushed once above
      94:U(A) // Note for '~' : Read() into A was done in 1st case block
    end;
  until 0=1;
end.

Output from compat.bf :

OOB get returns 0
Cells are unsigned 8 bit
Edge jumps work
Negative remainders work
@ in stringmode works

Output from b93 :

` works
: works
0-9 probably work
$ works
Westwards edge jump arrives at 79
0! is 1
5! is 0

Edit history:

(970-64=906) : Reimplemented movement, using 2 instead of 4 variables

(906-9=897) : Moved more calculations into 1st and 2nd case-blocks

(897-11=886) : Skip intermediate variable for all double-pop instructions

(886-6=880) : Read 1 input line extra to clear 's'tack

(880-14=866) : Simplified '?' by changing it into one of the 4 direction-instructions

(866-8=858) : Removed one case block

(858-13=845) : Fixed edge-jump, simplifying direction handling. Use 8 bit stack.

(845-3=842) : Combined left-right direction instruction into a single expression

PatrickvL

Posted 2011-02-07T01:12:58.507

Reputation: 641

Here's the fpc version, ready to run online : http://ideone.com/Pg259 (I did have to add a Delphi-compatibility line, and because ideone.com doesn't support file-uploads, I changed ReadLn into using stdin.)

– PatrickvL – 2011-03-19T22:41:01.930

2

16bit MSDOS .COM File - 1104 bytes

This is Base64 encoded (decoder here), save decoded file as a .com and execute from command line with name of program file to run as the only argument. Tested in WinXP command prompt.

yEAAADP/jNiAxBCJRv6JRvKAxBCJfuqJRuyJfvqJfviJfvSAxBCJRvbHRuiMAo7AM8C5AIDzq7Qs
zSGJVvC6RgWKHoAAMv+A6wF9Cei3ALQJzSHJw8aHggAAuAA9uoIAzSG6SAVy5YvYjkb+uQCAM8Dz
q7kBALpQBbQ/zSG6SgVyygvAdCWgUAU8CnQHPCBy4qrr34vHOkb5cgOIRvn+RviB5wD/gccAAevI
tD7NIQv/ukwFdJa4AwDNEDPb6FQAtAfNITxxdDk8cnQhPDF0DTwydBE8c3Xo6I8A6+CLRvaJRvLr
2ItG/olG8uvQi0b2iUby6B4A6HEAgH76AHTu67zoAgDJw7gAuI7AuCAHuQCA86vDYB6OXvK4ALiO
wLUZM/8z9rQHsVCsq/7JdfqBxrAA/s118FOLRvI7Rv6yz3QFi170svCA+1BzG4D/GXMWise0oPbk
ANiA1AAA2IDUAIv4R4rCqlsfYcOORv4migc8MHJVPDl3UbQALDDoKwD/ZugK23UDil75/svD/sM6
Xvl1+DLbwwr/dQOKfvj+z8P+xzp++HX4Mv/DBsR+6quJfuoHwwbEfuozwAv/dAmD7wImiwWJfuoH
w77uBIPGA4A8/3QOOAR19ItEAQvAdAP/4MO6TgXpZP7olP8migc8InSNtADos//r7+i4/4nB67To
9v8Dwel0/+ju/yvB6Wz/6Ob/9+npZP/o3v+Z9/npW//o1f+Z9/mLwulQ/+iF/wvAuAEAdAFI6UL/
6Lz/O8G4AQB/AUjpNP/HRuiMAukv/+hh/wvAdPHHRuiCAukg/+hS/wvAdAjHRuiWAukR/8dG6KAC
6Qn/i0bwuk189+IFGTaJRvAkBgWSA4vwrYlG6Ont/pYCoAKCAowC6Bf/6Ar/6dn+6FP/kegA/4nI
6c3+6AL/6cr+6Pz+C8B5CffYULAt6CYAWFO7UAUz0rkKAPfxgMIwiBdDC8B170uKB+gKAIH7UAV1
9Fvplf48CnQUBsR+9KqLxzxQdQSBx7AAiX70B8PGRvQA/kb1w+in/uja/+ls/uhp/ulm/ugOAOiV
/gaORv4miAQH6VX+6If+ik74C8B5BwLBgNQA6/X28YjhtQDocP5Rik75C8B5BwLBgNQA6/X28Yjg
WYjMi/DD6Mr/Bo5G/iaKBAe0AOkP/v928otG9olG8jP2Msnol/20B80hPC11CwrJdfH+wehc/+vq
PA11Do9G8ovGCsl0AvfY6dr9iMUsMDwJd9C0AFCwCvfmC9JadcT2xIB1vwHC9saAdbiJ1ojo6CH/
66//dvKLRvaJRvLoPf20B80hPCBy+FDoB/9YtACPRvLpkP3GRvoBwysAAy0IAyoQAy8YAyUhAyEs
A2A6Az5IAzxXA15mA3ZuAz92A19QA3xfAyLoAjqaA1yjAySvAy61AywKBCMTBHAZBGddBCZtBH7L
BEDsBCB/AgB/Av8xJDIkMyQ0JDUk

On startup, the display shows the program. Commands are:

  • r - runs the program (switches to output screen)
  • s - single steps the program
  • q - quits the interpreter
  • 1 - shows output screen (white cursor is current output position)
  • 2 - shows program screen (red cursors is current program position)

When an input command is executed, the display switches to the output screen. Input is echoed to the output screen. For ascii input, only characters in the range 32-255 are accepted. For numeric input, only values in the range -32768 to 32767 are allowed, press enter to complete input (sorry, no backspace).

I really should add a stack screen as well.

Update

Here's the original assembly source code, assembled using A86. It's quite long:

  enter 64,0
  xor di,di
  mov ax,ds
  add ah,10h
  mov [bp-2],ax   ; program
  mov [bp-14],ax  ; current display
  add ah,10h
  mov w[bp-22],di ; stack off 
  mov [bp-20],ax  ; stack seg
  mov w[bp-6],di  ; exit status
  mov w[bp-8],di  ; size of field -8=lines,-7=columns
  mov w[bp-12],di ; output window position
  add ah,10h
  mov w[bp-10],ax; output segment
  mov w[bp-24],MoveRight

  ; clear output
  mov es,ax
  xor ax,ax
  mov cx,8000h
  rep stosw

  ; random seed
  mov ah,2ch
  int 21h
  mov w[bp-16],dx

  ; get filename
  mov dx,StrNoFile
  mov bl,[80h]
  xor bh,bh
  sub bl,1
  jge NoError

Error:
  call ClearScreen
  mov ah,9
  int 21h
  leave
  ret

NoError:  
  ; open file
  mov b[82h+bx],0
  mov ax,3d00h
  mov dx,82h
  int 21h
  mov dx,StrBadFile
  jc Error
  mov bx,ax
  ; clear program
  mov es,[bp-2]
  mov cx,8000h
  xor ax,ax
  rep stosw
  ; read file
ReadLoop:
  mov cx,1
  mov dx,EOP
  mov ah,3fh
  int 21h
  mov dx,StrBadRead
  jc Error
  or ax,ax
  jz EOF
  mov al,b[EOP]
  cmp al,10
  je EOL
  cmp al,32
  jb ReadLoop
  stosb
  jmp ReadLoop
EOL:
  mov ax,di
  cmp al,[bp-7]
  jb l9
  mov [bp-7],al
l9:
  inc b[bp-8]
  and di,0ff00h  
  add di,100h
  jmp ReadLoop
EOF:
  mov ah,3eh
  int 21h
  or di,di
  mov dx,StrEmptyFile
  jz Error
  ; initialise
  mov ax,3
  int 10h
  xor bx,bx ; PC
  ; execute
Redraw:  
  call DisplayProgram
WaitForInput:  
  mov ah,7
  int 21h
  cmp al,'q'
  je Quit
  cmp al,'r'
  je DoRun
  cmp al,'1'
  je ShowIO
  cmp al,'2'
  je ShowProgram
  cmp al,'s'
  jne WaitForInput
  ; single step
  call Execute
  jmp Redraw

ShowIO:
  mov ax,[bp-10]
  mov [bp-14],ax
  jmp Redraw  

ShowProgram:
  mov ax,[bp-2]
  mov [bp-14],ax
  jmp Redraw

DoRun:
  mov ax,[bp-10]
  mov [bp-14],ax
  call DisplayProgram
  call Execute
  cmp b[bp-6],0
  je DoRun
  jmp Redraw

Quit:
  call ClearScreen
  leave
  ret

ClearScreen:
  mov ax,0b800h
  mov es,ax
  mov ax,720h  
  mov cx,8000h
  rep stosw
  ret

DisplayProgram:
  pusha
  push ds
  mov ds,[bp-14]
  mov ax,0b800h
  mov es,ax
  mov ch,25
  xor di,di
  xor si,si
  mov ah,7
l1:
  mov cl,80
l2:
  lodsb
  stosw
  dec cl
  jnz l2
  add si,256-80
  dec ch
  jnz l1
  push bx
  mov ax,[bp-14]
  cmp ax,[bp-2]
  mov dl,0cfh
  je l33
  mov bx,[bp-12]
  mov dl,0f0h
l33:  
  cmp bl,80
  jae l3
  cmp bh,25
  jae l3
  mov al,bh
  mov ah,160
  mul ah
  add al,bl
  adc ah,0
  add al,bl
  adc ah,0
  mov di,ax
  inc di
  mov al,dl
  stosb
l3:  
  pop bx
  pop ds
  popa
  ret

Execute:
  mov es,[bp-2]
  mov al,es:[bx]

  cmp al,'0'
  jb NotPush
  cmp al,'9'
  ja NotPush

  ; push number
  mov ah,0
  sub al,'0'
PushValueUpdatePC:
  call PushValue
UpdatePC:
  jmp [bp-24]

MoveLeft:
  or bl,bl
  jnz MoveLeftNoWrap
  mov bl,[bp-7]
MoveLeftNoWrap:
  dec bl
  ret

MoveRight:
  inc bl
  cmp bl,[bp-7]
  jne ret
  xor bl,bl
  ret

MoveUp:
  or bh,bh
  jnz MoveUpNoWrap
  mov bh,[bp-8]
MoveUpNoWrap:
  dec bh
  ret

MoveDown:
  inc bh
  cmp bh,[bp-8]
  jne ret
  xor bh,bh
  ret

PushValue:
  push es
  les di,[bp-22]
  stosw
  mov [bp-22],di
  pop es
  ret

PopValue:
  push es
  les di,[bp-22]
  xor ax,ax
  or di,di
  jz PopValueZero
  sub di,2
  mov ax,es:[di]
  mov [bp-22],di
PopValueZero:
  pop es
  ret

NotPush:
  mov si,Functions-3
NextFunction:
  add si,3  
FindFunction:
  cmp b[si],255
  je Endsearch
  cmp b[si],al
  jne NextFunction
  mov ax,[si+1]
  or ax,ax
  je EndSearch
  jmp ax
  ret

EndSearch:
  mov dx,StrEndSearch
  jmp Error  

DoStringMode:
  call UpdatePC  
  mov al,es:[bx]
  cmp al,'"'
  je UpdatePC
  mov ah,0
  call PushValue
  jmp DoStringMode

PopTwoValues:
  call PopValue
  mov cx,ax
  jmp PopValue

DoAdd:
  call PopTwoValues
  add ax,cx
  jmp PushValueUpdatePC

DoSub:
  call PopTwoValues
  sub ax,cx
  jmp PushValueUpdatePC  

DoMultiply:
  call PopTwoValues
  imul cx
  jmp PushValueUpdatePC

DoDivide:
  call PopTwoValues
  cwd
  idiv cx
  jmp PushValueUpdatePC

DoModulo:
  call PopTwoValues
  cwd
  idiv cx
  mov ax,dx
  jmp PushValueUpdatePC

DoNot:
  call PopValue
  or ax,ax
  mov ax,1
  jz DoNotZero
  dec ax
DoNotZero:  
  jmp PushValueUpdatePC

DoGreaterThan:
  call PopTwoValues
  cmp ax,cx
  mov ax,1
  jg DoGreaterThanIs1
  dec ax
DoGreaterThanIs1:
  jmp PushValueUpdatePC  

DoMoveRight:
  mov [bp-24],MoveRight
  jmp UpdatePC

DoLeftRight:
  call PopValue
  or ax,ax
  jz DoMoveRight

DoMoveLeft:
  mov [bp-24],MoveLeft
  jmp UpdatePC

DoMoveUpDown:  
  call PopValue
  or ax,ax
  jz DoMoveDown

DoMoveUp:
  mov [bp-24],MoveUp
  jmp UpdatePC

DoMoveDown:
  mov [bp-24],MoveDown
  jmp UpdatePC

DoRandomDirection:
  mov ax,[bp-16]
  mov dx,31821
  mul dx
  add ax,13849
  mov [bp-16],ax
  and al,6
  add ax,Movements
  mov si,ax
  lodsw
  mov [bp-24],ax
  jmp UpdatePC    

Movements:
  dw MoveUp, MoveDown, MoveLeft, MoveRight  

DoDuplicate:
  call PopValue
  call PushValue
  jmp PushValueUpdatePC  

DoSwap:
  call PopTwoValues
  xchg ax,cx
  call PushValue
  mov ax,cx
  jmp PushValueUpdatePC  

DoPop:
  call PopValue
  jmp UpdatePC

DoPopPrint:
  call PopValue
  or ax,ax
  jns Positive
  neg ax
  push ax
  mov al,'-'
  call PrintChar
  pop ax  
Positive:  
  push bx
  mov bx,EOP
DivLoop:  
  xor dx,dx
  mov cx,10
  div cx
  add dl,'0'
  mov [bx],dl
  inc bx
  or ax,ax
  jnz DivLoop
PrintLoop:  
  dec bx
  mov al,[bx]
  call PrintChar
  cmp bx,EOP
  jne PrintLoop
  pop bx
  jmp UpdatePC

PrintChar:
  cmp al,10
  je AsciiCR
  push es
  les di,[bp-12]
  stosb
  mov ax,di
  cmp al,80
  jne NoLF
  add di,256-80
NoLF:
  mov [bp-12],di
  pop es
  ret
AsciiCR:
  mov b[bp-12],0
  inc b[bp-11]
  ret

DoPopAsciiPrint:  
  call PopValue
  call PrintChar
  jmp UpdatePC

DoTrampoline:
  call UpdatePC
  jmp UpdatePC

DoPut:
  call GetCoord
  call PopValue
  push es
  mov es,[bp-2]
  mov es:[si],al
  pop es
  jmp UpdatePC

GetCoord:
  call PopValue
  mov cl,[bp-8]
DoGet1:  
  or ax,ax
  jns DecrementY
  add al,cl
  adc ah,0
  jmp DoGet1
DecrementY:
  div cl
  mov cl,ah
  mov ch,0
  call PopValue ; x
  push cx
  mov cl,[bp-7]
DoGet2:  
  or ax,ax
  jns DecrementX
  add al,cl
  adc ah,0
  jmp DoGet2
DecrementX:
  div cl
  mov al,ah
  pop cx ; ax=x, cx=y
  mov ah,cl
  mov si,ax
  ret

DoGet:
  call GetCoord
  push es
  mov es,[bp-2]
  mov al,es:[si]
  pop es
  mov ah,0
  jmp PushValueUpdatePC

DoInput:
  push [bp-14]
  mov ax,[bp-10]
  mov [bp-14],ax
  xor si,si
  xor cl,cl
DoInput1:
  call DisplayProgram
  mov ah,7
  int 21h
  cmp al,'-'
  jne DoInputEnter
  or cl,cl
  jnz DoInput1
  inc cl
  call PrintChar
  jmp DoInput1

DoInputEnter:
  cmp al,13
  jnz DoInputDigit

  pop [bp-14]
  mov ax,si
  or cl,cl
  jz DoInput3
  neg ax
DoInput3:  
  jmp PushValueUpdatePC

DoInputDigit:
  mov ch,al
  sub al,'0'
  cmp al,9
  ja DoInput1
  mov ah,0
  push ax
  mov al,10
  mul si
  or dx,dx
  pop dx
  jnz DoInput1
  test ah,80h
  jnz DoInput1
  add dx,ax
  test dh,80h
  jnz DoInput1  
  mov si,dx
  mov al,ch
  call PrintChar
  jmp DoInput1  

DoInputAscii:
  push [bp-14]
  mov ax,[bp-10]
  mov [bp-14],ax
  call DisplayProgram
DoInputAscii1:
  mov ah,7
  int 21h
  cmp al,32
  jb DoInputAscii1
  push ax
  call PrintChar
  pop ax
  mov ah,0
  pop [bp-14]
  jmp PushValueUpdatePC

DoExit:
  mov b[bp-6],1
  ret  

Functions:
  db '+' ; Addition: Pop a then b, push a+b
  dw DoAdd
  db '-' ; Subtraction: Pop a then b, push b-a
  dw DoSub
  db '*' ; Multiplication: Pop a then b, push a*b
  dw DoMultiply
  db '/' ; Integer division: Pop a then b, push b/a, rounded down. If a is 0, result is undefined
  dw DoDivide
  db '%' ; Modulo: Pop a then b, push the remainder of the integer division of b/a. If a is 0, result is undefined
  dw DoModulo
  db '!' ; Logical NOT: Pop a value. If the value is 0, push 1; otherwise, push 0.
  dw DoNot
  db '`' ; Greater than: Pop a then b, push 1 if b>a, otherwise 0.
  dw DoGreaterThan
  db '>' ; Start moving right
  dw DoMoveRight
  db '<' ; Start moving left
  dw DoMoveLeft
  db '^' ; Start moving up
  dw DoMoveUp
  db 'v' ; Start moving down
  dw DoMoveDown
  db '?' ; Start moving in a random cardinal direction
  dw DoRandomDirection
  db '_' ; Pop a value; move right if value=0, left otherwise
  dw DoLeftRight
  db '|' ; Pop a value; move down if value=0, up otherwise
  dw DoMoveUpDown
  db '"' ; Start string mode: push each character's ASCII value all the way up to the next "
  dw DoStringMode
  db ':' ; Duplicate value on top of the stack
  dw DoDuplicate
  db '\' ; Swap two values on top of the stack
  dw DoSwap
  db '$' ; Pop value from the stack
  dw DoPop
  db '.' ; Pop value and output as an integer
  dw DoPopPrint
  db ',' ; Pop value and output as ASCII character
  dw DoPopAsciiPrint
  db '#' ; Trampoline: Skip next cell
  dw DoTrampoline
  db 'p' ; A "put" call (a way to store a value for later use). Pop y then x then v, change the character at the position (x,y) in the program to the character with ASCII value v
  dw DoPut
  db 'g' ; A "get" call (a way to retrieve data in storage). Pop y then x, push ASCII value of the character at that position in the program
  dw DoGet
  db '&' ; Input an integer (may be multiple characters and may be negative) and push it
  dw DoInput
  db '~' ; Input a single character from stdin and push its ASCII value
  dw DoInputAscii
  db '@' ; End program
  dw DoExit
  db ' ' ; NOP
  dw UpdatePC
  db 0 ; NOP
  dw UpdatePC
  db 255

StrNoFile:
  db "1$";"No File$"
StrBadFile:
  db "2$";"Bad File$"
StrBadRead:
  db "3$";"Bad Read$"
StrEmptyFile:
  db "4$";"Empty File$"
StrEndSearch:
  db "5$";"Bad Instruction$"
EOP:

Skizz

Posted 2011-02-07T01:12:58.507

Reputation: 2 225

Would you mind adding the assembly for this? – FUZxxl – 2011-03-14T19:52:46.890

@FUZxxl: I've added the original source code. – Skizz – 2011-03-15T10:12:40.663