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:
- 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.
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
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
% 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
#!/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
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
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
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
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
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 ← '-'=⊑𝕩 ⋄ (¯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
$ 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#
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
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
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
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
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!
Logo
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
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
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
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
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
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
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
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)
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
« '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
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
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
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
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
\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
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!
- Programming Tasks
- Solutions by Programming Task
- 11l
- 8080 Assembly
- 8086 Assembly
- Ada
- ALGOL 68
- ALGOL W
- APL
- ARM Assembly
- Arturo
- AWK
- BASIC
- BASIC256
- FreeBASIC
- Gambas
- GW-BASIC
- QBasic
- Yabasic
- BBC BASIC
- BCPL
- Befunge
- BQN
- C
- C sharp
- C++
- CLU
- COBOL
- Commodore BASIC
- Common Lisp
- D
- Delphi
- Draco
- EasyLang
- Forth
- Fortran
- Go
- Haskell
- J
- Janet
- Java
- Jq
- Julia
- Kotlin
- Logo
- Lua
- Mathematica
- Wolfram Language
- MiniScript
- Modula-2
- Nim
- Objeck
- Oforth
- OoRexx
- Pascal
- Perl
- Phix
- PicoLisp
- PowerShell
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REXX
- RPL
- Ruby
- Scala
- SETL
- Sidef
- Sinclair ZX81 BASIC
- SNOBOL4
- Swift
- Tcl
- UBasic/4tH
- UNIX Shell
- Wren
- XPL0
- Zkl
- ZX Spectrum Basic