Subleq: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
m (→{{header|Wren}}: Changed to Wren S/H) |
|||
| (66 intermediate revisions by 28 users not shown) | |||
Line 5:
;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:
:# Let '''A''' be the value in the memory location identified by the instruction pointer; let '''B''' and '''C''' be the values stored in the next two consecutive addresses in memory.
:# Advance the instruction pointer three words, to point at the address ''after'' the address containing '''C'''.
:# If '''A''' is '''-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.)
:# 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.
:# 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'''.
:# 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.
<pre>15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0</pre>
The above "machine code" corresponds to something like this in a hypothetical assembler language for a signed 8-bit version of the machine:
<pre>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</pre>
<br><br>
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">F subleq(&a)
V i = 0
L i >= 0
I a[i] == -1
a[a[i + 1]] = :stdin.read(1).code
E I a[i + 1] == -1
print(Char(code' a[a[i]]), end' ‘’)
E
a[a[i + 1]] -= a[a[i]]
I a[a[i + 1]] <= 0
i = a[i + 2]
L.continue
i += 3
subleq(&[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72,
101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0])</syntaxhighlight>
{{out}}
<pre>
Hello, world!
</pre>
=={{header|8080 Assembly}}==
<syntaxhighlight lang="8080asm"> ;;; ---------------------------------------------------------------
;;; 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 ' $' </syntaxhighlight>
=={{header|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.
<syntaxhighlight lang="asm"> ;;; -------------------------------------------------------------
;;; 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 $</syntaxhighlight>
=={{header|Ada}}==
<
procedure Subleq is
Line 116 ⟶ 786:
Execute_Program(Memory);
end Subleq;</
<pre>>./subleq
Line 124 ⟶ 794:
=={{header|ALGOL 68}}==
<
# executes the program specified in code, stops when the instruction pointer #
# becomes negative #
Line 171 ⟶ 841:
)
)
</syntaxhighlight>
{{out}}
<pre>
Line 179 ⟶ 849:
=={{header|ALGOL W}}==
{{Trans|Algol 68}}
<
begin
Line 244 ⟶ 914:
end
end.</
{{out}}
<pre>
Hello, world!
</pre>
=={{header|APL}}==
{{works with|GNU APL}}
<syntaxhighlight lang="apl">#!/usr/local/bin/apl -s --
⎕IO←0 ⍝ 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
→(''≢0⍴text←⎕FIO[26]fn)/filerr ⍝ Load the file
text[(text∊⎕TC)/⍳⍴text]←' ' ⍝ Control characters to spaces
text[(text='-')/⍳⍴text]←'¯' ⍝ Negative numbers get high minus
M←⍎text ⍝ The memory starts with the numbers in the text
pc←0 ⍝ Program counter starts at PC
instr: (A B C)←3↑pc↓M ⍝ Read instruction
M←'(1+A⌈B⌈C⌈⍴M)↑M'⎕EA'M⊣M[A,B,C]' ⍝ Extend the array if necessary
pc←pc+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
pc←C ⍝ Set PC if necessary
→(C≥0)×instr ⍝ Next instruction if C≥0
in: X←(M[B]←1⎕FIO[41]1)⎕FIO[42]1 ⋄ →instr
out: X←M[A]⎕FIO[42]1 ⋄ →instr
usage: 'subleq.apl <file> - Run the SUBLEQ program in <file>' ⋄ →0
filerr: 'Error loading: ',fn ⋄ →0
∇
Subleq
)OFF
</syntaxhighlight>
=={{header|ARM Assembly}}==
<syntaxhighlight lang="text"> @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@ ARM SUBLEQ for Linux @@@
@@@ Word size is 32 bits. The program is @@@
@@@ given 8 MB (2 Mwords) to run in. @@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
.text
.global _start
@@@ Linux syscalls
.equ exit, 1
.equ read, 3
.equ write, 4
.equ open, 5
_start: pop {r6} @ Retrieve amount of arguments
cmp r6,#2 @ There should be exactly 2 (incl program)
ldrne r1,=usage @ Otherwise, print usage and stop
bne die
pop {r0,r1} @ Retrieve filename
mov r0,r1
mov r1,#0 @ Try to open the file in read mode
mov r2,#0
mov r7,#open
swi #0
movs r5,r0 @ File handle in R5
ldrmi r1,=efile @ If the file can't be opened, error
bmi die
ldr r8,=prog @ R8 = pointer into program
mov r6,#0 @ At the beginning, there is no data
rdnum: bl fchar @ Skip past whitespace
cmp r0,#32
bls rdnum
mov r9,#0 @ R9 = current number being read
subs r10,r0,#'- @ R10 is zero if number is negative
bleq fchar @ And get next character
1: sub r0,r0,#'0 @ Subtract ASCII 0
cmp r0,#9
ldrhi r1,=echar
bhi die @ Invalid digit = error
mov r1,#10
mla r0,r9,r1,r0 @ Multiply accumulator by 10 and add digit
mov r9,r0
bl fchar @ Get next character
cmp r0,#32 @ If it isn't whitespace...
bhi 1b @ ...then it's the next digit
tst r10,r10 @ If the number should be negative,
rsbeq r9,r9,#0 @ ...then negate it
str r9,[r8],#4 @ Store the number
b rdnum @ And get the next number.
setup: ldr r0,=prog @ Zero out the rest of program memory
sub r0,r8,r0 @ Zero to 8-word (32-byte) boundary
orr r0,r0,#31 @ Find address of last byte within
add r0,r0,r8 @ current 31-byte block
mov r1,#0 @ R1 = zero to write
1: str r1,[r8],#4 @ Write zeroes,
cmp r0,r8 @ until boundary reached.
blo 1b
mov r0,#0 @ 8 words of zeroes in r0-r7
umull r2,r3,r0,r1 @ A trick to produce 2 zero words in one
umull r4,r5,r0,r1 @ go: 0*0 = 0, long multiplication
umull r6,r7,r0,r1 @ results in 2 words.
ldr r9,=mem_end
2: stmia r8!,{r0-r7} @ Write 8 zero words at a time
cmp r8,r9 @ Are we at mem_end yet?
blo 2b @ If not, keep going
ldr r8,=prog @ R8 = IP, starts at beginning
ldr r6,=prog @ R6 = base address for memory
mov r12,#0xFFFF @ 0x1FFFFF = address mask
movt r12,#0x1F
instr: ldmia r8!,{r9-r11} @ R9, R10, R11 = A, B, C
cmp r9,#-1 @ If A=-1, get character
beq rchar
cmp r10,#-1 @ Otherwise, if B=-1, write character
beq wchar
and r9,r9,r12 @ Keep addresses within 2 Mwords
and r10,r10,r12
ldr r0,[r6,r9,lsl #2] @ Grab [A] and [B]
ldr r1,[r6,r10,lsl #2]
subs r1,r1,r0 @ Subtract
str r1,[r6,r10,lsl #2] @ Store back in [B]
cmpmi r0,r0 @ Set zero flag if negative
bne instr @ If result is positive, next instruction
lsls r8,r11,#2 @ Otherwise, C becomes the new IP
add r8,r8,r6
bpl instr @ If result is positive, keep going
mov r0,#0 @ Otherwise, we exit
mov r7,#exit
swi #0
@@@ Read character into [B]
rchar: mov r0,#0 @ STDIN
and r10,r10,r12 @ Address of B
add r10,r6,r10,lsl #2 @ Kept in R10 out of harm's way
mov r1,r10
mov r2,#1 @ Read one character
mov r7,#read
swi #0
cmp r0,#1 @ We should have received 1 byte
movne r1,#-1 @ If not, write -1
ldreqb r1,[r10] @ Otherwise, blank out the top 3 bytes
str r1,[r10]
b instr
@@@ Write character in [A]
wchar: mov r0,#1 @ STDIN
and r1,r9,r12 @ Address of [A]
add r1,r6,r1,lsl #2
mov r2,#1 @ Write one character
mov r7,#write
swi #0
b instr
@@@ Read character from file into R0. Tries to read more
@@@ if the buffer is empty (as given by R6). Buffer in R11.
fchar: tst r6,r6 @ Any bytes in the buffer?
ldrneb r0,[r11],#1 @ If so, return next character from buffer
subne r6,r6,#1
bxne lr
mov r12,lr @ Save link register
mov r0,r5 @ If not, read from file into buffer
ldr r1,=fbuf
mov r2,#0x400000
mov r7,#read
swi #0
movs r6,r0 @ Amount of bytes in r6
beq setup @ If no more bytes, start the program
ldr r11,=fbuf @ Otherwise, R11 = start of buffer
mov lr,r12
b fchar
@@@ Write a zero-terminated string, in [r1], to stdout.
print: push {lr}
mov r2,r1
1: ldrb r0,[r2],#1 @ Get character and advance pointer
tst r0,r0 @ Zero yet?
bne 1b @ If not, keep scanning
sub r2,r2,r1 @ If so, calculate length
mov r0,#1 @ STDOUT
mov r7,#write @ Write to STDOUT
swi #0
pop {pc}
@@@ Print error message in [r1], then end.
die: bl print
mov r0,#255
mov r7,#exit
swi #0
usage: .asciz "Usage: subleq <filename>\n"
efile: .asciz "Cannot open file\n"
echar: .asciz "Invalid number in file\n"
@@@ Memory
.bss
.align 4
prog: .space 0x400000 @ Lower half of program memory
fbuf: .space 0x400000 @ File buffer and top half of program memory
mem_end = .</syntaxhighlight>
{{out}}
<pre>$ cat hello.sub
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
$ ./subleq hello.sub
Hello, world!</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">run: function [prog][
mem: new prog
ip: 0
while [ip >= 0][
A: mem\[ip]
B: mem\[ip+1]
C: mem\[ip+2]
ip: ip + 3
if? A = neg 1 -> mem\[B]: to :integer first input ""
else [
if? B = neg 1 -> prints to :char mem\[A]
else [
mem\[B]: mem\[B] - mem\[A]
if mem\[B] =< 0 -> ip: C
]
]
]
]
test: @[15, 17, neg 1, 17, neg 1, neg 1, 16, 1, neg 1, 16, 3, neg 1, 15, 15, 0, 0, neg 1,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0]
run test</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|AWK}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f SUBLEQ.AWK SUBLEQ.TXT
# converted from Java
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)
}
</syntaxhighlight>
{{out}}
<pre>
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1
72 101 108 108 111 44 32 119 111 114 108 100 33 * Hello, world!
10 0
input: 3 records, 32 instructions, 1 comments
Hello, world!
</pre>
=={{header|BASIC}}==
{{works with|GW-BASIC}}
{{works with|QBasic}}
<syntaxhighlight lang="basic">10 DEFINT A-Z: DIM M(8192)
20 INPUT "Filename";F$
30 OPEN "I",1,F$
40 GOTO 70
50 INPUT #1,M(I)
60 I=I+1
70 IF EOF(1) THEN CLOSE(1) ELSE GOTO 50
80 I=0
90 A=M(I): B=M(I+1): C=M(I+2): I=I+3
100 IF A=-1 GOTO 150 ELSE IF B=-1 GOTO 190
120 M(B) = M(B) - M(A)
130 IF M(B)<=0 THEN I=C
140 IF I>=0 GOTO 90 ELSE END
150 A$ = INPUT$(1): PRINT A$;
160 C = ASC(A$): IF C=13 THEN C=10
170 M(B) = C
180 GOTO 90
190 IF M(A)=10 THEN PRINT ELSE PRINT(CHR$(M(A) AND 255));
200 GOTO 90</syntaxhighlight>
{{out}}
<pre>Filename? HELLO.SUB
Hello, world!</pre>
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
input "SUBLEQ> ", codigo
while instr(codigo, " ")
memoria[contador] = int(left(codigo, instr(codigo, " ") - 1))
codigo = mid(codigo, instr(codigo, " ") + 1, length(codigo))
contador += 1
end while
memoria[contador] = int(codigo)
contador = 0
do
a = memoria[contador]
b = memoria[contador + 1]
c = memoria[contador + 2]
contador += 3
if a = -1 then
input "SUBLEQ> ", caracter
memoria[b] = asc(caracter)
else
if b = -1 then
print chr(memoria[a]);
else
memoria[b] -= memoria[a]
if memoria[b] <= 0 then contador = c
end if
end if
until contador < 0</syntaxhighlight>
==={{header|FreeBASIC}}===
<syntaxhighlight lang="vbnet">
Dim As Integer memoria(255), contador = 0
Dim As String codigo, caracter
Input "SUBLEQ> ", codigo
While Instr(codigo, " ")
memoria(contador) = Val(Left(codigo, Instr(codigo, " ") - 1))
codigo = Mid(codigo, Instr(codigo, " ") + 1)
contador += 1
Wend
memoria(contador) = Val(codigo)
contador = 0
Do
Dim As Integer a = memoria(contador)
Dim As Integer b = memoria(contador + 1)
Dim As Integer c = memoria(contador + 2)
contador += 3
If a = -1 Then
Input "SUBLEQ> ", caracter
memoria(b) = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria(a));
Else
memoria(b) -= memoria(a)
If memoria(b) <= 0 Then contador = c
End If
End If
Loop Until contador < 0
Sleep</syntaxhighlight>
{{out}}
<pre>SUBLEQ> 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!</pre>
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">Public memoria[255] As Integer
Public Sub Main()
Dim contador As Integer = 0
Dim codigo As String, caracter As String
Print "SUBLEQ> ";
Input codigo
While InStr(codigo, " ")
memoria[contador] = Val(Left(codigo, InStr(codigo, " ") - 1))
codigo = Mid(codigo, InStr(codigo, " ") + 1)
contador += 1
Wend
memoria[contador] = Val(codigo)
contador = 0
Do
Dim a As Integer = memoria[contador]
Dim b As Integer = memoria[contador + 1]
Dim c As Integer = memoria[contador + 2]
contador += 3
If a = -1 Then
Print "SUBLEQ> ";
Input caracter
memoria[b] = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria[a]);
Else
memoria[b] -= memoria[a]
If memoria[b] <= 0 Then contador = c
End If
End If
Loop Until contador < 0
End</syntaxhighlight>
==={{header|GW-BASIC}}===
The [[#BASIC|BASIC]] solution works without any changes.
==={{header|QBasic}}===
The [[#BASIC|BASIC]] solution works without any changes.
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
input "SUBLEQ> " codigo$
while instr(codigo$, " ")
memoria(contador) = val(left$(codigo$, instr(codigo$, " ") - 1))
codigo$ = mid$(codigo$,instr(codigo$," ")+1,len(codigo$))
contador = contador + 1
wend
memoria(contador) = val(codigo$)
contador = 0
repeat
a = memoria(contador)
b = memoria(contador+ 1)
c = memoria(contador+ 2)
contador = contador + 3
if a = -1 then
input "SUBLEQ> " caracter$
memoria(b) = asc(caracter$)
else
if b = -1 then
print chr$(memoria(a));
else
memoria(b) = memoria(b) - memoria(a)
if memoria(b) <= 0 contador = c
fi
fi
until contador < 0
end</syntaxhighlight>
=={{header|BBC BASIC}}==
The BBC BASIC implementation reads the machine code program as a string from standard input and stores it in an array of signed 32-bit integers. The default size of the array is 256, but other values could easily be substituted. No attempt is made to handle errors arising from invalid Subleq programs.
<
DIM memory%(255)
counter% = 0
Line 279 ⟶ 1,403:
ENDIF
ENDIF
UNTIL counter% < 0</
Output:
<pre>SUBLEQ> 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!</pre>
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
// Read a string
let reads(v) be
$( let ch = ?
v%0 := 0
ch := rdch()
until ch = '*N' do
$( v%0 := v%0 + 1
v%(v%0) := ch
ch := rdch()
$)
$)
// Try to read a number, fail on EOF
// (Alas, the included READN just returns 0 and that's a valid number)
let readnum(n) = valof
$( let neg, ch = false, ?
!n := 0
$( ch := rdch()
if ch = endstreamch then resultis false
$) repeatuntil ch = '-' | '0' <= ch <= '9'
if ch = '-' then
$( neg := true
ch := rdch()
$)
while '0' <= ch <= '9' do
$( !n := !n * 10 + ch - '0'
ch := rdch()
$)
if neg then !n := -!n
resultis true
$)
// Read SUBLEQ code
let readfile(file, v) = valof
$( let i, oldin = 0, input()
selectinput(file)
while readnum(v+i) do i := i + 1
endread()
selectinput(oldin)
resultis i
$)
// Run SUBLEQ code
let run(v) be
$( let ip = 0
until ip < 0 do
$( let a, b, c = v!ip, v!(ip+1), v!(ip+2)
ip := ip + 3
test a=-1
then v!b := rdch()
else test b=-1
then wrch(v!a)
else
$( v!b := v!b - v!a
if v!b <= 0 then ip := c
$)
$)
$)
let start() be
$( let filename = vec 64
let file = ?
writes("Filename? ")
reads(filename)
file := findinput(filename)
test file = 0 then
writes("Cannot open file.*N")
else
$( let top = maxvec()
let mem = getvec(top)
let progtop = readfile(file, mem)
for i = progtop to top do mem!i := 0
run(mem)
freevec(mem)
$)
$)</syntaxhighlight>
{{out}}
<pre>Filename? hello.sub
Hello, world!</pre>
Line 292 ⟶ 1,500:
Also note that in some buggy interpreters you may need to pad the Befunge playfield with additional blank lines or spaces in order to initialise a writable memory area (without which the Subleq source may fail to load).
<
\0_v#-"-":\1_v#!`\*84:_^#- *8< >\#%"P"/#:5#<+g00g-\1+:"P"%\"P"v>5+#\*#<+"0"-~>^
<~0>#<$#-0#\<>$0>:3+\::"P"%\"P"/5+g00g-:1+#^_$:~>00gvv0gp03:+5/"P"\p02:%"P":< ^
>>>>>> , >>>>>> ^$p+5/"P"\%"P":-g00g+5/"P"\%"P":+1\+<>0g-\-:0v>5+g00g-:1+>>#^_$
-:0\`#@_^<<<<<_1#`-#0:#p2#g5#08#3*#g*#0%#2\#+2#g5#08#<**/5+g00g</
{{out}}
<pre>15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!</pre>
=={{header|BQN}}==
Since Subleq programs can potentially run forever, this program prints each character with a newline.
<syntaxhighlight lang="bqn">
# Helpers
_while_ ← {𝔽⍟𝔾∘𝔽_𝕣_𝔾∘𝔽⍟𝔾𝕩}
ToNum ← {neg ← '-'=⊑𝕩 ⋄ (¯1⋆neg)×10⊸×⊸+˜´·⌽-⟜'0'neg↓𝕩}
Subleq ← {
𝕊 memory:
{
𝕊 ip‿mem:
{
¯1‿b‿·: ⟨ip+3, (@-˜•term.CharB@)⌾(b⊸⊑) mem⟩;
a‿¯1‿·: •Out @+a⊑mem, ⟨ip+3, mem⟩;
a‿b‿c : d ← b-○(⊑⟜mem)a, ⟨(0<d)⊑⟨c, ip+3⟩, d⌾(b⊸⊑) mem⟩
} mem⊏˜ip+↕3
} _while_ {𝕊 ip‿mem: ip≥0} 0‿memory
}
Subleq ToNum¨•args</syntaxhighlight>
<syntaxhighlight lang="text">$ cbqn subleq.bqn 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
H
e
l
l
o
,
w
o
r
l
d
!
</syntaxhighlight>
=={{header|C}}==
Takes the subleq instruction file as input, prints out usage on incorrect invocation.
<syntaxhighlight lang="c">#include <stdlib.h>
#include <
void
subleq(int *code)
{
int ip = 0, a, b, c, nextIP;
char ch;
while(0 <= ip) {
nextIP = ip + 3;
a = code[ip];
b = code[ip + 1];
c = code[ip + 2];
if(a == -1) {
scanf("%c", &ch);
code[b] = (int)ch;
} else if(b == -1) {
printf("%c", (char)code[a]);
} else {
code[b] -= code[a];
if(code[b] <= 0)
nextIP = c;
}
Line 334 ⟶ 1,576:
}
void
processFile(char *fileName)
{
int *dataSet, i, num;
FILE *fp = fopen(fileName, "r");
fscanf(fp, "%d", &num);
dataSet = (int *)malloc(num * sizeof(int));
fscanf(fp, "%d", &dataSet[i]);
fclose(fp);
subleq(dataSet);
}
int
main(int argC, char *argV[])
{
if(argC != 2)
printf("Usage : %s <subleq code file>\n", argV[0]);
else
processFile(argV[1]);
return 0;
}
</syntaxhighlight>
Input file (subleqCode.txt), first row contains the number of code points ( integers in 2nd row):
<pre>
Line 370 ⟶ 1,609:
Hello, world!
</pre>
=={{header|C sharp|C#}}==
{{trans|Java}}
<syntaxhighlight lang="csharp">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);
}
}
}</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|C++}}==
<
#include <fstream>
#include <iostream>
Line 419 ⟶ 1,700:
return 0;
}
</syntaxhighlight>
{{out}}
Line 427 ⟶ 1,708:
</pre>
=={{header|
<syntaxhighlight lang="clu">% Read numbers from a stream
read_nums = iter (s: stream) yields (int)
while true do
c: char := stream$getc(s)
while c~='-' & ~(c>='0' & c<='9') do
c := stream$getc(s)
end
acc: int := 0
neg: bool
if c='-' then
neg := true
c := stream$getc(s)
else
neg := false
end
while c>='0' & c<='9' do
acc := acc*10 + char$c2i(c) - char$c2i('0')
c := stream$getc(s)
except when end_of_file: break end
end
if neg then acc := -acc end
yield(acc)
end except when end_of_file: end
end read_nums
% Auto-resizing array
mem = cluster is new, load, fetch, store
rep = array[int]
new = proc () returns (cvt)
return(rep$predict(0,2**9))
end new
fill_to = proc (a: rep, lim: int)
while rep$high(a) < lim do rep$addh(a,0) end
end fill_to
fetch = proc (a: cvt, n: int) returns (int) signals (bounds)
fill_to(a,n)
return(a[n]) resignal bounds
end fetch
store = proc (a: cvt, n: int, v: int) signals (bounds)
fill_to(a,n)
a[n] := v resignal bounds
end store
load = proc (a: cvt, s: stream)
i: int := 0
for n: int in read_nums(s) do
up(a)[i] := n
i := i + 1
end
end load
end mem
subleq = proc (m: mem, si, so: stream)
ip: int := 0
while ip >= 0
a: int := m[ip]
b: int := m[ip+1]
c: int := m[ip+2]
ip := ip +
if a=-1 then m[b]
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
fname: file_name := file_name$parse(sequence[string]$bottom(args))
file: stream := stream$open(fname, "read")
m: mem :=
mem$load(m, file)
stream$close(file)
subleq(m, pi, po)
end start_up</syntaxhighlight>
{{out}}
<pre>
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
$ ./subleq hello.sub
Hello, world!</pre>
=={{header|COBOL}}==
For compatibility with online COBOL compilers, where file IO is not supported, this implementation reads the Subleq program from the console. Note that COBOL tables (arrays) are indexed from 1 rather than 0, and so are character sets: in an ASCII environment 'A' is coded as 66 (the sixty-sixth character), not 65.
<
program-id. subleq-program.
data division.
Line 551 ⟶ 1,887:
if memory(adjusted-index-b) is equal to zero
or memory(adjusted-index-b) is negative
then move c to instruction-pointer.</
{{out}}
<pre>READING SUBLEQ PROGRAM... 0032 WORDS READ.
Line 559 ⟶ 1,895:
HALTED AFTER 0073 INSTRUCTIONS.</pre>
=={{header|Commodore BASIC}}==
The sample program is the one from the task description with a slightly different text string: it starts with the control code to convert to mixed-case mode (14), and the rest
is in PETSCII rather than standard ASCII.
<syntaxhighlight lang="basic">100 READ N:REM SIZE OF PROGRAM
110 DIM M%(N-1)
120 FOR I=1 TO N
130 : READ M%(I-1)
140 NEXT I
150 IP=0
160 FOR D=0 TO 1 STEP 0
170 : IF IP < 0 OR IP > N-3 THEN D=1:GOTO 290
180 : A=M%(IP):B=M%(IP+1):C=M%(IP+2)
190 : IP=IP+3
200 : IF A >= 0 THEN 240
210 : GET K$: IF K$="" THEN 210
220 : M%(B) = ASC(K$)
230 : GOTO 290
240 : IF B >= 0 THEN 270
250 : PRINT CHR$(M%(A));
260 : GOTO 290
270 : M%(B)=M%(B)-M%(A)
280 : IF M%(B) <= 0 THEN IP=C
290 NEXT D
300 END
310 DATA 33
320 DATA 15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1
330 DATA 14, 200, 69, 76, 76, 79, 44, 32, 87, 79, 82, 76, 68, 33, 13, 0</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
=={{header|Common Lisp}}==
<
(loop for pc = 0 then next-pc
until (minusp pc)
Line 581 ⟶ 1,949:
(let ((memory (vector 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72
101 108 108 111 44 32 119 111 114 108 100 33 10 0)))
(run memory)))</
{{out}}<pre>Hello, world!</pre>
=={{header|D}}==
<
void main() {
Line 617 ⟶ 1,985:
instructionPointer += 3;
} while (instructionPointer >= 0);
}</
{{out}}
<pre>Hello, world!</pre>
=={{header|Delphi}}==
{{Trans|Java}}
<syntaxhighlight lang="delphi">
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.
</syntaxhighlight>
=={{header|Draco}}==
<syntaxhighlight lang="draco">\util.g
proc nonrec rdch() byte:
char c;
if read(c) then
pretend(c, byte)
else
case ioerror()
incase CH_MISSING: readln(); 10
default: 0
esac
fi
corp
proc nonrec wrch(byte b) void:
if b=10
then writeln()
else write(pretend(b, char))
fi
corp
proc nonrec main() void:
[16384] int mem;
file() srcfile;
channel input text srcch;
*char fname;
int a, b, c, i;
byte iob;
BlockFill(pretend(&mem[0], *byte), sizeof(byte), 0);
fname := GetPar();
if fname = nil then
writeln("usage: SUBLEQ filename");
exit(1);
fi;
if not open(srcch, srcfile, fname) then
writeln("Cannot open input file");
exit(1)
fi;
i := 0;
while read(srcch; mem[i]) do i := i + 1 od;
close(srcch);
i := 0;
while i>=0 do
a := mem[i];
b := mem[i+1];
c := mem[i+2];
i := i + 3;
if a=-1 then mem[b] := rdch()
elif b=-1 then wrch(mem[a])
else
mem[b] := mem[b] - mem[a];
if mem[b] <= 0 then i := c fi
fi
od
corp</syntaxhighlight>
{{out}}
<pre>A>type hello.sub
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
A>subleq hello.sub
Hello, world!</pre>
=={{header|EasyLang}}==
{{trans|FreeBASIC}}
<syntaxhighlight>
global inpos inp$ .
func inp .
if inpos = 0
inp$ = input
if error = 1
return 255
.
inpos = 1
.
if inpos <= len inp$
h = strcode substr inp$ inpos 1
inpos += 1
return h
.
inpos = 0
return 10
.
proc subleq . mem[] .
repeat
a = mem[p]
b = mem[p + 1]
c = mem[p + 2]
p += 3
if a = -1
mem[b] = inp
elif b = -1
write strchar mem[a]
else
mem[b] -= mem[a]
if mem[b] <= 0
p = c
.
.
until p < 0
.
.
prog[] = [ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ]
arrbase prog[] 0
#
subleq prog[]
#
input_data
dummy data
</syntaxhighlight>
=={{header|Forth}}==
Note that Forth is stack oriented. Hence, the code is toggled in in reverse.
<syntaxhighlight lang="text">create M 32 cells allot
: enter refill drop parse-word evaluate ; : M[] cells M + ;
Line 637 ⟶ 2,172:
-1 0 0 15 15 -1 3 16 -1 1 16 -1 -1 17 -1 17 15
init subleq</
{{out}}
<pre>init subleq
Line 650 ⟶ 2,185:
But Fortran 90 introduced the ability to specify the lower bounds of an array, so MEM(0:LOTS) is available without difficulty, and formulae may be translated with greater ease: handling offsets is a simple clerical task; computers excel at simple clerical tasks, so, let the computer do it. Otherwise, the following code would work with F77, except possibly for the odd usage of $ in a FORMAT statement so that each character of output is not on successive lines.
<syntaxhighlight lang="fortran">
PROGRAM SUBLEQ0 !Simulates a One-Instruction computer, with Subtract and Branch if <= 0.
INTEGER LOTS,LOAD !Document some bounds.
Line 680 ⟶ 2,215:
IF (IAR.GE.0) GO TO 100 !Keep at it.
END !That was simple.
</syntaxhighlight>
For simplicity there are no checks on memory bounds or endless looping, nor any trace output. The result is
<pre>
Line 688 ⟶ 2,223:
=={{header|Go}}==
<
import (
Line 734 ⟶ 2,269:
log.Fatalln("write:", err)
}
}</
A much longer version using types, methods, etc
and that supports supplying a program via a file or the command line,
Line 742 ⟶ 2,277:
=={{header|Haskell}}==
Inspired by the Racket solution.
<
import Control.Monad.State
import Data.Char (chr, ord)
Line 771 ⟶ 2,306:
zip [0..]
[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 32, 119, 111, 114, 108, 100, 33, 10, 0]
</syntaxhighlight>
=={{header|J}}==
<
if.0=#INBUF do. INBUF=:LF,~1!:1]1 end.
r=.3 u:{.INBUF
Line 801 ⟶ 2,336:
end.
OUTBUF
)</
Example:
<
Hello, world!</
=={{header|Janet}}==
<syntaxhighlight lang="clojure">(defn main [& args]
(let [filename (get args 1)
fh (file/open filename)
program (file/read fh :all)
memory (eval-string (string "@[" program "]"))
size (length memory)]
(var pc 0)
(while (<= 0 pc size)
(let [a (get memory pc)
b (get memory (inc pc))
c (get memory (+ pc 2))]
(set pc (+ pc 3))
(cond
(< a 0) (put memory b (first (file/read stdin 1)))
(< b 0) (file/write stdout (buffer/push-byte @"" (get memory a)))
true
(do
(put memory b (- (get memory b) (get memory a)))
(if (<= (get memory b) 0)
(set pc c))))))))</syntaxhighlight>
{{Out}}
<pre>$ janet subleq.janet hello.sq
Hello, world!
</pre>
=={{header|Java}}==
<
public class Subleq {
Line 843 ⟶ 2,407:
} while (instructionPointer >= 0);
}
}</
<pre>Hello, world!</pre>
Line 858 ⟶ 2,422:
or some post-processing. The output shown below assumes the -j
(--join-output) command-line option is available.
<
def while(cond; update):
def _while: if cond then ., (update | _while) else empty end;
Line 889 ⟶ 2,453:
subleq([15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0])</
{{out}}
<
Hello, world!</
=={{header|Julia}}==
{{trans|Kotlin}}
'''Module''':
<
using
function interpret(
words =
buf = IOBuffer()
ip = 0
a, b, c = words[ip:ip+2]
ip += 3
Line 940 ⟶ 2,488:
return String(take!(buf))
end
interpret(src::AbstractString) = interpret(parse.(Int, split(src)))
end # module Subleq
</syntaxhighlight>
'''Main''':
<syntaxhighlight lang="julia">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"))
</syntaxhighlight>{{out}}
<pre>
Hello, world!
</pre>
=={{header|Kotlin}}==
<
fun subleq(program: String) {
Line 983 ⟶ 2,535:
val program = "15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0"
subleq(program)
}</
{{out}}
Line 991 ⟶ 2,543:
=={{header|Logo}}==
<
to load_subleq
Line 1,029 ⟶ 2,581:
load_subleq
run_subleq
bye</
{{Out}}
Line 1,038 ⟶ 2,590:
=={{header|Lua}}==
<
local mem, p, A, B, C = {}, 0
for word in prog:gmatch("%S+") do
Line 1,059 ⟶ 2,611:
end
subleq("15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0")</
=={{header|Mathematica}} / {{header|Wolfram Language}}==
{{trans|R}}
<syntaxhighlight lang="mathematica">ClearAll[memory, MemoryGet, MemorySet, MemorySubtract]
memory = {15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0,
0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33,
10, 0};
MemoryGet[addr_] := memory[[addr + 1]]
MemorySet[addr_, value_] := memory[[addr + 1]] = value
MemorySubtract[addr1_, addr2_] := MemorySet[addr1, MemoryGet[addr1] - MemoryGet[addr2]]
p = 0;
While[p >= 0,
a = MemoryGet[p];
b = MemoryGet[p + 1];
c = MemoryGet[p + 2];
If[b == -1,
Print[FromCharacterCode[MemoryGet[a]]]
,
MemorySubtract[b, a];
If[MemoryGet[b] < 1,
p = MemoryGet[p + 2];
Continue[]
]
];
p += 3;
]</syntaxhighlight>
{{out}}
<pre>H
e
l
l
o
,
w
o
r
l
d
!
</pre>
=={{header|MiniScript}}==
<syntaxhighlight lang="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"</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|Modula-2}}==
<
FROM Terminal IMPORT Write,WriteString,WriteLn,ReadChar;
Line 1,101 ⟶ 2,748:
ReadChar
END Subleq.</
=={{header|Nim}}==
<syntaxhighlight lang="nim">import streams
type
Interpreter = object
mem: seq[int]
ip: int
input, output: Stream
proc load(prog: openArray[int]; inp, outp: Stream): Interpreter =
Interpreter(mem: prog, input: inp, output: outp)
proc run(i: var Interpreter) =
while i.ip >= 0:
let A = i.mem[i.ip]
let B = i.mem[i.ip+1]
let C = i.mem[i.ip+2]
i.ip += 3
if A == -1:
i.mem[B] = ord(i.input.readChar)
elif B == -1:
i.output.write(chr(i.mem[A]))
else:
i.mem[B] -= i.mem[A]
if i.mem[B] <= 0:
i.ip = C
let test = @[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0]
var intr = load(test, newFileStream(stdin), newFileStream(stdout))
try:
intr.run()
except IndexDefect:
echo "ip: ", intr.ip
echo "mem: ", intr.mem</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|Objeck}}==
{{trans|Java}}
<
class Sublet {
Line 1,142 ⟶ 2,828:
while (instructionPointer >= 0);
}
}</
<pre>
Hello, world!
</pre>
=={{header|Oforth}}==
<
| ip a b c newb |
program asListBuffer ->program
Line 1,166 ⟶ 2,851:
[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0 ]
subleq</
=={{header|ooRexx}}==
Line 1,172 ⟶ 2,857:
{{trans|REXX}}
reformatted and long variable names that suit all Rexxes.
<
Signal on Halt /*enable user to halt the simulation. */
cell.=0 /*zero-out all of real memory locations*/
Line 1,209 ⟶ 2,894:
Return cell._ /*return the contents of "memory" loc _*/
halt: Say 'REXX program halted by user.'
Exit 1</
{{out}}
<pre>Hello, world!</pre>
Line 1,217 ⟶ 2,902:
Using an array object instead of a stem for cells.
<br>Array indexes must be positive!
<
Signal on Halt /*enable user to halt the simulation. */
cell=.array~new /*zero-out all of real memory locations*/
Line 1,252 ⟶ 2,937:
Exit
halt: Say 'REXX program halted by user.';
Exit 1</
=={{header|Pascal}}==
{{works with|Free Pascal|1.06}}
<
CONST
Line 1,316 ⟶ 3,001:
LOADTEXT (FILENAME, MEM);
SUBLEQ (MEM);
END.</
{{in}}
Line 1,327 ⟶ 3,012:
=={{header|Perl}}==
<
use strict;
use warnings;
Line 1,351 ⟶ 3,036:
}
}
}</
{{Output}}<pre>Hello, world!</pre>
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">subleq</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">ip</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">3</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">3</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">?</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">getc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">c</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">subleq</span><span style="color: #0000FF;">({</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">72</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">101</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">44</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">32</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">119</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">114</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">33</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">10</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,405 ⟶ 3,069:
=={{header|PicoLisp}}==
<
(nth
(quote
Line 1,418 ⟶ 3,082:
((lt0 B) (prin (char (car (mem A)))))
((le0 (dec (mem B) (car (mem A))))
(setq IP (mem C)) ) ) ) )</
Output:
<pre>Hello, world!</pre>
Line 1,424 ⟶ 3,088:
=={{header|PowerShell}}==
{{trans|Python}}
<syntaxhighlight lang="powershell">
function Invoke-Subleq ([int[]]$Program)
{
Line 1,462 ⟶ 3,126:
}
}
</syntaxhighlight>
<syntaxhighlight lang="powershell">
Invoke-Subleq -Program 15,17,-1,17,-1,-1,16,1,-1,16,3,-1,15,15,0,0,-1,72,101,108,108,111,44,32,119,111,114,108,100,33,10,0
</syntaxhighlight>
{{Out}}
<pre>
Hello, world!
</pre>
=={{header|PureBasic}}==
<syntaxhighlight lang="purebasic">DataSection
StartData:
Data.i 15,17,-1,17,-1,-1,16,1,-1,16,3,-1,15,15,0,0,-1,72,101,108,108,111,44,32,119,111,114,108,100,33,10,0
StopData:
EndDataSection
If OpenConsole("Subleq")=0 : End 1 : EndIf
Dim code.i((?StopData-?StartData)/SizeOf(Integer)-1)
CopyMemory(?StartData,@code(0),?StopData-?StartData)
Define.i ip=0,a,b,c,nip
While 0<=ip
nip=ip+3 : a=code(ip) : b=code(ip+1) : c=code(ip+2)
If a=-1 : code(b)=Asc(Input())
ElseIf b=-1 : Print(Chr(code(a)))
Else : code(b)-code(a) : If code(b)<=0 : nip=c : EndIf
EndIf
ip=nip
Wend
Input()</syntaxhighlight>
=={{header|Python}}==
<
def subleq(a):
Line 1,495 ⟶ 3,180:
subleq([15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15,
0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111,
114, 108, 100, 33, 10, 0])</
=={{header|Quackery}}==
Quackery understands a subset of ASCII, namely the printable characters, 32 (space) and 13 (carriage return). To accommodate this, the 10 (line feed) at the end of Hello, world! has been replaced with a 13.
The input stream to the Subleq program is passed to <code>subleq</code> as a string, along with the Subleq code, which is a nest of numbers. <code>getch</code> puts successive characters from the string into the address given by A. When the string is exhausted, <code>getch</code> puts a 0.
In the task program no input is required, so the empty string is passed.
<code>subleq</code> returns the output stream as a string.
<syntaxhighlight lang="Quackery"> ( O = Output string I = Input string S = Subleq code )
[ stack 0 ] is ip ( --> s )
[ stack 0 ] is a ( --> s )
[ stack 0 ] is b ( --> s )
[ stack 0 ] is c ( --> s )
[ over $ "" = iff 0
else
[ swap behead dip swap ]
swap b share poke ] is getch ( O I S --> O I S )
[ dup a share peek
dip rot join unrot ] is putch ( O I S --> O I S )
[ $ "" unrot
0 ip replace
[ dup ip share
2dup peek a replace
2dup 1 + peek b replace
2 + peek c replace
3 ip tally
a share -1 = iff getch again
b share -1 = iff putch again
dup b share peek
over a share peek -
tuck dip [ b share poke ]
1 < until
c share dup ip replace
0 < until ]
2drop ] is subleq ( I S --> O )
$ ""
' [ 15 17 -1 17 -1 -1 16 1
-1 16 3 -1 15 15 0 0
-1 72 101 108 108 111 44 32
119 111 114 108 100 33 13 0 ]
subleq echo$</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|R}}==
<syntaxhighlight lang="rsplus">
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
}
</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|Racket}}==
{{trans|Go}} The negative addresses are treated as -1.
<
(define (subleq v)
Line 1,526 ⟶ 3,297:
0))
(subleq Hello)</
{{out}}
<pre>Hello, world!</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{trans|Perl}}
<syntaxhighlight lang="raku" line>my @hello-world =
|<15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1>,
|"Hello, world!\n\0".comb.map(*.ord);
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;</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
Line 1,534 ⟶ 3,334:
The REXX language has no concept of a ''word'', but for storing numbers, the default is nine decimal digits.
<
signal on halt /*enable user to halt the simulation.*/
parse arg $ /*get optional low memory vals from CL.*/
Line 1,542 ⟶ 3,342:
else $=$$ 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
/* [↑] ASCII (the "else" choice). Line Feed≡LF*/
@.=
do j=0 for words($); @.j=word($,j+1)
do #=0 by 3 until #<0; a= @
when a<0
otherwise
end /*select*/
end
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:
halt: say 'The
{{out|output|text= when using the default input:}}
<pre>
Hello, world!
</pre>
=={{header|RPL}}==
{{works with|HP|48G}}
« 'Ram' DUP ROT ←ptr + GET 1 + GET
» '<span style="color:blue">PEEKind</span>' STO <span style="color:grey">@ ''( n → Ram[Ram[←ptr + n]] )''</span>
« 0 "" → ←ptr stdout
« { } + RDM 'Ram' STO
'''WHILE''' ←ptr 0 ≥ '''REPEAT'''
'''CASE'''
'Ram' ←ptr 1 + GET -1 == '''THEN'''
'Ram' 2 <span style="color:blue">PEEKind</span> '''DO UNTIL''' KEY '''END''' PUT '''END'''
'Ram' ←ptr 2 + GET -1 == '''THEN'''
'stdout' 1 <span style="color:blue">PEEKind</span> CHR STO+ '''END'''
2 <span style="color:blue">PEEKind</span> 1 <span style="color:blue">PEEKind</span> -
'Ram' DUP ←ptr 2 + GET 1 + 3 PICK PUT
0 ≤ '''THEN'''
1 SF '''END'''
1 CF
'''END'''
'''IF''' 1 FS? '''THEN'''
'Ram' ←ptr 3 + GET '←ptr' STO
'''ELSE'''
3 '←ptr' STO+
'''END'''
'''END'''
stdout
» » '<span style="color:blue">SUBLEQ</span>' STO <span style="color:grey">@ ''( [ program ] mem_size → stdout ] )''</span>
[ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ] 256 <span style="color:blue">SUBLEQ</span>
{{out}}
<pre>
1: "Hello, world!
"
</pre>
=={{header|Ruby}}==
<
def initialize program
@memory = program.map
@instruction_pointer = 0
end
Line 1,581 ⟶ 3,415:
writechar @memory[a]
else
difference = @memory[b] -= @memory[a]
@instruction_pointer = c if difference <= 0
end
Line 1,607 ⟶ 3,440:
subleq = Computer.new ARGV
subleq.run</
'''Sample usage:'''
<pre>
Line 1,616 ⟶ 3,449:
=={{header|Scala}}==
===Imperative, Javaish, destructible opcodes read===
<
object Subleq extends App {
Line 1,634 ⟶ 3,467:
instructionPointer += 3
} while (instructionPointer >= 0)
}</
{{Out}}See it running in your browser by [https://scastie.scala-lang.org/f4MszRqZR5qtxI6YwarJhw Scastie (JVM)].
=={{header|SETL}}==
<syntaxhighlight lang="setl">program subleq;
if command_line(1) = om then
print("error: no file given");
stop;
end if;
mem := readprog(command_line(1));
loop init ip := 0; while ip >= 0 do
a := mem(ip) ? 0;
b := mem(ip+1) ? 0;
c := mem(ip+2) ? 0;
ip +:= 3;
if a = -1 then
mem(b) := ichar (getchar ? "\0");
elseif b = -1 then
putchar(char ((mem(a) ? 0) mod 256));
elseif (mem(b) +:= -(mem(a) ? 0)) <= 0 then
ip := c;
end if;
end loop;
proc readprog(fname);
if (f := open(fname, "r")) = om then
print("error: cannot open file");
stop;
end if;
mem := {};
mp := 0;
loop doing getb(f, n); while n/=om do
mem(mp) := n;
mp +:= 1;
end loop;
close(f);
return mem;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ cat hello.sub
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
$ setl subleq.setl hello.sub
Hello, world!</pre>
=={{header|Sidef}}==
{{trans|
<
var ip = 0;
Line 1,653 ⟶ 3,532:
ip = c
}
}</
{{out}}
Line 1,665 ⟶ 3,544:
Requires at least 2k of RAM.
<
20 INPUT P$
30 LET W=1
Line 1,697 ⟶ 3,576:
310 GOTO 160
320 PRINT CHR$ (M(A+1)-1);
330 GOTO 160</
{{in}}
<pre>15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 46 43 50 50 53 27 1 61 53 56 50 42 28 118 0</pre>
{{out}}
<pre>HELLO, WORLD.</pre>
=={{header|SNOBOL4}}==
All "addresses" get 1 added to them before being used as array indexes.
<syntaxhighlight lang="snobol"> MEM = ARRAY('32')
MEM<1> = 15
MEM<2> = 17
MEM<3> = -1
MEM<4> = 17
MEM<5> = -1
MEM<6> = -1
MEM<7> = 16
MEM<8> = 1
MEM<9> = -1
MEM<10> = 16
MEM<11> = 3
MEM<12> = -1
MEM<13> = 15
MEM<14> = 15
MEM<15> = 0
MEM<16> = 0
MEM<17> = -1
MEM<18> = 72
MEM<19> = 101
MEM<20> = 108
MEM<21> = 108
MEM<22> = 111
MEM<23> = 44
MEM<24> = 32
MEM<25> = 119
MEM<26> = 111
MEM<27> = 114
MEM<28> = 108
MEM<29> = 100
MEM<30> = 33
MEM<31> = 10
MEM<32> = 0
INBUF =
OUTBUF =
BP = 0
IP = 0
LOOP GE(IP, 0) :F(DONE)
A = MEM<IP + 1>
B = MEM<IP + 2>
C = MEM<IP + 3>
IP = IP + 3
GE(A, 0) :S(NOIN)
LE(BP,SIZE(INBUF)) :S(GETCH)
INBUF = INPUT
BP = 1
GETCH &ALPHABET @N SUBSTR(INBUF,BP,1)
MEM<B + 1> = N
BP = BP + 1 :(LOOP)
NOIN GE(B, 0) :S(NOOUT)
EQ(MEM<A + 1>, 10) :F(PUTCH)
OUTPUT = OUTBUF
OUTBUF = :(LOOP)
PUTCH OUTBUF = OUTBUF CHAR(MEM<A + 1>) :(LOOP)
NOOUT MEM<B + 1> = MEM<B + 1> - MEM<A + 1>
LE(MEM<B + 1>, 0) :F(LOOP)
IP = C :(LOOP)
DONE EQ(SIZE(OUTBUF),0) :S(END)
OUTPUT = OUTBUF
END</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
=={{header|Swift}}==
{{trans|Python}}
<syntaxhighlight lang="swift">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)
</syntaxhighlight>
{{out}}
<pre>Hello, world!</pre>
=={{header|Tcl}}==
<syntaxhighlight lang="tcl">
namespace import ::tcl::mathop::-
Line 1,730 ⟶ 3,722:
fconfigure stdout -buffering none
subleq {15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0}
</syntaxhighlight>
{{out}}
Line 1,736 ⟶ 3,728:
=={{header|uBasic/4tH}}==
<syntaxhighlight lang="text">GoSub _Initialize ' Initialize memory
i = 0 ' Reset instruction pointer
Line 1,787 ⟶ 3,779:
@(30) = 10 ' Replace with =ORD(c) when required
@(31) = 0
Return</
{{out}}
<pre>Hello, world!
0 OK, 0:2010</pre>
=={{header|UNIX Shell}}==
===dash===
<syntaxhighlight lang="bash">#!/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
</syntaxhighlight>
===bash===
<syntaxhighlight lang="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"
</syntaxhighlight>
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="wren">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)</syntaxhighlight>
{{out}}
<pre>
Hello, world!
</pre>
=={{header|XPL0}}==
{{trans|ALGOL W}}
<syntaxhighlight lang "XPL0">\Subleq program interpreter
\Executes the program specified in scode, stops when the instruction
\ pointer becomes negative.
procedure RunSubleq ( SCode, CodeLength);
integer SCode, CodeLength;
define MaxMemory = 3 * 1024;
integer Memory ( MaxMemory );
integer IP, A, B, C, I;
begin
begin
for I := 0 to MaxMemory - 1 do Memory( I ) := 0;
\Load the program into Memory
for I := 0 to CodeLength do Memory( I ) := SCode( I );
\Start at instruction 0
IP := 0;
\Execute the instructions to IP is < 0
while IP >= 0 do begin
\Get three words at IP and advance IP past them
A := Memory( IP );
B := Memory( IP + 1 );
C := Memory( IP + 2 );
IP := IP + 3;
\Execute according to A, B and C
if A = -1 then begin
\Input a character to B
Memory( B ) := ChIn(1)
end
else if B = -1 then begin
\Output character from A
ChOut(0, Memory ( A ) )
end
else begin
\Subtract and branch if <= 0
Memory( B ) := Memory( B ) - Memory( A );
if Memory( B ) <= 0 then IP := C
end
end \while-do
end
end \RunSubleq \;
\Test the interpreter with the hello-world program specified in the task
integer Code;
begin
Code := [ 15, 17, -1, 17, -1, -1
, 16, 1, -1, 16, 3, -1
, 15, 15, 0, 0, -1, 72
, 101, 108, 108, 111, 44, 32
, 119, 111, 114, 108, 100, 33
, 10, 0 ];
RunSubleq( Code, 31 )
end</syntaxhighlight>
{{out}}
<pre>
Hello, world!
</pre>
=={{header|zkl}}==
{{trans|Python}}
<
i:=0;
while(i>=0){ A,B,C:=a[i,3];
Line 1,803 ⟶ 3,961:
i+=3;
}
}</
<
0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108,
100, 33, 10, 0);</
{{out}}<pre>Hello, world!</pre>
=={{header|ZX Spectrum Basic}}==
Reads the Subleq program from the keyboard, as space-separated numbers, and executes it. A couple of implementation details (arrays being indexed from 1 rather than from 0; the control character ASCII 10 needing to be intercepted specially, because it would otherwise be printed as <code>?</code> rather than as a newline character) are hidden from the Subleq programmer. Lines <code>10</code> to <code>140</code> are the machine code loader, lines <code>150</code> to <code>310</code> the VM.
<
20 INPUT p$
30 LET word=1
Line 1,841 ⟶ 3,999:
290 IF m(a+1)=10 THEN PRINT : GO TO 160
300 PRINT CHR$ m(a+1);
310 GO TO 160</
{{out}}
<pre>Hello, world!</pre>
| |||