Subleq: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
(Added Quackery.) |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
| (20 intermediate revisions by 8 users not shown) | |||
Line 17:
:# Let '''A''' be the value in the memory location identified by the instruction pointer; let '''B''' and '''C''' be the values stored in the next two consecutive addresses in memory.
:# Advance the instruction pointer three words, to point at the address ''after'' the address containing '''C'''.
:# If '''A''' is
:# If '''B''' is
:# Otherwise, both '''A''' and '''B''' are treated as addresses.
:# If the instruction pointer becomes negative, execution halts.
Line 33:
<pre>start:
0f 11 ff subleq (zero), (message), -1 ; subtract 0 from next character value to print;
; terminate if it's <=0
10
0f 0f 00 subleq (zero), (zero), start ; if 0-0 <= 0 (i.e. always) goto start
; useful constants
zero:
Line 1,109 ⟶ 1,111:
$ ./subleq hello.sub
Hello, world!</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">run: function [prog][
mem: new prog
ip: 0
while [ip >= 0][
A: mem\[ip]
B: mem\[ip+1]
C: mem\[ip+2]
ip: ip + 3
if? A = neg 1 -> mem\[B]: to :integer first input ""
else [
if? B = neg 1 -> prints to :char mem\[A]
else [
mem\[B]: mem\[B] - mem\[A]
if mem\[B] =< 0 -> ip: C
]
]
]
]
test: @[15, 17, neg 1, 17, neg 1, neg 1, 16, 1, neg 1, 16, 3, neg 1, 15, 15, 0, 0, neg 1,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0]
run test</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|AWK}}==
Line 1,166 ⟶ 1,200:
=={{header|BASIC}}==
{{works with|GW-BASIC}}
{{works with|QBasic}}
<syntaxhighlight lang="basic">10 DEFINT A-Z: DIM M(8192)
20 INPUT "Filename";F$
30 OPEN "I",1,F$
Line 1,188 ⟶ 1,224:
<pre>Filename? HELLO.SUB
Hello, world!</pre>
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
input "SUBLEQ> ", codigo
while instr(codigo, " ")
memoria[contador] = int(left(codigo, instr(codigo, " ") - 1))
codigo = mid(codigo, instr(codigo, " ") + 1, length(codigo))
contador += 1
end while
memoria[contador] = int(codigo)
contador = 0
do
a = memoria[contador]
b = memoria[contador + 1]
c = memoria[contador + 2]
contador += 3
if a = -1 then
input "SUBLEQ> ", caracter
memoria[b] = asc(caracter)
else
if b = -1 then
print chr(memoria[a]);
else
memoria[b] -= memoria[a]
if memoria[b] <= 0 then contador = c
end if
end if
until contador < 0</syntaxhighlight>
==={{header|FreeBASIC}}===
<syntaxhighlight lang="vbnet">
Dim As Integer memoria(255), contador = 0
Dim As String codigo, caracter
Input "SUBLEQ> ", codigo
While Instr(codigo, " ")
memoria(contador) = Val(Left(codigo, Instr(codigo, " ") - 1))
codigo = Mid(codigo, Instr(codigo, " ") + 1)
contador += 1
Wend
memoria(contador) = Val(codigo)
contador = 0
Do
Dim As Integer a = memoria(contador)
Dim As Integer b = memoria(contador + 1)
Dim As Integer c = memoria(contador + 2)
contador += 3
If a = -1 Then
Input "SUBLEQ> ", caracter
memoria(b) = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria(a));
Else
memoria(b) -= memoria(a)
If memoria(b) <= 0 Then contador = c
End If
End If
Loop Until contador < 0
Sleep</syntaxhighlight>
{{out}}
<pre>SUBLEQ> 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!</pre>
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">Public memoria[255] As Integer
Public Sub Main()
Dim contador As Integer = 0
Dim codigo As String, caracter As String
Print "SUBLEQ> ";
Input codigo
While InStr(codigo, " ")
memoria[contador] = Val(Left(codigo, InStr(codigo, " ") - 1))
codigo = Mid(codigo, InStr(codigo, " ") + 1)
contador += 1
Wend
memoria[contador] = Val(codigo)
contador = 0
Do
Dim a As Integer = memoria[contador]
Dim b As Integer = memoria[contador + 1]
Dim c As Integer = memoria[contador + 2]
contador += 3
If a = -1 Then
Print "SUBLEQ> ";
Input caracter
memoria[b] = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria[a]);
Else
memoria[b] -= memoria[a]
If memoria[b] <= 0 Then contador = c
End If
End If
Loop Until contador < 0
End</syntaxhighlight>
==={{header|GW-BASIC}}===
The [[#BASIC|BASIC]] solution works without any changes.
==={{header|QBasic}}===
The [[#BASIC|BASIC]] solution works without any changes.
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
input "SUBLEQ> " codigo$
while instr(codigo$, " ")
memoria(contador) = val(left$(codigo$, instr(codigo$, " ") - 1))
codigo$ = mid$(codigo$,instr(codigo$," ")+1,len(codigo$))
contador = contador + 1
wend
memoria(contador) = val(codigo$)
contador = 0
repeat
a = memoria(contador)
b = memoria(contador+ 1)
c = memoria(contador+ 2)
contador = contador + 3
if a = -1 then
input "SUBLEQ> " caracter$
memoria(b) = asc(caracter$)
else
if b = -1 then
print chr$(memoria(a));
else
memoria(b) = memoria(b) - memoria(a)
if memoria(b) <= 0 contador = c
fi
fi
until contador < 0
end</syntaxhighlight>
=={{header|BBC BASIC}}==
Line 1,710 ⟶ 1,895:
HALTED AFTER 0073 INSTRUCTIONS.</pre>
=={{header|Commodore BASIC}}==
The sample program is the one from the task description with a slightly different text string: it starts with the control code to convert to mixed-case mode (14), and the rest
is in PETSCII rather than standard ASCII.
<syntaxhighlight lang="basic">100 READ N:REM SIZE OF PROGRAM
110 DIM M%(N-1)
120 FOR I=1 TO N
130 : READ M%(I-1)
140 NEXT I
150 IP=0
160 FOR D=0 TO 1 STEP 0
170 : IF IP < 0 OR IP > N-3 THEN D=1:GOTO 290
180 : A=M%(IP):B=M%(IP+1):C=M%(IP+2)
190 : IP=IP+3
200 : IF A >= 0 THEN 240
210 : GET K$: IF K$="" THEN 210
220 : M%(B) = ASC(K$)
230 : GOTO 290
240 : IF B >= 0 THEN 270
250 : PRINT CHR$(M%(A));
260 : GOTO 290
270 : M%(B)=M%(B)-M%(A)
280 : IF M%(B) <= 0 THEN IP=C
290 NEXT D
300 END
310 DATA 33
320 DATA 15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1
330 DATA 14, 200, 69, 76, 76, 79, 44, 32, 87, 79, 82, 76, 68, 33, 13, 0</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
=={{header|Common Lisp}}==
Line 1,890 ⟶ 2,107:
A>subleq hello.sub
Hello, world!</pre>
=={{header|EasyLang}}==
{{trans|FreeBASIC}}
<syntaxhighlight>
global inpos inp$ .
func inp .
if inpos = 0
inp$ = input
if error = 1
return 255
.
inpos = 1
.
if inpos <= len inp$
h = strcode substr inp$ inpos 1
inpos += 1
return h
.
inpos = 0
return 10
.
proc subleq . mem[] .
repeat
a = mem[p]
b = mem[p + 1]
c = mem[p + 2]
p += 3
if a = -1
mem[b] = inp
elif b = -1
write strchar mem[a]
else
mem[b] -= mem[a]
if mem[b] <= 0
p = c
.
.
until p < 0
.
.
prog[] = [ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ]
arrbase prog[] 0
#
subleq prog[]
#
input_data
dummy data
</syntaxhighlight>
=={{header|Forth}}==
Line 1,955 ⟶ 2,221:
</pre>
And the linefeed (character(10)) had been sent forth, but is not apparent because it just ended the line.
=={{header|Go}}==
Line 2,983 ⟶ 3,207:
dip rot join unrot ] is putch ( O I S --> O I S )
[ $ "" unrot
0 ip replace
[ dup ip share
2dup peek a replace
Line 2,993 ⟶ 3,218:
dup b share peek
over a share peek -
tuck dip [ b share poke ]
1 < until
c share dup ip replace
2drop ] is subleq ( I S --> O )
Line 3,137 ⟶ 3,360:
<pre>
Hello, world!
</pre>
=={{header|RPL}}==
{{works with|HP|48G}}
« 'Ram' DUP ROT ←ptr + GET 1 + GET
» '<span style="color:blue">PEEKind</span>' STO <span style="color:grey">@ ''( n → Ram[Ram[←ptr + n]] )''</span>
« 0 "" → ←ptr stdout
« { } + RDM 'Ram' STO
'''WHILE''' ←ptr 0 ≥ '''REPEAT'''
'''CASE'''
'Ram' ←ptr 1 + GET -1 == '''THEN'''
'Ram' 2 <span style="color:blue">PEEKind</span> '''DO UNTIL''' KEY '''END''' PUT '''END'''
'Ram' ←ptr 2 + GET -1 == '''THEN'''
'stdout' 1 <span style="color:blue">PEEKind</span> CHR STO+ '''END'''
2 <span style="color:blue">PEEKind</span> 1 <span style="color:blue">PEEKind</span> -
'Ram' DUP ←ptr 2 + GET 1 + 3 PICK PUT
0 ≤ '''THEN'''
1 SF '''END'''
1 CF
'''END'''
'''IF''' 1 FS? '''THEN'''
'Ram' ←ptr 3 + GET '←ptr' STO
'''ELSE'''
3 '←ptr' STO+
'''END'''
'''END'''
stdout
» » '<span style="color:blue">SUBLEQ</span>' STO <span style="color:grey">@ ''( [ program ] mem_size → stdout ] )''</span>
[ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ] 256 <span style="color:blue">SUBLEQ</span>
{{out}}
<pre>
1: "Hello, world!
"
</pre>
Line 3,211 ⟶ 3,469:
}</syntaxhighlight>
{{Out}}See it running in your browser by [https://scastie.scala-lang.org/f4MszRqZR5qtxI6YwarJhw Scastie (JVM)].
=={{header|SETL}}==
<syntaxhighlight lang="setl">program subleq;
if command_line(1) = om then
print("error: no file given");
stop;
end if;
mem := readprog(command_line(1));
loop init ip := 0; while ip >= 0 do
a := mem(ip) ? 0;
b := mem(ip+1) ? 0;
c := mem(ip+2) ? 0;
ip +:= 3;
if a = -1 then
mem(b) := ichar (getchar ? "\0");
elseif b = -1 then
putchar(char ((mem(a) ? 0) mod 256));
elseif (mem(b) +:= -(mem(a) ? 0)) <= 0 then
ip := c;
end if;
end loop;
proc readprog(fname);
if (f := open(fname, "r")) = om then
print("error: cannot open file");
stop;
end if;
mem := {};
mp := 0;
loop doing getb(f, n); while n/=om do
mem(mp) := n;
mp +:= 1;
end loop;
close(f);
return mem;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ cat hello.sub
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
$ setl subleq.setl hello.sub
Hello, world!</pre>
=={{header|Sidef}}==
Line 3,278 ⟶ 3,581:
{{out}}
<pre>HELLO, WORLD.</pre>
=={{header|SNOBOL4}}==
All "addresses" get 1 added to them before being used as array indexes.
<syntaxhighlight lang="snobol"> MEM = ARRAY('32')
MEM<1> = 15
MEM<2> = 17
MEM<3> = -1
MEM<4> = 17
MEM<5> = -1
MEM<6> = -1
MEM<7> = 16
MEM<8> = 1
MEM<9> = -1
MEM<10> = 16
MEM<11> = 3
MEM<12> = -1
MEM<13> = 15
MEM<14> = 15
MEM<15> = 0
MEM<16> = 0
MEM<17> = -1
MEM<18> = 72
MEM<19> = 101
MEM<20> = 108
MEM<21> = 108
MEM<22> = 111
MEM<23> = 44
MEM<24> = 32
MEM<25> = 119
MEM<26> = 111
MEM<27> = 114
MEM<28> = 108
MEM<29> = 100
MEM<30> = 33
MEM<31> = 10
MEM<32> = 0
INBUF =
OUTBUF =
BP = 0
IP = 0
LOOP GE(IP, 0) :F(DONE)
A = MEM<IP + 1>
B = MEM<IP + 2>
C = MEM<IP + 3>
IP = IP + 3
GE(A, 0) :S(NOIN)
LE(BP,SIZE(INBUF)) :S(GETCH)
INBUF = INPUT
BP = 1
GETCH &ALPHABET @N SUBSTR(INBUF,BP,1)
MEM<B + 1> = N
BP = BP + 1 :(LOOP)
NOIN GE(B, 0) :S(NOOUT)
EQ(MEM<A + 1>, 10) :F(PUTCH)
OUTPUT = OUTBUF
OUTBUF = :(LOOP)
PUTCH OUTBUF = OUTBUF CHAR(MEM<A + 1>) :(LOOP)
NOOUT MEM<B + 1> = MEM<B + 1> - MEM<A + 1>
LE(MEM<B + 1>, 0) :F(LOOP)
IP = C :(LOOP)
DONE EQ(SIZE(OUTBUF),0) :S(END)
OUTPUT = OUTBUF
END</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
=={{header|Swift}}==
Line 3,480 ⟶ 3,858:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="
var subleq = Fn.new { |program|
Line 3,509 ⟶ 3,887:
subleq.call(program)</syntaxhighlight>
{{out}}
<pre>
Hello, world!
</pre>
=={{header|XPL0}}==
{{trans|ALGOL W}}
<syntaxhighlight lang "XPL0">\Subleq program interpreter
\Executes the program specified in scode, stops when the instruction
\ pointer becomes negative.
procedure RunSubleq ( SCode, CodeLength);
integer SCode, CodeLength;
define MaxMemory = 3 * 1024;
integer Memory ( MaxMemory );
integer IP, A, B, C, I;
begin
begin
for I := 0 to MaxMemory - 1 do Memory( I ) := 0;
\Load the program into Memory
for I := 0 to CodeLength do Memory( I ) := SCode( I );
\Start at instruction 0
IP := 0;
\Execute the instructions to IP is < 0
while IP >= 0 do begin
\Get three words at IP and advance IP past them
A := Memory( IP );
B := Memory( IP + 1 );
C := Memory( IP + 2 );
IP := IP + 3;
\Execute according to A, B and C
if A = -1 then begin
\Input a character to B
Memory( B ) := ChIn(1)
end
else if B = -1 then begin
\Output character from A
ChOut(0, Memory ( A ) )
end
else begin
\Subtract and branch if <= 0
Memory( B ) := Memory( B ) - Memory( A );
if Memory( B ) <= 0 then IP := C
end
end \while-do
end
end \RunSubleq \;
\Test the interpreter with the hello-world program specified in the task
integer Code;
begin
Code := [ 15, 17, -1, 17, -1, -1
, 16, 1, -1, 16, 3, -1
, 15, 15, 0, 0, -1, 72
, 101, 108, 108, 111, 44, 32
, 119, 111, 114, 108, 100, 33
, 10, 0 ];
RunSubleq( Code, 31 )
end</syntaxhighlight>
{{out}}
<pre>
| |||