Subleq: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
(Added Wren) |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
(43 intermediate revisions by 17 users not shown) | |||
Line 16:
The program should load the initial contents of the emulated machine's memory, set the instruction pointer to the first address (which is defined to be address 0), and begin emulating the machine, which works as follows:
:# 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,
:# If '''A''' is
:# If '''B''' is
:# Otherwise, both '''A''' and '''B''' are treated as addresses.
:# If the instruction pointer becomes negative, execution halts.
Your solution may initialize the emulated machine's memory in any convenient manner, but if you accept it as input, it should be a separate input stream from the one fed to the emulated machine once it is running. And if fed as text input, it should be in the form of raw subleq "machine code" - whitespace-separated decimal numbers, with no symbolic names or other assembly-level extensions, to be loaded into memory starting at address '''0''' (zero).
For purposes of this task, show the output of your solution when fed the below "Hello, world!" program.
As written,
<pre>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</pre>
Line 35 ⟶ 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 49:
48 65 6c 6c 6f 2c 20 77 6f 72 6c 64 21 0a 00</pre>
<br><br>
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">F subleq(&a)
V i = 0
L i >= 0
I a[i] == -1
a[a[i + 1]] = :stdin.read(1).code
E I a[i + 1] == -1
print(Char(code' a[a[i]]), end' ‘’)
E
a[a[i + 1]] -= a[a[i]]
I a[a[i + 1]] <= 0
i = a[i + 2]
L.continue
i += 3
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])</syntaxhighlight>
{{out}}
<pre>
Hello, world!
</pre>
=={{header|8080 Assembly}}==
<
;;; SUBLEQ for CP/M. The word size is 16 bits, and the program
;;; is given 16 Kwords (32 KB) of memory. (If the system doesn't
Line 396 ⟶ 421:
emem: db 'Memory error$'
einv: db 'Invalid integer: '
eiloc: db ' $' </
=={{header|8086 Assembly}}==
Line 403 ⟶ 427:
This program reads a file given on the command line. Optional CR/LF translation is included, for SUBLEQ programs that expect the UNIX line ending convention. The word size is 16 bits, and the program is given 64 KB (32 Kwords) of memory.
<
;;; SUBLEQ interpreter that runs under MS-DOS.
;;; The word size is 16 bits, and the SUBLEQ program gets a 64KB
Line 692 ⟶ 716:
fbuf: resb RBUFSZ ; File buffer
stack: resw 128 ; 128 words for main stack (should be enough)
memtop: equ $</
=={{header|Ada}}==
<
procedure Subleq is
Line 762 ⟶ 786:
Execute_Program(Memory);
end Subleq;</
<pre>>./subleq
Line 770 ⟶ 794:
=={{header|ALGOL 68}}==
<
# executes the program specified in code, stops when the instruction pointer #
# becomes negative #
Line 817 ⟶ 841:
)
)
</syntaxhighlight>
{{out}}
<pre>
Line 825 ⟶ 849:
=={{header|ALGOL W}}==
{{Trans|Algol 68}}
<
begin
Line 890 ⟶ 914:
end
end.</
{{out}}
<pre>
Line 898 ⟶ 922:
{{works with|GNU APL}}
<
⎕IO←0 ⍝ Index origin 0 is more intuitive with 'pointers'
∇Subleq;fn;text;M;A;B;C;X
Line 927 ⟶ 951:
Subleq
)OFF
</syntaxhighlight>
=={{header|ARM Assembly}}==
<syntaxhighlight lang="text"> @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@ ARM SUBLEQ for Linux @@@
@@@ Word size is 32 bits. The program is @@@
@@@ given 8 MB (2 Mwords) to run in. @@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
.text
.global _start
@@@ Linux syscalls
.equ exit, 1
.equ read, 3
.equ write, 4
.equ open, 5
_start: pop {r6} @ Retrieve amount of arguments
cmp r6,#2 @ There should be exactly 2 (incl program)
ldrne r1,=usage @ Otherwise, print usage and stop
bne die
pop {r0,r1} @ Retrieve filename
mov r0,r1
mov r1,#0 @ Try to open the file in read mode
mov r2,#0
mov r7,#open
swi #0
movs r5,r0 @ File handle in R5
ldrmi r1,=efile @ If the file can't be opened, error
bmi die
ldr r8,=prog @ R8 = pointer into program
mov r6,#0 @ At the beginning, there is no data
rdnum: bl fchar @ Skip past whitespace
cmp r0,#32
bls rdnum
mov r9,#0 @ R9 = current number being read
subs r10,r0,#'- @ R10 is zero if number is negative
bleq fchar @ And get next character
1: sub r0,r0,#'0 @ Subtract ASCII 0
cmp r0,#9
ldrhi r1,=echar
bhi die @ Invalid digit = error
mov r1,#10
mla r0,r9,r1,r0 @ Multiply accumulator by 10 and add digit
mov r9,r0
bl fchar @ Get next character
cmp r0,#32 @ If it isn't whitespace...
bhi 1b @ ...then it's the next digit
tst r10,r10 @ If the number should be negative,
rsbeq r9,r9,#0 @ ...then negate it
str r9,[r8],#4 @ Store the number
b rdnum @ And get the next number.
setup: ldr r0,=prog @ Zero out the rest of program memory
sub r0,r8,r0 @ Zero to 8-word (32-byte) boundary
orr r0,r0,#31 @ Find address of last byte within
add r0,r0,r8 @ current 31-byte block
mov r1,#0 @ R1 = zero to write
1: str r1,[r8],#4 @ Write zeroes,
cmp r0,r8 @ until boundary reached.
blo 1b
mov r0,#0 @ 8 words of zeroes in r0-r7
umull r2,r3,r0,r1 @ A trick to produce 2 zero words in one
umull r4,r5,r0,r1 @ go: 0*0 = 0, long multiplication
umull r6,r7,r0,r1 @ results in 2 words.
ldr r9,=mem_end
2: stmia r8!,{r0-r7} @ Write 8 zero words at a time
cmp r8,r9 @ Are we at mem_end yet?
blo 2b @ If not, keep going
ldr r8,=prog @ R8 = IP, starts at beginning
ldr r6,=prog @ R6 = base address for memory
mov r12,#0xFFFF @ 0x1FFFFF = address mask
movt r12,#0x1F
instr: ldmia r8!,{r9-r11} @ R9, R10, R11 = A, B, C
cmp r9,#-1 @ If A=-1, get character
beq rchar
cmp r10,#-1 @ Otherwise, if B=-1, write character
beq wchar
and r9,r9,r12 @ Keep addresses within 2 Mwords
and r10,r10,r12
ldr r0,[r6,r9,lsl #2] @ Grab [A] and [B]
ldr r1,[r6,r10,lsl #2]
subs r1,r1,r0 @ Subtract
str r1,[r6,r10,lsl #2] @ Store back in [B]
cmpmi r0,r0 @ Set zero flag if negative
bne instr @ If result is positive, next instruction
lsls r8,r11,#2 @ Otherwise, C becomes the new IP
add r8,r8,r6
bpl instr @ If result is positive, keep going
mov r0,#0 @ Otherwise, we exit
mov r7,#exit
swi #0
@@@ Read character into [B]
rchar: mov r0,#0 @ STDIN
and r10,r10,r12 @ Address of B
add r10,r6,r10,lsl #2 @ Kept in R10 out of harm's way
mov r1,r10
mov r2,#1 @ Read one character
mov r7,#read
swi #0
cmp r0,#1 @ We should have received 1 byte
movne r1,#-1 @ If not, write -1
ldreqb r1,[r10] @ Otherwise, blank out the top 3 bytes
str r1,[r10]
b instr
@@@ Write character in [A]
wchar: mov r0,#1 @ STDIN
and r1,r9,r12 @ Address of [A]
add r1,r6,r1,lsl #2
mov r2,#1 @ Write one character
mov r7,#write
swi #0
b instr
@@@ Read character from file into R0. Tries to read more
@@@ if the buffer is empty (as given by R6). Buffer in R11.
fchar: tst r6,r6 @ Any bytes in the buffer?
ldrneb r0,[r11],#1 @ If so, return next character from buffer
subne r6,r6,#1
bxne lr
mov r12,lr @ Save link register
mov r0,r5 @ If not, read from file into buffer
ldr r1,=fbuf
mov r2,#0x400000
mov r7,#read
swi #0
movs r6,r0 @ Amount of bytes in r6
beq setup @ If no more bytes, start the program
ldr r11,=fbuf @ Otherwise, R11 = start of buffer
mov lr,r12
b fchar
@@@ Write a zero-terminated string, in [r1], to stdout.
print: push {lr}
mov r2,r1
1: ldrb r0,[r2],#1 @ Get character and advance pointer
tst r0,r0 @ Zero yet?
bne 1b @ If not, keep scanning
sub r2,r2,r1 @ If so, calculate length
mov r0,#1 @ STDOUT
mov r7,#write @ Write to STDOUT
swi #0
pop {pc}
@@@ Print error message in [r1], then end.
die: bl print
mov r0,#255
mov r7,#exit
swi #0
usage: .asciz "Usage: subleq <filename>\n"
efile: .asciz "Cannot open file\n"
echar: .asciz "Invalid number in file\n"
@@@ Memory
.bss
.align 4
prog: .space 0x400000 @ Lower half of program memory
fbuf: .space 0x400000 @ File buffer and top half of program memory
mem_end = .</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
$ ./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}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f SUBLEQ.AWK SUBLEQ.TXT
# converted from Java
Line 974 ⟶ 1,188:
exit(0)
}
</syntaxhighlight>
{{out}}
<pre>
Line 984 ⟶ 1,198:
Hello, world!
</pre>
=={{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$
40 GOTO 70
50 INPUT #1,M(I)
60 I=I+1
70 IF EOF(1) THEN CLOSE(1) ELSE GOTO 50
80 I=0
90 A=M(I): B=M(I+1): C=M(I+2): I=I+3
100 IF A=-1 GOTO 150 ELSE IF B=-1 GOTO 190
120 M(B) = M(B) - M(A)
130 IF M(B)<=0 THEN I=C
140 IF I>=0 GOTO 90 ELSE END
150 A$ = INPUT$(1): PRINT A$;
160 C = ASC(A$): IF C=13 THEN C=10
170 M(B) = C
180 GOTO 90
190 IF M(A)=10 THEN PRINT ELSE PRINT(CHR$(M(A) AND 255));
200 GOTO 90</syntaxhighlight>
{{out}}
<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}}==
The BBC BASIC implementation reads the machine code program as a string from standard input and stores it in an array of signed 32-bit integers. The default size of the array is 256, but other values could easily be substituted. No attempt is made to handle errors arising from invalid Subleq programs.
<
DIM memory%(255)
counter% = 0
Line 1,014 ⟶ 1,403:
ENDIF
ENDIF
UNTIL counter% < 0</
Output:
<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|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
// Read a string
let reads(v) be
$( let ch = ?
v%0 := 0
ch := rdch()
until ch = '*N' do
$( v%0 := v%0 + 1
v%(v%0) := ch
ch := rdch()
$)
$)
// Try to read a number, fail on EOF
// (Alas, the included READN just returns 0 and that's a valid number)
let readnum(n) = valof
$( let neg, ch = false, ?
!n := 0
$( ch := rdch()
if ch = endstreamch then resultis false
$) repeatuntil ch = '-' | '0' <= ch <= '9'
if ch = '-' then
$( neg := true
ch := rdch()
$)
while '0' <= ch <= '9' do
$( !n := !n * 10 + ch - '0'
ch := rdch()
$)
if neg then !n := -!n
resultis true
$)
// Read SUBLEQ code
let readfile(file, v) = valof
$( let i, oldin = 0, input()
selectinput(file)
while readnum(v+i) do i := i + 1
endread()
selectinput(oldin)
resultis i
$)
// Run SUBLEQ code
let run(v) be
$( let ip = 0
until ip < 0 do
$( let a, b, c = v!ip, v!(ip+1), v!(ip+2)
ip := ip + 3
test a=-1
then v!b := rdch()
else test b=-1
then wrch(v!a)
else
$( v!b := v!b - v!a
if v!b <= 0 then ip := c
$)
$)
$)
let start() be
$( let filename = vec 64
let file = ?
writes("Filename? ")
reads(filename)
file := findinput(filename)
test file = 0 then
writes("Cannot open file.*N")
else
$( let top = maxvec()
let mem = getvec(top)
let progtop = readfile(file, mem)
for i = progtop to top do mem!i := 0
run(mem)
freevec(mem)
$)
$)</syntaxhighlight>
{{out}}
<pre>Filename? hello.sub
Hello, world!</pre>
Line 1,027 ⟶ 1,500:
Also note that in some buggy interpreters you may need to pad the Befunge playfield with additional blank lines or spaces in order to initialise a writable memory area (without which the Subleq source may fail to load).
<
\0_v#-"-":\1_v#!`\*84:_^#- *8< >\#%"P"/#:5#<+g00g-\1+:"P"%\"P"v>5+#\*#<+"0"-~>^
<~0>#<$#-0#\<>$0>:3+\::"P"%\"P"/5+g00g-:1+#^_$:~>00gvv0gp03:+5/"P"\p02:%"P":< ^
>>>>>> , >>>>>> ^$p+5/"P"\%"P":-g00g+5/"P"\%"P":+1\+<>0g-\-:0v>5+g00g-:1+>>#^_$
-:0\`#@_^<<<<<_1#`-#0:#p2#g5#08#3*#g*#0%#2\#+2#g5#08#<**/5+g00g</
{{out}}
<pre>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|BQN}}==
Since Subleq programs can potentially run forever, this program prints each character with a newline.
<syntaxhighlight lang="bqn">
# Helpers
_while_ ← {𝔽⍟𝔾∘𝔽_𝕣_𝔾∘𝔽⍟𝔾𝕩}
ToNum ← {neg ← '-'=⊑𝕩 ⋄ (¯1⋆neg)×10⊸×⊸+˜´·⌽-⟜'0'neg↓𝕩}
Subleq ← {
𝕊 memory:
{
𝕊 ip‿mem:
{
¯1‿b‿·: ⟨ip+3, (@-˜•term.CharB@)⌾(b⊸⊑) mem⟩;
a‿¯1‿·: •Out @+a⊑mem, ⟨ip+3, mem⟩;
a‿b‿c : d ← b-○(⊑⟜mem)a, ⟨(0<d)⊑⟨c, ip+3⟩, d⌾(b⊸⊑) mem⟩
} mem⊏˜ip+↕3
} _while_ {𝕊 ip‿mem: ip≥0} 0‿memory
}
Subleq ToNum¨•args</syntaxhighlight>
<syntaxhighlight lang="text">$ cbqn subleq.bqn 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
H
e
l
l
o
,
w
o
r
l
d
!
</syntaxhighlight>
=={{header|C}}==
Takes the subleq instruction file as input, prints out usage on incorrect invocation.
<syntaxhighlight lang="c">#include <stdlib.h>
#include <
void
subleq(int *code)
{
int ip = 0, a, b, c, nextIP;
char ch;
while(0 <= ip) {
nextIP = ip + 3;
a = code[ip];
b = code[ip + 1];
c = code[ip + 2];
if(a == -1) {
scanf("%c", &ch);
code[b] = (int)ch;
} else if(b == -1) {
printf("%c", (char)code[a]);
} else {
code[b] -= code[a];
if(code[b] <= 0)
nextIP = c;
}
Line 1,069 ⟶ 1,576:
}
void
processFile(char *fileName)
{
int *dataSet, i, num;
FILE *fp = fopen(fileName, "r");
fscanf(fp, "%d", &num);
dataSet = (int *)malloc(num * sizeof(int));
fscanf(fp, "%d", &dataSet[i]);
fclose(fp);
subleq(dataSet);
}
int
main(int argC, char *argV[])
{
if(argC != 2)
printf("Usage : %s <subleq code file>\n", argV[0]);
else
processFile(argV[1]);
return 0;
}
</syntaxhighlight>
Input file (subleqCode.txt), first row contains the number of code points ( integers in 2nd row):
<pre>
Line 1,108 ⟶ 1,612:
=={{header|C sharp|C#}}==
{{trans|Java}}
<
namespace Subleq {
Line 1,144 ⟶ 1,648:
}
}
}</
{{out}}
<pre>Hello, world!</pre>
=={{header|C++}}==
<
#include <fstream>
#include <iostream>
Line 1,196 ⟶ 1,700:
return 0;
}
</syntaxhighlight>
{{out}}
Line 1,203 ⟶ 1,707:
Hello, world!
</pre>
=={{header|CLU}}==
<syntaxhighlight lang="clu">% Read numbers from a stream
read_nums = iter (s: stream) yields (int)
while true do
c: char := stream$getc(s)
while c~='-' & ~(c>='0' & c<='9') do
c := stream$getc(s)
end
acc: int := 0
neg: bool
if c='-' then
neg := true
c := stream$getc(s)
else
neg := false
end
while c>='0' & c<='9' do
acc := acc*10 + char$c2i(c) - char$c2i('0')
c := stream$getc(s)
except when end_of_file: break end
end
if neg then acc := -acc end
yield(acc)
end except when end_of_file: end
end read_nums
% Auto-resizing array
mem = cluster is new, load, fetch, store
rep = array[int]
new = proc () returns (cvt)
return(rep$predict(0,2**9))
end new
fill_to = proc (a: rep, lim: int)
while rep$high(a) < lim do rep$addh(a,0) end
end fill_to
fetch = proc (a: cvt, n: int) returns (int) signals (bounds)
fill_to(a,n)
return(a[n]) resignal bounds
end fetch
store = proc (a: cvt, n: int, v: int) signals (bounds)
fill_to(a,n)
a[n] := v resignal bounds
end store
load = proc (a: cvt, s: stream)
i: int := 0
for n: int in read_nums(s) do
up(a)[i] := n
i := i + 1
end
end load
end mem
% Run a Subleq program
subleq = proc (m: mem, si, so: stream)
ip: int := 0
while ip >= 0 do
a: int := m[ip]
b: int := m[ip+1]
c: int := m[ip+2]
ip := ip + 3
if a=-1 then m[b] := char$c2i(stream$getc(si))
elseif b=-1 then stream$putc(so,char$i2c(m[a] // 256))
else
m[b] := m[b] - m[a]
if m[b] <= 0 then ip := c end
end
end
end subleq
start_up = proc ()
pi: stream := stream$primary_input()
po: stream := stream$primary_output()
args: sequence[string] := get_argv()
if sequence[string]$size(args) ~= 1 then
stream$putl(stream$error_output(), "Usage: subleq file_name")
return
end
fname: file_name := file_name$parse(sequence[string]$bottom(args))
file: stream := stream$open(fname, "read")
m: mem := mem$new()
mem$load(m, file)
stream$close(file)
subleq(m, pi, po)
end start_up</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
$ ./subleq hello.sub
Hello, world!</pre>
=={{header|COBOL}}==
For compatibility with online COBOL compilers, where file IO is not supported, this implementation reads the Subleq program from the console. Note that COBOL tables (arrays) are indexed from 1 rather than 0, and so are character sets: in an ASCII environment 'A' is coded as 66 (the sixty-sixth character), not 65.
<
program-id. subleq-program.
data division.
Line 1,286 ⟶ 1,887:
if memory(adjusted-index-b) is equal to zero
or memory(adjusted-index-b) is negative
then move c to instruction-pointer.</
{{out}}
<pre>READING SUBLEQ PROGRAM... 0032 WORDS READ.
Line 1,294 ⟶ 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}}==
<
(loop for pc = 0 then next-pc
until (minusp pc)
Line 1,316 ⟶ 1,949:
(let ((memory (vector 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)))
(run memory)))</
{{out}}<pre>Hello, world!</pre>
=={{header|D}}==
<
void main() {
Line 1,352 ⟶ 1,985:
instructionPointer += 3;
} while (instructionPointer >= 0);
}</
{{out}}
Line 1,359 ⟶ 1,992:
=={{header|Delphi}}==
{{Trans|Java}}
<syntaxhighlight lang="delphi">
program SubleqTest;
Line 1,404 ⟶ 2,037:
readln;
end.
</syntaxhighlight>
=={{header|Draco}}==
<syntaxhighlight lang="draco">\util.g
proc nonrec rdch() byte:
char c;
if read(c) then
pretend(c, byte)
else
case ioerror()
incase CH_MISSING: readln(); 10
default: 0
esac
fi
corp
proc nonrec wrch(byte b) void:
if b=10
then writeln()
else write(pretend(b, char))
fi
corp
proc nonrec main() void:
[16384] int mem;
file() srcfile;
channel input text srcch;
*char fname;
int a, b, c, i;
byte iob;
BlockFill(pretend(&mem[0], *byte), sizeof(byte), 0);
fname := GetPar();
if fname = nil then
writeln("usage: SUBLEQ filename");
exit(1);
fi;
if not open(srcch, srcfile, fname) then
writeln("Cannot open input file");
exit(1)
fi;
i := 0;
while read(srcch; mem[i]) do i := i + 1 od;
close(srcch);
i := 0;
while i>=0 do
a := mem[i];
b := mem[i+1];
c := mem[i+2];
i := i + 3;
if a=-1 then mem[b] := rdch()
elif b=-1 then wrch(mem[a])
else
mem[b] := mem[b] - mem[a];
if mem[b] <= 0 then i := c fi
fi
od
corp</syntaxhighlight>
{{out}}
<pre>A>type 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
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}}==
Note that Forth is stack oriented. Hence, the code is toggled in in reverse.
<syntaxhighlight lang="text">create M 32 cells allot
: enter refill drop parse-word evaluate ; : M[] cells M + ;
Line 1,421 ⟶ 2,172:
-1 0 0 15 15 -1 3 16 -1 1 16 -1 -1 17 -1 17 15
init subleq</
{{out}}
<pre>init subleq
Line 1,434 ⟶ 2,185:
But Fortran 90 introduced the ability to specify the lower bounds of an array, so MEM(0:LOTS) is available without difficulty, and formulae may be translated with greater ease: handling offsets is a simple clerical task; computers excel at simple clerical tasks, so, let the computer do it. Otherwise, the following code would work with F77, except possibly for the odd usage of $ in a FORMAT statement so that each character of output is not on successive lines.
<syntaxhighlight lang="fortran">
PROGRAM SUBLEQ0 !Simulates a One-Instruction computer, with Subtract and Branch if <= 0.
INTEGER LOTS,LOAD !Document some bounds.
Line 1,464 ⟶ 2,215:
IF (IAR.GE.0) GO TO 100 !Keep at it.
END !That was simple.
</syntaxhighlight>
For simplicity there are no checks on memory bounds or endless looping, nor any trace output. The result is
<pre>
Line 1,472 ⟶ 2,223:
=={{header|Go}}==
<
import (
Line 1,518 ⟶ 2,269:
log.Fatalln("write:", err)
}
}</
A much longer version using types, methods, etc
and that supports supplying a program via a file or the command line,
Line 1,526 ⟶ 2,277:
=={{header|Haskell}}==
Inspired by the Racket solution.
<
import Control.Monad.State
import Data.Char (chr, ord)
Line 1,555 ⟶ 2,306:
zip [0..]
[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 32, 119, 111, 114, 108, 100, 33, 10, 0]
</syntaxhighlight>
=={{header|J}}==
<
if.0=#INBUF do. INBUF=:LF,~1!:1]1 end.
r=.3 u:{.INBUF
Line 1,585 ⟶ 2,336:
end.
OUTBUF
)</
Example:
<
Hello, world!</
=={{header|Janet}}==
<syntaxhighlight lang="clojure">(defn main [& args]
(let [filename (get args 1)
fh (file/open filename)
program (file/read fh :all)
memory (eval-string (string "@[" program "]"))
size (length memory)]
(var pc 0)
(while (<= 0 pc size)
(let [a (get memory pc)
b (get memory (inc pc))
c (get memory (+ pc 2))]
(set pc (+ pc 3))
(cond
(< a 0) (put memory b (first (file/read stdin 1)))
(< b 0) (file/write stdout (buffer/push-byte @"" (get memory a)))
true
(do
(put memory b (- (get memory b) (get memory a)))
(if (<= (get memory b) 0)
(set pc c))))))))</syntaxhighlight>
{{Out}}
<pre>$ janet subleq.janet hello.sq
Hello, world!
</pre>
=={{header|Java}}==
<
public class Subleq {
Line 1,627 ⟶ 2,407:
} while (instructionPointer >= 0);
}
}</
<pre>Hello, world!</pre>
Line 1,642 ⟶ 2,422:
or some post-processing. The output shown below assumes the -j
(--join-output) command-line option is available.
<
def while(cond; update):
def _while: if cond then ., (update | _while) else empty end;
Line 1,673 ⟶ 2,453:
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])</
{{out}}
<
Hello, world!</
=={{header|Julia}}==
Line 1,682 ⟶ 2,462:
'''Module''':
<
using OffsetArrays
Line 1,712 ⟶ 2,492:
end # module Subleq
</syntaxhighlight>
'''Main''':
<
print(Subleq.interpret("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"))
</
<pre>
Hello, world!
Line 1,725 ⟶ 2,505:
=={{header|Kotlin}}==
<
fun subleq(program: String) {
Line 1,755 ⟶ 2,535:
val program = "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"
subleq(program)
}</
{{out}}
Line 1,763 ⟶ 2,543:
=={{header|Logo}}==
<
to load_subleq
Line 1,801 ⟶ 2,581:
load_subleq
run_subleq
bye</
{{Out}}
Line 1,810 ⟶ 2,590:
=={{header|Lua}}==
<
local mem, p, A, B, C = {}, 0
for word in prog:gmatch("%S+") do
Line 1,831 ⟶ 2,611:
end
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")</
=={{header|Mathematica}} / {{header|Wolfram Language}}==
{{trans|R}}
<syntaxhighlight lang="mathematica">ClearAll[memory, MemoryGet, MemorySet, MemorySubtract]
memory = {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};
MemoryGet[addr_] := memory[[addr + 1]]
MemorySet[addr_, value_] := memory[[addr + 1]] = value
MemorySubtract[addr1_, addr2_] := MemorySet[addr1, MemoryGet[addr1] - MemoryGet[addr2]]
p = 0;
While[p >= 0,
a = MemoryGet[p];
b = MemoryGet[p + 1];
c = MemoryGet[p + 2];
If[b == -1,
Print[FromCharacterCode[MemoryGet[a]]]
,
MemorySubtract[b, a];
If[MemoryGet[b] < 1,
p = MemoryGet[p + 2];
Continue[]
]
];
p += 3;
]</syntaxhighlight>
{{out}}
<pre>H
e
l
l
o
,
w
o
r
l
d
!
</pre>
=={{header|MiniScript}}==
<
step = 3
currentAddress = 0
Line 1,872 ⟶ 2,694:
print out
print "-------------------"
print "Execution Complete"</
{{out}}
<pre>
Line 1,887 ⟶ 2,709:
=={{header|Modula-2}}==
<
FROM Terminal IMPORT Write,WriteString,WriteLn,ReadChar;
Line 1,926 ⟶ 2,748:
ReadChar
END Subleq.</
=={{header|Nim}}==
<syntaxhighlight lang="nim">import streams
type
Interpreter = object
mem: seq[int]
ip: int
input, output: Stream
proc load(prog: openArray[int]; inp, outp: Stream): Interpreter =
Interpreter(mem: prog, input: inp, output: outp)
proc run(i: var Interpreter) =
while i.ip >= 0:
let A = i.mem[i.ip]
let B = i.mem[i.ip+1]
let C = i.mem[i.ip+2]
i.ip += 3
if A == -1:
i.mem[B] = ord(i.input.readChar)
elif B == -1:
i.output.write(chr(i.mem[A]))
else:
i.mem[B] -= i.mem[A]
if i.mem[B] <= 0:
i.ip = C
let test = @[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]
var intr = load(test, newFileStream(stdin), newFileStream(stdout))
try:
intr.run()
except IndexDefect:
echo "ip: ", intr.ip
echo "mem: ", intr.mem</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|Objeck}}==
{{trans|Java}}
<
class Sublet {
Line 1,967 ⟶ 2,828:
while (instructionPointer >= 0);
}
}</
<pre>
Line 1,975 ⟶ 2,836:
=={{header|Oforth}}==
<
| ip a b c newb |
program asListBuffer ->program
Line 1,990 ⟶ 2,851:
[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 ]
subleq</
=={{header|ooRexx}}==
Line 1,996 ⟶ 2,857:
{{trans|REXX}}
reformatted and long variable names that suit all Rexxes.
<
Signal on Halt /*enable user to halt the simulation. */
cell.=0 /*zero-out all of real memory locations*/
Line 2,033 ⟶ 2,894:
Return cell._ /*return the contents of "memory" loc _*/
halt: Say 'REXX program halted by user.'
Exit 1</
{{out}}
<pre>Hello, world!</pre>
Line 2,041 ⟶ 2,902:
Using an array object instead of a stem for cells.
<br>Array indexes must be positive!
<
Signal on Halt /*enable user to halt the simulation. */
cell=.array~new /*zero-out all of real memory locations*/
Line 2,076 ⟶ 2,937:
Exit
halt: Say 'REXX program halted by user.';
Exit 1</
=={{header|Pascal}}==
{{works with|Free Pascal|1.06}}
<
CONST
Line 2,140 ⟶ 3,001:
LOADTEXT (FILENAME, MEM);
SUBLEQ (MEM);
END.</
{{in}}
Line 2,151 ⟶ 3,012:
=={{header|Perl}}==
<
use strict;
use warnings;
Line 2,175 ⟶ 3,036:
}
}
}</
{{Output}}<pre>Hello, world!</pre>
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">subleq</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">ip</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">3</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">3</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">?</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">getc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">c</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">subleq</span><span style="color: #0000FF;">({</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">72</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">101</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">44</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">32</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">119</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">114</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">33</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">10</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 2,206 ⟶ 3,069:
=={{header|PicoLisp}}==
<
(nth
(quote
Line 2,219 ⟶ 3,082:
((lt0 B) (prin (char (car (mem A)))))
((le0 (dec (mem B) (car (mem A))))
(setq IP (mem C)) ) ) ) )</
Output:
<pre>Hello, world!</pre>
Line 2,225 ⟶ 3,088:
=={{header|PowerShell}}==
{{trans|Python}}
<syntaxhighlight lang="powershell">
function Invoke-Subleq ([int[]]$Program)
{
Line 2,263 ⟶ 3,126:
}
}
</syntaxhighlight>
<syntaxhighlight lang="powershell">
Invoke-Subleq -Program 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
</syntaxhighlight>
{{Out}}
<pre>
Hello, world!
</pre>
=={{header|PureBasic}}==
<syntaxhighlight lang="purebasic">DataSection
StartData:
Data.i 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
StopData:
EndDataSection
If OpenConsole("Subleq")=0 : End 1 : EndIf
Dim code.i((?StopData-?StartData)/SizeOf(Integer)-1)
CopyMemory(?StartData,@code(0),?StopData-?StartData)
Define.i ip=0,a,b,c,nip
While 0<=ip
nip=ip+3 : a=code(ip) : b=code(ip+1) : c=code(ip+2)
If a=-1 : code(b)=Asc(Input())
ElseIf b=-1 : Print(Chr(code(a)))
Else : code(b)-code(a) : If code(b)<=0 : nip=c : EndIf
EndIf
ip=nip
Wend
Input()</syntaxhighlight>
=={{header|Python}}==
<
def subleq(a):
Line 2,296 ⟶ 3,180:
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])</
=={{header|Quackery}}==
Quackery understands a subset of ASCII, namely the printable characters, 32 (space) and 13 (carriage return). To accommodate this, the 10 (line feed) at the end of Hello, world! has been replaced with a 13.
The input stream to the Subleq program is passed to <code>subleq</code> as a string, along with the Subleq code, which is a nest of numbers. <code>getch</code> puts successive characters from the string into the address given by A. When the string is exhausted, <code>getch</code> puts a 0.
In the task program no input is required, so the empty string is passed.
<code>subleq</code> returns the output stream as a string.
<syntaxhighlight lang="Quackery"> ( O = Output string I = Input string S = Subleq code )
[ stack 0 ] is ip ( --> s )
[ stack 0 ] is a ( --> s )
[ stack 0 ] is b ( --> s )
[ stack 0 ] is c ( --> s )
[ over $ "" = iff 0
else
[ swap behead dip swap ]
swap b share poke ] is getch ( O I S --> O I S )
[ dup a share peek
dip rot join unrot ] is putch ( O I S --> O I S )
[ $ "" unrot
0 ip replace
[ dup ip share
2dup peek a replace
2dup 1 + peek b replace
2 + peek c replace
3 ip tally
a share -1 = iff getch again
b share -1 = iff putch again
dup b share peek
over a share peek -
tuck dip [ b share poke ]
1 < until
c share dup ip replace
0 < until ]
2drop ] is subleq ( I S --> O )
$ ""
' [ 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 13 0 ]
subleq echo$</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|R}}==
<
mem <- c(15, 17, -1, 17, -1, -1, 16, 1,
-1, 16, 3, -1, 15, 15, 0, 0,
Line 2,327 ⟶ 3,264:
instructionPointer <- instructionPointer + 3
}
</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
Line 2,333 ⟶ 3,270:
=={{header|Racket}}==
{{trans|Go}} The negative addresses are treated as -1.
<
(define (subleq v)
Line 2,360 ⟶ 3,297:
0))
(subleq Hello)</
{{out}}
<pre>Hello, world!</pre>
Line 2,367 ⟶ 3,304:
(formerly Perl 6)
{{trans|Perl}}
<syntaxhighlight lang="raku" line>my @hello-world =
|<15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1>,
|"Hello, world!\n\0".comb.map(*.ord);
my $ip = 0;
while $ip >= 0 && $ip < @memory {
my ($a, $b, $c) = @memory[$ip
$ip += 3;
if $a < 0 {
} elsif $b < 0 {
} else {
}
}
}
run-subleq @hello-world;</syntaxhighlight>
{{out}}
Line 2,392 ⟶ 3,334:
The REXX language has no concept of a ''word'', but for storing numbers, the default is nine decimal digits.
<
signal on halt /*enable user to halt the simulation.*/
parse arg $ /*get optional low memory vals from CL.*/
Line 2,414 ⟶ 3,356:
/*──────────────────────────────────────────────────────────────────────────────────────*/
@: parse arg @z; return @.@z /*return a memory location (cell @Z).*/
halt: say 'The One─Instruction Set Computer simulation pgm was halted by user.'; exit 1</
{{out|output|text= when using the default input:}}
<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>
=={{header|Ruby}}==
<
def initialize program
@memory = program.map
@instruction_pointer = 0
end
Line 2,438 ⟶ 3,415:
writechar @memory[a]
else
difference = @memory[b] -= @memory[a]
@instruction_pointer = c if difference <= 0
end
Line 2,464 ⟶ 3,440:
subleq = Computer.new ARGV
subleq.run</
'''Sample usage:'''
<pre>
Line 2,473 ⟶ 3,449:
=={{header|Scala}}==
===Imperative, Javaish, destructible opcodes read===
<
object Subleq extends App {
Line 2,491 ⟶ 3,467:
instructionPointer += 3
} while (instructionPointer >= 0)
}</
{{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}}==
{{trans|Raku}}
<
var ip = 0;
Line 2,511 ⟶ 3,532:
ip = c
}
}</
{{out}}
Line 2,523 ⟶ 3,544:
Requires at least 2k of RAM.
<
20 INPUT P$
30 LET W=1
Line 2,555 ⟶ 3,576:
310 GOTO 160
320 PRINT CHR$ (M(A+1)-1);
330 GOTO 160</
{{in}}
<pre>15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 46 43 50 50 53 27 1 61 53 56 50 42 28 118 0</pre>
{{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 2,565 ⟶ 3,661:
{{trans|Python}}
<
var i = 0
Line 2,593 ⟶ 3,689:
subleq(&prog)
</syntaxhighlight>
{{out}}
Line 2,601 ⟶ 3,697:
=={{header|Tcl}}==
<syntaxhighlight lang="tcl">
namespace import ::tcl::mathop::-
Line 2,626 ⟶ 3,722:
fconfigure stdout -buffering none
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}
</syntaxhighlight>
{{out}}
Line 2,632 ⟶ 3,728:
=={{header|uBasic/4tH}}==
<syntaxhighlight lang="text">GoSub _Initialize ' Initialize memory
i = 0 ' Reset instruction pointer
Line 2,683 ⟶ 3,779:
@(30) = 10 ' Replace with =ORD(c) when required
@(31) = 0
Return</
{{out}}
<pre>Hello, world!
Line 2,691 ⟶ 3,787:
=={{header|UNIX Shell}}==
===dash===
<
mem="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 "
Line 2,733 ⟶ 3,829:
done
echo "Total step:"$STEP
</syntaxhighlight>
===bash===
<
mem=(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)
while
(( step++ ))
if
printf '%b' '\x'$(printf '%x' ${mem[
else
addr=$c
fi
fi
done
</syntaxhighlight>
=={{header|Wren}}==
{{trans|Kotlin}}
<
var subleq = Fn.new { |program|
Line 2,793 ⟶ 3,885:
var program = "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"
subleq.call(program)</
{{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>
Line 2,802 ⟶ 3,953:
=={{header|zkl}}==
{{trans|Python}}
<
i:=0;
while(i>=0){ A,B,C:=a[i,3];
Line 2,810 ⟶ 3,961:
i+=3;
}
}</
<
0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108,
100, 33, 10, 0);</
{{out}}<pre>Hello, world!</pre>
=={{header|ZX Spectrum Basic}}==
Reads the Subleq program from the keyboard, as space-separated numbers, and executes it. A couple of implementation details (arrays being indexed from 1 rather than from 0; the control character ASCII 10 needing to be intercepted specially, because it would otherwise be printed as <code>?</code> rather than as a newline character) are hidden from the Subleq programmer. Lines <code>10</code> to <code>140</code> are the machine code loader, lines <code>150</code> to <code>310</code> the VM.
<
20 INPUT p$
30 LET word=1
Line 2,848 ⟶ 3,999:
290 IF m(a+1)=10 THEN PRINT : GO TO 160
300 PRINT CHR$ m(a+1);
310 GO TO 160</
{{out}}
<pre>Hello, world!</pre>
|