| Bytes | Lang | Time | Link |
|---|---|---|---|
| 734 | C gcc | 210309T081712Z | ceilingc |
| 323 | Befunge93 | 210225T053413Z | quintopi |
| 842 | Delphi | 110318T074437Z | Patrickv |
| 1104 | 16bit MSDOS .COM File | 110209T171223Z | Skizz |
| 515 | Perl | 110207T164724Z | J B |
C (gcc), 853 815 801 787 770 748 735 745 734 bytes
#define z(a,b);a(){b;}
#define Y*s
#define Z*s--
S[1<<20],Y=S,x,y,m,r,c=-1,t,n=80;char M[2000]z(b,Y=!Y)z(G,m=1)z(k,x&1?r-=x-2:(c-=x-1))z(H,Z)z(E,Y%=Z)z(K,scanf("%d",++s))z(B,Y*=Z)z(A,Y+=Z)z(i,putchar(Z))z(a,Y-=Z)z(I,printf("%d ",Z))z(d,Y/=Z)z(g,Y=Y++)z(L,x=2)z(R,x=0)z(w,Y++^=Z^=Y++^=Z)z(U,x=3)z(h,Z?L():R())z(e,Y=Z<Y)z(J,Y=M[Z*n+Y])z(j,M[Z*n+Z]=s[-2];Z)z(D,x=1)z(v,Z?U():D())z(l,*++s=getchar())F();(*f[])()={[33]=b,G,k,H,E,K,[42]=B,A,i,a,I,d,[58]=g,0,L,0,R,F,[92]=w,0,U,h,e,['g']=J,['p']=j,['v']=D,['|']=v,0,l}z(F,f["><^v"[rand()&3]]())main(C,V)int**V;{for(t=open(V[!!memset(M,32,2e3)]);read(t,&C,1);)C-10?M[y*n+x++]=C:(x=!++y);for(R();m|t-64;m?t-34?*++s=t:(m=0):t-48<10u?*++s=t-48:f[t]&&f[t]())k(),t=M[(r=(r+25)%25)*n+(c=(c+n)%n)];}
The program is loaded into an array and the interpreter enters the main loop; the byte at the current program counter is the offset of an array of function pointers, each function performs the operation required by that instruction. String mode and numeric literals are special cases that are handled differently.
Slightly golfed less
#define z(a,b);a(){b;}
#define Y*s
#define Z*s--
S[1<<20],Y=S,x,y,m,r,c=-1,t;
char M[2000]
z(b,Y=!Y) /* ! */
z(G,m=1) /* string mode */
z(k,x&1?r-=x-2:(c-=x-1)) /* # */
z(H,Z) /* $ */
z(E,Y%=Z) /* % */
z(K,scanf("%d",++s)) /* & */
z(B,Y*=Z) /* * */
z(A,Y+=Z) /* + */
z(i,putchar(Z)) /* , */
z(a,Y-=Z) /* - */
z(I,printf("%d ",Z)) /* . */
z(d,Y/=Z) /* / */
z(g,Y=Y++) /* : */
z(L,x=2) /* < */
z(R,x=0) /* > */
z(w,Y++^=Z^=Y++^=Z) /* \ */
z(U,x=3) /* ^ */
z(h,Z?L():R()) /* _ */
z(e,Y=Z<Y) /*\` */
z(J,Y=M[Z*80+Y]) /* g */
z(j,M[Z*80+Z]=s[-2];Z) /* p */
z(D,x=1) /* v */
z(v,Z?U():D()) /* | */
z(l,*++s=getchar()) /* ~ */
F(); /* ? */
(*f[])()={[33]=b,G,k,H,E,K,
[42]=B,A,i,a,I,d,
[58]=g,0,L,0,R,F,
[92]=w,0,U,h,e,
['g']=J,['p']=j,
['v']=D,['|']=v,0,l}
z(F,f["><^v"[rand()&3]]()) /* ? */
main(C,V)int**V;{
/* load */
for(t=open(V[1],!memset(M,32,2000));read(t,&C,1);)
C-10?M[y*80+x++]=C:(x=!++y);
/* execute */
for(R();m|t-64;m?t-34?*++s=t:(m=0):t>47&t<58?*++s=t-48:f[t]&&f[t]())
k(),
t=M[(r=(r+25)%25)*80+(c=(c+80)%80)];
}
Edit: Improved test coverage and fixed bugs. Test suite largely lifted from esolang-park
Befunge-93 - 404 371 361 352 339 337 323 bytes
<xyXYvp01<>110vv5_v#`0+1:_v#+!-"g"\<v"<":::<>1v#p03-1_>! g20gp00g1+0v25p
v2g02 < p0 20p<+vp020p01-10$_:"p"-!^>>-!\ v^ <>0p20pv|!*-";"\+1::~p0<
v2-10<^v# ^#< <<$< < ^+!-"_"\+!-"?"<>#^_10v4p<:^00 _$20g1+20p^
v21p010>#<40g20v>\%:40p5+g:92p:75*1--00g!\#^_\$0 v >91+-^
<3+g01g 03p04+g<^++g04g02:*54p03:%\++g03g01:"P"p0<
Input program must have and modify at most 20 lines. Input can be provided in same file as Befunge program by placing it after a ; character. Yes, it can interpret itself, but the *54 in the bottom line should be replaced by *53 if you do that. And if you ask that interpreted interpreter to interpret itself, change it to *52 etc. If run in a Befunge-97 interpreter, it will also support the a-f commands (but not ' or any new command that affects control flow or wrapping behavior).
Note that it basically asks the interpreter it runs in to handle all the stuff relating to I/O and stack, so its specific behavior is largely dependent on that of the interpreter running it. In other words, it is perfectly compliant if run in a compliant interpreter.
It works by reading in the program from input (until EOF or semicolon) directly into the playfield below it, then simulating the movement of a virtual instruction pointer through that program. It copies each command from the program into its own execution area (at position (9,2) on the grid) and runs its own instruction pointer through it after ensuring all of its own data has been removed from the stack (as all of the interpreted program's stack data is maintained at the bottom of the stack). This is the standard methodology for Befunge self-interpretation since the early 00s, but I don't think it has ever been done in such a small program.
A fuller explanation is in the annotations you can see by clicking the link above.
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
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:
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.