Subleq

From Rosetta Code
Task
Subleq
You are encouraged to solve this task according to the task description, using any language you may know.

Subleq is an example of a One-Instruction Set Computer (OISC).

It is named after its only instruction, which is SUbtract and Branch if Less than or EQual to zero.

Task

Your task is to create an interpreter which emulates a SUBLEQ machine.

The machine's memory consists of an array of signed integers.   These integers may be interpreted in three ways:

  •   simple numeric values
  •   memory addresses
  •   characters for input or output

Any reasonable word size that accommodates all three of the above uses is fine.

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:

  1.   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.
  2.   Advance the instruction pointer three words, to point at the address after the address containing C.
  3.   If A is -1 (negative unity), then a character is read from the machine's input and its numeric value stored in the address given by B. C is unused. (Most implementations adopt the C convention of signaling EOF by storing -1 as the read-in character.)
  4.   If B is -1 (negative unity), then the number contained in the address given by A is interpreted as a character and written to the machine's output. C is unused.
  5.   Otherwise, both A and B are treated as addresses. The number contained in address A is subtracted from the number in address B (and the difference left in address B). If the result is positive, execution continues uninterrupted; if the result is zero or negative, the instruction pointer is set to C.
  6.   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, this example assumes ASCII or a superset of it, such as any of the Latin-N character sets or Unicode;   you may translate the numbers representing characters (starting with 72=ASCII 'H') into another character set if your implementation runs in a non-ASCII-compatible environment. If 0 is not an appropriate terminator in your character set, the program logic will need some adjustment as well.

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

The above "machine code" corresponds to something like this in a hypothetical assembler language for a signed 8-bit version of the machine:

start:
    0f 11 ff subleq (zero), (message), -1 ; subtract 0 from next character value to print;
                                          ; terminate if it's <=0
    11 ff ff subleq (message), -1, -1     ; output character
    10 01 ff subleq (neg1), (start+1), -1 ; modify above two instructions by subtracting -1 
    10 03 ff subleq (neg1), (start+3), -1 ;   (adding 1) to their target addresses 
    0f 0f 00 subleq (zero), (zero), start ; if 0-0 <= 0 (i.e. always) goto start

; useful constants
zero: 
    00      .data 0  
neg1: 
    ff      .data -1
; the message to print
message: .data "Hello, world!\n\0"
    48 65 6c 6c 6f 2c 20 77 6f 72 6c 64 21 0a 00



11l

Translation of: Python
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])
Output:
Hello, world!

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
	;;;	have enough, the program will not run.)
	;;;	I/O is via the console; since it cannot normally be redirected,
	;;;	CR/LF translation is on by default. It can be turned off with
	;;;	the 'R' switch.
	;;;	---------------------------------------------------------------
	;;;	CP/M system calls
getch:	equ	1h
putch:	equ	2h
puts:	equ	9h
fopen:	equ	0Fh
fread:	equ	14h
	;;;	RAM locations
fcb1:	equ	5ch	; FCB 1 (automatically preloaded with 1st file name)
fcb2:	equ	6ch	; FCB 2 (we're abusing this one for the switch)
dma:	equ	80h	; default DMA is located at 80h
bdos:	equ	5h 	; CP/M entry point
memtop:	equ	6h	; First reserved memory address (below this is ours)
	;;;	Constants
CR:	equ	13	; CR and LF
LF:	equ	10
EOF:	equ	26	; EOF marker (as we don't have exact filesizes)
MSTART:	equ	2048	; Reserve 2K of memory for this program + the stack
MSIZE:	equ	32768	; Reserve 32K of memory (16Kwords) for the SUBLEQ code
PB:	equ	0C6h	; PUSH B opcode. 
	org	100h
	;;;	-- Memory initialization --------------------------------------
	;;;	The fastest way to zero out a whole bunch of memory on the 8080
	;;;	is to push zeroes onto the stack. Since we need to do 32K,
	;;;	and it's slow already to begin with, let's do it that way.
	lxi	d,MSTART+MSIZE	; Top address we need
	lhld	memtop		; See if we even have enough memory
	call	cmp16		; Compare the two
	xchg			; Put top address in HL
	lxi	d,emem		; Memory error message
	jnc	die		; If there isn't enough memory, stop.
	sphl			; Set the stack pointer to the top of memory
	lxi	b,0 		; 2 zero bytes to push
	xra	a		; Zero out A.
	;;;	Each PUSH pushes 2 zeroes. 256 * 64 * 2 = 32768 zeroes. 
	;;;	In the interests of "speedy" (ha!) execution, let's unroll this
	;;;	loop a bit. In the interest of the reader, let's not write out
	;;;	64 lines of "PUSH B". 'PB' is set to the opcode for PUSH B, and
	;;;	4*16=64. This costs some memory, but since we're basically
	;;;	assuming a baller >48K system anyway to run any non-trivial
	;;;	SUBLEQ code (ha!), we can spare the 64 bytes. 
memini:	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB	
	db	PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB
	inr	a		; This will loop around 256 times
	jnz	memini
	push	b
	;;;	This conveniently leaves SP pointing just below SUBLEQ memory.
	;;;	-- Check the raw switch ---------------------------------------
	;;;	CP/M conveniently parses the command line for us, under the
	;;;	assumption that there are two whitespace-separated filenames,
	;;;	which are also automatically made uppercase.
	;;;	We only have to see if the second filename starts with 'R'.
	lda	fcb2+1 		; Filename starts at offset 1 in the FCB
	cpi	'R'		; Is it 'R'?
	jnz	readfl		; If not, go read the file (in FCB1).
	lxi	h,chiraw	; If so, rewrite the jumps to use the raw fns
	shld	chin+1
	lxi	h,choraw
	shld	chout+1
	;;;	-- Parse the input file ---------------------------------------
	;;;	The input file should consist of signed integers written in
	;;;	decimal, separated by whitespace. (For simplicity, we'll call
	;;;	all control characters whitespace). CP/M can only read files
	;;;	128 bytes at a time, so we'll process it 128 bytes at a time
	;;;	as well.
readfl:	lda	fcb1+1		; See if a file was given
	cpi	' '		; If not, the filename will be empty (spaces)
	lxi	d,eusage	; Print the usage string if that is the case
	jz	die 
	mvi	c,fopen		; Otherwise, try to open the file.
	lxi	d,fcb1
	call	bdos
	inr	a		; FF is returned on error
	lxi	d,efile		; Print 'file error' and stop.
	jz	die
	;;;	Start parsing 16-bit numbers
	lxi	h,MSTART	; Start of SUBLEQ memory
	push	h		; Keep that on the stack
skipws:	call	fgetc		; Get character from file
	jc	rddone		; If EOF, we're done
	cpi	' '+1 		; Is it whitespace?
	jc	skipws		; Then get next character
rdnum:	lxi	h,0		; H = accumulator to store the number
	mov	b,h		; Set B if number should be negative.
	cpi	'-'		; Did we read a minus sign?
	jnz	rddgt		; If not, then this should be a digit.
	inr	b		; But if so, set B,
	call	fgetc		; and get the next character.
	jc	rddone
rddgt:	sui	'0'		; Make ASCII digit
	cpi	10 		; Which should now be less than 10
	jnc	fmterr		; Otherwise, print an error and stop
	mov	d,h		; Set HL=HL*10
	mov	e,l		; DE = HL 
	dad	h		; HL *= 2
	dad	h		; HL *= 4
	dad	d 		; HL *= 5
	dad	h 		; HL *= 10
	mvi	d,0		; Add in the digit
	mov	e,a
	dad 	d
	call	fgetc		; Get next character
	jc	rdeof		; EOF while reading number
	cpi	' '+1 		; Is it whitespace?
	jnc	rddgt		; If not, then it should be the next digit
	xchg			; If so, write the number to SUBLEQ memory
	pop	h 		; Number in DE and pointer in HL
	call	wrnum		; Write the number
	push	h		; Put the pointer back
	jmp	skipws		; Then skip to next number and parse it
rdeof:	xchg			; EOF, but we still have a number to write
	pop	h		; Number in DE and pointer in HL
	call	wrnum		; Write the number
	push	h
rddone:	pop	h		; We're done, discard pointer
	;;;	-- Run the SUBLEQ code ----------------------------------------
	lxi	h,MSTART	; Initialize IP
	;;; 	At the start of step, HL = IP (in system memory)
step:	mov	e,m		; Load A into DE
	inx	h
	mov	d,m
	inx	h
	mov	c,m		; Load B into BC
	inx	h
	mov	b,m
	inx	h
	mov	a,e		; Check if A=-1
	ana	d
	inr	a
	jz 	sbin		; If so, read input
	mov	a,b		; Otherwise, check if B=-1
	ana	c
	inr	a
	jz	sbout		; If so, write output
	;;;	Perform the SUBLEQ instruction
	push	h		; Store the IP (-2) on the stack
	mov	a,d		; Obtain [A] (set DE=[DE])
	ani	3Fh		; Make sure address is in 16K words
	mov	d,a
	lxi	h,MSTART	; Add to start address twice
	dad	d		; (SUBLEQ addresses words, we're addressing
	dad 	d		; bytes)
	mov	e,m		; Load low byte
	inx	h
	mov	d,m		; Load high byte
	mov	a,b		; Obtain [B] (set BC=[BC])
	ani	3Fh		; This adress should also be in the 16K words
	mov	b,a
	lxi	h,MSTART	; Add to start address twice, again
	dad	b
	dad	b
	mov	c,m		; Load low byte
	inx	h
	mov	b,m		; Load high byte
	mov	a,c		; BC (B) -= DE (A)
	sub	e		; Subtract low bytes
	mov	c,a
	mov	a,b		; Subtract high bytes
	sbb	d
	mov	b,a
	mov	m,b		; HL is still pointing to the high byte of [B]
	dcx	h
	mov	m,c		; Store the low byte back too
	pop	h		; Restore IP
	ral			; Check sign bit of [B] (which is still in A)
	jc	sujmp		; If set, it's negative, and we need to jump
	rar
	ora	c		; If we're still here, it wasn't set. OR with
	jz	sujmp		; low bit, if zero then we also need to jump
	inx	h 		; We don't need to jump, so we should ignore C;
	inx 	h		; increment the IP to advance past it.
	jmp	step		; Next step
sujmp:	mov	c,m		; We do need to jump, load BC=C
	inx	h
	mov	a,m		; High byte into A
	ral			; See if it is negative
	jc	quit		; If so, stop
	rar
	ani	3Fh		; Don't jump outside the address space
	mov	b,a		; High byte into B
	lxi	h,MSTART	; Calculate new IP
	dad	b
	dad	b
	jmp	step		; Do next step
	;;;	Input: A=-1
sbin:	inx	h		; Advance IP past C
	inx	h
	xchg			; IP in DE
	mov	a,b		; Calculate address for BC (B)
	ani	3Fh
	mov	b,a
	lxi	h,MSTART	
	dad	b
	dad	b
	call	chin		; Read character
	mov	m,a		; Store in low byte
	inx	h
	mvi	m,0 		; Store zero in high byte
	xchg			; IP back in HL
	jmp	step		; Next step
	;;;	Output: B=-1
sbout:	inx	h		; Advance IP past C
	inx	h
	xchg			; IP in DE and A in HL
	mov	a,h		; Calculate address for A
	ani	3Fh
	mov	h,a
	dad	h
	lxi	b,MSTART
	dad	b
	mov	a,m		; Retrieve low byte (character)
	call	chout		; Write character
	xchg			; IP back in HL
	jmp	step		; Next step 
quit:	rst	0
	;;;	-- Write number to SUBLEQ memory ------------------------------
	;;;	Assuming: DE holds the number, B=1 if number should be negated,
	;;;	HL holds the pointer to SUBLEQ memory.
wrnum:	dcr	b		; Should the number be negated?
	jnz	wrpos		; If not, just write it
	dcx	d		; Otherwise, negate it: decrement,
	mov	a,e		; Then complement low byte,
	cma
	mov	e,a
	mov	a,d		; Then complement high byte
	cma
	mov	d,a		; And then write it
wrpos:	mov	m,e		; Write low byte
	inx	h		; Advance pointer
	mov	m,d		; Write high byte
	inx	h		; Advance pointer
	ret 
	;;;	-- Read file byte by byte -------------------------------------
	;;;	The next byte from the file in FCB1 is returned in A, and all
	;;;	other registers are preserved. When 128 bytes have been read,
	;;;	the next record is loaded automatically. Carry set on EOF.
fgetc:	push	h		; Keep HL registers
	lda	fgptr		; Where are we in the record?
	ana	a		 
	jz	nxtrec		; If at 0 (rollover), load new record.
frecc:	mvi	h,0		; HL = A
	mov	l,a 		
	inr	a		; Next A
	sta	fgptr 		; Write A back
	mov	a,m		; Retrieve byte
	pop	h		; Restore HL registers
	cpi	EOF		; Is it EOF?
	rnz			; If not, we're done (ANA clears carry)
	stc			; But otherwise, set carry
	ret
nxtrec:	push	d		; Keep the other registers too
	push	b
	mvi	c,fread		; Read record from file
	lxi	d,fcb1
	call	bdos
	dcr	a		; A=1 on EOF
	jz	fgeof	
	inr	a		; A<>0 = error
	lxi	d,efile
	jnz	die
	mvi	a,80h		; If we're still here, record read correctly
	sta	fgptr		; Set pointer back to beginning of DMA.
	pop	b		; Restore B and D 
	pop	d
	jmp	frecc		; Get first character from the record.
fgeof:	stc			; On EOF (no more records), set carry 
	jmp	resbdh		; And restore the registers 
fgptr:	db 	0		; Pointer (80h-FFh) into DMA area. Reload on 0.
	;;;	-- Compare DE to HL -------------------------------------------
cmp16:	mov	a,d		; Compare high bytes
	cmp	h
	rnz			; If they are not equal, we know the ordering
	mov	a,e		; If they are equal, compare lower bytes
	cmp 	l
	ret 
	;;;	-- Register-preserving I/O routines ---------------------------
chin:	jmp	chitr		; These are rewritten to jump to the raw I/O
chout:	jmp	chotr		; instructions to turn translation off.
	;;;	-- Read character into A with translation ---------------------
chitr:	call	chiraw		; Get raw character
	cpi	CR		; Is it CR? 
	rnz			; If not, return character unchanged
	mvi	a,LF		; Otherwise, return LF (terminal sends only CR)
	ret
	;;;	-- Read character into A. -------------------------------------
chiraw:	push	h		; Save all registers except A
	push	d
	push	b
	mvi 	c,getch		; Get character from terminal
	call	bdos		; Character ends up in A
	jmp	resbdh		; Restore registers afterwards
	;;;	-- Write character in A to terminal with translation ----------
chotr:	cpi	LF		; Is it LF?
	jnz	choraw		; If not, just print it
	mvi	a,CR		; Otherwise, print a CR first,
	call	choraw
	mvi	a,LF		; And then a LF. (fall through)
	;;;	-- Write character in A to terminal ---------------------------
choraw:	push	h		; Store all registers
	push	d
	push	b
	push	psw		
	mvi	c,putch		; Write character to terminal
	mov	e,a
	call	bdos
	;;;	-- Restore registers ------------------------------------------
restor:	pop	psw		; Restore all registers
resbdh:	pop	b		; Restore B D H
	pop	d
	pop	h
	ret
	;;;	-- Make parse error message and stop --------------------------
	;;;	A should hold the offending character _after_ '0' has already
	;;; 	been subtracted.
fmterr:	adi	'0'		; Undo subtraction of ASCII 0
	lxi	h,eiloc		; Write the characters in the error message
	mov	m,a
	inx	h
	mvi	b,4		; Max. 4 more characters
fmtelp:	call	fgetc		; Get next character
	jc	fmtdne		; If EOF, stop
	mov	m,a		; If not, store the character
	inx	h		; Advance pointer
	dcr	b		; Should we do more characters?
	jnz	fmtelp		; If so, go get another
fmtdne:	lxi	d,einv		; Print 'invalid integer' error message.
	;;;	-- Print an error message and stop ----------------------------
die:	mvi	c,puts
	call	bdos
	rst	0
	;;;	-- Error messages ---------------------------------------------
eusage:	db	'SUBLEQ <file> [R]: Run the SUBLEQ program in <file>.$'
efile:	db	'File error$'	
emem:	db	'Memory error$'
einv:	db	'Invalid integer: '
eiloc:	db	'     $'

8086 Assembly

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
	;;;	(that is, 32K Subleq words) address space. 
	;;;	The SUBLEQ program is read from a text file given on the
	;;;	command line, I/O is done via the console. 
	;;;	Console I/O is normally raw, but with the /T parameter,
	;;;	line ending translation is done (CRLF <> LF). 
	;;;	-------------------------------------------------------------
	bits	16
	cpu	8086
	;;;	MS-DOS system calls
getch:	equ	1h	; Get character
putch:	equ	2h	; Print character
puts:	equ	9h	; Print string
fopen:	equ	3Dh	; Open file
fclose:	equ	3Eh	; Close file
fread:	equ	3Fh	; Read from file
alloc:	equ	48h	; Allocate memory block
resize:	equ	4Ah	; Change size of memory block
exit:	equ	4Ch	; Exit to DOS
	;;;	Constants
RBUFSZ:	equ	1024	; 1K read buffer 
CR:	equ	13	; CR and LF 
LF:	equ	10
	;;;	RAM locations
cmdlen:	equ	80h	; Length of command line
cmdlin:	equ	81h	; Contents of command line
	org	100h
section	.text
	clc			; Make sure string instructions go forward
	;;;	-- Memory initialization ------------------------------------
	;;;	This is a .COM file. This means MS-DOS gives us all available
	;;;	memory starting at CS:0, and CS=DS=ES=SS. This means in order
	;;;	to allocate a separate 64k segment for the SUBLEQ memory
	;;;	space, we will first need to free all memory we're not using. 
	;;;	-------------------------------------------------------------
memini:	mov	sp,memtop	; Point SP into memory we will be keeping
	mov	dx,emem		; Set up a pointer to the memory error msg
	mov	ah,resize	; Reallocate current block
	mov	bx,sp		; Size is in paragraphs (16 bytes), and the 
	mov	cl,4		; assembler will not let me shift a label at
	shr	bx,cl		; compile time, so we'll do it at runtime.
	inc	bx		; BX=(memtop>>4)+1; memtop in last paragraph.	
	int	21h
	jnc	.alloc		; Carry not set = allocate memory
	jmp	die		; Otherwise, error (jump > 128 bytes)
	;;;	Allocate a 64K block for the SUBLEQ program's address space
.alloc:	mov	ah,alloc	; Allocate 64K (4096 paragraphs) for the
	mov	bx,4096		; SUBLEQ program. Because that is the size of
	int	21h		; an 8086 segment, we get free wraparound,
	jnc	.zero		; and we don't have to worry about bounds
	jmp	die		; checking.
	;;;	Zero out the memory we're given
.zero:	push	ax		; Keep SUBLEQ segment on stack.
	mov	es,ax		; Let ES point into our SUBLEQ segment.
	mov	cx,32768	; 32K words = 64K bytes to set to zero.
	xor	ax,ax		; We don't have to care about where DI is,
	rep	stosw		; since we're doing all of ES anyway.
	;;;	-- Parse the command line and open the file -----------------
	;;;	A filename should be given on the command line, which should
	;;;	be a text file containing (possibly negative) integers
	;;;	written in base 10. For "efficiency", we read the file 1K
	;;;	at a time into a buffer, rather than character by character.
	;;;	We also handle the '/T' parameter here. 
	;;;	-------------------------------------------------------------
rfile:	mov	dx,usage	; Print 'usage' message if no argument 
	mov	di,cmdlin	; 0-terminate command line for use with fopen 
	xor	bh,bh		; We'll use BX to index into the command line
	mov	bl,[cmdlen]	; Length of command line
	test	bl,bl		; If it's zero, no argument was given
	jnz	.term		; If not zero, go ahead
	jmp 	die		; Otherwise, error (again, jump > 128 bytes)
.term:	mov	[di+bx],bh	; Otherwise, 0-terminate
	mov	ax,ds		; Let ES point into our data segment
	mov	es,ax		; (in order to use SCASB).
.skp:	mov	al,' '		; Skip any preceding spaces
	mov	cx,128		; Max. command line length
	repe	scasb
	dec	di		; As usual, SCASB goes one byte too far
	mov	al,[di]		; If we're at zero now, we don't have an
	test	al,al		; argument either, so same error. 
	jnz	.parm		; (Again, jump > 128 bytes)
	jmp	die
.parm	cmp	al,'/'		; Input parameter?
	jne	.open		; If not, this is the filename, open it
	inc	di		; If so, is it 'T' or 't'?
	mov	al,[di]
	inc	di		; Skip past it
	mov	dl,[di]		; And is the next one a space again?
	cmp	dl,' '
	je	.testp		; If so, it's potentially valid
.perr:	mov	dx,eparm	; If not, print error message
	jmp	die
.testp:	or	al,32		; Make lowercase
	cmp	al,'t'		; 'T'?
	jne	.perr		; If not, print error message
	inc	byte [trans]	; If so, turn translation on 
	jmp	.skp		; And then get the filename
.open:	mov	ax,fopen<<8	; Open file for reading (AL=0=O_RDONLY)
	mov	dx,di		; 0-terminated path on the command line
	int	21h
	jnc	.read		; Carry not set = file opened
	mov	dx,efile	; Otherwise, file error (we don't much care
	jmp	die		; which one, that's too much work.)
.read:	pop	es 		; Let ES be the SUBLEQ segment (which we
	xor	di,di		; pushed earlier), and DI point to 1st word.
	mov	bp,ax		; Keep the file handle in BP.
	xor	cx,cx		; We have read no bytes yet.
	;;;	-- Read and parse the file ----------------------------------
	;;;	We need to read 16-bit signed integers from the file,
	;;;	in decimal. The integers are separated by whitespace, which
	;;;	for simplicity's sake we'll say is ASCII space and _all_
	;;;	control characters. BP, CX and SI are used as state to 
	;;;	emulate character-based I/O, and so must be preserved;
	;;;	furthermore, DI is used as a pointer into the SUBLEQ memory.
	;;;	-------------------------------------------------------------
skipws:	call	fgetc		; Get next character
	jc	fdone		; If we get EOF, we're done.
	cmp	al,' '		; Is it whitespace? (0 upto ' ' inclusive)
	jbe	skipws		; Then keep skipping
rdnum:	xor	dl,dl		; DL is set if number is negative
	xor	bx,bx		; BX will keep the number
	cmp	al,'-'		; Is first character a '-'?
	jne	.dgt		; If not, it's positive 
	inc	dx		; Otherwise, set DL,
	call	fgetc		; and get next character.
	jc	fdone
.dgt:	mov	dh,al		; Store character in DH
	sub	dh,'0'		; Subtract '0'
	cmp	dh,9		; Digit is [0..9]?
	jbe	.dgtok		; Then it is OK
	jmp	fmterr		; Otherwise, format error (jump > 128)
.dgtok:	mov	ax,bx		; BX *= 10 (without using MUL or SHL BX,CL;
	shl	bx,1		; since we can't spare the registers).
	shl	bx,1
	add	bx,ax
	shl 	bx,1
	mov	al,dh		; Load digit into AL
	cbw			; Sign extend (in practice just sets AH=0)
	add	bx,ax		; Add it into BX
	call	fgetc		; Get next character
	jc	dgteof		; EOF while reading num is special
	cmp	al,' '		; If it isn't whitespace, 
	ja	.dgt		; then it's the next digit.
	test	dl,dl		; Otherwise, number is done. Was it negative?
	jz 	.wrnum		; If not, write it to SUBLEQ memory
	neg	bx		; Otherwise, negate it
.wrnum:	mov	ax,bx		; ...and _then_ write it.
	stosw
	jmp	skipws		; Skip any other wspace and get next number
dgteof:	test	dl,dl		; If we reached EOF while reading a number,
	jz	.wrnum		; we need to do the same conditional negation
	neg	bx		; and write out the number that was still in
.wrnum:	mov	ax,bx		; BX.
	stosw
fdone:	mov	ah,fclose	; When we're done, close the file.
	mov	bx,bp		; (Not strictly necessary since we've only
	int	21h		; read, so we don't care about errors.)
	;;;	-- Run the SUBLEQ code --------------------------------------
	;;;	SI = instruction pointer. An instruction A B C is loaded into
	;;;	BX DI AX respectively. Note that SUBLEQ addresses words,
	;;;	whereas the 8086 addresses bytes, so the addresses all need
	;;;	to be shifted left once before being used. 
	;;;	-------------------------------------------------------------
subleq:	xor	si,si		; Start with IP=0
	mov	cl,[trans]	; CL = \r\n translation on or off
	mov	ax,es		; Set DS=ES=SUBLEQ segment
	mov	ds,ax
	;;;	Load instruction
.step:	lodsw			; Load A
	mov	bx,ax		; BP = A
	lodsw			; Load B
	mov	di,ax		; DI = B
	lodsw			; Load C (AX=C)
	;;;	Check for special cases
	inc	bx		; BX=-1 = read byte	
	jz	.in		; If ++BP==0, then read character  
	dec	bx		; Restore BX
	inc	di		; If ++DI==0, then write character
	jz	.out		
	dec	di		; Restore DI
	;;;	Do the SUBLEQ instruction
	shl	di,1		; Addresses must be doubled since SUBLEQ
	shl	bx,1		; addresses words and we're addressing bytes
	mov	dx,[di]		; Retrieve [B]
	sub	dx,[bx]		; DX = [B] - [A]
	mov	[di],dx		; [B] = DX
	jg	.step		; If [B]>[A], (i.e. [B]-[A]>=0), do next step
	shl	ax,1		; Otherwise, AX*2 (C) becomes the new IP
	mov	si,ax
	jnc	.step		; If high bit was 0, next step
	mov	ax,exit<<8	; But otherwise, it was negative, so we stop
	int	21h
	;;;	Read a character from standard input
.in:	mov	ah,getch	; Input: read character into AL
	int	21h		
	cmp	al,CR		; Is it CR? 
	je	.crin		; If not, just store the character
.sto:	xor	ah,ah		; Character goes in low byte of word
	shl	di,1		; Word address to byte address
	mov	[di],ax		; Store character in memory at B
	jmp	.step		; And do next step
	;;;	Pressing enter only returns CR; not CR LF on two reads, 
	;;;	therefore on CR we give LF instead when translation is on.
.crin:	test	cl,cl		; Do we even want translation?
	jz	.sto		; If not, just store the CR and leave it
	mov	al,LF		; But if so, use LF instead
	jmp	.sto
	;;;	Write a character to standard output
.out: 	shl	bx,1		; Load character from [A]
	mov	dl,[bx]		; We only need the low byte
	mov 	ah,putch	; Set AH to print the character
	cmp	dl,LF		; Is it LF?
	je	.lfo		; Then handle it separately
.wr:	int	21h
	jmp	.step		; Do next step
	;;;	LF needs to be translated into CR LF, so we need to print the
	;;;	CR first and then the LF, if translation is on.
.lfo:	test	cl,cl		; Do we even want translation?
	jz	.wr		; If not, just print the LF
	mov	dl,CR		; If so, print a CL first
	int	21h
	mov	dl,LF		; And then a LF
	jmp	.wr
	;;;	-- Subroutine: get byte from file buffer. --------------------
	;;;	If the buffer is empty, fill with more bytes from file.
	;;;	On EOF, return with carry set. 
	;;;	Input:  BP = file handle, CX = bytes left in buffer,
	;;;	        SI = current pointer into buffer.
	;;;	Output: AL = byte, CX and SI moved, other registers preserved
	;;;	-------------------------------------------------------------
fgetc:	test	cx,cx		; Bytes left?
	jz	.read		; If not, read from file
.buf:	lodsb			; Otherwise, get byte from buffer
	dec	cx		; One fewer byte left
	ret			; And we're done. (TEST clears carry, LODSB
				; and DEC don't touch it, so it's clear.)
.read:	push	ax		; Keep AX, BX, DX
	push	bx
	push	dx
	mov	ah,fread	; Read from file,
	mov	bx,bp		; BP = file handle,
	mov	cx,RBUFSZ	; Fill up entire buffer if possible,
	mov	dx,fbuf		; Starting at the start of buffer,
	mov	si,dx		; Also start returning bytes from there.
	int	21h
	jc	.err		; Carry set = read error
	mov	cx,ax		; CX = amount of bytes read
	pop	dx		; Restore AX, BX, DX
	pop	bx
	pop 	ax
	test	cx,cx		; If CX not zero, we now have data in buffer
	jnz	.buf		; So get first byte from buffer
	stc			; But if not, EOF, so set carry and return
	ret
.err:	mov	dx,efile	; On error, print the file error message
	jmp	die		; and stop
	;;;	Parse error (invalid digit) ---------------------------------
	;;;	Invalid character is in AL. BP, CX, SI still set to read from
	;;;	file. 
fmterr:	mov	dx,ds		; Set ES=DS
	mov	es,dx 
	mov	dl,5		; Max. 5 characters
	mov	di,eparse.dat	; DI = empty space in error message
.wrch:	stosb			; Store character in error message
	call	fgetc		; Get next character 
	jc	.done		; No more chars = stop
	dec	dl		; If room left, 
	jnz	.wrch		; write next character
.done:	mov	dx,eparse	; Use error message with offender written in
				; And fall through to stop the program
	;;;	Print the error message in [DS:DX] and terminate with
	;;;	errorlevel 2. 
die:	mov	ah,puts
	int	21h
	mov	ax,exit<<8 | 2
	int	21h
section	.data
usage:	db	'SUBLEQ [/T] <file> - Run the SUBLEQ program in <file>.$'
efile:	db	'Error reading file.$'
eparm:	db	'Invalid parameter.$'
emem:	db	'Memory allocation failure.$'
eparse:	db	'Invalid integer at: '
.dat:	db	'     $'	; Spaces to be filled in by error routine
trans:	db	0	; Will be set if CRLF translation is on
section	.bss	
fbuf:	resb	RBUFSZ	; File buffer
stack:	resw	128	; 128 words for main stack (should be enough)
memtop:	equ	$

Ada

with Ada.Text_IO;

procedure Subleq is
   
   Storage_Size: constant Positive := 2**8; -- increase or decrease memory
   Steps: Natural := 999; -- "emergency exit" to stop endless loops
 
   subtype Address is Integer range -1 .. (Storage_Size-1);
   subtype Memory_Location is Address range 0 .. Address'Last;
 
   type Storage is array(Memory_Location) of Integer;
 
   package TIO renames Ada.Text_IO;
   package IIO is new TIO.Integer_IO(Integer);
 
   procedure Read_Program(Mem: out Storage) is
      Idx: Memory_Location := 0;
   begin
      while not TIO.End_Of_Line loop
	 IIO.Get(Mem(Idx));
 	 Idx := Idx + 1;
      end loop;
   exception 
      when others => TIO.Put_Line("Reading program: Something went wrong!"); 
   end Read_Program;
 
   procedure Execute_Program(Mem: in out Storage) is
      PC: Integer := 0; -- program counter
      function Source return Integer is (Mem(PC));
      function Dest return Integer is (Mem(PC+1));
      function Branch return Integer is (Mem(PC+2));
      function Next return Integer is (PC+3);
   begin
      while PC >= 0 and Steps >= 0 loop
	 Steps := Steps -1;
	 if Source = -1 then -- read input
            declare
               Char: Character;
            begin
               TIO.Get (Char);
               Mem(Dest) := Character'Pos (Char);
            end;
	    PC := Next;
	 elsif Dest = -1 then -- write output
	    TIO.Put(Character'Val(Mem(Source)));
	    PC := Next;
	 else -- subtract and branch if less or equal
	    Mem(Dest) := Mem(Dest) - Mem(Source);
	    if Mem(Dest) <= 0 then  
	       PC := Branch;
	    else
	       PC := Next;
	    end if;
	 end if;
      end loop;
      TIO.Put_Line(if PC >= 0 then "Emergency exit: program stopped!" else "");
    exception
      when others => TIO.Put_Line("Failure when executing Program"); 
   end Execute_Program;
 
   Memory: Storage := (others => 0); -- no initial "junk" in memory!
 
begin
 
   Read_Program(Memory);
   Execute_Program(Memory);
 
end Subleq;
>./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!

ALGOL 68

# Subleq program interpreter                                                 #
# executes the program specified in code, stops when the instruction pointer #
# becomes negative                                                           #
PROC run subleq = ( []INT code )VOID:
     BEGIN
        INT   max memory = 3 * 1024;
        [ 0 : max memory - 1 ]INT memory;
        # load the program into memory                                       #
        # a slice yields a row with LWB 1...                                 #
        memory[ 0 : UPB code - LWB code ] := code[ AT 1 ];
        # start at instruction 0                                             #
        INT   ip := 0;
        # execute the instructions until ip is < 0                           #
        WHILE ip >= 0 DO
            # get three words at ip and advance ip past them                 #
            INT a := memory[ ip     ];
            INT b := memory[ ip + 1 ];
            INT c := memory[ ip + 2 ];
            ip +:= 3;
            # execute according to a, b and c                                #
            IF   a = -1 THEN
                # input a character to b                                     #
                CHAR input;
                get( stand in, ( input ) );
                memory[ b ] := ABS input
            ELIF b = -1 THEN
                # output character from a                                    #
                print( ( REPR memory[ a ] ) )
            ELSE
                # subtract and branch if le 0                                #
                memory[ b ] -:= memory[ a ];
                IF memory[ b ] <= 0 THEN
                    ip := c
                FI
            FI
        OD
     END # run subleq # ;

# test the interpreter with the hello-world program specified in the task    #
run 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
            )
          )
Output:
Hello, world!

ALGOL W

Translation of: Algol 68
% Subleq program interpreter                                                 %
begin

    % executes the program specified in scode, stops when the instruction    %
    % pointer becomes negative                                               %
    procedure runSubleq ( integer array scode( * )
                        ; integer value codeLength
                        ) ;
    begin
        integer maxMemory;
        maxMemory := 3 * 1024;
        begin
            integer array memory ( 0 :: maxMemory - 1 );
            integer       ip, a, b, c;
            for i := 0 until maxMemory - 1 do memory( i ) := 0;
            % load the program into memory                                   %
            for i := 0 until codeLength do memory( i ) := scode( i );

            % start at instruction 0                                         %
            ip := 0;
            % execute the instructions until 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                                 %
                    string(1) input;
                    read( input );
                    memory( b ) := decode( input )
                    end
                else if b = -1 then begin
                    % output character from a                                %
                    writeon( code( memory( a ) ) )
                    end
                else begin
                    % subtract and branch if le 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 %
    begin
        integer array code ( 0 :: 31 );
        integer       codePos;
        codePos := 0;
        for 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
        do begin
            code( codePos ) := i;
            codePos := codePos + 1;
        end;
        runSubleq( code, 31 )
    end

end.
Output:
Hello, world!

APL

Works with: GNU APL
#!/usr/local/bin/apl -s --
⎕IO0                       ⍝ Index origin 0 is more intuitive with 'pointers'
Subleq;fn;text;M;A;B;C;X
        (5≠⍴⎕ARG)/usage    ⍝ There should be one (additional) argument
        fn⎕ARG[4]         ⍝ This argument should be the file name
        (''0text⎕FIO[26]fn)/filerr ⍝ Load the file
        text[(text⎕TC)/⍳⍴text]' '    ⍝ Control characters to spaces
        text[(text='-')/⍳⍴text]'¯'    ⍝ Negative numbers get high minus
        Mtext             ⍝ The memory starts with the numbers in the text
        pc0                ⍝ Program counter starts at PC
        
instr:  (A B C)3pcM        ⍝ Read instruction
        M'(1+A⌈B⌈C⌈⍴M)↑M'⎕EA'M⊣M[A,B,C]' ⍝ Extend the array if necessary
        pcpc+3               ⍝ PC is incremented by 3
        (A=¯1)/in            ⍝ If A=-1, read input
        (B=¯1)/out           ⍝ If B=-1, write output
        (0<M[B]M[B]-M[A])/instr   ⍝ Do SUBLEQ instruction
        pcC                  ⍝ Set PC if necessary
        (C0)×instr          ⍝ Next instruction if C≥0
        
in:     X(M[B]1⎕FIO[41]1)⎕FIO[42]1  instr
out:    XM[A]⎕FIO[42]1  instr
        
usage:  'subleq.apl <file> - Run the SUBLEQ program in <file>'  0
filerr: 'Error loading: ',fn  0


Subleq
)OFF


ARM Assembly

	@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
	@@@	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	=	.
Output:
$ 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!

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
Output:
Hello, world!

AWK

# syntax: GAWK -f SUBLEQ.AWK SUBLEQ.TXT
# converted from Java
BEGIN {
    instruction_pointer = 0
}
{   printf("%s\n",$0)
    for (i=1; i<=NF; i++) {
      if ($i == "*") {
        ncomments++
        break
      }
      mem[instruction_pointer++] = $i
    }
}
END {
    if (instruction_pointer == 0) {
      print("error: nothing to run")
      exit(1)
    }
    printf("input: %d records, %d instructions, %d comments\n\n",NR,instruction_pointer,ncomments)
    instruction_pointer = 0
    do {
      a = mem[instruction_pointer]
      b = mem[instruction_pointer+1]
      if (a == -1) {
        getline <"con"
        mem[b] = $1
      }
      else if (b == -1) {
        printf("%c",mem[a])
      }
      else {
        mem[b] -= mem[a]
        if (mem[b] < 1) {
          instruction_pointer = mem[instruction_pointer+2]
          continue
        }
      }
      instruction_pointer += 3
    } while (instruction_pointer >= 0)
    exit(0)
}
Output:
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 * Hello, world!
10 0
input: 3 records, 32 instructions, 1 comments

Hello, world!

BASIC

Works with: GW-BASIC
Works with: QBasic
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
Output:
Filename? HELLO.SUB
Hello, world!

BASIC256

Translation of: FreeBASIC
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

FreeBASIC

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
Output:
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!

Gambas

Translation of: FreeBASIC
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

GW-BASIC

The BASIC solution works without any changes.

QBasic

The BASIC solution works without any changes.

Yabasic

Translation of: FreeBASIC
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

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.

REM >subleq
DIM memory%(255)
counter% = 0
INPUT "SUBLEQ> " program$
WHILE INSTR(program$, " ")
    memory%(counter%) = VAL(LEFT$(program$, INSTR(program$, " ") - 1))
    program$ = MID$(program$, INSTR(program$, " ") + 1)
    counter% += 1
ENDWHILE
memory%(counter%) = VAL(program$)
counter% = 0
REPEAT
    a% = memory%(counter%)
    b% = memory%(counter% + 1)
    c% = memory%(counter% + 2)
    counter% += 3
    IF a% = -1 THEN
        INPUT "SUBLEQ> " character$
        memory%(b%) = ASC(character$)
    ELSE
        IF b% = -1 THEN
            PRINT CHR$(memory%(a%));
        ELSE
            memory%(b%) = memory%(b%) - memory%(a%)
            IF memory%(b%) <= 0 THEN counter% = c%
        ENDIF
    ENDIF
UNTIL counter% < 0

Output:

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!

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)
    $)
$)
Output:
Filename? hello.sub
Hello, world!

Befunge

The Subleq source is read from stdin, terminated by any control character - typically a carriage return or line feed, but a tab will also suffice. Thereafter any input read from stdin is considered input to the program itself.

The word size is limited to the cell size of the Befunge playfield, so it can be as low as 8 bits in many interpreters. The code automatically adjusts for unsigned implementations, though, so negative values will always be supported.

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).

01-00p00g:0`*2/00p010p0>$~>:4v4:-1g02p+5/"P"\%"P":p01+1:g01+g00*p02+1_v#!`"/":<
\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
Output:
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!

BQN

Since Subleq programs can potentially run forever, this program prints each character with a newline.

# Helpers
_while_  {𝔽𝔾𝔽_𝕣_𝔾𝔽𝔾𝕩}
ToNum  {neg  '-'=⊑𝕩  (¯1neg)×10×+˜´·⌽-'0'neg𝕩}

Subleq  {
  𝕊 memory:
  {
    𝕊 ipmem:
    {
      ¯1b·: ip+3, (@-˜•term.CharB@)(b) mem;
      a¯1·: •Out @+amem, ip+3, mem;
      abc : d  b-(mem)a, (0<d)c, ip+3⟩, d(b) mem
    } mem˜ip+↕3
  }  _while_ {𝕊 ipmem: ip0} 0memory
}

Subleq ToNum¨•args
$ 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
!

C

Takes the subleq instruction file as input, prints out usage on incorrect invocation.

#include <stdlib.h>
#include <stdio.h>

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;
		}
		ip = nextIP;
	}
}

void
processFile(char *fileName)
{
	int *dataSet, i, num;
	FILE *fp = fopen(fileName, "r");
	fscanf(fp, "%d", &num);
	dataSet = (int *)malloc(num * sizeof(int));
	for(i = 0; i < num; i++)
		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;
}

Input file (subleqCode.txt), first row contains the number of code points ( integers in 2nd row):

32
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

Invocation and output:

C:\rosettaCode>subleq.exe subleqCode.txt
Hello, world!

C#

Translation of: Java
using System;

namespace Subleq {
    class Program {
        static void Main(string[] args) {
            int[] 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,
            };

            int instructionPointer = 0;

            do {
                int a = mem[instructionPointer];
                int b = mem[instructionPointer + 1];

                if (a == -1) {
                    mem[b] = Console.Read();
                }
                else if (b == -1) {
                    Console.Write((char)mem[a]);
                }
                else {
                    mem[b] -= mem[a];
                    if (mem[b] < 1) {
                        instructionPointer = mem[instructionPointer + 2];
                        continue;
                    }
                }

                instructionPointer += 3;
            } while (instructionPointer >= 0);
        }
    }
}
Output:
Hello, world!

C++

#include <fstream>
#include <iostream>
#include <iterator>
#include <vector>

class subleq {
public:
    void load_and_run( std::string file ) {
        std::ifstream f( file.c_str(), std::ios_base::in );
        std::istream_iterator<int> i_v, i_f( f );
        std::copy( i_f, i_v, std::back_inserter( memory ) );
        f.close();
        run();
    }

private:
    void run() {
        int pc = 0, next, a, b, c;
        char z;
        do {
            next = pc + 3;
            a = memory[pc]; b = memory[pc + 1]; c = memory[pc + 2];
            if( a == -1 ) {
                std::cin >> z; memory[b] = static_cast<int>( z );
            } else if( b == -1 ) {
                std::cout << static_cast<char>( memory[a] );
            } else {
                memory[b] -= memory[a];
                if( memory[b] <= 0 ) next = c;
            }
            pc = next;
        } while( pc >= 0 );
    }

    std::vector<int> memory;
};

int main( int argc, char* argv[] ) {
    subleq s;
    if( argc > 1 ) {
        s.load_and_run( argv[1] );
    } else {
        std::cout << "usage: subleq <filename>\n";
    }
    return 0;
}
Output:
subleq test.txt
Hello, world!

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
Output:
$ 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!

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.

identification division.
program-id. subleq-program.
data division.
working-storage section.
01  subleq-source-code.
    05 source-string                      pic x(2000).
01  subleq-virtual-machine.
    05 memory-table.
        10 memory                         pic s9999
            occurs 500 times.
    05 a                                  pic s9999.
    05 b                                  pic s9999.
    05 c                                  pic s9999.
    05 instruction-pointer                pic s9999.
    05 input-output-character             pic x.
01  working-variables.
    05 loop-counter                       pic 9999.
    05 instruction-counter                pic 9999.
    05 string-pointer                     pic 9999.
    05 adjusted-index-a                   pic 9999.
    05 adjusted-index-b                   pic 9999.
    05 output-character-code              pic 9999.
procedure division.
read-source-paragraph.
    accept source-string from console.
    display 'READING SUBLEQ PROGRAM... ' with no advancing.
    move 1 to string-pointer.
    move 0 to instruction-counter.
    perform split-source-paragraph varying loop-counter from 1 by 1
        until loop-counter is greater than 500
        or string-pointer is greater than 2000.
    display instruction-counter with no advancing.
    display ' WORDS READ.'.
execute-paragraph.
    move 1 to instruction-pointer.
    move 0 to instruction-counter.
    display 'BEGINNING RUN... '.
    display ''.
    perform execute-instruction-paragraph
        until instruction-pointer is negative.
    display ''.
    display 'HALTED AFTER ' instruction-counter ' INSTRUCTIONS.'.
    stop run.
execute-instruction-paragraph.
    add 1 to instruction-counter.
    move memory(instruction-pointer) to a.
    add 1 to instruction-pointer.
    move memory(instruction-pointer) to b.
    add 1 to instruction-pointer.
    move memory(instruction-pointer) to c.
    add 1 to instruction-pointer.
    if a is equal to -1 then perform input-paragraph.
    if b is equal to -1 then perform output-paragraph.
    if a is not equal to -1 and b is not equal to -1
        then perform subtraction-paragraph.
split-source-paragraph.
    unstring source-string delimited by all spaces
        into memory(loop-counter)
        with pointer string-pointer.
    add 1 to instruction-counter.
input-paragraph.
    display '> ' with no advancing.
    accept input-output-character from console.
    add 1 to b giving adjusted-index-b.
    move function ord(input-output-character)
        to memory(adjusted-index-b).
    subtract 1 from memory(adjusted-index-b).
output-paragraph.
    add 1 to a giving adjusted-index-a.
    add 1 to memory(adjusted-index-a) giving output-character-code.
    move function char(output-character-code)
        to input-output-character.
    display input-output-character with no advancing.
subtraction-paragraph.
    add 1 to c.
    add 1 to a giving adjusted-index-a.
    add 1 to b giving adjusted-index-b.
    subtract memory(adjusted-index-a) from memory(adjusted-index-b).
    if memory(adjusted-index-b) is equal to zero
        or memory(adjusted-index-b) is negative
        then move c to instruction-pointer.
Output:
READING SUBLEQ PROGRAM... 0032 WORDS READ.
BEGINNING RUN... 

Hello, world!

HALTED AFTER 0073 INSTRUCTIONS.

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.

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
Output:
Hello, world!

Common Lisp

(defun run (memory)
  (loop for pc = 0 then next-pc
        until (minusp pc)
        for a = (aref memory pc)
        for b = (aref memory (+ pc 1))
        for c = (aref memory (+ pc 2))
        for next-pc = (cond ((minusp a)
                             (setf (aref memory b) (char-code (read-char)))
                             (+ pc 3))
                            ((minusp b)
                             (write-char (code-char (aref memory a)))
                             (+ pc 3))
                            ((plusp (setf (aref memory b)
                                          (- (aref memory b) (aref memory a))))
                             (+ pc 3))
                            (t c))))

(defun main ()
  (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)))
Output:
Hello, world!

D

import std.stdio;

void main() {
    int[] 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
    ];

    int instructionPointer = 0;

    do {
        int a = mem[instructionPointer];
        int b = mem[instructionPointer + 1];

        if (a == -1) {
            int input;
            readf!" %d"(input);
            mem[b] = input;
        } else if (b == -1) {
            write(cast(char) mem[a]);
        } else {
            mem[b] -= mem[a];
            if (mem[b] < 1) {
                instructionPointer = mem[instructionPointer + 2];
                continue;
            }
        }

        instructionPointer += 3;
    } while (instructionPointer >= 0);
}
Output:
Hello, world!

Delphi

Translation of: Java
program SubleqTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  mem: array of Integer;
  instructionPointer: Integer;
  a, b: Integer;

begin
  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];
  instructionPointer := 0;

  repeat
    a := mem[instructionPointer];
    b := mem[instructionPointer + 1];

    if a = -1 then
    begin
      read(mem[b]);
    end
    else if b = -1 then
    begin
      write(ansichar(mem[a]));
    end
    else
    begin
      mem[b] := mem[b] - mem[a];
      if (mem[b] < 1) then
      begin
        instructionPointer := mem[instructionPointer + 2];
        Continue;
      end;
    end;
    inc(instructionPointer, 3);
  until (instructionPointer >= length(mem)) or (instructionPointer < 0);
  readln;
end.

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
Output:
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!

EasyLang

Translation of: FreeBASIC
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


Forth

Note that Forth is stack oriented. Hence, the code is toggled in in reverse.

create M 32 cells allot

: enter refill drop parse-word evaluate ; : M[] cells M + ;
: init M 32 cells bounds ?do i ! 1 cells +loop ;
: b-a+! dup dup cell+ @ M[] swap @ M[] @ negate over +! ;
: c b-a+! @ 1- 0< if 2 cells + @ else swap 3 + then nip ;
: b? dup cell+ @ 0< if @ M[] @ emit 3 + else c then ;
: a? dup @ 0< if cell+ @ M[] enter swap ! 3 + else b? then ;
: subleq cr 0 begin dup 1+ 0> while dup M[] a? repeat drop ;

0 10 33 100 108 114 111 119 32 44 111 108 108 101 72
-1 0 0 15 15 -1 3 16 -1 1 16 -1 -1 17 -1 17 15

init subleq
Output:
init subleq
Hello, world!
 ok

Fortran

There is no protocol for getting the programme into the computer, as with a bootstrap sequence. Pre-emptively reading a sequence of numbers into a MEM array would do, and Fortran offers a free-format input option that would do it easily, except, there is no provision for knowing the number of values to read before they are read. A READ (IN,*) MEM(1:N) or similar would read input until values for all N elements had been found, reading additional records as required, and strike end-of-file if there were not enough supplied. One could then rewind the file and try again with a different value of N in a variant of a binary search, but this would be grotesque. This is why a common style is READ(IN,*) N,A(1:N) The alternative would be to read each record of the input file into a text variable, then scan the text and extract numbers as encountered until end-of-file or some suitable indication is reached. This is good, but, how long a record must the text variable allow for? More annoyance! A lot of infrastructure detracting from the prime task, so, a pre-emptive set of values for an array INITIAL, as per the example.

Fortran arrays start with element one. Other languages require a start of zero. Whichever is selected, some parts of a formula may naturally start with zero and others start with one and there is no escape. When translating formulae into furrytran, this can mean a change of interpretation of certain parts of the formulae, or, the introduction of an offset so that wherever a formula calls for A(i), you code A(i + 1) and so forth. It is also possible to play tricks via the likes of EQUIVALENCE (A(1),A1(2)) where array A1 has elements one to a hundred, and so array A indexes these same elements as zero to ninety-nine. This of course will only work if array bound checking is not strict, which was usual because most early fortran compilers only provided bound checking as a special feature to be asked for politely. Another ploy would be to devise FUNCTION A(I) in place of an array A, and then one could employ whatever indexing one desired to read a value. Languages such as Pascal preclude this, because although A(i) is a function, an array must have A[i]. Alas, Fortran does not support palindromic function usage, (as with SUBSTR in pl/i) so although one can have N = DAYNUM(Year,Month,Day) the reverse function can't be coded as DAYNUM(Year,Month,Day) = N, a pity.

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.

      PROGRAM SUBLEQ0	!Simulates a One-Instruction computer, with Subtract and Branch if <= 0.
      INTEGER LOTS,LOAD		!Document some bounds.
      PARAMETER (LOTS = 36, LOAD = 31)	!Sufficient for the example.
      INTEGER IAR, MEM(0:LOTS)		!The basic storage of a computer. IAR could be in memory too.
      INTEGER ABC(3),A,B,C		!A hardware register. Could use INTEGER*1 for everything...
      EQUIVALENCE (ABC(1),A),(ABC(2),B),(ABC(3),C)	!It has components.
      INTEGER INITIAL(0:LOAD)		!There is no sign of a bootstrap loader sequence!
      DATA INITIAL/15,17,-1,17,-1,-1,16,1,-1,16,3,-1,15,15,0,0,-1,	!These are operations, it so happens.
     1          72,101,108,108,111,44,32,119,111,114,108,100,33,10,0/	!And these happen to be ASCII character code numbers.
Core memory initialisation.
      MEM = -66			!Accessing uninitialised memory is improper. This might cause hiccoughs..
      MEM(0:LOAD) = INITIAL	!No bootstrap!
      IAR = 0			!The Instruction Address Register starts at the start.
Commence execution of the current instruction.
  100 ABC = MEM(IAR:IAR + 2)	!Load the three-word instruction.
      IAR = IAR + 3		!Advance IAR accordingly.
      IF (A .EQ. -1) THEN	!Decode the instruction as per the design.
        WRITE (6,102)			!Supply a prompt, otherwise, obscurity results.
  102   FORMAT (" A number:",$)		!But, that will make a mess of the layout.
        READ (5,*) MEM(B)		!The specified action is to read as a number.
      ELSE IF (B .EQ. -1) THEN	!This is for output.
        WRITE (6,103) CHAR(MEM(A))	!As specified, interpret a number as a character.
  103   FORMAT (A1,$)			!The $, obviously, states: do not end the line and start the next.
      ELSE			!And this is a two-part action.
        MEM(B) = MEM(B) - MEM(A)	!Perform arithmetic.
        IF (MEM(B).LE.0) IAR = C	!And based on the result, maybe a GO TO.
      END IF			!So much for decoding.
      IF (IAR.GE.0) GO TO 100	!Keep at it.
      END	!That was simple.

For simplicity there are no checks on memory bounds or endless looping, nor any trace output. The result is

Hello, world!

And the linefeed (character(10)) had been sent forth, but is not apparent because it just ended the line.

Go

package main

import (
	"io"
	"log"
	"os"
)

func main() {
	var mem = []int{
		15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1,
		//'H', 'e', 'l', 'l', 'o', ' ', 'w', 'o', 'r', 'l', 'd', '!', '\n',
		72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10,
		0,
	}
	for ip := 0; ip >= 0; {
		switch {
		case mem[ip] == -1:
			mem[mem[ip+1]] = readbyte()
		case mem[ip+1] == -1:
			writebyte(mem[mem[ip]])
		default:
			b := mem[ip+1]
			v := mem[b] - mem[mem[ip]]
			mem[b] = v
			if v <= 0 {
				ip = mem[ip+2]
				continue
			}
		}
		ip += 3
	}
}

func readbyte() int {
	var b [1]byte
	if _, err := io.ReadFull(os.Stdin, b[:]); err != nil {
		log.Fatalln("read:", err)
	}
	return int(b[0])
}

func writebyte(b int) {
	if _, err := os.Stdout.Write([]byte{byte(b)}); err != nil {
		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, and provides better handling of index out of range errors is also available.

Haskell

Inspired by the Racket solution.

{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.State
import Data.Char (chr, ord)
import Data.IntMap

subleq = loop 0
    where
      loop ip =
          when (ip >= 0) $
          do m0 <- gets (! ip)
             m1 <- gets (! (ip + 1))
             if m0 < 0
                then do modify . insert m1 ch . ord =<< liftIO getChar
                        loop (ip + 3)
                else if m1 < 0
                        then do liftIO . putChar . chr =<< gets (! m0)
                                loop (ip + 3)
                        else do v <- (-) <$> gets (! m1) <*> gets (! m0)
                                modify $ insert m1 v
                                if v <= 0
                                   then loop =<< gets (! (ip + 2))
                                   else loop (ip + 3)

main = evalStateT subleq helloWorld
    where
      helloWorld =
          fromList $
          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]

J

readchar=:3 :0
  if.0=#INBUF do. INBUF=:LF,~1!:1]1 end.
  r=.3 u:{.INBUF
  INBUF=:}.INBUF
  r
)

writechar=:3 :0
  OUTBUF=:OUTBUF,u:y
)

subleq=:3 :0
  INBUF=:OUTBUF=:''
  p=.0
  whilst.0<:p do.
    'A B C'=. (p+0 1 2){y
    p=.p+3
    if._1=A do. y=. (readchar'') B} y
    elseif._1=B do. writechar A{y
    elseif. 1   do.
      t=. (B{y)-A{y
      y=. t B}y
      if. 0>:t do.p=.C end.
    end.
  end.
  OUTBUF
)

Example:

   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!

Janet

(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))))))))
Output:
$ janet subleq.janet hello.sq
Hello, world!

Java

import java.util.Scanner;

public class Subleq {

    public static void main(String[] args) {
        int[] 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};

        Scanner input = new Scanner(System.in);
        int instructionPointer = 0;

        do {
            int a = mem[instructionPointer];
            int b = mem[instructionPointer + 1];

            if (a == -1) {
                mem[b] = input.nextInt();

            } else if (b == -1) {
                System.out.printf("%c", (char) mem[a]);

            } else {

                mem[b] -= mem[a];
                if (mem[b] < 1) {
                    instructionPointer = mem[instructionPointer + 2];
                    continue;
                }
            }

            instructionPointer += 3;

        } while (instructionPointer >= 0);
    }
}
Hello, world!

jq

Works with: jq version 1.4

The subleq function defined here emulates the subleq OSIC; it produces a stream of characters.

The program as presented here can be used with jq 1.4, but to see the stream of characters it produces as a stream of strings requires either a more recent version of jq or some post-processing. The output shown below assumes the -j (--join-output) command-line option is available.

# If your jq has while/2 then the following definition can be omitted:
def while(cond; update):
  def _while: if cond then ., (update | _while) else empty end;
  _while;

# subleq(a) runs the program, a, an array of integers.
# Input: the data
# When the subleq OSIC is about to emit a NUL character, it stops instead.
def subleq(a):
  . as $input
  # state: [i, indexIntoInput, a, output]
  | [0, 0, a]
  | while( .[0] >= 0 and .[3] != 0 ;
           .[0] as $i
           | .[1] as $ix
           | .[2] as $a
           | if $a[$i] == -1 then
                if $input and $ix < ($input|length)
                then [$i+3, $ix + 1, ($a[$a[$i + 1]] = $input[$ix]), null]
                else [-1]
                end
              elif $a[$i + 1] == -1 then [$i+3, $ix, $a, $a[$a[$i]]]
              else
                [$i, $ix, ($a | .[.[$i + 1]] -= .[.[$i]]), null]
                | .[2] as $a
                | if $a[$a[$i+1]] <= 0 then .[0] = $a[$i + 2] else . end
                | .[0] += 3
              end )
  | .[3] | select(.) | [.] | implode;

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])
Output:
$ jq -r -j -n -f subleq.jq 
Hello, world!

Julia

Translation of: Kotlin

Module:

module Subleq
 
using OffsetArrays 

function interpret(allwords::AbstractVector{Int})
    words = OffsetArray(allwords, -1)
    buf = IOBuffer()
    ip = 0
    while true
        a, b, c = words[ip:ip+2]
        ip += 3
        if a < 0
            print("Enter a character: ")
            words[b] = parse(Int, readline(stdin))
        elseif b < 0
            print(buf, Char(words[a]))
        else
            words[b] -= words[a]
            if words[b]  0
                ip = c
            end
            ip < 0 && break
        end
    end
    return String(take!(buf))
end
 
interpret(src::AbstractString) = interpret(parse.(Int, split(src)))
 
end  # module Subleq

Main:

using .Subleq

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"))
Output:
Hello, world!

Kotlin

// version 1.1.2

fun subleq(program: String) {
    val words = program.split(' ').map { it.toInt() }.toTypedArray()
    val sb = StringBuilder()
    var ip = 0
    while (true) {
        val a = words[ip]
        val b = words[ip + 1]
        var c = words[ip + 2]
        ip += 3
        if (a < 0) {
            print("Enter a character : ")
            words[b] = readLine()!![0].toInt()
        }
        else if (b < 0) { 
            sb.append(words[a].toChar())
        }
        else {
            words[b] -= words[a]
            if (words[b] <= 0) ip = c 
            if (ip < 0) break                
        }
    }
    print(sb) 
}

fun main(args: Array<String>) {
    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)
}
Output:
Hello, world!

make "memory (array 32 0)

to load_subleq
  local "i make "i 0
  local "line
  make "line readlist
  while [or (not empty? :line) (not list? :line)] [
    foreach :line [
        setitem :i :memory ?
        make "i sum :i 1
    ]
    make "line readlist
  ]
end

to run_subleq
  make "ip 0
  while [greaterequal? :ip 0] [
    local "a make "a item :ip :memory
    make "ip sum :ip 1
    local "b make "b item :ip :memory
    make "ip sum :ip 1
    local "c make "c item :ip :memory
    make "ip sum :ip 1
    cond [
     [[less? :a 0]  setitem :b :memory ascii readchar ]
     [[less? :b 0]  type char item :a :memory ]
     [else 
        local "av make "av item :a :memory
        local "bv make "bv item :b :memory
        local "diff make "diff difference :bv :av
        setitem :b :memory :diff
        if [lessequal? :diff 0] [make "ip :c]]]
    ]
end

load_subleq
run_subleq
bye
Output:
logo subleq.lg
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
^D
Hello, world!

Lua

function subleq (prog)
    local mem, p, A, B, C = {}, 0
    for word in prog:gmatch("%S+") do
        mem[p] = tonumber(word)
        p = p + 1
    end
    p = 0
    repeat
        A, B, C = mem[p], mem[p + 1], mem[p + 2]
        if A == -1 then
            mem[B] = io.read()
        elseif B == -1 then
            io.write(string.char(mem[A]))
        else
            mem[B] = mem[B] - mem[A]
            if mem[B] <= 0 then p = C end
        end
        p = p + 3
    until not mem[mem[p]]
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")

Mathematica / Wolfram Language

Translation of: R
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;
 ]
Output:
H
e
l
l
o
,
w
o
r
l
d
!


MiniScript

memory = []
step = 3
currentAddress = 0
out = ""

process = function(address)
    A = memory[address].val
    B = memory[address + 1].val
    C = memory[address + 2].val
    nextAddress = address + step
    
    if A == -1 then
        memory[B] = input
    else if B == -1 then
        globals.out = globals.out + char(memory[A].val)
    else
        memory[B] = str(memory[B].val - memory[A].val)
        if memory[B] < 1 then nextAddress = C
    end if
    return nextAddress
end function

print
memory = input("Enter SUBLEQ program").split

print
print "Running Program"
print "-------------------"
processing = currentAddress < memory.len
while processing
    currentAddress = process(currentAddress)
    if currentAddress >= memory.len or currentAddress == -1 then
        processing = false
    end if
end while

print out
print "-------------------"
print "Execution Complete"
Output:
Enter 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

Running Program
-------------------
Hello, world!

-------------------
Execution Complete

Modula-2

MODULE Subleq;
FROM Terminal IMPORT Write,WriteString,WriteLn,ReadChar;

TYPE MEMORY = ARRAY[0..31] OF INTEGER;
VAR
    mem : MEMORY;
    ip,a,b : INTEGER;
    ch : CHAR;
BEGIN
    mem := 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
    };

    ip := 0;
    REPEAT
        a := mem[ip];
        b := mem[ip+1];

        IF a = -1 THEN
            ch := ReadChar();
            mem[b] := ORD(ch);
        ELSIF b = -1 THEN
            Write(CHR(mem[a]));
        ELSE
            DEC(mem[b],mem[a]);
            IF mem[b] < 1 THEN
                ip := mem[ip+2];
                CONTINUE
            END
        END;

        INC(ip,3)
    UNTIL ip < 0;
    WriteLn;

    ReadChar
END Subleq.

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
Output:
Hello, world!

Objeck

Translation of: Java
use System.IO;

class Sublet {
  function : Main(args : String[]) ~ Nil {
    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];
 
    instructionPointer := 0;

    do {
      a := mem[instructionPointer];
      b := mem[instructionPointer + 1];

      if (a = -1) {
        mem[b] := Console->ReadString()->Get(0);
        instructionPointer += 3;
      }
      else if (b = -1) {
        value := mem[a]->As(Char);
        value->Print();
        instructionPointer += 3;
      }
      else {
        mem[b] -= mem[a];
        if (mem[b] < 1) {
          instructionPointer := mem[instructionPointer + 2];
        }
        else {
          instructionPointer += 3;
        };
      };
    } 
    while (instructionPointer >= 0);
  }
}
Hello, world!

Oforth

: subleq(program)
| ip a b c newb |
   program asListBuffer ->program
   0 ->ip
   while( ip 0 >= ) [
      ip 1+ dup program at ->a 1+ dup program at ->b 1+ program at ->c
      ip 3 + ->ip
      a -1 = ifTrue: [ b System.In >> nip program put continue ]
      b -1 = ifTrue: [ System.Out a 1+ program at <<c drop continue ]
      b 1+ program at a 1+ program at - ->newb
      program put(b 1+, newb)
      newb 0 <= ifTrue: [ c ->ip ]
      ] ;
 
[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

ooRexx

version 1

Translation of: REXX

reformatted and long variable names that suit all Rexxes.

/*REXX program simulates execution of a  One-Instruction Set Computer (OISC). */
Signal on Halt                         /*enable user to halt the simulation.  */
cell.=0                                /*zero-out all of real memory locations*/
ip=0                                   /*initialize ip  (instruction pointer).*/
Parse Arg memory                       /*get optional low memory vals from CL.*/
memory=space(memory)                   /*elide superfluous blanks from string.*/

If memory==''  Then Do
  memory='15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1' /* common start     */
  If 3=='f3'x  Then                    /* EBCDIC                              */
    memory=memory '200 133 147 147 150 107 64 166 150 153 147 132  90  21 0'
  else /* ASCII      H   e   l   l   o   , bla  w   o   r   l   d   ! l/f */
    memory=memory ' 72 101 108 108 111  44 32 119 111 114 108 100  33  10 0'
  End

Do i=0 For words(memory)               /* copy memory to cells                */
  cell.i=word(memory,i+1)
  End

Do Until ip<0                          /* [?]  neg addresses are treated as -1*/
  a=cell(ip)
  b=cell(ip+1)
  c=cell(ip+2)                         /*get values for  A,  B,  and  C.      */
  ip=ip+3                              /*advance the ip (instruction pointer).*/
  Select                               /*choose an instruction state.         */
    When a<0 Then cell.b=charin()            /* read a character from term.   */
    When b<0 Then call charout ,d2c(cell.a)  /* write "    "      to    "     */
    Otherwise Do
      cell.b=cell.b-cell.a             /* put difference ---? loc  B.         */
      If cell.b<=0  Then ip=c          /* if ¬positive, set ip to  C.         */
      End
    End
  End
Exit
cell: Parse arg _
      Return cell._                    /*return the contents of "memory" loc _*/
halt: Say 'REXX program halted by user.'
      Exit 1
Output:
Hello, world!

version 2

Translation of: REXX

Using an array object instead of a stem for cells.
Array indexes must be positive!

/*REXX program simulates execution of a  One-Instruction Set Computer (OISC). */
Signal on Halt                         /*enable user to halt the simulation.  */
cell=.array~new                        /*zero-out all of real memory locations*/
ip=0                                   /*initialize ip  (instruction pointer).*/
Parse Arg memory                       /*get optional low memory vals from CL.*/
memory=space(memory)                   /*elide superfluous blanks from string.*/

if memory==''  then Do
  memory='15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1' /* common start     */
  If 3=="f3"x  then                    /* EBCDIC                              */
    memory=memory '200 133 147 147 150 107 64 166 150 153 147 132  90  21 0'
  else /* ASCII      H   e   l   l   o   , bla  w   o   r   l   d   ! l/f */
    memory=memory ' 72 101 108 108 111  44 32 119 111 114 108 100  33  10 0'
  End

Do i=1 To words(memory)               /* copy memory to cells                */
  cell[i]=word(memory,i)
  End

Do Until ip<0                          /* [?]  neg addresses are treated as -1*/
  a=cell[ip+1]
  b=cell[ip+2]
  c=cell[ip+3]                         /*get values for  A,  B,  and  C.      */
  ip=ip+3                              /*advance the ip (instruction pointer).*/
  Select                               /*choose an instruction state.         */
    When a<0   then cell[b+1]=charin()           /* read a character from term*/
    When b<0   then call charout ,d2c(cell[a+1]) /* write "    "      to    " */
    Otherwise Do
      cell[b+1]-=cell[a+1]             /* put difference ---? loc  B[         */
      If cell[b+1]<=0  Then ip=c       /* if ¬positive, set ip to  C[         */
      End
    End
  End
Exit
halt: Say 'REXX program halted by user.';
      Exit 1

Pascal

Works with: Free Pascal version 1.06
PROGRAM OISC;

CONST
	MAXADDRESS = 1255;

TYPE
	MEMORY = PACKED ARRAY [0 .. MAXADDRESS] OF INTEGER;

VAR
	MEM : MEMORY;
	FILENAME : STRING;

PROCEDURE LOADTEXT (FILENAME : STRING; VAR MEM : MEMORY);
	VAR
		NUMBERS : TEXT;
		ADDRESS : INTEGER;
	BEGIN
		ASSIGN (NUMBERS, FILENAME);
		ADDRESS := 0;
		RESET (NUMBERS);
		WHILE (ADDRESS <= MAXADDRESS) AND NOT EOF (NUMBERS) DO BEGIN
			READ (NUMBERS, MEM [ADDRESS]);
			ADDRESS := ADDRESS + 1
		END;
		CLOSE (NUMBERS);
		FOR ADDRESS := ADDRESS TO MAXADDRESS DO
			MEM [ADDRESS] := 0
	END;

PROCEDURE SUBLEQ (VAR MEM : MEMORY);
	VAR
		ADDRESS, A, B, C : INTEGER;
		IO : CHAR;
	BEGIN
		ADDRESS := 0;
		WHILE ADDRESS >= 0 DO BEGIN
			A := MEM [ADDRESS];
			B := MEM [ADDRESS + 1];
			C := MEM [ADDRESS + 2];
			ADDRESS := ADDRESS + 3;
			IF A = -1 THEN BEGIN
				READ (IO);
				MEM [B] := ORD (IO)
			END
			ELSE IF B = -1 THEN BEGIN
				IO := CHR (MEM [A]);
				WRITE (IO)
			END
			ELSE BEGIN
				MEM [B] := MEM [B] - MEM [A];
				IF MEM [B] <= 0 THEN ADDRESS := C
			END
		END
	END;

BEGIN
	WRITE ('Filename>');
	READLN (FILENAME);
	LOADTEXT (FILENAME, MEM);
	SUBLEQ (MEM);
END.
Input:

hello-world.txt

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
Output:
Filename>hello-world.txt
Hello, world!

Perl

#!/usr/bin/env perl
use strict;
use warnings;
my $file = shift;
my @memory = ();
open (my $fh, $file);
while (<$fh>) {
  chomp;
  push @memory, split;
}
close($fh);
my $ip = 0;
while ($ip >= 0 && $ip < @memory) {
  my ($a, $b, $c) = @memory[$ip,$ip+1,$ip+2];
 $ip += 3;
 if ($a < 0) {
    $memory[$b] = ord(getc);
 } elsif ($b < 0) {
    print chr($memory[$a]);
 } else {
    if (($memory[$b] -= $memory[$a]) <= 0) {
     $ip = $c;
   } 
 }
}
Output:
Hello, world!

Phix

procedure subleq(sequence code)
    integer ip := 0
    while ip>=0 do
        integer {a,b,c} = code[ip+1..ip+3]
        ip += 3
        if a=-1 then
            code[b+1] = iff(platform()=JS?'?':getc(0))
        elsif b=-1 then
            puts(1,code[a+1])
        else
            code[b+1] -= code[a+1]
            if code[b+1]<=0 then
                ip := c
            end if
        end if
    end while
end procedure
 
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})
Output:
Hello, world!

PicoLisp

(de mem (N)
   (nth
      (quote
         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 )
      (inc N) ) )

(for (IP (mem 0)  IP)
   (let (A (pop 'IP)  B (pop 'IP)  C (pop 'IP))
      (cond
         ((lt0 A) (set (mem B) (char)))
         ((lt0 B) (prin (char (car (mem A)))))
         ((le0 (dec (mem B) (car (mem A))))
            (setq IP (mem C)) ) ) ) )

Output:

Hello, world!

PowerShell

Translation of: Python
function Invoke-Subleq ([int[]]$Program)
{
    [int]$ip, [string]$output = $null

    try
    {
        while ($ip -ge 0)
        {
            if ($Program[$ip] -eq -1)
            {
                $Program[$Program[$ip + 1]] = [int](Read-Host -Prompt SUBLEQ)[0]
            }
            elseif ($Program[$ip + 1] -eq -1)
            {
                $output += "$([char]$Program[$Program[$ip]])"
            }
            else
            {
                $Program[$Program[$ip + 1]] -= $Program[$Program[$ip]]

                if ($Program[$Program[$ip + 1]] -le 0)
                {
                    $ip = $Program[$ip + 2]
                    continue
                }
            }

            $ip += 3
        }

        return $output
    }
    catch [IndexOutOfRangeException],[Exception]
    {
        Write-Host "$($Error[0].Exception.Message)" -ForegroundColor Red
    }
}
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
Output:
Hello, world!

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()

Python

import sys

def subleq(a):
    i = 0
    try:
        while i >= 0:
            if a[i] == -1:
                a[a[i + 1]] = ord(sys.stdin.read(1))
            elif a[i + 1] == -1:
                print(chr(a[a[i]]), end="")
            else:
                a[a[i + 1]] -= a[a[i]]
                if a[a[i + 1]] <= 0:
                    i = a[i + 2]
                    continue
            i += 3
    except (ValueError, IndexError, KeyboardInterrupt):
        print("abort")
        print(a)

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])

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 subleq as a string, along with the Subleq code, which is a nest of numbers. getch puts successive characters from the string into the address given by A. When the string is exhausted, getch puts a 0.

In the task program no input is required, so the empty string is passed.

subleq returns the output stream as a string.

  ( 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$
Output:
Hello, world!

R

mem <- c(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)

getFromMemory <- function(addr) { mem[[addr + 1]] } # because first element in mem is mem[[1]] 
setMemory <- function(addr, value) { mem[[addr + 1]] <<- value }
subMemory <- function(x, y) { setMemory(x, getFromMemory(x) - getFromMemory(y)) }

instructionPointer <- 0
while (instructionPointer >= 0) {
  a <- getFromMemory(instructionPointer)
  b <- getFromMemory(instructionPointer + 1)
  c <- getFromMemory(instructionPointer + 2)
  if (b == -1) {
    cat(rawToChar(as.raw(getFromMemory(a))))
  } else {
    subMemory(b, a)
    if (getFromMemory(b) < 1) {
      instructionPointer <- getFromMemory(instructionPointer + 2)
      next
    }
  }
  instructionPointer <- instructionPointer + 3
}
Output:
Hello, world!

Racket

Translation of: Go
The negative addresses are treated as -1.
#lang racket

(define (subleq v)
  (define (mem n)
    (vector-ref v n))
  (define (mem-set! n x)
    (vector-set! v n x))
  (let loop ([ip 0])
    (when (>= ip 0)
      (define m0 (mem ip))
      (define m1 (mem (add1 ip)))
      (cond 
        [(< m0 0) (mem-set! m1 (read-byte))
                  (loop (+ ip 3))]
        [(< m1 0) (write-byte (mem m0))
                  (loop (+ ip 3))]
        [else (define v (- (mem m1) (mem m0)))
              (mem-set! m1 v)
              (if (<= v 0)
                 (loop (mem (+ ip 2)))
                 (loop (+ ip 3)))]))))

(define Hello (vector 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1
                    ; H    e    l    l    o    ,  <sp> w    o    r    l    d    !   \n
                      72   101  108  108  111  44  32  119  111  114  108  100  33  10
                      0))

(subleq Hello)
Output:
Hello, world!

Raku

(formerly Perl 6)

Translation of: Perl
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);

sub run-subleq(@memory) {
  my $ip = 0;
  while $ip >= 0 && $ip < @memory {
    my ($a, $b, $c) = @memory[$ip..*];
    $ip += 3;
    if $a < 0 {
      @memory[$b] = getc.ord;
    } elsif $b < 0 {
      print @memory[$a].chr;
    } else {
      if (@memory[$b] -= @memory[$a]) <= 0 {
        $ip = $c;
      } 
    }
  }
}

run-subleq @hello-world;
Output:
Hello, world!

REXX

The REXX version supports   ASCII   and   EBCDIC   integer (glyphs)   for the message text.

The REXX language has no concept of a   word,   but for storing numbers, the default is nine decimal digits.

/*REXX program  simulates  the  execution  of a   One─Instruction Set Computer  (OISC). */
signal on halt                                   /*enable user to  halt  the simulation.*/
parse arg $                                      /*get optional low memory vals from CL.*/
$$= '15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1'  /*common stuff for EBCDIC & ASCII.*/
    /*EBCDIC "then" choice [↓]       H   e   l   l   o  , BLANK w   o   r   l   d  !  LF*/
if $='' then if 6=="f6"x  then $=$$ 200 133 147 147 150 107 64 166 150 153 147 132 90 21 0
                          else $=$$  72 101 108 108 111  44 32 119 111 114 108 100 33 10 0
                        /* [↑]  ASCII   (the "else" choice).                Line Feed≡LF*/
@.= 0                                            /*zero all memory & instruction pointer*/
         do j=0  for words($);  @.j=word($,j+1)  /*assign memory.  OISC is zero─indexed.*/
         end   /*j*/                             /*obtain A, B, C memory values──►────┐ */
    do #=0  by 3 until #<0;     a= @(#-3);    b= @(#-2);     c= @(#-1)   /* ◄─────────┘ */
        select                                   /*choose an instruction state.         */
        when a<0  then @.b= charin()             /*  read a character from the terminal.*/
        when b<0  then call charout , d2c(@.a)   /* write "     "      to   "     "     */
        otherwise      @.b= @.b - @.a            /*put difference  ────►  location  B.  */
                    if @.b<=0  then #= c         /*Not positive?   Then set  #  to  C.  */
        end   /*select*/                         /* [↑]  choose one of two states.      */
    end       /*#*/                              /*leave the DO loop if  #  is negative.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:     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
output   when using the default input:
Hello, world!

RPL

Works with: HP version 48G
« 'Ram' DUP ROT ←ptr + GET 1 + GET
» 'PEEKind' STO    @ ( n → Ram[Ram[←ptr + n]] )

« 0 "" → ←ptr stdout
  « { } + RDM 'Ram' STO
    WHILE ←ptr 0 ≥ REPEAT
       CASE
          'Ram' ←ptr 1 + GET -1 == THEN
             'Ram' 2 PEEKind DO UNTIL KEY END PUT END
          'Ram' ←ptr 2 + GET -1 == THEN
             'stdout' 1 PEEKind CHR STO+ END
          2 PEEKind 1 PEEKind -
          '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
» » 'SUBLEQ' STO    @ ( [ program ] mem_size → stdout ] )
[ 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 SUBLEQ
Output:
1: "Hello, world!
"

Ruby

class Computer
  def initialize program
    @memory = program.map &:to_i
    @instruction_pointer = 0
  end

  def step
    return nil if @instruction_pointer < 0

    a, b, c = @memory[@instruction_pointer .. @instruction_pointer + 2]
    @instruction_pointer += 3

    if a == -1
      b = readchar
    elsif b == -1
      writechar @memory[a]
    else
      difference = @memory[b] -= @memory[a]
      @instruction_pointer = c if difference <= 0
    end

    @instruction_pointer
  end

  def run
    current_pointer = @instruction_pointer
    current_pointer = step while current_pointer >= 0
  end

  private

  def readchar
    gets[0].ord
  end

  def writechar code_point
    print code_point.chr
  end
end

subleq = Computer.new ARGV

subleq.run

Sample usage:

>ruby subleq.rb 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!

Scala

Imperative, Javaish, destructible opcodes read

import java.util.Scanner

object Subleq extends App {
  val mem = Array(15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1,
    'H', 'e', 'l', 'l', 'o', ',', ' ', 'w', 'o', 'r', 'l', 'd', '!', 10, 0)
  val input = new Scanner(System.in)
  var instructionPointer = 0

  do {
    val (a, b) = (mem(instructionPointer), mem(instructionPointer + 1))
    if (a == -1) mem(b) = input.nextInt
    else if (b == -1) print(f"${mem(a)}%c")
    else {
      mem(b) -= mem(a)
      if (mem(b) < 1) instructionPointer = mem(instructionPointer + 2) - 3
    }
    instructionPointer += 3
  } while (instructionPointer >= 0)
}
Output:
See it running in your browser by Scastie (JVM).

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;
Output:
$ 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!

Sidef

Translation of: Raku
var memory = ARGV.map{.to_i};
var ip = 0;

while (ip.ge(0) && ip.lt(memory.len)) {
    var (a, b, c) = memory[ip, ip+1, ip+2];
    ip += 3;
    if (a < 0) {
        memory[b] = STDIN.getc.ord;
    }
    elsif (b < 0) {
        print memory[a].chr;
    }
    elsif ((memory[b] -= memory[a]) <= 0) {
        ip = c
    }
}
Output:
$ sidef subleq.sf 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!

Sinclair ZX81 BASIC

Translation of: ZX Spectrum Basic

The ZX81's character set does not include lower-case letters or the ! character. It also happens to use 0 as the code for a blank, making zero-terminated strings awkward; this program gets around the difficulty by the stupid trick of always storing +1 instead of where is a printable character code.

Requires at least 2k of RAM.

 10 DIM M(32)
 20 INPUT P$
 30 LET W=1
 40 LET C=1
 50 IF C<LEN P$ THEN GOTO 80
 60 LET M(W)=VAL P$
 70 GOTO 150
 80 IF P$(C)=" " THEN GOTO 110
 90 LET C=C+1
100 GOTO 50
110 LET M(W)=VAL P$( TO C-1)
120 LET P$=P$(C+1 TO )
130 LET W=W+1
140 GOTO 40
150 LET P=0
160 LET A=M(P+1)
170 LET B=M(P+2)
180 LET C=M(P+3)
190 LET P=P+3
200 IF A=-1 THEN GOTO 260
210 IF B=-1 THEN GOTO 290
220 LET M(B+1)=M(B+1)-M(A+1)
230 IF M(B+1)<=0 THEN LET P=C
240 IF P<0 THEN STOP
250 GOTO 160
260 INPUT C$
270 LET M(B+1)=1+CODE C$
280 GOTO 160
290 IF M(A+1)<>118 THEN GOTO 320
300 PRINT
310 GOTO 160
320 PRINT CHR$ (M(A+1)-1);
330 GOTO 160
Input:
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
Output:
HELLO, WORLD.

SNOBOL4

All "addresses" get 1 added to them before being used as array indexes.

        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
Output:
Hello, world!

Swift

Translation of: Python
func subleq(_ inst: inout [Int]) {
  var i = 0
  
  while i >= 0 {
    if inst[i] == -1 {
      inst[inst[i + 1]] = Int(readLine(strippingNewline: true)!.unicodeScalars.first!.value)
    } else if inst[i + 1] == -1 {
      print(String(UnicodeScalar(inst[inst[i]])!), terminator: "")
    } else {
      inst[inst[i + 1]] -= inst[inst[i]]
      
      if inst[inst[i + 1]] <= 0 {
        i = inst[i + 2]
        continue
      }
    }
    
    i += 3
  }
}

var 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
]

subleq(&prog)
Output:
Hello, world!

Tcl

namespace import ::tcl::mathop::-

proc subleq {pgm} {
    set ip 0
    while {$ip >= 0} {
        lassign [lrange $pgm $ip $ip+2] a b c
        incr ip 3
        if {$a == -1} {
            scan [read stdin 1] %C char
            lset pgm $b $char
        } elseif {$b == -1} {
            set char [format %c [lindex $pgm $a]]
            puts -nonewline $char
        } else {
            lset pgm $b [set res [- [lindex $pgm $b] [lindex $pgm $a]]]
            if {$res <= 0} {
                set ip $c
            }
        }
    }
}

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}
Output:
Hello, world!

uBasic/4tH

GoSub _Initialize                      ' Initialize memory

i = 0                                  ' Reset instruction pointer

Do While i > -1                        ' While IP is not negative
  A = @(i)                             ' Fill the registers with
  B = @(i+1)                           ' opcodes and operands
  C = @(i+2)

  i = i + 3                            ' Increment instruction counter
                                       ' A<0 = Input, B<0 = Output
  If B < 0 Then Print CHR(@(A)); : Continue
  If A < 0 Then Input "Enter: ";@(B) : Continue
  @(B) = @(B) - @(A) : If @(B) < 1 Then i = C
Loop                                   ' Change memory contents
                                       ' And optionally the IP
End
                                       ' Corresponds to assembler language:
_Initialize                            ' start:
  @(0) = 15                            '   zero, message, -1
  @(1) = 17
  @(2) = -1
  @(3) = 17                            '   message, -1, -1
  @(4) = -1
  @(5) = -1
  @(6) = 16                            '   neg1, start+1, -1
  @(7) = 1
  @(8) = -1
  @(9) = 16                            '   neg1, start+3, -1
  @(10) = 3
  @(11) = -1
  @(12) = 15                           '   zero, zero, start
  @(13) = 15
  @(14) = 0
  @(15) = 0                            ' zero: 0
  @(16) = -1                           ' neg1: -1
  @(17) = 72                           ' message: "Hello, world!\n\0"
  @(18) = 101
  @(19) = 108
  @(20) = 108
  @(21) = 111
  @(22) = 44
  @(23) = 32
  @(24) = 119
  @(25) = 111
  @(26) = 114
  @(27) = 108
  @(28) = 100
  @(29) = 33                           ' Works only with ASCII
  @(30) = 10                           ' Replace with =ORD(c) when required
  @(31) = 0
Return
Output:
Hello, world!

0 OK, 0:2010

UNIX Shell

dash

#!/bin/sh

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 "

i=0
for v in $mem
do
  eval 'mem_'$i=$v
  i=$(( $i + 1 ))
done

get_m () {
  eval echo '$mem_'$1
}
set_m () {
  eval 'mem_'$1=$2
}

ADDR=0
STEP=0

while [ ${STEP} -lt 9999 ]
do
  STEP=$(( $STEP + 1 ))
  A=$(get_m $ADDR)
  B=$(get_m $(($ADDR + 1)) )
  C=$(get_m $(($ADDR + 2)) )
  ADDR=$((ADDR + 3))
  if [ $B -lt 0 ]; then
    get_m $A |  awk '{printf "%c",$1}'
  else
    set_m $B $(( $(get_m $B) - $(get_m $A) ))
    if [ $(get_m $B) -le 0 ]; then
      if [ $C -eq -1 ]; then
        echo "Total step:"$STEP
        exit 0
      fi
      ADDR=$C
    fi
  fi
done
echo "Total step:"$STEP

bash

#!/usr/bin/env 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)

addr=0
step=0

while (( addr >= 0 )); do
  (( step++ ))
  a=${mem[addr]}
  b=${mem[addr + 1]}
  c=${mem[addr + 2]}
  (( addr += 3 ))
  if (( b < 0 )); then
     printf '%b' '\x'$(printf '%x' ${mem[a]})
  else
    if (( (mem[b] -= mem[a]) <= 0 )); then
      addr=$c
    fi
  fi
done
printf 'Total step:%d\n' "$step"

Wren

Translation of: Kotlin
import "io" for Stdin, Stdout

var subleq = Fn.new { |program|
    var words = program.split(" ").map { |w| Num.fromString(w) }.toList
    var sb = ""
    var ip = 0
    while (true) {
        var a = words[ip]
        var b = words[ip+1]
        var c = words[ip+2]
        ip = ip + 3
        if (a < 0) {
            System.write("Enter a character : ")
            Stdout.flush()
            words[b] = Num.fromString(Stdin.readLine()[0])
        } else if (b < 0) {
            sb = sb + String.fromByte(words[a])
        } else {
            words[b] = words[b] - words[a]
            if (words[b] <= 0) ip = c
            if (ip < 0) break
        }
    }
    System.write(sb)
}

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)
Output:
Hello, world!

XPL0

Translation of: ALGOL W
\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
Output:
Hello, world!

zkl

Translation of: Python
fcn subleq(a,a1,a2,etc){ a=vm.arglist.copy();
   i:=0;
   while(i>=0){ A,B,C:=a[i,3];
      if(A==-1) a[B]=ask("::").toInt(); // or File.stdin.read(1)[0] // int
      else if(B==-1) print(a[A].toChar());
      else if( (a[B]-=a[A]) <=0) { i=C; 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);
Output:
Hello, world!

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 ? rather than as a newline character) are hidden from the Subleq programmer. Lines 10 to 140 are the machine code loader, lines 150 to 310 the VM.

 10 DIM m(512)
 20 INPUT p$
 30 LET word=1
 40 LET char=1
 50 IF char<LEN p$ THEN GO TO 80
 60 LET m(word)=VAL p$
 70 GO TO 150
 80 IF p$(char)=" " THEN GO TO 110
 90 LET char=char+1
100 GO TO 50
110 LET m(word)=VAL p$( TO char-1)
120 LET p$=p$(char+1 TO )
130 LET word=word+1
140 GO TO 40
150 LET ptr=0
160 LET a=m(ptr+1)
170 LET b=m(ptr+2)
180 LET c=m(ptr+3)
190 LET ptr=ptr+3
200 IF a=-1 THEN GO TO 260
210 IF b=-1 THEN GO TO 290
220 LET m(b+1)=m(b+1)-m(a+1)
230 IF m(b+1)<=0 THEN LET ptr=c
240 IF ptr<0 THEN STOP
250 GO TO 160
260 INPUT c$
270 LET m(b+1)=CODE c$
280 GO TO 160
290 IF m(a+1)=10 THEN PRINT : GO TO 160
300 PRINT CHR$ m(a+1);
310 GO TO 160
Output:
Hello, world!